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

definition inputTransition :: "pi \<Rightarrow> name \<Rightarrow> pi \<Rightarrow> name \<Rightarrow> name \<Rightarrow> pi \<Rightarrow> bool" ("_ \<Longrightarrow>\<^sub>l_ in _\<rightarrow>_<_> \<prec> _" [80, 80, 80, 80, 80] 80)
where "P \<Longrightarrow>\<^sub>lu in P'' \<rightarrow>a<x> \<prec> P' \<equiv> \<exists>P'''. P \<Longrightarrow>\<^sub>\<tau> P''' \<and> P''' \<longmapsto>a<x> \<prec> P'' \<and> P''[x::=u] \<Longrightarrow>\<^sub>\<tau> P'"

definition transition :: "(pi \<times> Late_Semantics.residual) set" where
  "transition \<equiv> {x. \<exists>P P' \<alpha> P'' P'''. P \<Longrightarrow>\<^sub>\<tau> P' \<and> P' \<longmapsto>\<alpha> \<prec> P'' \<and> P'' \<Longrightarrow>\<^sub>\<tau> P''' \<and> x = (P, \<alpha> \<prec> P''')}  \<union>
                {x. \<exists>P P' a y P'' P'''. P \<Longrightarrow>\<^sub>\<tau> P' \<and> (P' \<longmapsto>(a<\<nu>y> \<prec> P'')) \<and> P'' \<Longrightarrow>\<^sub>\<tau> P''' \<and> x = (P, (a<\<nu>y> \<prec> P'''))}"

abbreviation weakTransition_judge :: "pi \<Rightarrow> Late_Semantics.residual \<Rightarrow> bool" ("_ \<Longrightarrow>\<^sub>l _" [80, 80] 80)
  where "P \<Longrightarrow>\<^sub>l Rs \<equiv> (P, Rs) \<in> transition"

lemma weakNonInput[dest]:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi

  assumes "P \<Longrightarrow>\<^sub>la<x> \<prec> P'"

  shows False
using assms
by(auto simp add: transition_def residual.inject)

lemma transitionI:
  fixes P    :: pi
  and   P''' :: pi
  and   \<alpha>    :: freeRes
  and   P''  :: pi
  and   P'   :: pi
  and   a    :: name
  and   x    :: name
  and   u    :: name

  shows "\<lbrakk>P \<Longrightarrow>\<^sub>\<tau> P'''; P''' \<longmapsto>\<alpha> \<prec> P''; P'' \<Longrightarrow>\<^sub>\<tau> P'\<rbrakk> \<Longrightarrow> P \<Longrightarrow>\<^sub>l\<alpha> \<prec> P'"
  and   "\<lbrakk>P \<Longrightarrow>\<^sub>\<tau> P'''; P''' \<longmapsto>a<\<nu>x> \<prec> P''; P'' \<Longrightarrow>\<^sub>\<tau> P'\<rbrakk> \<Longrightarrow> P \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> P'"
  and   "\<lbrakk>P \<Longrightarrow>\<^sub>\<tau> P'''; P''' \<longmapsto>a<x> \<prec> P''; P''[x::=u] \<Longrightarrow>\<^sub>\<tau> P'\<rbrakk> \<Longrightarrow> P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P'"
proof -
  assume "P \<Longrightarrow>\<^sub>\<tau> P'''" and "P''' \<longmapsto> \<alpha> \<prec> P''" and "P'' \<Longrightarrow>\<^sub>\<tau> P'"
  thus "P \<Longrightarrow>\<^sub>l \<alpha> \<prec> P'"
    by(force simp add: transition_def)
next
  assume "P \<Longrightarrow>\<^sub>\<tau> P'''" and "P''' \<longmapsto>a<\<nu>x> \<prec> P''" and "P'' \<Longrightarrow>\<^sub>\<tau> P'"
  thus "P \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> P'"
    by(force simp add: transition_def)
next
  assume "P \<Longrightarrow>\<^sub>\<tau> P'''" and "P''' \<longmapsto>a<x> \<prec> P''" and "P''[x::=u] \<Longrightarrow>\<^sub>\<tau> P'"
  thus "P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P'"
    by(force simp add: inputTransition_def)
qed

lemma transitionE:
  fixes P  :: pi
  and   \<alpha>  :: freeRes
  and   P'  :: pi
  and   P'' :: pi
  and   a   :: name
  and   u   :: name
  and   x   :: name

  shows "P \<Longrightarrow>\<^sub>l\<alpha> \<prec> P' \<Longrightarrow> \<exists>P'' P'''. P \<Longrightarrow>\<^sub>\<tau> P'' \<and> P'' \<longmapsto>\<alpha> \<prec> P''' \<and> P''' \<Longrightarrow>\<^sub>\<tau> P'" (is "_ \<Longrightarrow> ?thesis1")
  and   "\<lbrakk>P \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> P'; x \<sharp> P\<rbrakk> \<Longrightarrow> \<exists>P'' P'''. P \<Longrightarrow>\<^sub>\<tau> P''' \<and> P''' \<longmapsto>a<\<nu>x> \<prec> P'' \<and> P'' \<Longrightarrow>\<^sub>\<tau> P'"
  and   "\<lbrakk>P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P'\<rbrakk> \<Longrightarrow> \<exists>P'''. P \<Longrightarrow>\<^sub>\<tau> P''' \<and> P''' \<longmapsto>a<x> \<prec> P'' \<and> P''[x::=u] \<Longrightarrow>\<^sub>\<tau> P'"
proof -
  assume "P \<Longrightarrow>\<^sub>l\<alpha> \<prec> P'"
  thus ?thesis1 by(auto simp add: transition_def residual.inject)
