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

lemma inputSupportDerivative:
  assumes "P \<longmapsto>a<x> \<prec> P'"

  shows "(supp P') - {x} \<subseteq> supp P"
using assms
apply(nominal_induct rule: inputInduct)
apply(auto simp add: pi.supp abs_supp supp_atm)
apply(rule ccontr)
apply(simp add: fresh_def[symmetric])
apply(drule_tac fresh_fact1)
apply(rotate_tac 4)
apply assumption
apply(simp add: fresh_def)
apply force
apply(case_tac "x \<sharp> P")
apply(drule_tac fresh_fact1)
apply(rotate_tac 2)
apply assumption
apply(simp add: fresh_def)
apply force
apply(rotate_tac 2)
apply(drule_tac fresh_fact2)
apply(simp add: fresh_def)
by force

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

  assumes "P \<longmapsto>a[b] \<prec> P'"

  shows "(supp P') \<subseteq> ((supp P)::name set)"
using assms
by(nominal_induct rule: outputInduct) (auto simp add: pi.supp abs_supp)

lemma boundOutputSupportDerivative:
  assumes "P \<longmapsto>a<\<nu>x> \<prec> P'"
  and     "x \<sharp> P"

  shows "(supp P') - {x} \<subseteq> supp P"
using assms
by(nominal_induct rule: boundOutputInduct) (auto simp add: pi.supp abs_supp supp_atm dest: outputSupportDerivative)

lemma tauSupportDerivative:

  assumes "P \<longmapsto>\<tau> \<prec> P'"

  shows "((supp P')::name set) \<subseteq> supp P"
using assms
proof(nominal_induct rule: tauInduct)
  case(Tau P)
  thus ?case by(force simp add: pi.supp)
next
  case(Match P)
  thus ?case by(force simp add: pi.supp)
next
  case(Mismatch P)
  thus ?case by(force simp add: pi.supp)
next
  case(Sum1 P)
  thus ?case by(force simp add: pi.supp)
next
  case(Sum2 P)
  thus ?case by(force simp add: pi.supp)
next
  case(Par1 P)
  thus ?case by(force simp add: pi.supp)
next
  case(Par2 P)
  thus ?case by(force simp add: pi.supp)
next
  case(Comm1 P a b P' Q Q')
  from `P \<longmapsto>a<b> \<prec> P'` have "(supp P') - {b} \<subseteq> supp P" by(rule inputSupportDerivative)
  moreover from `Q \<longmapsto> a[b] \<prec> Q'` have "((supp Q')::name set) \<subseteq> supp Q" by(rule outputSupportDerivative)
  moreover from `Q \<longmapsto> a[b] \<prec> Q'` have "b \<in> supp Q"
    by(nominal_induct rule: outputInduct) (auto simp add: pi.supp abs_supp supp_atm)
  ultimately show ?case by(auto simp add: pi.supp)
next
  case(Comm2 P a b P' Q Q')
  from `P \<longmapsto> a[b] \<prec> P'` have "((supp P')::name set) \<subseteq> supp P" by(rule outputSupportDerivative)
  moreover from `Q \<longmapsto>a<b> \<prec> Q'` have "(supp Q') - {b} \<subseteq> supp Q" by(rule inputSupportDerivative)
  moreover from `P \<longmapsto> a[b] \<prec> P'` have "b \<in> supp P"
    by(nominal_induct rule: outputInduct) (auto simp add: pi.supp abs_supp supp_atm)
  ultimately show ?case by(auto simp add: pi.supp)
next
  case(Close1 P a x P' Q Q')
  thus ?case by(auto dest: inputSupportDerivative boundOutputSupportDerivative simp add: abs_supp pi.supp)
next
  case(Close2 P a x P' Q Q')
  thus ?case by(auto dest: inputSupportDerivative boundOutputSupportDerivative simp add: abs_supp pi.supp)
