section \<open>Completeness\<close>

theory Completeness imports Prover Semantics begin

subsection \<open>Hintikka Counter Model\<close>

locale Hintikka =
  fixes A B :: \<open>fm set\<close>
  assumes
    Basic: \<open>\<^bold>\<ddagger>P ts \<in> A \<Longrightarrow> \<^bold>\<ddagger>P ts \<in> B \<Longrightarrow> False\<close> and
    FlsA: \<open>\<^bold>\<bottom> \<notin> A\<close> and
    ImpA: \<open>p \<^bold>\<longrightarrow> q \<in> A \<Longrightarrow> p \<in> B \<or> q \<in> A\<close> and
    ImpB: \<open>p \<^bold>\<longrightarrow> q \<in> B \<Longrightarrow> p \<in> A \<and> q \<in> B\<close> and
    UniA: \<open>\<^bold>\<forall>p \<in> A \<Longrightarrow> \<forall>t. \<langle>t\<rangle>p \<in> A\<close> and
    UniB: \<open>\<^bold>\<forall>p \<in> B \<Longrightarrow> \<exists>t. \<langle>t\<rangle>p \<in> B\<close>

abbreviation \<open>M A \<equiv> \<lbrakk>\<^bold>#, \<^bold>\<dagger>, \<lambda>P ts. \<^bold>\<ddagger>P ts \<in> A\<rbrakk>\<close>

lemma id_tm [simp]: \<open>\<lparr>\<^bold>#, \<^bold>\<dagger>\<rparr> t = t\<close>
  by (induct t) (auto cong: map_cong)

lemma size_sub_fm [simp]: \<open>size (sub_fm s p) = size p\<close>
  by (induct p arbitrary: s) auto

theorem Hintikka_counter_model:
  assumes \<open>Hintikka A B\<close>
  shows \<open>(p \<in> A \<longrightarrow> M A p) \<and> (p \<in> B \<longrightarrow> \<not> M A p)\<close>
proof (induct p rule: wf_induct [where r=\<open>measure size\<close>])
  case 1
  then show ?case ..
next
  case (2 x)
  then show ?case
  proof (cases x; safe del: notI)
    case Falsity
    show \<open>\<^bold>\<bottom> \<in> A \<Longrightarrow> M A \<^bold>\<bottom>\<close> \<open>\<^bold>\<bottom> \<in> B \<Longrightarrow> \<not> M A \<^bold>\<bottom>\<close>
      using Hintikka.FlsA assms by simp_all
  next
    case (Pre P ts)
    show \<open>\<^bold>\<ddagger>P ts \<in> A \<Longrightarrow> M A (\<^bold>\<ddagger>P ts)\<close> \<open>\<^bold>\<ddagger>P ts \<in> B \<Longrightarrow> \<not> M A (\<^bold>\<ddagger>P ts)\<close>
      using Hintikka.Basic assms by (auto cong: map_cong)
  next
    case (Imp p q)
    show \<open>p \<^bold>\<longrightarrow> q \<in> A \<Longrightarrow> M A (p \<^bold>\<longrightarrow> q)\<close> \<open>p \<^bold>\<longrightarrow> q \<in> B \<Longrightarrow> \<not> M A (p \<^bold>\<longrightarrow> q)\<close>
      using assms Hintikka.ImpA[of A B p q] Hintikka.ImpB[of A B p q] Imp 2 by auto
  next
    case (Uni p)
    have \<open>\<langle>t\<rangle>p \<in> A \<Longrightarrow> M A (\<langle>t\<rangle>p)\<close> \<open>\<langle>t\<rangle>p \<in> B \<Longrightarrow> \<not> M A (\<langle>t\<rangle>p)\<close> for t
      using Uni 2 by (metis fm.size(8) in_measure lessI less_add_same_cancel1 size_sub_fm)+
    then show \<open>\<^bold>\<forall>p \<in> A \<Longrightarrow> M A (\<^bold>\<forall>p)\<close> \<open>\<^bold>\<forall>p \<in> B \<Longrightarrow> \<not> M A (\<^bold>\<forall>p)\<close>
      using assms Hintikka.UniA[of A B p] Hintikka.UniB[of A B p] by auto
  qed
qed

subsection \<open>Escape Paths Form Hintikka Sets\<close>

lemma sset_sdrop: \<open>sset (sdrop n s) \<subseteq> sset s\<close>
  by (induct n arbitrary: s) (auto intro: stl_sset in_mono)

lemma epath_sdrop: \<open>epath steps \<Longrightarrow> epath (sdrop n steps)\<close>
  by (induct n) (auto elim: epath.cases)