next
  assume "P \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> P'" and "x \<sharp> P"
  thus "\<exists>P'' P'''. P \<Longrightarrow>\<^sub>\<tau> P''' \<and> P''' \<longmapsto>a<\<nu>x> \<prec> P'' \<and> P'' \<Longrightarrow>\<^sub>\<tau> P'"
  using [[hypsubst_thin = true]]
    apply(auto simp add: transition_def residualInject name_abs_eq)
    apply(rule_tac x="[(x, y)] \<bullet> P''" in exI)
    apply(rule_tac x=P' in exI)
    apply(clarsimp)
    apply(auto)
    apply(subgoal_tac "x \<sharp> P''")
    apply(simp add: alphaBoundResidual name_swap)
    using freshChain
    apply(force dest: freshBoundDerivative)
    using eqvtChainI
    by simp
next
  assume PTrans: "P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P'"
  thus "\<exists>P'''. P \<Longrightarrow>\<^sub>\<tau> P''' \<and> P''' \<longmapsto> a<x> \<prec> P'' \<and> P''[x::=u] \<Longrightarrow>\<^sub>\<tau> P'"
    by(auto simp add: inputTransition_def)
qed

lemma alphaInput:
  fixes P   :: pi
  and   u   :: name
  and   P'' :: pi
  and   a   :: name
  and   x   :: name
  and   P'  :: pi
  and   y   :: name

  assumes PTrans:  "P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P'"
  and     yFreshP: "y \<sharp> P"

  shows "P \<Longrightarrow>\<^sub>lu in ([(x, y)] \<bullet> P'')\<rightarrow>a<y> \<prec> P'"
proof(cases "x=y")
  assume "x=y"
  with PTrans show ?thesis by simp
next
  assume xineqy: "x\<noteq>y"
  from PTrans obtain P''' where PChain: "P \<Longrightarrow>\<^sub>\<tau> P'''"
                            and P'''Trans: "P''' \<longmapsto>a<x> \<prec> P''"
                            and P''Chain: "P''[x::=u] \<Longrightarrow>\<^sub>\<tau> P'"
    by(blast dest: transitionE)

  from PChain yFreshP have "y \<sharp> P'''" by(rule freshChain)
  with P'''Trans xineqy have yFreshP'': "y \<sharp> P''" by(blast dest: freshBoundDerivative)

  with P'''Trans have "P''' \<longmapsto>a<y> \<prec> [(x, y)] \<bullet> P''" by(simp add: alphaBoundResidual)
  moreover from P''Chain yFreshP'' have "([(x, y)] \<bullet> P'')[y::=u] \<Longrightarrow>\<^sub>\<tau> P'"
    by(simp add: renaming name_swap)
  ultimately show ?thesis using PChain by(blast intro: transitionI)
qed

lemma tauActionChain:
  fixes P  :: pi
  and   P' :: pi

  shows "P \<Longrightarrow>\<^sub>l\<tau> \<prec> P' \<Longrightarrow> P \<Longrightarrow>\<^sub>\<tau> P'"
  and   "P \<noteq> P' \<Longrightarrow> P \<Longrightarrow>\<^sub>\<tau> P' \<Longrightarrow> P \<Longrightarrow>\<^sub>l\<tau> \<prec> P'"
proof -
  assume "P \<Longrightarrow>\<^sub>l\<tau> \<prec> P'"
  then obtain P'' P''' where "P \<Longrightarrow>\<^sub>\<tau> P''"
                         and "P'' \<longmapsto>\<tau> \<prec> P'''"
                         and "P''' \<Longrightarrow>\<^sub>\<tau> P'"
    by(blast dest: transitionE)
  thus "P \<Longrightarrow>\<^sub>\<tau> P'" by auto
next
  assume "P \<Longrightarrow>\<^sub>\<tau> P'" and "P \<noteq> P'"
  thus "P \<Longrightarrow>\<^sub>l\<tau> \<prec> P'"
  proof(induct rule: tauChainInduct)
    case id
    thus ?case by simp
  next
    case(ih P'' P''')
    have "P \<Longrightarrow>\<^sub>\<tau> P''" and "P'' \<longmapsto> \<tau> \<prec> P'''" by fact+
    moreover have "P''' \<Longrightarrow>\<^sub>\<tau> P'''" by simp
    ultimately show ?case by(rule transitionI)
  qed
qed

lemma singleActionChain:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   \<alpha>  :: freeRes
  and   u  :: name

  shows "P \<longmapsto>a<\<nu>x> \<prec> P' \<Longrightarrow> P \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> P'"
  and   "\<lbrakk>P \<longmapsto>a<x> \<prec> P'\<rbrakk> \<Longrightarrow> P \<Longrightarrow>\<^sub>lu in P'\<rightarrow>a<x> \<prec> P'[x::=u]"
  and   "P \<longmapsto>\<alpha> \<prec> P' \<Longrightarrow> P \<Longrightarrow>\<^sub>l\<alpha> \<prec> P'"
proof -
  assume "P \<longmapsto>a<\<nu>x> \<prec> P'"
  moreover have "P \<Longrightarrow>\<^sub>\<tau> P" by simp
  moreover have "P' \<Longrightarrow>\<^sub>\<tau> P'" by simp
  ultimately show "P \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> P'" by(blast intro: transitionI)
next
  assume "P \<longmapsto>a<x> \<prec> P'"
  moreover have "P \<Longrightarrow>\<^sub>\<tau> P" by simp
  moreover have "P'[x::=u] \<Longrightarrow>\<^sub>\<tau> P'[x::=u]" by simp
  ultimately show "P \<Longrightarrow>\<^sub>lu in P'\<rightarrow>a<x> \<prec> P'[x::=u]" by(blast intro: transitionI)
next
  assume "P \<longmapsto>\<alpha> \<prec> P'"
  moreover have "P \<Longrightarrow>\<^sub>\<tau> P" by simp
  moreover have "P' \<Longrightarrow>\<^sub>\<tau> P'" by simp
  ultimately show "P \<Longrightarrow>\<^sub>l\<alpha> \<prec> P'"  by(blast intro: transitionI)
qed

lemma Tau:
  fixes P :: pi

  shows "\<tau>.(P) \<Longrightarrow>\<^sub>l \<tau> \<prec>  P"
proof -
  have "\<tau>.(P) \<Longrightarrow>\<^sub>\<tau> \<tau>.(P)" by simp
  moreover have "\<tau>.(P) \<longmapsto>\<tau> \<prec> P" by(rule transitions.Tau)
  moreover have "P \<Longrightarrow>\<^sub>\<tau> P" by simp
  ultimately show ?thesis by(rule transitionI)
qed

lemma Input:
  fixes a :: name
  and   x :: name
  and   u :: name
  and   P :: pi

  shows "a<x>.P \<Longrightarrow>\<^sub>lu in P\<rightarrow>a<x> \<prec> P[x::=u]"
proof -
  have "a<x>.P \<Longrightarrow>\<^sub>\<tau> a<x>.P" by simp
  moreover have "a<x>.P \<longmapsto> a<x> \<prec> P" by(rule Input)
  moreover have "P[x::=u] \<Longrightarrow>\<^sub>\<tau> P[x::=u]" by simp
  ultimately show ?thesis by(rule transitionI)
qed

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

  shows "a{b}.P \<Longrightarrow>\<^sub>la[b] \<prec> P"
proof -
  have "a{b}.P \<Longrightarrow>\<^sub>\<tau> a{b}.P" by simp
  moreover have "a{b}.P \<longmapsto>a[b] \<prec> P" by(rule transitions.Output)
  moreover have "P \<Longrightarrow>\<^sub>\<tau> P" by simp
  ultimately show ?thesis by(rule transitionI)
qed

lemma Match:
  fixes P  :: pi
  and   Rs :: residual
  and   a  :: name
  and   u  :: name
  and   b  :: name
  and   x  :: name
  and   P' :: pi

  shows "P \<Longrightarrow>\<^sub>l Rs \<Longrightarrow> [a\<frown>a]P \<Longrightarrow>\<^sub>l Rs"
  and   "P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>b<x> \<prec> P' \<Longrightarrow> [a\<frown>a]P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>b<x> \<prec> P'"
proof -
  assume PTrans: "P \<Longrightarrow>\<^sub>l Rs"
  thus "[a\<frown>a]P \<Longrightarrow>\<^sub>l Rs"
  proof(nominal_induct avoiding: P rule: residual.strong_inducts)
    case(BoundR b x P')
    have PTrans: "P \<Longrightarrow>\<^sub>l b\<guillemotleft>x\<guillemotright> \<prec> P'" and xFreshP: "x \<sharp> P" by fact+
    from PTrans obtain b' where beq: "b = BoundOutputS b'" by(cases b) auto
    with PTrans xFreshP obtain P'' P''' where PTrans: "P \<Longrightarrow>\<^sub>\<tau> P''"
                                          and P''Trans: "P'' \<longmapsto>b'<\<nu>x> \<prec> P'''"
                                          and P'''Trans: "P''' \<Longrightarrow>\<^sub>\<tau> P'"
      by(blast dest: transitionE)
    show ?case
    proof(cases "P = P''")
      assume "P = P''"
      moreover have "[a\<frown>a]P \<Longrightarrow>\<^sub>\<tau> [a\<frown>a]P" by simp
      moreover from P''Trans have "[a\<frown>a]P'' \<longmapsto> b'<\<nu>x> \<prec> P'''" by(rule Match)
      ultimately show ?thesis using beq P'''Trans by(blast intro: transitionI)
    next
      assume "P \<noteq> P''"
      with PTrans have "[a\<frown>a]P \<Longrightarrow>\<^sub>\<tau> P''" by(rule matchChain)
      thus ?thesis using beq P''Trans P'''Trans by(blast intro: transitionI)
    qed
  next
    case(FreeR \<alpha> P')
    have "P \<Longrightarrow>\<^sub>l \<alpha> \<prec> P'" by fact

    then obtain P'' P''' where PTrans: "P \<Longrightarrow>\<^sub>\<tau> P''"
                           and P''Trans: "P'' \<longmapsto> \<alpha> \<prec> P'''"
                           and P'''Trans: "P''' \<Longrightarrow>\<^sub>\<tau> P'"
      by(blast dest: transitionE)
    show ?case
    proof(cases "P = P''")
      assume "P = P''"
      moreover have "[a\<frown>a]P \<Longrightarrow>\<^sub>\<tau> [a\<frown>a]P" by simp
      moreover from P''Trans have "[a\<frown>a]P'' \<longmapsto> \<alpha> \<prec> P'''" by(rule transitions.Match)
      ultimately show ?thesis using P'''Trans by(blast intro: transitionI)
    next
      assume "P \<noteq> P''"
      with PTrans have "[a\<frown>a]P \<Longrightarrow>\<^sub>\<tau> P''" by(rule matchChain)
      thus ?thesis using P''Trans P'''Trans by(rule transitionI)
    qed
  qed
next
  assume "P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>b<x> \<prec> P'"
  then obtain P''' where PChain: "P \<Longrightarrow>\<^sub>\<tau> P'''"
                     and P'''Trans: "P''' \<longmapsto>b<x> \<prec> P''"
                     and P''Chain: "P''[x::=u] \<Longrightarrow>\<^sub>\<tau> P'"
    by(blast dest: transitionE)
  show "[a\<frown>a]P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>b<x> \<prec> P'"
  proof(cases "P=P'''")
    assume "P=P'''"
    moreover have "[a\<frown>a]P \<Longrightarrow>\<^sub>\<tau> [a\<frown>a]P" by simp
    moreover from P'''Trans have "[a\<frown>a]P''' \<longmapsto>b<x> \<prec> P''" by(rule Late_Semantics.Match)
    ultimately show ?thesis using P''Chain by(blast intro: transitionI)
  next
    assume "P \<noteq> P'''"
    with PChain have "[a\<frown>a]P \<Longrightarrow>\<^sub>\<tau> P'''" by(rule matchChain)
    thus ?thesis using P'''Trans P''Chain by(rule transitionI)
  qed
qed

lemma Mismatch:
  fixes P  :: pi
  and   Rs :: residual
  and   a  :: name
  and   c  :: name
  and   u  :: name
  and   b  :: name
  and   x  :: name
  and   P' :: pi

  shows "\<lbrakk>P \<Longrightarrow>\<^sub>l Rs; a \<noteq> c\<rbrakk> \<Longrightarrow> [a\<noteq>c]P \<Longrightarrow>\<^sub>l Rs"
  and   "\<lbrakk>P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>b<x> \<prec> P'; a \<noteq> c\<rbrakk> \<Longrightarrow> [a\<noteq>c]P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>b<x> \<prec> P'"
proof -
  assume PTrans: "P \<Longrightarrow>\<^sub>l Rs"
     and aineqc: "a \<noteq> c"
  thus "[a\<noteq>c]P \<Longrightarrow>\<^sub>l Rs"
  proof(nominal_induct avoiding: P rule: residual.strong_inducts)
    case(BoundR b x P')
    have PTrans: "P \<Longrightarrow>\<^sub>l b\<guillemotleft>x\<guillemotright> \<prec> P'" and xFreshP: "x \<sharp> P" by fact+
    from PTrans obtain b' where beq: "b = BoundOutputS b'" by(cases b, auto)
    with PTrans xFreshP obtain P'' P''' where PTrans: "P \<Longrightarrow>\<^sub>\<tau> P''"
                                          and P''Trans: "P'' \<longmapsto>b'<\<nu>x> \<prec> P'''"
                                          and P'''Trans: "P''' \<Longrightarrow>\<^sub>\<tau> P'"
      by(blast dest: transitionE)
    show ?case
    proof(cases "P = P''")
      assume "P = P''"
      moreover have "[a\<noteq>c]P \<Longrightarrow>\<^sub>\<tau> [a\<noteq>c]P" by simp
      moreover from P''Trans aineqc have "[a\<noteq>c]P'' \<longmapsto>b'<\<nu>x> \<prec> P'''" by(rule transitions.Mismatch)
      ultimately show ?thesis using beq P'''Trans by(blast intro: transitionI)
    next
      assume "P \<noteq> P''"
      with PTrans aineqc have "[a\<noteq>c]P \<Longrightarrow>\<^sub>\<tau> P''" by(rule mismatchChain)
      thus ?thesis using beq P''Trans P'''Trans by(blast intro: transitionI)
    qed
  next
    case(FreeR \<alpha> P')
    have "P \<Longrightarrow>\<^sub>l \<alpha> \<prec> P'" by fact

    then obtain P'' P''' where PTrans: "P \<Longrightarrow>\<^sub>\<tau> P''"
                           and P''Trans: "P'' \<longmapsto> \<alpha> \<prec> P'''"
                           and P'''Trans: "P''' \<Longrightarrow>\<^sub>\<tau> P'"
      by(blast dest: transitionE)
    show ?case
    proof(cases "P = P''")
      assume "P = P''"
      moreover have "[a\<noteq>c]P \<Longrightarrow>\<^sub>\<tau> [a\<noteq>c]P" by simp
      moreover from P''Trans \<open>a \<noteq> c\<close> have "[a\<noteq>c]P'' \<longmapsto> \<alpha> \<prec> P'''" by(rule transitions.Mismatch)
      ultimately show ?thesis using P'''Trans by(blast intro: transitionI)
    next
      assume "P \<noteq> P''"
      with PTrans aineqc have "[a\<noteq>c]P \<Longrightarrow>\<^sub>\<tau> P''" by(rule mismatchChain)
      thus ?thesis using P''Trans P'''Trans by(rule transitionI)
    qed
  qed
next
  assume aineqc: "a \<noteq> c"
  assume "P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>b<x> \<prec> P'"
  then obtain P''' where PChain: "P \<Longrightarrow>\<^sub>\<tau> P'''"
                     and P'''Trans: "P''' \<longmapsto>b<x> \<prec> P''"
                     and P''Chain: "P''[x::=u] \<Longrightarrow>\<^sub>\<tau> P'"
    by(blast dest: transitionE)
  show "[a\<noteq>c]P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>b<x> \<prec> P'"
  proof(cases "P=P'''")
    assume "P=P'''"
    moreover have "[a\<noteq>c]P \<Longrightarrow>\<^sub>\<tau> [a\<noteq>c]P" by simp
    moreover from P'''Trans aineqc have "[a\<noteq>c]P''' \<longmapsto>b<x> \<prec> P''" by(rule Late_Semantics.Mismatch)
    ultimately show ?thesis using P''Chain by(blast intro: transitionI)
  next
    assume "P \<noteq> P'''"
    with PChain aineqc have "[a\<noteq>c]P \<Longrightarrow>\<^sub>\<tau> P'''" by(rule mismatchChain)
    thus ?thesis using P'''Trans P''Chain by(rule transitionI)
  qed
qed

lemma Open:
  fixes P  :: pi
  and   a  :: name
  and   b  :: name
  and   P' :: pi

  assumes Trans:  "P \<Longrightarrow>\<^sub>la[b] \<prec> P'"
  and     aInEqb: "a \<noteq> b"

  shows "<\<nu>b>P \<Longrightarrow>\<^sub>la<\<nu>b> \<prec> P'"
proof -
  from Trans obtain P'' P''' where A: "P \<Longrightarrow>\<^sub>\<tau> P''"
                               and B: "P'' \<longmapsto>a[b] \<prec> P'''"
                               and C: "P''' \<Longrightarrow>\<^sub>\<tau> P'"
    by(force dest: transitionE)
  from A have "<\<nu>b>P \<Longrightarrow>\<^sub>\<tau> <\<nu>b>P''" by(rule ResChain)
  moreover from B aInEqb have "<\<nu>b>P'' \<longmapsto>a<\<nu>b> \<prec> P'''" by(rule Open)
  ultimately show ?thesis using C by(force simp add: transition_def)
qed

lemma Sum1:
  fixes P   :: pi
  and   Rs  :: residual
  and   Q   :: pi
  and   u   :: name
  and   P'' :: pi
  and   a   :: name
  and   x   :: name
  and   P'  :: pi

  shows "P \<Longrightarrow>\<^sub>l Rs \<Longrightarrow> P \<oplus> Q \<Longrightarrow>\<^sub>l Rs"
  and   "P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P' \<Longrightarrow> P \<oplus> Q \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P'"
proof -
  assume "P \<Longrightarrow>\<^sub>l Rs"
  thus "P \<oplus> Q \<Longrightarrow>\<^sub>l Rs"
  proof(nominal_induct avoiding: P rule: residual.strong_inducts)
    case(BoundR a x P' P)
    have PTrans: "P \<Longrightarrow>\<^sub>la\<guillemotleft>x\<guillemotright> \<prec> P'"
     and xFreshP: "x \<sharp> P" by fact+
    from PTrans obtain a' where aeq: "a = BoundOutputS a'" by(cases a, auto)
    with PTrans xFreshP obtain P'' P''' where PTrans: "P \<Longrightarrow>\<^sub>\<tau> P''"
                                          and P''Trans: "P'' \<longmapsto>a'<\<nu>x> \<prec> P'''"
                                          and P'''Trans: "P''' \<Longrightarrow>\<^sub>\<tau> P'"
      by(blast dest: transitionE)
    show ?case
    proof(cases "P = P''")
      assume "P = P''"
      moreover have "P \<oplus> Q \<Longrightarrow>\<^sub>\<tau> P \<oplus> Q" by simp
      moreover from P''Trans have "P'' \<oplus> Q \<longmapsto>a'<\<nu>x> \<prec> P'''" by(rule transitions.Sum1)
      ultimately show ?thesis using P'''Trans aeq by(blast intro: transitionI)
    next
      assume "P \<noteq> P''"
      with PTrans have "P \<oplus> Q \<Longrightarrow>\<^sub>\<tau> P''" by(rule sum1Chain)
      thus ?thesis using P''Trans P'''Trans aeq by(blast intro: transitionI)
    qed
  next
    case(FreeR \<alpha> P')
    have "P \<Longrightarrow>\<^sub>l \<alpha> \<prec> P'" by fact

    then obtain P'' P''' where PTrans: "P \<Longrightarrow>\<^sub>\<tau> P''"
                           and P''Trans: "P'' \<longmapsto> \<alpha> \<prec> P'''"
                           and P'''Trans: "P''' \<Longrightarrow>\<^sub>\<tau> P'"
      by(blast dest: transitionE)
    show ?case
    proof(cases "P = P''")
      assume "P = P''"
      moreover have "P \<oplus> Q \<Longrightarrow>\<^sub>\<tau> P \<oplus> Q" by simp
      moreover from P''Trans have "P'' \<oplus> Q \<longmapsto> \<alpha> \<prec> P'''" by(rule transitions.Sum1)
      ultimately show ?thesis using P'''Trans by(blast intro: transitionI)
    next
      assume "P \<noteq> P''"
      with PTrans have "P \<oplus> Q \<Longrightarrow>\<^sub>\<tau> P''" by(rule sum1Chain)
      thus ?thesis using P''Trans P'''Trans by(rule transitionI)
    qed
  qed
next
  assume "P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P'"
  then obtain P''' where PChain: "P \<Longrightarrow>\<^sub>\<tau> P'''"
                     and P'''Trans: "P''' \<longmapsto>a<x> \<prec> P''"
                     and P''Chain: "P''[x::=u] \<Longrightarrow>\<^sub>\<tau> P'"
    by(blast dest: transitionE)
  show "P \<oplus> Q \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P'"
  proof(cases "P = P'''")
    assume "P = P'''"
    moreover have "P \<oplus> Q \<Longrightarrow>\<^sub>\<tau> P \<oplus> Q" by simp
    moreover from P'''Trans have "P''' \<oplus> Q \<longmapsto>a<x> \<prec> P''" by(rule transitions.Sum1)
    ultimately show ?thesis using P''Chain by(blast intro: transitionI)
  next
    assume "P \<noteq> P'''"
    with PChain have "P \<oplus> Q \<Longrightarrow>\<^sub>\<tau> P'''" by(rule sum1Chain)
    thus ?thesis using P'''Trans P''Chain by(blast intro: transitionI)
  qed
qed

lemma Sum2:
  fixes Q  :: pi
  and   Rs :: residual
  and   P  :: pi
  and   u  :: name
  and   Q'' :: pi
  and   a  :: name
  and   x  :: name
  and   Q' :: pi

  shows "Q \<Longrightarrow>\<^sub>l Rs \<Longrightarrow> P \<oplus> Q \<Longrightarrow>\<^sub>l Rs"
  and   "Q \<Longrightarrow>\<^sub>lu in Q''\<rightarrow>a<x> \<prec> Q' \<Longrightarrow> P \<oplus> Q \<Longrightarrow>\<^sub>lu in Q''\<rightarrow>a<x> \<prec> Q'"
proof -
  assume "Q \<Longrightarrow>\<^sub>l Rs"
  thus "P \<oplus> Q \<Longrightarrow>\<^sub>l Rs"
  proof(nominal_induct avoiding: Q rule: residual.strong_inducts)
    case(BoundR a x Q' Q)
    have QTrans: "Q \<Longrightarrow>\<^sub>la\<guillemotleft>x\<guillemotright> \<prec> Q'"
     and xFreshQ: "x \<sharp> Q" by fact+
    from QTrans obtain a' where aeq: "a = BoundOutputS a'" by(cases a, auto)
    with QTrans xFreshQ obtain Q'' Q''' where QTrans: "Q \<Longrightarrow>\<^sub>\<tau> Q''"
                                          and Q''Trans: "Q'' \<longmapsto>a'<\<nu>x> \<prec> Q'''"
                                          and Q'''Trans: "Q''' \<Longrightarrow>\<^sub>\<tau> Q'"
      by(blast dest: transitionE)
    show ?case
    proof(cases "Q = Q''")
      assume "Q = Q''"
      moreover have "P \<oplus> Q \<Longrightarrow>\<^sub>\<tau> P \<oplus> Q" by simp
      moreover from Q''Trans have "P \<oplus> Q'' \<longmapsto>a'<\<nu>x> \<prec> Q'''" by(rule transitions.Sum2)
      ultimately show ?thesis using Q'''Trans aeq by(blast intro: transitionI)
    next
      assume "Q \<noteq> Q''"
      with QTrans have "P \<oplus> Q \<Longrightarrow>\<^sub>\<tau> Q''" by(rule sum2Chain)
      thus ?thesis using Q''Trans Q'''Trans aeq by(blast intro: transitionI)
    qed
  next
    case(FreeR \<alpha> Q')
    have "Q \<Longrightarrow>\<^sub>l \<alpha> \<prec> Q'" by fact

    then obtain Q'' Q''' where QTrans: "Q \<Longrightarrow>\<^sub>\<tau> Q''"
                           and Q''Trans: "Q'' \<longmapsto> \<alpha> \<prec> Q'''"
                           and Q'''Trans: "Q''' \<Longrightarrow>\<^sub>\<tau> Q'"
      by(blast dest: transitionE)
    show ?case
    proof(cases "Q = Q''")
      assume "Q = Q''"
      moreover have "P \<oplus> Q \<Longrightarrow>\<^sub>\<tau> P \<oplus> Q" by simp
      moreover from Q''Trans have "P \<oplus> Q'' \<longmapsto> \<alpha> \<prec> Q'''" by(rule transitions.Sum2)
      ultimately show ?thesis using Q'''Trans by(blast intro: transitionI)
    next
      assume "Q \<noteq> Q''"
      with QTrans have "P \<oplus> Q \<Longrightarrow>\<^sub>\<tau> Q''" by(rule sum2Chain)
      thus ?thesis using Q''Trans Q'''Trans by(rule transitionI)
    qed
  qed
next
  assume "Q \<Longrightarrow>\<^sub>lu in Q''\<rightarrow>a<x> \<prec> Q'"
  then obtain Q''' where QChain: "Q \<Longrightarrow>\<^sub>\<tau> Q'''"
                     and Q'''Trans: "Q''' \<longmapsto>a<x> \<prec> Q''"
                     and Q''Chain: "Q''[x::=u] \<Longrightarrow>\<^sub>\<tau> Q'"
    by(blast dest: transitionE)
  show "P \<oplus> Q \<Longrightarrow>\<^sub>lu in Q''\<rightarrow>a<x> \<prec> Q'"
  proof(cases "Q = Q'''")
    assume "Q = Q'''"
    moreover have "P \<oplus> Q \<Longrightarrow>\<^sub>\<tau> P \<oplus> Q" by simp
    moreover from Q'''Trans have "P \<oplus> Q''' \<longmapsto>a<x> \<prec> Q''" by(rule transitions.Sum2)
    ultimately show ?thesis using Q''Chain by(blast intro: transitionI)
  next
    assume "Q \<noteq> Q'''"
    with QChain have "P \<oplus> Q \<Longrightarrow>\<^sub>\<tau> Q'''" by(rule sum2Chain)
    thus ?thesis using Q'''Trans Q''Chain by(blast intro: transitionI)
  qed
qed

lemma Par1B:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   u  :: name
  and   P'' :: pi

  shows "\<lbrakk>P \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> P'; x \<sharp> Q\<rbrakk> \<Longrightarrow> P \<parallel> Q \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> (P' \<parallel> Q)"
  and   "\<lbrakk>P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P'; x \<sharp> Q\<rbrakk> \<Longrightarrow> P \<parallel> Q \<Longrightarrow>\<^sub>lu in (P'' \<parallel> Q)\<rightarrow>a<x> \<prec> P' \<parallel> Q"
proof -
  assume PTrans: "P \<Longrightarrow>\<^sub>l a<\<nu>x> \<prec> P'"
  assume xFreshQ: "x \<sharp> Q"

  have Goal: "\<And>P a x P' Q. \<lbrakk>P \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> P'; x \<sharp> P; x \<sharp> Q\<rbrakk> \<Longrightarrow> P \<parallel> Q \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> (P' \<parallel> Q)"
  proof -
    fix P a x P' Q
    assume PTrans: "P \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> P'"
    assume xFreshP: "x \<sharp> P"
    assume xFreshQ: "x \<sharp> (Q::pi)"

    from PTrans xFreshP obtain P'' P''' where PTrans: "P \<Longrightarrow>\<^sub>\<tau> P''"
                                          and P''Trans: "P'' \<longmapsto>a<\<nu>x> \<prec> P'''"
                                          and P'''Trans: "P''' \<Longrightarrow>\<^sub>\<tau> P'"
      by(blast dest: transitionE)
    from PTrans have "P \<parallel> Q \<Longrightarrow>\<^sub>\<tau> P'' \<parallel> Q" by(rule Par1Chain)
    moreover from P''Trans xFreshQ have "P'' \<parallel> Q \<longmapsto>a<\<nu>x> \<prec> (P''' \<parallel> Q)" by(rule Par1B)
    moreover from P'''Trans have "P''' \<parallel> Q \<Longrightarrow>\<^sub>\<tau> P' \<parallel> Q" by(rule Par1Chain)
    ultimately show "P \<parallel> Q \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> (P' \<parallel> Q)" by(rule transitionI)
  qed

  have "\<exists>c::name. c \<sharp> (P, P', Q)" by(blast intro: name_exists_fresh)
  then obtain c::name where cFreshP: "c \<sharp> P" and cFreshP': "c \<sharp> P'" and cFreshQ: "c \<sharp> Q"
    by(force simp add: fresh_prod)

  from cFreshP' have "a<\<nu>x> \<prec> P' = a<\<nu>c> \<prec> ([(x, c)] \<bullet> P')" by(rule alphaBoundResidual)
  moreover have "a<\<nu>x> \<prec> (P' \<parallel> Q) = a<\<nu>c> \<prec> (([(x, c)] \<bullet> P') \<parallel> Q)"
  proof -
    from cFreshP' cFreshQ have "c \<sharp> P' \<parallel> Q" by simp
    hence "a<\<nu>x> \<prec> (P' \<parallel> Q) = a<\<nu>c> \<prec> ([(x, c)] \<bullet> (P' \<parallel> Q))" by(rule alphaBoundResidual)
    with cFreshQ xFreshQ show ?thesis by(simp add: name_fresh_fresh)
  qed
  ultimately show "P \<parallel> Q \<Longrightarrow>\<^sub>l a<\<nu>x> \<prec> P' \<parallel> Q" using PTrans cFreshP cFreshQ by(force intro: Goal)
next
  assume PTrans: "P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P'"
     and xFreshQ: "x \<sharp> Q"
  from PTrans obtain P''' where PChain: "P \<Longrightarrow>\<^sub>\<tau> P'''"
                            and P'''Trans: "P''' \<longmapsto>a<x> \<prec> P''"
                            and P''Chain: "P''[x::=u] \<Longrightarrow>\<^sub>\<tau> P'"
    by(blast dest: transitionE)
  from PChain have "P \<parallel> Q \<Longrightarrow>\<^sub>\<tau> P''' \<parallel> Q" by(rule Par1Chain)
  moreover from P'''Trans xFreshQ have "P''' \<parallel> Q \<longmapsto>a<x> \<prec> (P'' \<parallel> Q)" by(rule Par1B)
  moreover have "(P'' \<parallel> Q)[x::=u] \<Longrightarrow>\<^sub>\<tau> P' \<parallel> Q"
  proof -
    from P''Chain have "P''[x::=u] \<parallel> Q \<Longrightarrow>\<^sub>\<tau> P' \<parallel> Q" by(rule Par1Chain)
    with xFreshQ show ?thesis by(simp add: forget)
  qed
  ultimately show "P \<parallel> Q \<Longrightarrow>\<^sub>lu in (P'' \<parallel> Q)\<rightarrow>a<x> \<prec> (P' \<parallel> Q)" by(rule transitionI)
qed

lemma Par1F:
  fixes P  :: pi
  and   \<alpha>  :: freeRes
  and   P' :: pi

  assumes PTrans: "P \<Longrightarrow>\<^sub>l\<alpha> \<prec> P'"

  shows "P \<parallel> Q \<Longrightarrow>\<^sub>l\<alpha> \<prec> (P' \<parallel> Q)"
proof -
  from PTrans obtain P'' P''' where PTrans: "P \<Longrightarrow>\<^sub>\<tau> P''"
                                and P''Trans: "P'' \<longmapsto>\<alpha> \<prec> P'''"
                                and P'''Trans: "P''' \<Longrightarrow>\<^sub>\<tau> P'"
    by(blast dest: transitionE)
  from PTrans have "P \<parallel> Q \<Longrightarrow>\<^sub>\<tau> P'' \<parallel> Q" by(rule Par1Chain)
  moreover from P''Trans have "P'' \<parallel> Q \<longmapsto>\<alpha> \<prec> (P''' \<parallel> Q)" by(rule transitions.Par1F)
  moreover from P'''Trans have "P''' \<parallel> Q \<Longrightarrow>\<^sub>\<tau> P' \<parallel> Q" by(rule Par1Chain)
  ultimately show ?thesis by(rule transitionI)
qed

lemma Par2B:
  fixes Q  :: pi
  and   a  :: name
  and   x  :: name
  and   Q' :: pi
  and   P  :: pi
  and   u  :: name
  and   Q'' :: pi

  shows "Q \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> Q' \<Longrightarrow> x \<sharp> P \<Longrightarrow> P \<parallel> Q \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> (P \<parallel> Q')"
  and   "Q \<Longrightarrow>\<^sub>lu in Q''\<rightarrow>a<x> \<prec> Q' \<Longrightarrow> x \<sharp> P \<Longrightarrow> P \<parallel> Q \<Longrightarrow>\<^sub>lu in (P \<parallel> Q'')\<rightarrow>a<x> \<prec> P \<parallel> Q'"
proof -
  assume QTrans: "Q \<Longrightarrow>\<^sub>l a<\<nu>x> \<prec> Q'"
  assume xFreshP: "x \<sharp> P"

  have Goal: "\<And>Q a x Q' P. \<lbrakk>Q \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> Q'; x \<sharp> Q; x \<sharp> P\<rbrakk> \<Longrightarrow> P \<parallel> Q \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> (P \<parallel> Q')"
  proof -
    fix Q a x Q' P
    assume QTrans: "Q \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> Q'"
    assume xFreshQ: "x \<sharp> Q"
    assume xFreshP: "x \<sharp> (P::pi)"

    from QTrans xFreshQ obtain Q'' Q''' where QTrans: "Q \<Longrightarrow>\<^sub>\<tau> Q''"
                                          and Q''Trans: "Q'' \<longmapsto>a<\<nu>x> \<prec> Q'''"
                                          and Q'''Trans: "Q''' \<Longrightarrow>\<^sub>\<tau> Q'"
      by(blast dest: transitionE)
    from QTrans have "P \<parallel> Q \<Longrightarrow>\<^sub>\<tau> P \<parallel> Q''" by(rule Par2Chain)
    moreover from Q''Trans xFreshP have "P \<parallel> Q'' \<longmapsto>a<\<nu>x> \<prec> (P \<parallel> Q''')" by(rule Par2B)
    moreover from Q'''Trans have "P \<parallel> Q''' \<Longrightarrow>\<^sub>\<tau> P \<parallel> Q'" by(rule Par2Chain)
    ultimately show "P \<parallel> Q \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> (P \<parallel> Q')" by(rule transitionI)
  qed

  have "\<exists>c::name. c \<sharp> (Q, Q', P)" by(blast intro: name_exists_fresh)
  then obtain c::name where cFreshQ: "c \<sharp> Q" and cFreshQ': "c \<sharp> Q'" and cFreshP: "c \<sharp> P"
    by(force simp add: fresh_prod)

  from cFreshQ' have "a<\<nu>x> \<prec> Q' = a<\<nu>c> \<prec> ([(x, c)] \<bullet> Q')" by(rule alphaBoundResidual)
  moreover have "a<\<nu>x> \<prec> (P \<parallel> Q') = a<\<nu>c> \<prec> (P \<parallel> ([(x, c)] \<bullet> Q'))"
  proof -
    from cFreshQ' cFreshP have "c \<sharp> P \<parallel> Q'" by simp
    hence "a<\<nu>x> \<prec> (P \<parallel> Q') = a<\<nu>c> \<prec> ([(x, c)] \<bullet> (P \<parallel> Q'))" by(rule alphaBoundResidual)
    with cFreshP xFreshP show ?thesis by(simp add: name_fresh_fresh)
  qed
  ultimately show "P \<parallel> Q \<Longrightarrow>\<^sub>l a<\<nu>x> \<prec> P \<parallel> Q'" using QTrans cFreshQ cFreshP by(force intro: Goal)
next
  assume QTrans: "Q \<Longrightarrow>\<^sub>lu in Q''\<rightarrow>a<x> \<prec> Q'"
     and xFreshP: "x \<sharp> P"
  from QTrans obtain Q''' where QChain: "Q \<Longrightarrow>\<^sub>\<tau> Q'''"
                            and Q'''Trans: "Q''' \<longmapsto>a<x> \<prec> Q''"
                            and Q''Chain: "Q''[x::=u] \<Longrightarrow>\<^sub>\<tau> Q'"
    by(blast dest: transitionE)
  from QChain have "P \<parallel> Q \<Longrightarrow>\<^sub>\<tau> P \<parallel> Q'''" by(rule Par2Chain)
  moreover from Q'''Trans xFreshP have "P \<parallel> Q''' \<longmapsto>a<x> \<prec> (P \<parallel> Q'')" by(rule Par2B)
  moreover have "(P \<parallel> Q'')[x::=u] \<Longrightarrow>\<^sub>\<tau> P \<parallel> Q'"
  proof -
    from Q''Chain have "P \<parallel> (Q''[x::=u]) \<Longrightarrow>\<^sub>\<tau> P \<parallel> Q'" by(rule Par2Chain)
    with xFreshP show ?thesis by(simp add: forget)
  qed
  ultimately show "P \<parallel> Q \<Longrightarrow>\<^sub>lu in (P \<parallel> Q'')\<rightarrow>a<x> \<prec> (P \<parallel> Q')" by(rule transitionI)
qed

lemma Par2F:
  fixes Q :: pi
  and   \<alpha>  :: freeRes
  and   Q' :: pi

  assumes QTrans: "Q \<Longrightarrow>\<^sub>l\<alpha> \<prec> Q'"

  shows "P \<parallel> Q \<Longrightarrow>\<^sub>l\<alpha> \<prec> (P \<parallel> Q')"
proof -
  from QTrans obtain Q'' Q''' where QTrans: "Q \<Longrightarrow>\<^sub>\<tau> Q''"
                                and Q''Trans: "Q'' \<longmapsto>\<alpha> \<prec> Q'''"
                                and Q'''Trans: "Q''' \<Longrightarrow>\<^sub>\<tau> Q'"
    by(blast dest: transitionE)
  from QTrans have "P \<parallel> Q \<Longrightarrow>\<^sub>\<tau> P \<parallel> Q''" by(rule Par2Chain)
  moreover from Q''Trans have "P \<parallel> Q'' \<longmapsto>\<alpha> \<prec> (P \<parallel> Q''')" by(rule transitions.Par2F)
  moreover from Q'''Trans have "P \<parallel> Q''' \<Longrightarrow>\<^sub>\<tau> P \<parallel> Q'" by(rule Par2Chain)
  ultimately show ?thesis by(rule transitionI)
qed

lemma Comm1:
  fixes P  :: pi
  and   b  :: name
  and   P'' :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   Q  :: pi
  and   Q' :: pi

  assumes PTrans: "P \<Longrightarrow>\<^sub>lb in P'' \<rightarrow>a<x> \<prec> P'"
  and     QTrans: "Q \<Longrightarrow>\<^sub>la[b] \<prec> Q'"

  shows "P \<parallel> Q \<Longrightarrow>\<^sub>l\<tau> \<prec> P' \<parallel> Q'"
proof -
  from PTrans obtain P''' where PChain: "P \<Longrightarrow>\<^sub>\<tau> P'''"
                            and P'''Trans: "P''' \<longmapsto>a<x> \<prec> P''"
                            and P''Chain: "P''[x::=b] \<Longrightarrow>\<^sub>\<tau> P'"
    by(blast dest: transitionE)
  from QTrans obtain Q'' Q''' where QChain: "Q \<Longrightarrow>\<^sub>\<tau> Q'''"
                                and Q'''Trans: "Q''' \<longmapsto>a[b] \<prec> Q''"
                                and Q''Chain: "Q'' \<Longrightarrow>\<^sub>\<tau> Q'"
    by(blast dest: transitionE)

  from PChain QChain have "P \<parallel> Q \<Longrightarrow>\<^sub>\<tau> P''' \<parallel> Q'''" by(rule chainPar)
  moreover from P'''Trans Q'''Trans have "P''' \<parallel> Q''' \<longmapsto>\<tau> \<prec> P''[x::=b] \<parallel> Q''"
    by(rule Comm1)
  moreover from P''Chain Q''Chain have "P''[x::=b] \<parallel> Q'' \<Longrightarrow>\<^sub>\<tau> P' \<parallel> Q'" by(rule chainPar)
  ultimately show ?thesis by(rule transitionI)
qed

lemma Comm2:
  fixes P  :: pi
  and   a  :: name
  and   b  :: name
  and   P' :: pi
  and   Q  :: pi
  and   x  :: name
  and   Q'' :: pi
  and   Q' :: pi

  assumes PTrans: "P \<Longrightarrow>\<^sub>la[b] \<prec> P'"
  and     QTrans: "Q \<Longrightarrow>\<^sub>lb in Q''\<rightarrow>a<x> \<prec> Q'"

  shows "P \<parallel> Q \<Longrightarrow>\<^sub>l\<tau> \<prec> P' \<parallel> Q'"
proof -
  from PTrans obtain P'' P''' where PChain: "P \<Longrightarrow>\<^sub>\<tau> P'''"
                                and P'''Trans: "P''' \<longmapsto>a[b] \<prec> P''"
                                and P''Chain: "P'' \<Longrightarrow>\<^sub>\<tau> P'"
    by(blast dest: transitionE)
  from QTrans obtain Q''' where QChain: "Q \<Longrightarrow>\<^sub>\<tau> Q'''"
                            and Q'''Trans: "Q''' \<longmapsto>a<x> \<prec> Q''"
                            and Q''Chain: "Q''[x::=b] \<Longrightarrow>\<^sub>\<tau> Q'"
    by(blast dest: transitionE)

  from PChain QChain have "P \<parallel> Q \<Longrightarrow>\<^sub>\<tau> P''' \<parallel> Q'''" by(rule chainPar)
  moreover from P'''Trans Q'''Trans have "P''' \<parallel> Q''' \<longmapsto>\<tau> \<prec> P'' \<parallel> (Q''[x::=b])"
    by(rule Comm2)
  moreover from P''Chain Q''Chain have "P'' \<parallel> (Q''[x::=b]) \<Longrightarrow>\<^sub>\<tau> P' \<parallel> Q'" by(rule chainPar)
  ultimately show ?thesis by(rule transitionI)
qed

lemma Close1:
  fixes P  :: pi
  and   y  :: name
  and   P'' :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   Q  :: pi
  and   Q' :: pi

  assumes PTrans: "P \<Longrightarrow>\<^sub>ly in P''\<rightarrow>a<x> \<prec> P'"
  and     QTrans: "Q \<Longrightarrow>\<^sub>la<\<nu>y> \<prec> Q'"
  and     yFreshP: "y \<sharp> P"
  and     yFreshQ: "y \<sharp> Q"

  shows "P \<parallel> Q \<Longrightarrow>\<^sub>l\<tau> \<prec> <\<nu>y>(P' \<parallel> Q')"
proof -
  from PTrans obtain P''' where PChain: "P \<Longrightarrow>\<^sub>\<tau> P'''"
                            and P'''Trans: "P''' \<longmapsto>a<x> \<prec> P''"
                            and P''Chain: "P''[x::=y] \<Longrightarrow>\<^sub>\<tau> P'"
    by(blast dest: transitionE)
  from QTrans yFreshQ obtain Q'' Q''' where QChain: "Q \<Longrightarrow>\<^sub>\<tau> Q'''"
                                        and Q'''Trans: "Q''' \<longmapsto>a<\<nu>y> \<prec> Q''"
                                        and Q''Chain: "Q'' \<Longrightarrow>\<^sub>\<tau> Q'"
    by(blast dest: transitionE)

  from PChain yFreshP have yFreshP''': "y \<sharp> P'''" by(rule freshChain)

  from PChain QChain have "P \<parallel> Q \<Longrightarrow>\<^sub>\<tau> P''' \<parallel> Q'''" by(rule chainPar)
  moreover from P'''Trans Q'''Trans yFreshP''' have "P''' \<parallel> Q''' \<longmapsto>\<tau> \<prec> <\<nu>y>(P''[x::=y] \<parallel> Q'')"
    by(rule Close1)
  moreover have "<\<nu>y>(P''[x::=y] \<parallel> Q'') \<Longrightarrow>\<^sub>\<tau> <\<nu>y>(P' \<parallel> Q')"
  proof -
    from P''Chain Q''Chain have "P''[x::=y] \<parallel> Q'' \<Longrightarrow>\<^sub>\<tau> P' \<parallel> Q'" by(rule chainPar)
    thus ?thesis by(rule ResChain)
  qed
  ultimately show "P \<parallel> Q \<Longrightarrow>\<^sub>l\<tau> \<prec> <\<nu>y>(P' \<parallel> Q')" by(rule transitionI)
qed

lemma Close2:
  fixes P  :: pi
  and   y  :: name
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   Q  :: pi
  and   Q'' :: pi
  and   Q' :: pi

  assumes PTrans: "P \<Longrightarrow>\<^sub>la<\<nu>y> \<prec> P'"
  and     QTrans: "Q \<Longrightarrow>\<^sub>ly in Q''\<rightarrow>a<x> \<prec> Q'"
  and     yFreshP: "y \<sharp> P"
  and     yFreshQ: "y \<sharp> Q"

  shows "P \<parallel> Q \<Longrightarrow>\<^sub>l\<tau> \<prec> <\<nu>y>(P' \<parallel> Q')"
proof -
  from PTrans yFreshP obtain P'' P''' where PChain: "P \<Longrightarrow>\<^sub>\<tau> P'''"
                                        and P'''Trans: "P''' \<longmapsto>a<\<nu>y> \<prec> P''"
                                        and P''Chain: "P'' \<Longrightarrow>\<^sub>\<tau> P'"
    by(blast dest: transitionE)

  from QTrans obtain Q''' where QChain: "Q \<Longrightarrow>\<^sub>\<tau> Q'''"
                            and Q'''Trans: "Q''' \<longmapsto>a<x> \<prec> Q''"
                            and Q''Chain: "Q''[x::=y] \<Longrightarrow>\<^sub>\<tau> Q'"
    by(blast dest: transitionE)

  from QChain yFreshQ have yFreshQ''': "y \<sharp> Q'''" by(rule freshChain)

  from PChain QChain have "P \<parallel> Q \<Longrightarrow>\<^sub>\<tau> P''' \<parallel> Q'''" by(rule chainPar)
  moreover from P'''Trans Q'''Trans yFreshQ''' have "P''' \<parallel> Q''' \<longmapsto>\<tau> \<prec> <\<nu>y>(P'' \<parallel> (Q''[x::=y]))"
    by(rule Close2)
  moreover have "<\<nu>y>(P'' \<parallel> (Q''[x::=y])) \<Longrightarrow>\<^sub>\<tau> <\<nu>y>(P' \<parallel> Q')"
  proof -
    from P''Chain Q''Chain have "P'' \<parallel> (Q''[x::=y]) \<Longrightarrow>\<^sub>\<tau> P' \<parallel> Q'" by(rule chainPar)
    thus ?thesis by(rule ResChain)
  qed
  ultimately show "P \<parallel> Q \<Longrightarrow>\<^sub>l\<tau> \<prec> <\<nu>y>(P' \<parallel> Q')" by(rule transitionI)
qed

lemma ResF:
  fixes P  :: pi
  and   \<alpha>  :: freeRes
  and   P' :: pi
  and   x  :: name

  assumes PTrans: "P \<Longrightarrow>\<^sub>l\<alpha> \<prec> P'"
  and     xFreshAlpha: "x \<sharp> \<alpha>"

  shows "<\<nu>x>P \<Longrightarrow>\<^sub>l\<alpha> \<prec> <\<nu>x>P'"
proof -
  from PTrans obtain P'' P''' where PChain: "P \<Longrightarrow>\<^sub>\<tau> P''"
                                and P''Trans: "P'' \<longmapsto>\<alpha> \<prec> P'''"
                                and P'''Chain: "P''' \<Longrightarrow>\<^sub>\<tau> P'"
    by(blast dest: transitionE)

  from PChain have "<\<nu>x>P \<Longrightarrow>\<^sub>\<tau> <\<nu>x>P''" by(rule ResChain)
  moreover from P''Trans xFreshAlpha have "<\<nu>x>P'' \<longmapsto>\<alpha> \<prec> <\<nu>x>P'''"
    by(rule transitions.ResF)
  moreover from P'''Chain have "<\<nu>x>P''' \<Longrightarrow>\<^sub>\<tau> <\<nu>x>P'" by(rule ResChain)
  ultimately show ?thesis by(rule transitionI)
qed

lemma ResB:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   y  :: name
  and   u  :: name
  and   P'' :: pi

  shows "\<lbrakk>P \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> P'; y \<noteq> a; y \<noteq> x; x \<sharp> P\<rbrakk> \<Longrightarrow> <\<nu>y>P \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> (<\<nu>y>P')"
  and   "\<lbrakk>P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P'; y \<noteq> a; y \<noteq> x; y \<noteq> u\<rbrakk> \<Longrightarrow> <\<nu>y>P \<Longrightarrow>\<^sub>lu in (<\<nu>y>P'')\<rightarrow>a<x> \<prec> (<\<nu>y>P')"
proof -
  assume PTrans: "P \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> P'"
     and yineqa: "y \<noteq> a"
     and yineqx: "y \<noteq> x"
     and xFreshP: "x \<sharp> P"

  from PTrans xFreshP obtain P'' P''' where PChain: "P \<Longrightarrow>\<^sub>\<tau> P''"
                                        and P''Trans: "P'' \<longmapsto>a<\<nu>x> \<prec> P'''"
                                        and P'''Chain: "P''' \<Longrightarrow>\<^sub>\<tau> P'"
    by(blast dest: transitionE)

  from PChain have "<\<nu>y>P \<Longrightarrow>\<^sub>\<tau> <\<nu>y>P''" by(rule ResChain)
  moreover from P''Trans yineqa yineqx have "<\<nu>y>P'' \<longmapsto>a<\<nu>x> \<prec> (<\<nu>y>P''')"
    by(force intro: ResB)
  moreover from P'''Chain have "<\<nu>y>P''' \<Longrightarrow>\<^sub>\<tau> <\<nu>y>P'" by(rule ResChain)
  ultimately show "<\<nu>y>P \<Longrightarrow>\<^sub>l a<\<nu>x> \<prec> <\<nu>y>P'" by(rule transitionI)
next
  assume PTrans: "P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P'"
     and yineqa: "y \<noteq> a"
     and yineqx: "y \<noteq> x"
     and yinequ: "y \<noteq> u"

  from PTrans obtain P''' where PChain: "P \<Longrightarrow>\<^sub>\<tau> P'''"
                            and P'''Trans: "P''' \<longmapsto>a<x> \<prec> P''"
                            and P''Chain: "P''[x::=u] \<Longrightarrow>\<^sub>\<tau> P'"
    by(blast dest: transitionE)

  from PChain have "<\<nu>y>P \<Longrightarrow>\<^sub>\<tau> <\<nu>y>P'''" by(rule ResChain)
  moreover from P'''Trans yineqa yineqx have "<\<nu>y>P''' \<longmapsto>a<x> \<prec> (<\<nu>y>P'')"
    by(force intro: ResB)
  moreover have "(<\<nu>y>P'')[x::=u] \<Longrightarrow>\<^sub>\<tau> <\<nu>y>P'"
  proof -
    from P''Chain have "<\<nu>y>(P''[x::=u]) \<Longrightarrow>\<^sub>\<tau> <\<nu>y>P'" by(rule ResChain)
    with yineqx yinequ show ?thesis by(simp add: eqvt_subs[THEN sym])
  qed
  ultimately show "<\<nu>y>P \<Longrightarrow>\<^sub>lu in (<\<nu>y>P'')\<rightarrow>a<x> \<prec> <\<nu>y>P'" by(rule transitionI)
qed

lemma Bang:
  fixes P  :: pi
  and   Rs :: residual
  and   u  :: name
  and   P'' :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi

  shows "P \<parallel> !P \<Longrightarrow>\<^sub>l Rs \<Longrightarrow> !P \<Longrightarrow>\<^sub>l Rs"
  and   "P \<parallel> !P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P' \<Longrightarrow> !P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P'"
proof -
  assume "P \<parallel> !P \<Longrightarrow>\<^sub>l Rs"
  thus "!P \<Longrightarrow>\<^sub>l Rs"
  proof(nominal_induct avoiding: P rule: residual.strong_inducts)
    case(BoundR a x P' P)
    assume xFreshP: "x \<sharp> P"
    assume PTrans: "P \<parallel> !P \<Longrightarrow>\<^sub>la\<guillemotleft>x\<guillemotright> \<prec> P'"
    from PTrans obtain a' where aeq: "a = BoundOutputS a'" by(cases a, auto)

    with PTrans xFreshP obtain P'' P''' where PChain: "P \<parallel> !P \<Longrightarrow>\<^sub>\<tau> P''"
                                          and P''Trans: "P'' \<longmapsto>a'<\<nu>x> \<prec> P'''"
                                          and P'''Chain: "P''' \<Longrightarrow>\<^sub>\<tau> P'"
      by(force dest: transitionE)

    show "!P \<Longrightarrow>\<^sub>la\<guillemotleft>x\<guillemotright> \<prec> P'"
    proof(cases "P'' = P \<parallel> !P")
      assume "P'' = P \<parallel> !P"
      moreover with P''Trans have "!P \<longmapsto>a'<\<nu>x> \<prec> P'''" by(blast intro: transitions.Bang)
      ultimately show ?thesis using PChain P'''Chain aeq by(simp, rule_tac transitionI, auto)
    next
      assume "P'' \<noteq> P \<parallel> !P"
      with PChain have "!P \<Longrightarrow>\<^sub>\<tau> P''" by(rule bangChain)
      with P''Trans P'''Chain aeq show ?thesis by(blast intro: transitionI)
    qed
  next
    fix \<alpha> P' P
    assume "P \<parallel> !P \<Longrightarrow>\<^sub>l\<alpha> \<prec> P'"

    then obtain P'' P''' where PChain: "P \<parallel> !P \<Longrightarrow>\<^sub>\<tau> P''"
                           and P''Trans: "P'' \<longmapsto>\<alpha> \<prec> P'''"
                           and P'''Chain: "P''' \<Longrightarrow>\<^sub>\<tau> P'"
      by(force dest: transitionE)

    show "!P \<Longrightarrow>\<^sub>l\<alpha> \<prec> P'"
    proof(cases "P'' = P \<parallel> !P")
      assume "P'' = P \<parallel> !P"
      moreover with P''Trans have "!P \<longmapsto>\<alpha> \<prec> P'''" by(blast intro: transitions.Bang)
      ultimately show ?thesis using PChain P'''Chain by(rule_tac transitionI, auto)
    next
      assume "P'' \<noteq> P \<parallel> !P"
      with PChain have "!P \<Longrightarrow>\<^sub>\<tau> P''" by(rule bangChain)
      with P''Trans P'''Chain show ?thesis by(blast intro: transitionI)
    qed
  qed
next
  assume "P \<parallel> !P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P'"

  then obtain P''' where PChain: "P \<parallel> !P \<Longrightarrow>\<^sub>\<tau> P'''"
                     and P'''Trans: "P''' \<longmapsto>a<x> \<prec> P''"
                     and P''Chain: "P''[x::=u] \<Longrightarrow>\<^sub>\<tau> P'"
    by(force dest: transitionE)

  show "!P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P'"
  proof(cases "P''' = P \<parallel> !P")
    assume "P''' = P \<parallel> !P"
    moreover with P'''Trans have "!P \<longmapsto>a<x> \<prec> P''" by(blast intro: transitions.Bang)
    ultimately show ?thesis using PChain P''Chain by(rule_tac transitionI, auto)
  next
    assume "P''' \<noteq> P \<parallel> !P"
    with PChain have "!P \<Longrightarrow>\<^sub>\<tau> P'''" by(rule bangChain)
    with P'''Trans P''Chain show ?thesis by(blast intro: transitionI)
  qed
qed

lemma tauTransitionChain:
  fixes P  :: pi
  and   P' :: pi

  assumes "P \<Longrightarrow>\<^sub>l\<tau> \<prec> P'"

  shows "P \<Longrightarrow>\<^sub>\<tau> P'"
using assms
by(auto simp add: transition_def residualInject)

lemma chainTransitionAppend:
  fixes P   :: pi
  and   P'  :: pi
  and   Rs  :: residual
  and   a   :: name
  and   x   :: name
  and   P'' :: pi
  and   u   :: name
  and   P''' :: pi
  and   \<alpha>   :: freeRes

  shows "P \<Longrightarrow>\<^sub>\<tau> P' \<Longrightarrow> P' \<Longrightarrow>\<^sub>l Rs \<Longrightarrow> P \<Longrightarrow>\<^sub>l Rs"
  and   "P \<Longrightarrow>\<^sub>\<tau> P'' \<Longrightarrow> P'' \<Longrightarrow>\<^sub>lu in P'''\<rightarrow>a<x> \<prec> P' \<Longrightarrow> P \<Longrightarrow>\<^sub>lu in P'''\<rightarrow>a<x> \<prec> P'"
  and   "P \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> P'' \<Longrightarrow> P'' \<Longrightarrow>\<^sub>\<tau> P' \<Longrightarrow> x \<sharp> P \<Longrightarrow> P \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> P'"
  and   "P \<Longrightarrow>\<^sub>lu in P'''\<rightarrow>a<x> \<prec> P'' \<Longrightarrow> P'' \<Longrightarrow>\<^sub>\<tau> P' \<Longrightarrow> P \<Longrightarrow>\<^sub>lu in P'''\<rightarrow>a<x> \<prec> P'"
  and   "P \<Longrightarrow>\<^sub>l\<alpha> \<prec> P'' \<Longrightarrow> P'' \<Longrightarrow>\<^sub>\<tau> P' \<Longrightarrow> P \<Longrightarrow>\<^sub>l\<alpha> \<prec> P'"
proof -
  assume "P \<Longrightarrow>\<^sub>\<tau> P'" and "P' \<Longrightarrow>\<^sub>l Rs"
  thus "P \<Longrightarrow>\<^sub>l Rs"
    by(auto simp add: transition_def residualInject) (blast dest: rtrancl_trans)+
next
  assume "P \<Longrightarrow>\<^sub>\<tau> P''" and "P'' \<Longrightarrow>\<^sub>lu in P'''\<rightarrow>a<x> \<prec> P'"
  thus "P \<Longrightarrow>\<^sub>lu in P'''\<rightarrow>a<x> \<prec> P'"
    apply(auto simp add: inputTransition_def residualInject)
    by(blast dest: rtrancl_trans)+
next
  assume PTrans: "P \<Longrightarrow>\<^sub>l a<\<nu>x> \<prec> P''"
  assume P''Chain: "P'' \<Longrightarrow>\<^sub>\<tau> P'"
  assume xFreshP: "x \<sharp> P"

  from PTrans xFreshP obtain P''' P'''' where PChain: "P \<Longrightarrow>\<^sub>\<tau> P'''"
                                          and P'''Trans: "P''' \<longmapsto>a<\<nu>x> \<prec> P''''"
                                          and P''''Chain: "P'''' \<Longrightarrow>\<^sub>\<tau> P''"
    by(blast dest: transitionE)

  from P''''Chain P''Chain have "P'''' \<Longrightarrow>\<^sub>\<tau> P'" by auto
  with PChain P'''Trans show "P \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> P'" by(rule transitionI)
next
  assume PTrans: "P \<Longrightarrow>\<^sub>lu in P'''\<rightarrow>a<x> \<prec> P''"
  assume P''Chain: "P'' \<Longrightarrow>\<^sub>\<tau> P'"

  from PTrans obtain P'''' where PChain: "P \<Longrightarrow>\<^sub>\<tau> P''''"
                             and P''''Trans: "P'''' \<longmapsto>a<x> \<prec> P'''"
                             and P'''Chain: "P'''[x::=u] \<Longrightarrow>\<^sub>\<tau> P''"
    by(blast dest: transitionE)

  from P'''Chain P''Chain have "P'''[x::=u] \<Longrightarrow>\<^sub>\<tau> P'" by auto
  with PChain P''''Trans show "P \<Longrightarrow>\<^sub>lu in P'''\<rightarrow>a<x> \<prec> P'" by(blast intro: transitionI)
next
  assume PTrans: "P \<Longrightarrow>\<^sub>l\<alpha> \<prec> P''"
  assume P''Chain: "P'' \<Longrightarrow>\<^sub>\<tau> P'"

  from PTrans obtain P''' P'''' where PChain: "P \<Longrightarrow>\<^sub>\<tau> P'''"
                                  and P'''Trans: "P''' \<longmapsto>\<alpha> \<prec> P''''"
                                  and P''''Chain: "P'''' \<Longrightarrow>\<^sub>\<tau> P''"
    by(blast dest: transitionE)

  from P''''Chain P''Chain have "P'''' \<Longrightarrow>\<^sub>\<tau> P'" by auto
  with PChain P'''Trans show "P \<Longrightarrow>\<^sub>l\<alpha> \<prec> P'" by(rule transitionI)
qed

lemma freshInputTransition:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   u  :: name
  and   P'' :: pi
  and   P' :: pi
  and   c  :: name

  assumes PTrans: "P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P'"
  and     cFreshP: "c \<sharp> P"
  and     cinequ: "c \<noteq> u"

  shows "c \<sharp> P'"
proof -

  from PTrans obtain P''' where PChain: "P \<Longrightarrow>\<^sub>\<tau> P'''"
                            and P'''Trans: "P''' \<longmapsto>a<x> \<prec> P''"
                            and P''Chain: "P''[x::=u] \<Longrightarrow>\<^sub>\<tau> P'"
    by(blast dest: transitionE)

  from PChain cFreshP have cFreshP''': "c \<sharp> P'''" by(rule freshChain)
  show "c \<sharp> P'"
  proof(cases "x=c")
    assume xeqc: "x=c"
    from cinequ have "c \<sharp> P''[c::=u]" apply - by(rule fresh_fact2)
    with P''Chain xeqc show ?thesis by(force intro: freshChain)
  next
    assume xineqc: "x\<noteq>c"
    with P'''Trans cFreshP''' have "c \<sharp> P''" by(blast dest: freshBoundDerivative)
    with cinequ have "c \<sharp> P''[x::=u]"
      apply -
      apply(rule fresh_fact1)
      by simp
    with P''Chain show ?thesis by(rule freshChain)
  qed
qed

lemma freshBoundOutputTransition:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   c  :: name

  assumes PTrans: "P \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> P'"
  and     cFreshP: "c \<sharp> P"
  and     cineqx: "c \<noteq> x"

  shows "c \<sharp> P'"
proof -
  have Goal: "\<And>P a x P' c. \<lbrakk>P \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> P'; x \<sharp> P; c \<sharp> P; c \<noteq> x\<rbrakk> \<Longrightarrow> c \<sharp> P'"
  proof -
    fix P a x P' c
    assume PTrans: "P \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> P'"
    assume xFreshP: "x \<sharp> P"
    assume cFreshP: "(c::name) \<sharp> P"
    assume cineqx: "c \<noteq> x"

    from PTrans xFreshP obtain P'' P''' where PTrans: "P \<Longrightarrow>\<^sub>\<tau> P''"
                                          and P''Trans: "P'' \<longmapsto>a<\<nu>x> \<prec> P'''"
                                          and P'''Trans: "P''' \<Longrightarrow>\<^sub>\<tau> P'"
      by(blast dest: transitionE)

    from PTrans cFreshP have "c \<sharp> P''" by(rule freshChain)
    with P''Trans cineqx have "c \<sharp> P'''" by(blast dest: Late_Semantics.freshBoundDerivative)
    with P'''Trans show "c \<sharp> P'" by(rule freshChain)
  qed

  have "\<exists>d::name. d \<sharp> (P, P', c)" by(blast intro: name_exists_fresh)
  then obtain d::name where dFreshP: "d \<sharp> P" and dFreshP': "d \<sharp> P'" and cineqd: "c \<noteq> d"
    by(force simp add: fresh_prod)

  from PTrans dFreshP' have "P \<Longrightarrow>\<^sub>la<\<nu>d> \<prec> ([(x, d)] \<bullet> P')" by(simp add: alphaBoundResidual)
  hence "c \<sharp> [(x, d)] \<bullet> P'" using dFreshP cFreshP cineqd by(rule Goal)
  with cineqd cineqx show ?thesis by(simp add: name_fresh_left name_calc)
qed

lemma freshTauTransition:
  fixes P :: pi
  and   c :: name

  assumes PTrans: "P \<Longrightarrow>\<^sub>l\<tau> \<prec> P'"
  and     cFreshP: "c \<sharp> P"

  shows "c \<sharp> P'"
proof -
  from PTrans have "P \<Longrightarrow>\<^sub>\<tau> P'" by(rule tauTransitionChain)
  thus ?thesis using cFreshP by(rule freshChain)
qed

lemma freshOutputTransition:
  fixes P  :: pi
  and   a  :: name
  and   b  :: name
  and   P' :: pi
  and   c  :: name

  assumes PTrans: "P \<Longrightarrow>\<^sub>la[b] \<prec> P'"
  and     cFreshP: "c \<sharp> P"

  shows "c \<sharp> P'"
proof -
  from PTrans obtain P'' P''' where PTrans: "P \<Longrightarrow>\<^sub>\<tau> P''"
                                and P''Trans: "P'' \<longmapsto>a[b] \<prec> P'''"
                                and P'''Trans: "P''' \<Longrightarrow>\<^sub>\<tau> P'"
      by(blast dest: transitionE)

    from PTrans cFreshP have "c \<sharp> P''" by(rule freshChain)
    with P''Trans have "c \<sharp> P'''" by(blast dest: Late_Semantics.freshFreeDerivative)
    with P'''Trans show ?thesis by(rule freshChain)
qed

lemma eqvtI:
  fixes P    :: pi
  and   Rs   :: residual
  and   perm :: "name prm"
  and   u    :: name
  and   P''  :: pi
  and   a    :: name
  and   x    :: name
  and   P'   :: pi

  shows "P \<Longrightarrow>\<^sub>l Rs \<Longrightarrow> (perm \<bullet> P) \<Longrightarrow>\<^sub>l (perm \<bullet> Rs)"
  and   "P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P' \<Longrightarrow> (perm \<bullet> P) \<Longrightarrow>\<^sub>l(perm \<bullet> u) in (perm \<bullet> P'')\<rightarrow>(perm \<bullet> a)<(perm \<bullet> x)> \<prec> (perm \<bullet> P')"
proof -
  assume "P \<Longrightarrow>\<^sub>l Rs"
  thus "(perm \<bullet> P) \<Longrightarrow>\<^sub>l (perm \<bullet> Rs)"
  proof(nominal_induct Rs avoiding: P rule: residual.strong_inducts)
    case(BoundR a x P' P)
    have PTrans: "P \<Longrightarrow>\<^sub>la\<guillemotleft>x\<guillemotright> \<prec> P'" by fact
    moreover then obtain b where aeqb: "a = BoundOutputS b" by(cases a, auto)
    moreover have "x \<sharp> P" by fact
    ultimately obtain P'' P''' where PTrans: "P \<Longrightarrow>\<^sub>\<tau> P''"
                               and P''Trans: "P'' \<longmapsto>b<\<nu>x> \<prec> P'''"
                              and P'''Trans: "P''' \<Longrightarrow>\<^sub>\<tau> P'"
      by(blast dest: transitionE)

    from PTrans have "(perm \<bullet> P) \<Longrightarrow>\<^sub>\<tau> (perm \<bullet> P'')" by(rule eqvtChainI)
    moreover from P''Trans have "(perm \<bullet> P'') \<longmapsto> (perm \<bullet> (b<\<nu>x> \<prec> P'''))"
      by(rule eqvts)
    moreover from P'''Trans have "(perm \<bullet> P''') \<Longrightarrow>\<^sub>\<tau> (perm \<bullet> P')" by(rule eqvtChainI)
    ultimately show ?case using aeqb by(force intro: transitionI)
  next
    case(FreeR \<alpha> P' P)
    have "P \<Longrightarrow>\<^sub>l\<alpha> \<prec> P'" by fact
    then obtain P'' P''' where PTrans: "P \<Longrightarrow>\<^sub>\<tau> P''"
                           and P''Trans: "P'' \<longmapsto>\<alpha> \<prec> P'''"
                           and P'''Trans: "P''' \<Longrightarrow>\<^sub>\<tau> P'"
      by(blast dest: transitionE)

    from PTrans have "(perm \<bullet> P) \<Longrightarrow>\<^sub>\<tau> (perm \<bullet> P'')" by(rule eqvtChainI)
    moreover from P''Trans have "(perm \<bullet> P'') \<longmapsto> (perm \<bullet> (\<alpha> \<prec> P'''))"
      by(rule eqvts)
    moreover from P'''Trans have "(perm \<bullet> P''') \<Longrightarrow>\<^sub>\<tau> (perm \<bullet> P')" by(rule eqvtChainI)
    ultimately show ?case by(force intro: transitionI)
  qed
next
  assume "P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P'"

  then obtain P''' where PChain: "P \<Longrightarrow>\<^sub>\<tau> P'''"
                     and P'''Trans: "P''' \<longmapsto>a<x> \<prec> P''"
                     and P''Chain: "P''[x::=u] \<Longrightarrow>\<^sub>\<tau> P'"
      by(blast dest: transitionE)

    from PChain have "(perm \<bullet> P) \<Longrightarrow>\<^sub>\<tau> (perm \<bullet> P''')" by(rule eqvtChainI)
    moreover from P'''Trans have "(perm \<bullet> P''') \<longmapsto> (perm \<bullet> (a<x> \<prec> P''))"
      by(rule eqvts)
    moreover from P''Chain have "(perm \<bullet> P''[x::=u]) \<Longrightarrow>\<^sub>\<tau> (perm \<bullet> P')" by(rule eqvtChainI)
    ultimately show "(perm \<bullet> P) \<Longrightarrow>\<^sub>l(perm \<bullet> u) in (perm \<bullet> P'')\<rightarrow>(perm \<bullet> a)<(perm \<bullet> x)> \<prec> (perm \<bullet> P')"
      by(force intro: transitionI simp add: eqvt_subs[THEN sym] perm_bij)
qed

lemmas freshTransition = freshBoundOutputTransition freshOutputTransition
                         freshInputTransition freshTauTransition

end


(*
    File:        dAlpha.thy
    Time-stamp:  <2016-01-12T14:47:32Z>
    Author:      JRF
    Web:         http://jrf.cocolog-nifty.com/software/2016/01/post.html
    Logic Image: Logics_ZF (of Isabelle2020)
*)

theory dAlpha imports dLambda begin

definition dSkeltonEq :: "[i, i] => o" where
"dSkeltonEq(M, N) == M: dTerm & N: dTerm &
   (ALL l. (EX x. <l, TdVar(x)>: dOcc(M))
                    <-> (EX x. <l, TdVar(x)>: dOcc(N))) &
   (ALL l. (EX n. <l, TdBound(n)>: dOcc(M))
                    <-> (EX n. <l, TdBound(n)>: dOcc(N))) &
   (ALL l. <l, TdLam>: dOcc(M) <-> <l, TdLam>: dOcc(N)) &
   (ALL l. <l, TdApp>: dOcc(M) <-> <l, TdApp>: dOcc(N))"

definition dAlpha :: "[i, i]=>o" where
"dAlpha(M, N) == dSkeltonEq(M, N) &
   (ALL l x. <l, TdVar(x)>: dOcc(M) <-> <l, TdVar(x)>: dOcc(N)) &
   (ALL l m. (EX T U. dBoundBy(<l, T>, <m, U>, M))
                     <-> (EX T U. dBoundBy(<l, T>, <m, U>, N)))"

(** dSkeltonEq **)
lemma dSkeltonEqD1:
  "dSkeltonEq(M, N) ==> M: dTerm"
apply (unfold dSkeltonEq_def)
apply (erule conjunct1)
done

lemma dSkeltonEqD2:
  "dSkeltonEq(M, N) ==> N: dTerm"
apply (unfold dSkeltonEq_def)
apply (erule conjunct2 [THEN conjunct1])
done

lemma dSkeltonEq_TdVarD:
  "[| dSkeltonEq(M, N); <l, TdVar(x)>: dOcc(M) |]
      ==> EX x. <l, TdVar(x)>: dOcc(N)"
apply (unfold dSkeltonEq_def)
apply blast
done

lemma dSkeltonEq_TdBoundD:
  "[| dSkeltonEq(M, N); <l, TdBound(n)>: dOcc(M) |]
      ==> EX n. <l, TdBound(n)>: dOcc(N)"
apply (unfold dSkeltonEq_def)
apply blast
done

lemma dSkeltonEq_TdLamD:
  "[| dSkeltonEq(M, N); <l, TdLam>: dOcc(M) |]
      ==> <l, TdLam>: dOcc(N)"
apply (unfold dSkeltonEq_def)
apply blast
done

lemma dSkeltonEq_TdAppD:
  "[| dSkeltonEq(M, N); <l, TdApp>: dOcc(M) |]
      ==> <l, TdApp>: dOcc(N)"
apply (unfold dSkeltonEq_def)
apply blast
done

lemma dSkeltonEq_refl:
  "M: dTerm ==> dSkeltonEq(M, M)"
apply (unfold dSkeltonEq_def)
apply blast
done

lemma dSkeltonEq_sym:
  "dSkeltonEq(M, N) ==> dSkeltonEq(N, M)"
apply (unfold dSkeltonEq_def)
apply blast
done

lemma dSkeltonEq_trans:
  "[| dSkeltonEq(M, N); dSkeltonEq(N, L) |] ==> dSkeltonEq(M, L)"
apply (unfold dSkeltonEq_def)
apply (erule conjE)+
apply ((erule spec [THEN iff_trans], erule spec)
       | (assumption | rule conjI allI))+
done

lemma dSkeltonEq_dVarI:
  "[| x: LVariable; y: LVariable |] ==> dSkeltonEq(dVar(x), dVar(y))"
apply (unfold dSkeltonEq_def)
apply (assumption | rule dTerm.intros conjI)+
apply (blast elim!: dTag.free_elims dOcc_dTermEs
         intro: dOcc_dTermIs)+
done

lemma dSkeltonEq_dBoundI:
  "[| n: nat; m: nat |] ==> dSkeltonEq(dBound(n), dBound(m))"
apply (unfold dSkeltonEq_def)
apply (assumption | rule dTerm.intros conjI)+
apply (blast elim!: dTag.free_elims dOcc_dTermEs
         intro: dOcc_dTermIs)+
done

lemma dSkeltonEq_dLamI:
  "dSkeltonEq(M, N) ==> dSkeltonEq(dLam(M), dLam(N))"
apply (unfold dSkeltonEq_def)
apply (erule conjE)+
apply (assumption | rule dTerm.intros conjI)
apply (safe elim!: dTag.free_elims dOcc_dTermEs)
apply (blast intro: dOcc_dTermIs)+
done

lemma dSkeltonEq_dAppI:
  "[| dSkeltonEq(A, C); dSkeltonEq(B, D)|]
      ==> dSkeltonEq(dApp(A, B), dApp(C, D))"
apply (unfold dSkeltonEq_def)
apply (erule conjE)+
apply (assumption | rule dTerm.intros conjI)
apply (safe elim!: dTag.free_elims dOcc_dTermEs)
apply (blast intro!: dOcc_dTermIs)+
done

lemmas dSkeltonEq_LTermIs = dSkeltonEq_dVarI dSkeltonEq_dBoundI
                          dSkeltonEq_dLamI dSkeltonEq_dAppI

lemma dSkeltonEq_dVarE:
  assumes major: "dSkeltonEq(dVar(x), N)"
  and prem:
     "!! y B. [| N = dVar(y); x: LVariable; y: LVariable |] ==> R"
  shows "R"
apply (insert major)
apply (unfold dSkeltonEq_def)
apply (elim dTerm_typeEs conjE)
apply (subgoal_tac "EX y. <[], TdVar(y)>: dOcc(N)"
                   "EX y: LVariable.  N = dVar(y)")
prefer 3
apply (erule spec [THEN iffD1])
apply (assumption | rule exI dOcc_dTermIs)+
prefer 2
apply (erule exE)
apply (erule_tac a="N" in dTerm.cases)
prefer 4
apply hypsubst
apply (blast elim!: dTag.free_elims list.free_elims dOcc_dTermEs)
prefer 3
apply hypsubst
apply (blast elim!: dTag.free_elims list.free_elims dOcc_dTermEs)
prefer 2
apply (blast elim!: dTag.free_elims list.free_elims dOcc_dTermEs)
apply (assumption | rule bexI)+
apply (erule bexE)
apply (rule prem)
apply assumption+
done

lemma dSkeltonEq_dBoundE:
  assumes major: "dSkeltonEq(dBound(n), N)"
  and prem: "!! m B. [| N = dBound(m); n: nat; m: nat |] ==> R"
  shows "R"
apply (insert major)
apply (unfold dSkeltonEq_def)
apply (elim dTerm_typeEs conjE)
apply (subgoal_tac "EX m. <[], TdBound(m)>: dOcc(N)"
                   "EX m: nat.  N = dBound(m)")
prefer 3
apply (erule spec [THEN iffD1])
apply (assumption | rule exI dOcc_dTermIs)+
prefer 2
apply (erule exE)
apply (erule_tac a="N" in dTerm.cases)
prefer 4
apply hypsubst
apply (blast elim!: dTag.free_elims list.free_elims dOcc_dTermEs)
prefer 3
apply hypsubst
apply (blast elim!: dTag.free_elims list.free_elims dOcc_dTermEs)
prefer 1
apply (blast elim!: dTag.free_elims list.free_elims dOcc_dTermEs)
apply (assumption | rule bexI)+
apply (erule bexE)
apply (rule prem)
apply assumption+
done

lemma dSkeltonEq_dLamE:
  assumes major: "dSkeltonEq(dLam(A), N)"
  and prem: "!! y B. [| N = dLam(B); dSkeltonEq(A, B) |] ==> R"
  shows "R"
apply (insert major)
apply (unfold dSkeltonEq_def)
apply (elim dTerm_typeEs conjE)
apply (subgoal_tac "<[], TdLam>: dOcc(N)"
                   "EX B: dTerm. N = dLam(B)")
prefer 3
apply (erule spec [THEN iffD1])
apply (assumption | rule exI dOcc_dTermIs)+
prefer 2
apply (erule_tac a="N" in dTerm.cases)
prefer 4
apply hypsubst
apply (blast elim!: dTag.free_elims list.free_elims dOcc_dTermEs)
prefer 3
apply hypsubst
apply (blast elim!: dTag.free_elims list.free_elims dOcc_dTermEs)
prefer 2
apply hypsubst
apply (blast elim!: dTag.free_elims list.free_elims dOcc_dTermEs)
apply hypsubst
apply (blast elim!: dTag.free_elims list.free_elims dOcc_dTermEs)
apply (elim bexE)
apply hypsubst
apply (rule prem)
apply assumption
apply (unfold dSkeltonEq_def)
apply (intro conjI)
apply assumption+

apply (intro allI iffI)
apply (erule exE)
apply (drule spec [THEN iffD1], rule exI, erule dOcc_dTermIs)
apply (blast elim!: list.free_elims dTag.free_elims dOcc_dTermEs)
apply (erule exE)
apply (drule spec [THEN iffD2], rule exI, erule dOcc_dTermIs)
apply (blast elim!: list.free_elims dTag.free_elims dOcc_dTermEs)

apply (intro allI iffI)
apply (erule exE)
apply (drule spec [THEN iffD1], rule exI, erule dOcc_dTermIs)
apply (blast elim!: list.free_elims dTag.free_elims dOcc_dTermEs)
apply (erule exE)
apply (drule spec [THEN iffD2], rule exI, erule dOcc_dTermIs)
apply (blast elim!: list.free_elims dTag.free_elims dOcc_dTermEs)

apply (intro allI iffI)
apply (drule spec [THEN iffD1], erule dOcc_dTermIs)
apply (blast elim!: list.free_elims dTag.free_elims dOcc_dTermEs)
apply (drule spec [THEN iffD2], erule dOcc_dTermIs)
apply (blast elim!: list.free_elims dTag.free_elims dOcc_dTermEs)

apply (intro allI iffI)
apply (drule spec [THEN iffD1], erule dOcc_dTermIs)
apply (blast elim!: list.free_elims dTag.free_elims dOcc_dTermEs)
apply (drule spec [THEN iffD2], erule dOcc_dTermIs)
apply (blast elim!: list.free_elims dTag.free_elims dOcc_dTermEs)
done

lemma dSkeltonEq_dAppE:
  assumes major: "dSkeltonEq(dApp(A, B), N)"
  and prem:
   "!! C D. [| N = dApp(C, D); dSkeltonEq(A, C); dSkeltonEq(B, D) |]
            ==> R"
  shows "R"
apply (insert major)
apply (unfold dSkeltonEq_def)
apply (elim dTerm_typeEs conjE)
apply (subgoal_tac "<[], TdApp>: dOcc(N)"
                   "EX C: dTerm.  EX D: dTerm. N = dApp(C, D)")
prefer 3
apply (erule spec [THEN iffD1])
apply (assumption | rule dOcc_dTermIs)+
prefer 2
apply (erule_tac a="N" in dTerm.cases)
apply hypsubst
apply (blast elim!: dTag.free_elims dOcc_dTermEs)
apply (blast elim!: dTag.free_elims dOcc_dTermEs)
apply (blast elim!: dTag.free_elims list.free_elims dOcc_dTermEs)
apply (blast elim!: dTag.free_elims list.free_elims dOcc_dTermEs)

apply (elim bexE)
apply (rule prem)
apply assumption
apply (unfold dSkeltonEq_def)

apply hypsubst
apply (intro conjI)
apply assumption+

apply (intro allI iffI)
apply (erule exE)
apply (drule spec [THEN iffD1], rule exI, erule dOcc_dTermIs)
apply (blast elim!: list.free_elims dTag.free_elims dOcc_dTermEs)
apply (erule exE)
apply (drule spec [THEN iffD2], rule exI, erule dOcc_dTermIs)
apply (blast elim!: list.free_elims dTag.free_elims dOcc_dTermEs)

apply (intro allI iffI)
apply (erule exE)
apply (drule spec [THEN iffD1], rule exI, erule dOcc_dTermIs)
apply (blast elim!: list.free_elims dTag.free_elims dOcc_dTermEs)
apply (erule exE)
apply (drule spec [THEN iffD2], rule exI, erule dOcc_dTermIs)
apply (blast elim!: list.free_elims dTag.free_elims dOcc_dTermEs)

apply (intro allI iffI)
apply (drule spec [THEN iffD1], erule dOcc_dTermIs)
apply (blast elim!: list.free_elims dTag.free_elims dOcc_dTermEs)
apply (drule spec [THEN iffD2], erule dOcc_dTermIs)
apply (blast elim!: list.free_elims dTag.free_elims dOcc_dTermEs)

apply (intro allI iffI)
apply (drule spec [THEN iffD1], erule dOcc_dTermIs)
apply (blast elim!: list.free_elims dTag.free_elims dOcc_dTermEs)
apply (drule spec [THEN iffD2], erule dOcc_dTermIs)
apply (blast elim!: list.free_elims dTag.free_elims dOcc_dTermEs)

apply hypsubst
apply (intro conjI)
apply assumption+

apply (intro allI iffI)
apply (erule exE)
apply (drule spec [THEN iffD1], rule exI, erule dOcc_dTermIs)
apply (blast elim!: list.free_elims dTag.free_elims dOcc_dTermEs)
apply (erule exE)
apply (drule spec [THEN iffD2], rule exI, erule dOcc_dTermIs)
apply (blast elim!: list.free_elims dTag.free_elims dOcc_dTermEs)

apply (intro allI iffI)
apply (erule exE)
apply (drule spec [THEN iffD1], rule exI, erule dOcc_dTermIs)
apply (blast elim!: list.free_elims dTag.free_elims dOcc_dTermEs)
apply (erule exE)
apply (drule spec [THEN iffD2], rule exI, erule dOcc_dTermIs)
apply (blast elim!: list.free_elims dTag.free_elims dOcc_dTermEs)

apply (intro allI iffI)
apply (drule spec [THEN iffD1], erule dOcc_dTermIs)
apply (blast elim!: list.free_elims dTag.free_elims dOcc_dTermEs)
apply (drule spec [THEN iffD2], erule dOcc_dTermIs)
apply (blast elim!: list.free_elims dTag.free_elims dOcc_dTermEs)

apply (intro allI iffI)
apply (drule spec [THEN iffD1], erule dOcc_dTermIs)
apply (blast elim!: list.free_elims dTag.free_elims dOcc_dTermEs)
apply (drule spec [THEN iffD2], erule dOcc_dTermIs)
apply (blast elim!: list.free_elims dTag.free_elims dOcc_dTermEs)

done

lemmas dSkeltonEq_dTermEs = dSkeltonEq_dVarE dSkeltonEq_dBoundE
                            dSkeltonEq_dLamE dSkeltonEq_dAppE

lemma dSkeltonEq_skelton:
  assumes major: "dSkeltonEq(M, N)"
  and prem: "<l, T>: dOcc(M)"
  shows "EX U. <l, U>: dOcc(N)"
apply (insert dOcc_typeD2 [OF prem major [THEN dSkeltonEqD1]] prem)
apply (erule dTag.cases)
apply hypsubst
apply (drule major [THEN dSkeltonEq_TdVarD])
apply (erule exE)
apply (erule exI)
apply hypsubst
apply (drule major [THEN dSkeltonEq_TdBoundD])
apply (erule exE)
apply (erule exI)
apply hypsubst
apply (drule major [THEN dSkeltonEq_TdLamD])
apply (erule exI)
apply hypsubst
apply (drule major [THEN dSkeltonEq_TdAppD])
apply (erule exI)
done

lemmas dTerm_Occ_ind_cond_Occ_not_empty_lemma
  = Occ_ind_cond_Occ_not_empty_lemma [OF dTerm_Occ_ind_cond]

lemma dSkeltonEq_dLamDeg_lemma:
  assumes major: "dSkeltonEq(M, N)"
  and prem1: "<l, T>: dOcc(M)"
  and prem2: "<l @ x, U>: dOcc(M)"
  shows "dLamDeg(x, dsubterm(M, l)) = dLamDeg(x, dsubterm(N, l))"
apply (rule prem2 [THEN rev_mp])
apply (rule prem1 [THEN rev_mp])
apply (rule major [THEN rev_mp])
apply (rule_tac x="N" in spec)
apply (rule_tac x="T" in spec)
apply (rule_tac x="l" and A="list(nat)" in bspec)
apply (rule_tac x="x" and A="list(nat)" in bspec)
prefer 3
prefer 3
apply (rule dOcc_typeD1 [OF prem2 major [THEN dSkeltonEqD1],
        THEN app_typeD])
apply (rule dOcc_typeD1 [OF prem1 major [THEN dSkeltonEqD1]])+
apply (rule major [THEN dSkeltonEqD1, THEN dTerm.induct])
apply (safe elim!: dSkeltonEq_dTermEs ConsE dOcc_dTermEs
         dTag.free_elims)
apply (simp_all add: dTerm.intros dSkeltonEqD1 dSkeltonEqD2)
apply (safe elim!: list.free_elims ConsE)

apply (frule dSkeltonEqD1 [THEN dTerm_Occ_ind_cond_Occ_not_empty_lemma])
apply (erule bexE)
apply (drule_tac x6="l" and x5="[]" and x3="B" in bspec [THEN bspec, THEN spec, THEN spec,
       THEN mp, THEN mp, THEN mp])
apply (assumption | rule list.intros)+
apply simp
apply (simp add: dSkeltonEqD1 dSkeltonEqD2)

apply (frule dSkeltonEqD1 [THEN dTerm_Occ_ind_cond_Occ_not_empty_lemma])
apply (erule bexE)
apply (drule_tac x6="l" and x5="[]" and x3="C" in bspec [THEN bspec, THEN spec, THEN spec,
       THEN mp, THEN mp, THEN mp], erule_tac [4] asm_rl)
apply (assumption | rule list.intros)+
apply simp
apply (simp add: dSkeltonEqD1 dSkeltonEqD2)

apply (frule_tac M="N" in dSkeltonEqD1 [THEN dTerm_Occ_ind_cond_Occ_not_empty_lemma])
apply (erule bexE)
apply (drule_tac x6="l" and x5="[]" and x3="D" in bspec [THEN bspec, THEN spec, THEN spec,
       THEN mp, THEN mp, THEN mp], erule_tac [4] asm_rl)
apply (assumption | rule list.intros)+
apply simp
apply (simp add: dSkeltonEqD1 dSkeltonEqD2)
done

(** dAlpha **)
lemma dAlphaD1:
  "dAlpha(M, N) ==> dSkeltonEq(M, N)"
apply (unfold dAlpha_def)
apply (erule conjunct1)
done

lemma dAlphaD2:
  "[| dAlpha(M, N); <l, TdVar(x)>: dOcc(M) |] ==> <l, TdVar(x)>: dOcc(N)"
apply (unfold dAlpha_def)
apply blast
done

lemma dAlphaD3:
  "[| dAlpha(M, N); dBoundBy(<l, T>, <m, U>, M) |]
      ==> EX n. dBoundBy(<l, TdBound(n)>, <m, TdLam>, N)"
apply (unfold dAlpha_def)
apply (drule conjunct2 [THEN conjunct2])
apply (drule spec [THEN spec, THEN iffD1])
apply (erule exI [THEN exI])
apply (elim exE)
apply (rule_tac M="N" in dBoundByE)
apply assumption
apply safe
apply (erule exI)
done

lemma dAlpha_dBoundByD:
  assumes major: "dAlpha(M, N)"
  and prem: "dBoundBy(<l, T>, <m, U>, M)"
  shows "dBoundBy(<l, T>, <m, U>, N)"
apply (rule prem [THEN dBoundByE])
apply (insert dAlphaD3 [OF major prem])
apply (safe elim!: dBoundByE dest!: app_right_inj
            elim!: dTag.free_elims)
apply (erule dOcc_typeD1)
apply assumption
apply (frule major [THEN dAlphaD1, THEN dSkeltonEq_dLamDeg_lemma], assumption)
apply (simp only: succ_inject_iff)
apply (assumption | rule refl dBoundByI)+
done

lemma dAlphaI:
  assumes prem1: "dSkeltonEq(M, N)"
  and prem2: "!! l x. <l, TdVar(x)>: dOcc(M) <-> <l, TdVar(x)>: dOcc(N)"
  and prem3: "!! l m. (EX x. dBoundBy(<l, TdBound(x)>, <m, TdLam>, M))
               <-> (EX x. dBoundBy(<l, TdBound(x)>, <m, TdLam>, N))"
  shows "dAlpha(M, N)"
apply (unfold dAlpha_def)
apply (rule prem1 [THEN conjI])
apply (rule allI [THEN allI, THEN conjI])
apply (rule prem2)
apply safe
apply (rule_tac [2] dBoundByE, erule_tac [2] asm_rl)
apply (rule_tac [1] dBoundByE, erule_tac [1] asm_rl)
apply safe
apply (drule exI [THEN prem3 [THEN iffD1]])
apply (drule_tac [2] exI [THEN prem3 [THEN iffD2]])
apply blast+
done

lemma dAlpha_dPropI:
  assumes prem1: "M: dProp"
  and prem2: "N: dProp"
  and prem3:
     "!! l. <l, TdLam>: dOcc(M) <-> <l, TdLam>: dOcc(N)"
  and prem4:
     "!! l. <l, TdApp>: dOcc(M) <-> <l, TdApp>: dOcc(N)"
  and prem5:
     "!! l x. <l, TdVar(x)>: dOcc(M) <-> <l, TdVar(x)>: dOcc(N)"
  and prem6:
     "!! l m. (EX x. dBoundBy(<l, TdBound(x)>, <m, TdLam>, M))
              <-> (EX x. dBoundBy(<l, TdBound(x)>, <m, TdLam>, N))"
  shows "dAlpha(M, N)"
apply (rule dAlphaI)
apply (erule_tac [2] asm_rl | rule_tac [2] prem5 prem6)+
apply (unfold dSkeltonEq_def)
apply (assumption | rule conjI prem1 prem2 dPropD1)+
apply (rule_tac [2] conjI)
apply (rule_tac [3] conjI)
apply (rule_tac [4] allI)
apply (rule_tac [3] allI)
apply (rule_tac [2] allI)
apply (rule_tac [1] allI)
apply (erule_tac [3] asm_rl | rule_tac [3] prem3 prem4)+
apply safe
apply (drule prem5 [THEN iffD1], erule exI)
apply (drule prem5 [THEN iffD2], erule exI)
apply (drule prem1 [THEN dProp_dBoundBy_lemma1])
apply (drule_tac [2] prem2 [THEN dProp_dBoundBy_lemma1])
apply safe
apply (drule exI [THEN prem6 [THEN iffD1]])
apply (drule_tac [2] exI [THEN prem6 [THEN iffD2]])
apply (blast elim!: dBoundByE)+
done

lemma dAlpha_refl:
  "M: dTerm ==> dAlpha(M, M)"
apply (unfold dAlpha_def)
apply (blast intro: dSkeltonEq_refl)
done

lemma dAlpha_sym:
  "dAlpha(M, N) ==> dAlpha(N, M)"
apply (unfold dAlpha_def)
apply (blast intro: dSkeltonEq_sym)
done

lemma dAlpha_trans:
  "[| dAlpha(M, N); dAlpha(N, L) |] ==> dAlpha(M, L)"
apply (unfold dAlpha_def)
apply (blast intro: dSkeltonEq_trans)
done

lemmas dTerm_Occ_ind_cond_Occ_inj = Occ_ind_cond_Occ_inj [OF
  dTerm_Occ_ind_cond]

lemma dAlpha_imp_dProp_eq:
  assumes major: "dAlpha(M, N)"
  and prem1: "M: dProp"
  and prem2: "N: dProp"
  shows "M = N"
apply (insert prem1 [THEN dPropD1] prem2 [THEN dPropD1])
apply (rule dTerm_Occ_ind_cond_Occ_inj [THEN iffD1])
apply (assumption | rule equalityI)+
apply (rule_tac [2] subsetI)
apply (rule_tac [1] subsetI)
apply (rule_tac [2] dOcc_domain [THEN subsetD, THEN SigmaE],
       erule_tac [3] asm_rl)
apply (rule_tac [1] dOcc_domain [THEN subsetD, THEN SigmaE],
       erule_tac [2] asm_rl)
prefer 3
apply assumption+
apply (erule_tac [2] dTag.cases)
apply (erule_tac [1] dTag.cases)
prefer 6
apply hypsubst
apply (drule prem2 [THEN dProp_dBoundBy_lemma1])
apply (erule exE)
apply (drule major [THEN dAlpha_sym, THEN dAlpha_dBoundByD])
defer 1
defer 6
defer 6
prefer 2
apply hypsubst
apply (drule prem1 [THEN dProp_dBoundBy_lemma1])
apply (erule exE)
apply (drule major [THEN dAlpha_dBoundByD])
prefer 2
apply (safe elim!: dBoundByE dTag.free_elims)

apply (erule major [THEN dAlphaD2])
apply (erule major [THEN dAlphaD1, THEN dSkeltonEq_TdLamD])
apply (erule major [THEN dAlphaD1, THEN dSkeltonEq_TdAppD])
apply (erule major [THEN dAlpha_sym, THEN dAlphaD2])
apply (erule major [THEN dAlpha_sym, THEN dAlphaD1, THEN dSkeltonEq_TdLamD])
apply (erule major [THEN dAlpha_sym, THEN dAlphaD1, THEN dSkeltonEq_TdAppD])
done

lemma dAlpha_dProp_iff:
  assumes prem1: "M: dProp"
  and prem2: "N: dProp"
  shows "dAlpha(M, N) <-> M = N"
apply (rule iffI)
prefer 2
apply hypsubst
apply (rule prem2 [THEN dPropD1, THEN dAlpha_refl])
apply (erule dAlpha_imp_dProp_eq)
apply (rule prem1 prem2)+
done

(** Rules for depth induction **)
lemmas dTerm_Occ_Term_cons = Occ_Term_cons [OF
  dTerm_Occ_ind_cond dTerm_Term_cons_inj_cond]

lemma depth_ind_dLam:
  "[| dOcc(dLam(M)) <= Occ_fbs_op(dTag, Z); M: dTerm |]
     ==> dOcc(M) <= domain(Z) * dTag"
apply (rule_tac P="%x. x <= domain(Z) * dTag" in ssubst)
apply (erule_tac [2] b="0" in Occ_subtree_Occ_fbs_op_lemma)
apply (simp add: dTerm_Occ_Term_cons Occ_subtree_Occ_cons
        dTerm_cons_eqns_sym)
done

lemma depth_ind_dApp1:
  "[| dOcc(dApp(M, N)) <= Occ_fbs_op(dTag, Z); M: dTerm; N: dTerm |]
     ==> dOcc(M) <= domain(Z) * dTag"
apply (rule_tac P="%x. x <= domain(Z) * dTag" in ssubst)
apply (erule_tac [2] b="0" in Occ_subtree_Occ_fbs_op_lemma)
apply (simp add: dTerm_Occ_Term_cons Occ_subtree_Occ_cons
        dTerm_cons_eqns_sym)
done

lemma depth_ind_dApp2:
  "[| dOcc(dApp(M, N)) <= Occ_fbs_op(dTag, Z); M: dTerm; N: dTerm |]
     ==> dOcc(N) <= domain(Z) * dTag"
apply (rule_tac P="%x. x <= domain(Z) * dTag" in ssubst)
apply (erule_tac [2] b="1" in Occ_subtree_Occ_fbs_op_lemma)
apply (simp add: dTerm_Occ_Term_cons Occ_subtree_Occ_cons
        dTerm_cons_eqns_sym)
done

lemma depth_ind_dSubst_dVar_lemma:
  assumes major: "<l, T>: dOcc(dSubst(M, n, dVar(x)))"
  and prem1: "M: dTerm"
  and prem2: "x: LVariable"
  and prem3: "n: nat"
  shows "EX T. <l, T>: dOcc(M)"
apply (insert prem2)
apply (rule major [THEN rev_mp])
apply (rule prem3 [THEN [2] bspec])
apply (rule_tac x="l" in spec)
apply (rule prem1 [THEN dTerm.induct])
apply (rule_tac [2] ballI [THEN allI])
apply (case_tac [2] "xaa = n")
apply (case_tac [3] "xaa < n")
apply (simp_all del: all_simps ball_simps)
apply (safe elim!: dOcc_dTermEs)
apply (blast intro!: dOcc_dTermIs)+
done

lemma depth_ind_dSubst_dVar:
  assumes major: "dOcc(M) <= domain(Z) * dTag"
  and prem1: "M: dTerm"
  and prem2: "x: LVariable"
  and prem3: "n: nat"
  shows "dOcc(dSubst(M, n, dVar(x))) <= domain(Z) * dTag"
apply (rule subsetI)
apply (rule dOcc_domain [THEN subsetD, THEN SigmaE])
prefer 2 apply assumption
apply (assumption | rule dSubst_type prem1 prem2 prem3 dTerm.intros)+
apply hypsubst
apply (frule depth_ind_dSubst_dVar_lemma)
apply (erule_tac [4] exE)
apply (rule_tac [4] SigmaI)
apply (erule_tac [4] major [THEN subsetD, THEN SigmaD1])
apply (assumption | rule prem2 prem3 prem1)+
done

end


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

theory CSP_F_law_step
imports CSP_F_domain CSP_T.CSP_T_law_step
begin

(*****************************************************************

         1. step laws
         2.
         3.
         4.

 *****************************************************************)

(*********************************************************
                    stop expansion
 *********************************************************)

(*------------------*
 |      csp law     |
 *------------------*)

lemma cspF_STOP_step: "STOP =F[M1,M2] ? :{} -> Pf"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_STOP_step)
apply (simp add: failures_iff)
done

(* to avoide producing free variables in tactics *)

lemma cspF_STOP_step_DIV: "STOP =F[M1,M2] ? x:{} -> DIV"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_STOP_step)
apply (simp add: failures_iff)
done

(*********************************************************
                    Act_prefix expansion
 *********************************************************)

(*------------------*
 |      csp law     |
 *------------------*)

lemma cspF_Act_prefix_step: "a -> P =F[M,M] ? x:{a} -> P"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Act_prefix_step)
apply (simp add: failures_iff)
done

(*********************************************************
                    Ext choice expansion
 *********************************************************)

(*------------------*
 |      csp law     |
 *------------------*)

lemma cspF_Ext_choice_step:
  "(? :X -> Pf) [+] (? :Y -> Qf) =F[M,M]
      ? x:(X Un Y) ->
                (IF (x : X & x : Y) THEN (Pf x |~| Qf x)
                 ELSE IF (x : X) THEN Pf x
                 ELSE Qf x)"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Ext_choice_step)
apply (rule order_antisym)

(* => *)
 apply (rule)
 apply (simp add: in_failures)
 apply (elim disjE conjE exE)
 apply (simp_all)
 apply (force)
 apply (rule_tac x="a" in exI)
 apply (rule_tac x="sa" in exI)
 apply (simp)
 apply (rule_tac x="a" in exI)
 apply (rule_tac x="sa" in exI)
 apply (simp)
 apply (simp add: in_traces)
 apply (simp add: in_traces)

(* <= *)
 apply (rule)
 apply (simp add: in_failures)
 apply (elim disjE conjE exE)
 apply (simp_all)
 apply (force)

 apply (case_tac "a : Y")
 apply (simp_all add: in_failures)

 apply (case_tac "a : X")
 apply (simp_all add: in_failures)
done

(*********************************************************
                    Parallel expansion
 *********************************************************)

(* set 1 *)

lemma cspF_Parallel_step_set1:
  "[| Ya - insert Tick (Ev ` X) = Za - insert Tick (Ev ` X) ;
       Ev ` Y Int Ya = {}; Ev ` Z Int Za = {} |]
   ==> Ev ` (X Int Y Int Z) Int (Ya Un Za) = {}"
by (auto)

(* set 2 *)

lemma cspF_Parallel_step_set2:
  "[| Ya - insert Tick (Ev ` X) = Za - insert Tick (Ev ` X) ;
       Ev ` Y Int Ya = {}; Ev ` Z Int Za = {} |]
   ==> Ev ` (Y - X) Int (Ya Un Za) = {}"
apply (rule equalityI)
 apply (rule subsetI)
 apply (simp add: inj_image_diff_dist)
 apply (simp add: in_Ev_set)
 apply (elim conjE exE)

 apply (erule disjE)
  apply (fast)
    (* *)
  apply (simp)
   apply (case_tac "Ev a : Ya")
   apply (fast)
   apply (rotate_tac 1)
   apply (erule equalityE)
   apply (rotate_tac -1)
   apply (erule subsetE)
   apply (drule_tac x="Ev a" in bspec, fast)
   apply (simp)
  apply (fast)
done

(* set 3 *)

lemma cspF_Parallel_step_set3:
  "[| Ya - insert Tick (Ev ` X) = Za - insert Tick (Ev ` X) ;
       Ev ` Y Int Ya = {}; Ev ` Z Int Za = {} |]
   ==> Ev ` (Z - X) Int (Ya Un Za) = {}"
apply (rule equalityI)
 apply (rule subsetI)
 apply (simp add: inj_image_diff_dist)
 apply (simp add: in_Ev_set)
 apply (elim conjE exE)
 apply (erule disjE)
  apply (simp)
   apply (case_tac "Ev a : Za")
   apply (fast)
   apply (rotate_tac 1)
   apply (erule equalityE)
   apply (erule subsetE)
   apply (drule_tac x="Ev a" in bspec, fast)
   apply (simp)
  apply (fast)
    (* *)
  apply (simp)
done

(* set 4 *)

lemma cspF_Parallel_step_set4:
  "Ev ` (X Int Y Int Z Un (Y - X) Un (Z - X)) Int Xa = {}
   ==> Xa =
       Xa - insert Tick (Ev ` X) Un (Xa Int insert Tick (Ev ` X) - Ev ` Y) Un
      (Xa - insert Tick (Ev ` X) Un (Xa Int insert Tick (Ev ` X) - Ev ` Z))"
by (auto)

(* set 5 *)

lemma cspF_Parallel_step_set5:
  "Ev ` (X Int Y Int Z Un (Y - X) Un (Z - X)) Int Xa = {}
   ==> Ev ` Y Int
      (Xa - insert Tick (Ev ` X) Un (Xa Int insert Tick (Ev ` X) - Ev ` Y)) = {} &
       Ev ` Z Int
      (Xa - insert Tick (Ev ` X) Un (Xa Int insert Tick (Ev ` X) - Ev ` Z)) = {}"
by (auto)

(*------------------*
 |      csp law     |
 *------------------*)

lemma cspF_Parallel_step:
  "(? :Y -> Pf) |[X]| (? :Z -> Qf) =F[M,M]
      ? x:((X Int Y Int Z) Un (Y - X) Un (Z - X))
         -> IF (x : X) THEN (Pf x |[X]| Qf x)
               ELSE IF (x : Y & x : Z) THEN ((Pf x |[X]| ? x:Z -> Qf x)
                                     |~| (? x:Y -> Pf x |[X]| Qf x))
               ELSE IF (x : Y) THEN (Pf x |[X]| ? x:Z -> Qf x)
               ELSE (? x:Y -> Pf x |[X]| Qf x)"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Parallel_step)
apply (rule order_antisym)

(* => *)
apply (rule)
apply (simp add: in_failures)
apply (elim disjE conjE exE)

 (* (nil,nil) *)
 apply (simp add: image_Un Int_Un_distrib2)
 apply (simp add: cspF_Parallel_step_set1
                  cspF_Parallel_step_set2
                  cspF_Parallel_step_set3)

 (* (nil,Ev) *)
 apply (simp)
 apply (insert trace_nil_or_Tick_or_Ev)
 apply (drule_tac x="s" in spec)

 apply (erule disjE, simp)
 apply (erule disjE, simp)
 apply (elim conjE exE, simp)
 apply (simp add: par_tr_head)

 apply (rule_tac x="aa" in exI)
 apply (rule_tac x="sc" in exI)
 apply (simp)

 apply (case_tac "aa : Y")
  apply (simp)
  apply (rule disjI2)
  apply (rule_tac x="Ya" in exI)
  apply (rule_tac x="Za" in exI)
  apply (simp)
  apply (rule_tac x="<>" in exI)
  apply (rule_tac x="sb" in exI)
  apply (simp)
  (* "aa ~: Y" *)
  apply (simp)
  apply (rule_tac x="Ya" in exI)
  apply (rule_tac x="Za" in exI)
  apply (simp)
  apply (rule_tac x="<>" in exI)
  apply (rule_tac x="sb" in exI)
  apply (simp)

 (* (Ev,nil) *)
 apply (simp)
 apply (drule_tac x="s" in spec)

 apply (erule disjE, simp)
 apply (erule disjE, simp)
 apply (elim conjE exE, simp)
 apply (simp add: par_tr_head)

 apply (rule_tac x="a" in exI)
 apply (rule_tac x="sc" in exI)
 apply (simp)

 apply (case_tac "a : Z")
  apply (simp)
  apply (rule disjI1)
  apply (rule_tac x="Ya" in exI)
  apply (rule_tac x="Za" in exI)
  apply (simp)
  apply (rule_tac x="sb" in exI)
  apply (rule_tac x="<>" in exI)
  apply (simp)
  (* "a ~: Z" *)
  apply (simp)
  apply (rule_tac x="Ya" in exI)
  apply (rule_tac x="Za" in exI)
  apply (simp)
  apply (rule_tac x="sb" in exI)
  apply (rule_tac x="<>" in exI)
  apply (simp)

 (* (Ev,Ev) *)
 apply (drule_tac x="s" in spec)
 apply (erule disjE, simp)
 apply (erule disjE, simp)
 apply (elim conjE exE, simp)
 apply (simp add: par_tr_head)
 apply (elim disjE conjE exE, simp)

  (* sync *)
  apply (rule_tac x="aa" in exI)
  apply (rule_tac x="sd" in exI)
  apply (simp)
  apply (rule_tac x="Ya" in exI)
  apply (rule_tac x="Za" in exI)
  apply (simp)
  apply (rule_tac x="sb" in exI)
  apply (rule_tac x="sc" in exI)
  apply (simp)

  (* left *)
  apply (simp)
  apply (rule_tac x="a" in exI)
  apply (rule_tac x="sd" in exI)
  apply (simp)

  apply (case_tac "a : Z")
   apply (simp)
   apply (rule disjI1)
   apply (rule_tac x="Ya" in exI)
   apply (rule_tac x="Za" in exI)
   apply (simp)
   apply (rule_tac x="sb" in exI)
   apply (rule_tac x="<Ev aa> ^^^ sc" in exI)
   apply (simp)
   (* "a ~: Z" *)
   apply (simp)
   apply (rule_tac x="Ya" in exI)
   apply (rule_tac x="Za" in exI)
   apply (simp)
   apply (rule_tac x="sb" in exI)
   apply (rule_tac x="<Ev aa> ^^^ sc" in exI)
   apply (simp)

  (* right *)
  apply (simp)
  apply (rule_tac x="aa" in exI)
  apply (rule_tac x="sd" in exI)
  apply (simp)

  apply (case_tac "aa : Y")
   apply (simp)
   apply (rule disjI2)
   apply (rule_tac x="Ya" in exI)
   apply (rule_tac x="Za" in exI)
   apply (simp)
   apply (rule_tac x="<Ev a> ^^^ sb" in exI)
   apply (rule_tac x="sc" in exI)
   apply (simp)
   (* "aa ~: Y" *)
   apply (simp)
   apply (rule_tac x="Ya" in exI)
   apply (rule_tac x="Za" in exI)
   apply (simp)
   apply (rule_tac x="<Ev a> ^^^ sb" in exI)
   apply (rule_tac x="sc" in exI)
   apply (simp)

(* <= *)

apply (rule)
apply (simp add: in_failures)
apply (elim disjE conjE exE)

 (* nil *)
 apply (simp)
 apply (rule_tac x="(Xa - insert Tick (Ev ` X)) Un
                   ((Xa Int insert Tick (Ev ` X)) - Ev ` Y)" in exI)
 apply (rule_tac x="(Xa - insert Tick (Ev ` X)) Un
                   ((Xa Int insert Tick (Ev ` X)) - Ev ` Z)" in exI)
 apply (simp add: cspF_Parallel_step_set4)
 apply (rule conjI, force)
 apply (simp add: cspF_Parallel_step_set5)

 (* sync *)
 apply (simp add: in_failures)
 apply (elim conjE exE, simp)
 apply (rule_tac x="Ya" in exI)
 apply (rule_tac x="Za" in exI)
 apply (simp)
 apply (rule_tac x="<Ev a> ^^^ sb" in exI)
 apply (rule_tac x="<Ev a> ^^^ t" in exI)
 apply (simp add: par_tr_head)

 (* left *)
 apply (case_tac "a : Z")
  apply (simp add: in_failures)
  apply (erule disjE)
   apply (elim conjE exE, simp)
   apply (rule_tac x="Ya" in exI)
   apply (rule_tac x="Za" in exI)
   apply (simp)
   apply (rule_tac x="<Ev a> ^^^ sb" in exI)
   apply (rule_tac x="t" in exI)
   apply (simp add: par_tr_head)
   (* *)
   apply (elim conjE exE, simp)
   apply (rule_tac x="Ya" in exI)
   apply (rule_tac x="Za" in exI)
   apply (simp)
   apply (rule_tac x="sb" in exI)
   apply (rule_tac x="<Ev a> ^^^ t" in exI)
   apply (simp add: par_tr_head)
  (* "a ~: Z" *)
  apply (simp add: in_failures)
  apply (elim conjE exE, simp)
  apply (rule_tac x="Ya" in exI)
  apply (rule_tac x="Za" in exI)
  apply (simp)
  apply (rule_tac x="<Ev a> ^^^ sb" in exI)
  apply (rule_tac x="t" in exI)
  apply (simp add: par_tr_head)

 (* right *)
 apply (case_tac "a : Y")
  apply (simp add: in_failures)
  apply (erule disjE)
   apply (elim conjE exE, simp)
   apply (rule_tac x="Ya" in exI)
   apply (rule_tac x="Za" in exI)
   apply (simp)
   apply (rule_tac x="<Ev a> ^^^ sb" in exI)
   apply (rule_tac x="t" in exI)
   apply (simp add: par_tr_head)
   (* *)
   apply (elim conjE exE, simp)
   apply (rule_tac x="Ya" in exI)
   apply (rule_tac x="Za" in exI)
   apply (simp)
   apply (rule_tac x="sb" in exI)
   apply (rule_tac x="<Ev a> ^^^ t" in exI)
   apply (simp add: par_tr_head)
  (* "a ~: Y" *)
  apply (simp add: in_failures)
  apply (elim conjE exE, simp)
  apply (rule_tac x="Ya" in exI)
  apply (rule_tac x="Za" in exI)
  apply (simp)
  apply (rule_tac x="sb" in exI)
  apply (rule_tac x="<Ev a> ^^^ t" in exI)
  apply (simp add: par_tr_head)
done

(*********************************************************
                      Hide expansion
 *********************************************************)

(*------------------*
 |      csp law     |
 *------------------*)

lemma cspF_Hiding_step:
  "(? :Y -> Pf) -- X =F[M,M]
      IF (Y Int X = {}) THEN (? x:Y -> (Pf x -- X))
                         ELSE ((? x:(Y-X) -> (Pf x -- X))
                               [> (! x:(Y Int X) .. (Pf x -- X)))"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Hiding_step)
apply (rule order_antisym)

 (* => *)
 apply (rule)
 apply (simp add: in_failures)
 apply (elim conjE exE)
 apply (erule disjE)
  (* not hidden *)
  apply (simp)
  apply (case_tac "Y Int X ~= {}", fast)
  apply (simp)
  apply (fast)
  (* hidden *)
  apply (elim conjE exE)
   apply (simp)

  apply (case_tac "a : X")
  apply (case_tac "Y Int X = {}", fast)
   apply (simp)
   apply (case_tac "sb --tr X = <>")
   apply (rule disjI1)
   apply (simp)
   apply (rule_tac x="a" in bexI)
   apply (rule_tac x="sb" in exI)
   apply (simp)
   apply (simp)

   apply (rule disjI2)
   apply (simp)
   apply (rule disjI2)
   apply (rule_tac x="a" in bexI)
   apply (rule_tac x="sb" in exI)
   apply (simp)
   apply (simp)

  (* a ~: X *)
   apply (case_tac "Y Int X = {}")
    apply (simp)
    apply (fast)
   (* Y Int X ~= {} *)
    apply (simp)
    apply (fast)

 (* <= *)
 apply (rule)
 apply (case_tac "Y Int X = {}")
  apply (simp add: in_failures)
  apply (erule disjE)
   apply (rule_tac x="<>" in exI)
   apply (simp)
   apply (fast)
  (* *)
   apply (elim conjE exE)
   apply (case_tac "a : X", fast)
   apply (rule_tac x="<Ev a> ^^^ sb" in exI)
   apply (simp)

 (* Y Int X ~= {} *)
 apply (simp add: in_failures_IF)
 apply (simp add: in_failures_Timeout)
 apply (elim disjE)
  (* 1 *)
  apply (simp add: in_failures)
  apply (elim conjE exE bexE)
  apply (rule_tac x="<Ev a> ^^^ sa" in exI)
  apply (simp)

  (* 2 *)
  apply (simp add: in_failures)
  apply (elim conjE, simp)
  apply (elim conjE exE)
  apply (rule_tac x="<Ev a> ^^^ sb" in exI)
  apply (simp)
  (* 3 *)
  apply (simp add: in_failures)
  apply (simp add: in_traces)
done

(*********************************************************
                    Renaming expansion
 *********************************************************)

(*------------------*
 |      csp law     |
 *------------------*)

lemma cspF_Renaming_step:
  "(? :X -> Pf) [[r]] =F[M,M]
    ? y:(r `` X) -> (! x:{x. x:X & (x,y):r} .. (Pf x)[[r]])"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Renaming_step)
apply (rule order_antisym)

(* => *)
 apply (rule)
 apply (simp add: in_failures)
 apply (elim disjE conjE exE)
  (* 1 *)
  apply (simp add: ren_inv_def)
  apply (force)
  (* 2 *)
  apply (simp add: ren_tr_decompo)
  apply (elim conjE exE)
  apply (rule disjI2)
  apply (rule_tac x="b" in exI)
  apply (rule_tac x="t" in exI)
  apply (simp)
  apply (fast)

(* <= *)
 apply (rule)
 apply (simp add: in_failures)
 apply (elim disjE conjE exE)
  (* 1 *)
  apply (simp add: ren_inv_def)
  apply (force)
  (* 2 *)
  apply (rule_tac x="<Ev aa> ^^^ sb" in exI)
  apply (simp)
done

(*********************************************************
            Sequential composition expansion
 *********************************************************)

(*------------------*
 |      csp law     |
 *------------------*)

lemma cspF_Seq_compo_step:
  "(? :X -> Pf) ;; Q =F[M,M] ? x:X -> (Pf x ;; Q)"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Seq_compo_step)
apply (rule order_antisym)

(* => *)
 apply (rule)
 apply (simp add: in_failures)
 apply (elim conjE exE disjE)

 apply (simp_all)
 apply (insert trace_nil_or_Tick_or_Ev)
 apply (drule_tac x="sa" in spec)
 apply (erule disjE)
 apply (simp add: in_traces)
 apply (erule disjE)
 apply (simp)

 apply (elim conjE exE)
 apply (simp)
 apply (rule_tac x="a" in exI)
 apply (rule_tac x="sb ^^^ t" in exI)
 apply (simp add: appt_assoc)
 apply (simp add: in_traces)
 apply (fast)

(* <= *)
 apply (rule)
 apply (simp add: in_failures)
 apply (erule disjE)
 (* 1 *)
  apply (rule disjI1)
  apply (simp)
  apply (fast)

 (* 2 *)
  apply (elim conjE exE disjE)

  (* 2-1 *)
   apply (simp)

  (* 2-2 *)
   apply (rule disjI2)
   apply (simp)
   apply (rule_tac x="<Ev a> ^^^ sb" in exI)
   apply (rule_tac x="t" in exI, simp)
   apply (simp add: appt_assoc)
   apply (simp add: in_traces)
done

(*********************************************************
                    Depth_rest expansion
 *********************************************************)

(*------------------*
 |      csp law     |
 *------------------*)

lemma cspF_Depth_rest_step:
  "(? :X -> Pf) |. (Suc n) =F[M,M] ? x:X -> (Pf x |. n)"
apply (simp add: cspF_cspT_semantics)
apply (simp add: cspT_Depth_rest_step)
apply (rule order_antisym)

(* => *)
 apply (rule)
 apply (simp add: in_failures)
 apply (elim disjE conjE exE)
 apply (simp_all)
 apply (rule_tac x="a" in exI)
 apply (rule_tac x="sb" in exI)
 apply (simp)
 apply (rule disjI2)
 apply (insert trace_nil_or_Tick_or_Ev)
 apply (drule_tac x="sa" in spec)
 apply (elim conjE exE disjE)
 apply (simp_all)
 apply (simp add: appt_assoc)
 apply (force)

(* <= *)
 apply (rule)
 apply (simp add: in_failures)
 apply (elim disjE conjE exE)
 apply (simp_all)
 apply (rule_tac x="<Ev a> ^^^ sb" in exI)
 apply (simp add: appt_assoc)
done

(*********************************************************)

lemmas cspF_step = cspF_STOP_step       cspF_Act_prefix_step
                   cspF_Ext_choice_step cspF_Parallel_step
                   cspF_Hiding_step     cspF_Renaming_step
                   cspF_Seq_compo_step  cspF_Depth_rest_step

lemmas cspF_light_step = cspF_STOP_step  cspF_Act_prefix_step

lemmas cspF_step_rw = cspF_STOP_step_DIV       cspF_Act_prefix_step
                   cspF_Ext_choice_step cspF_Parallel_step
                   cspF_Hiding_step     cspF_Renaming_step
                   cspF_Seq_compo_step  cspF_Depth_rest_step

lemmas cspF_light_step_rw = cspF_STOP_step_DIV  cspF_Act_prefix_step

end