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

lemma tauPres:
  fixes P    :: pi
  and   Q    :: pi
  and   Rel  :: "(pi \<times> pi) set"
  and   Rel' :: "(pi \<times> pi) set"

  assumes PRelQ: "(P, Q) \<in> Rel"

  shows "\<tau>.(P) \<leadsto><Rel> \<tau>.(Q)"
proof(induct rule: simCases)
  case(Bound Q' a y)
  have "\<tau>.(Q) \<longmapsto>a<\<nu>y> \<prec> Q'" by fact
  hence False by auto
  thus ?case by simp
next
  case(Input Q' a x)
  have "\<tau>.(Q) \<longmapsto>a<x> \<prec> Q'" by fact
  hence False by auto
  thus ?case by simp
next
  case(Free Q' \<alpha>)
  have "\<tau>.(Q) \<longmapsto> \<alpha> \<prec> Q'" by fact
  thus ?case using PRelQ
  proof(induct rule: tauCases, auto simp add: pi.inject residual.inject)
    have "\<tau>.(P) \<Longrightarrow>\<^sub>l\<tau> \<prec> P" by(rule Weak_Late_Step_Semantics.Tau)
    moreover assume "(P, Q') \<in> Rel"
    ultimately show "\<exists>P'. \<tau>.(P) \<Longrightarrow>\<^sub>l\<tau> \<prec> P' \<and> (P', Q') \<in> Rel" by blast
  qed
qed

lemma inputPres:
  fixes P    :: pi
  and   Q    :: pi
  and   a    :: name
  and   x    :: name
  and   Rel  :: "(pi \<times> pi) set"

  assumes PRelQ: "\<forall>y. (P[x::=y], Q[x::=y]) \<in> Rel"
  and     Eqvt: "eqvt Rel"

  shows "a<x>.P \<leadsto><Rel> a<x>.Q"
proof -
  show ?thesis using Eqvt
  proof(induct rule: simCasesCont[of _ "(P, a, x, Q)"])
    case(Bound Q' b y)
    have "a<x>.Q \<longmapsto>b<\<nu>y> \<prec> Q'" by fact
    hence False by auto
    thus ?case by simp
  next
    case(Input Q' b y)
    have "y \<sharp> (P, a, x, Q)" by fact
    hence yFreshP: "(y::name) \<sharp> P" and yineqx: "y \<noteq> x" and "y \<noteq> a" and "y \<sharp> Q"
      by(simp add: fresh_prod)+
    have "a<x>.Q \<longmapsto>b<y> \<prec> Q'" by fact
    thus ?case using `y \<noteq> a` `y \<noteq> x` `y \<sharp> Q`
    proof(induct rule: inputCases, auto simp add: subject.inject)
      have "\<forall>u. \<exists>P'. a<x>.P \<Longrightarrow>\<^sub>lu in ([(x, y)] \<bullet> P)\<rightarrow>a<y> \<prec> P' \<and> (P', ([(x, y)] \<bullet> Q)[y::=u]) \<in> Rel"
      proof(rule allI)
        fix u
        have "a<x>.P \<Longrightarrow>\<^sub>lu in ([(x, y)] \<bullet> P)\<rightarrow>a<y> \<prec> ([(x, y)] \<bullet> P)[y::=u]" (is "?goal")
        proof -
          from yFreshP have "a<x>.P = a<y>.([(x, y)] \<bullet> P)" by(rule Agent.alphaInput)
          moreover have "a<y>.([(x, y)] \<bullet> P) \<Longrightarrow>\<^sub>lu in ([(x, y)] \<bullet> P)\<rightarrow>a<y> \<prec> ([(x, y)] \<bullet> P)[y::=u]"
            by(rule Weak_Late_Step_Semantics.Input)
          ultimately show ?goal by(simp add: name_swap)
        qed

        moreover have "(([(x, y)] \<bullet> P)[y::=u], ([(x, y)] \<bullet> Q)[y::=u]) \<in> Rel"
        proof -
          from PRelQ have "(P[x::=u], Q[x::=u]) \<in> Rel" by auto
          with `y \<sharp> P` `y \<sharp> Q` show ?thesis by(simp add: renaming)
        qed

        ultimately show "\<exists>P'. a<x>.P \<Longrightarrow>\<^sub>lu in ([(x, y)] \<bullet> P)\<rightarrow>a<y> \<prec> P' \<and> (P', ([(x, y)] \<bullet> Q)[y::=u]) \<in> Rel"
          by blast
      qed

      thus "\<exists>P''. \<forall>u. \<exists>P'. a<x>.P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<y> \<prec> P' \<and> (P', ([(x, y)] \<bullet> Q)[y::=u]) \<in> Rel" by blast
    qed
  next
    case(Free Q' \<alpha>)
    have "a<x>.Q \<longmapsto>\<alpha> \<prec> Q'" by fact
    hence False by auto
    thus ?case by simp
  qed
qed

lemma outputPres:
  fixes P    :: pi
  and   Q    :: pi
  and   a    :: name
  and   b    :: name
  and   Rel  :: "(pi \<times> pi) set"
  and   Rel' :: "(pi \<times> pi) set"

  assumes PRelQ: "(P, Q) \<in> Rel"

  shows "a{b}.P \<leadsto><Rel> a{b}.Q"
proof(induct rule: simCases)
  case(Bound Q' c x)
  have "a{b}.Q \<longmapsto>c<\<nu>x> \<prec> Q'" by fact
  hence False by auto
  thus ?case by simp
next
  case(Input Q' c x)
  have "a{b}.Q \<longmapsto>c<x> \<prec> Q'" by fact
  hence False by auto
  thus ?case by simp
next
  case(Free Q' \<alpha>)
  have "a{b}.Q \<longmapsto>\<alpha> \<prec> Q'" by fact
  thus ?case using PRelQ
  proof(induct rule: outputCases, auto simp add: pi.inject residual.inject)
    have "a{b}.P \<Longrightarrow>\<^sub>la[b] \<prec> P" by(rule Weak_Late_Step_Semantics.Output)
    moreover assume "(P, Q') \<in> Rel"
    ultimately show "\<exists>P'. a{b}.P \<Longrightarrow>\<^sub>la[b] \<prec> P' \<and> (P', Q') \<in> Rel" by blast
  qed
qed

  assumes PSimQ: "P \<leadsto><Rel> Q"
  and     RelRel': "Rel \<subseteq> Rel'"

  shows "[a\<frown>b]P \<leadsto><Rel'> [a\<frown>b]Q"
proof(induct rule: simCases)
  case(Bound Q' c x)
  have "x \<sharp> [a\<frown>b]P" by fact
  hence xFreshP: "(x::name) \<sharp> P" by simp
  have "[a\<frown>b]Q \<longmapsto> c<\<nu>x> \<prec> Q'" by fact
  thus ?case
  proof(induct rule: matchCases)
    case cMatch
    have "Q \<longmapsto>c<\<nu>x> \<prec> Q'" by fact
    with PSimQ xFreshP obtain P' where PTrans: "P \<Longrightarrow>\<^sub>lc<\<nu>x> \<prec> P'"
                                   and P'RelQ': "(P', Q') \<in> Rel"
      by(blast dest: simE)
    from PTrans have "[a\<frown>a]P \<Longrightarrow>\<^sub>lc<\<nu>x> \<prec> P'" by(rule Weak_Late_Step_Semantics.Match)
    moreover from P'RelQ' RelRel' have "(P', Q') \<in> Rel'" by blast
    ultimately show ?case by blast
  qed
next
  case(Input Q' c x)
  have "x \<sharp> [a\<frown>b]P" by fact
  hence xFreshP: "(x::name) \<sharp> P" by simp
  have "[a\<frown>b]Q \<longmapsto>c<x> \<prec> Q'" by fact
  thus ?case
  proof(induct rule: matchCases)
    case cMatch
    have "Q \<longmapsto> c<x> \<prec> Q'" by fact
    with PSimQ xFreshP obtain P'' where L1: "\<forall>u. \<exists>P'. P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>c<x> \<prec> P' \<and> (P', Q'[x::=u]) \<in> Rel"
      by(blast dest: simE)
    have "\<forall>u. \<exists>P'. [a\<frown>a]P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>c<x> \<prec> P' \<and> (P', Q'[x::=u]) \<in> Rel'"
    proof(rule allI)
      fix u
      from L1 obtain P' where PTrans: "P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>c<x> \<prec> P'" and P'RelQ': "(P', Q'[x::=u]) \<in> Rel"
        by blast
      from PTrans have "[a\<frown>a]P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>c<x> \<prec> P'" by(rule Weak_Late_Step_Semantics.Match)
      with P'RelQ' RelRel' show "\<exists>P'. [a\<frown>a]P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>c<x> \<prec> P' \<and> (P', Q'[x::=u]) \<in> Rel'"
        by blast
    qed
    thus ?case by blast
  qed
next
  case(Free Q' \<alpha>)
  have "[a\<frown>b]Q \<longmapsto>\<alpha> \<prec> Q'" by fact
  thus ?case
  proof(induct rule: matchCases)
    case cMatch
    have "Q \<longmapsto>\<alpha> \<prec> Q'" by fact
    with PSimQ obtain P' where PTrans: "P \<Longrightarrow>\<^sub>l\<alpha> \<prec> P'" and PRel: "(P', Q') \<in> Rel"
      by(blast dest: simE)
    from PTrans have "[a\<frown>a]P \<Longrightarrow>\<^sub>l\<alpha> \<prec> P'" by(rule Weak_Late_Step_Semantics.Match)
    with PRel RelRel' show ?case by blast
  qed
qed

lemma mismatchPres:
  fixes P    :: pi
  and   Q    :: pi
  and   a    :: name
  and   b    :: name
  and   Rel  :: "(pi \<times> pi) set"
  and   Rel' :: "(pi \<times> pi) set"

  assumes PSimQ: "P \<leadsto><Rel> Q"
  and     RelRel': "Rel \<subseteq> Rel'"

  shows "[a\<noteq>b]P \<leadsto><Rel'> [a\<noteq>b]Q"
proof(cases "a=b")
  assume "a=b"
  thus ?thesis
    by(auto simp add: weakStepSimDef)
next
  assume aineqb: "a\<noteq>b"
  show ?thesis
  proof(induct rule: simCases)
    case(Bound Q' c x)
    have "x \<sharp> [a\<noteq>b]P" by fact
    hence xFreshP: "(x::name) \<sharp> P" by simp
    have "[a\<noteq>b]Q \<longmapsto> c<\<nu>x> \<prec> Q'" by fact
    thus ?case
    proof(induct rule: mismatchCases)
      case cMismatch
      have "Q \<longmapsto>c<\<nu>x> \<prec> Q'" by fact
      with PSimQ xFreshP obtain P' where PTrans: "P \<Longrightarrow>\<^sub>lc<\<nu>x> \<prec> P'"
                                     and P'RelQ': "(P', Q') \<in> Rel"
        by(blast dest: simE)
      from PTrans aineqb have "[a\<noteq>b]P \<Longrightarrow>\<^sub>lc<\<nu>x> \<prec> P'" by(rule Weak_Late_Step_Semantics.Mismatch)
      moreover from P'RelQ' RelRel' have "(P', Q') \<in> Rel'" by blast
      ultimately show ?case by blast
    qed
  next
    case(Input Q' c x)
    have "x \<sharp> [a\<noteq>b]P" by fact
    hence xFreshP: "(x::name) \<sharp> P" by simp
    have "[a\<noteq>b]Q \<longmapsto>c<x> \<prec> Q'" by fact
    thus ?case
    proof(induct rule: mismatchCases)
      case cMismatch
      have "Q \<longmapsto> c<x> \<prec> Q'" by fact
      with PSimQ xFreshP obtain P'' where L1: "\<forall>u. \<exists>P'. P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>c<x> \<prec> P' \<and> (P', Q'[x::=u]) \<in> Rel"
        by(blast dest: simE)
      have "\<forall>u. \<exists>P'. [a\<noteq>b]P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>c<x> \<prec> P' \<and> (P', Q'[x::=u]) \<in> Rel'"
      proof(rule allI)
        fix u
        from L1 obtain P' where PTrans: "P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>c<x> \<prec> P'" and P'RelQ': "(P', Q'[x::=u]) \<in> Rel"
          by blast
        from PTrans aineqb have "[a\<noteq>b]P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>c<x> \<prec> P'" by(rule Weak_Late_Step_Semantics.Mismatch)
        with P'RelQ' RelRel' show "\<exists>P'. [a\<noteq>b]P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>c<x> \<prec> P' \<and> (P', Q'[x::=u]) \<in> Rel'"
          by blast
      qed
      thus ?case by blast
    qed
  next
    case(Free Q' \<alpha>)
    have "[a\<noteq>b]Q \<longmapsto>\<alpha> \<prec> Q'" by fact
    thus ?case
    proof(induct rule: mismatchCases)
      case cMismatch
      have "Q \<longmapsto>\<alpha> \<prec> Q'" by fact
      with PSimQ obtain P' where PTrans: "P \<Longrightarrow>\<^sub>l\<alpha> \<prec> P'" and PRel: "(P', Q') \<in> Rel"
        by(blast dest: simE)
      from PTrans `a \<noteq> b` have "[a\<noteq>b]P \<Longrightarrow>\<^sub>l\<alpha> \<prec> P'" by(rule Weak_Late_Step_Semantics.Mismatch)
      with PRel RelRel' show ?case by blast
    qed
  qed
qed

lemma sumCompose:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi
  and   T :: pi

  assumes PSimQ: "P \<leadsto><Rel> Q"
  and     RSimT: "R \<leadsto><Rel> T"
  and     RelRel': "Rel \<subseteq> Rel'"

  shows "P \<oplus> R \<leadsto><Rel'> Q \<oplus> T"
proof(induct rule: simCases)
  case(Bound Q' a x)
  have "x \<sharp> P \<oplus> R" by fact
  hence xFreshP: "(x::name) \<sharp> P" and xFreshR: "x \<sharp> R" by simp+
  have "Q \<oplus> T \<longmapsto>a<\<nu>x> \<prec> Q'" by fact
  thus ?case
  proof(induct rule: sumCases)
    case cSum1
    have "Q \<longmapsto>a<\<nu>x> \<prec> Q'" by fact
    with xFreshP PSimQ obtain P' where PTrans: "P \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> P'" and P'RelQ': "(P', Q') \<in> Rel"
      by(blast dest: simE)
    from PTrans have "P \<oplus> R \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> P'" by(rule Weak_Late_Step_Semantics.Sum1)
    moreover from P'RelQ' RelRel' have "(P', Q') \<in> Rel'" by blast
    ultimately show ?case by blast
  next
    case cSum2
    have "T \<longmapsto>a<\<nu>x> \<prec> Q'" by fact
    with xFreshR RSimT obtain R' where RTrans: "R \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> R'" and R'RelQ': "(R', Q') \<in> Rel"
      by(blast dest: simE)
    from RTrans have "P \<oplus> R \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> R'" by(rule Weak_Late_Step_Semantics.Sum2)
    moreover from R'RelQ' RelRel' have "(R', Q') \<in> Rel'" by blast
    ultimately show ?thesis by blast
  qed
next
  case(Input Q' a x)
  have "x \<sharp> P \<oplus> R" by fact
  hence xFreshP: "(x::name) \<sharp> P" and xFreshR: "x \<sharp> R" by simp+
  have "Q \<oplus> T \<longmapsto>a<x> \<prec> Q'" by fact
  thus ?case
  proof(induct rule: sumCases)
    case cSum1
    have "Q \<longmapsto>a<x> \<prec> Q'" by fact
    with xFreshP PSimQ obtain P'' where L1: "\<forall>u. \<exists>P'. P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P' \<and> (P', Q'[x::=u]) \<in> Rel"
      by(blast dest: simE)
    have "\<forall>u. \<exists>P'. P \<oplus> R \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P' \<and> (P', Q'[x::=u]) \<in> Rel'"
    proof(rule allI)
      fix u
      from L1 obtain P' where PTrans: "P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P'"
                          and P'RelQ': "(P', Q'[x::=u]) \<in> Rel" by blast
      from PTrans have "P \<oplus> R \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P'" by(rule Weak_Late_Step_Semantics.Sum1)
      with P'RelQ' RelRel' show "\<exists>P'. P \<oplus> R \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P' \<and> (P', Q'[x::=u]) \<in> Rel'" by blast
    qed
    thus ?case by blast
  next
    case cSum2
    have "T \<longmapsto>a<x> \<prec> Q'" by fact
    with xFreshR RSimT obtain R'' where L1: "\<forall>u. \<exists>R'. R \<Longrightarrow>\<^sub>lu in R''\<rightarrow>a<x> \<prec> R' \<and> (R', Q'[x::=u]) \<in> Rel"
      by(blast dest: simE)
    have "\<forall>u. \<exists>P'. P \<oplus> R \<Longrightarrow>\<^sub>lu in R''\<rightarrow>a<x> \<prec> P' \<and> (P', Q'[x::=u]) \<in> Rel'"
    proof(rule allI)
      fix u
      from L1 obtain R' where RTrans: "R \<Longrightarrow>\<^sub>lu in R''\<rightarrow>a<x> \<prec> R'"
                          and R'RelQ': "(R', Q'[x::=u]) \<in> Rel" by blast
      from RTrans have "P \<oplus> R \<Longrightarrow>\<^sub>lu in R''\<rightarrow>a<x> \<prec> R'" by(rule Weak_Late_Step_Semantics.Sum2)
      with R'RelQ' RelRel' show  "\<exists>P'. P \<oplus> R \<Longrightarrow>\<^sub>lu in R''\<rightarrow>a<x> \<prec> P' \<and> (P', Q'[x::=u]) \<in> Rel'" by blast
    qed
    thus ?case by blast
  qed
next
  case(Free Q' \<alpha>)
  have "Q \<oplus> T \<longmapsto>\<alpha> \<prec> Q'" by fact
  thus ?case
  proof(induct rule: sumCases)
    case cSum1
    have "Q \<longmapsto>\<alpha> \<prec> Q'" by fact
    with PSimQ obtain P' where PTrans: "P \<Longrightarrow>\<^sub>l\<alpha> \<prec> P'" and PRel: "(P', Q') \<in> Rel"
      by(blast dest: simE)
    from PTrans have "P \<oplus> R \<Longrightarrow>\<^sub>l\<alpha> \<prec> P'" by(rule Weak_Late_Step_Semantics.Sum1)
    with RelRel' PRel show ?case by blast
  next
    case cSum2
    have "T \<longmapsto>\<alpha> \<prec> Q'" by fact
    with RSimT obtain R' where RTrans: "R \<Longrightarrow>\<^sub>l\<alpha> \<prec> R'" and RRel: "(R', Q') \<in> Rel"
      by(blast dest: simE)
    from RTrans have "P \<oplus> R \<Longrightarrow>\<^sub>l\<alpha> \<prec> R'" by(rule Weak_Late_Step_Semantics.Sum2)
    with RelRel' RRel show ?case by blast
  qed
qed

lemma sumPres:
  fixes P :: pi
  and   Q :: pi
  and   R :: pi

  assumes PSimQ: "P \<leadsto><Rel> Q"
  and     Id: "Id \<subseteq> Rel"
  and     RelRel': "Rel \<subseteq> Rel'"

  shows "P \<oplus> R \<leadsto><Rel'> Q \<oplus> R"
proof -
  from Id have Refl: "R \<leadsto><Rel> R" by(rule reflexive)
  from PSimQ Refl RelRel' show ?thesis by(rule sumCompose)
qed

lemma parPres:
  fixes P     :: pi
  and   Q     :: pi
  and   R     :: pi
  and   Rel   :: "(pi \<times> pi) set"
  and   Rel'  :: "(pi \<times> pi) set"

  assumes PSimQ:    "P \<leadsto><Rel> Q"
  and     PRelQ:    "(P, Q) \<in> Rel"
  and     Par:      "\<And>P Q R. (P, Q) \<in> Rel \<Longrightarrow> (P \<parallel> R, Q \<parallel> R) \<in> Rel'"
  and     Res:      "\<And>P Q a. (P, Q) \<in> Rel' \<Longrightarrow> (<\<nu>a>P, <\<nu>a>Q) \<in> Rel'"
  and     EqvtRel:  "eqvt Rel"
  and     EqvtRel': "eqvt Rel'"

  shows "P \<parallel> R \<leadsto><Rel'> Q \<parallel> R"
using EqvtRel'
proof(induct rule: simCasesCont[where C="(P, Q, R)"])
  case(Bound Q' a x)
  have "x \<sharp> (P, Q, R)" by fact
  hence xFreshP: "x \<sharp> P" and xFreshR: "x \<sharp> R" and "x \<sharp> Q" by simp+
  from `Q \<parallel> R \<longmapsto> a<\<nu>x> \<prec> Q'` `x \<sharp> Q` `x \<sharp> R` show ?case
  proof(induct rule: parCasesB)
    case(cPar1 Q')
    have QTrans: "Q \<longmapsto> a<\<nu>x> \<prec> Q'" by fact

    from xFreshP PSimQ QTrans obtain P' where PTrans:"P \<Longrightarrow>\<^sub>l a<\<nu>x> \<prec> P'"
                                          and P'RelQ': "(P', Q') \<in> Rel"
      by(blast dest: simE)
    from PTrans xFreshR have "P \<parallel> R \<Longrightarrow>\<^sub>l a<\<nu>x> \<prec> (P' \<parallel> R)" by(rule Weak_Late_Step_Semantics.Par1B)
    moreover from P'RelQ' have "(P' \<parallel> R, Q' \<parallel> R) \<in> Rel'" by(rule Par)
    ultimately show ?case by blast
  next
    case(cPar2 R')
    have RTrans: "R \<longmapsto> a<\<nu>x> \<prec> R'" by fact
    hence "R \<Longrightarrow>\<^sub>l a<\<nu>x> \<prec> R'"
      by(auto simp add: weakTransition_def dest: Weak_Late_Step_Semantics.singleActionChain)
    with xFreshP xFreshR have ParTrans: "P \<parallel> R \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> P \<parallel> R'"
      by(blast intro: Weak_Late_Step_Semantics.Par2B)
    moreover from PRelQ  have "(P \<parallel> R', Q \<parallel>  R') \<in> Rel'" by(rule Par)
    ultimately show ?case by blast
  qed
next
  case(Input Q' a x)
  have "x \<sharp> (P, Q, R)" by fact
  hence xFreshP: "x \<sharp> P" and xFreshR: "x \<sharp> R" and "x \<sharp> Q" by simp+
  from `Q \<parallel> R \<longmapsto>a<x> \<prec> Q'` `x \<sharp> Q` `x \<sharp> R`
  show ?case
  proof(induct rule: parCasesB)
    case(cPar1 Q')
    have QTrans: "Q \<longmapsto>a<x> \<prec> Q'" by fact
    from xFreshP PSimQ QTrans obtain P''
      where L1: "\<forall>u. \<exists>P'. P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P' \<and> (P', Q'[x::=u]) \<in> Rel"
      by(blast dest: simE)
    have "\<forall>u. \<exists>P'. P \<parallel> R \<Longrightarrow>\<^sub>lu in (P'' \<parallel> R)\<rightarrow>a<x> \<prec> P' \<and> (P', Q'[x::=u] \<parallel> R[x::=u]) \<in> Rel'"
    proof(rule allI)
      fix u
      from L1 obtain P' where PTrans:"P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P'"
                          and P'RelQ': "(P', Q'[x::=u]) \<in> Rel" by blast
      from PTrans xFreshR have "P \<parallel> R \<Longrightarrow>\<^sub>lu in (P'' \<parallel> R)\<rightarrow>a<x> \<prec> (P' \<parallel> R)"
        by(rule Weak_Late_Step_Semantics.Par1B)
      moreover from P'RelQ'  have "(P' \<parallel> R, Q'[x::=u] \<parallel> R) \<in> Rel'"
        by(rule Par)
      ultimately show "\<exists>P'. P \<parallel> R \<Longrightarrow>\<^sub>lu in (P'' \<parallel> R)\<rightarrow>a<x> \<prec> P' \<and> (P', Q'[x::=u] \<parallel> (R[x::=u])) \<in> Rel'"
        using xFreshR
        by(force simp add: forget)
    qed
    thus ?case by force
  next
    case(cPar2 R')
    have RTrans: "R \<longmapsto>a<x> \<prec> R'" by fact
    have "\<forall>u. \<exists>P'. P \<parallel> R \<Longrightarrow>\<^sub>lu in (P \<parallel> R')\<rightarrow>a<x> \<prec> P' \<and> (P', Q \<parallel> R'[x::=u]) \<in> Rel'"
    proof
      fix u
      from RTrans have "R \<Longrightarrow>\<^sub>lu in R'\<rightarrow>a<x> \<prec> R'[x::=u]"
        by(rule Weak_Late_Step_Semantics.singleActionChain)
      hence "P \<parallel> R \<Longrightarrow>\<^sub>lu in P \<parallel> R'\<rightarrow>a<x> \<prec> P \<parallel> R'[x::=u]" using `x \<sharp> P`
        by(rule Weak_Late_Step_Semantics.Par2B)
      moreover from PRelQ have "(P \<parallel> R'[x::=u], Q \<parallel>  R'[x::=u]) \<in> Rel'" by(rule Par)
      ultimately show "\<exists>P'. P \<parallel> R \<Longrightarrow>\<^sub>lu in (P \<parallel> R')\<rightarrow>a<x> \<prec> P' \<and>
                           (P', Q \<parallel> R'[x::=u]) \<in> Rel'" by blast
    qed
    thus ?case using `x \<sharp> Q` by(fastforce simp add: forget)
  qed
next
  case(Free QR' \<alpha>)
  have "Q \<parallel> R \<longmapsto> \<alpha> \<prec> QR'" by fact
  thus ?case
  proof(induct rule: parCasesF[of _ _ _ _ _ "(P, R)"])
    case(cPar1 Q')
    have "Q \<longmapsto> \<alpha> \<prec> Q'" by fact
    with PSimQ obtain P' where PTrans: "P \<Longrightarrow>\<^sub>l\<alpha> \<prec> P'" and PRel: "(P', Q') \<in> Rel"
      by(blast dest: simE)
    from PTrans have Trans: "P \<parallel> R \<Longrightarrow>\<^sub>l\<alpha> \<prec> P' \<parallel> R" by(rule Weak_Late_Step_Semantics.Par1F)
    moreover from PRel have "(P' \<parallel> R, Q' \<parallel> R) \<in> Rel'" by(blast intro: Par)
    ultimately show ?case by blast
  next
    case(cPar2 R')
    have "R \<longmapsto> \<alpha> \<prec> R'" by fact
    hence "R \<Longrightarrow>\<^sub>l\<alpha> \<prec> R'"
      by(rule Weak_Late_Step_Semantics.singleActionChain)
    hence "P \<parallel> R \<Longrightarrow>\<^sub>l\<alpha> \<prec> (P \<parallel> R')" by(rule Weak_Late_Step_Semantics.Par2F)
    moreover from PRelQ have "(P \<parallel> R', Q \<parallel> R') \<in> Rel'" by(blast intro: Par)
    ultimately show ?case by blast
  next
    case(cComm1 Q' R' a b x)
    have QTrans: "Q \<longmapsto> a<x> \<prec> Q'" and RTrans: "R \<longmapsto> a[b] \<prec> R'" by fact+
    have "x \<sharp> (P, R)" by fact
    hence xFreshP: "x \<sharp> P" by(simp add: fresh_prod)

    from PSimQ QTrans xFreshP obtain P' P'' where PTrans: "P \<Longrightarrow>\<^sub>lb in P''\<rightarrow>a<x> \<prec> P'"
                                              and P'RelQ': "(P', Q'[x::=b]) \<in> Rel"
      by(blast dest: simE)

    from RTrans have "R \<Longrightarrow>\<^sub>la[b] \<prec> R'"
      by(rule Weak_Late_Step_Semantics.singleActionChain)

    with PTrans have "P \<parallel> R \<Longrightarrow>\<^sub>l\<tau> \<prec> P' \<parallel> R'" by(rule Weak_Late_Step_Semantics.Comm1)
    moreover from P'RelQ' have "(P' \<parallel> R', Q'[x::=b] \<parallel> R') \<in> Rel'" by(rule Par)
    ultimately show ?case by blast
  next
    case(cComm2 Q' R' a b x)
    have QTrans: "Q \<longmapsto>a[b] \<prec> Q'" and RTrans: "R \<longmapsto>a<x> \<prec> R'" by fact+
    have "x \<sharp> (P, R)" by fact
    hence xFreshR: "x \<sharp> R" by(simp add: fresh_prod)

    from PSimQ QTrans obtain P' where PTrans: "P \<Longrightarrow>\<^sub>la[b] \<prec> P'"
                                  and PRel: "(P', Q') \<in> Rel"
      by(blast dest: simE)
    from RTrans have "R \<Longrightarrow>\<^sub>lb in R'\<rightarrow>a<x> \<prec> R'[x::=b]"
      by(rule Weak_Late_Step_Semantics.singleActionChain)
    with PTrans have "P \<parallel> R \<Longrightarrow>\<^sub>l\<tau> \<prec> P' \<parallel> R'[x::=b]" by(rule Weak_Late_Step_Semantics.Comm2)
    moreover from PRel have "(P' \<parallel> R'[x::=b], Q' \<parallel> R'[x::=b]) \<in> Rel'" by(rule Par)
    ultimately show ?case by blast
  next
    case(cClose1 Q' R' a x y)
    have QTrans: "Q \<longmapsto>a<x> \<prec> Q'" and RTrans: "R \<longmapsto>a<\<nu>y> \<prec> R'" by fact+
    have "x \<sharp> (P, R)" and "y \<sharp> (P, R)" by fact+
    hence xFreshP: "x \<sharp> P" and yFreshR: "y \<sharp> R" and yFreshP: "y \<sharp> P" by(simp add: fresh_prod)+

    from PSimQ QTrans xFreshP obtain P' P'' where PTrans: "P \<Longrightarrow>\<^sub>ly in P''\<rightarrow>a<x> \<prec> P'"
                                              and P'RelQ': "(P', Q'[x::=y]) \<in> Rel"
      by(blast dest: simE)
    from RTrans have "R \<Longrightarrow>\<^sub>la<\<nu>y> \<prec> R'"
      by(auto simp add: weakTransition_def dest: Weak_Late_Step_Semantics.singleActionChain)
    with PTrans have Trans: "P \<parallel> R \<Longrightarrow>\<^sub>l\<tau> \<prec> <\<nu>y>(P' \<parallel> R')" using yFreshP yFreshR
      by(rule Weak_Late_Step_Semantics.Close1)
    moreover from P'RelQ' have "(<\<nu>y>(P' \<parallel> R'), <\<nu>y>(Q'[x::=y] \<parallel> R')) \<in> Rel'"
      by(blast intro: Par Res)
    ultimately show ?case by blast
  next
    case(cClose2 Q' R' a x y)
    have QTrans: "Q \<longmapsto>a<\<nu>y> \<prec> Q'" and RTrans: "R \<longmapsto>a<x> \<prec> R'" by fact+
    have "x \<sharp> (P, R)" and "y \<sharp> (P, R)" by fact+
    hence xFreshR: "x \<sharp> R" and yFreshP: "y \<sharp> P" and yFreshR: "y \<sharp> R" by(simp add: fresh_prod)+

    from PSimQ QTrans yFreshP obtain P' where PTrans: "P \<Longrightarrow>\<^sub>la<\<nu>y> \<prec> P'"
                                          and P'RelQ': "(P', Q') \<in> Rel"
      by(blast dest: simE)

    from RTrans have "R \<Longrightarrow>\<^sub>ly in R'\<rightarrow>a<x> \<prec> R'[x::=y]"
      by(rule Weak_Late_Step_Semantics.singleActionChain)
    with PTrans have "P \<parallel> R \<Longrightarrow>\<^sub>l\<tau> \<prec> <\<nu>y>(P' \<parallel> R'[x::=y])" using yFreshP yFreshR
      by(rule Weak_Late_Step_Semantics.Close2)
    moreover from P'RelQ' have "(<\<nu>y>(P' \<parallel> R'[x::=y]), <\<nu>y>(Q' \<parallel> R'[x::=y])) \<in> Rel'"
      by(blast intro: Par Res)
    ultimately show ?case by blast
  qed
qed

  assumes PSimQ: "P \<leadsto><Rel> Q"
  and     ResRel: "\<And>(P::pi) (Q::pi) (x::name). (P, Q) \<in> Rel \<Longrightarrow> (<\<nu>x>P, <\<nu>x>Q) \<in> Rel'"
  and     RelRel': "Rel \<subseteq> Rel'"
  and     EqvtRel: "eqvt Rel"
  and     EqvtRel': "eqvt Rel'"

  shows "<\<nu>x>P \<leadsto><Rel'> <\<nu>x>Q"
proof -
  from EqvtRel' show ?thesis
  proof(induct rule: simCasesCont[of _ "(P, Q, x)"])
    case(Bound Q' a y)
    have Trans: "<\<nu>x>Q \<longmapsto>a<\<nu>y> \<prec> Q'" by fact
    have "y \<sharp> (P, Q, x)" by fact
    hence yineqx: "y \<noteq> x" and yFreshP: "y \<sharp> P" and "y \<sharp> Q" by(simp add: fresh_prod)+
    from Trans `y \<noteq> x` `y \<sharp> Q` show ?case
    proof(induct rule: resCasesB)
      case(cOpen a Q')
      have QTrans: "Q \<longmapsto>a[x] \<prec> Q'" and aineqx: "a \<noteq> x" by fact+

      from PSimQ QTrans obtain P' where PTrans: "P \<Longrightarrow>\<^sub>la[x] \<prec> P'"
                                    and P'RelQ': "(P', Q') \<in> Rel"
        by(blast dest: simE)

      have "<\<nu>x>P \<Longrightarrow>\<^sub>la<\<nu>y> \<prec> ([(y, x)] \<bullet> P')"
      proof -
        from PTrans aineqx have "<\<nu>x>P \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> P'" by(rule Weak_Late_Step_Semantics.Open)
        moreover from PTrans yFreshP have "y \<sharp> P'" by(force intro: Weak_Late_Step_Semantics.freshTransition)
        ultimately show ?thesis by(simp add: alphaBoundResidual name_swap)
      qed
      moreover from EqvtRel P'RelQ' RelRel' have "([(y, x)] \<bullet> P', [(y, x)] \<bullet> Q') \<in> Rel'"
        by(blast intro: eqvtRelI)
      ultimately show ?case by blast
    next
      case(cRes Q')
      have QTrans: "Q \<longmapsto>a<\<nu>y> \<prec> Q'" by fact
      from `x \<sharp> BoundOutputS a` have "x \<noteq> a" by simp

      from PSimQ yFreshP QTrans obtain P' where PTrans: "P \<Longrightarrow>\<^sub>la<\<nu>y> \<prec> P'"
                                            and P'RelQ': "(P', Q') \<in> Rel"
        by(blast dest: simE)
      from PTrans `x \<noteq> a` yineqx yFreshP have ResTrans: "<\<nu>x>P \<Longrightarrow>\<^sub>la<\<nu>y> \<prec> (<\<nu>x>P')"
        by(blast intro: Weak_Late_Step_Semantics.ResB)
      moreover from P'RelQ' have "((<\<nu>x>P'), (<\<nu>x>Q')) \<in> Rel'"
        by(rule ResRel)
      ultimately show ?case by blast
    qed
  next
    case(Input Q' a y)
    have "y \<sharp> (P, Q, x)" by fact
    hence yineqx: "y \<noteq> x" and yFreshP: "y \<sharp> P" and "y \<sharp> Q" by(simp add: fresh_prod)+
    have "<\<nu>x>Q \<longmapsto>a<y> \<prec> Q'" by fact
    thus ?case using yineqx `y \<sharp> Q`
    proof(induct rule: resCasesB)
      case(cOpen a Q')
      thus ?case by simp
    next
      case(cRes Q')
      have QTrans: "Q \<longmapsto>a<y> \<prec> Q'" by fact
      from `x \<sharp> InputS a` have "x \<noteq> a" by simp

      from PSimQ QTrans yFreshP obtain P''
        where L1: "\<forall>u. \<exists>P'. P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<y> \<prec> P' \<and> (P', Q'[y::=u]) \<in> Rel"
        by(blast dest: simE)
      have "\<forall>u. \<exists>P'. <\<nu>x>P \<Longrightarrow>\<^sub>lu in (<\<nu>x>P'')\<rightarrow>a<y> \<prec> P' \<and> (P', (<\<nu>x>Q')[y::=u]) \<in> Rel'"
      proof(rule allI)
        fix u
        show "\<exists>P'. <\<nu>x>P \<Longrightarrow>\<^sub>lu in <\<nu>x>P''\<rightarrow>a<y> \<prec> P' \<and> (P', (<\<nu>x>Q')[y::=u]) \<in> Rel'"
        proof(cases "x=u")
          assume xequ: "x=u"

          have "\<exists>c::name. c \<sharp> (P, P'', Q', x, y, a)" 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'"
                                and cineqx: "c \<noteq> x" and cineqy: "c \<noteq> y" and cineqa: "c \<noteq> a"
            by(force simp add: fresh_prod)

          from L1 obtain P' where PTrans: "P \<Longrightarrow>\<^sub>lc in P''\<rightarrow>a<y> \<prec> P'"
                              and P'RelQ': "(P', Q'[y::=c]) \<in> Rel"
            by blast
          have "<\<nu>x>P \<Longrightarrow>\<^sub>lu in (<\<nu>x>P'')\<rightarrow>a<y> \<prec> <\<nu>c>([(x, c)] \<bullet> P')"
          proof -
            from PTrans yineqx `x \<noteq> a` cineqx have "<\<nu>x>P \<Longrightarrow>\<^sub>lc in (<\<nu>x>P'')\<rightarrow>a<y> \<prec> <\<nu>x>P'"
              by(blast intro: Weak_Late_Step_Semantics.ResB)
            hence "([(x, c)] \<bullet> <\<nu>x>P) \<Longrightarrow>\<^sub>l([(x, c)] \<bullet> c) in ([(x, c)] \<bullet> <\<nu>x>P'')\<rightarrow>([(x, c)] \<bullet> a)<([(x, c)] \<bullet> y)> \<prec> [(x, c)] \<bullet> <\<nu>x>P'"
              by(rule Weak_Late_Step_Semantics.eqvtI)
            moreover from cFreshP have "<\<nu>c>([(x, c)] \<bullet> P) = <\<nu>x>P" by(simp add: alphaRes)
            moreover from cFreshP'' have "<\<nu>c>([(x, c)] \<bullet> P'') = <\<nu>x>P''" by(simp add: alphaRes)
            ultimately show ?thesis using `x \<noteq> a` cineqa yineqx cineqy cineqx xequ by(simp add: name_calc)
          qed
          moreover have "(<\<nu>c>([(x, c)] \<bullet> P'), (<\<nu>x>Q')[y::=u]) \<in> Rel'"
          proof -
            from P'RelQ' have "(<\<nu>x>P', <\<nu>x>(Q'[y::=c])) \<in> Rel'" by(rule ResRel)
            with EqvtRel' have "([(x, c)] \<bullet> <\<nu>x>P', [(x, c)] \<bullet> <\<nu>x>(Q'[y::=c])) \<in> Rel'"  by(rule eqvtRelI)
            with cineqy yineqx cineqx have "(<\<nu>c>([(x, c)] \<bullet> P'), (<\<nu>c>([(x, c)] \<bullet> Q'))[y::=x]) \<in> Rel'"
              by(simp add: name_calc eqvt_subs)
            with cFreshQ' xequ show ?thesis by(simp add: alphaRes)
          qed
          ultimately show ?thesis by blast
        next
          assume xinequ: "x \<noteq> u"
          from L1 obtain P' where PTrans: "P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<y> \<prec> P'"
                             and P'RelQ': "(P', Q'[y::=u]) \<in> Rel" by blast

          from PTrans `x \<noteq> a` yineqx xinequ have "<\<nu>x>P \<Longrightarrow>\<^sub>lu in (<\<nu>x>P'')\<rightarrow>a<y> \<prec> <\<nu>x>P'"
            by(blast intro: Weak_Late_Step_Semantics.ResB)
          moreover from P'RelQ' xinequ yineqx have "(<\<nu>x>P', (<\<nu>x>Q')[y::=u]) \<in> Rel'"
            by(force intro: ResRel)
          ultimately show ?thesis by blast
        qed
      qed
      thus ?case by blast
    qed
  next
    case(Free Q' \<alpha>)
    have "<\<nu>x>Q \<longmapsto> \<alpha> \<prec> Q'" by fact
    thus ?case
    proof(induct rule: resCasesF)
      case(cRes Q')
      have "Q \<longmapsto>\<alpha> \<prec> Q'" by fact
      with PSimQ obtain P' where PTrans: "P \<Longrightarrow>\<^sub>l\<alpha> \<prec> P'"
                             and P'RelQ': "(P', Q') \<in> Rel"
        by(blast dest: simE)

      have "<\<nu>x>P \<Longrightarrow>\<^sub>l\<alpha> \<prec> <\<nu>x>P'"
      proof -
        have xFreshAlpha: "x \<sharp> \<alpha>" by fact
        with PTrans show ?thesis by(rule Weak_Late_Step_Semantics.ResF)
      qed
      moreover from P'RelQ' have "(<\<nu>x>P', <\<nu>x>Q') \<in> Rel'" by(rule ResRel)
      ultimately show ?case by blast
    qed
  qed
qed

  shows "!P \<leadsto><bangRel Rel'> !Q"
proof -
  from eqvtRel' have EqvtBangRel': "eqvt(bangRel Rel')" by(rule eqvtBangRel)
  from RelRel' have BRelRel': "\<And>P Q. (P, Q) \<in> bangRel Rel \<Longrightarrow> (P, Q) \<in> bangRel Rel'"
    by(auto intro: bangRelSubset)

  have "\<And>Rs P. \<lbrakk>!Q \<longmapsto> Rs; (P, !Q) \<in> bangRel Rel\<rbrakk> \<Longrightarrow> weakStepSimAct P Rs P (bangRel Rel')"
  proof -
    fix Rs P
    assume "!Q \<longmapsto> Rs" and "(P, !Q) \<in> bangRel Rel"
    thus "weakStepSimAct P Rs P (bangRel Rel')"
    proof(nominal_induct avoiding: P rule: bangInduct)
      case(cPar1B aa x Q' P)
      have QTrans: "Q \<longmapsto>aa\<guillemotleft>x\<guillemotright> \<prec> Q'" and xFreshQ: "x \<sharp> Q" by fact+
      have "(P, Q \<parallel> !Q) \<in> bangRel Rel" and "x \<sharp> P" by fact+
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q) \<in> Rel" and RBangRelQ: "(R, !Q) \<in> bangRel Rel" by fact+
        have "x \<sharp> P \<parallel> R" by fact
        hence xFreshP: "x \<sharp> P" and xFreshR: "x \<sharp> R" by simp+
        from PRelQ have PSimQ: "P \<leadsto><Rel'> Q" by(rule Sim)
        from EqvtBangRel' show ?case
        proof(induct rule: simActBoundCases)
          case(Input a)
          have "aa = InputS a" by fact
          with PSimQ QTrans xFreshP obtain P''
            where L1: "\<forall>u. \<exists>P'. P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P' \<and> (P', Q'[x::=u]) \<in> Rel'"
            by(blast dest: simE)
          have "\<forall>u. \<exists>P'. P \<parallel> R \<Longrightarrow>\<^sub>lu in (P'' \<parallel> R)\<rightarrow>a<x> \<prec> P' \<and> (P', (Q' \<parallel> !Q)[x::=u]) \<in> bangRel Rel'"
          proof(rule allI)
            fix u
            from L1 obtain P' where PTrans: "P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P'"
                                and P'RelQ': "(P', Q'[x::=u]) \<in> Rel'"
              by blast
            from PTrans xFreshR have "P \<parallel> R \<Longrightarrow>\<^sub>lu in (P'' \<parallel> R)\<rightarrow>a<x>\<prec> P' \<parallel> R"
              by(rule Weak_Late_Step_Semantics.Par1B)
            moreover have "(P' \<parallel> R, (Q' \<parallel> !Q)[x::=u]) \<in> bangRel Rel'"
            proof -
              from P'RelQ' RBangRelQ have "(P' \<parallel> R, Q'[x::=u] \<parallel> !Q) \<in> bangRel Rel'"
                by(blast intro: BRelRel' Rel.BRPar)
              with xFreshQ show ?thesis by(force simp add: forget)
            qed
            ultimately show "\<exists>P'. P \<parallel> R \<Longrightarrow>\<^sub>lu in (P'' \<parallel> R)\<rightarrow>a<x> \<prec> P' \<and>
                                  (P', (Q' \<parallel> !Q)[x::=u]) \<in> bangRel Rel'"
              by blast
          qed
          thus ?case by blast
        next
          case(BoundOutput a)
          have "aa = BoundOutputS a" by fact
          with PSimQ QTrans xFreshP obtain P' where PTrans: "P \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> P'" and P'RelQ': "(P', Q') \<in> Rel'"
            by(force dest: simE)
          from PTrans xFreshR have "P \<parallel> R \<Longrightarrow>\<^sub>la<\<nu>x>\<prec> P' \<parallel> R"
            by(rule Weak_Late_Step_Semantics.Par1B)
          moreover from P'RelQ' RBangRelQ have "(P' \<parallel> R, Q' \<parallel> !Q) \<in> bangRel Rel'"
            by(blast intro: Rel.BRPar BRelRel')
          ultimately show ?case by blast
        qed
      qed
    next
      case(cPar1F \<alpha> Q' P)
      have QTrans: "Q \<longmapsto> \<alpha> \<prec> Q'" by fact
      have "(P, Q \<parallel> !Q) \<in> bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q) \<in> Rel" and RBangRelQ: "(R, !Q) \<in> bangRel Rel" by fact+
        show ?case
        proof(induct rule: simActFreeCases)
          case Free
          from PRelQ have "P \<leadsto><Rel'> Q" by(rule Sim)
          with QTrans obtain P' where PTrans: "P \<Longrightarrow>\<^sub>l\<alpha> \<prec> P'" and P'RelQ': "(P', Q') \<in> Rel'"
            by(blast dest: simE)

          from PTrans have "P \<parallel> R \<Longrightarrow>\<^sub>l\<alpha> \<prec> P' \<parallel> R" by(rule Weak_Late_Step_Semantics.Par1F)
          moreover from P'RelQ' RBangRelQ have "(P' \<parallel> R, Q' \<parallel> !Q) \<in> bangRel Rel'"
            by(blast intro: BRelRel' Rel.BRPar)
          ultimately show ?case by blast
        qed
      qed
    next
      case(cPar2B aa x Q' P)
      have IH: "\<And>P. (P, !Q) \<in> bangRel Rel \<Longrightarrow> weakStepSimAct P (aa\<guillemotleft>x\<guillemotright> \<prec> Q') P (bangRel Rel')" by fact
      have xFreshQ: "x \<sharp> Q" by fact
      have "(P, Q \<parallel> !Q) \<in> bangRel Rel" and "x \<sharp> P" by fact+
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q) \<in> Rel" and RBangRelQ: "(R, !Q) \<in> bangRel Rel" by fact+
        have "x \<sharp> P \<parallel> R" by fact
        hence xFreshP: "x \<sharp> P" and xFreshR: "x \<sharp> R" by simp+
        from RBangRelQ have IH: "weakStepSimAct R (aa\<guillemotleft>x\<guillemotright> \<prec> Q') R (bangRel Rel')" by(rule IH)
        from EqvtBangRel' show ?case
        proof(induct rule: simActBoundCases)
          case(Input a)
          have "aa = InputS a" by fact
          with xFreshR IH obtain  R'' where L1: "\<forall>u. \<exists>R'. R \<Longrightarrow>\<^sub>lu in R''\<rightarrow>a<x> \<prec> R' \<and>
                                                 (R', Q'[x::=u]) \<in> bangRel Rel'"
            by(simp add: weakStepSimAct_def, blast)
          have "\<forall>u. \<exists>P'. P \<parallel> R \<Longrightarrow>\<^sub>lu in (P \<parallel> R'')\<rightarrow>a<x> \<prec> P' \<and> (P', (Q \<parallel> Q')[x::=u]) \<in> bangRel Rel'"
          proof(rule allI)
            fix u
            from L1 obtain R' where RTrans: "R \<Longrightarrow>\<^sub>lu in R''\<rightarrow>a<x> \<prec> R'"
                                and R'BangRelT': "(R', Q'[x::=u]) \<in> bangRel Rel'"
              by blast

            from RTrans xFreshP have "P \<parallel> R \<Longrightarrow>\<^sub>lu in (P \<parallel> R'')\<rightarrow>a<x> \<prec> P \<parallel> R'"
              by(rule Weak_Late_Step_Semantics.Par2B)
            moreover have "(P \<parallel> R', (Q \<parallel> Q')[x::=u]) \<in> bangRel Rel'"
            proof -
              from PRelQ R'BangRelT' have "(P \<parallel> R', Q \<parallel> Q'[x::=u]) \<in> bangRel Rel'"
                by(blast intro: RelRel' Rel.BRPar)
              with xFreshQ show ?thesis by(simp add: forget)
            qed
            ultimately show "\<exists>P'. P \<parallel> R \<Longrightarrow>\<^sub>lu in (P \<parallel> R'')\<rightarrow>a<x> \<prec> P' \<and> (P', (Q \<parallel> Q')[x::=u]) \<in> bangRel Rel'"
              by blast
          qed
          thus ?case by blast
        next
          case(BoundOutput a)
          have "aa = BoundOutputS a" by fact
          with IH xFreshR obtain R' where RTrans: "R \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> R'"
                                      and R'BangRelT': "(R', Q') \<in> bangRel Rel'"
            by(simp add: weakStepSimAct_def, blast)

          from RTrans xFreshP have "P \<parallel> R \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> P \<parallel> R'"
            by(auto intro: Weak_Late_Step_Semantics.Par2B)
          moreover from PRelQ R'BangRelT' have "(P \<parallel> R', Q \<parallel> Q') \<in> bangRel Rel'"
            by(blast intro: RelRel' Rel.BRPar)
          ultimately show ?case by blast
        qed
      qed
    next
      case(cPar2F \<alpha> Q')
      have IH: "\<And>P. (P, !Q) \<in> bangRel Rel \<Longrightarrow> weakStepSimAct P (\<alpha> \<prec> Q') P (bangRel Rel')" by fact+
      have "(P, Q \<parallel> !Q) \<in> bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q) \<in> Rel" and RBangRelQ: "(R, !Q) \<in> bangRel Rel" by fact+
        show ?case
        proof(induct rule: simActFreeCases)
          case Free
          from RBangRelQ have "weakStepSimAct R (\<alpha> \<prec> Q') R (bangRel Rel')" by(rule IH)
          then obtain R' where RTrans: "R \<Longrightarrow>\<^sub>l\<alpha> \<prec> R'" and R'BangRelQ': "(R', Q') \<in> bangRel Rel'"
            by(simp add: weakStepSimAct_def, blast)

          from RTrans have "P \<parallel> R \<Longrightarrow>\<^sub>l\<alpha> \<prec> P \<parallel> R'" by(rule Weak_Late_Step_Semantics.Par2F)
          moreover from PRelQ R'BangRelQ' have "(P \<parallel> R', Q \<parallel> Q') \<in> bangRel Rel'"
            by(blast intro: RelRel' Rel.BRPar)
          ultimately show ?case by blast
        qed
      qed
    next
      case(cComm1 a x Q' b Q'' P)
      have QTrans: "Q \<longmapsto> a<x> \<prec> Q'" by fact
      have IH: "\<And>P. (P, !Q) \<in> bangRel Rel \<Longrightarrow> weakStepSimAct P (a[b] \<prec> Q'') P (bangRel Rel')" by fact+
      have "(P, Q \<parallel> !Q) \<in> bangRel Rel" and "x \<sharp> P" by fact+
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q) \<in> Rel" and RBangRelQ: "(R, !Q) \<in> bangRel Rel" by fact+
        have "x \<sharp> P \<parallel> R" by fact
        hence xFreshP: "x \<sharp> P" by simp
        show ?case
        proof(induct rule: simActFreeCases)
          case Free
          from PRelQ have "P \<leadsto><Rel'> Q" by(rule Sim)
          with QTrans xFreshP obtain P' P'' where PTrans: "P \<Longrightarrow>\<^sub>lb in P''\<rightarrow>a<x> \<prec> P'"
                                              and P'RelQ': "(P', Q'[x::=b]) \<in> Rel'"
            by(blast dest: simE)

          from RBangRelQ have "weakStepSimAct R (a[b] \<prec> Q'') R (bangRel Rel')" by(rule IH)
          then obtain R' where RTrans: "R \<Longrightarrow>\<^sub>la[b] \<prec> R'"
                           and R'RelT': "(R', Q'') \<in> bangRel Rel'"
            by(simp add: weakStepSimAct_def, blast)
          from PTrans RTrans have "P \<parallel> R \<Longrightarrow>\<^sub>l\<tau> \<prec> (P' \<parallel> R')"
            by(rule Weak_Late_Step_Semantics.Comm1)
          moreover from P'RelQ' R'RelT' have "(P' \<parallel> R', Q'[x::=b] \<parallel> Q'') \<in> bangRel Rel'"
            by(blast intro: RelRel' Rel.BRPar)
          ultimately show ?case by blast
        qed
      qed
    next
      case(cComm2 a b Q' x Q'' P)
      have QTrans: "Q \<longmapsto>a[b] \<prec> Q'" by fact
      have IH: "\<And>P. (P, !Q) \<in> bangRel Rel \<Longrightarrow> weakStepSimAct P (a<x> \<prec> Q'') P (bangRel Rel')"
        by fact
      have "(P, Q \<parallel> !Q) \<in> bangRel Rel" and "x \<sharp> P" by fact+
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q) \<in> Rel" and RBangRelQ: "(R, !Q) \<in> bangRel Rel" by fact+
        have "x \<sharp> P \<parallel> R" by fact
        hence xFreshR: "x \<sharp> R" by simp
        show ?case
        proof(induct rule: simActFreeCases)
          case Free

          from PRelQ have "P \<leadsto><Rel'> Q" by(rule Sim)
          with QTrans obtain P' where PTrans: "P \<Longrightarrow>\<^sub>la[b] \<prec> P'"
                                  and P'RelQ': "(P', Q') \<in> Rel'"
            by(blast dest: simE)

          from RBangRelQ have "weakStepSimAct R (a<x> \<prec> Q'') R (bangRel Rel')"
            by(rule IH)
          with xFreshR obtain R' R'' where RTrans: "R \<Longrightarrow>\<^sub>lb in R''\<rightarrow>a<x> \<prec> R'"
                                       and R'BangRelQ'': "(R', Q''[x::=b]) \<in> bangRel Rel'"
            by(simp add: weakStepSimAct_def, blast)

          from PTrans RTrans have "P \<parallel> R \<Longrightarrow>\<^sub>l\<tau> \<prec> (P' \<parallel> R')"
            by(rule Weak_Late_Step_Semantics.Comm2)
          moreover from P'RelQ' R'BangRelQ'' have "(P' \<parallel> R', Q' \<parallel> Q''[x::=b]) \<in> bangRel Rel'"
            by(rule Rel.BRPar)
          ultimately show ?case by blast
        qed
      qed
    next
      case(cClose1 a x Q' y Q'' P)
      have QTrans: "Q \<longmapsto> a<x> \<prec> Q'" by fact
      have IH: "\<And>P. (P, !Q) \<in> bangRel Rel \<Longrightarrow> weakStepSimAct P (a<\<nu>y> \<prec> Q'') P (bangRel Rel')"
        by fact
      have "(P, Q \<parallel> !Q) \<in> bangRel Rel" and "x \<sharp> P" and "y \<sharp> P" by fact+
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q) \<in> Rel" and RBangRelQ: "(R, !Q) \<in> bangRel Rel" by fact+
        have "x \<sharp> P \<parallel> R" and "y \<sharp> P \<parallel> R" by fact+
        hence xFreshP: "x \<sharp> P" and yFreshR: "y \<sharp> R" and yFreshP: "y \<sharp> P" by simp+
        show ?case
        proof(induct rule: simActFreeCases)
          case Free
          from PRelQ have "P \<leadsto><Rel'> Q" by(rule Sim)
          with QTrans xFreshP obtain P' P'' where PTrans: "P \<Longrightarrow>\<^sub>ly in P''\<rightarrow>a<x> \<prec> P'"
                                              and P'RelQ': "(P', Q'[x::=y]) \<in> Rel'"
            by(blast dest: simE)

          from RBangRelQ have "weakStepSimAct R (a<\<nu>y> \<prec> Q'') R (bangRel Rel')" by(rule IH)
          with yFreshR obtain R' where RTrans: "R \<Longrightarrow>\<^sub>la<\<nu>y> \<prec> R'"
                                   and R'BangRelQ'': "(R', Q'') \<in> bangRel Rel'"
            by(simp add: weakStepSimAct_def, blast)
          from PTrans RTrans yFreshP yFreshR have "P \<parallel> R \<Longrightarrow>\<^sub>l\<tau> \<prec> <\<nu>y>(P' \<parallel> R')"
            by(rule Weak_Late_Step_Semantics.Close1)
          moreover from P'RelQ' R'BangRelQ'' have "(<\<nu>y>(P' \<parallel> R'), <\<nu>y>(Q'[x::=y] \<parallel> Q'')) \<in> bangRel Rel'"
            by(force intro: Rel.BRPar Rel.BRRes)
          ultimately show ?case by blast
        qed
      qed
    next
      case(cClose2 a y Q' x Q'')
      have QTrans: "Q \<longmapsto> a<\<nu>y> \<prec> Q'" by fact
      have IH: "\<And>P. (P, !Q) \<in> bangRel Rel \<Longrightarrow> weakStepSimAct P (a<x> \<prec> Q'') P (bangRel Rel')"
        by fact
      have "(P, Q \<parallel> !Q) \<in> bangRel Rel" and "x \<sharp> P" and "y \<sharp> P" by fact+
      thus ?case
      proof(induct rule: BRParCases)
        case(BRPar P R)
        have PRelQ: "(P, Q) \<in> Rel" and RBangRelQ: "(R, !Q) \<in> bangRel Rel" by fact+
        have "x \<sharp> P \<parallel> R" and "y \<sharp> P \<parallel> R" by fact+
        hence xFreshR: "x \<sharp> R" and yFreshR: "y \<sharp> R" and yFreshP: "y \<sharp> P" by simp+
        show ?case
        proof(induct rule: simActFreeCases)
          case Free
          from PRelQ have "P \<leadsto><Rel'> Q" by(rule Sim)
          with QTrans yFreshP obtain P' where PTrans: "P \<Longrightarrow>\<^sub>la<\<nu>y> \<prec> P'"
                                          and P'RelQ': "(P', Q') \<in> Rel'"
            by(blast dest: simE)

          from RBangRelQ have "weakStepSimAct R (a<x> \<prec> Q'') R (bangRel Rel')"
            by(rule IH)
          with xFreshR obtain R' R'' where RTrans: "R \<Longrightarrow>\<^sub>ly in R''\<rightarrow>a<x> \<prec> R'"
                                       and R'BangRelT': "(R', Q''[x::=y]) \<in> bangRel Rel'"
            by(simp add: weakStepSimAct_def, blast)

          from PTrans RTrans yFreshP yFreshR have "P \<parallel> R \<Longrightarrow>\<^sub>l\<tau> \<prec> <\<nu>y>(P' \<parallel> R')"
            by(rule Weak_Late_Step_Semantics.Close2)
          moreover from P'RelQ' R'BangRelT' have "(<\<nu>y>(P' \<parallel> R'), <\<nu>y>(Q' \<parallel> Q''[x::=y])) \<in> bangRel Rel'"
            by(force intro: Rel.BRPar Rel.BRRes)
          ultimately show ?case by blast
        qed
      qed
    next
      case(cBang Rs)
      have IH: "\<And>P. (P, Q \<parallel> !Q) \<in> bangRel Rel \<Longrightarrow> weakStepSimAct P Rs P (bangRel Rel')"
        by fact
      have "(P, !Q) \<in> bangRel Rel" by fact
      thus ?case
      proof(induct rule: BRBangCases)
        case(BRBang P)
        have PRelQ: "(P, Q) \<in> Rel" by fact
        hence "(!P, !Q) \<in> bangRel Rel" by(rule Rel.BRBang)
        with PRelQ have "(P \<parallel> !P, Q \<parallel> !Q) \<in> bangRel Rel" by(rule Rel.BRPar)
        hence "weakStepSimAct (P \<parallel> !P) Rs (P \<parallel> !P) (bangRel Rel')" by(rule IH)
        thus ?case
        proof(simp (no_asm) add: weakStepSimAct_def, auto)
          fix Q' a x
          assume "weakStepSimAct (P \<parallel> !P) (a<\<nu>x> \<prec> Q') (P \<parallel> !P) (bangRel Rel')" and "x \<sharp> P"
          then obtain P' where PTrans: "(P \<parallel> !P) \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> P'"
                           and P'RelQ': "(P', Q') \<in> (bangRel Rel')"
            by(simp add: weakStepSimAct_def, blast)
          from PTrans have "!P \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> P'"
            by(rule Weak_Late_Step_Semantics.Bang)
          with P'RelQ' show "\<exists>P'. !P \<Longrightarrow>\<^sub>la<\<nu>x> \<prec> P' \<and> (P', Q') \<in> bangRel Rel'" by blast
        next
          fix Q' a x
          assume "weakStepSimAct (P \<parallel> !P) (a<x> \<prec> Q') (P \<parallel> !P) (bangRel Rel')" and "x \<sharp> P"
          then obtain P'' where L1: "\<forall>u. \<exists>P'. P \<parallel> !P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P' \<and> (P', Q'[x::=u]) \<in> (bangRel Rel')"
            by(simp add: weakStepSimAct_def, blast)
          have "\<forall>u. \<exists>P'. !P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P' \<and> (P', Q'[x::=u]) \<in> (bangRel Rel')"
          proof(rule allI)
            fix u
            from L1 obtain P' where PTrans: "P \<parallel> !P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P'"
                                and P'RelQ': "(P', Q'[x::=u]) \<in> (bangRel Rel')"
              by blast
            from PTrans have "!P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P'" by(rule Weak_Late_Step_Semantics.Bang)
            with P'RelQ' show "\<exists>P'. !P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P' \<and> (P', Q'[x::=u]) \<in> (bangRel Rel')" by blast
          qed
          thus "\<exists>P''. \<forall>u. \<exists>P'. !P \<Longrightarrow>\<^sub>lu in P''\<rightarrow>a<x> \<prec> P' \<and> (P', Q'[x::=u]) \<in> (bangRel Rel')" by blast
        next
          fix Q' \<alpha>
          assume "weakStepSimAct (P \<parallel> !P) (\<alpha> \<prec> Q') (P \<parallel> !P) (bangRel Rel')"
          then obtain P' where PTrans: "(P \<parallel> !P) \<Longrightarrow>\<^sub>l\<alpha> \<prec> P'"
                           and P'RelQ': "(P', Q') \<in> (bangRel Rel')"
            by(simp add: weakStepSimAct_def, blast)
          from PTrans have "!P \<Longrightarrow>\<^sub>l\<alpha> \<prec> P'"
            by(rule Weak_Late_Step_Semantics.Bang)
          with P'RelQ' show "\<exists>P'. !P \<Longrightarrow>\<^sub>l\<alpha> \<prec> P' \<and> (P', Q') \<in> (bangRel Rel')" by blast
        qed
      qed
    qed
  qed
  moreover from PRelQ have "(!P, !Q) \<in> bangRel Rel" by(rule Rel.BRBang)
  ultimately show ?thesis by(simp add: weakStepSim_def)
qed

end


section \<open>Implementation of Deterministic Rabin Automata\<close>

theory DRA_Implement
imports
  "DRA_Refine"
  "../../Basic/Implement"
begin

  datatype ('label, 'state) drai = drai
    (alphabeti: "'label list")
    (initiali: "'state")
    (transitioni: "'label \<Rightarrow> 'state \<Rightarrow> 'state")
    (conditioni: "'state rabin gen")

  definition drai_rel :: "('label\<^sub>1 \<times> 'label\<^sub>2) set \<Rightarrow> ('state\<^sub>1 \<times> 'state\<^sub>2) set \<Rightarrow>
    (('label\<^sub>1, 'state\<^sub>1) drai \<times> ('label\<^sub>2, 'state\<^sub>2) drai) set" where
    [to_relAPP]: "drai_rel L S \<equiv> {(A\<^sub>1, A\<^sub>2).
      (alphabeti A\<^sub>1, alphabeti A\<^sub>2) \<in> \<langle>L\<rangle> list_rel \<and>
      (initiali A\<^sub>1, initiali A\<^sub>2) \<in> S \<and>
      (transitioni A\<^sub>1, transitioni A\<^sub>2) \<in> L \<rightarrow> S \<rightarrow> S \<and>
      (conditioni A\<^sub>1, conditioni A\<^sub>2) \<in> \<langle>rabin_rel S\<rangle> list_rel}"

  lemma drai_param[param]:
    "(drai, drai) \<in> \<langle>L\<rangle> list_rel \<rightarrow> S \<rightarrow> (L \<rightarrow> S \<rightarrow> S) \<rightarrow>
      \<langle>rabin_rel S\<rangle> list_rel \<rightarrow> \<langle>L, S\<rangle> drai_rel"
    "(alphabeti, alphabeti) \<in> \<langle>L, S\<rangle> drai_rel \<rightarrow> \<langle>L\<rangle> list_rel"
    "(initiali, initiali) \<in> \<langle>L, S\<rangle> drai_rel \<rightarrow> S"
    "(transitioni, transitioni) \<in> \<langle>L, S\<rangle> drai_rel \<rightarrow> L \<rightarrow> S \<rightarrow> S"
    "(conditioni, conditioni) \<in> \<langle>L, S\<rangle> drai_rel \<rightarrow> \<langle>rabin_rel S\<rangle> list_rel"
    unfolding drai_rel_def fun_rel_def by auto

  definition drai_dra_rel :: "('label\<^sub>1 \<times> 'label\<^sub>2) set \<Rightarrow> ('state\<^sub>1 \<times> 'state\<^sub>2) set \<Rightarrow>
    (('label\<^sub>1, 'state\<^sub>1) drai \<times> ('label\<^sub>2, 'state\<^sub>2) dra) set" where
    [to_relAPP]: "drai_dra_rel L S \<equiv> {(A\<^sub>1, A\<^sub>2).
      (alphabeti A\<^sub>1, alphabet A\<^sub>2) \<in> \<langle>L\<rangle> list_set_rel \<and>
      (initiali A\<^sub>1, initial A\<^sub>2) \<in> S \<and>
      (transitioni A\<^sub>1, transition A\<^sub>2) \<in> L \<rightarrow> S \<rightarrow> S \<and>
      (conditioni A\<^sub>1, condition A\<^sub>2) \<in> \<langle>rabin_rel S\<rangle> list_rel}"

  lemma drai_dra_param[param, autoref_rules]:
    "(drai, dra) \<in> \<langle>L\<rangle> list_set_rel \<rightarrow> S \<rightarrow> (L \<rightarrow> S \<rightarrow> S) \<rightarrow>
      \<langle>rabin_rel S\<rangle> list_rel \<rightarrow> \<langle>L, S\<rangle> drai_dra_rel"
    "(alphabeti, alphabet) \<in> \<langle>L, S\<rangle> drai_dra_rel \<rightarrow> \<langle>L\<rangle> list_set_rel"
    "(initiali, initial) \<in> \<langle>L, S\<rangle> drai_dra_rel \<rightarrow> S"
    "(transitioni, transition) \<in> \<langle>L, S\<rangle> drai_dra_rel \<rightarrow> L \<rightarrow> S \<rightarrow> S"
    "(conditioni, condition) \<in> \<langle>L, S\<rangle> drai_dra_rel \<rightarrow> \<langle>rabin_rel S\<rangle> list_rel"
    unfolding drai_dra_rel_def fun_rel_def by auto

  definition drai_dra :: "('label, 'state) drai \<Rightarrow> ('label, 'state) dra" where
    "drai_dra A \<equiv> dra (set (alphabeti A)) (initiali A) (transitioni A) (conditioni A)"
  definition drai_invar :: "('label, 'state) drai \<Rightarrow> bool" where
    "drai_invar A \<equiv> distinct (alphabeti A)"

  lemma drai_dra_id_param[param]: "(drai_dra, id) \<in> \<langle>L, S\<rangle> drai_dra_rel \<rightarrow> \<langle>L, S\<rangle> dra_rel"
  proof
    fix Ai A
    assume 1: "(Ai, A) \<in> \<langle>L, S\<rangle> drai_dra_rel"
    have 2: "drai_dra Ai = dra (set (alphabeti Ai)) (initiali Ai) (transitioni Ai) (conditioni Ai)"
      unfolding drai_dra_def by rule
    have 3: "id A = dra (id (alphabet A)) (initial A) (transition A) (condition A)" by simp
    show "(drai_dra Ai, id A) \<in> \<langle>L, S\<rangle> dra_rel" unfolding 2 3 using 1 by parametricity
  qed

  lemma drai_dra_br: "\<langle>Id, Id\<rangle> drai_dra_rel = br drai_dra drai_invar"
  proof safe
    show "(A, B) \<in> \<langle>Id, Id\<rangle> drai_dra_rel" if "(A, B) \<in> br drai_dra drai_invar"
      for A and B :: "('a, 'b) dra"
      using that unfolding drai_dra_rel_def drai_dra_def drai_invar_def
      by (auto simp: in_br_conv list_set_rel_def)
    show "(A, B) \<in> br drai_dra drai_invar" if "(A, B) \<in> \<langle>Id, Id\<rangle> drai_dra_rel"
      for A and B :: "('a, 'b) dra"
    proof -
      have 1: "(drai_dra A, id B) \<in> \<langle>Id, Id\<rangle> dra_rel" using that by parametricity
      have 2: "drai_invar A"
        using drai_dra_param(2 - 5)[param_fo, OF that]
        by (auto simp: in_br_conv list_set_rel_def drai_invar_def)
      show ?thesis using 1 2 unfolding in_br_conv by auto
    qed
  qed

end


(*  Title:       Isabelle Collections Library
    Author:      Peter Lammich <peter dot lammich at uni-muenster.de>
    Maintainer:  Peter Lammich <peter dot lammich at uni-muenster.de>
*)
(*
  Changes since submission on 2009-11-26:

  2009-12-10: OrderedSet, implemented iterators, min, max, to_sorted_list

*)

section \<open>\isaheader{Set Implementation by Red-Black-Tree}\<close>
theory RBTSetImpl
imports
  "../spec/SetSpec"
  RBTMapImpl
  "../gen_algo/SetByMap"
  "../gen_algo/SetGA"
begin
text_raw \<open>\label{thy:RBTSetImpl}\<close>
(*@impl Set
  @type ('a::linorder) rs
  @abbrv rs,r
  Sets over linearly ordered elements implemented by red-black trees.
*)

subsection "Definitions"
type_synonym
  'a rs = "('a::linorder,unit) rm"

setup Locale_Code.open_block
interpretation rs_sbm: OSetByOMap rm_basic_ops by unfold_locales
setup Locale_Code.close_block

definition rs_ops :: "('x::linorder,'x rs) oset_ops"
  where [icf_rec_def]: "rs_ops \<equiv> rs_sbm.obasic.dflt_oops"

setup Locale_Code.open_block
interpretation rs: StdOSetDefs rs_ops .
interpretation rs: StdOSet rs_ops
  unfolding rs_ops_def
  by (rule rs_sbm.obasic.dflt_oops_impl)

interpretation rs: StdSet_no_invar rs_ops
  by unfold_locales (simp add: icf_rec_unf SetByMapDefs.invar_def)
setup Locale_Code.close_block

setup \<open>ICF_Tools.revert_abbrevs "rs"\<close>

lemmas rbt_it_to_it_map_code_unfold[code_unfold] =
  it_to_it_map_fold'[OF pi_rm]
  it_to_it_map_fold'[OF pi_rm_rev]

lemma pi_rs[proper_it]:
  "proper_it' rs.iteratei rs.iteratei"
  "proper_it' rs.iterateoi rs.iterateoi"
  "proper_it' rs.rev_iterateoi rs.rev_iterateoi"
  unfolding rs.iteratei_def[abs_def] rs.iterateoi_def[abs_def]
    rs.rev_iterateoi_def[abs_def]
  by (rule proper_it'I icf_proper_iteratorI)+

interpretation
  pi_rs: proper_it_loc rs.iteratei rs.iteratei +
  pi_rs_o: proper_it_loc rs.iterateoi rs.iterateoi +
  pi_rs_ro: proper_it_loc rs.rev_iterateoi rs.rev_iterateoi
  by unfold_locales (rule pi_rs)+

definition test_codegen where "test_codegen \<equiv> (
  rs.empty,
  rs.memb,
  rs.ins,
  rs.delete,
  rs.list_it,
  rs.sng,
  rs.isEmpty,
  rs.isSng,
  rs.ball,
  rs.bex,
  rs.size,
  rs.size_abort,
  rs.union,
  rs.union_dj,
  rs.diff,
  rs.filter,
  rs.inter,
  rs.subset,
  rs.equal,
  rs.disjoint,
  rs.disjoint_witness,
  rs.sel,
  rs.to_list,
  rs.from_list,

  rs.ordered_list_it,
  rs.rev_list_it,
  rs.min,
  rs.max,
  rs.to_sorted_list,
  rs.to_rev_list
)"

export_code test_codegen checking SML

end


theory Test_Map
  imports "../DP_Consistency"
begin

function f :: "nat \<Rightarrow> int" where
  "f 0 = 0"
| "f (Suc i) = undefined (map f [0..<Suc i])"
  by pat_completeness auto
termination
  apply (relation "measure size")
  by (auto intro: wf_mlex mlex_less )

lemma map\<^sub>T'_cong[fundef_cong]:
  fixes f g
  assumes "\<And>x. x \<in> set xs \<Longrightarrow> f x = g x" "xs = ys"
  shows   "map\<^sub>T' f xs = map\<^sub>T' g ys"
  using assms
  apply (induction xs arbitrary: ys)
  subgoal
    by auto
  subgoal for x xs ys
    by (cases ys) auto
  done

function f\<^sub>T :: "nat \<Rightarrow>\<^sub>T int" where
  "f\<^sub>T 0 = return 0"
| "f\<^sub>T (Suc i) = undefined (map\<^sub>T' f\<^sub>T [0..<Suc i])"
  by pat_completeness auto
termination
  apply (relation "size <*mlex*> {}")
  by (auto intro: wf_mlex mlex_less )

(*
lemma [fundef_cong]:
  fixes f g x y
  assumes "\<And> f' g'. f' \<in> set_state f \<Longrightarrow> g' \<in> set_state g \<Longrightarrow> f' y = g' y" "x = y"
  shows "f . (return x) = g . (return y)"
    using assms unfolding fun_app_lifted_def by simp
*)

thm set_state_def
     (*
lemma [fundef_cong]:
  fixes f g x y
  assumes
    "\<And> f' g' x' y'. f' \<in> set_state f \<Longrightarrow> g' \<in> set_state g \<Longrightarrow> x' \<in> set_state x \<Longrightarrow> y' \<in> set_state y
    \<Longrightarrow> f' x' = g' y'"
  shows "f . x = g . y"
    using assms unfolding fun_app_lifted_def sorry *)
(*
lemma [fundef_cong]:
  fixes f g
  assumes "\<And>x xs'. xs' \<in> set_state xs \<Longrightarrow> x \<in> set xs' \<Longrightarrow> f . (return x) = g . (return x)" "xs = ys"
  shows   "map\<^sub>T . f . xs = map\<^sub>T . g . ys"
    sorry
*)
(*
lemma [fundef_cong]:
  fixes f g
  assumes
    "\<And>x xs' f' g'. xs' \<in> set_state xs \<Longrightarrow> x \<in> set xs' \<Longrightarrow> f' \<in> set_state f \<Longrightarrow> g' \<in> set_state g
    \<Longrightarrow> f' x = g' x" "xs = ys"
  shows   "map\<^sub>T . f . xs \<equiv> map\<^sub>T . g . ys"
    sorry
 *)
(*
lemma [fundef_cong]:
  fixes f g x y
  assumes "\<And> x. do { f' \<leftarrow> f; x' \<leftarrow> x; f' x' } = do { g' \<leftarrow> g; x' \<leftarrow> x; g' x' }" "x = y"
  shows "f . (return x) = g . (return y)"
    using assms unfolding fun_app_lifted_def by simp

lemma [fundef_cong]:
  fixes f g
  assumes "\<And>x xs'. xs' \<in> set_state xs \<Longrightarrow> x \<in> set xs' \<Longrightarrow> f . (return x) = g . (return x)" "xs = ys"
  shows   "map\<^sub>T . f . xs = map\<^sub>T . g . ys"
    sorry
*)

(*
lemma [fundef_cong]:
  fixes f g
  assumes
    "\<And>x xs'. xs' \<in> set_state xs \<Longrightarrow> x \<in> set xs' \<Longrightarrow> do { f' \<leftarrow> f; f' x} = do { g' \<leftarrow> g; g' x}"
    "xs = ys"
  shows   "map\<^sub>T . f . xs = map\<^sub>T . g . ys"
  sorry
*)

term map\<^sub>T' term map\<^sub>T
lemma map\<^sub>T_map\<^sub>T':
  "(map\<^sub>T . (return ff)) = \<langle>map\<^sub>T' ff\<rangle>"
  unfolding map\<^sub>T_def lift_3_def
  sorry

(*
lemma [fundef_cong]:
  fixes f g xs ys
  assumes
    "\<And>x xs'. xs' \<in> set_state xs \<Longrightarrow> x \<in> set xs' \<Longrightarrow> f x = g x" "xs = ys"
  shows "map\<^sub>T . (return f) . xs = map\<^sub>T . (return g) . ys"
  using assms(2)
  unfolding map\<^sub>T_map\<^sub>T'
  apply simp
  unfolding fun_app_lifted_def
  apply (simp add: left_identity)
  unfolding bind_def
  apply simp
  apply (rule ext)
  subgoal for M
    apply (cases "runState ys M")
    apply auto
    using assms(1)
    apply auto
    subgoal premises prems for xs M'
      using prems(2-)
      apply (induction xs arbitrary: ys)
       apply simp
      apply simp
      sorry
    done
  done
*)

      (*
lemma [fundef_cong]:
  fixes f g xs
  assumes
    "\<And>x xs'. xs' \<in> set_state xs \<Longrightarrow> x \<in> set xs' \<Longrightarrow> f x = g x"
  shows "map\<^sub>T . (return f) . xs = map\<^sub>T . (return g) . xs"
  sorry
    term 0 (**)
*)

(*
function f\<^sub>T' :: "nat \<Rightarrow>\<^sub>T int" where
  "f\<^sub>T' 0 = return 0"
| "f\<^sub>T' (Suc i) = undefined (map\<^sub>T . (return f\<^sub>T') . (return ([0..<Suc i])))"
  by pat_completeness auto
termination
  apply (relation "measure size")
   apply simp
  apply (simp add: Monad.return_def)
  by auto
term 0 (**)
*)
    thm map\<^sub>T_def[unfolded lift_3_def]

context dp_consistency
begin

lemma map\<^sub>T_return_return_cong:
  fixes f g xs
  assumes "\<And>x. x\<in>set xs \<Longrightarrow> f x = g x"
  shows "map\<^sub>T . \<langle>f\<rangle> . \<langle>xs\<rangle> = map\<^sub>T . \<langle>g\<rangle> . \<langle>xs\<rangle>"
  unfolding map\<^sub>T_map\<^sub>T' return_app_return
  using assms by (auto intro: map\<^sub>T'_cong)

lemma map\<^sub>T_return_upt_cong:
  fixes f g l r
  assumes "\<And>x. x\<in>set [l..<r] \<Longrightarrow> f x = g x"
  shows "map\<^sub>T . \<langle>f\<rangle> . (upt\<^sub>T . \<langle>l\<rangle> . \<langle>r\<rangle>) = map\<^sub>T . \<langle>g\<rangle> . (upt\<^sub>T . \<langle>l\<rangle> . \<langle>r\<rangle>)"
  unfolding upt\<^sub>T_def lift_33_def return_app_return using assms by (auto intro: map\<^sub>T_return_return_cong)
end

fun fe :: "nat \<Rightarrow> nat" where
  "fe 0 = 0"
| "fe (Suc x) = undefined (map (\<lambda>x. fe x + 1) [0..<Suc x])"


;;; -*- syntax: common-lisp; package: KEIM; base: 10; mode: LISP -*-
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;
;;                                                                          ;;
;;   Copyright (C) 1993 by AG Siekmann, Fachbereich Informatik,             ;;
;;   Universitaet des Saarlandes, Saarbruecken, Germany.                    ;;
;;   All rights reserved.                                                   ;;
;;   For information about this program, write to:                          ;;
;;     KEIM Project                                                         ;;
;;     AG Siekmann/FB Informatik                                            ;;
;;     Universitaet des Saarlandes                                          ;;
;;     Postfach 1150                                                        ;;
;;     D-66041 Saarbruecken                                                 ;;
;;     Germany                                                              ;;
;;   electronic mail: keim@cs.uni-sb.de                                     ;;
;;                                                                          ;;
;;   The author makes no representations about the suitability of this      ;;
;;   software for any purpose.  It is provided "AS IS" without express or   ;;
;;   implied warranty.  In particular, it must be understood that this      ;;
;;   software is an experimental version, and is not suitable for use in    ;;
;;   any safety-critical application, and the author denies a license for   ;;
;;   such use.                                                              ;;
;;                                                                          ;;
;;   You may use, copy, modify and distribute this software for any         ;;
;;   noncommercial and non-safety-critical purpose.  Use of this software   ;;
;;   in a commercial product is not included under this license.  You must  ;;
;;   maintain this copyright statement in all copies of this software that  ;;
;;   you modify or distribute.                                              ;;
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;
(in-package :omega)

(th~deftheorem first-second-of-pair
           (in typed-set)
 (conclusion (all-types aa bb (forall  (lam (x aa)
					 (forall (lam (y bb)
						      (and
						       (= (first-of-pair (pair x y)) x)
						       (= (second-of-pair (pair y x)) x)))))))))
(th~deftheorem pair-equality
           (in typed-set)
 (conclusion (all-types aa bb
			(forall  (lam (x aa)
				      (forall (lam (y bb)
						   (forall (lam (a aa)
								(forall (lam (b bb)
						      (equiv
						       (= (pair x y)(pair a b))
						       (and (= a x)(= y b))))))))))))))

(th~deftheorem chris-test-1
           (in base)
 (conclusion (forall  (lam (x o)
	(or (= x (or x (not x)))
            (= x (and x (not x))))))))
;;;;;;;;;

(th~deftheorem commutativity-of-union
	       (in typed-set)
	       (category THEOREM)
	       (conclusion (all-types bb (forall (lam (X (o bb)) (forall (lam (Y (o bb))
			     (= (union X Y) (union Y X))))))))
	       (help "Commutativity of union."))

(th~deftheorem commutativity-of-intersection
	       (in typed-set)
	       (category THEOREM)
	       (conclusion (all-types bb (forall (lam (X (o bb)) (forall (lam (Y (o bb))
			     (= (intersection X Y) (intersection Y X))))))))
	       (help "Commutativity of intersection."))

(th~deftheorem reflexive-subsetp
	       (in typed-set)
	       (category THEOREM)
	       (conclusion (all-types bb (forall (lam (X (o bb))
			     (subsetp X X)))))
	       (help "Each set is a subset of itself."))

(th~deftheorem subsetp-of-union
	       (in typed-set)
	       (category THEOREM)
	       (conclusion (all-types bb (forall (lam (X (o bb)) (forall (lam (A (o bb)) (forall (lam (B (o bb))
				(implies (or (subsetp X A)
					     (subsetp X B))
					 (subsetp X (union A B)))))))))))
	       (help "Subset of union of sets."))

(th~deftheorem subsetp-of-intersection
	       (in typed-set)
	       (category THEOREM)
	       (conclusion (all-types bb (forall (lam (X (o bb)) (forall (lam (A (o bb)) (forall (lam (B (o bb))
				(implies (and (subsetp X A)
					      (subsetp X B))
					 (subsetp X (intersection A B)))))))))))
	       (help "Subset of intersection of sets."))

(th~deftheorem subsetp-of-union-simple
	       (in typed-set)
	       (category THEOREM)
	       (conclusion (all-types bb (forall (lam (X (o bb)) (forall (lam (A (o bb))
					 (subsetp X (union A X))))))))
	       (help "Subset of union of sets, special case."))

(th~deftheorem union-is-subsetp
	       (in typed-set)
	       (category THEOREM)
	       (conclusion (all-types a (forall (lam (X (o a))
				        (forall (lam (Y (o a))
					(forall (lam (Z (o a))
						     (implies (and (subsetp X Z)
								   (subsetp Y Z))
							      (subsetp (union X Y) Z))))))))))
	       (help "Union of X Y is subset if each X and Y is subset."))

(th~deftheorem intersection-is-subsetp
	       (in typed-set)
	       (category THEOREM)
	       (conclusion (all-types a (forall (lam (X (o a))
				        (forall (lam (Y (o a))
					(forall (lam (Z (o a))
						     (implies (or (subsetp X Z)
								  (subsetp Y Z))
							      (subsetp (intersection X Y) Z))))))))))
	       (help "Intersection of X Y is subset if either X or Y is subset."))

(th~deftheorem intersection-is-subsetp-simple
	 (in typed-set)
         (conclusion  (all-types a
			   (forall (lam (X (o a))
                           (forall (lam (Y (o a))
                              (subsetp (intersection X Y) X)))))))
	 (help "Intersection is subset, special case."))

(th~deftheorem union-of-itself
	       (in typed-set)
	       (category THEOREM)
	       (conclusion (all-types bb (forall (lam (X (o bb))
					 (= X (union X X))))))
	       (help "The union of the same sets S is equal to S."))

(th~deftheorem intersection-of-itself
	       (in typed-set)
	       (category THEOREM)
	       (conclusion (all-types bb (forall (lam (X (o bb))
					 (= X (intersection X X))))))
	       (help "The union of the same sets S is equal to S."))

(th~deftheorem distributivity-of-union-to-intersection
	       (in typed-set)
	       (category THEOREM)
	       (conclusion (all-types bb (forall (lam (X (o bb)) (forall (lam (Y (o bb)) (forall (lam (Z (o bb))
			     (= (union (intersection X Y) Z)
				(intersection (union X Z) (union Y Z)))))))))))
	       (help "Distributivity of union and intersection."))

(th~deftheorem distributivity-of-intersection-to-union
	       (in typed-set)
	       (category THEOREM)
	       (conclusion (all-types bb (forall (lam (X (o bb)) (forall (lam (Y (o bb)) (forall (lam (Z (o bb))
			     (= (intersection (union X Y) Z)
				(union (intersection X Z) (intersection Y Z)))))))))))
	       (help "Distributivity of union and intersection."))


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

context weakTauLaws begin

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

  shows "\<Psi> \<rhd> \<tau>.(P) \<approx> P"
proof -
  let ?X = "{(\<Psi>, \<tau>.(P), P) | \<Psi> P. True}" let ?Y = "{(\<Psi>, P, \<tau>.(P)) | \<Psi> P. True}"
  have "(\<Psi>, \<tau>.(P), P) \<in> ?X \<union> ?Y" by auto
  moreover have "eqvt(?X \<union> ?Y)" by(auto simp add: eqvt_def simp add: eqvts)
  ultimately have "\<Psi> \<rhd> \<tau>.(P) \<approx>\<^sub>w P"
  proof(coinduct rule: weakenTransitiveCoinduct)
    case(cStatImp \<Psi> P Q)
    show ?case
    proof(cases "(\<Psi>, P, Q) \<in> ?X")
      case True
      {
        fix \<Psi> P
        have "\<Psi> \<rhd> P \<lessapprox>\<^sub>w<(?X \<union> ?Y \<union> weakBisim)> P" by(auto simp add: weakenStatImp_def intro: weakBisimReflexive)
        moreover have "(\<Psi>, \<tau>.(P), P) \<in> ?X \<union> ?Y \<union> weakBisim" by auto
        ultimately have "\<Psi> \<rhd> \<tau>.(P) \<lessapprox>\<^sub>w<(?X \<union> ?Y \<union> weakBisim)> P"
          by(rule tauLaw1StatImpLeft)
      }
      with `(\<Psi>, P, Q) \<in> ?X` show ?thesis by auto
    next
      case False
      from `(\<Psi>, P, Q) \<notin> ?X` `(\<Psi>, P, Q) \<in> ?X \<union> ?Y` have "(\<Psi>, P, Q) \<in> ?Y" by auto
      {
        fix \<Psi> P
        have "\<Psi> \<rhd> P \<lessapprox><weakBisim> P" using weakBisimReflexive
          by(rule weakBisimE)
        moreover have "\<And>\<Psi> P Q R. \<lbrakk>\<Psi> \<rhd> P \<approx> Q; \<Psi> \<rhd> Q \<sim> R\<rbrakk> \<Longrightarrow> (\<Psi>, P, R) \<in> ?X \<union> ?Y \<union> weakBisim"
          by(fastforce intro: weakBisimTransitive strongBisimWeakBisim)
        ultimately have  "\<Psi> \<rhd> P \<lessapprox><( ?X \<union> ?Y \<union> weakBisim)> \<tau>.(P)" by(rule tauLaw1StatImpRight)
        moreover have "\<And>\<Psi> P Q \<Psi>'. \<lbrakk>(\<Psi>, P, Q) \<in> ?X \<union> ?Y \<union> weakBisim; \<Psi> \<simeq> \<Psi>'\<rbrakk> \<Longrightarrow> (\<Psi>', P, Q) \<in> ?X \<union> ?Y \<union> weakBisim"
          by(auto dest: statEqWeakBisim)
        ultimately have "\<Psi> \<rhd> P \<lessapprox>\<^sub>w<( ?X \<union> ?Y \<union> weakBisim)> \<tau>.(P)" by(rule weakStatImpWeakenStatImp)
      }
      with `(\<Psi>, P, Q) \<in> ?Y` show ?thesis by auto
    qed
  next
    case(cSim \<Psi> P Q)
    let ?Z = "{(\<Psi>, P, Q) | \<Psi> P Q. \<exists>P' Q'. \<Psi> \<rhd> P \<sim> P' \<and> (\<Psi>, P', Q') \<in> ?X \<union> ?Y \<union> weakenBisim \<and> \<Psi> \<rhd> Q' \<sim> Q}"
    have "eqvt ?Z"
      apply auto
      apply(auto simp add: eqvt_def eqvts)
      apply(rule_tac x="(p \<bullet> (\<tau>.(Q')))" in exI)
      apply(auto intro: bisimClosed)
      apply(simp add: eqvts)
      apply(blast intro: bisimClosed weakBisimClosed)
      apply(rule_tac x="(p \<bullet> P')" in exI)
      apply(auto intro: bisimClosed)
      apply(rule_tac x="\<tau>.(p \<bullet> P')" in exI)
      apply auto
      apply(drule_tac p=p and Q=b in bisimClosed)
      apply(simp add: eqvts)
      apply(rule_tac x="(p \<bullet> P')" in exI)
      apply(auto intro: bisimClosed)
      apply(rule_tac x="p \<bullet> Q'" in exI)
      apply auto
      by(blast intro: bisimClosed dest: weakBisimClosed)+
    show ?case
    proof(cases "(\<Psi>, P, Q) \<in> ?X")
      case True
      {
        fix P
        have "\<Psi> \<rhd> P \<leadsto><?Z> P" using weakenBisimEqWeakBisim by(blast intro: weakSimReflexive weakBisimReflexive bisimReflexive)
        moreover note `eqvt ?Z`
        moreover have "\<And>\<Psi> P Q R. \<lbrakk>\<Psi> \<rhd> P \<sim> Q; (\<Psi>, Q, R) \<in> ?Z\<rbrakk> \<Longrightarrow> (\<Psi>, P, R) \<in> ?Z"
          by(blast intro: bisimTransitive)
        ultimately have "\<Psi> \<rhd> \<tau>.(P) \<leadsto><?Z> P"
          by(rule tauLaw1SimLeft)
        moreover have "\<And>\<Psi> P Q \<Psi>'. \<lbrakk>(\<Psi>, P, Q) \<in> ?Z; \<Psi> \<simeq> \<Psi>'\<rbrakk> \<Longrightarrow> (\<Psi>', P, Q) \<in> ?Z"
          by simp (blast intro: statEqWeakBisim statEqBisim)
        ultimately have "\<Psi> \<rhd> \<tau>.(P) \<leadsto>\<^sub>w<?Z> P" by(rule weakSimWeakenSim)
      }
      with `(\<Psi>, P, Q) \<in> ?X` show ?thesis by auto
    next
      case False
      from `(\<Psi>, P, Q) \<notin> ?X` `(\<Psi>, P, Q) \<in> ?X \<union> ?Y` have "(\<Psi>, P, Q) \<in> ?Y" by auto
      moreover {
        fix P
        note `eqvt ?Z`
        moreover have "(\<Psi>, P, P) \<in> ?Z" by simp (blast intro: weakBisimReflexive bisimReflexive)
        moreover have "\<And>\<Psi> P Q R. \<lbrakk>(\<Psi>, P, Q) \<in> ?Z; \<Psi> \<rhd> Q \<sim> R\<rbrakk> \<Longrightarrow> (\<Psi>, P, R) \<in> ?Z"
          by(blast intro: bisimTransitive)
        ultimately have "\<Psi> \<rhd> P \<leadsto><?Z> \<tau>.(P)" by(rule tauLaw1SimRight)
        moreover have "\<And>\<Psi> P Q \<Psi>'. \<lbrakk>(\<Psi>, P, Q) \<in> ?Z; \<Psi> \<simeq> \<Psi>'\<rbrakk> \<Longrightarrow> (\<Psi>', P, Q) \<in> ?Z"
          by simp (blast intro: statEqWeakBisim statEqBisim)
        ultimately have "\<Psi> \<rhd> P \<leadsto>\<^sub>w<?Z> \<tau>.(P)" by(rule weakSimWeakenSim)
      }
      ultimately show ?thesis by auto
    qed
  next
    case(cExt \<Psi> P Q \<Psi>')
    thus ?case by auto
  next
    case(cSym \<Psi> P Q)
    thus ?case by auto
  qed
  thus ?thesis by simp
qed

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

  shows "\<Psi> \<rhd> \<alpha>\<cdot>(\<tau>.(P)) \<approx> \<alpha>\<cdot>P"
proof -
  let ?X = "({(\<Psi>, \<alpha>\<cdot>(\<tau>.(P)), \<alpha>\<cdot>P) | \<Psi> \<alpha> P. True})"
  let ?Y = "({(\<Psi>, \<alpha>\<cdot>P, \<alpha>\<cdot>(\<tau>.(P))) | \<Psi> \<alpha> P. True})"

  have "(\<Psi>, \<alpha>\<cdot>(\<tau>.(P)), \<alpha>\<cdot>P) \<in> ?X \<union> ?Y" by blast
  moreover have "eqvt(?X \<union> ?Y)" by(fastforce simp add: eqvt_def simp add: eqvts)
  ultimately have "\<Psi> \<rhd> \<alpha>\<cdot>(\<tau>.(P)) \<approx>\<^sub>w \<alpha>\<cdot>P"
  proof(coinduct rule: weakenTransitiveCoinduct)
    case(cStatImp \<Psi> P Q)
    show ?case
    proof(cases "(\<Psi>, P, Q) \<in> ?X")
      case True
      {
        fix \<Psi> \<alpha> P
        have "\<And>\<Psi>'. (\<Psi> \<otimes> \<Psi>', \<alpha>\<cdot>(\<tau>.(P)), \<alpha>\<cdot>P) \<in> ?X \<union> ?Y \<union> weakenBisim" by auto
        hence "\<Psi> \<rhd> \<alpha>\<cdot>(\<tau>.(P)) \<lessapprox><(?X \<union> ?Y \<union> weakenBisim)> \<alpha>\<cdot>P" by(rule tauLaw3StatImpLeft)
        moreover have "\<And>\<Psi> P Q \<Psi>'. \<lbrakk>(\<Psi>, P, Q) \<in> ?X \<union> ?Y \<union> weakenBisim; \<Psi> \<simeq> \<Psi>'\<rbrakk> \<Longrightarrow> (\<Psi>', P, Q) \<in> ?X \<union> ?Y \<union> weakenBisim"
          by(fastforce intro: statEqWeakBisim)
        ultimately have "\<Psi> \<rhd> \<alpha>\<cdot>(\<tau>.(P)) \<lessapprox>\<^sub>w<(?X \<union> ?Y \<union> weakenBisim)> \<alpha>\<cdot>P" by(rule weakStatImpWeakenStatImp)
      }
      with `(\<Psi>, P, Q) \<in> ?X` show ?thesis by blast
    next
      case False
      {
        fix \<Psi> \<alpha> P
        have "\<And>\<Psi>'. (\<Psi> \<otimes> \<Psi>', \<alpha>\<cdot>P, \<alpha>\<cdot>(\<tau>.(P))) \<in> ?X \<union> ?Y \<union> weakenBisim" by auto
        hence "\<Psi> \<rhd> \<alpha>\<cdot>P \<lessapprox><(?X \<union> ?Y \<union> weakenBisim)> \<alpha>\<cdot>(\<tau>.(P))" by(rule tauLaw3StatImpRight)
        moreover have "\<And>\<Psi> P Q \<Psi>'. \<lbrakk>(\<Psi>, P, Q) \<in> ?X \<union> ?Y \<union> weakenBisim; \<Psi> \<simeq> \<Psi>'\<rbrakk> \<Longrightarrow> (\<Psi>', P, Q) \<in> ?X \<union> ?Y \<union> weakenBisim"
          by(fastforce intro: statEqWeakBisim)
        ultimately have "\<Psi> \<rhd> \<alpha>\<cdot>P \<lessapprox>\<^sub>w<(?X \<union> ?Y \<union> weakenBisim)> \<alpha>\<cdot>(\<tau>.(P))" by(rule weakStatImpWeakenStatImp)
      }
      moreover from `(\<Psi>, P, Q) \<notin> ?X` `(\<Psi>, P, Q) \<in> ?X \<union> ?Y` have "(\<Psi>, P, Q) \<in> ?Y" by blast
      ultimately show ?thesis by auto
    qed
  next
    case(cSim \<Psi> P Q)
    let ?Z = "{(\<Psi>, P, Q) | \<Psi> P Q. \<exists>P' Q'. \<Psi> \<rhd> P \<sim> P' \<and> (\<Psi>, P', Q') \<in> ?X \<union> ?Y \<union> weakenBisim \<and> \<Psi> \<rhd> Q' \<sim> Q}"
    have "eqvt ?Z"
      apply(clarsimp simp add: eqvt_def)
      apply(elim disjE)
      apply(rule_tac x="p \<bullet> P'" in exI)
      apply(clarsimp simp add: bisimClosed eqvts)
      apply(blast intro: bisimClosed eqvts)
      apply(rule_tac x="p \<bullet> P'" in exI)
      apply(clarsimp simp add: bisimClosed eqvts)
      apply(rule_tac x="p \<bullet> (\<alpha>\<cdot>(\<tau>.(P)))" in exI)
      apply(clarsimp simp add: eqvts)
      apply(rule conjI)
      apply(rule disjI2)
      apply(blast intro: bisimClosed eqvts)
      apply(drule_tac p=p in bisimClosed)
      apply(drule_tac p=p in bisimClosed)
      apply(simp add: eqvts)
      by(blast dest: bisimClosed weakBisimClosed)
    show ?case
    proof(cases "(\<Psi>, P, Q) \<in> ?X")
      case True
      note `(\<Psi>, P, Q) \<in> ?X`
      moreover {
        fix \<Psi> P \<alpha>
        note `eqvt ?Z`
        moreover have "(\<Psi>, P, P) \<in> ?Z" using weakenBisimEqWeakBisim by(blast intro: weakBisimReflexive bisimReflexive)
        moreover have "\<And>xvec Tvec. length xvec = length Tvec \<Longrightarrow> (\<Psi>, P[xvec::=Tvec], P[xvec::=Tvec]) \<in> ?Z"
           using weakenBisimEqWeakBisim by(blast intro: weakBisimReflexive bisimReflexive)
        moreover have "\<And>\<Psi> P Q R S. \<lbrakk>\<Psi> \<rhd> P \<sim> Q; (\<Psi>, Q, R) \<in> ?Z; \<Psi> \<rhd> R \<sim> S\<rbrakk> \<Longrightarrow> (\<Psi>, P, S) \<in> ?Z" by(blast intro: bisimTransitive)
        moreover have "\<And>\<Psi> P Q \<Psi>'. (\<Psi>, P, Q) \<in> ?Z \<Longrightarrow> (\<Psi> \<otimes> \<Psi>', P, Q) \<in> ?Z" by(blast dest: weakenBisimE(3) bisimE(3))
        ultimately have "\<Psi> \<rhd> \<alpha>\<cdot>(\<tau>.(P)) \<leadsto><?Z> \<alpha>\<cdot>P" by(rule tauLaw3SimLeft)
        moreover have "\<And>\<Psi> P Q \<Psi>'. \<lbrakk>(\<Psi>, P, Q) \<in> ?Z; \<Psi> \<simeq> \<Psi>'\<rbrakk> \<Longrightarrow> (\<Psi>', P, Q) \<in> ?Z" by simp (blast dest: statEqWeakBisim statEqBisim)
        ultimately have "\<Psi> \<rhd> \<alpha>\<cdot>(\<tau>.(P)) \<leadsto>\<^sub>w<?Z> \<alpha>\<cdot>P" by(rule weakSimWeakenSim)
      }
      ultimately show ?thesis by auto
    next
      case False
      from `(\<Psi>, P, Q) \<notin> ?X` `(\<Psi>, P, Q) \<in> ?X \<union> ?Y` have "(\<Psi>, P, Q) \<in> ?Y" by blast
      moreover {
        fix \<Psi> P \<alpha>
        note `eqvt ?Z`
        moreover have "\<And>\<Psi> xvec Tvec. length xvec=length Tvec \<Longrightarrow> (\<Psi>, P[xvec::=Tvec], \<tau>.(P[xvec::=Tvec])) \<in> ?Z"
          by simp (blast intro: weakBisimE(4) bisimReflexive tauLaw1)
        moreover have "\<And>\<Psi> P Q R S. \<lbrakk>\<Psi> \<rhd> P \<sim> Q; (\<Psi>, Q, R) \<in> ?Z; \<Psi> \<rhd> R \<sim> S\<rbrakk> \<Longrightarrow> (\<Psi>, P, S) \<in> ?Z" by(blast intro: bisimTransitive)
        moreover have "\<And>\<Psi>. (\<Psi>, P, \<tau>.(P)) \<in> ?Z" by simp (blast intro: weakBisimE(4) bisimReflexive tauLaw1)
        ultimately have "\<Psi> \<rhd> \<alpha>\<cdot>P \<leadsto><?Z> \<alpha>\<cdot>(\<tau>.(P))" by(rule tauLaw3SimRight)
        moreover have "\<And>\<Psi> P Q \<Psi>'. \<lbrakk>(\<Psi>, P, Q) \<in> ?Z; \<Psi> \<simeq> \<Psi>'\<rbrakk> \<Longrightarrow> (\<Psi>', P, Q) \<in> ?Z" by simp (blast dest: statEqWeakBisim statEqBisim)
        ultimately have "\<Psi> \<rhd> \<alpha>\<cdot>P \<leadsto>\<^sub>w<?Z> \<alpha>\<cdot>(\<tau>.(P))" by(rule weakSimWeakenSim)
      }
      ultimately show ?thesis by auto
    qed
  next
    case(cExt \<Psi> P Q \<Psi>')
    thus ?case by auto
  next
    case(cSym \<Psi> P Q)
    thus ?case by blast
  qed
  thus ?thesis by simp
qed

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

  shows "\<Psi> \<rhd> \<alpha>\<cdot>(\<tau>.(P)) \<doteq> \<alpha>\<cdot>P"
proof(induct rule: weakPsiCongI)
  case cWeakBisim
  show ?case by(rule tauLaw3)
next
  case cSimLeft
  have "\<Psi> \<rhd> P \<approx> P" by(rule weakBisimReflexive)
  moreover have "\<And>\<Psi> P Q R S. \<lbrakk>\<Psi> \<rhd> P \<sim> Q; \<Psi> \<rhd> Q \<approx> R; \<Psi> \<rhd> R \<sim> S\<rbrakk> \<Longrightarrow> \<Psi> \<rhd> P \<approx> S"
    by(blast intro: weakBisimTransitive strongBisimWeakBisim)
  ultimately show ?case using weakBisimE(3) by(rule tauLaw3CongSimLeft)
next
  case cSimRight
  have "\<Psi> \<rhd>  P \<approx> P" by(rule weakBisimReflexive)
  moreover have "\<And>\<Psi> P Q R S. \<lbrakk>\<Psi> \<rhd> P \<sim> Q; \<Psi> \<rhd> Q \<approx> R; \<Psi> \<rhd> R \<sim> S\<rbrakk> \<Longrightarrow> \<Psi> \<rhd> P \<approx> S"
    by(blast intro: weakBisimTransitive strongBisimWeakBisim)
  ultimately show ?case using tauLaw1[THEN weakBisimE(4)]
    by(rule tauLaw3CongSimRight)
qed

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

  shows "\<alpha>\<cdot>(\<tau>.(P)) \<doteq>\<^sub>c \<alpha>\<cdot>P"
proof(induct rule: weakCongI)
  case(cWeakPsiCong \<Psi> \<sigma>)
  show ?case
  proof(nominal_induct \<alpha> rule: prefix.strong_inducts)
  next
    case(pInput M yvec N)
    obtain p where "set p \<subseteq> set yvec \<times> set(p \<bullet> yvec)" and "(p \<bullet> yvec) \<sharp>* N" and "(p \<bullet> yvec) \<sharp>* P" and "(p \<bullet> yvec) \<sharp>* \<sigma>"
      by(rule_tac xvec=yvec and c="(N, P, \<sigma>)" in name_list_avoiding) auto
    thus ?case using `wellFormedSubst \<sigma>` tauLaw3PsiCong[where \<alpha>="pInput (substTerm.seqSubst M \<sigma>) (p \<bullet> yvec) (substTerm.seqSubst (p \<bullet> N) \<sigma>)"]
      by(simp add: inputChainAlpha' eqvts)
  next
    case(pOutput M N)
    thus ?case using  `wellFormedSubst \<sigma>` tauLaw3PsiCong[where \<alpha>="pOutput (substTerm.seqSubst M \<sigma>) (substTerm.seqSubst N \<sigma>)"]
      by simp
  next
    case pTau
    thus ?case using  `wellFormedSubst \<sigma>` tauLaw3PsiCong[where \<alpha>="pTau"]
      by simp
  qed
qed

end

end