lemma eff_preserves_Pre:
  assumes \<open>effStep ((A, B), r) ss\<close> \<open>(A', B') |\<in>| ss\<close>
  shows \<open>(\<^bold>\<ddagger>P ts [\<in>] A \<Longrightarrow> \<^bold>\<ddagger>P ts [\<in>] A')\<close> \<open>\<^bold>\<ddagger>P ts [\<in>] B \<Longrightarrow> \<^bold>\<ddagger>P ts [\<in>] B'\<close>
  using assms by (induct r \<open>(A, B)\<close> rule: eff.induct) (auto split: if_splits)

lemma epath_eff:
  assumes \<open>epath steps\<close> \<open>effStep (shd steps) ss\<close>
  shows \<open>fst (shd (stl steps)) |\<in>| ss\<close>
  using assms by (auto elim: epath.cases)

abbreviation \<open>lhs s \<equiv> fst (fst s)\<close>
abbreviation \<open>rhs s \<equiv> snd (fst s)\<close>
abbreviation \<open>lhsd s \<equiv> lhs (shd s)\<close>
abbreviation \<open>rhsd s \<equiv> rhs (shd s)\<close>

lemma epath_Pre_sdrop:
  assumes \<open>epath steps\<close> shows
    \<open>\<^bold>\<ddagger>P ts [\<in>] lhs (shd steps) \<Longrightarrow> \<^bold>\<ddagger>P ts [\<in>] lhsd (sdrop m steps)\<close>
    \<open>\<^bold>\<ddagger>P ts [\<in>] rhs (shd steps) \<Longrightarrow> \<^bold>\<ddagger>P ts [\<in>] rhsd (sdrop m steps)\<close>
  using assms eff_preserves_Pre
  by (induct m arbitrary: steps) (simp; metis (no_types, lifting) epath.cases surjective_pairing)+

lemma Saturated_sdrop:
  assumes \<open>Saturated steps\<close>
  shows \<open>Saturated (sdrop n steps)\<close>
  using assms unfolding Saturated_def saturated_def by (simp add: alw_iff_sdrop)

definition treeA :: \<open>(sequent \<times> rule) stream \<Rightarrow> fm set\<close> where
  \<open>treeA steps \<equiv> \<Union>s \<in> sset steps. set (lhs s)\<close>

definition treeB :: \<open>(sequent \<times> rule) stream \<Rightarrow> fm set\<close> where
  \<open>treeB steps \<equiv> \<Union>s \<in> sset steps. set (rhs s)\<close>

lemma treeA_snth: \<open>p \<in> treeA steps \<Longrightarrow> \<exists>n. p [\<in>] lhsd (sdrop n steps)\<close>
  unfolding treeA_def using sset_range[of steps] by simp

lemma treeB_snth: \<open>p \<in> treeB steps \<Longrightarrow> \<exists>n. p [\<in>] rhsd (sdrop n steps)\<close>
  unfolding treeB_def using sset_range[of steps] by simp

lemma treeA_sdrop: \<open>treeA (sdrop n steps) \<subseteq> treeA steps\<close>
  unfolding treeA_def by (induct n) (simp, metis SUP_subset_mono order_refl sset_sdrop)

lemma treeB_sdrop: \<open>treeB (sdrop n steps) \<subseteq> treeB steps\<close>
  unfolding treeB_def by (induct n) (simp, metis SUP_subset_mono order_refl sset_sdrop)

lemma enabled_ex_taken:
  assumes \<open>epath steps\<close> \<open>Saturated steps\<close> \<open>enabled r (fst (shd steps))\<close>
  shows \<open>\<exists>k. takenAtStep r (shd (sdrop k steps))\<close>
  using assms unfolding Saturated_def saturated_def UNIV_rules by (auto simp: ev_iff_sdrop)

lemma Hintikka_epath:
  assumes \<open>epath steps\<close> \<open>Saturated steps\<close>
  shows \<open>Hintikka (treeA steps) (treeB steps)\<close>
proof
  fix P ts
  assume \<open>\<^bold>\<ddagger>P ts \<in> treeA steps\<close>
  then obtain m where m: \<open>\<^bold>\<ddagger>P ts [\<in>] lhsd (sdrop m steps)\<close>
    using treeA_snth by auto

  assume \<open>\<^bold>\<ddagger>P ts \<in> treeB steps\<close>
  then obtain k where k: \<open>\<^bold>\<ddagger>P ts [\<in>] rhsd (sdrop k steps)\<close>
    using treeB_snth by auto

  let ?j = \<open>m + k\<close>
  let ?jstep = \<open>shd (sdrop ?j steps)\<close>

  have \<open>\<^bold>\<ddagger>P ts [\<in>] lhs ?jstep\<close>
    using assms m epath_sdrop epath_Pre_sdrop by (metis (no_types, lifting) sdrop_add)
  moreover have \<open>\<^bold>\<ddagger>P ts [\<in>] rhs ?jstep\<close>
    using assms k epath_sdrop epath_Pre_sdrop by (metis (no_types, lifting) add.commute sdrop_add)
  ultimately have \<open>enabled (Axiom P ts) (fst ?jstep)\<close>
    unfolding enabled_def by (metis eff.simps(2) prod.exhaust_sel)
  then obtain j' where \<open>takenAtStep (Axiom P ts) (shd (sdrop j' steps))\<close>
    using enabled_ex_taken[OF epath_sdrop[OF assms(1)] Saturated_sdrop[OF assms(2)]] by auto
  then have \<open>eff (snd (shd (sdrop j' steps))) (fst (shd (sdrop j' steps))) = None\<close>
    using assms(1) epath_sdrop epath_eff
    by (metis (no_types, lifting) eff.simps(2) epath.simps equalsffemptyD surjective_pairing)
  then show False
    using assms(1) epath_sdrop by (metis epath.cases option.discI)
next
  show \<open>\<^bold>\<bottom> \<notin> treeA steps\<close>
  proof
    assume \<open>\<^bold>\<bottom> \<in> treeA steps\<close>
    then have \<open>\<exists>j. enabled FlsL (fst (shd (sdrop j steps)))\<close>
      unfolding enabled_def using treeA_snth by (metis eff.simps(3) prod.exhaust_sel sdrop_simps(1))
    then obtain j where \<open>takenAtStep FlsL (shd (sdrop j steps))\<close> (is \<open>takenAtStep _ (shd ?steps)\<close>)
      using enabled_ex_taken[OF epath_sdrop[OF assms(1)] Saturated_sdrop[OF assms(2)]] by auto
    then have \<open>eff (snd (shd ?steps)) (fst (shd ?steps)) = None\<close>
      using assms(1) epath_sdrop epath_eff
      by (metis (no_types, lifting) eff.simps(3) epath.simps equalsffemptyD surjective_pairing)
    then show False
      using assms(1) epath_sdrop by (metis epath.cases option.discI)
  qed