next
  case(Res P P' x)
  thus ?case by(force simp add: pi.supp abs_supp)
next
  case(Bang P P')
  thus ?case by(force simp add: pi.supp)
qed

lemma tauChainSupportDerivative:
  fixes P  :: pi
  and   P' :: pi

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

  shows "((supp P')::name set) \<subseteq> (supp P)"
using assms
by(induct rule: tauChainInduct) (auto dest: tauSupportDerivative)

definition outputTransition :: "pi \<Rightarrow> name \<Rightarrow> name \<Rightarrow> pi \<Rightarrow> bool" ("_ \<Longrightarrow>_<\<nu>_> \<prec> _" [80, 80, 80, 80] 80)
  where "P \<Longrightarrow>a<\<nu>x> \<prec> P' \<equiv> \<exists>P''' P''. P \<Longrightarrow>\<^sub>\<tau> P''' \<and> P''' \<longmapsto>a<\<nu>x> \<prec> P'' \<and> P'' \<Longrightarrow>\<^sub>\<tau> P'"

definition freeTransition :: "pi \<Rightarrow> freeRes\<Rightarrow> pi \<Rightarrow> bool" ("_ \<Longrightarrow>_ \<prec> _" [80, 80, 80] 80)
  where "P \<Longrightarrow>\<alpha> \<prec> P' \<equiv> \<exists>P''' P''. P \<Longrightarrow>\<^sub>\<tau> P''' \<and> P''' \<longmapsto>\<alpha> \<prec> P'' \<and> P'' \<Longrightarrow>\<^sub>\<tau> P'"

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

  shows "\<lbrakk>P \<Longrightarrow>\<^sub>\<tau> P'''; P''' \<longmapsto>\<alpha> \<prec> P''; P'' \<Longrightarrow>\<^sub>\<tau> P'\<rbrakk> \<Longrightarrow> P \<Longrightarrow>\<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>a<\<nu>x> \<prec> P'"
by(auto simp add: outputTransition_def freeTransition_def)

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

  shows "P \<Longrightarrow>\<alpha> \<prec> P' \<Longrightarrow> (\<exists>P'' P'''. P \<Longrightarrow>\<^sub>\<tau> P'' \<and> P'' \<longmapsto>\<alpha> \<prec> P''' \<and> P''' \<Longrightarrow>\<^sub>\<tau> P')"
  and   "P \<Longrightarrow>a<\<nu>x> \<prec> P' \<Longrightarrow> \<exists>P'' P'''. P \<Longrightarrow>\<^sub>\<tau> P''' \<and> P''' \<longmapsto>a<\<nu>x> \<prec> P'' \<and> P'' \<Longrightarrow>\<^sub>\<tau> P'"
by(auto simp add: outputTransition_def freeTransition_def)

lemma weakTransitionAlpha:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   y  :: name

  assumes PTrans: "P \<Longrightarrow>a<\<nu>x> \<prec> P'"
  and     "y \<sharp> P"

  shows "P \<Longrightarrow>a<\<nu>y> \<prec> ([(x, y)] \<bullet> P')"
proof(cases "y=x")
  case True
  with PTrans show ?thesis by simp
next
  case False
  from PTrans 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(force dest: transitionE)
  note PChain
  moreover from PChain `y \<sharp> P` have "y \<sharp> P'''" by(rule freshChain)
  with P'''Trans have "y \<sharp> P''" using `y \<noteq> x` by(rule freshTransition)
  with P'''Trans have "P''' \<longmapsto>a<\<nu>y> \<prec> ([(x, y)] \<bullet> P'')" by(simp add: alphaBoundOutput name_swap)
  moreover from P''Chain have "([(x, y)] \<bullet> P'') \<Longrightarrow>\<^sub>\<tau> ([(x, y)] \<bullet> P')"
    by(rule eqvtChainI)
  ultimately show ?thesis by(rule transitionI)
qed

lemma singleActionChain:
  fixes P  :: pi
  and   Rs :: residual

  shows "P \<longmapsto>a<\<nu>x> \<prec> P' \<Longrightarrow> P \<Longrightarrow>a<\<nu>x> \<prec> P'"
  and   "P \<longmapsto>\<alpha> \<prec> P' \<Longrightarrow> P \<Longrightarrow>\<alpha> \<prec> P'"
proof -
  have "P \<Longrightarrow>\<^sub>\<tau> P" by simp
  moreover assume "P \<longmapsto>a<\<nu>x> \<prec> P'"
  moreover have "P' \<Longrightarrow>\<^sub>\<tau> P'" by simp
  ultimately show "P \<Longrightarrow>a<\<nu>x> \<prec> P'"
    by(rule transitionI)
next
  have "P \<Longrightarrow>\<^sub>\<tau> P" by simp
  moreover assume "P \<longmapsto>\<alpha> \<prec> P'"
  moreover have "P' \<Longrightarrow>\<^sub>\<tau> P'" by simp
  ultimately show "P \<Longrightarrow>\<alpha> \<prec> P'"
    by(rule transitionI)
qed

lemma Tau:
  fixes P :: pi

  shows "\<tau>.(P) \<Longrightarrow> \<tau> \<prec>  P"
proof -
  have "\<tau>.(P) \<Longrightarrow>\<^sub>\<tau> \<tau>.(P)" by simp
  moreover have "\<tau>.(P) \<longmapsto>\<tau> \<prec> P" by(rule Early_Semantics.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> a<u> \<prec> P[x::=u]"
proof -
  have "a<x>.P \<Longrightarrow>\<^sub>\<tau> a<x>.P" by simp
  moreover have "a<x>.P \<longmapsto> a<u> \<prec> P[x::=u]" by(rule Early_Semantics.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>a[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 Early_Semantics.Output)
  moreover have "P \<Longrightarrow>\<^sub>\<tau> P" by simp
  ultimately show ?thesis by(rule transitionI)
qed

lemma Match:
  fixes P  :: pi
  and   b  :: name
  and   x  :: name
  and   a  :: name
  and   P' :: pi
  and   \<alpha> :: freeRes

  shows "P \<Longrightarrow>b<\<nu>x> \<prec> P' \<Longrightarrow> [a\<frown>a]P \<Longrightarrow>b<\<nu>x> \<prec> P'"
  and   "P \<Longrightarrow>\<alpha> \<prec> P' \<Longrightarrow> [a\<frown>a]P \<Longrightarrow>\<alpha> \<prec> P'"
proof -
  assume "P \<Longrightarrow> b<\<nu>x> \<prec> P'"
  then obtain P'' P''' where PChain: "P \<Longrightarrow>\<^sub>\<tau> P'''"
                         and P'''Trans: "P''' \<longmapsto>b<\<nu>x> \<prec> P''"
                         and P''Chain: "P'' \<Longrightarrow>\<^sub>\<tau> P'"
    by(force dest: transitionE)
  show "[a\<frown>a]P \<Longrightarrow>b<\<nu>x> \<prec> P'"
  proof(cases "P = P'''")
    case True
    have "[a\<frown>a]P \<Longrightarrow>\<^sub>\<tau> [a\<frown>a]P" by simp
    moreover from `P = P'''` P'''Trans have "[a\<frown>a]P \<longmapsto> b<\<nu>x> \<prec> P''"
      by(rule_tac Early_Semantics.Match) auto
    ultimately show ?thesis using P''Chain by(rule transitionI)
  next
    case False
    from PChain `P \<noteq> P'''` have "[a\<frown>a]P \<Longrightarrow>\<^sub>\<tau> P'''" by(rule matchChain)
    thus ?thesis using P'''Trans P''Chain by(rule transitionI)
  qed
next
  assume "P \<Longrightarrow>\<alpha> \<prec> P'"
  then 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(force dest: transitionE)
  show "[a\<frown>a]P \<Longrightarrow>\<alpha> \<prec> P'"
  proof(cases "P = P'''")
    case True
    have "[a\<frown>a]P \<Longrightarrow>\<^sub>\<tau> [a\<frown>a]P" by simp
    moreover from `P = P'''` P'''Trans have "[a\<frown>a]P \<longmapsto>\<alpha> \<prec> P''"
      by(rule_tac Early_Semantics.Match) auto
    ultimately show ?thesis using P''Chain by(rule transitionI)
  next
    case False
    from PChain `P \<noteq> P'''` 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   c  :: name
  and   x  :: name
  and   a  :: name
  and   b  :: name
  and   P' :: pi
  and   \<alpha> :: freeRes

  shows "\<lbrakk>P \<Longrightarrow>c<\<nu>x> \<prec> P'; a \<noteq> b\<rbrakk> \<Longrightarrow> [a\<noteq>b]P \<Longrightarrow>c<\<nu>x> \<prec> P'"
  and   "\<lbrakk>P \<Longrightarrow>\<alpha> \<prec> P'; a \<noteq> b\<rbrakk> \<Longrightarrow> [a\<noteq>b]P \<Longrightarrow>\<alpha> \<prec> P'"
proof -
  assume "P \<Longrightarrow>c<\<nu>x> \<prec> P'"
  then obtain P'' P''' where PChain: "P \<Longrightarrow>\<^sub>\<tau> P'''"
                         and P'''Trans: "P''' \<longmapsto>c<\<nu>x> \<prec> P''"
                         and P''Chain: "P'' \<Longrightarrow>\<^sub>\<tau> P'"
    by(force dest: transitionE)
  assume "a \<noteq> b"
  show "[a\<noteq>b]P \<Longrightarrow>c<\<nu>x> \<prec> P'"
  proof(cases "P = P'''")
    case True
    have "[a\<noteq>b]P \<Longrightarrow>\<^sub>\<tau> [a\<noteq>b]P" by simp
    moreover from `P = P'''` `a \<noteq> b` P'''Trans have "[a\<noteq>b]P \<longmapsto> c<\<nu>x> \<prec> P''"
      by(rule_tac Early_Semantics.Mismatch) auto
    ultimately show ?thesis using P''Chain by(rule transitionI)
  next
    case False
    from PChain `a \<noteq> b` `P \<noteq> P'''` have "[a\<noteq>b]P \<Longrightarrow>\<^sub>\<tau> P'''" by(rule mismatchChain)
    thus ?thesis using P'''Trans P''Chain by(rule transitionI)
  qed
next
  assume "P \<Longrightarrow>\<alpha> \<prec> P'"
  then 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(force dest: transitionE)
  assume "a \<noteq> b"
  show "[a\<noteq>b]P \<Longrightarrow>\<alpha> \<prec> P'"
  proof(cases "P = P'''")
    case True
    have "[a\<noteq>b]P \<Longrightarrow>\<^sub>\<tau> [a\<noteq>b]P" by simp
    moreover from `P = P'''` `a \<noteq> b` P'''Trans have "[a\<noteq>b]P \<longmapsto>\<alpha> \<prec> P''"
      by(rule_tac Early_Semantics.Mismatch) auto
    ultimately show ?thesis using P''Chain by(rule transitionI)
  next
    case False
    from PChain `a \<noteq> b` `P \<noteq> P'''` have "[a\<noteq>b]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 PTrans:  "P \<Longrightarrow>a[b] \<prec> P'"
  and     "a \<noteq> b"

  shows "<\<nu>b>P \<Longrightarrow>a<\<nu>b> \<prec> P'"
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(force dest: transitionE)
  from PChain have "<\<nu>b>P \<Longrightarrow>\<^sub>\<tau> <\<nu>b>P'''" by(rule ResChain)
  moreover from P'''Trans `a \<noteq> b` have "<\<nu>b>P''' \<longmapsto>a<\<nu>b> \<prec> P''" by(rule Open)
  ultimately show ?thesis using P''Chain by(rule transitionI)
qed

lemma Sum1:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   Q  :: pi
  and   \<alpha>  :: freeRes

  shows "P \<Longrightarrow>a<\<nu>x> \<prec> P' \<Longrightarrow> P \<oplus> Q \<Longrightarrow>a<\<nu>x> \<prec> P'"
  and   "P \<Longrightarrow>\<alpha> \<prec> P' \<Longrightarrow> P \<oplus> Q \<Longrightarrow>\<alpha> \<prec> P'"
proof -
  assume "P \<Longrightarrow>a<\<nu>x> \<prec> P'"
  then 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(force dest: transitionE)
  show "P \<oplus> Q \<Longrightarrow>a<\<nu>x> \<prec> P'"
  proof(cases "P = P'''")
    case True
    have "P \<oplus> Q \<Longrightarrow>\<^sub>\<tau> P \<oplus> Q" by simp
    moreover from P'''Trans `P = P'''` have "P \<oplus> Q \<longmapsto> a<\<nu>x> \<prec> P''" by(blast intro: Sum1)
    ultimately show ?thesis using P''Chain by(rule transitionI)
  next
    case False
    from PChain `P \<noteq> P'''` have "P \<oplus> Q \<Longrightarrow>\<^sub>\<tau> P'''" by(rule sum1Chain)
    thus ?thesis using P'''Trans P''Chain by(rule transitionI)
  qed
next
  assume "P \<Longrightarrow>\<alpha> \<prec> P'"
  then 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(force dest: transitionE)
  show "P \<oplus> Q \<Longrightarrow>\<alpha> \<prec> P'"
  proof(cases "P = P'''")
    case True
    have "P \<oplus> Q \<Longrightarrow>\<^sub>\<tau> P \<oplus> Q" by simp
    moreover from P'''Trans `P = P'''` have "P \<oplus> Q \<longmapsto>\<alpha> \<prec> P''" by(blast intro: Sum1)
    ultimately show ?thesis using P''Chain by(rule transitionI)
  next
    case False
    from PChain `P \<noteq> P'''` have "P \<oplus> Q \<Longrightarrow>\<^sub>\<tau> P'''" by(rule sum1Chain)
    thus ?thesis using P'''Trans P''Chain by(rule transitionI)
  qed
qed

lemma Sum2:
  fixes Q  :: pi
  and   a  :: name
  and   x  :: name
  and   Q' :: pi
  and   P  :: pi
  and   \<alpha>  :: freeRes

  shows "Q \<Longrightarrow>a<\<nu>x> \<prec> Q' \<Longrightarrow> P \<oplus> Q \<Longrightarrow>a<\<nu>x> \<prec> Q'"
  and   "Q \<Longrightarrow>\<alpha> \<prec> Q' \<Longrightarrow> P \<oplus> Q \<Longrightarrow>\<alpha> \<prec> Q'"
proof -
  assume "Q \<Longrightarrow>a<\<nu>x> \<prec> Q'"
  then obtain Q'' Q''' where QChain: "Q \<Longrightarrow>\<^sub>\<tau> Q'''"
                         and Q'''Trans: "Q''' \<longmapsto>a<\<nu>x> \<prec> Q''"
                         and Q''Chain: "Q'' \<Longrightarrow>\<^sub>\<tau> Q'"
    by(force dest: transitionE)
  show "P \<oplus> Q \<Longrightarrow>a<\<nu>x> \<prec> Q'"
  proof(cases "Q = Q'''")
    case True
    have "P \<oplus> Q \<Longrightarrow>\<^sub>\<tau> P \<oplus> Q" by simp
    moreover from Q'''Trans `Q = Q'''` have "P \<oplus> Q \<longmapsto>a<\<nu>x> \<prec> Q''" by(blast intro: Sum2)
    ultimately show ?thesis using Q''Chain by(rule transitionI)
  next
    case False
    from QChain `Q \<noteq> Q'''` have "P \<oplus> Q \<Longrightarrow>\<^sub>\<tau> Q'''" by(rule sum2Chain)
    thus ?thesis using Q'''Trans Q''Chain by(rule transitionI)
  qed
next
  assume "Q \<Longrightarrow>\<alpha> \<prec> Q'"
  then obtain Q'' Q''' where QChain: "Q \<Longrightarrow>\<^sub>\<tau> Q'''"
                         and Q'''Trans: "Q''' \<longmapsto>\<alpha> \<prec> Q''"
                         and Q''Chain: "Q'' \<Longrightarrow>\<^sub>\<tau> Q'"
    by(force dest: transitionE)
  show "P \<oplus> Q \<Longrightarrow>\<alpha> \<prec> Q'"
  proof(cases "Q = Q'''")
    case True
    have "P \<oplus> Q \<Longrightarrow>\<^sub>\<tau> P \<oplus> Q" by simp
    moreover from Q'''Trans `Q = Q'''` have "P \<oplus> Q \<longmapsto>\<alpha> \<prec> Q''" by(blast intro: Sum2)
    ultimately show ?thesis using Q''Chain by(rule transitionI)
  next
    case False
    from QChain `Q \<noteq> Q'''` have "P \<oplus> Q \<Longrightarrow>\<^sub>\<tau> Q'''" by(rule sum2Chain)
    thus ?thesis using Q'''Trans Q''Chain by(rule transitionI)
  qed
qed

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

  assumes PTrans: "P \<Longrightarrow>a<\<nu>x> \<prec> P'"
  and     "x \<sharp> Q"

  shows "P \<parallel> Q \<Longrightarrow>a<\<nu>x> \<prec> (P' \<parallel> Q)"
proof -
  from PTrans 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 "P \<parallel> Q \<Longrightarrow>\<^sub>\<tau> P''' \<parallel> Q" by(rule Par1Chain)
  moreover from P'''Trans `x \<sharp> Q` have "P''' \<parallel> Q \<longmapsto>a<\<nu>x> \<prec> (P'' \<parallel> Q)" by(rule Early_Semantics.Par1B)
  moreover from P''Chain have "P'' \<parallel> Q \<Longrightarrow>\<^sub>\<tau> P' \<parallel> Q" by(rule Par1Chain)
  ultimately show "P \<parallel> Q \<Longrightarrow>a<\<nu>x> \<prec> (P' \<parallel> Q)" by(rule transitionI)
qed

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

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

  shows "P \<parallel> Q \<Longrightarrow>\<alpha> \<prec> (P' \<parallel> Q)"
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 "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 Early_Semantics.Par1F)
  moreover from P''Chain 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

  assumes QTrans: "Q \<Longrightarrow>a<\<nu>x> \<prec> Q'"
  and     "x \<sharp> P"

  shows "P \<parallel> Q \<Longrightarrow>a<\<nu>x> \<prec> (P \<parallel> Q')"
proof -
  from QTrans obtain Q'' Q''' where QChain: "Q \<Longrightarrow>\<^sub>\<tau> Q'''"
                                and Q'''Trans: "Q''' \<longmapsto>a<\<nu>x> \<prec> Q''"
                                and Q''Chain: "Q'' \<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 `x \<sharp> P` have "P \<parallel> Q''' \<longmapsto>a<\<nu>x> \<prec> (P \<parallel> Q'')" by(rule Early_Semantics.Par2B)
  moreover from Q''Chain have "P \<parallel> Q'' \<Longrightarrow>\<^sub>\<tau> P \<parallel> Q'" by(rule Par2Chain)
  ultimately show "P \<parallel> Q \<Longrightarrow>a<\<nu>x> \<prec> (P \<parallel> Q')" by(rule transitionI)
qed

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

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

  shows "P \<parallel> Q \<Longrightarrow>\<alpha> \<prec> (P \<parallel> Q')"
proof -
  from QTrans obtain Q'' Q''' where QChain: "Q \<Longrightarrow>\<^sub>\<tau> Q'''"
                                and Q'''Trans: "Q''' \<longmapsto>\<alpha> \<prec> Q''"
                                and Q''Chain: "Q'' \<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 have "P \<parallel> Q''' \<longmapsto>\<alpha> \<prec> (P \<parallel> Q'')" by(rule Early_Semantics.Par2F)
  moreover from Q''Chain 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   a  :: name
  and   b  :: name
  and   P' :: pi
  and   Q  :: pi
  and   Q' :: pi

  assumes PTrans: "P \<Longrightarrow>a<b> \<prec> P'"
  and     QTrans: "Q \<Longrightarrow>a[b] \<prec> Q'"

  shows "P \<parallel> Q \<Longrightarrow>\<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'' 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'' \<parallel> Q''"
    by(rule Early_Semantics.Comm1)
  moreover from P''Chain Q''Chain have "P'' \<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   Q' :: pi

  assumes PTrans: "P \<Longrightarrow>a[b] \<prec> P'"
  and     QTrans: "Q \<Longrightarrow>a<b> \<prec> Q'"

  shows "P \<parallel> Q \<Longrightarrow>\<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'' 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'' \<parallel> Q''"
    by(rule Early_Semantics.Comm2)
  moreover from P''Chain Q''Chain have "P'' \<parallel> Q'' \<Longrightarrow>\<^sub>\<tau> P' \<parallel> Q'" by(rule chainPar)
  ultimately show ?thesis by(rule transitionI)
qed

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

  assumes PTrans: "P \<Longrightarrow>a<x> \<prec> P'"
  and     QTrans: "Q \<Longrightarrow>a<\<nu>x> \<prec> Q'"
  and     "x \<sharp> P"

  shows "P \<parallel> Q \<Longrightarrow>\<tau> \<prec> <\<nu>x>(P' \<parallel> Q')"
proof -
  from PTrans obtain P''' P'' where PChain: "P \<Longrightarrow>\<^sub>\<tau> P'''"
                                and P'''Trans: "P''' \<longmapsto>a<x> \<prec> P''"
                                and P''Chain: "P'' \<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<\<nu>x> \<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 PChain `x \<sharp> P` have "x \<sharp> P'''" by(rule freshChain)
  with P'''Trans Q'''Trans have "P''' \<parallel> Q''' \<longmapsto>\<tau> \<prec> <\<nu>x>(P'' \<parallel> Q'')"
    by(rule Early_Semantics.Close1)
  moreover from P''Chain Q''Chain have "P'' \<parallel> Q'' \<Longrightarrow>\<^sub>\<tau> P' \<parallel> Q'" by(rule chainPar)
  hence "<\<nu>x>(P'' \<parallel> Q'') \<Longrightarrow>\<^sub>\<tau> <\<nu>x>(P' \<parallel> Q')" by(rule ResChain)
  ultimately show ?thesis by(rule transitionI)
qed

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

  assumes PTrans: "P \<Longrightarrow>a<\<nu>x> \<prec> P'"
  and     QTrans: "Q \<Longrightarrow>a<x> \<prec> Q'"
  and     xFreshQ: "x \<sharp> Q"

  shows "P \<parallel> Q \<Longrightarrow>\<tau> \<prec> <\<nu>x>(P' \<parallel> Q')"
proof -
  from PTrans 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 QTrans obtain Q'' Q''' where QChain: "Q \<Longrightarrow>\<^sub>\<tau> Q'''"
                                and Q'''Trans: "Q''' \<longmapsto>a<x> \<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 QChain `x \<sharp> Q` have "x \<sharp> Q'''" by(rule freshChain)

  with P'''Trans Q'''Trans have "P''' \<parallel> Q''' \<longmapsto>\<tau> \<prec> <\<nu>x>(P'' \<parallel> Q'')"
    by(rule Early_Semantics.Close2)
  moreover from P''Chain Q''Chain have "P'' \<parallel> Q'' \<Longrightarrow>\<^sub>\<tau> P' \<parallel> Q'" by(rule chainPar)
 hence "<\<nu>x>(P'' \<parallel> Q'') \<Longrightarrow>\<^sub>\<tau> <\<nu>x>(P' \<parallel> Q')" by(rule ResChain)
  ultimately show ?thesis by(rule transitionI)
qed

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

  assumes PTrans: "P \<Longrightarrow>\<alpha> \<prec> P'"
  and     "x \<sharp> \<alpha>"

  shows "<\<nu>x>P \<Longrightarrow>\<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 `x \<sharp> \<alpha>` have "<\<nu>x>P''' \<longmapsto>\<alpha> \<prec> <\<nu>x>P''"
    by(rule Early_Semantics.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

  assumes PTrans: "P \<Longrightarrow>a<\<nu>x> \<prec> P'"
  and     "y \<noteq> a"
  and     "y \<noteq> x"

  shows "<\<nu>y>P \<Longrightarrow>a<\<nu>x> \<prec> (<\<nu>y>P')"
proof -
  from PTrans 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  `y \<noteq> a` `y \<noteq> x` have "<\<nu>y>P''' \<longmapsto>a<\<nu>x> \<prec> (<\<nu>y>P'')"
    by(rule Early_Semantics.ResB)
  moreover from P''Chain have "<\<nu>y>P'' \<Longrightarrow>\<^sub>\<tau> <\<nu>y>P'" by(rule ResChain)
  ultimately show ?thesis by(rule transitionI)
qed

lemma Bang:
  fixes P  :: pi
  and   Rs :: residual

  shows "P \<parallel> !P \<Longrightarrow>a<\<nu>x> \<prec> P' \<Longrightarrow> !P \<Longrightarrow>a<\<nu>x> \<prec> P'"
  and   "P \<parallel> !P \<Longrightarrow>\<alpha> \<prec> P' \<Longrightarrow> !P \<Longrightarrow>\<alpha> \<prec> P'"
proof -
  assume PTrans: "P \<parallel> !P \<Longrightarrow> a<\<nu>x> \<prec> P'"

  from PTrans 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>a<\<nu>x> \<prec> P'"
  proof(cases "P''' = P \<parallel> !P")
    case True
    have "!P \<Longrightarrow>\<^sub>\<tau> !P" by simp
    moreover from P'''Trans `P''' = P \<parallel> !P` have "!P \<longmapsto>a<\<nu>x> \<prec> P''" by(blast intro: Early_Semantics.Bang)
    ultimately show ?thesis using P''Chain by(rule transitionI)
  next
    case False
    from PChain `P''' \<noteq> P \<parallel> !P` have "!P \<Longrightarrow>\<^sub>\<tau> P'''" by(rule bangChain)
    with P'''Trans P''Chain show ?thesis by(blast intro: transitionI)
  qed
next
  fix \<alpha> P' P
  assume "P \<parallel> !P \<Longrightarrow>\<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>\<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: 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>\<tau> \<prec> P'"

  shows "P \<Longrightarrow>\<^sub>\<tau> P'"
using assms
by(force dest: transitionE tauActTauChain)

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

  shows "P \<Longrightarrow>a<\<nu>x> \<prec> P'' \<Longrightarrow> P'' \<Longrightarrow>\<^sub>\<tau> P' \<Longrightarrow> P \<Longrightarrow>a<\<nu>x> \<prec> P'"
  and   "P \<Longrightarrow>\<alpha> \<prec> P'' \<Longrightarrow> P'' \<Longrightarrow>\<^sub>\<tau> P' \<Longrightarrow> P \<Longrightarrow>\<alpha> \<prec> P'"
  and   "P \<Longrightarrow>\<^sub>\<tau> P'' \<Longrightarrow> P'' \<Longrightarrow>a<\<nu>x> \<prec> P' \<Longrightarrow> P \<Longrightarrow>a<\<nu>x> \<prec> P'"
  and   "P \<Longrightarrow>\<^sub>\<tau> P'' \<Longrightarrow> P'' \<Longrightarrow>\<alpha> \<prec> P' \<Longrightarrow> P \<Longrightarrow>\<alpha> \<prec> P'"
proof -
  assume PTrans: "P \<Longrightarrow> a<\<nu>x> \<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>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>a<\<nu>x> \<prec> P'" by(rule transitionI)
next
  assume PTrans: "P \<Longrightarrow>\<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>\<alpha> \<prec> P'" by(rule transitionI)
next
  assume PChain: "P \<Longrightarrow>\<^sub>\<tau> P''"
  assume P''Trans: "P'' \<Longrightarrow> a<\<nu>x> \<prec> P'"

  from P''Trans obtain P''' P'''' where P''Chain: "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 P''Chain have "P \<Longrightarrow>\<^sub>\<tau> P''''" by auto
  thus "P \<Longrightarrow>a<\<nu>x> \<prec> P'" using P''''Trans P'''Chain by(rule transitionI)
next
  assume PChain: "P \<Longrightarrow>\<^sub>\<tau> P''"
  assume P''Trans: "P'' \<Longrightarrow>\<alpha> \<prec> P'"

  from P''Trans obtain P''' P'''' where P''Chain: "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 P''Chain have "P \<Longrightarrow>\<^sub>\<tau> P''''" by auto
  thus "P \<Longrightarrow>\<alpha> \<prec> P'" using P''''Trans P'''Chain by(rule transitionI)
qed

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

  assumes PTrans: "P \<Longrightarrow>a<\<nu>x> \<prec> P'"
  and     "c \<sharp> P"
  and     "c \<noteq> x"

  shows "c \<sharp> P'"
proof -
  from PTrans 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 `c \<sharp> P` have "c \<sharp> P'''" by(rule freshChain)
  with P'''Trans have "c \<sharp> P''" using `c \<noteq> x` by(rule Early_Semantics.freshTransition)
  with P''Chain show "c \<sharp> P'" by(rule freshChain)
qed

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

  assumes PTrans: "P \<Longrightarrow>\<tau> \<prec> P'"
  and     "c \<sharp> P"

  shows "c \<sharp> P'"
proof -
  from PTrans have "P \<Longrightarrow>\<^sub>\<tau> P'" by(rule tauTransitionChain)
  thus ?thesis using `c \<sharp> P` 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>a[b] \<prec> P'"
  and     "c \<sharp> P"

  shows "c \<sharp> P'"
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 PChain `c \<sharp> P` have "c \<sharp> P'''" by(rule freshChain)
    with P'''Trans have "c \<sharp> P''" by(rule Early_Semantics.freshTransition)
    with P''Chain show ?thesis by(rule freshChain)
qed

lemma eqvtI[eqvt]:
  fixes P  :: pi
  and   a  :: name
  and   x  :: name
  and   P' :: pi
  and   p :: "name prm"
  and   \<alpha> :: freeRes

  shows "P \<Longrightarrow>a<\<nu>x> \<prec> P' \<Longrightarrow> (p \<bullet> P) \<Longrightarrow>(p \<bullet> a)<\<nu>(p \<bullet> x)> \<prec> (p \<bullet> P')"
  and   "P \<Longrightarrow>\<alpha> \<prec> P' \<Longrightarrow> (p \<bullet> P) \<Longrightarrow>(p \<bullet> \<alpha>) \<prec> (p \<bullet> P')"
proof -
  assume "P \<Longrightarrow>a<\<nu>x> \<prec> P'"
  then 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 "(p \<bullet> P) \<Longrightarrow>\<^sub>\<tau> (p \<bullet> P''')" by(rule eqvtChainI)
  moreover from P'''Trans have "(p \<bullet> P''') \<longmapsto> (p \<bullet> (a<\<nu>x> \<prec> P''))"
    by(rule TransitionsEarly.eqvt)
  hence "(p \<bullet> P''') \<longmapsto> (p \<bullet> a)<\<nu>(p \<bullet> x)> \<prec> (p \<bullet> P'')"
    by(simp add: eqvts)
  moreover from P''Chain have "(p \<bullet> P'') \<Longrightarrow>\<^sub>\<tau> (p \<bullet> P')" by(rule eqvtChainI)
  ultimately show "(p \<bullet> P) \<Longrightarrow>(p \<bullet> a)<\<nu>(p \<bullet> x)> \<prec> (p \<bullet> P')"
    by(rule transitionI)
next
  assume "P \<Longrightarrow>\<alpha> \<prec> P'"
  then 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 "(p \<bullet> P) \<Longrightarrow>\<^sub>\<tau> (p \<bullet> P''')" by(rule eqvtChainI)
  moreover from P'''Trans have "(p \<bullet> P''') \<longmapsto> (p \<bullet> (\<alpha> \<prec> P''))"
    by(rule TransitionsEarly.eqvt)
  hence "(p \<bullet> P''') \<longmapsto> (p \<bullet> \<alpha>) \<prec> (p \<bullet> P'')"
    by(simp add: eqvts)
  moreover from P''Chain have "(p \<bullet> P'') \<Longrightarrow>\<^sub>\<tau> (p \<bullet> P')" by(rule eqvtChainI)
  ultimately show "(p \<bullet> P) \<Longrightarrow>(p \<bullet> \<alpha>) \<prec> (p \<bullet> P')"
    by(rule transitionI)
qed

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

  assumes PTrans: "P \<Longrightarrow>a<b> \<prec> P'"
  and     "c \<sharp> P"
  and     "c \<noteq> b"

  shows "c \<sharp> P'"
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 PChain `c \<sharp> P` have "c \<sharp> P'''" by(rule freshChain)
  with P'''Trans have "c \<sharp> P''" using `c \<noteq> b` by(rule Early_Semantics.freshInputTransition)
  with P''Chain show ?thesis by(rule freshChain)
qed

lemmas freshTransition = freshBoundOutputTransition freshOutputTransition
                         freshInputTransition freshTauTransition

end


theory Anti_Plurality_Rule
imports Scoring_Rules
        "Compositional_Structures/Basic_Modules/Anti_Plurality_Module"
        "Compositional_Structures/Elect_Composition"

begin

lemma anti_plurality_elect:
  shows "electoral_module (elector anti_plurality)"
proof(unfold anti_plurality.simps)
  show "electoral_module (elector (max_eliminator (scoring vector_anti_plurality)))"
     using scoring_mod_A by blast
qed

lemma anti_plurality_hom:
  shows "homogeneity (elector anti_plurality)" unfolding anti_plurality.simps
  using scoring_rules_homogeneity
  by blast

lemma anti_plurality_reinforcement:
  shows "reinforcement (elector anti_plurality)" unfolding anti_plurality.simps
  using scoring_module_rein
  by blast

end


(*  Title:      ZF/Resid/Redex.thy
    Author:     Ole Rasmussen, University of Cambridge
*)

theory Redex imports ZF begin
consts
  redexes     :: i

datatype
  "redexes" = Var ("n \<in> nat")
            | Fun ("t \<in> redexes")
            | App ("b \<in> bool","f \<in> redexes", "a \<in> redexes")

consts
  Ssub  :: "i"
  Scomp :: "i"
  Sreg  :: "i"

abbreviation
  Ssub_rel  (infixl \<open>\<Longleftarrow>\<close> 70) where
  "a \<Longleftarrow> b \<equiv> \<langle>a,b\<rangle> \<in> Ssub"

abbreviation
  Scomp_rel  (infixl \<open>\<sim>\<close> 70) where
  "a \<sim> b \<equiv> \<langle>a,b\<rangle> \<in> Scomp"

abbreviation
  "regular(a) \<equiv> a \<in> Sreg"

consts union_aux        :: "i\<Rightarrow>i"
primrec (*explicit lambda is required because both arguments of "\<squnion>" vary*)
  "union_aux(Var(n)) =
     (\<lambda>t \<in> redexes. redexes_case(\<lambda>j. Var(n), \<lambda>x. 0, \<lambda>b x y.0, t))"

  "union_aux(Fun(u)) =
     (\<lambda>t \<in> redexes. redexes_case(\<lambda>j. 0, \<lambda>y. Fun(union_aux(u)`y),
                                  \<lambda>b y z. 0, t))"

  "union_aux(App(b,f,a)) =
     (\<lambda>t \<in> redexes.
        redexes_case(\<lambda>j. 0, \<lambda>y. 0,
                     \<lambda>c z u. App(b or c, union_aux(f)`z, union_aux(a)`u), t))"

definition
  union  (infixl \<open>\<squnion>\<close> 70) where
  "u \<squnion> v \<equiv> union_aux(u)`v"

inductive
  domains       "Ssub" \<subseteq> "redexes*redexes"
  intros
    Sub_Var:     "n \<in> nat \<Longrightarrow> Var(n) \<Longleftarrow> Var(n)"
    Sub_Fun:     "\<lbrakk>u \<Longleftarrow> v\<rbrakk>\<Longrightarrow> Fun(u) \<Longleftarrow> Fun(v)"
    Sub_App1:    "\<lbrakk>u1 \<Longleftarrow> v1; u2 \<Longleftarrow> v2; b \<in> bool\<rbrakk>\<Longrightarrow>
                     App(0,u1,u2) \<Longleftarrow> App(b,v1,v2)"
    Sub_App2:    "\<lbrakk>u1 \<Longleftarrow> v1; u2 \<Longleftarrow> v2\<rbrakk>\<Longrightarrow> App(1,u1,u2) \<Longleftarrow> App(1,v1,v2)"
  type_intros    redexes.intros bool_typechecks

inductive
  domains       "Scomp" \<subseteq> "redexes*redexes"
  intros
    Comp_Var:    "n \<in> nat \<Longrightarrow> Var(n) \<sim> Var(n)"
    Comp_Fun:    "\<lbrakk>u \<sim> v\<rbrakk>\<Longrightarrow> Fun(u) \<sim> Fun(v)"
    Comp_App:    "\<lbrakk>u1 \<sim> v1; u2 \<sim> v2; b1 \<in> bool; b2 \<in> bool\<rbrakk>
                  \<Longrightarrow> App(b1,u1,u2) \<sim> App(b2,v1,v2)"
  type_intros    redexes.intros bool_typechecks

inductive
  domains       "Sreg" \<subseteq> redexes
  intros
    Reg_Var:     "n \<in> nat \<Longrightarrow> regular(Var(n))"
    Reg_Fun:     "\<lbrakk>regular(u)\<rbrakk>\<Longrightarrow> regular(Fun(u))"
    Reg_App1:    "\<lbrakk>regular(Fun(u)); regular(v)\<rbrakk>\<Longrightarrow>regular(App(1,Fun(u),v))"
    Reg_App2:    "\<lbrakk>regular(u); regular(v)\<rbrakk>\<Longrightarrow>regular(App(0,u,v))"
  type_intros    redexes.intros bool_typechecks

declare redexes.intros [simp]

(* ------------------------------------------------------------------------- *)
(*    Specialisation of comp-rules                                           *)
(* ------------------------------------------------------------------------- *)

lemmas compD1 [simp] = Scomp.dom_subset [THEN subsetD, THEN SigmaD1]
lemmas compD2 [simp] = Scomp.dom_subset [THEN subsetD, THEN SigmaD2]
lemmas regD [simp] = Sreg.dom_subset [THEN subsetD]

(* ------------------------------------------------------------------------- *)
(*    Equality rules for union                                               *)
(* ------------------------------------------------------------------------- *)

lemma union_Var [simp]: "n \<in> nat \<Longrightarrow> Var(n) \<squnion> Var(n)=Var(n)"
by (simp add: union_def)

lemma union_Fun [simp]: "v \<in> redexes \<Longrightarrow> Fun(u) \<squnion> Fun(v) = Fun(u \<squnion> v)"
by (simp add: union_def)

lemma union_App [simp]:
     "\<lbrakk>b2 \<in> bool; u2 \<in> redexes; v2 \<in> redexes\<rbrakk>
      \<Longrightarrow> App(b1,u1,v1) \<squnion> App(b2,u2,v2)=App(b1 or b2,u1 \<squnion> u2,v1 \<squnion> v2)"
by (simp add: union_def)

lemma or_1_right [simp]: "a or 1 = 1"
by (simp add: or_def cond_def)

lemma or_0_right [simp]: "a \<in> bool \<Longrightarrow> a or 0 = a"
by (simp add: or_def cond_def bool_def, auto)

declare Ssub.intros [simp]
declare bool_typechecks [simp]
declare Sreg.intros [simp]
declare Scomp.intros [simp]

declare Scomp.intros [intro]

inductive_cases [elim!]:
  "regular(App(b,f,a))"
  "regular(Fun(b))"
  "regular(Var(b))"
  "Fun(u) \<sim> Fun(t)"
  "u \<sim> Fun(t)"
  "u \<sim> Var(n)"
  "u \<sim> App(b,t,a)"
  "Fun(t) \<sim> v"
  "App(b,f,a) \<sim> v"
  "Var(n) \<sim> u"

(* ------------------------------------------------------------------------- *)
(*    comp proofs                                                            *)
(* ------------------------------------------------------------------------- *)

lemma comp_refl [simp]: "u \<in> redexes \<Longrightarrow> u \<sim> u"
by (erule redexes.induct, blast+)

lemma comp_sym: "u \<sim> v \<Longrightarrow> v \<sim> u"
by (erule Scomp.induct, blast+)

lemma comp_sym_iff: "u \<sim> v \<longleftrightarrow> v \<sim> u"
by (blast intro: comp_sym)

lemma comp_trans [rule_format]: "u \<sim> v \<Longrightarrow> \<forall>w. v \<sim> w\<longrightarrow>u \<sim> w"
by (erule Scomp.induct, blast+)

(* ------------------------------------------------------------------------- *)
(*   union proofs                                                            *)
(* ------------------------------------------------------------------------- *)

lemma union_l: "u \<sim> v \<Longrightarrow> u \<Longleftarrow> (u \<squnion> v)"
apply (erule Scomp.induct)
apply (erule_tac [3] boolE, simp_all)
done

lemma union_r: "u \<sim> v \<Longrightarrow> v \<Longleftarrow> (u \<squnion> v)"
apply (erule Scomp.induct)
apply (erule_tac [3] c = b2 in boolE, simp_all)
done

lemma union_sym: "u \<sim> v \<Longrightarrow> u \<squnion> v = v \<squnion> u"
by (erule Scomp.induct, simp_all add: or_commute)

(* ------------------------------------------------------------------------- *)
(*      regular proofs                                                       *)
(* ------------------------------------------------------------------------- *)

lemma union_preserve_regular [rule_format]:
     "u \<sim> v \<Longrightarrow> regular(u) \<longrightarrow> regular(v) \<longrightarrow> regular(u \<squnion> v)"
  by (erule Scomp.induct, auto)

end


theory weird_nat_mul3_same
imports Main
        "$HIPSTER_HOME/IsaHipster"
begin

datatype Nat = Z | S "Nat"

fun add3acc :: "Nat => Nat => Nat => Nat" where
"add3acc (Z) (Z) z = z"
| "add3acc (Z) (S y2) z = add3acc Z y2 (S z)"
| "add3acc (S x2) y z = add3acc x2 (S y) z"

fun mul3acc :: "Nat => Nat => Nat => Nat" where
"mul3acc (Z) y z = Z"
| "mul3acc (S x2) (Z) z = Z"
| "mul3acc (S x2) (S x3) (Z) = Z"
| "mul3acc (S (Z)) (S (Z)) (S (Z)) = S Z"
| "mul3acc (S (Z)) (S (Z)) (S (S x5)) =
     S (add3acc
          (mul3acc Z Z (S x5))
          (add3acc
             (mul3acc (S Z) Z (S x5)) (mul3acc Z (S Z) (S x5))
             (mul3acc Z Z (S Z)))
          (add3acc Z Z (S x5)))"
| "mul3acc (S (Z)) (S (S x6)) (S x4) =
     S (add3acc
          (mul3acc Z (S x6) x4)
          (add3acc
             (mul3acc (S Z) (S x6) x4) (mul3acc Z (S Z) x4)
             (mul3acc Z (S x6) (S Z)))
          (add3acc Z (S x6) x4))"
| "mul3acc (S (S x7)) (S x3) (S x4) =
     S (add3acc
          (mul3acc (S x7) x3 x4)
          (add3acc
             (mul3acc (S Z) x3 x4) (mul3acc (S x7) (S Z) x4)
             (mul3acc (S x7) x3 (S Z)))
          (add3acc (S x7) x3 x4))"

fun add3 :: "Nat => Nat => Nat => Nat" where
"add3 (Z) (Z) z = z"
| "add3 (Z) (S y2) z = S (add3 Z y2 z)"
| "add3 (S x2) y z = S (add3 x2 y z)"

fun mul3 :: "Nat => Nat => Nat => Nat" where
"mul3 (Z) y z = Z"
| "mul3 (S x2) (Z) z = Z"
| "mul3 (S x2) (S x3) (Z) = Z"
| "mul3 (S (Z)) (S (Z)) (S (Z)) = S Z"
| "mul3 (S (Z)) (S (Z)) (S (S x5)) =
     S (add3
          (mul3 Z Z (S x5))
          (add3 (mul3 (S Z) Z (S x5)) (mul3 Z (S Z) (S x5)) (mul3 Z Z (S Z)))
          (add3 Z Z (S x5)))"
| "mul3 (S (Z)) (S (S x6)) (S x4) =
     S (add3
          (mul3 Z (S x6) x4)
          (add3
             (mul3 (S Z) (S x6) x4) (mul3 Z (S Z) x4) (mul3 Z (S x6) (S Z)))
          (add3 Z (S x6) x4))"
| "mul3 (S (S x7)) (S x3) (S x4) =
     S (add3
          (mul3 (S x7) x3 x4)
          (add3
             (mul3 (S Z) x3 x4) (mul3 (S x7) (S Z) x4) (mul3 (S x7) x3 (S Z)))
          (add3 (S x7) x3 x4))"

(*hipster add3acc mul3acc add3 mul3 *)

theorem x0 :
  "!! (x :: Nat) (y :: Nat) (z :: Nat) .
     (mul3 x y z) = (mul3acc x y z)"
  by (tactic \<open>Subgoal.FOCUS_PARAMS (K (Tactic_Data.hard_tac @{context})) @{context} 1\<close>)

end


theory weird_nat_mul2_comm
imports Main
        "$HIPSTER_HOME/IsaHipster"
begin

datatype Nat = Z | S "Nat"

fun add3acc :: "Nat => Nat => Nat => Nat" where
"add3acc (Z) (Z) z = z"
| "add3acc (Z) (S y2) z = add3acc Z y2 (S z)"
| "add3acc (S x2) y z = add3acc x2 (S y) z"

fun mul2 :: "Nat => Nat => Nat" where
"mul2 (Z) y = Z"
| "mul2 (S z) (Z) = Z"
| "mul2 (S z) (S x2) = S (add3acc z x2 (mul2 z x2))"

(*hipster add3acc mul2 *)

theorem x0 :
  "!! (x :: Nat) (y :: Nat) . (mul2 x y) = (mul2 y x)"
  by (tactic \<open>Subgoal.FOCUS_PARAMS (K (Tactic_Data.hard_tac @{context})) @{context} 1\<close>)

end


(*
    Author:   Benedikt Seidl
    License:  BSD
*)

section \<open>Implementation of the DRA Construction\<close>

theory DRA_Implementation
imports
  DRA_Construction
  LTL.Rewriting
  Transition_Systems_and_Automata.DRA_Translate
begin

subsection \<open>Generating the Explicit Automaton\<close>

text \<open>
  We convert the implicit automaton to its explicit representation
  and afterwards proof the final correctness theorem and the overall
  size bound.
\<close>

definition dra_to_drai :: "('a, 'b) dra \<Rightarrow> 'a list \<Rightarrow> ('a, 'b) drai"
where
  "dra_to_drai \<AA> \<Sigma> = drai \<Sigma> (initial \<AA>) (transition \<AA>) (condition \<AA>)"

lemma dra_to_drai_language:
  "set \<Sigma> = alphabet \<AA> \<Longrightarrow> language (drai_dra (dra_to_drai \<AA> \<Sigma>)) = language \<AA>"
  by (simp add: dra_to_drai_def drai_dra_def)

definition drai_to_draei :: "nat \<Rightarrow> ('a, 'b :: hashable) drai \<Rightarrow> ('a, nat) draei"
where
  "drai_to_draei hms = to_draei_impl (=) bounded_hashcode_nat hms"

lemma dra_to_drai_rel:
  assumes
    "(\<Sigma>, alphabet A) \<in> \<langle>Id\<rangle> list_set_rel"
  shows
    "(dra_to_drai A \<Sigma>, A) \<in> \<langle>Id, Id\<rangle>drai_dra_rel"
proof -
  have "(A, A) \<in> \<langle>Id, Id\<rangle>dra_rel"
    by simp

  then have "(dra_to_drai A \<Sigma>, dra (alphabet A) (initial A) (transition A) (condition A)) \<in> \<langle>Id, Id\<rangle>drai_dra_rel"
    unfolding dra_to_drai_def using assms by parametricity

  then show ?thesis
    by simp
qed

lemma draei_language_rel:
  fixes
    A :: "('label, 'state :: hashable) dra"
  assumes
    "(\<Sigma>, alphabet A) \<in> \<langle>Id\<rangle> list_set_rel"
  and
    "finite (DRA.nodes A)"
  and
    "is_valid_def_hm_size TYPE('state) hms"
  shows
    "DRA.language (drae_dra (draei_drae (drai_to_draei hms (dra_to_drai A \<Sigma>)))) = DRA.language A"
proof -
  have "(dra_to_drai A \<Sigma>, A) \<in> \<langle>Id, Id\<rangle>drai_dra_rel"
    using dra_to_drai_rel assms by fast

  then have "(drai_to_draei hms (dra_to_drai A \<Sigma>), to_draei A) \<in> \<langle>Id_on (dra.alphabet A), rel (dra_to_drai A \<Sigma>) A (=) bounded_hashcode_nat hms\<rangle> draei_dra_rel"
    unfolding drai_to_draei_def
    using to_draei_impl_refine[unfolded autoref_tag_defs]
    by parametricity (simp_all add: assms is_bounded_hashcode_def bounded_hashcode_nat_bounds)

  then have "(DRA.language ((drae_dra \<circ> draei_drae) (drai_to_draei hms (dra_to_drai A \<Sigma>))), DRA.language (id (to_draei A))) \<in> \<langle>\<langle>Id_on (dra.alphabet A)\<rangle> stream_rel\<rangle> set_rel"
    by parametricity

  then show ?thesis
    by (simp add: to_draei_def)
qed

subsection \<open>Defining the Alphabet\<close>

fun atoms_ltlc_list :: "'a ltlc \<Rightarrow> 'a list"
where
  "atoms_ltlc_list true\<^sub>c = []"
| "atoms_ltlc_list false\<^sub>c = []"
| "atoms_ltlc_list prop\<^sub>c(q) = [q]"
| "atoms_ltlc_list (not\<^sub>c \<phi>) = atoms_ltlc_list \<phi>"
| "atoms_ltlc_list (\<phi> and\<^sub>c \<psi>) = List.union (atoms_ltlc_list \<phi>) (atoms_ltlc_list \<psi>)"
| "atoms_ltlc_list (\<phi> or\<^sub>c \<psi>) = List.union (atoms_ltlc_list \<phi>) (atoms_ltlc_list \<psi>)"
| "atoms_ltlc_list (\<phi> implies\<^sub>c \<psi>) = List.union (atoms_ltlc_list \<phi>) (atoms_ltlc_list \<psi>)"
| "atoms_ltlc_list (X\<^sub>c \<phi>) = atoms_ltlc_list \<phi>"
| "atoms_ltlc_list (F\<^sub>c \<phi>) = atoms_ltlc_list \<phi>"
| "atoms_ltlc_list (G\<^sub>c \<phi>) = atoms_ltlc_list \<phi>"
| "atoms_ltlc_list (\<phi> U\<^sub>c \<psi>) = List.union (atoms_ltlc_list \<phi>) (atoms_ltlc_list \<psi>)"
| "atoms_ltlc_list (\<phi> R\<^sub>c \<psi>) = List.union (atoms_ltlc_list \<phi>) (atoms_ltlc_list \<psi>)"
| "atoms_ltlc_list (\<phi> W\<^sub>c \<psi>) = List.union (atoms_ltlc_list \<phi>) (atoms_ltlc_list \<psi>)"
| "atoms_ltlc_list (\<phi> M\<^sub>c \<psi>) = List.union (atoms_ltlc_list \<phi>) (atoms_ltlc_list \<psi>)"

lemma atoms_ltlc_list_set:
  "set (atoms_ltlc_list \<phi>) = atoms_ltlc \<phi>"
  by (induction \<phi>) simp_all

lemma atoms_ltlc_list_distinct:
  "distinct (atoms_ltlc_list \<phi>)"
  by (induction \<phi>) simp_all

definition ltl_alphabet :: "'a list \<Rightarrow> 'a set list"
where
  "ltl_alphabet AP = map set (subseqs AP)"

subsection \<open>The Final Constant\<close>

text \<open>
  We require the quotient type to be hashable in order to efficiently explore the automaton.
\<close>

locale dra_implementation = dra_construction_size _ _ _ Abs
  for
    Abs :: "'a ltln \<Rightarrow> 'ltlq :: hashable"
begin

definition ltln_to_draei :: "'a list \<Rightarrow> 'a ltln \<Rightarrow> ('a set, nat) draei"
where
  "ltln_to_draei AP \<phi> = drai_to_draei (Suc (size \<phi>)) (dra_to_drai (ltl_to_dra_alphabet \<phi> (set AP)) (ltl_alphabet AP))"

definition ltlc_to_draei :: "'a ltlc \<Rightarrow> ('a set, nat) draei"
where
  "ltlc_to_draei \<phi> = ltln_to_draei (atoms_ltlc_list \<phi>) (simplify Slow (ltlc_to_ltln \<phi>))"

lemma ltl_to_dra_alphabet_rel:
  "distinct AP \<Longrightarrow> (ltl_alphabet AP, alphabet (ltl_to_dra_alphabet \<psi> (set AP))) \<in> \<langle>Id\<rangle> list_set_rel"
  unfolding ltl_to_dra_alphabet_alphabet ltl_alphabet_def
  by (simp add: list_set_rel_def in_br_conv subseqs_powset distinct_set_subseqs)

lemma ltlc_to_ltln_simplify_atoms:
  "atoms_ltln (simplify Slow (ltlc_to_ltln \<phi>)) \<subseteq> atoms_ltlc \<phi>"
  using ltlc_to_ltln_atoms simplify_atoms by fast

lemma valid_def_hm_size:
  "is_valid_def_hm_size TYPE('state) (Suc (size \<phi>))" for \<phi> :: "'a ltln"
  unfolding is_valid_def_hm_size_def
  using ltln.size_neq by auto

theorem final_correctness:
  "to_omega ` language (drae_dra (draei_drae (ltlc_to_draei \<phi>)))
    = language_ltlc \<phi> \<inter> {w. range w \<subseteq> Pow (atoms_ltlc \<phi>)}"
  unfolding ltlc_to_draei_def ltln_to_draei_def
  unfolding draei_language_rel[OF ltl_to_dra_alphabet_rel[OF atoms_ltlc_list_distinct] ltl_to_dra_alphabet_nodes_finite valid_def_hm_size]
  unfolding atoms_ltlc_list_set
  unfolding ltl_to_dra_alphabet_language[OF ltlc_to_ltln_simplify_atoms]
  unfolding ltlc_to_ltln_atoms language_ltln_def language_ltlc_def ltlc_to_ltln_semantics simplify_correct ..

end

end


theory Lappend_literates
  imports Main "$HIPSTER_HOME/IsaHipster"
    Lappend
    Literate
begin
setup Tactic_Data.set_coinduct_sledgehammer
setup Misc_Data.set_noisy

cohipster literate lappend
lemma lemma_af [thy_expl]: "lappend (literate z x2) y = literate z x2"
  by (coinduction arbitrary: x2 y z rule: Llist.Llist.coinduct_strong)
    auto
(* Discovered and proved in ca. 20 seconds,
   lemmas about lappend are also discovered but discarded before proving
   since they are already imported from Lappend.thy *)

end