next
  fix p q
  assume \<open>p \<^bold>\<longrightarrow> q \<in> treeA steps\<close>
  then have \<open>\<exists>k. enabled (ImpL p q) (fst (shd (sdrop k steps)))\<close>
    unfolding enabled_def using treeA_snth by (metis eff.simps(5) prod.exhaust_sel sdrop_simps(1))
  then obtain j where \<open>takenAtStep (ImpL p q) (shd (sdrop j steps))\<close> (is \<open>takenAtStep _ (shd ?s)\<close>)
    using enabled_ex_taken[OF epath_sdrop[OF assms(1)] Saturated_sdrop[OF assms(2)]] by auto
  then have \<open>fst (shd (stl ?s)) |\<in>|
      {| (lhsd ?s [\<div>] (p \<^bold>\<longrightarrow> q), p # rhsd ?s), (q # lhsd ?s [\<div>] (p \<^bold>\<longrightarrow> q), rhsd ?s) |}\<close>
    using assms(1) epath_sdrop epath_eff
    by (metis (no_types, lifting) eff.simps(5) epath.cases option.distinct(1) prod.collapse)
  then have \<open>p [\<in>] rhs (shd (stl ?s)) \<or> q [\<in>] lhs (shd (stl ?s))\<close>
    by auto
  then have \<open>p \<in> treeB (stl ?s) \<or> q \<in> treeA (stl ?s)\<close>
    unfolding treeA_def treeB_def by (meson UN_I shd_sset)
  then show \<open>p \<in> treeB steps \<or> q \<in> treeA steps\<close>
    using treeA_sdrop treeB_sdrop by (metis sdrop_simps(2) subsetD)
next
  fix p q
  assume \<open>p \<^bold>\<longrightarrow> q \<in> treeB steps\<close>
  then have \<open>\<exists>k. enabled (ImpR p q) (fst (shd (sdrop k steps)))\<close>
    unfolding enabled_def using treeB_snth by (metis eff.simps(6) prod.exhaust_sel sdrop_simps(1))
  then obtain j where \<open>takenAtStep (ImpR p q) (shd (sdrop j steps))\<close> (is \<open>takenAtStep _ (shd ?s)\<close>)
    using enabled_ex_taken[OF epath_sdrop[OF assms(1)] Saturated_sdrop[OF assms(2)]] by auto
  then have \<open>fst (shd (stl ?s)) |\<in>| {| (p # lhsd ?s, q # rhsd ?s [\<div>] (p \<^bold>\<longrightarrow> q)) |}\<close>
    using assms(1) epath_sdrop epath_eff
    by (metis (no_types, lifting) eff.simps(6) epath.cases option.distinct(1) prod.collapse)
  then have \<open>p [\<in>] lhs (shd (stl ?s)) \<and> q [\<in>] rhs (shd (stl ?s))\<close>
    by auto
  then have \<open>p \<in> treeA (stl ?s) \<and> q \<in> treeB (stl ?s)\<close>
    unfolding treeA_def treeB_def by (meson UN_I shd_sset)
  then show \<open>p \<in> treeA steps \<and> q \<in> treeB steps\<close>
    using treeA_sdrop treeB_sdrop by (metis sdrop_simps(2) subsetD)
next
  fix p
  assume *: \<open>\<^bold>\<forall>p \<in> treeA steps\<close>
  show \<open>\<forall>t. \<langle>t\<rangle>p \<in> treeA steps\<close>
  proof
    fix t
    from * have \<open>\<exists>k. enabled (UniL t p) (fst (shd (sdrop k steps)))\<close>
      unfolding enabled_def using treeA_snth by (metis eff.simps(7) prod.exhaust_sel sdrop_simps(1))
    then obtain j where \<open>takenAtStep (UniL t p) (shd (sdrop j steps))\<close>(is \<open>takenAtStep _ (shd ?s)\<close>)
      using enabled_ex_taken[OF epath_sdrop[OF assms(1)] Saturated_sdrop[OF assms(2)]] by auto
    then have \<open>fst (shd (stl ?s)) |\<in>| {| (\<langle>t\<rangle>p # lhsd ?s, rhsd ?s) |}\<close>
      using assms(1) epath_sdrop epath_eff
      by (metis (no_types, lifting) eff.simps(7) epath.cases option.distinct(1) prod.collapse)
    then have \<open>\<langle>t\<rangle>p [\<in>] lhs (shd (stl ?s))\<close>
      by auto
    then have \<open>\<langle>t\<rangle>p \<in> treeA (stl ?s)\<close>
      unfolding treeA_def by (meson UN_I shd_sset)
    then show \<open>\<langle>t\<rangle>p \<in> treeA steps\<close>
      using treeA_sdrop by (metis sdrop_simps(2) subsetD)
  qed
next
  fix p
  assume *: \<open>\<^bold>\<forall>p \<in> treeB steps\<close>
  then have \<open>\<exists>k. enabled (UniR p) (fst (shd (sdrop k steps)))\<close>
    unfolding enabled_def using treeB_snth by (metis eff.simps(8) prod.exhaust_sel sdrop_simps(1))
  then obtain j where \<open>takenAtStep (UniR p) (shd (sdrop j steps))\<close>(is \<open>takenAtStep _ (shd ?s)\<close>)
    using enabled_ex_taken[OF epath_sdrop[OF assms(1)] Saturated_sdrop[OF assms(2)]] by auto
  then have \<open>fst (shd (stl ?s)) |\<in>|
        {| (lhsd ?s, \<langle>\<^bold>#(fresh (lhsd ?s @ rhsd ?s))\<rangle>p # rhsd ?s [\<div>] \<^bold>\<forall>p) |}\<close>
    using assms(1) epath_sdrop epath_eff
    by (metis (no_types, lifting) eff.simps(8) epath.cases option.distinct(1) prod.collapse)
  then have \<open>\<exists>t. \<langle>t\<rangle>p [\<in>] rhs (shd (stl ?s))\<close>
    by auto
  then have \<open>\<exists>t. \<langle>t\<rangle>p \<in> treeB (stl ?s)\<close>
    unfolding treeB_def by (meson UN_I shd_sset)
  then show \<open>\<exists>t. \<langle>t\<rangle>p \<in> treeB steps\<close>
    using treeB_sdrop by (metis sdrop_simps(2) subsetD)
qed

subsection \<open>Completeness\<close>

lemma fair_stream_rules: \<open>Fair_Stream.fair rules\<close>
  unfolding rules_def using fair_stream surj_rule_of_nat .

lemma fair_rules: \<open>fair rules\<close>
  using fair_stream_rules unfolding Fair_Stream.fair_def fair_def alw_iff_sdrop ev_holds_sset
  by (metis dual_order.refl le_Suc_ex sdrop_snth snth_sset)

lemma epath_prover:
  fixes A B :: \<open>fm list\<close>
  defines \<open>t \<equiv> prover (A, B)\<close>
  shows \<open>(fst (root t) = (A, B) \<and> wf t \<and> tfinite t) \<or>
    (\<exists>steps. fst (shd steps) = (A, B) \<and> epath steps \<and> Saturated steps)\<close> (is \<open>?A \<or> ?B\<close>)
proof -
  { assume \<open>\<not> ?A\<close>
    with assms have \<open>\<not> tfinite (mkTree rules (A, B))\<close>
      unfolding prover_def using wf_mkTree fair_rules by simp
    then obtain steps where \<open>ipath (mkTree rules (A, B)) steps\<close> using Konig by blast
    with assms have \<open>fst (shd steps) = (A, B) \<and> epath steps \<and> Saturated steps\<close>
      by (metis (no_types, lifting) fair_rules UNIV_I fst_conv ipath.cases
          ipath_mkTree_Saturated mkTree.simps(1) wf_ipath_epath wf_mkTree)
    then have ?B by blast
  }
  then show ?thesis by blast
qed

lemma epath_countermodel:
  assumes \<open>fst (shd steps) = (A, B)\<close> \<open>epath steps\<close> \<open>Saturated steps\<close>
  shows \<open>\<exists>(E :: _ \<Rightarrow> tm) F G. \<not> sc (E, F, G) (A, B)\<close>
proof -
  have \<open>Hintikka (treeA steps) (treeB steps)\<close> (is \<open>Hintikka ?A ?B\<close>)
    using assms Hintikka_epath assms by simp
  moreover have \<open>\<forall>p [\<in>] A. p \<in> ?A\<close> \<open>\<forall>p [\<in>] B. p \<in> ?B\<close>
    using assms shd_sset unfolding treeA_def treeB_def by fastforce+
  ultimately have \<open>\<forall>p [\<in>] A. M ?A p\<close> \<open>\<forall>p [\<in>] B. \<not> M ?A p\<close>
    using Hintikka_counter_model assms by blast+
  then show ?thesis
    by auto
qed

theorem prover_completeness:
  assumes \<open>\<forall>(E :: _ \<Rightarrow> tm) F G. sc (E, F, G) (A, B)\<close>
  defines \<open>t \<equiv> prover (A, B)\<close>
  shows \<open>fst (root t) = (A, B) \<and> wf t \<and> tfinite t\<close>
  using assms epath_prover epath_countermodel by blast

corollary
  assumes \<open>\<forall>(E :: _ \<Rightarrow> tm) F G. \<lbrakk>E, F, G\<rbrakk> p\<close>
  defines \<open>t \<equiv> prover ([], [p])\<close>
  shows \<open>fst (root t) = ([], [p]) \<and> wf t \<and> tfinite t\<close>
  using assms prover_completeness by simp

end


(* Authors: Simon Wimmer, Peter Lammich *)
theory Liveness_Subsumption
  imports
    Refine_Imperative_HOL.Sepref Worklist_Common TA_Library.Subsumption_Graphs
begin

context Search_Space_Nodes_Defs
begin

sublocale G: Subgraph_Node_Defs .

no_notation E ("_ \<rightarrow> _" [100, 100] 40)
notation G.E' ("_ \<rightarrow> _" [100, 100] 40)
no_notation reaches ("_ \<rightarrow>* _" [100, 100] 40)
notation G.G'.reaches ("_ \<rightarrow>* _" [100, 100] 40)
no_notation reaches1 ("_ \<rightarrow>\<^sup>+ _" [100, 100] 40)
notation G.G'.reaches1 ("_ \<rightarrow>\<^sup>+ _" [100, 100] 40)

text \<open>Plain set membership is also an option.\<close>
definition "check_loop v ST = (\<exists> v' \<in> set ST. v' \<preceq> v)"

definition dfs :: "'a set \<Rightarrow> (bool \<times> 'a set) nres" where
  "dfs P \<equiv> do {
    (P,ST,r) \<leftarrow> RECT (\<lambda>dfs (P,ST,v).
      do {
        if check_loop v ST then RETURN (P, ST, True)
        else do {
          if \<exists> v' \<in> P. v \<preceq> v' then
            RETURN (P, ST, False)
          else do {
              let ST = v # ST;
              (P, ST', r) \<leftarrow>
                FOREACHcd {v'. v \<rightarrow> v'} (\<lambda>(_,_,b). \<not>b) (\<lambda>v' (P,ST,_). dfs (P,ST,v')) (P,ST,False);
              ASSERT (ST' = ST);
              let ST = tl ST';
              let P = insert v P;
              RETURN (P, ST, r)
            }
        }
      }
    ) (P,[],a\<^sub>0);
    RETURN (r, P)
  }"

definition liveness_compatible where "liveness_compatible P \<equiv>
    (\<forall> x x' y. x \<rightarrow> y \<and> x' \<in> P \<and> x \<preceq> x' \<longrightarrow> (\<exists> y' \<in> P. y \<preceq> y')) \<and>
    (\<forall> s' \<in> P. \<forall> s. s \<preceq> s' \<and> V s \<longrightarrow>
      \<not> (\<lambda> x y. x \<rightarrow> y \<and> (\<exists> x' \<in> P. \<exists> y' \<in> P. x \<preceq> x' \<and> y \<preceq> y'))\<^sup>+\<^sup>+ s s)
    "

definition "dfs_spec \<equiv>
  SPEC (\<lambda> (r, P).
    (r \<longrightarrow> (\<exists> x. a\<^sub>0 \<rightarrow>* x \<and> x \<rightarrow>\<^sup>+ x))
  \<and> (\<not> r \<longrightarrow> \<not> (\<exists> x. a\<^sub>0 \<rightarrow>* x \<and> x \<rightarrow>\<^sup>+ x)
      \<and> liveness_compatible P \<and> P \<subseteq> {x. V x}
    )
  )"

end (* Search Space Defs *)

locale Liveness_Search_Space_pre =
  Search_Space_Nodes +
  assumes finite_V: "finite {a. V a}"
begin

lemma check_loop_loop: "\<exists> v' \<in> set ST. v' \<preceq> v" if "check_loop v ST"
  using that unfolding check_loop_def by blast

lemma check_loop_no_loop: "v \<notin> set ST" if "\<not> check_loop v ST"
  using that unfolding check_loop_def by blast

lemma mono:
  "a \<preceq> b \<Longrightarrow> a \<rightarrow> a' \<Longrightarrow> V b \<Longrightarrow> \<exists> b'. b \<rightarrow> b' \<and> a' \<preceq> b'"
  by (auto dest: mono simp: G.E'_def)

context
  fixes P :: "'a set" and E1 E2 :: "'a \<Rightarrow> 'a \<Rightarrow> bool" and v :: 'a
  defines [simp]: "E1 \<equiv> \<lambda>x y. x \<rightarrow> y \<and> (\<exists>x'\<in>P. x \<preceq> x') \<and> (\<exists>x\<in>P. y \<preceq> x)"
  defines [simp]: "E2 \<equiv> \<lambda>x y. x \<rightarrow> y \<and> (x \<preceq> v \<or> (\<exists>xa\<in>P. x \<preceq> xa)) \<and> (y \<preceq> v \<or> (\<exists>x\<in>P. y \<preceq> x))"
begin

interpretation G:  Graph_Defs E1  .
interpretation G': Graph_Defs E2 .
interpretation SG: Subgraph E2 E1 by standard auto
interpretation SG': Subgraph_Start E a\<^sub>0 E1 by standard auto
interpretation SG'': Subgraph_Start E a\<^sub>0 E2 by standard auto

(* XXX Generalize *)
lemma G_subgraph_reaches[intro]:
  "G.G'.reaches a b" if "G.reaches a b"
  using that by induction auto

(* XXX Generalize *)
lemma G'_subgraph_reaches[intro]:
  "G.G'.reaches a b" if "G'.reaches a b"
  using that by induction auto

lemma liveness_compatible_extend:
  assumes
    "V s" "V v" "s \<preceq> v"
    "liveness_compatible P"
    "\<forall>va. v \<rightarrow> va \<longrightarrow> (\<exists>x\<in>P. va \<preceq> x)"
    "E2\<^sup>+\<^sup>+ s s"
  shows False
proof -
  include graph_automation_aggressive
  have 1: "\<exists> b' \<in> P. b \<preceq> b'" if "G.reaches a b" "a \<preceq> a'" "a' \<in> P" for a a' b
    using that by cases auto
  have 2: "E1 a b" if "a \<rightarrow> b" "a \<preceq> a'" "a' \<in> P" "V a" for a a' b
    using assms(4) that unfolding liveness_compatible_def by auto
  from assms(6) have "E2\<^sup>+\<^sup>+ s s"
    by auto
  have 4: "G.reaches a b" if "G'.reaches a b" "a \<preceq> a'" "a' \<in> P" "V a" for a a' b
    using that
  proof induction
    case base
    then show ?case
      by blast
  next
    case (step b c)
    then have "G.reaches a b"
      by auto
    from \<open>V a\<close> \<open>G.reaches a b\<close> have "V b"
      including subgraph_automation by blast
    from \<open>G.reaches a b\<close> \<open>a \<preceq> a'\<close> \<open>a' \<in> P\<close> obtain b' where "b' \<in> P" "b \<preceq> b'"
      by (fastforce dest: 1)
    with \<open>E2 b c\<close> \<open>V b\<close> have "E1 b c"
      by (fastforce intro: 2)
    with \<open>G.reaches a b\<close> show ?case
      by blast
  qed
  from \<open>E2\<^sup>+\<^sup>+ s s\<close> obtain x where "E2 s x" "G'.reaches x s"
    by atomize_elim blast (* XXX *)
  then have "s \<rightarrow> x"
    by auto
  with \<open>s \<preceq> v\<close> \<open>V s\<close> \<open>V v\<close> obtain x' where "v \<rightarrow> x'" "x \<preceq> x'"
    by (auto dest: mono)
  with assms(5) obtain x'' where "x \<preceq> x''" "x'' \<in> P"
    by (auto intro: order_trans)
  from 4[OF \<open>G'.reaches x s\<close> \<open>x \<preceq> x''\<close> \<open>x'' \<in> P\<close>] \<open>s \<rightarrow> x\<close> \<open>V s\<close> have "G.reaches x s"
    including subgraph_automation by blast
  with \<open>x \<preceq> x''\<close> \<open>x'' \<in> P\<close> obtain s' where "s \<preceq> s'" "s' \<in> P"
    by (blast dest: 1)
  with \<open>s \<rightarrow> x\<close> \<open>x \<preceq> x''\<close> \<open>x'' \<in> P\<close> have "E1 s x"
    by auto
  with \<open>G.reaches x s\<close> have "G.reaches1 s s"
    by blast
  with assms(4) \<open>s' \<in> P\<close> \<open>s \<preceq> s'\<close> \<open>V s\<close> show False
    unfolding liveness_compatible_def by auto
qed

lemma liveness_compatible_extend':
  assumes
    "V s" "V v" "s \<preceq> s'" "s' \<in> P"
    "\<forall>va. v \<rightarrow> va \<longrightarrow> (\<exists>x\<in>P. va \<preceq> x)"
    "liveness_compatible P"
    "E2\<^sup>+\<^sup>+ s s"
  shows False
proof -
  show ?thesis
  proof (cases "G.reaches1 s s")
    case True
    with assms show ?thesis
      unfolding liveness_compatible_def by auto
  next
    case False
    with SG.non_subgraph_cycle_decomp[of s s] assms(7) obtain c d where **:
      "G'.reaches s c" "E2 c d" "\<not> E1 c d" "G'.reaches d s"
      by auto
    from \<open>E2 c d\<close> \<open>\<not> E1 c d\<close> have "c \<preceq> v \<or> d \<preceq> v"
      by auto
    with \<open>V s\<close> ** obtain v' where "G'.reaches1 v' v'" "v' \<preceq> v" "V v'"
      apply atomize_elim
      apply (erule disjE)
      subgoal
        including graph_automation_aggressive
        by (blast intro: rtranclp_trans G.subgraphI) (* XXX Fix automation *)
      subgoal
        unfolding G'.reaches1_reaches_iff2
        by (blast intro: rtranclp_trans intro: G.subgraphI) (* XXX Fix automation *)
      done
    with assms show ?thesis
      by (auto intro: liveness_compatible_extend)
  qed
qed

end (* Edge sets restricted to passed set *)

lemma liveness_compatible_cycle_start:
  assumes
    "liveness_compatible P" "a \<rightarrow>* x" "x \<rightarrow>\<^sup>+ x" "a \<preceq> s" "s \<in> P"
  shows False
proof -
  include graph_automation_aggressive
  have *: "\<exists> y \<in> P. x \<preceq> y" if "G.G'.reaches a x" for x
    using that assms unfolding liveness_compatible_def by induction auto
  have **:
    "(\<lambda>x y. x \<rightarrow> y \<and> (\<exists>x'\<in>P. x \<preceq> x') \<and> (\<exists>x\<in>P. y \<preceq> x))\<^sup>+\<^sup>+ a' b \<longleftrightarrow> a' \<rightarrow>\<^sup>+ b "
    if "a \<rightarrow>* a'" for a' b
    apply standard
    subgoal
      by (induction rule: tranclp_induct; blast)
    subgoal
      using \<open>a \<rightarrow>* a'\<close>
      apply - apply (induction rule: tranclp.induct)
      subgoal for a' b'
        by (auto intro: *)
      by (rule tranclp.intros(2), auto intro: *)
    done
  from assms show ?thesis
    unfolding liveness_compatible_def by clarsimp (blast dest: * ** intro: G.subgraphI)
qed

lemma liveness_compatible_inv:
  assumes "V v" "liveness_compatible P" "\<forall>va. v \<rightarrow> va \<longrightarrow> (\<exists>x\<in>P. va \<preceq> x)"
  shows "liveness_compatible (insert v P)"
  using assms
  apply (subst liveness_compatible_def)
  apply safe
     apply clarsimp_all
     apply (meson mono order_trans; fail)
    apply (subst (asm) liveness_compatible_def, meson; fail)
  by (blast intro: liveness_compatible_extend liveness_compatible_extend')+

interpretation subsumption: Subsumption_Graph_Pre_Nodes "(\<preceq>)" "(\<prec>)" E V
  by standard (drule mono, auto simp: Subgraph_Node_Defs.E'_def)

lemma pre_cycle_cycle:
  "(\<exists> x x'. a\<^sub>0 \<rightarrow>* x \<and> x \<rightarrow>\<^sup>+ x' \<and> x \<preceq> x') \<longleftrightarrow> (\<exists> x. a\<^sub>0 \<rightarrow>* x \<and> x \<rightarrow>\<^sup>+ x)"
  by (meson G.E'_def G.G'.reaches1_reaches_iff1 subsumption.pre_cycle_cycle_reachable finite_V)

lemma reachable_alt:
  "V v" if "V a\<^sub>0" "a\<^sub>0 \<rightarrow>* v"
  using that(2,1) by cases (auto simp: G.E'_def)

lemma dfs_correct:
  "dfs P \<le> dfs_spec" if "V a\<^sub>0" "liveness_compatible P" "P \<subseteq> {x. V x}"
proof -

  define rpre where "rpre \<equiv> \<lambda>(P,ST,v).
        a\<^sub>0 \<rightarrow>* v
      \<and> V v
      \<and> P \<subseteq> {x. V x}
      \<and> set ST \<subseteq> {x. a\<^sub>0 \<rightarrow>* x}
      \<and> set ST \<subseteq> {x. V x}
      \<and> liveness_compatible P
      \<and> (\<forall> s \<in> set ST. s \<rightarrow>\<^sup>+ v)
      \<and> distinct ST
    "

  define rpost where "rpost \<equiv> \<lambda>(P,ST,v) (P',ST',r).
    (r \<longrightarrow> (\<exists> x x'. a\<^sub>0 \<rightarrow>* x \<and> x \<rightarrow>\<^sup>+ x' \<and> x \<preceq> x') \<and> ST' = ST) \<and>
    (\<not> r \<longrightarrow>
      P \<subseteq> P'
      \<and> P' \<subseteq> {x. V x}
      \<and> set ST \<subseteq> {x. a\<^sub>0 \<rightarrow>* x}
      \<and> ST' = ST
      \<and> (\<forall> s \<in> set ST. s \<rightarrow>* v)
      \<and> liveness_compatible P'
      \<and> (\<exists> v' \<in> P'. v \<preceq> v')
      \<and> distinct ST
      )
      "

  define inv where "inv \<equiv> \<lambda> P ST v (_ :: 'a set) it (P', ST', r).
    (r \<longrightarrow> (\<exists> x x'. a\<^sub>0 \<rightarrow>* x \<and> x \<rightarrow>\<^sup>+ x' \<and> x \<preceq> x') \<and> ST' = ST) \<and>
    (\<not> r \<longrightarrow>
        P \<subseteq> P'
      \<and> P' \<subseteq> {x. V x}
      \<and> set ST \<subseteq> {x. a\<^sub>0 \<rightarrow>* x}
      \<and> ST' = ST
      \<and> (\<forall> s \<in> set ST. s \<rightarrow>* v)
      \<and> set ST \<subseteq> {x. V x}
      \<and> liveness_compatible P'
      \<and> (\<forall> v \<in> {v'. v \<rightarrow> v'} - it. (\<exists> v' \<in> P'. v \<preceq> v'))
      \<and> distinct ST
    )
  "

  define Termination :: "(('a set \<times> 'a list \<times> 'a) \<times> 'a set \<times> 'a list \<times> 'a) set" where
    "Termination = inv_image (finite_psupset {x. V x}) (\<lambda> (a,b,c). set b)"

  have rpre_init: "rpre (P, [], a\<^sub>0)"
    unfolding rpre_def using \<open>V a\<^sub>0\<close> \<open>liveness_compatible P\<close> \<open>P \<subseteq> _\<close> by auto

  have wf: "wf Termination"
    unfolding Termination_def by (blast intro: finite_V)

  have successors_finite: "finite {v'. v \<rightarrow> v'}" for v
    using finite_V unfolding G.E'_def by auto

  show ?thesis
    unfolding dfs_def dfs_spec_def
    apply (refine_rcg refine_vcg)
    apply (rule order.trans)
     apply(rule RECT_rule[where
          pre = rpre and
          V = Termination and
          M = "\<lambda>x. SPEC (rpost x)"
          ])

      (* Trimono *)
      subgoal
        unfolding FOREACHcd_def by refine_mono

      (* Termination *)
       apply (rule wf; fail)

      (* Precondition holds initially *)
      apply (rule rpre_init; fail)

     defer

    (* The postcondition establishes the specification *)
    subgoal
      apply refine_vcg
      unfolding rpost_def pre_cycle_cycle
      including graph_automation
      by (auto dest: liveness_compatible_cycle_start)

    apply (thin_tac "_ = f")

    (* Pre \<longrightarrow> Post *)
    apply refine_vcg

    (*
    (* Assertion *)
    subgoal for f x a b aa ba
      unfolding rpre_def by auto

    (* Assertion *)
    subgoal for f x a b aa ba
      unfolding rpre_def by auto
    *)

    (* Cycle found *)
    subgoal for f x a b aa ba
      by (subst rpost_def, subst (asm) (2) rpre_def, auto 4 4 dest: check_loop_loop)

    (* Subsumption *)
    subgoal for f x P b ST v
      by (subst rpost_def, subst (asm) (2) rpre_def, force)

    (* Foreach *)
    subgoal for f x P b ST v

      thm nfoldli_rule
      apply (refine_vcg
          FOREACHcd_rule[where I = "inv P (v # ST) v"]
          )
         apply clarsimp_all
        (*
      (* Finitely Branching *)
      subgoal
        thm succs_correct
        apply (auto intro: successors_finite simp: rpre_def rpost_def succs_correct)
          apply (subst succs_correct)
          oops
*)

      (* Finitely Branching *)
      subgoal
        by (auto intro: successors_finite)

      (* Pre \<longrightarrow> Invariant *)
      subgoal
        using \<open>V a\<^sub>0\<close>
        by (
          subst (asm) (2) rpre_def, subst inv_def,
          auto dest: check_loop_no_loop
        )

      (* Invariant *)
      subgoal for _ it v' P' ST' c
        apply (rule order.trans)
         apply rprems

        (* Inv \<longrightarrow> Pre *)
        subgoal
          apply (subst rpre_def, subst (asm) inv_def)
          apply clarsimp
          subgoal premises prems
          proof -
            from prems \<open>V a\<^sub>0\<close> have "v \<rightarrow> v'"
              by auto
            with prems show ?thesis
              by (auto intro: G.E'_V2)
          qed
          done

        (* Termination *)
        subgoal
          using \<open>V a\<^sub>0\<close> unfolding Termination_def
          by (auto simp: finite_psupset_def inv_def intro: G.subgraphI)

        (* Post \<longrightarrow> Inv *)
        subgoal
          apply (subst inv_def, subst (asm) inv_def, subst rpost_def)
          apply (clarsimp simp: it_step_insert_iff)
          by (safe; (intro exI conjI)?; (blast intro: rtranclp_trans))

        done

      (* Cycle \<longrightarrow> Assertion *)
      subgoal
        by (subst (asm) inv_def, simp)

      (* Cycle \<longrightarrow> Post *)
      subgoal for P' ST' c
        using \<open>V a\<^sub>0\<close> by (subst rpost_def, subst (asm) inv_def, auto)

      (* No cycle \<longrightarrow> Assertion *)
      subgoal
        by (subst (asm) inv_def, simp)

      (* No cycle \<longrightarrow> Post *)
      subgoal for P' ST'
        using \<open>V a\<^sub>0\<close>
        by (subst rpost_def, subst (asm) inv_def, auto intro: liveness_compatible_inv G.subgraphI)

      done
    done
qed

end (* Search Space Finite Strict *)

locale Liveness_Search_Space_Defs =
  Search_Space_Nodes_Defs +
  fixes succs :: "'a \<Rightarrow> 'a list"
begin

definition dfs1 :: "'a set \<Rightarrow> (bool \<times> 'a set) nres" where
  "dfs1 P \<equiv> do {
    (P,ST,r) \<leftarrow> RECT (\<lambda>dfs (P,ST,v).
      do {
        ASSERT (V v \<and> set ST \<subseteq> {x. V x});
        if check_loop v ST then RETURN (P, ST, True)
        else do {
          if \<exists> v' \<in> P. v \<preceq> v' then
            RETURN (P, ST, False)
          else do {
              let ST = v # ST;
              (P, ST', r) \<leftarrow>
                nfoldli (succs v) (\<lambda>(_,_,b). \<not>b) (\<lambda>v' (P,ST,_). dfs (P,ST,v')) (P,ST,False);
              ASSERT (ST' = ST);
              let ST = tl ST';
              let P = insert v P;
              RETURN (P, ST, r)
            }
        }
      }
    ) (P,[],a\<^sub>0);
    RETURN (r, P)
  }"

end (* Liveness Search Space Defs *)

locale Liveness_Search_Space =
  Liveness_Search_Space_Defs +
  Liveness_Search_Space_pre +
  assumes succs_correct: "V a \<Longrightarrow> set (succs a) = {x. a \<rightarrow> x}"
  assumes finite_V: "finite {a. V a}"
begin

(* XXX
  The following complications only arise because we add the assertion in this refinement step.
*)
lemma succs_ref[refine]:
  "(succs a, succs b) \<in> \<langle>Id\<rangle>list_rel" if "(a, b) \<in> Id"
  using that by auto

lemma start_ref[refine]:
  "((P, [], a\<^sub>0), P, [], a\<^sub>0) \<in> Id \<times>\<^sub>r br id (\<lambda> xs. set xs \<subseteq> {x. V x}) \<times>\<^sub>r br id V" if "V a\<^sub>0"
  using that by (auto simp: br_def)

lemma refine_aux[refine]:
  "((x, x1c, True), x', x1a, True) \<in> Id \<times>\<^sub>r br id (\<lambda>xs. set xs \<subseteq> Collect V) \<times>\<^sub>r Id"
  if "(x1c, x1a) \<in> br id (\<lambda>xs. set xs \<subseteq> {x. V x})" "(x, x') \<in> Id"
  using that by auto

lemma refine_loop:
  "(\<And>x x'. (x, x') \<in> Id \<times>\<^sub>r br id (\<lambda>xs. set xs \<subseteq> {x. V x}) \<times>\<^sub>r br id V \<Longrightarrow>
            dfs' x \<le> \<Down> (Id \<times>\<^sub>r br id (\<lambda>xs. set xs \<subseteq> Collect V) \<times>\<^sub>r bool_rel) (dfsa x')) \<Longrightarrow>
   (x, x') \<in> Id \<times>\<^sub>r br id (\<lambda>xs. set xs \<subseteq> {x. V x}) \<times>\<^sub>r br id V \<Longrightarrow>
   x2 = (x1a, x2a) \<Longrightarrow>
   x' = (x1, x2) \<Longrightarrow>
   x2b = (x1c, x2c) \<Longrightarrow>
   x = (x1b, x2b) \<Longrightarrow>
   nfoldli (succs x2c) (\<lambda>(_, _, b). \<not> b) (\<lambda>v' (P, ST, _). dfs' (P, ST, v')) (x1b, x2c # x1c, False)
   \<le> \<Down> (Id \<times>\<^sub>r br id (\<lambda>xs. set xs \<subseteq> {x. V x}) \<times>\<^sub>r bool_rel)
       (FOREACHcd {v'. x2a \<rightarrow> v'} (\<lambda>(_, _, b). \<not> b)
          (\<lambda>v' (P, ST, _). dfsa (P, ST, v')) (x1, x2a # x1a, False))"
  apply (subgoal_tac "(succs x2c, succs x2a) \<in> \<langle>br id V\<rangle>list_rel")

  unfolding FOREACHcd_def
   apply refine_rcg
   apply (rule rhs_step_bind_SPEC)
    apply (rule succs_correct)
    apply (auto simp: br_def; fail)
   apply (erule nfoldli_refine)
     apply (auto simp: br_def; fail)
    apply (auto simp: br_def; fail)
   apply (auto simp: br_def; fail)
  unfolding br_def list_rel_def
  by (simp, rule list.rel_refl_strong, auto intro: G.E'_V2 simp: succs_correct)

lemma dfs1_dfs_ref[refine]:
  "dfs1 P \<le> \<Down> Id (dfs P)" if "V a\<^sub>0"
  using that unfolding dfs1_def dfs_def
  apply refine_rcg
            apply (auto simp: br_def; fail)+
     apply (rule refine_loop; assumption)
  by (auto simp: br_def)

end (* Liveness Search Space *)

end (* Theory *)


(* Author: Joshua Schneider, ETH Zurich *)

subsection \<open>Lists\<close>

theory Applicative_List imports
  Applicative
  "~~/src/Tools/Adhoc_Overloading"
begin

definition "ap_list fs xs = List.bind fs (\<lambda>f. List.bind xs (\<lambda>x. [f x]))"

adhoc_overloading Applicative.ap ap_list

lemma Nil_ap[simp]: "ap_list [] xs = []"
unfolding ap_list_def by simp

lemma ap_Nil[simp]: "ap_list fs [] = []"
unfolding ap_list_def by (induction fs) simp_all

lemma ap_list_transfer[transfer_rule]:
  "rel_fun (list_all2 (rel_fun A B)) (rel_fun (list_all2 A) (list_all2 B)) ap_list ap_list"
unfolding ap_list_def[abs_def] List.bind_def
by transfer_prover

context begin interpretation applicative_syntax .

lemma cons_ap_list: "(f # fs) \<diamondop> xs = map f xs @ fs \<diamondop> xs"
unfolding ap_list_def by (induction xs) simp_all

lemma append_ap_distrib: "(fs @ gs) \<diamondop> xs = fs \<diamondop> xs @ gs \<diamondop> xs"
unfolding ap_list_def by (induction fs) simp_all

applicative list
for
  pure: "\<lambda>x. [x]"
  ap: ap_list
  rel: list_all2
  set: set
proof -
  fix x :: "'a list"
  show "[\<lambda>x. x] \<diamondop> x = x" unfolding ap_list_def by (induction x) simp_all
next
  fix g :: "('b \<Rightarrow> 'c) list" and f :: "('a \<Rightarrow> 'b) list" and x
  let ?B = "\<lambda>g f x. g (f x)"
  show "[?B] \<diamondop> g \<diamondop> f \<diamondop> x = g \<diamondop> (f \<diamondop> x)"
  proof (induction g)
    case Nil show ?case by simp
  next
    case (Cons g gs)
    have g_comp: "[?B g] \<diamondop> f \<diamondop> x = [g] \<diamondop> (f \<diamondop> x)"
    proof (induction f)
      case Nil show ?case by simp
    next
      case (Cons f fs)
      have "[?B g] \<diamondop> (f # fs) \<diamondop> x = [g] \<diamondop> ([f] \<diamondop> x) @ [?B g] \<diamondop> fs \<diamondop> x"
        by (simp add: cons_ap_list)
      also have "... = [g] \<diamondop> ([f] \<diamondop> x) @ [g] \<diamondop> (fs \<diamondop> x)" using Cons.IH ..
      also have "... = [g] \<diamondop> ((f # fs) \<diamondop> x)" by (simp add: cons_ap_list)
      finally show ?case .
    qed
    have "[?B] \<diamondop> (g # gs) \<diamondop> f \<diamondop> x = [?B g] \<diamondop> f \<diamondop> x @ [?B] \<diamondop> gs \<diamondop> f \<diamondop> x"
      by (simp add: cons_ap_list append_ap_distrib)
    also have "... = [g] \<diamondop> (f \<diamondop> x) @ gs \<diamondop> (f \<diamondop> x)" using g_comp Cons.IH by simp
    also have "... = (g # gs) \<diamondop> (f \<diamondop> x)" by (simp add: cons_ap_list)
    finally show ?case .
  qed
next
  fix f :: "('a \<Rightarrow> 'b) list" and x
  show "f \<diamondop> [x] = [\<lambda>f. f x] \<diamondop> f" unfolding ap_list_def by simp
next
  fix R :: "'a \<Rightarrow> 'b \<Rightarrow> bool"
  show "rel_fun R (list_all2 R) (\<lambda>x. [x]) (\<lambda>x. [x])" by transfer_prover
next
  fix R and f :: "('a \<Rightarrow> 'b) list" and g :: "('a \<Rightarrow> 'c) list" and x
  assume [transfer_rule]: "list_all2 (rel_fun (eq_on (set x)) R) f g"
  have [transfer_rule]: "list_all2 (eq_on (set x)) x x" by (simp add: list_all2_same)
  show "list_all2 R (f \<diamondop> x) (g \<diamondop> x)" by transfer_prover
qed (simp add: cons_ap_list)

lemma map_ap_conv[applicative_unfold]: "map f x = [f] \<diamondop> x"
unfolding ap_list_def List.bind_def
by simp

end

end


(*
   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 \<open>P \<longmapsto>a<b> \<prec> P'\<close> have "(supp P') - {b} \<subseteq> supp P" by(rule inputSupportDerivative)
  moreover from \<open>Q \<longmapsto> a[b] \<prec> Q'\<close> have "((supp Q')::name set) \<subseteq> supp Q" by(rule outputSupportDerivative)
  moreover from \<open>Q \<longmapsto> a[b] \<prec> Q'\<close> 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 \<open>P \<longmapsto> a[b] \<prec> P'\<close> have "((supp P')::name set) \<subseteq> supp P" by(rule outputSupportDerivative)
  moreover from \<open>Q \<longmapsto>a<b> \<prec> Q'\<close> have "(supp Q') - {b} \<subseteq> supp Q" by(rule inputSupportDerivative)
  moreover from \<open>P \<longmapsto> a[b] \<prec> P'\<close> 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 \<open>y \<sharp> P\<close> have "y \<sharp> P'''" by(rule freshChain)
  with P'''Trans have "y \<sharp> P''" using \<open>y \<noteq> x\<close> 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 \<open>P = P'''\<close> 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 \<open>P \<noteq> P'''\<close> 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 \<open>P = P'''\<close> 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 \<open>P \<noteq> P'''\<close> 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 \<open>P = P'''\<close> \<open>a \<noteq> b\<close> 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 \<open>a \<noteq> b\<close> \<open>P \<noteq> P'''\<close> 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 \<open>P = P'''\<close> \<open>a \<noteq> b\<close> 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 \<open>a \<noteq> b\<close> \<open>P \<noteq> P'''\<close> 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 \<open>a \<noteq> b\<close> 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 \<open>P = P'''\<close> 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 \<open>P \<noteq> P'''\<close> 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 \<open>P = P'''\<close> 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 \<open>P \<noteq> P'''\<close> 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 \<open>Q = Q'''\<close> 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 \<open>Q \<noteq> Q'''\<close> 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 \<open>Q = Q'''\<close> 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 \<open>Q \<noteq> Q'''\<close> 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 \<open>x \<sharp> Q\<close> 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 \<open>x \<sharp> P\<close> 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 \<open>x \<sharp> P\<close> 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 \<open>x \<sharp> Q\<close> 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 \<open>x \<sharp> \<alpha>\<close> 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  \<open>y \<noteq> a\<close> \<open>y \<noteq> x\<close> 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 \<open>P''' = P \<parallel> !P\<close> 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 \<open>P''' \<noteq> P \<parallel> !P\<close> 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 \<open>c \<sharp> P\<close> have "c \<sharp> P'''" by(rule freshChain)
  with P'''Trans have "c \<sharp> P''" using \<open>c \<noteq> x\<close> 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 \<open>c \<sharp> P\<close> 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 \<open>c \<sharp> P\<close> 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 \<open>c \<sharp> P\<close> have "c \<sharp> P'''" by(rule freshChain)
  with P'''Trans have "c \<sharp> P''" using \<open>c \<noteq> b\<close> by(rule Early_Semantics.freshInputTransition)
  with P''Chain show ?thesis by(rule freshChain)
qed

lemmas freshTransition = freshBoundOutputTransition freshOutputTransition
                         freshInputTransition freshTauTransition

end