theory Proof_1_14
  imports Proofs_1
begin

theorem proof_1_14: "VC14 inv1 env s0 user_value pressure_value"
  apply(simp only: VC14_def inv1_def R1_def extraInv_def)
  apply(rule impI)
  apply(rule conjI)
   apply(rule conjI)
    apply simp
   apply((rule allI)+)
   apply(rule impI)
  subgoal premises prems for s1 s2
    using prems(2) apply(simp split: if_splits)
    using prems
    apply (smt (z3) getPstate.simps(9) le_refl ltime.simps(9) substate_toEnvNum_id)
        using prems(1)
    by (meson prems(2))


(*  Title:       Isabelle Collections Library
    Author:      Andreas Lochbihler <andreas dot lochbihler at kit.edu>
    Maintainer:  Andreas Lochbihler <andreas dot lochbihler at kit.edu>
*)
section \<open>\isaheader{Set implementation via tries}\<close>
theory TrieSetImpl imports
  TrieMapImpl
  "../gen_algo/SetByMap"
  "../gen_algo/SetGA"
begin

(*@impl Set
  @type ('a) ts
  @abbrv ts,t
  Sets of elements of type @{typ "'a list"} implemented by tries.
*)

subsection "Definitions"

type_synonym
  'a ts = "('a, unit) trie"

setup Locale_Code.open_block
interpretation ts_sbm: SetByMap tm_basic_ops by unfold_locales
setup Locale_Code.close_block

definition ts_ops :: "('a list,'a ts) set_ops"
  where [icf_rec_def]:
  "ts_ops \<equiv> ts_sbm.basic.dflt_ops"

setup Locale_Code.open_block
interpretation ts: StdSet ts_ops
  unfolding ts_ops_def by (rule ts_sbm.basic.dflt_ops_impl)
interpretation ts: StdSet_no_invar ts_ops
  by unfold_locales (simp add: icf_rec_unf SetByMapDefs.invar_def)
setup Locale_Code.close_block

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

lemmas ts_it_to_it_map_code_unfold[code_unfold] =
  it_to_it_map_fold'[OF pi_trie]

lemma pi_ts[proper_it]: "proper_it' ts.iteratei ts.iteratei"
  unfolding ts.iteratei_def[abs_def]
  by (rule proper_it'I icf_proper_iteratorI)+

interpretation pi_ts: proper_it_loc ts.iteratei ts.iteratei
  by unfold_locales (rule pi_ts)

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

export_code test_codegen checking SML

end


subsection\<open>Main Theorems\<close>

theory Stuttering
imports StutteringLemmas

begin

text \<open>
  Using the lemmas of the previous section about the invariance by stuttering
  of various properties of TESL specifications, we can now prove that the atomic
  formulae that compose TESL specifications are invariant by stuttering.
\<close>

text \<open>Sporadic specifications are preserved in a dilated run.\<close>
lemma sporadic_sub:
  assumes \<open>sub \<lless> r\<close>
      and \<open>sub \<in> \<lbrakk>c sporadic \<tau> on c'\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
    shows \<open>r \<in> \<lbrakk>c sporadic \<tau> on c'\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
proof -
  from assms(1) is_subrun_def obtain f
    where \<open>dilating f sub r\<close> by blast
  hence \<open>\<forall>n c. time ((Rep_run sub) n c) = time ((Rep_run r) (f n) c)
           \<and> hamlet ((Rep_run sub) n c) = hamlet ((Rep_run r) (f n) c)\<close> by (simp add: dilating_def)
  moreover from assms(2) have
    \<open>sub \<in> {r. \<exists> n. hamlet ((Rep_run r) n c) \<and> time ((Rep_run r) n c') = \<tau>}\<close> by simp
  from this obtain k where \<open>time ((Rep_run sub) k c') = \<tau> \<and> hamlet ((Rep_run sub) k c)\<close> by auto
  ultimately have \<open>time ((Rep_run r) (f k) c') = \<tau> \<and> hamlet ((Rep_run r) (f k) c)\<close> by simp
  thus ?thesis by auto
qed

text \<open>Implications are preserved in a dilated run.\<close>
theorem implies_sub:
  assumes \<open>sub \<lless> r\<close>
      and \<open>sub \<in> \<lbrakk>c\<^sub>1 implies c\<^sub>2\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
    shows \<open>r \<in> \<lbrakk>c\<^sub>1 implies c\<^sub>2\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
proof -
  from assms(1) is_subrun_def obtain f where \<open>dilating f sub r\<close> by blast
  moreover from assms(2) have
    \<open>sub \<in> {r. \<forall>n. hamlet ((Rep_run r) n c\<^sub>1) \<longrightarrow> hamlet ((Rep_run r) n c\<^sub>2)}\<close> by simp
  hence \<open>\<forall>n. hamlet ((Rep_run sub) n c\<^sub>1) \<longrightarrow> hamlet ((Rep_run sub) n c\<^sub>2)\<close> by simp
  ultimately have \<open>\<forall>n. hamlet ((Rep_run r) n c\<^sub>1) \<longrightarrow> hamlet ((Rep_run r) n c\<^sub>2)\<close>
    using ticks_imp_ticks_subk ticks_sub by blast
  thus ?thesis by simp
qed

theorem implies_not_sub:
  assumes \<open>sub \<lless> r\<close>
      and \<open>sub \<in> \<lbrakk>c\<^sub>1 implies not c\<^sub>2\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
    shows \<open>r \<in> \<lbrakk>c\<^sub>1 implies not c\<^sub>2\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
proof -
  from assms(1) is_subrun_def obtain f where \<open>dilating f sub r\<close> by blast
  moreover from assms(2) have
    \<open>sub \<in> {r. \<forall>n. hamlet ((Rep_run r) n c\<^sub>1) \<longrightarrow> \<not> hamlet ((Rep_run r) n c\<^sub>2)}\<close> by simp
  hence \<open>\<forall>n. hamlet ((Rep_run sub) n c\<^sub>1) \<longrightarrow> \<not> hamlet ((Rep_run sub) n c\<^sub>2)\<close> by simp
  ultimately have \<open>\<forall>n. hamlet ((Rep_run r) n c\<^sub>1) \<longrightarrow> \<not> hamlet ((Rep_run r) n c\<^sub>2)\<close>
    using ticks_imp_ticks_subk ticks_sub by blast
  thus ?thesis by simp
qed

text \<open>Precedence relations are preserved in a dilated run.\<close>
theorem weakly_precedes_sub:
  assumes \<open>sub \<lless> r\<close>
      and \<open>sub \<in> \<lbrakk>c\<^sub>1 weakly precedes c\<^sub>2\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
    shows \<open>r \<in> \<lbrakk>c\<^sub>1 weakly precedes c\<^sub>2\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
proof -
  from assms(1) is_subrun_def obtain f where *:\<open>dilating f sub r\<close> by blast
  from assms(2) have
    \<open>sub \<in> {r. \<forall>n. (run_tick_count r c\<^sub>2 n) \<le> (run_tick_count r c\<^sub>1 n)}\<close> by simp
  hence \<open>\<forall>n. (run_tick_count sub c\<^sub>2 n) \<le> (run_tick_count sub c\<^sub>1 n)\<close> by simp
  from dil_tick_count[OF assms(1) this]
    have \<open>\<forall>n. (run_tick_count r c\<^sub>2 n) \<le> (run_tick_count r c\<^sub>1 n)\<close> by simp
  thus ?thesis by simp
qed

theorem strictly_precedes_sub:
  assumes \<open>sub \<lless> r\<close>
      and \<open>sub \<in> \<lbrakk>c\<^sub>1 strictly precedes c\<^sub>2\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
    shows \<open>r \<in> \<lbrakk>c\<^sub>1 strictly precedes c\<^sub>2\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
proof -
  from assms(1) is_subrun_def obtain f where *:\<open>dilating f sub r\<close> by blast
  from assms(2) have
    \<open>sub \<in> { \<rho>. \<forall>n::nat. (run_tick_count \<rho> c\<^sub>2 n) \<le> (run_tick_count_strictly \<rho> c\<^sub>1 n) }\<close>
  by simp
  with strictly_precedes_alt_def2[of \<open>c\<^sub>2\<close> \<open>c\<^sub>1\<close>]  have
    \<open>sub \<in> { \<rho>. (\<not>hamlet ((Rep_run \<rho>) 0 c\<^sub>2))
  \<and> (\<forall>n::nat. (run_tick_count \<rho> c\<^sub>2 (Suc n)) \<le> (run_tick_count \<rho> c\<^sub>1 n)) }\<close>
  by blast
  hence \<open>(\<not>hamlet ((Rep_run sub) 0 c\<^sub>2))
       \<and> (\<forall>n::nat. (run_tick_count sub c\<^sub>2 (Suc n)) \<le> (run_tick_count sub c\<^sub>1 n))\<close>
    by simp
  hence
    1:\<open>(\<not>hamlet ((Rep_run sub) 0 c\<^sub>2))
     \<and> (\<forall>n::nat. (tick_count sub c\<^sub>2 (Suc n)) \<le> (tick_count sub c\<^sub>1 n))\<close>
  by (simp add: tick_count_is_fun)
  have \<open>\<forall>n::nat. (tick_count r c\<^sub>2 (Suc n)) \<le> (tick_count r c\<^sub>1 n)\<close>
  proof -
    { fix n::nat
      have \<open>tick_count r c\<^sub>2 (Suc n) \<le> tick_count r c\<^sub>1 n\<close>
      proof (cases \<open>\<exists>n\<^sub>0. f n\<^sub>0 = n\<close>)
        case True \<comment> \<open>n is in the image of f\<close>
          from this obtain n\<^sub>0 where fn:\<open>f n\<^sub>0 = n\<close> by blast
          show ?thesis
          proof (cases \<open>\<exists>sn\<^sub>0. f sn\<^sub>0 = Suc n\<close>)
            case True \<comment> \<open>Suc n is in the image of f\<close>
              from this obtain sn\<^sub>0 where fsn:\<open>f sn\<^sub>0 = Suc n\<close> by blast
              with fn strict_mono_suc * have \<open>sn\<^sub>0 = Suc n\<^sub>0\<close>
                using  dilating_def dilating_fun_def by blast
              with 1 have \<open>tick_count sub c\<^sub>2 sn\<^sub>0 \<le> tick_count sub c\<^sub>1 n\<^sub>0\<close> by simp
              thus ?thesis using fn fsn tick_count_sub[OF *] by simp
          next
            case False \<comment> \<open>Suc n is not in the image of f\<close>
              hence \<open>\<not>hamlet ((Rep_run r) (Suc n) c\<^sub>2)\<close>
                using * by (simp add: dilating_def dilating_fun_def)
              hence \<open>tick_count r c\<^sub>2 (Suc n) = tick_count r c\<^sub>2 n\<close>
                by (simp add: tick_count_suc)
              also have \<open>... = tick_count sub c\<^sub>2 n\<^sub>0\<close>
                using fn tick_count_sub[OF *] by simp
              finally have \<open>tick_count r c\<^sub>2 (Suc n) = tick_count sub c\<^sub>2 n\<^sub>0\<close> .
              moreover have \<open>tick_count sub c\<^sub>2 n\<^sub>0 \<le> tick_count sub c\<^sub>2 (Suc n\<^sub>0)\<close>
                by (simp add: tick_count_suc)
              ultimately have
                \<open>tick_count r c\<^sub>2 (Suc n) \<le> tick_count sub c\<^sub>2 (Suc n\<^sub>0)\<close> by simp
              moreover have
                \<open>tick_count sub c\<^sub>2 (Suc n\<^sub>0) \<le> tick_count sub c\<^sub>1 n\<^sub>0\<close> using 1 by simp
              ultimately have \<open>tick_count r c\<^sub>2 (Suc n) \<le> tick_count sub c\<^sub>1 n\<^sub>0\<close> by simp
              thus ?thesis using tick_count_sub[OF *] fn by simp
          qed
      next
        case False \<comment> \<open>n is not in the image of f\<close>
          from greatest_prev_image[OF * this] obtain n\<^sub>p  where
            np_prop:\<open>f n\<^sub>p < n \<and> (\<forall>k. f n\<^sub>p < k \<and> k \<le> n \<longrightarrow> (\<nexists>k\<^sub>0. f k\<^sub>0 = k))\<close> by blast
          from tick_count_latest[OF * this] have
            \<open>tick_count r c\<^sub>1 n = tick_count r c\<^sub>1 (f n\<^sub>p)\<close> .
          hence a:\<open>tick_count r c\<^sub>1 n = tick_count sub c\<^sub>1 n\<^sub>p\<close>
            using tick_count_sub[OF *] by simp
          have b: \<open>tick_count sub c\<^sub>2 (Suc n\<^sub>p) \<le> tick_count sub c\<^sub>1 n\<^sub>p\<close> using 1 by simp
          show ?thesis
          proof (cases \<open>\<exists>sn\<^sub>0. f sn\<^sub>0 = Suc n\<close>)
            case True \<comment> \<open>Suc n is in the image of f\<close>
              from this obtain sn\<^sub>0 where fsn:\<open>f sn\<^sub>0 = Suc n\<close> by blast
              from next_non_stuttering[OF * np_prop this]  have sn_prop:\<open>sn\<^sub>0 = Suc n\<^sub>p\<close> .
              with b have \<open>tick_count sub c\<^sub>2 sn\<^sub>0 \<le> tick_count sub c\<^sub>1 n\<^sub>p\<close> by simp
              thus ?thesis using tick_count_sub[OF *] fsn a by auto
          next
            case False \<comment> \<open>Suc n is not in the image of f\<close>
              hence \<open>\<not>hamlet ((Rep_run r) (Suc n) c\<^sub>2)\<close>
                using * by (simp add: dilating_def dilating_fun_def)
              hence \<open>tick_count r c\<^sub>2 (Suc n) = tick_count r c\<^sub>2 n\<close>
                by (simp add: tick_count_suc)
              also have \<open>... = tick_count sub c\<^sub>2 n\<^sub>p\<close> using np_prop tick_count_sub[OF *]
                by (simp add: tick_count_latest[OF * np_prop])
              finally have \<open>tick_count r c\<^sub>2 (Suc n) = tick_count sub c\<^sub>2 n\<^sub>p\<close> .
              moreover have \<open>tick_count sub c\<^sub>2 n\<^sub>p \<le> tick_count sub c\<^sub>2 (Suc n\<^sub>p)\<close>
                by (simp add: tick_count_suc)
              ultimately have
                \<open>tick_count r c\<^sub>2 (Suc n) \<le> tick_count sub c\<^sub>2 (Suc n\<^sub>p)\<close> by simp
              moreover have
                \<open>tick_count sub c\<^sub>2 (Suc n\<^sub>p) \<le> tick_count sub c\<^sub>1 n\<^sub>p\<close> using 1 by simp
              ultimately have \<open>tick_count r c\<^sub>2 (Suc n) \<le> tick_count sub c\<^sub>1 n\<^sub>p\<close> by simp
              thus ?thesis using np_prop mono_tick_count  using a by linarith
          qed
      qed
    } thus ?thesis ..
  qed
  moreover from 1 have \<open>\<not>hamlet ((Rep_run r) 0 c\<^sub>2)\<close>
    using * empty_dilated_prefix ticks_sub by fastforce
  ultimately show ?thesis by (simp add: tick_count_is_fun strictly_precedes_alt_def2)
qed

text \<open>
  Time delayed relations are preserved in a dilated run.
\<close>
theorem time_delayed_sub:
  assumes \<open>sub \<lless> r\<close>
      and \<open>sub \<in> \<lbrakk> a time-delayed by \<delta>\<tau> on ms implies b \<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
    shows \<open>r \<in> \<lbrakk> a time-delayed by \<delta>\<tau> on ms implies b \<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
proof -
  from assms(1) is_subrun_def obtain f where *:\<open>dilating f sub r\<close> by blast
  from assms(2) have \<open>\<forall>n. hamlet ((Rep_run sub) n a)
                          \<longrightarrow> (\<forall>m \<ge> n. first_time sub ms m (time ((Rep_run sub) n ms) + \<delta>\<tau>)
                                       \<longrightarrow> hamlet ((Rep_run sub) m b))\<close>
    using TESL_interpretation_atomic.simps(5)[of \<open>a\<close> \<open>\<delta>\<tau>\<close> \<open>ms\<close> \<open>b\<close>] by simp
  hence **:\<open>\<forall>n\<^sub>0. hamlet ((Rep_run r) (f n\<^sub>0) a)
                  \<longrightarrow> (\<forall>m\<^sub>0 \<ge> n\<^sub>0. first_time r ms (f m\<^sub>0) (time ((Rep_run r) (f n\<^sub>0) ms) + \<delta>\<tau>)
                                  \<longrightarrow> hamlet ((Rep_run r) (f m\<^sub>0) b))  \<close>
    using first_time_image[OF *] dilating_def * by fastforce
  hence \<open>\<forall>n. hamlet ((Rep_run r) n a)
                  \<longrightarrow> (\<forall>m \<ge> n. first_time r ms m (time ((Rep_run r) n ms) + \<delta>\<tau>)
                                \<longrightarrow> hamlet ((Rep_run r) m b))\<close>
  proof -
    { fix n assume assm:\<open>hamlet ((Rep_run r) n a)\<close>
      from ticks_image_sub[OF * assm] obtain n\<^sub>0 where nfn0:\<open>n = f n\<^sub>0\<close> by blast
      with ** assm have ft0:
        \<open>(\<forall>m\<^sub>0 \<ge> n\<^sub>0. first_time r ms (f m\<^sub>0) (time ((Rep_run r) (f n\<^sub>0) ms) + \<delta>\<tau>)
                    \<longrightarrow> hamlet ((Rep_run r) (f m\<^sub>0) b))\<close> by blast
      have \<open>(\<forall>m \<ge> n. first_time r ms m (time ((Rep_run r) n ms) + \<delta>\<tau>)
                       \<longrightarrow> hamlet ((Rep_run r) m b)) \<close>
      proof -
      { fix m assume hyp:\<open>m \<ge> n\<close>
        have \<open>first_time r ms m (time (Rep_run r n ms) + \<delta>\<tau>) \<longrightarrow> hamlet (Rep_run r m b)\<close>
        proof (cases \<open>\<exists>m\<^sub>0. f m\<^sub>0 = m\<close>)
          case True
          from this obtain m\<^sub>0 where \<open>m = f m\<^sub>0\<close> by blast
          moreover have \<open>strict_mono f\<close> using * by (simp add: dilating_def dilating_fun_def)
          ultimately show ?thesis using ft0 hyp nfn0 by (simp add: strict_mono_less_eq)
        next
          case False thus ?thesis
          proof (cases \<open>m = 0\<close>)
            case True
              hence \<open>m = f 0\<close> using * by (simp add: dilating_def dilating_fun_def)
              then show ?thesis using False by blast
          next
            case False
            hence \<open>\<exists>pm. m = Suc pm\<close> by (simp add: not0_implies_Suc)
            from this obtain pm where mpm:\<open>m = Suc pm\<close> by blast
            hence \<open>\<nexists>pm\<^sub>0. f pm\<^sub>0 = Suc pm\<close> using \<open>\<nexists>m\<^sub>0. f m\<^sub>0 = m\<close> by simp
            with *  have \<open>time (Rep_run r (Suc pm) ms) = time (Rep_run r pm ms)\<close>
              using dilating_def dilating_fun_def by blast
            hence \<open>time (Rep_run r pm ms) = time (Rep_run r m ms)\<close> using mpm by simp
            moreover from mpm have \<open>pm < m\<close> by simp
            ultimately have \<open>\<exists>m' < m. time (Rep_run r m' ms) = time (Rep_run r m ms)\<close> by blast
            hence \<open>\<not>(first_time r ms m (time (Rep_run r n ms) + \<delta>\<tau>))\<close>
              by (auto simp add: first_time_def)
            thus ?thesis by simp
          qed
        qed
      } thus ?thesis by simp
      qed
    } thus ?thesis by simp
  qed
  thus ?thesis by simp
qed

text \<open>Time relations are preserved through dilation of a run.\<close>
lemma tagrel_sub':
  assumes \<open>sub \<lless> r\<close>
      and \<open>sub \<in> \<lbrakk> time-relation \<lfloor>c\<^sub>1,c\<^sub>2\<rfloor> \<in> R \<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
    shows \<open>R (time ((Rep_run r) n c\<^sub>1), time ((Rep_run r) n c\<^sub>2))\<close>
proof -
  from assms(1) is_subrun_def obtain f where *:\<open>dilating f sub r\<close> by blast
  moreover from assms(2) TESL_interpretation_atomic.simps(2) have
    \<open>sub \<in> {r. \<forall>n. R (time ((Rep_run r) n c\<^sub>1), time ((Rep_run r) n c\<^sub>2))}\<close> by blast
  hence 1:\<open>\<forall>n. R (time ((Rep_run sub) n c\<^sub>1), time ((Rep_run sub) n c\<^sub>2))\<close> by simp
  show ?thesis
  proof (induction n)
    case 0
      from 1 have \<open>R (time ((Rep_run sub) 0 c\<^sub>1), time ((Rep_run sub) 0 c\<^sub>2))\<close> by simp
      moreover from * have \<open>f 0 = 0\<close> by (simp add: dilating_def dilating_fun_def)
      moreover from * have \<open>\<forall>c. time ((Rep_run sub) 0 c) = time ((Rep_run r) (f 0) c)\<close>
        by (simp add: dilating_def)
      ultimately show ?case by simp
  next
    case (Suc n)
    then show ?case
    proof (cases \<open>\<nexists>n\<^sub>0. f n\<^sub>0 = Suc n\<close>)
      case True
      with * have \<open>\<forall>c. time (Rep_run r (Suc n) c) = time (Rep_run r n c)\<close>
        by (simp add: dilating_def dilating_fun_def)
      thus ?thesis using Suc.IH by simp
    next
      case False
      from this obtain n\<^sub>0 where n\<^sub>0prop:\<open>f n\<^sub>0 = Suc n\<close> by blast
      from 1 have \<open>R (time ((Rep_run sub) n\<^sub>0 c\<^sub>1), time ((Rep_run sub) n\<^sub>0 c\<^sub>2))\<close> by simp
      moreover from n\<^sub>0prop * have \<open>time ((Rep_run sub) n\<^sub>0 c\<^sub>1) = time ((Rep_run r) (Suc n) c\<^sub>1)\<close>
        by (simp add: dilating_def)
      moreover from n\<^sub>0prop * have \<open>time ((Rep_run sub) n\<^sub>0 c\<^sub>2) = time ((Rep_run r) (Suc n) c\<^sub>2)\<close>
        by (simp add: dilating_def)
      ultimately show ?thesis by simp
    qed
  qed
qed

corollary tagrel_sub:
  assumes \<open>sub \<lless> r\<close>
      and \<open>sub \<in> \<lbrakk> time-relation \<lfloor>c\<^sub>1,c\<^sub>2\<rfloor> \<in> R \<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
    shows \<open>r \<in> \<lbrakk> time-relation \<lfloor>c\<^sub>1,c\<^sub>2\<rfloor> \<in> R \<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
using tagrel_sub'[OF assms] unfolding TESL_interpretation_atomic.simps(3) by simp

text \<open>Time relations are also preserved by contraction\<close>
lemma tagrel_sub_inv:
  assumes \<open>sub \<lless> r\<close>
      and \<open>r \<in> \<lbrakk> time-relation \<lfloor>c\<^sub>1, c\<^sub>2\<rfloor> \<in> R \<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
    shows \<open>sub \<in> \<lbrakk> time-relation \<lfloor>c\<^sub>1, c\<^sub>2\<rfloor> \<in> R \<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
proof -
  from assms(1) is_subrun_def obtain f where df:\<open>dilating f sub r\<close> by blast
  moreover from assms(2) TESL_interpretation_atomic.simps(2) have
    \<open>r \<in> {\<rho>. \<forall>n. R (time ((Rep_run \<rho>) n c\<^sub>1), time ((Rep_run \<rho>) n c\<^sub>2))}\<close> by blast
  hence \<open>\<forall>n. R (time ((Rep_run r) n c\<^sub>1), time ((Rep_run r) n c\<^sub>2))\<close> by simp
  hence \<open>\<forall>n. (\<exists>n\<^sub>0. f n\<^sub>0 = n) \<longrightarrow> R (time ((Rep_run r) n c\<^sub>1), time ((Rep_run r) n c\<^sub>2))\<close> by simp
  hence \<open>\<forall>n\<^sub>0. R (time ((Rep_run r) (f n\<^sub>0) c\<^sub>1), time ((Rep_run r) (f n\<^sub>0) c\<^sub>2))\<close> by blast
  moreover from dilating_def df have
    \<open>\<forall>n c. time ((Rep_run sub) n c) = time ((Rep_run r) (f n) c)\<close> by blast
  ultimately have \<open>\<forall>n\<^sub>0. R (time ((Rep_run sub) n\<^sub>0 c\<^sub>1), time ((Rep_run sub) n\<^sub>0 c\<^sub>2))\<close> by auto
  thus ?thesis by simp
qed

text \<open>
  Kill relations are preserved in a dilated run.
\<close>
theorem kill_sub:
  assumes \<open>sub \<lless> r\<close>
      and \<open>sub \<in> \<lbrakk> c\<^sub>1 kills c\<^sub>2 \<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
    shows \<open>r \<in> \<lbrakk> c\<^sub>1 kills c\<^sub>2 \<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
proof -
  from assms(1) is_subrun_def obtain f where *:\<open>dilating f sub r\<close> by blast
  from assms(2) TESL_interpretation_atomic.simps(8) have
    \<open>\<forall>n. hamlet (Rep_run sub n c\<^sub>1) \<longrightarrow> (\<forall>m\<ge>n. \<not> hamlet (Rep_run sub m c\<^sub>2))\<close> by simp
  hence 1:\<open>\<forall>n. hamlet (Rep_run r (f n) c\<^sub>1) \<longrightarrow> (\<forall>m\<ge>n. \<not> hamlet (Rep_run r (f m) c\<^sub>2))\<close>
    using ticks_sub[OF *] by simp
  hence \<open>\<forall>n. hamlet (Rep_run r (f n) c\<^sub>1) \<longrightarrow> (\<forall>m\<ge> (f n). \<not> hamlet (Rep_run r m c\<^sub>2))\<close>
  proof -
    { fix n assume \<open>hamlet (Rep_run r (f n) c\<^sub>1)\<close>
      with 1 have 2:\<open>\<forall> m \<ge> n. \<not> hamlet (Rep_run r (f m) c\<^sub>2)\<close> by simp
      have \<open>\<forall> m\<ge> (f n). \<not> hamlet (Rep_run r m c\<^sub>2)\<close>
      proof -
        { fix m assume h:\<open>m \<ge> f n\<close>
          have \<open>\<not> hamlet (Rep_run r m c\<^sub>2)\<close>
          proof (cases \<open>\<exists>m\<^sub>0. f m\<^sub>0 = m\<close>)
            case True
              from this obtain m\<^sub>0 where fm0:\<open>f m\<^sub>0 = m\<close> by blast
              hence \<open>m\<^sub>0 \<ge> n\<close>
                using * dilating_def dilating_fun_def h strict_mono_less_eq by fastforce
              with 2 show ?thesis using fm0 by blast
          next
            case False
              thus ?thesis  using ticks_image_sub'[OF *] by blast
          qed
        } thus ?thesis by simp
      qed
    } thus ?thesis by simp
  qed
  hence \<open>\<forall>n. hamlet (Rep_run r n c\<^sub>1) \<longrightarrow> (\<forall>m \<ge> n. \<not> hamlet (Rep_run r m c\<^sub>2))\<close>
    using ticks_imp_ticks_subk[OF *] by blast
  thus ?thesis using TESL_interpretation_atomic.simps(8) by blast
qed

lemmas atomic_sub_lemmas = sporadic_sub tagrel_sub implies_sub implies_not_sub
                           time_delayed_sub weakly_precedes_sub
                           strictly_precedes_sub kill_sub

text \<open>
  We can now prove that all atomic specification formulae are preserved
  by the dilation of runs.
\<close>

text \<open>
  Finally, any TESL specification is invariant by stuttering.
\<close>
theorem TESL_stuttering_invariant:
  assumes \<open>sub \<lless> r\<close>
    shows \<open>sub \<in> \<lbrakk>\<lbrakk> S \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L \<Longrightarrow> r \<in> \<lbrakk>\<lbrakk> S \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
proof (induction S)
  case Nil
    thus ?case by simp
next
  case (Cons a s)
    from Cons.prems have sa:\<open>sub \<in> \<lbrakk> a \<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close> and sb:\<open>sub \<in> \<lbrakk>\<lbrakk> s \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close>
      using TESL_interpretation_image by simp+
    from Cons.IH[OF sb] have \<open>r \<in> \<lbrakk>\<lbrakk> s \<rbrakk>\<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close> .
    moreover from atomic_sub[OF assms(1) sa] have \<open>r \<in> \<lbrakk> a \<rbrakk>\<^sub>T\<^sub>E\<^sub>S\<^sub>L\<close> .
    ultimately show ?case using  TESL_interpretation_image by simp
qed

end


(*  Title:      HOL/Auth/Guard/P1.thy
    Author:     Frederic Blanqui, University of Cambridge Computer Laboratory
    Copyright   2002  University of Cambridge

From G. Karjoth, N. Asokan and C. Gulcu
"Protecting the computation results of free-roaming agents"
Mobiles Agents 1998, LNCS 1477.
*)

section{*Protocol P1*}

theory P1 imports "../Public" Guard_Public List_Msg begin

subsection{*Protocol Definition*}

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

the contents of the messages are not completely specified in the paper
we assume that the user sends his request and his itinerary in the clear

we will adopt the following format for messages: {|A,r,I,L|}
A: originator (agent)
r: request (number)
I: next shops (agent list)
L: collected offers (offer list)

in the paper, the authors use nonces r_i to add redundancy in the offer
in order to make it safer against dictionary attacks
it is not necessary in our modelization since crypto is assumed to be strong
(Crypt in injective)
******************************************************************************)

subsubsection{*offer chaining:
B chains his offer for A with the head offer of L for sending it to C*}

definition chain :: "agent => nat => agent => msg => agent => msg" where
"chain B ofr A L C ==
let m1= Crypt (pubK A) (Nonce ofr) in
let m2= Hash {|head L, Agent C|} in
sign B {|m1,m2|}"

declare Let_def [simp]

lemma chain_inj [iff]: "(chain B ofr A L C = chain B' ofr' A' L' C')
= (B=B' & ofr=ofr' & A=A' & head L = head L' & C=C')"
by (auto simp: chain_def Let_def)

lemma Nonce_in_chain [iff]: "Nonce ofr:parts {chain B ofr A L C}"
by (auto simp: chain_def sign_def)

subsubsection{*agent whose key is used to sign an offer*}

fun shop :: "msg => msg" where
"shop {|B,X,Crypt K H|} = Agent (agt K)"

lemma shop_chain [simp]: "shop (chain B ofr A L C) = Agent B"
by (simp add: chain_def sign_def)

subsubsection{*nonce used in an offer*}

fun nonce :: "msg => msg" where
"nonce {|B,{|Crypt K ofr,m2|},CryptH|} = ofr"

lemma nonce_chain [simp]: "nonce (chain B ofr A L C) = Nonce ofr"
by (simp add: chain_def sign_def)

subsubsection{*next shop*}

fun next_shop :: "msg => agent" where
"next_shop {|B,{|m1,Hash{|headL,Agent C|}|},CryptH|} = C"

lemma next_shop_chain [iff]: "next_shop (chain B ofr A L C) = C"
by (simp add: chain_def sign_def)

subsubsection{*anchor of the offer list*}

definition anchor :: "agent => nat => agent => msg" where
"anchor A n B == chain A n A (cons nil nil) B"

lemma anchor_inj [iff]: "(anchor A n B = anchor A' n' B')
= (A=A' & n=n' & B=B')"
by (auto simp: anchor_def)

lemma Nonce_in_anchor [iff]: "Nonce n:parts {anchor A n B}"
by (auto simp: anchor_def)

lemma shop_anchor [simp]: "shop (anchor A n B) = Agent A"
by (simp add: anchor_def)

lemma nonce_anchor [simp]: "nonce (anchor A n B) = Nonce n"
by (simp add: anchor_def)

lemma next_shop_anchor [iff]: "next_shop (anchor A n B) = B"
by (simp add: anchor_def)

subsubsection{*request event*}

definition reqm :: "agent => nat => nat => msg => agent => msg" where
"reqm A r n I B == {|Agent A, Number r, cons (Agent A) (cons (Agent B) I),
cons (anchor A n B) nil|}"

lemma reqm_inj [iff]: "(reqm A r n I B = reqm A' r' n' I' B')
= (A=A' & r=r' & n=n' & I=I' & B=B')"
by (auto simp: reqm_def)

lemma Nonce_in_reqm [iff]: "Nonce n:parts {reqm A r n I B}"
by (auto simp: reqm_def)

definition req :: "agent => nat => nat => msg => agent => event" where
"req A r n I B == Says A B (reqm A r n I B)"

lemma req_inj [iff]: "(req A r n I B = req A' r' n' I' B')
= (A=A' & r=r' & n=n' & I=I' & B=B')"
by (auto simp: req_def)

subsubsection{*propose event*}

definition prom :: "agent => nat => agent => nat => msg => msg =>
msg => agent => msg" where
"prom B ofr A r I L J C == {|Agent A, Number r,
app (J, del (Agent B, I)), cons (chain B ofr A L C) L|}"

lemma prom_inj [dest]: "prom B ofr A r I L J C
= prom B' ofr' A' r' I' L' J' C'
==> B=B' & ofr=ofr' & A=A' & r=r' & L=L' & C=C'"
by (auto simp: prom_def)

lemma Nonce_in_prom [iff]: "Nonce ofr:parts {prom B ofr A r I L J C}"
by (auto simp: prom_def)

definition pro :: "agent => nat => agent => nat => msg => msg =>
msg => agent => event" where
"pro B ofr A r I L J C == Says B C (prom B ofr A r I L J C)"

lemma pro_inj [dest]: "pro B ofr A r I L J C = pro B' ofr' A' r' I' L' J' C'
==> B=B' & ofr=ofr' & A=A' & r=r' & L=L' & C=C'"
by (auto simp: pro_def dest: prom_inj)

subsubsection{*protocol*}

inductive_set p1 :: "event list set"
where

  Nil: "[]:p1"

| Fake: "[| evsf:p1; X:synth (analz (spies evsf)) |] ==> Says Spy B X # evsf : p1"

| Request: "[| evsr:p1; Nonce n ~:used evsr; I:agl |] ==> req A r n I B # evsr : p1"

| Propose: "[| evsp:p1; Says A' B {|Agent A,Number r,I,cons M L|}:set evsp;
  I:agl; J:agl; isin (Agent C, app (J, del (Agent B, I)));
  Nonce ofr ~:used evsp |] ==> pro B ofr A r I (cons M L) J C # evsp : p1"

subsubsection{*Composition of Traces*}

lemma "evs':p1 ==>
       evs:p1 & (ALL n. Nonce n:used evs' --> Nonce n ~:used evs) -->
       evs'@evs : p1"
apply (erule p1.induct, safe)
apply (simp_all add: used_ConsI)
apply (erule p1.Fake, erule synth_sub, rule analz_mono, rule knows_sub_app)
apply (erule p1.Request, safe, simp_all add: req_def, force)
apply (erule_tac A'=A' in p1.Propose, simp_all)
apply (drule_tac x=ofr in spec, simp add: pro_def, blast)
apply (erule_tac A'=A' in p1.Propose, auto simp: pro_def)
done

subsubsection{*Valid Offer Lists*}

inductive_set
  valid :: "agent => nat => agent => msg set"
  for A :: agent and n :: nat and B :: agent
where
  Request [intro]: "cons (anchor A n B) nil:valid A n B"

| Propose [intro]: "L:valid A n B
==> cons (chain (next_shop (head L)) ofr A L C) L:valid A n B"

subsubsection{*basic properties of valid*}

lemma valid_not_empty: "L:valid A n B ==> EX M L'. L = cons M L'"
by (erule valid.cases, auto)

lemma valid_pos_len: "L:valid A n B ==> 0 < len L"
by (erule valid.induct, auto)

subsubsection{*offers of an offer list*}

definition offer_nonces :: "msg => msg set" where
"offer_nonces L == {X. X:parts {L} & (EX n. X = Nonce n)}"

subsubsection{*the originator can get the offers*}

lemma "L:valid A n B ==> offer_nonces L <= analz (insert L (initState A))"
by (erule valid.induct, auto simp: anchor_def chain_def sign_def
offer_nonces_def initState.simps)

subsubsection{*list of offers*}

fun offers :: "msg => msg" where
"offers (cons M L) = cons {|shop M, nonce M|} (offers L)" |
"offers other = nil"

subsubsection{*list of agents whose keys are used to sign a list of offers*}

fun shops :: "msg => msg" where
"shops (cons M L) = cons (shop M) (shops L)" |
"shops other = other"

lemma shops_in_agl: "L:valid A n B ==> shops L:agl"
by (erule valid.induct, auto simp: anchor_def chain_def sign_def)

subsubsection{*builds a trace from an itinerary*}

fun offer_list :: "agent * nat * agent * msg * nat => msg" where
"offer_list (A,n,B,nil,ofr) = cons (anchor A n B) nil" |
"offer_list (A,n,B,cons (Agent C) I,ofr) = (
let L = offer_list (A,n,B,I,Suc ofr) in
cons (chain (next_shop (head L)) ofr A L C) L)"

lemma "I:agl ==> ALL ofr. offer_list (A,n,B,I,ofr):valid A n B"
by (erule agl.induct, auto)

fun trace :: "agent * nat * agent * nat * msg * msg * msg
=> event list" where
"trace (B,ofr,A,r,I,L,nil) = []" |
"trace (B,ofr,A,r,I,L,cons (Agent D) K) = (
let C = (if K=nil then B else agt_nb (head K)) in
let I' = (if K=nil then cons (Agent A) (cons (Agent B) I)
          else cons (Agent A) (app (I, cons (head K) nil))) in
let I'' = app (I, cons (head K) nil) in
pro C (Suc ofr) A r I' L nil D
# trace (B,Suc ofr,A,r,I'',tail L,K))"

definition trace' :: "agent => nat => nat => msg => agent => nat => event list" where
"trace' A r n I B ofr == (
let AI = cons (Agent A) I in
let L = offer_list (A,n,B,AI,ofr) in
trace (B,ofr,A,r,nil,L,AI))"

declare trace'_def [simp]

subsubsection{*there is a trace in which the originator receives a valid answer*}

lemma p1_not_empty: "evs:p1 ==> req A r n I B:set evs -->
(EX evs'. evs'@evs:p1 & pro B' ofr A r I' L J A:set evs' & L:valid A n B)"
oops

subsection{*properties of protocol P1*}

text{*publicly verifiable forward integrity:
anyone can verify the validity of an offer list*}

subsubsection{*strong forward integrity:
except the last one, no offer can be modified*}

lemma strong_forward_integrity: "ALL L. Suc i < len L
--> L:valid A n B & repl (L,Suc i,M):valid A n B --> M = ith (L,Suc i)"
apply (induct i)
(* i = 0 *)
apply clarify
apply (frule len_not_empty, clarsimp)
apply (frule len_not_empty, clarsimp)
apply (ind_cases "{|x,xa,l'a|}:valid A n B" for x xa l'a)
apply (ind_cases "{|x,M,l'a|}:valid A n B" for x l'a)
apply (simp add: chain_def)
(* i > 0 *)
apply clarify
apply (frule len_not_empty, clarsimp)
apply (ind_cases "{|x,repl(l',Suc na,M)|}:valid A n B" for x l' na)
apply (frule len_not_empty, clarsimp)
apply (ind_cases "{|x,l'|}:valid A n B" for x l')
by (drule_tac x=l' in spec, simp, blast)

subsubsection{*insertion resilience:
except at the beginning, no offer can be inserted*}

lemma chain_isnt_head [simp]: "L:valid A n B ==>
head L ~= chain (next_shop (head L)) ofr A L C"
by (erule valid.induct, auto simp: chain_def sign_def anchor_def)

lemma insertion_resilience: "ALL L. L:valid A n B --> Suc i < len L
--> ins (L,Suc i,M) ~:valid A n B"
apply (induct i)
(* i = 0 *)
apply clarify
apply (frule len_not_empty, clarsimp)
apply (ind_cases "{|x,l'|}:valid A n B" for x l', simp)
apply (ind_cases "{|x,M,l'|}:valid A n B" for x l', clarsimp)
apply (ind_cases "{|head l',l'|}:valid A n B" for l', simp, simp)
(* i > 0 *)
apply clarify
apply (frule len_not_empty, clarsimp)
apply (ind_cases "{|x,l'|}:valid A n B" for x l')
apply (frule len_not_empty, clarsimp)
apply (ind_cases "{|x,ins(l',Suc na,M)|}:valid A n B" for x l' na)
apply (frule len_not_empty, clarsimp)
by (drule_tac x=l' in spec, clarsimp)

subsubsection{*truncation resilience:
only shop i can truncate at offer i*}

lemma truncation_resilience: "ALL L. L:valid A n B --> Suc i < len L
--> cons M (trunc (L,Suc i)):valid A n B --> shop M = shop (ith (L,i))"
apply (induct i)
(* i = 0 *)
apply clarify
apply (frule len_not_empty, clarsimp)
apply (ind_cases "{|x,l'|}:valid A n B" for x l')
apply (frule len_not_empty, clarsimp)
apply (ind_cases "{|M,l'|}:valid A n B" for l')
apply (frule len_not_empty, clarsimp, simp)
(* i > 0 *)
apply clarify
apply (frule len_not_empty, clarsimp)
apply (ind_cases "{|x,l'|}:valid A n B" for x l')
apply (frule len_not_empty, clarsimp)
by (drule_tac x=l' in spec, clarsimp)

subsubsection{*declarations for tactics*}

declare knows_Spy_partsEs [elim]
declare Fake_parts_insert [THEN subsetD, dest]
declare initState.simps [simp del]

subsubsection{*get components of a message*}

lemma get_ML [dest]: "Says A' B {|A,r,I,M,L|}:set evs ==>
M:parts (spies evs) & L:parts (spies evs)"
by blast

subsubsection{*general properties of p1*}

lemma reqm_neq_prom [iff]:
"reqm A r n I B ~= prom B' ofr A' r' I' (cons M L) J C"
by (auto simp: reqm_def prom_def)

lemma prom_neq_reqm [iff]:
"prom B' ofr A' r' I' (cons M L) J C ~= reqm A r n I B"
by (auto simp: reqm_def prom_def)

lemma req_neq_pro [iff]: "req A r n I B ~= pro B' ofr A' r' I' (cons M L) J C"
by (auto simp: req_def pro_def)

lemma pro_neq_req [iff]: "pro B' ofr A' r' I' (cons M L) J C ~= req A r n I B"
by (auto simp: req_def pro_def)

lemma p1_has_no_Gets: "evs:p1 ==> ALL A X. Gets A X ~:set evs"
by (erule p1.induct, auto simp: req_def pro_def)

lemma p1_is_Gets_correct [iff]: "Gets_correct p1"
by (auto simp: Gets_correct_def dest: p1_has_no_Gets)

lemma p1_is_one_step [iff]: "one_step p1"
by (unfold one_step_def, clarify, ind_cases "ev#evs:p1" for ev evs, auto)

lemma p1_has_only_Says' [rule_format]: "evs:p1 ==>
ev:set evs --> (EX A B X. ev=Says A B X)"
by (erule p1.induct, auto simp: req_def pro_def)

lemma p1_has_only_Says [iff]: "has_only_Says p1"
by (auto simp: has_only_Says_def dest: p1_has_only_Says')

lemma p1_is_regular [iff]: "regular p1"
apply (simp only: regular_def, clarify)
apply (erule_tac p1.induct)
apply (simp_all add: initState.simps knows.simps pro_def prom_def
                     req_def reqm_def anchor_def chain_def sign_def)
by (auto dest: no_Key_in_agl no_Key_in_appdel parts_trans)

subsubsection{*private keys are safe*}

lemma priK_parts_Friend_imp_bad [rule_format,dest]:
     "[| evs:p1; Friend B ~= A |]
      ==> (Key (priK A):parts (knows (Friend B) evs)) --> (A:bad)"
apply (erule p1.induct)
apply (simp_all add: initState.simps knows.simps pro_def prom_def
                req_def reqm_def anchor_def chain_def sign_def)
apply (blast dest: no_Key_in_agl)
apply (auto del: parts_invKey disjE  dest: parts_trans
            simp add: no_Key_in_appdel)
done

lemma priK_analz_Friend_imp_bad [rule_format,dest]:
     "[| evs:p1; Friend B ~= A |]
==> (Key (priK A):analz (knows (Friend B) evs)) --> (A:bad)"
by auto

lemma priK_notin_knows_max_Friend: "[| evs:p1; A ~:bad; A ~= Friend C |]
==> Key (priK A) ~:analz (knows_max (Friend C) evs)"
apply (rule not_parts_not_analz, simp add: knows_max_def, safe)
apply (drule_tac H="spies' evs" in parts_sub)
apply (rule_tac p=p1 in knows_max'_sub_spies', simp+)
apply (drule_tac H="spies evs" in parts_sub)
by (auto dest: knows'_sub_knows [THEN subsetD] priK_notin_initState_Friend)

subsubsection{*general guardedness properties*}

lemma agl_guard [intro]: "I:agl ==> I:guard n Ks"
by (erule agl.induct, auto)

lemma Says_to_knows_max'_guard: "[| Says A' C {|A'',r,I,L|}:set evs;
Guard n Ks (knows_max' C evs) |] ==> L:guard n Ks"
by (auto dest: Says_to_knows_max')

lemma Says_from_knows_max'_guard: "[| Says C A' {|A'',r,I,L|}:set evs;
Guard n Ks (knows_max' C evs) |] ==> L:guard n Ks"
by (auto dest: Says_from_knows_max')

lemma Says_Nonce_not_used_guard: "[| Says A' B {|A'',r,I,L|}:set evs;
Nonce n ~:used evs |] ==> L:guard n Ks"
by (drule not_used_not_parts, auto)

subsubsection{*guardedness of messages*}

lemma chain_guard [iff]: "chain B ofr A L C:guard n {priK A}"
by (case_tac "ofr=n", auto simp: chain_def sign_def)

lemma chain_guard_Nonce_neq [intro]: "n ~= ofr
==> chain B ofr A' L C:guard n {priK A}"
by (auto simp: chain_def sign_def)

lemma anchor_guard [iff]: "anchor A n' B:guard n {priK A}"
by (case_tac "n'=n", auto simp: anchor_def)

lemma anchor_guard_Nonce_neq [intro]: "n ~= n'
==> anchor A' n' B:guard n {priK A}"
by (auto simp: anchor_def)

lemma reqm_guard [intro]: "I:agl ==> reqm A r n' I B:guard n {priK A}"
by (case_tac "n'=n", auto simp: reqm_def)

lemma reqm_guard_Nonce_neq [intro]: "[| n ~= n'; I:agl |]
==> reqm A' r n' I B:guard n {priK A}"
by (auto simp: reqm_def)

lemma prom_guard [intro]: "[| I:agl; J:agl; L:guard n {priK A} |]
==> prom B ofr A r I L J C:guard n {priK A}"
by (auto simp: prom_def)

lemma prom_guard_Nonce_neq [intro]: "[| n ~= ofr; I:agl; J:agl;
L:guard n {priK A} |] ==> prom B ofr A' r I L J C:guard n {priK A}"
by (auto simp: prom_def)

subsubsection{*Nonce uniqueness*}

lemma uniq_Nonce_in_chain [dest]: "Nonce k:parts {chain B ofr A L C} ==> k=ofr"
by (auto simp: chain_def sign_def)

lemma uniq_Nonce_in_anchor [dest]: "Nonce k:parts {anchor A n B} ==> k=n"
by (auto simp: anchor_def chain_def sign_def)

lemma uniq_Nonce_in_reqm [dest]: "[| Nonce k:parts {reqm A r n I B};
I:agl |] ==> k=n"
by (auto simp: reqm_def dest: no_Nonce_in_agl)

lemma uniq_Nonce_in_prom [dest]: "[| Nonce k:parts {prom B ofr A r I L J C};
I:agl; J:agl; Nonce k ~:parts {L} |] ==> k=ofr"
by (auto simp: prom_def dest: no_Nonce_in_agl no_Nonce_in_appdel)

subsubsection{*requests are guarded*}

lemma req_imp_Guard [rule_format]: "[| evs:p1; A ~:bad |] ==>
req A r n I B:set evs --> Guard n {priK A} (spies evs)"
apply (erule p1.induct, simp)
apply (simp add: req_def knows.simps, safe)
apply (erule in_synth_Guard, erule Guard_analz, simp)
by (auto simp: req_def pro_def dest: Says_imp_knows_Spy)

lemma req_imp_Guard_Friend: "[| evs:p1; A ~:bad; req A r n I B:set evs |]
==> Guard n {priK A} (knows_max (Friend C) evs)"
apply (rule Guard_knows_max')
apply (rule_tac H="spies evs" in Guard_mono)
apply (rule req_imp_Guard, simp+)
apply (rule_tac B="spies' evs" in subset_trans)
apply (rule_tac p=p1 in knows_max'_sub_spies', simp+)
by (rule knows'_sub_knows)

subsubsection{*propositions are guarded*}

lemma pro_imp_Guard [rule_format]: "[| evs:p1; B ~:bad; A ~:bad |] ==>
pro B ofr A r I (cons M L) J C:set evs --> Guard ofr {priK A} (spies evs)"
apply (erule p1.induct) (* +3 subgoals *)
(* Nil *)
apply simp
(* Fake *)
apply (simp add: pro_def, safe) (* +4 subgoals *)
(* 1 *)
apply (erule in_synth_Guard, drule Guard_analz, simp, simp)
(* 2 *)
apply simp
(* 3 *)
apply (simp, simp add: req_def pro_def, blast)
(* 4 *)
apply (simp add: pro_def)
apply (blast dest: prom_inj Says_Nonce_not_used_guard Nonce_not_used_Guard)
(* 5 *)
apply simp
apply safe (* +1 subgoal *)
apply (simp add: pro_def)
apply (blast dest: prom_inj Says_Nonce_not_used_guard)
(* 6 *)
apply (simp add: pro_def)
apply (blast dest: Says_imp_knows_Spy)
(* Request *)
apply (simp add: pro_def)
apply (blast dest: prom_inj Says_Nonce_not_used_guard Nonce_not_used_Guard)
(* Propose *)
apply simp
apply safe (* +1 subgoal *)
(* 1 *)
apply (simp add: pro_def)
apply (blast dest: prom_inj Says_Nonce_not_used_guard)
(* 2 *)
apply (simp add: pro_def)
by (blast dest: Says_imp_knows_Spy)

lemma pro_imp_Guard_Friend: "[| evs:p1; B ~:bad; A ~:bad;
pro B ofr A r I (cons M L) J C:set evs |]
==> Guard ofr {priK A} (knows_max (Friend D) evs)"
apply (rule Guard_knows_max')
apply (rule_tac H="spies evs" in Guard_mono)
apply (rule pro_imp_Guard, simp+)
apply (rule_tac B="spies' evs" in subset_trans)
apply (rule_tac p=p1 in knows_max'_sub_spies', simp+)
by (rule knows'_sub_knows)

subsubsection{*data confidentiality:
no one other than the originator can decrypt the offers*}

lemma Nonce_req_notin_spies: "[| evs:p1; req A r n I B:set evs; A ~:bad |]
==> Nonce n ~:analz (spies evs)"
by (frule req_imp_Guard, simp+, erule Guard_Nonce_analz, simp+)

lemma Nonce_req_notin_knows_max_Friend: "[| evs:p1; req A r n I B:set evs;
A ~:bad; A ~= Friend C |] ==> Nonce n ~:analz (knows_max (Friend C) evs)"
apply (clarify, frule_tac C=C in req_imp_Guard_Friend, simp+)
apply (simp add: knows_max_def, drule Guard_invKey_keyset, simp+)
by (drule priK_notin_knows_max_Friend, auto simp: knows_max_def)

lemma Nonce_pro_notin_spies: "[| evs:p1; B ~:bad; A ~:bad;
pro B ofr A r I (cons M L) J C:set evs |] ==> Nonce ofr ~:analz (spies evs)"
by (frule pro_imp_Guard, simp+, erule Guard_Nonce_analz, simp+)

lemma Nonce_pro_notin_knows_max_Friend: "[| evs:p1; B ~:bad; A ~:bad;
A ~= Friend D; pro B ofr A r I (cons M L) J C:set evs |]
==> Nonce ofr ~:analz (knows_max (Friend D) evs)"
apply (clarify, frule_tac A=A in pro_imp_Guard_Friend, simp+)
apply (simp add: knows_max_def, drule Guard_invKey_keyset, simp+)
by (drule priK_notin_knows_max_Friend, auto simp: knows_max_def)

subsubsection{*non repudiability:
an offer signed by B has been sent by B*}

lemma Crypt_reqm: "[| Crypt (priK A) X:parts {reqm A' r n I B}; I:agl |] ==> A=A'"
by (auto simp: reqm_def anchor_def chain_def sign_def dest: no_Crypt_in_agl)

lemma Crypt_prom: "[| Crypt (priK A) X:parts {prom B ofr A' r I L J C};
I:agl; J:agl |] ==> A=B | Crypt (priK A) X:parts {L}"
apply (simp add: prom_def anchor_def chain_def sign_def)
by (blast dest: no_Crypt_in_agl no_Crypt_in_appdel)

lemma Crypt_safeness: "[| evs:p1; A ~:bad |] ==> Crypt (priK A) X:parts (spies evs)
--> (EX B Y. Says A B Y:set evs & Crypt (priK A) X:parts {Y})"
apply (erule p1.induct)
(* Nil *)
apply simp
(* Fake *)
apply clarsimp
apply (drule_tac P="%G. Crypt (priK A) X:G" in parts_insert_substD, simp)
apply (erule disjE)
apply (drule_tac K="priK A" in Crypt_synth, simp+, blast, blast)
(* Request *)
apply (simp add: req_def, clarify)
apply (drule_tac P="%G. Crypt (priK A) X:G" in parts_insert_substD, simp)
apply (erule disjE)
apply (frule Crypt_reqm, simp, clarify)
apply (rule_tac x=B in exI, rule_tac x="reqm A r n I B" in exI, simp, blast)
(* Propose *)
apply (simp add: pro_def, clarify)
apply (drule_tac P="%G. Crypt (priK A) X:G" in parts_insert_substD, simp)
apply (rotate_tac -1, erule disjE)
apply (frule Crypt_prom, simp, simp)
apply (rotate_tac -1, erule disjE)
apply (rule_tac x=C in exI)
apply (rule_tac x="prom B ofr Aa r I (cons M L) J C" in exI, blast)
apply (subgoal_tac "cons M L:parts (spies evsp)")
apply (drule_tac G="{cons M L}" and H="spies evsp" in parts_trans, blast, blast)
apply (drule Says_imp_spies, rotate_tac -1, drule parts.Inj)
apply (drule parts.Snd, drule parts.Snd, drule parts.Snd)
by auto

lemma Crypt_Hash_imp_sign: "[| evs:p1; A ~:bad |] ==>
Crypt (priK A) (Hash X):parts (spies evs)
--> (EX B Y. Says A B Y:set evs & sign A X:parts {Y})"
apply (erule p1.induct)
(* Nil *)
apply simp
(* Fake *)
apply clarsimp
apply (drule_tac P="%G. Crypt (priK A) (Hash X):G" in parts_insert_substD)
apply simp
apply (erule disjE)
apply (drule_tac K="priK A" in Crypt_synth, simp+, blast, blast)
(* Request *)
apply (simp add: req_def, clarify)
apply (drule_tac P="%G. Crypt (priK A) (Hash X):G" in parts_insert_substD)
apply simp
apply (erule disjE)
apply (frule Crypt_reqm, simp+)
apply (rule_tac x=B in exI, rule_tac x="reqm Aa r n I B" in exI)
apply (simp add: reqm_def sign_def anchor_def no_Crypt_in_agl)
apply (simp add: chain_def sign_def, blast)
(* Propose *)
apply (simp add: pro_def, clarify)
apply (drule_tac P="%G. Crypt (priK A) (Hash X):G" in parts_insert_substD)
apply simp
apply (rotate_tac -1, erule disjE)
apply (simp add: prom_def sign_def no_Crypt_in_agl no_Crypt_in_appdel)
apply (simp add: chain_def sign_def)
apply (rotate_tac -1, erule disjE)
apply (rule_tac x=C in exI)
apply (rule_tac x="prom B ofr Aa r I (cons M L) J C" in exI)
apply (simp add: prom_def chain_def sign_def)
apply (erule impE)
apply (blast dest: get_ML parts_sub)
apply (blast del: MPair_parts)+
done

lemma sign_safeness: "[| evs:p1; A ~:bad |] ==> sign A X:parts (spies evs)
--> (EX B Y. Says A B Y:set evs & sign A X:parts {Y})"
apply (clarify, simp add: sign_def, frule parts.Snd)
apply (blast dest: Crypt_Hash_imp_sign [unfolded sign_def])
done

end


theory Extra_no_setVarAny
  imports HandDryer_no_setVarAny Requirements_no_setVarAny VCTheoryLemmas_no_setVarAny
begin

theorem extra2: "VC2 extraInv s0 hands_value"
  apply(simp only: VC2_def extraInv_def dryer_def
waiting_def drying_def)
  by auto

theorem extra3: "VC3 extraInv s0 hands_value"
  apply(simp only: VC3_def extraInv_def dryer_def
waiting_def drying_def)
  by auto

theorem extra5: "VC5 extraInv s0 hands_value"
  apply(simp only: VC5_def extraInv_def dryer_def
waiting_def drying_def)
  apply(auto)
proof -
  assume 1: " toEnvP s0"
   " \<forall>s1. toEnvP s1 \<and> substate s1 s0 \<longrightarrow>
         getPstate s1 Ctrl =
         Suc (Suc (Suc (Suc 0))) \<or>
         getPstate s1 Ctrl =
         Suc (Suc (Suc (Suc (Suc 0))))"
    "env (setVarBool s0 hands ON) ON "
   " getPstate s0 Ctrl =
    Suc (Suc (Suc (Suc (Suc 0)))) "
   " hands_value "
   " 0 < ltimeEnv s0 Ctrl "
   " ltimeEnv s0 Ctrl \<le> 10 "
  "\<forall>s1. toEnvP s1 \<and>
         substate s1 s0 \<and>
         Suc (toEnvNum s1 s0) = ltimeEnv s0 Ctrl \<longrightarrow>
         getVarBool s1 (Suc 0) \<and>
         getVarBool s1 (Suc (Suc 0)) "
   " \<forall>s1. toEnvP s1 \<and>
         substate s1 s0 \<and>
         Suc (toEnvNum s1 s0) < ltimeEnv s0 Ctrl \<longrightarrow>
         \<not> getVarBool s1 (Suc 0) \<and>
         getVarBool s1 (Suc (Suc 0))"
  with toEnvNum_id  have "Suc (toEnvNum s0 s0) = ltimeEnv s0 Ctrl \<or>
Suc (toEnvNum s0 s0) <ltimeEnv s0 Ctrl" by auto
  with 1 substate_refl
  show "getVarBool s0 (Suc (Suc 0))" by auto
qed

theorem extra6: "VC6 extraInv s0 hands_value"
  apply(simp only: VC6_def extraInv_def dryer_def
waiting_def drying_def)
  by auto

theorem extra7: "VC7 extraInv s0 hands_value"
  apply(simp only: VC7_def extraInv_def dryer_def
waiting_def drying_def)
  apply(auto)
proof -
  assume 1: "toEnvP s0 "
    "\<forall>s1. toEnvP s1 \<and> substate s1 s0 \<longrightarrow>
         getPstate s1 Ctrl =
         Suc (Suc (Suc (Suc 0))) \<or>
         getPstate s1 Ctrl =
         Suc (Suc (Suc (Suc (Suc 0)))) "
   " env (setVarBool s0 hands OFF) OFF "
    "getPstate s0 Ctrl =
    Suc (Suc (Suc (Suc (Suc 0)))) "
    "\<not> hands_value "
   " ltimeEnv s0 Ctrl \<noteq> 10 "
    "0 < ltimeEnv s0 Ctrl "
   " ltimeEnv s0 Ctrl \<le> 10 "
   " \<forall>s1. toEnvP s1 \<and>
         substate s1 s0 \<and>
         Suc (toEnvNum s1 s0) = ltimeEnv s0 Ctrl \<longrightarrow>
         getVarBool s1 (Suc 0) \<and>
         getVarBool s1 (Suc (Suc 0)) "
    "\<forall>s1. toEnvP s1 \<and>
         substate s1 s0 \<and>
         Suc (toEnvNum s1 s0) < ltimeEnv s0 Ctrl \<longrightarrow>
         \<not> getVarBool s1 (Suc 0) \<and>
         getVarBool s1 (Suc (Suc 0))"
with toEnvNum_id  have "Suc (toEnvNum s0 s0) = ltimeEnv s0 Ctrl \<or>
Suc (toEnvNum s0 s0) <ltimeEnv s0 Ctrl" by auto
  with 1 substate_refl
  show "getVarBool s0 (Suc (Suc 0))" by auto
qed

end


theory L_Transform
imports
  Validity
  Bisimilarity_Implies_Equivalence
  FL_Equivalence_Implies_Bisimilarity
begin

section \<open>\texorpdfstring{$L$}{L}-Transform\<close>

subsection \<open>States\<close>

text \<open>The intuition is that states of kind~\<open>AC\<close> can perform ordinary actions, and states of
kind~\<open>EF\<close> can commit effects.\<close>

datatype ('state,'effect) L_state =
    AC "'effect \<times> 'effect fs_set \<times> 'state"
  | EF "'effect fs_set \<times> 'state"

instantiation L_state :: (pt,pt) pt
begin

  fun permute_L_state :: "perm \<Rightarrow> ('a,'b) L_state \<Rightarrow> ('a,'b) L_state" where
    "p \<bullet> (AC x) = AC (p \<bullet> x)"
  | "p \<bullet> (EF x) = EF (p \<bullet> x)"

  instance
  proof
    fix x :: "('a,'b) L_state"
    show "0 \<bullet> x = x" by (cases x, simp_all)
  next
    fix p q and x :: "('a,'b) L_state"
    show "(p + q) \<bullet> x = p \<bullet> q \<bullet> x" by (cases x, simp_all)
  qed

end

declare permute_L_state.simps [eqvt]

lemma supp_AC [simp]: "supp (AC x) = supp x"
unfolding supp_def by simp

lemma supp_EF [simp]: "supp (EF x) = supp x"
unfolding supp_def by simp

instantiation L_state :: (fs,fs) fs
begin

  instance
  proof
    fix x :: "('a,'b) L_state"
    show "finite (supp x)"
      by (cases x) (simp add: finite_supp)+
  qed

end

subsection \<open>Actions and binding names\<close>

datatype ('act,'effect) L_action =
    Act 'act
  | Eff 'effect

instantiation L_action :: (pt,pt) pt
begin

  fun permute_L_action :: "perm \<Rightarrow> ('a,'b) L_action \<Rightarrow> ('a,'b) L_action" where
    "p \<bullet> (Act \<alpha>) = Act (p \<bullet> \<alpha>)"
  | "p \<bullet> (Eff f) = Eff (p \<bullet> f)"

  instance
  proof
    fix x :: "('a,'b) L_action"
    show "0 \<bullet> x = x" by (cases x, simp_all)
  next
    fix p q and x :: "('a,'b) L_action"
    show "(p + q) \<bullet> x = p \<bullet> q \<bullet> x" by (cases x, simp_all)
  qed

end

declare permute_L_action.simps [eqvt]

lemma supp_Act [simp]: "supp (Act \<alpha>) = supp \<alpha>"
unfolding supp_def by simp

lemma supp_Eff [simp]: "supp (Eff f) = supp f"
unfolding supp_def by simp

instantiation L_action :: (fs,fs) fs
begin

  instance
  proof
    fix x :: "('a,'b) L_action"
    show "finite (supp x)"
      by (cases x) (simp add: finite_supp)+
  qed

end

instantiation L_action :: (bn,fs) bn
begin

  fun bn_L_action :: "('a,'b) L_action \<Rightarrow> atom set" where
    "bn_L_action (Act \<alpha>) = bn \<alpha>"
  | "bn_L_action (Eff _) = {}"

  instance
  proof
    fix p and \<alpha> :: "('a,'b) L_action"
    show "p \<bullet> bn \<alpha> = bn (p \<bullet> \<alpha>)"
      by (cases \<alpha>) (simp add: bn_eqvt, simp)
  next
    fix \<alpha> :: "('a,'b) L_action"
    show "finite (bn \<alpha>)"
      by (cases \<alpha>) (simp add: bn_finite, simp)
  qed

end

subsection \<open>Satisfaction\<close>

context effect_nominal_ts
begin

  fun L_satisfies :: "('state,'effect) L_state \<Rightarrow> 'pred \<Rightarrow> bool" (infix "\<turnstile>\<^sub>L" 70) where
    "AC (_,_,P) \<turnstile>\<^sub>L \<phi> \<longleftrightarrow> P \<turnstile> \<phi>"
  | "EF _       \<turnstile>\<^sub>L \<phi> \<longleftrightarrow> False"

  lemma L_satisfies_eqvt: assumes "P\<^sub>L \<turnstile>\<^sub>L \<phi>" shows "(p \<bullet> P\<^sub>L) \<turnstile>\<^sub>L (p \<bullet> \<phi>)"
  proof (cases P\<^sub>L)
    case (AC fFP)
    with assms have "snd (snd fFP) \<turnstile> \<phi>"
      by (metis L_satisfies.simps(1) prod.collapse)
    then have "snd (snd (p \<bullet> fFP)) \<turnstile> p \<bullet> \<phi>"
      by (metis satisfies_eqvt snd_eqvt)
    then show ?thesis
      using AC by (metis L_satisfies.simps(1) permute_L_state.simps(1) prod.collapse)
  next
    case EF
    with assms have "False"
      by simp
    then show ?thesis ..
  qed

end

subsection \<open>Transitions\<close>

context effect_nominal_ts
begin

  fun L_transition :: "('state,'effect) L_state \<Rightarrow> (('act,'effect) L_action, ('state,'effect) L_state) residual \<Rightarrow> bool" (infix "\<rightarrow>\<^sub>L" 70) where
    "AC (f,F,P) \<rightarrow>\<^sub>L \<alpha>P' \<longleftrightarrow> (\<exists>\<alpha> P'. P \<rightarrow> \<langle>\<alpha>,P'\<rangle> \<and> \<alpha>P' = \<langle>Act \<alpha>, EF (L (\<alpha>,F,f), P')\<rangle> \<and> bn \<alpha> \<sharp>* (F,f))" \<comment> \<open>note the freshness condition\<close>
  | "EF (F,P) \<rightarrow>\<^sub>L \<alpha>P' \<longleftrightarrow> (\<exists>f. f \<in>\<^sub>f\<^sub>s F \<and> \<alpha>P' = \<langle>Eff f, AC (f, F, \<langle>f\<rangle>P)\<rangle>)"

  lemma L_transition_eqvt: assumes "P\<^sub>L \<rightarrow>\<^sub>L \<alpha>\<^sub>LP\<^sub>L'" shows "(p \<bullet> P\<^sub>L) \<rightarrow>\<^sub>L (p \<bullet> \<alpha>\<^sub>LP\<^sub>L')"
  proof (cases P\<^sub>L)
    case AC
    {
      fix f F P
      assume *: "P\<^sub>L = AC (f,F,P)"
      with assms obtain \<alpha> P' where trans: "P \<rightarrow> \<langle>\<alpha>,P'\<rangle>" and \<alpha>P': "\<alpha>\<^sub>LP\<^sub>L' = \<langle>Act \<alpha>, EF (L (\<alpha>,F,f), P')\<rangle>" and fresh: "bn \<alpha> \<sharp>* (F,f)"
        by auto
      from trans have "p \<bullet> P \<rightarrow> \<langle>p \<bullet> \<alpha>, p \<bullet> P'\<rangle>"
        by (simp add: transition_eqvt')
      moreover from \<alpha>P' have "p \<bullet> \<alpha>\<^sub>LP\<^sub>L' = \<langle>Act (p \<bullet> \<alpha>), EF (L (p \<bullet> \<alpha>, p \<bullet> F, p \<bullet> f), p \<bullet> P')\<rangle>"
        by (simp add: L_eqvt')
      moreover from fresh have "bn (p \<bullet> \<alpha>) \<sharp>* (p \<bullet> F, p \<bullet> f)"
        by (metis bn_eqvt fresh_star_Pair fresh_star_permute_iff)
      ultimately have "p \<bullet> P\<^sub>L \<rightarrow>\<^sub>L p \<bullet> \<alpha>\<^sub>LP\<^sub>L'"
        using "*" by auto
    }
    with AC show ?thesis
      by (metis prod.collapse)
  next
    case EF
    {
      fix F P
      assume *: "P\<^sub>L = EF (F,P)"
      with assms obtain f where "f \<in>\<^sub>f\<^sub>s F" and "\<alpha>\<^sub>LP\<^sub>L' = \<langle>Eff f, AC (f, F, \<langle>f\<rangle>P)\<rangle>"
        by auto
      then have "(p \<bullet> f) \<in>\<^sub>f\<^sub>s (p \<bullet> F)" and "p \<bullet> \<alpha>\<^sub>LP\<^sub>L' = \<langle>Eff (p \<bullet> f), AC (p \<bullet> f, p \<bullet> F, \<langle>p \<bullet> f\<rangle>(p \<bullet> P))\<rangle>"
        by simp+
      then have "p \<bullet> P\<^sub>L \<rightarrow>\<^sub>L p \<bullet> \<alpha>\<^sub>LP\<^sub>L'"
        using "*" L_transition.simps(2) Pair_eqvt permute_L_state.simps(2) by force
    }
    with EF show ?thesis
      by (metis prod.collapse)
  qed

  text \<open>The binding names in the alpha-variant that witnesses the $L$-transition may be chosen fresh
  for any finitely supported context.\<close>

  lemma L_transition_AC_strong:
    assumes "finite (supp X)" and "AC (f,F,P) \<rightarrow>\<^sub>L \<langle>\<alpha>\<^sub>L,P\<^sub>L'\<rangle>"
    shows "\<exists>\<alpha> P'. P \<rightarrow> \<langle>\<alpha>,P'\<rangle> \<and> \<langle>\<alpha>\<^sub>L,P\<^sub>L'\<rangle> = \<langle>Act \<alpha>, EF (L (\<alpha>,F,f), P')\<rangle> \<and> bn \<alpha> \<sharp>* X"
  using assms proof -
    from \<open>AC (f,F,P) \<rightarrow>\<^sub>L \<langle>\<alpha>\<^sub>L,P\<^sub>L'\<rangle>\<close> obtain \<alpha> P' where transition: "P \<rightarrow> \<langle>\<alpha>,P'\<rangle>" and alpha: "\<langle>\<alpha>\<^sub>L,P\<^sub>L'\<rangle> = \<langle>Act \<alpha>, EF (L (\<alpha>,F,f), P')\<rangle>" and fresh: "bn \<alpha> \<sharp>* (F,f)"
      by (metis L_transition.simps(1))
    let ?Act = "Act \<alpha> :: ('act,'effect) L_action" \<comment> \<open>the type annotation prevents a type that is too polymorphic and doesn't fix~@{typ 'effect}\<close>
    have "finite (bn \<alpha>)"
      by (fact bn_finite)
    moreover note \<open>finite (supp X)\<close>
    moreover have "finite (supp (\<langle>?Act, EF (L (\<alpha>,F,f), P')\<rangle>, \<langle>\<alpha>,P'\<rangle>, F, f))"
      by (metis finite_Diff finite_UnI finite_supp supp_Pair supp_abs_residual_pair)
    moreover from fresh have "bn \<alpha> \<sharp>* (\<langle>?Act, EF (L (\<alpha>,F,f), P')\<rangle>, \<langle>\<alpha>,P'\<rangle>, F, f)"
      by (auto simp add: fresh_star_def fresh_def supp_Pair supp_abs_residual_pair)
    ultimately obtain p where fresh_X: "(p \<bullet> bn \<alpha>) \<sharp>* X" and "supp (\<langle>?Act, EF (L (\<alpha>,F,f), P')\<rangle>, \<langle>\<alpha>,P'\<rangle>, F, f) \<sharp>* p"
      by (metis at_set_avoiding2)
    then have "supp \<langle>?Act, EF (L (\<alpha>,F,f), P')\<rangle> \<sharp>* p" and "supp \<langle>\<alpha>,P'\<rangle> \<sharp>* p" and "supp (F,f) \<sharp>* p"
      by (metis fresh_star_Un supp_Pair)+
    then have "p \<bullet> \<langle>?Act, EF (L (\<alpha>,F,f), P')\<rangle> = \<langle>?Act, EF (L (\<alpha>,F,f), P')\<rangle>" and "p \<bullet> \<langle>\<alpha>,P'\<rangle> = \<langle>\<alpha>,P'\<rangle>" and "p \<bullet> (F,f) = (F,f)"
      by (metis supp_perm_eq)+
    then have "\<langle>Act (p \<bullet> \<alpha>), EF (L (p \<bullet> \<alpha>, F, f), p \<bullet> P')\<rangle> = \<langle>?Act, EF (L (\<alpha>,F,f), P')\<rangle>" and "\<langle>p \<bullet> \<alpha>, p \<bullet> P'\<rangle> = \<langle>\<alpha>,P'\<rangle>"
      using permute_L_action.simps(1) permute_L_state.simps(2) abs_residual_pair_eqvt L_eqvt' Pair_eqvt by auto
    then show "\<exists>\<alpha> P'. P \<rightarrow> \<langle>\<alpha>,P'\<rangle> \<and> \<langle>\<alpha>\<^sub>L,P\<^sub>L'\<rangle> = \<langle>Act \<alpha>, EF (L (\<alpha>,F,f), P')\<rangle> \<and> bn \<alpha> \<sharp>* X"
      using transition and alpha and fresh_X by (metis bn_eqvt)
  qed

  (* bn \<alpha> \<sharp>* (F,f) is required for the \<longleftarrow> implication as well as for the \<longrightarrow> implication;
     additionally bn \<alpha> \<sharp>* P is required for the \<longrightarrow> implication. *)

  lemma L_transition_AC_fresh:
    assumes "bn \<alpha> \<sharp>* (F,f,P)"
    shows "AC (f,F,P) \<rightarrow>\<^sub>L \<langle>Act \<alpha>, P\<^sub>L'\<rangle> \<longleftrightarrow> (\<exists>P'. P\<^sub>L' = EF (L (\<alpha>,F,f), P') \<and> P \<rightarrow> \<langle>\<alpha>,P'\<rangle>)"
  proof
    assume "AC (f,F,P) \<rightarrow>\<^sub>L \<langle>Act \<alpha>, P\<^sub>L'\<rangle>"
    moreover have "finite (supp (F,f,P))"
      by (fact finite_supp)
    ultimately obtain \<alpha>' P' where trans: "P \<rightarrow> \<langle>\<alpha>',P'\<rangle>" and eq: "\<langle>Act \<alpha> :: ('act,'effect) L_action, P\<^sub>L'\<rangle> = \<langle>Act \<alpha>', EF (L (\<alpha>',F,f), P')\<rangle>" and fresh: "bn \<alpha>' \<sharp>* (F,f,P)"
      using L_transition_AC_strong by blast
    from eq obtain p where p: "p \<bullet> (Act \<alpha> :: ('act,'effect) L_action, P\<^sub>L') = (Act \<alpha>', EF (L (\<alpha>',F,f), P'))" and supp_p: "supp p \<subseteq> bn (Act \<alpha> :: ('act,'effect) L_action) \<union> p \<bullet> bn (Act \<alpha> :: ('act,'effect) L_action)"
      using residual_eq_iff_perm_renaming by metis

    from p have p_\<alpha>: "p \<bullet> \<alpha> = \<alpha>'" and p_P\<^sub>L': "p \<bullet> P\<^sub>L' = EF (L (\<alpha>',F,f), P')"
      by simp_all

    from supp_p and p_\<alpha> and assms and fresh have "supp p \<sharp>* (F, f, P)"
      by (simp add: bn_eqvt fresh_star_def) blast
    then have p_F: "p \<bullet> F = F" and p_f: "p \<bullet> f = f" and p_P: "p \<bullet> P = P"
      by (simp_all add: fresh_star_Pair perm_supp_eq)

    from p_P\<^sub>L' have "P\<^sub>L' = -p \<bullet> EF (L (\<alpha>',F,f), P')"
      by (metis permute_minus_cancel(2))
    then have "P\<^sub>L' = EF (L (\<alpha>,F,f), -p \<bullet> P')"
      using p_\<alpha> p_F p_f by simp (metis (full_types) permute_minus_cancel(2))

    moreover from trans have "P \<rightarrow> \<langle>\<alpha>, -p \<bullet> P'\<rangle>"
      using p_P and p_\<alpha> by (metis permute_minus_cancel(2) transition_eqvt')

    ultimately show "\<exists>P'. P\<^sub>L' = EF (L (\<alpha>,F,f), P') \<and> P \<rightarrow> \<langle>\<alpha>,P'\<rangle>"
      by blast
  next
    assume "\<exists>P'. P\<^sub>L' = EF (L (\<alpha>,F,f), P') \<and> P \<rightarrow> \<langle>\<alpha>,P'\<rangle>"
    moreover from assms have "bn \<alpha> \<sharp>* (F,f)"
      by (simp add: fresh_star_Pair)
    ultimately show "AC (f, F, P) \<rightarrow>\<^sub>L \<langle>Act \<alpha>, P\<^sub>L'\<rangle>"
      using L_transition.simps(1) by blast
  qed

end

subsection \<open>Translation of \texorpdfstring{$F/L$}{F/L}-formulas into formulas without effects\<close>

text \<open>Since we defined formulas via a manual quotient construction, we also need to define the
$L$-transform via lifting from the underlying type of infinitely branching trees. As before, we
cannot use {\bf nominal\_function} because that generates proof obligations where, for formulas
of the form~@{term "Conj xset"}, the assumption that~@{term xset} has finite support is missing.\<close>

text \<open>The following auxiliary function returns trees (modulo $\alpha$-equivalence) rather than
formulas. This allows us to prove equivariance for \emph{all} argument trees, without an assumption
that they are (hereditarily) finitely supported. Further below--after this auxiliary function has
been lifted to $F/L$-formulas as arguments--we derive a version that returns formulas.\<close>

primrec L_transform_Tree :: "('idx,'pred::fs,'act::bn,'eff::fs) Tree \<Rightarrow> ('idx, 'pred, ('act,'eff) L_action) Formula.Tree\<^sub>\<alpha>" where
  "L_transform_Tree (tConj tset) = Formula.Conj\<^sub>\<alpha> (map_bset L_transform_Tree tset)"
| "L_transform_Tree (tNot t) = Formula.Not\<^sub>\<alpha> (L_transform_Tree t)"
| "L_transform_Tree (tPred f \<phi>) = Formula.Act\<^sub>\<alpha> (Eff f) (Formula.Pred\<^sub>\<alpha> \<phi>)"
| "L_transform_Tree (tAct f \<alpha> t) = Formula.Act\<^sub>\<alpha> (Eff f) (Formula.Act\<^sub>\<alpha> (Act \<alpha>) (L_transform_Tree t))"

lemma L_transform_Tree_eqvt [eqvt]: "p \<bullet> L_transform_Tree t = L_transform_Tree (p \<bullet> t)"
proof (induct t)
  case (tConj tset)
  then show ?case
    by simp (metis (no_types, hide_lams) bset.map_cong0 map_bset_eqvt permute_fun_def permute_minus_cancel(1))
qed simp_all

text \<open>@{const L_transform_Tree} respects $\alpha$-equivalence.\<close>

lemma alpha_Tree_L_transform_Tree:
  assumes "alpha_Tree t1 t2"
  shows "L_transform_Tree t1 = L_transform_Tree t2"
using assms proof (induction t1 t2 rule: alpha_Tree_induct')
  case (alpha_tConj tset1 tset2)
  then have "rel_bset (=) (map_bset L_transform_Tree tset1) (map_bset L_transform_Tree tset2)"
    by (simp add: bset.rel_map(1) bset.rel_map(2) bset.rel_mono_strong)
  then show ?case
    by (simp add: bset.rel_eq)
next
  case (alpha_tAct f1 \<alpha>1 t1 f2 \<alpha>2 t2)
  from \<open>alpha_Tree (FL_Formula.Tree.tAct f1 \<alpha>1 t1) (FL_Formula.Tree.tAct f2 \<alpha>2 t2)\<close>
    obtain p where *: "(bn \<alpha>1, t1) \<approx>set alpha_Tree (supp_rel alpha_Tree) p (bn \<alpha>2, t2)"
      and **: "(bn \<alpha>1, \<alpha>1) \<approx>set (=) supp p (bn \<alpha>2, \<alpha>2)" and "f1 = f2"
    by auto
  from * have fresh: "(supp_rel alpha_Tree t1 - bn \<alpha>1) \<sharp>* p" and alpha: "alpha_Tree (p \<bullet> t1) t2" and eq: "p \<bullet> bn \<alpha>1 = bn \<alpha>2"
    by (auto simp add: alpha_set)
  from alpha_tAct.IH(2) have "supp_rel Formula.alpha_Tree (Formula.rep_Tree\<^sub>\<alpha> (L_transform_Tree t1)) \<subseteq> supp_rel alpha_Tree t1"
    by (metis (no_types, lifting) infinite_mono Formula.alpha_Tree_permute_rep_commute L_transform_Tree_eqvt mem_Collect_eq subsetI supp_rel_def)
  with fresh have fresh': "(supp_rel Formula.alpha_Tree (Formula.rep_Tree\<^sub>\<alpha> (L_transform_Tree t1)) - bn \<alpha>1) \<sharp>* p"
    by (meson DiffD1 DiffD2 DiffI fresh_star_def subsetCE)
  moreover from alpha have alpha': "Formula.alpha_Tree (p \<bullet> Formula.rep_Tree\<^sub>\<alpha> (L_transform_Tree t1)) (Formula.rep_Tree\<^sub>\<alpha> (L_transform_Tree t2))"
    using alpha_tAct.IH(1) by (metis Formula.alpha_Tree_permute_rep_commute L_transform_Tree_eqvt)
  moreover from fresh' alpha' eq have "supp_rel Formula.alpha_Tree (Formula.rep_Tree\<^sub>\<alpha> (L_transform_Tree t1)) - bn \<alpha>1 = supp_rel Formula.alpha_Tree (Formula.rep_Tree\<^sub>\<alpha> (L_transform_Tree t2)) - bn \<alpha>2"
    by (metis (mono_tags) Diff_eqvt Formula.alpha_Tree_eqvt' Formula.alpha_Tree_eqvt_aux Formula.alpha_Tree_supp_rel atom_set_perm_eq)
  ultimately have "(bn \<alpha>1, Formula.rep_Tree\<^sub>\<alpha> (L_transform_Tree t1)) \<approx>set Formula.alpha_Tree (supp_rel Formula.alpha_Tree) p (bn \<alpha>2, Formula.rep_Tree\<^sub>\<alpha> (L_transform_Tree t2))"
    using eq by (simp add: alpha_set)
  moreover from ** have "(bn \<alpha>1, Act \<alpha>1) \<approx>set (=) supp p (bn \<alpha>2, Act \<alpha>2)"
    by (metis (mono_tags, lifting) L_Transform.supp_Act alpha_set permute_L_action.simps(1))
  ultimately have "Formula.Act\<^sub>\<alpha> (Act \<alpha>1) (L_transform_Tree t1) = Formula.Act\<^sub>\<alpha> (Act \<alpha>2) (L_transform_Tree t2)"
    by (auto simp add: Formula.Act\<^sub>\<alpha>_eq_iff)
  with \<open>f1 = f2\<close> show ?case
    by simp
qed simp_all

text \<open>$L$-transform for trees modulo $\alpha$-equivalence.\<close>

lift_definition L_transform_Tree\<^sub>\<alpha> :: "('idx,'pred::fs,'act::bn,'eff::fs) Tree\<^sub>\<alpha> \<Rightarrow> ('idx, 'pred, ('act,'eff) L_action) Formula.Tree\<^sub>\<alpha>" is
    L_transform_Tree
  by (fact alpha_Tree_L_transform_Tree)

lemma L_transform_Tree\<^sub>\<alpha>_eqvt [eqvt]: "p \<bullet> L_transform_Tree\<^sub>\<alpha> t\<^sub>\<alpha> = L_transform_Tree\<^sub>\<alpha> (p \<bullet> t\<^sub>\<alpha>)"
  by transfer (simp)

lemma L_transform_Tree\<^sub>\<alpha>_Conj\<^sub>\<alpha> [simp]: "L_transform_Tree\<^sub>\<alpha> (Conj\<^sub>\<alpha> tset\<^sub>\<alpha>) = Formula.Conj\<^sub>\<alpha> (map_bset L_transform_Tree\<^sub>\<alpha> tset\<^sub>\<alpha>)"
  by (simp add: Conj\<^sub>\<alpha>_def' L_transform_Tree\<^sub>\<alpha>.abs_eq) (metis (no_types, lifting) L_transform_Tree\<^sub>\<alpha>.rep_eq bset.map_comp bset.map_cong0 comp_apply)

lemma L_transform_Tree\<^sub>\<alpha>_Not\<^sub>\<alpha> [simp]: "L_transform_Tree\<^sub>\<alpha> (Not\<^sub>\<alpha> t\<^sub>\<alpha>) = Formula.Not\<^sub>\<alpha> (L_transform_Tree\<^sub>\<alpha> t\<^sub>\<alpha>)"
  by transfer simp

lemma L_transform_Tree\<^sub>\<alpha>_Pred\<^sub>\<alpha> [simp]: "L_transform_Tree\<^sub>\<alpha> (Pred\<^sub>\<alpha> f \<phi>) = Formula.Act\<^sub>\<alpha> (Eff f) (Formula.Pred\<^sub>\<alpha> \<phi>)"
  by transfer simp

lemma L_transform_Tree\<^sub>\<alpha>_Act\<^sub>\<alpha> [simp]: "L_transform_Tree\<^sub>\<alpha> (Act\<^sub>\<alpha> f \<alpha> t\<^sub>\<alpha>) = Formula.Act\<^sub>\<alpha> (Eff f) (Formula.Act\<^sub>\<alpha> (Act \<alpha>) (L_transform_Tree\<^sub>\<alpha> t\<^sub>\<alpha>))"
  by transfer simp

lemma finite_supp_map_bset_L_transform_Tree\<^sub>\<alpha> [simp]:
  assumes "finite (supp tset\<^sub>\<alpha>)"
  shows "finite (supp (map_bset L_transform_Tree\<^sub>\<alpha> tset\<^sub>\<alpha>))"
proof -
  have "eqvt map_bset" and "eqvt L_transform_Tree\<^sub>\<alpha>"
    by (simp add: eqvtI)+
  then have "supp (map_bset L_transform_Tree\<^sub>\<alpha>) = {}"
    using supp_fun_eqvt supp_fun_app_eqvt by blast
  then have "supp (map_bset L_transform_Tree\<^sub>\<alpha> tset\<^sub>\<alpha>) \<subseteq> supp tset\<^sub>\<alpha>"
    using supp_fun_app by blast
  with assms show "finite (supp (map_bset L_transform_Tree\<^sub>\<alpha> tset\<^sub>\<alpha>))"
    by (metis finite_subset)
qed

lemma L_transform_Tree\<^sub>\<alpha>_preserves_hereditarily_fs:
  assumes "hereditarily_fs t\<^sub>\<alpha>"
  shows "Formula.hereditarily_fs (L_transform_Tree\<^sub>\<alpha> t\<^sub>\<alpha>)"
using assms proof (induct rule: hereditarily_fs.induct)
  case (Conj\<^sub>\<alpha> tset\<^sub>\<alpha>)
  then show ?case
    by (auto intro!: Formula.hereditarily_fs.Conj\<^sub>\<alpha>) (metis imageE map_bset.rep_eq)
next
  case (Not\<^sub>\<alpha> t\<^sub>\<alpha>)
  then show ?case
    by (simp add: Formula.hereditarily_fs.Not\<^sub>\<alpha>)
next
  case (Pred\<^sub>\<alpha> f \<phi>)
  then show ?case
    by (simp add: Formula.hereditarily_fs.Act\<^sub>\<alpha> Formula.hereditarily_fs.Pred\<^sub>\<alpha>)
next
  case (Act\<^sub>\<alpha> t\<^sub>\<alpha> f \<alpha>)
  then show ?case
    by (simp add: Formula.hereditarily_fs.Act\<^sub>\<alpha>)
qed

text \<open>$L$-transform for $F/L$-formulas.\<close>

lift_definition L_transform_formula :: "('idx,'pred::fs,'act::bn,'eff::fs) formula \<Rightarrow> ('idx, 'pred, ('act,'eff) L_action) Formula.Tree\<^sub>\<alpha>" is
    L_transform_Tree\<^sub>\<alpha>
  .

lemma L_transform_formula_eqvt [eqvt]: "p \<bullet> L_transform_formula x = L_transform_formula (p \<bullet> x)"
  by transfer (simp)

lemma L_transform_formula_Conj [simp]:
  assumes "finite (supp xset)"
  shows "L_transform_formula (Conj xset) = Formula.Conj\<^sub>\<alpha> (map_bset L_transform_formula xset)"
  using assms by (simp add: Conj_def L_transform_formula_def bset.map_comp map_fun_def)

lemma L_transform_formula_Not [simp]: "L_transform_formula (Not x) = Formula.Not\<^sub>\<alpha> (L_transform_formula x)"
  by transfer simp

lemma L_transform_formula_Pred [simp]: "L_transform_formula (Pred f \<phi>) = Formula.Act\<^sub>\<alpha> (Eff f) (Formula.Pred\<^sub>\<alpha> \<phi>)"
  by transfer simp

lemma L_transform_formula_Act [simp]: "L_transform_formula (FL_Formula.Act f \<alpha> x) = Formula.Act\<^sub>\<alpha> (Eff f) (Formula.Act\<^sub>\<alpha> (Act \<alpha>) (L_transform_formula x))"
  by transfer simp

lemma L_transform_formula_hereditarily_fs [simp]: "Formula.hereditarily_fs (L_transform_formula x)"
  by transfer (fact L_transform_Tree\<^sub>\<alpha>_preserves_hereditarily_fs)

text \<open>Finally, we define the proper $L$-transform, which returns formulas instead of trees.\<close>

definition L_transform :: "('idx,'pred::fs,'act::bn,'eff::fs) formula \<Rightarrow> ('idx, 'pred, ('act,'eff) L_action) Formula.formula" where
  "L_transform x = Formula.Abs_formula (L_transform_formula x)"

lemma L_transform_eqvt [eqvt]: "p \<bullet> L_transform x = L_transform (p \<bullet> x)"
  unfolding L_transform_def by simp

lemma finite_supp_map_bset_L_transform [simp]:
  assumes "finite (supp xset)"
  shows "finite (supp (map_bset L_transform xset))"
proof -
  have "eqvt map_bset" and "eqvt L_transform"
    by (simp add: eqvtI)+
  then have "supp (map_bset L_transform) = {}"
    using supp_fun_eqvt supp_fun_app_eqvt by blast
  then have "supp (map_bset L_transform xset) \<subseteq> supp xset"
    using supp_fun_app by blast
  with assms show "finite (supp (map_bset L_transform xset))"
    by (metis finite_subset)
qed

lemma L_transform_Conj [simp]:
  assumes "finite (supp xset)"
  shows "L_transform (Conj xset) = Formula.Conj (map_bset L_transform xset)"
  using assms unfolding L_transform_def by (simp add: Formula.Conj_def bset.map_comp o_def)

lemma L_transform_Not [simp]: "L_transform (Not x) = Formula.Not (L_transform x)"
  unfolding L_transform_def by (simp add: Formula.Not_def)

lemma L_transform_Pred [simp]: "L_transform (Pred f \<phi>) = Formula.Act (Eff f) (Formula.Pred \<phi>)"
  unfolding L_transform_def by (simp add: Formula.Act_def Formula.Pred_def Formula.hereditarily_fs.Pred\<^sub>\<alpha>)

lemma L_transform_Act [simp]: "L_transform (FL_Formula.Act f \<alpha> x) = Formula.Act (Eff f) (Formula.Act (Act \<alpha>) (L_transform x))"
  unfolding L_transform_def by (simp add: Formula.Act_def Formula.hereditarily_fs.Act\<^sub>\<alpha>)

context effect_nominal_ts
begin

  interpretation L_transform: nominal_ts "(\<turnstile>\<^sub>L)" "(\<rightarrow>\<^sub>L)"
  by unfold_locales (fact L_satisfies_eqvt, fact L_transition_eqvt)

  text \<open>The $L$-transform preserves satisfaction of formulas in the following sense:\<close>

  theorem FL_valid_iff_valid_L_transform:
    assumes "(x::('idx,'pred,'act,'effect) formula) \<in> \<A>[F]"
    shows "FL_valid P x \<longleftrightarrow> L_transform.valid (EF (F, P)) (L_transform x)"
  using assms proof (induct x arbitrary: P)
    case (Conj xset F)
    then show ?case
      by auto (metis imageE map_bset.rep_eq, simp add: map_bset.rep_eq)
  next
    case (Not F x)
    then show ?case by simp
  next
    case (Pred f F \<phi>)
    let ?\<phi> = "Formula.Pred \<phi> :: ('idx, 'pred, ('act,'effect) L_action) Formula.formula"
    show ?case
    proof
      assume "FL_valid P (Pred f \<phi>)"
      then have "L_transform.valid (AC (f, F, \<langle>f\<rangle>P)) ?\<phi>"
        by (simp add: L_transform.valid_Act)
      moreover from \<open>f \<in>\<^sub>f\<^sub>s F\<close> have "EF (F, P) \<rightarrow>\<^sub>L \<langle>Eff f, AC (f, F, \<langle>f\<rangle>P)\<rangle>"
        by (metis L_transition.simps(2))
      ultimately show "L_transform.valid (EF (F, P)) (L_transform (Pred f \<phi>))"
        using L_transform.valid_Act by fastforce
    next
      assume "L_transform.valid (EF (F, P)) (L_transform (Pred f \<phi>))"
      then obtain P' where trans: "EF (F, P) \<rightarrow>\<^sub>L \<langle>Eff f, P'\<rangle>" and valid: "L_transform.valid P' ?\<phi>"
        by simp (metis bn_L_action.simps(2) empty_iff fresh_star_def L_transform.valid_Act_fresh L_transform.valid_Pred L_transition.simps(2))
      from trans have "P' = AC (f, F, \<langle>f\<rangle>P)"
        by (simp add: residual_empty_bn_eq_iff)
      with valid show "FL_valid P (Pred f \<phi>)"
        by simp
    qed
  next
    case (Act f F \<alpha> x)
    show ?case
    proof
      assume "FL_valid P (FL_Formula.Act f \<alpha> x)"
      then obtain \<alpha>' x' P' where eq: "FL_Formula.Act f \<alpha> x = FL_Formula.Act f \<alpha>' x'" and trans: "\<langle>f\<rangle>P \<rightarrow> \<langle>\<alpha>',P'\<rangle>" and valid: "FL_valid P' x'" and fresh: "bn \<alpha>' \<sharp>* (F, f)"
        by (metis FL_valid_Act_strong finite_supp)
      from eq obtain p where p_x: "p \<bullet> x = x'" and p_\<alpha>: "p \<bullet> \<alpha> = \<alpha>'" and supp_p: "supp p \<subseteq> bn \<alpha> \<union> bn \<alpha>'"
        by (metis bn_eqvt FL_Formula.Act_eq_iff_perm_renaming)
      from \<open>bn \<alpha> \<sharp>* (F, f)\<close> and fresh have "supp (F, f) \<sharp>* p"
        using supp_p by (auto simp add: fresh_star_Pair fresh_star_def supp_Pair fresh_def)
      then have "p \<bullet> F = F" and "p \<bullet> f = f"
        using supp_perm_eq by fastforce+

      from valid have "FL_valid (-p \<bullet> P') x"
        using p_x by (metis FL_valid_eqvt permute_minus_cancel(2))
      then have "L_transform.valid (EF (L (\<alpha>, F, f), -p \<bullet> P')) (L_transform x)"
        using Act.hyps(4) by metis
      then have "L_transform.valid (p \<bullet> EF (L (\<alpha>, F, f), -p \<bullet> P')) (p \<bullet> L_transform x)"
        by (fact L_transform.valid_eqvt)
      then have "L_transform.valid (EF (L (\<alpha>', F, f), P')) (L_transform x')"
        using p_x and p_\<alpha> and \<open>p \<bullet> F = F\<close> and \<open>p \<bullet> f = f\<close> by simp

      then have "L_transform.valid (AC (f, F, \<langle>f\<rangle>P)) (Formula.Act (Act \<alpha>') (L_transform x'))"
        using trans fresh L_transform.valid_Act by fastforce
      with \<open>f \<in>\<^sub>f\<^sub>s F\<close> and eq show "L_transform.valid (EF (F, P)) (L_transform (FL_Formula.Act f \<alpha> x))"
        using L_transform.valid_Act by fastforce
    next
      assume *: "L_transform.valid (EF (F, P)) (L_transform (FL_Formula.Act f \<alpha> x))"

      \<comment> \<open>rename~@{term "bn \<alpha>"} to avoid~@{term "(F, f, P)"}, without touching~@{term F} or~@{term "FL_Formula.Act f \<alpha> x"}\<close>
      obtain p where 1: "(p \<bullet> bn \<alpha>) \<sharp>* (F, f, P)" and 2: "supp (F, FL_Formula.Act f \<alpha> x) \<sharp>* p"
      proof (rule at_set_avoiding2[of "bn \<alpha>" "(F, f, P)" "(F, FL_Formula.Act f \<alpha> x)", THEN exE])
        show "finite (bn \<alpha>)" by (fact bn_finite)
      next
        show "finite (supp (F, f, P))" by (fact finite_supp)
      next
        show "finite (supp (F, FL_Formula.Act f \<alpha> x))" by (simp add: finite_supp)
      next
        from \<open>bn \<alpha> \<sharp>* (F, f)\<close> show "bn \<alpha> \<sharp>* (F, FL_Formula.Act f \<alpha> x)"
          by (simp add: fresh_star_Pair fresh_star_def fresh_def supp_Pair)
      qed metis
      from 2 have "supp F \<sharp>* p" and Act_fresh: "supp (FL_Formula.Act f \<alpha> x) \<sharp>* p"
        by (simp add: fresh_star_Pair fresh_star_def supp_Pair)+
      from \<open>supp F \<sharp>* p\<close> have "p \<bullet> F = F"
        by (metis supp_perm_eq)
      from Act_fresh have "p \<bullet> f = f"
        using fresh_star_Un supp_perm_eq by fastforce
      from Act_fresh have eq: "FL_Formula.Act f \<alpha> x = FL_Formula.Act f (p \<bullet> \<alpha>) (p \<bullet> x)"
        by (metis FL_Formula.Act_eq_iff_perm FL_Formula.Act_eqvt supp_perm_eq)

      with * obtain P' where trans: "EF (F, P) \<rightarrow>\<^sub>L \<langle>Eff f,P'\<rangle>" and valid: "L_transform.valid P' (Formula.Act (Act (p \<bullet> \<alpha>)) (L_transform (p \<bullet> x)))"
        using L_transform_Act by (metis L_transform.valid_Act_fresh bn_L_action.simps(2) empty_iff fresh_star_def)
      from trans have P': "P' = AC (f, F, \<langle>f\<rangle>P)"
        by (simp add: residual_empty_bn_eq_iff)

      have supp_f_P: "supp (\<langle>f\<rangle>P) \<subseteq> supp f \<union> supp P"
        using effect_apply_eqvt supp_fun_app supp_fun_app_eqvt by fastforce
      with 1 have "bn (Act (p \<bullet> \<alpha>)) \<sharp>* AC (f, F, \<langle>f\<rangle>P)"
        by (auto simp add: bn_eqvt fresh_star_def fresh_def supp_Pair)
      with valid obtain P'' where trans': "AC (f, F, \<langle>f\<rangle>P) \<rightarrow>\<^sub>L \<langle>Act (p \<bullet> \<alpha>),P''\<rangle>" and valid': "L_transform.valid P'' (L_transform (p \<bullet> x))"
        using P' by (metis L_transform.valid_Act_fresh)

      from supp_f_P and 1 have "bn (p \<bullet> \<alpha>) \<sharp>* (F, f, \<langle>f\<rangle>P)"
        by (auto simp add: bn_eqvt fresh_star_def fresh_def supp_Pair)
      with trans' obtain P' where P'': "P'' = EF (L (p \<bullet> \<alpha>, F, f), P')" and trans'': "\<langle>f\<rangle>P \<rightarrow> \<langle>p \<bullet> \<alpha>,P'\<rangle>"
        by (metis L_transition_AC_fresh)

      from valid' have "L_transform.valid (-p \<bullet> P'') (L_transform x)"
        by (metis (mono_tags) L_transform.valid_eqvt L_transform_eqvt permute_minus_cancel(2))
      with P'' \<open>p \<bullet> F = F\<close> \<open>p \<bullet> f = f\<close> have "L_transform.valid (EF (L (\<alpha>, F, f), - p \<bullet> P')) (L_transform x)"
        by simp (metis pemute_minus_self permute_minus_cancel(1))
      then have "FL_valid P' (p \<bullet> x)"
        using Act.hyps(4) by (metis FL_valid_eqvt permute_minus_cancel(1))

      with trans'' and eq show "FL_valid P (FL_Formula.Act f \<alpha> x)"
        by (metis FL_valid_Act)
    qed
  qed

end

subsection \<open>Bisimilarity in the \texorpdfstring{$L$}{L}-transform\<close>

context effect_nominal_ts
begin

  (* Not quite sure why this is needed again? *)
  interpretation L_transform: nominal_ts "(\<turnstile>\<^sub>L)" "(\<rightarrow>\<^sub>L)"
  by unfold_locales (fact L_satisfies_eqvt, fact L_transition_eqvt)

  notation L_transform.bisimilar (infix "\<sim>\<cdot>\<^sub>L" 100)

  text \<open>$F/L$-bisimilarity is equivalent to bisimilarity in the $L$-transform.\<close>

  inductive L_bisimilar :: "('state,'effect) L_state \<Rightarrow> ('state,'effect) L_state \<Rightarrow> bool" where
    "P \<sim>\<cdot>[F] Q \<Longrightarrow> L_bisimilar (EF (F,P)) (EF (F,Q))"
  | "P \<sim>\<cdot>[F] Q \<Longrightarrow> f \<in>\<^sub>f\<^sub>s F \<Longrightarrow> L_bisimilar (AC (f, F, \<langle>f\<rangle>P)) (AC (f, F, \<langle>f\<rangle>Q))"

  lemma L_bisimilar_is_L_transform_bisimulation: "L_transform.is_bisimulation L_bisimilar"
  unfolding L_transform.is_bisimulation_def
  proof
    show "symp L_bisimilar"
      by (metis FL_bisimilar_symp L_bisimilar.cases L_bisimilar.intros symp_def)
  next
    have "\<forall>P\<^sub>L Q\<^sub>L. L_bisimilar P\<^sub>L Q\<^sub>L \<longrightarrow> (\<forall>\<phi>. P\<^sub>L \<turnstile>\<^sub>L \<phi> \<longrightarrow> Q\<^sub>L \<turnstile>\<^sub>L \<phi>)" (is ?S)
      using FL_bisimilar_is_L_bisimulation L_bisimilar.simps is_L_bisimulation_def by auto
    moreover have "\<forall>P\<^sub>L Q\<^sub>L. L_bisimilar P\<^sub>L Q\<^sub>L \<longrightarrow> (\<forall>\<alpha>\<^sub>L P\<^sub>L'. bn \<alpha>\<^sub>L \<sharp>* Q\<^sub>L \<longrightarrow> P\<^sub>L \<rightarrow>\<^sub>L \<langle>\<alpha>\<^sub>L,P\<^sub>L'\<rangle> \<longrightarrow> (\<exists>Q\<^sub>L'. Q\<^sub>L \<rightarrow>\<^sub>L \<langle>\<alpha>\<^sub>L,Q\<^sub>L'\<rangle> \<and> L_bisimilar P\<^sub>L' Q\<^sub>L'))" (is ?T)
      proof (clarify)
        fix P\<^sub>L Q\<^sub>L \<alpha>\<^sub>L P\<^sub>L'
        assume L_bisim: "L_bisimilar P\<^sub>L Q\<^sub>L" and fresh\<^sub>L: "bn \<alpha>\<^sub>L \<sharp>* Q\<^sub>L" and trans\<^sub>L: "P\<^sub>L \<rightarrow>\<^sub>L \<langle>\<alpha>\<^sub>L,P\<^sub>L'\<rangle>"
        obtain Q\<^sub>L' where "Q\<^sub>L \<rightarrow>\<^sub>L \<langle>\<alpha>\<^sub>L,Q\<^sub>L'\<rangle>" and "L_bisimilar P\<^sub>L' Q\<^sub>L'"
          using L_bisim proof (rule L_bisimilar.cases)
            fix P F Q
            assume P\<^sub>L: "P\<^sub>L = EF (F, P)" and Q\<^sub>L: "Q\<^sub>L = EF (F, Q)" and bisim: "P \<sim>\<cdot>[F] Q"
            from P\<^sub>L and trans\<^sub>L obtain f where effect: "f \<in>\<^sub>f\<^sub>s F" and \<alpha>\<^sub>LP\<^sub>L': "\<langle>\<alpha>\<^sub>L,P\<^sub>L'\<rangle> = \<langle>Eff f, AC (f, F, \<langle>f\<rangle>P)\<rangle>"
              using L_transition.simps(2) by blast
            from Q\<^sub>L and effect have "Q\<^sub>L \<rightarrow>\<^sub>L \<langle>Eff f, AC (f, F, \<langle>f\<rangle>Q)\<rangle>"
              using L_transition.simps(2) by blast
            moreover from bisim and effect have "L_bisimilar (AC (f, F, \<langle>f\<rangle>P)) (AC (f, F, \<langle>f\<rangle>Q))"
              using L_bisimilar.intros(2) by blast
            moreover from \<alpha>\<^sub>LP\<^sub>L' have "\<alpha>\<^sub>L = Eff f" and "P\<^sub>L' = AC (f, F, \<langle>f\<rangle>P)"
              by (metis bn_L_action.simps(2) residual_empty_bn_eq_iff)+
            ultimately show "thesis"
              using \<open>\<And>Q\<^sub>L'. Q\<^sub>L \<rightarrow>\<^sub>L \<langle>\<alpha>\<^sub>L,Q\<^sub>L'\<rangle> \<Longrightarrow> L_bisimilar P\<^sub>L' Q\<^sub>L' \<Longrightarrow> thesis\<close> by blast
          next
            fix P F Q f
            assume P\<^sub>L: "P\<^sub>L = AC (f, F, \<langle>f\<rangle>P)" and Q\<^sub>L: "Q\<^sub>L = AC (f, F, \<langle>f\<rangle>Q)" and bisim: "P \<sim>\<cdot>[F] Q" and effect: "f \<in>\<^sub>f\<^sub>s F"
            have "finite (supp (\<langle>f\<rangle>Q, F, f))"
              by (fact finite_supp)
            with P\<^sub>L and trans\<^sub>L obtain \<alpha> P' where trans_P: "\<langle>f\<rangle>P \<rightarrow> \<langle>\<alpha>,P'\<rangle>" and \<alpha>\<^sub>LP\<^sub>L': "\<langle>\<alpha>\<^sub>L,P\<^sub>L'\<rangle> = \<langle>Act \<alpha>, EF (L (\<alpha>,F,f), P')\<rangle>" and fresh: "bn \<alpha> \<sharp>* (\<langle>f\<rangle>Q, F, f)"
              by (metis L_transition_AC_strong)
            from bisim and effect and fresh and trans_P obtain Q' where trans_Q: "\<langle>f\<rangle>Q \<rightarrow> \<langle>\<alpha>,Q'\<rangle>" and bisim': "P' \<sim>\<cdot>[L (\<alpha>,F,f)] Q'"
              by (metis FL_bisimilar_simulation_step)
            from fresh have "bn \<alpha> \<sharp>* (F, f)"
              by (meson fresh_PairD(2) fresh_star_def)
            with Q\<^sub>L and trans_Q have trans_Q\<^sub>L: "Q\<^sub>L \<rightarrow>\<^sub>L \<langle>Act \<alpha>, EF (L (\<alpha>,F,f), Q')\<rangle>"
              by (metis L_transition.simps(1))

            from \<alpha>\<^sub>LP\<^sub>L' obtain p where p: "(\<alpha>\<^sub>L,P\<^sub>L') = p \<bullet> (Act \<alpha>, EF (L (\<alpha>,F,f), P'))" and supp_p: "supp p \<subseteq> bn \<alpha> \<union> bn \<alpha>\<^sub>L"
              by (metis (no_types, lifting) bn_L_action.simps(1) residual_eq_iff_perm_renaming)
            from supp_p and fresh and fresh\<^sub>L and Q\<^sub>L have "supp p \<sharp>* (\<langle>f\<rangle>Q, F, f)"
              unfolding fresh_star_def by (metis (no_types, hide_lams) Un_iff fresh_Pair fresh_def subsetCE supp_AC)
            then have p_fQ: "p \<bullet> \<langle>f\<rangle>Q = \<langle>f\<rangle>Q" and p_Ff: "p \<bullet> (F,f) = (F,f)"
              by (simp add: fresh_star_def perm_supp_eq)+
            from p and p_Ff have "\<alpha>\<^sub>L = Act (p \<bullet> \<alpha>)" and "P\<^sub>L' = EF (L (p \<bullet> \<alpha>, F, f), p \<bullet> P')"
              by auto

            moreover from Q\<^sub>L and p_fQ and p_Ff have "p \<bullet> Q\<^sub>L = Q\<^sub>L"
              by simp
            with trans_Q\<^sub>L have "Q\<^sub>L \<rightarrow>\<^sub>L p \<bullet> \<langle>Act \<alpha>, EF (L (\<alpha>,F,f), Q')\<rangle>"
              by (metis L_transform.transition_eqvt)
            then have "Q\<^sub>L \<rightarrow>\<^sub>L \<langle>Act (p \<bullet> \<alpha>), EF (L (p \<bullet> \<alpha>, F, f), p \<bullet> Q')\<rangle>"
              using p_Ff by simp

            moreover from p_Ff have "p \<bullet> F = F" and "p \<bullet> f = f"
              by simp+
            with bisim' have "(p \<bullet> P') \<sim>\<cdot>[L (p \<bullet> \<alpha>, F, f)] (p \<bullet> Q')"
              by (metis FL_bisimilar_eqvt L_eqvt')
            then have "L_bisimilar (EF (L (p \<bullet> \<alpha>, F, f), p \<bullet> P')) (EF (L (p \<bullet> \<alpha>, F, f), p \<bullet> Q'))"
              by (metis L_bisimilar.intros(1))

            ultimately show thesis
                using \<open>\<And>Q\<^sub>L'. Q\<^sub>L \<rightarrow>\<^sub>L \<langle>\<alpha>\<^sub>L,Q\<^sub>L'\<rangle> \<Longrightarrow> L_bisimilar P\<^sub>L' Q\<^sub>L' \<Longrightarrow> thesis\<close> by blast
          qed
        then show "\<exists>Q\<^sub>L'. Q\<^sub>L \<rightarrow>\<^sub>L \<langle>\<alpha>\<^sub>L,Q\<^sub>L'\<rangle> \<and> L_bisimilar P\<^sub>L' Q\<^sub>L'"
          by auto
      qed
    ultimately show "?S \<and> ?T"
      by metis
  qed

  definition invL_FL_bisimilar :: "'effect first \<Rightarrow> 'state \<Rightarrow> 'state \<Rightarrow> bool" where
    "invL_FL_bisimilar F P Q \<equiv> EF (F,P) \<sim>\<cdot>\<^sub>L EF(F,Q)"

  lemma invL_FL_bisimilar_is_L_bisimulation: "is_L_bisimulation invL_FL_bisimilar"
  unfolding is_L_bisimulation_def
  proof
    fix F
    have "symp (invL_FL_bisimilar F)" (is ?R)
      by (metis L_transform.bisimilar_symp invL_FL_bisimilar_def symp_def)
    moreover have "\<forall>P Q. invL_FL_bisimilar F P Q \<longrightarrow> (\<forall>f. f \<in>\<^sub>f\<^sub>s F \<longrightarrow> (\<forall>\<phi>. \<langle>f\<rangle>P \<turnstile> \<phi> \<longrightarrow> \<langle>f\<rangle>Q \<turnstile> \<phi>))" (is ?S)
      proof (clarify)
        fix P Q f \<phi>
        assume bisim: "invL_FL_bisimilar F P Q" and effect: "f \<in>\<^sub>f\<^sub>s F" and satisfies: "\<langle>f\<rangle>P \<turnstile> \<phi>"
        from bisim have "EF (F,P) \<sim>\<cdot>\<^sub>L EF (F,Q)"
          by (metis invL_FL_bisimilar_def)
        moreover have "bn (Eff f) \<sharp>* EF (F,Q)"
          by (simp add: fresh_star_def)
        moreover from effect have "EF (F,P) \<rightarrow>\<^sub>L \<langle>Eff f, AC (f, F, \<langle>f\<rangle>P)\<rangle>"
          by (metis L_transition.simps(2))
        ultimately obtain Q\<^sub>L' where trans: "EF (F,Q) \<rightarrow>\<^sub>L \<langle>Eff f, Q\<^sub>L'\<rangle>" and L_bisim: "AC (f, F, \<langle>f\<rangle>P) \<sim>\<cdot>\<^sub>L Q\<^sub>L'"
          by (metis L_transform.bisimilar_simulation_step)
        from trans obtain f' where "\<langle>Eff f :: ('act,'effect) L_action, Q\<^sub>L'\<rangle> = \<langle>Eff f', AC (f', F, \<langle>f'\<rangle>Q)\<rangle>"
          by (metis L_transition.simps(2))
        then have Q\<^sub>L': "Q\<^sub>L' = AC (f, F, \<langle>f\<rangle>Q)"
          by (metis L_action.inject(2) bn_L_action.simps(2) residual_empty_bn_eq_iff)

        from satisfies have "AC (f, F, \<langle>f\<rangle>P) \<turnstile>\<^sub>L \<phi>"
          by (metis L_satisfies.simps(1))
        with L_bisim and Q\<^sub>L' have "AC (f, F, \<langle>f\<rangle>Q) \<turnstile>\<^sub>L \<phi>"
          by (metis L_transform.bisimilar_is_bisimulation L_transform.is_bisimulation_def)
        then show "\<langle>f\<rangle>Q \<turnstile> \<phi>"
          by (metis L_satisfies.simps(1))
      qed
    moreover have "\<forall>P Q. invL_FL_bisimilar F P Q \<longrightarrow> (\<forall>f. f \<in>\<^sub>f\<^sub>s F \<longrightarrow> (\<forall>\<alpha> P'. bn \<alpha> \<sharp>* (\<langle>f\<rangle>Q, F, f) \<longrightarrow>
        \<langle>f\<rangle>P \<rightarrow> \<langle>\<alpha>,P'\<rangle> \<longrightarrow> (\<exists>Q'. \<langle>f\<rangle>Q \<rightarrow> \<langle>\<alpha>,Q'\<rangle> \<and> invL_FL_bisimilar (L (\<alpha>, F, f)) P' Q')))" (is ?T)
      proof (clarify)
        fix P Q f \<alpha> P'
        assume bisim: "invL_FL_bisimilar F P Q" and effect: "f \<in>\<^sub>f\<^sub>s F" and fresh: "bn \<alpha> \<sharp>* (\<langle>f\<rangle>Q, F, f)" and trans: "\<langle>f\<rangle>P \<rightarrow> \<langle>\<alpha>,P'\<rangle>"
        from bisim have "EF (F,P) \<sim>\<cdot>\<^sub>L EF (F,Q)"
          by (metis invL_FL_bisimilar_def)
        moreover have "bn (Eff f) \<sharp>* EF (F,Q)"
          by (simp add: fresh_star_def)
        moreover from effect have "EF (F,P) \<rightarrow>\<^sub>L \<langle>Eff f, AC (f, F, \<langle>f\<rangle>P)\<rangle>"
          by (metis L_transition.simps(2))
        ultimately obtain Q\<^sub>L' where trans\<^sub>L: "EF (F,Q) \<rightarrow>\<^sub>L \<langle>Eff f, Q\<^sub>L'\<rangle>" and L_bisim: "AC (f, F, \<langle>f\<rangle>P) \<sim>\<cdot>\<^sub>L Q\<^sub>L'"
          by (metis L_transform.bisimilar_simulation_step)
        from trans\<^sub>L obtain f' where "\<langle>Eff f :: ('act,'effect) L_action, Q\<^sub>L'\<rangle> = \<langle>Eff f', AC (f', F, \<langle>f'\<rangle>Q)\<rangle>"
          by (metis L_transition.simps(2))
        then have Q\<^sub>L': "Q\<^sub>L' = AC (f, F, \<langle>f\<rangle>Q)"
          by (metis L_action.inject(2) bn_L_action.simps(2) residual_empty_bn_eq_iff)

        from L_bisim and Q\<^sub>L' have "AC (f, F, \<langle>f\<rangle>P) \<sim>\<cdot>\<^sub>L AC (f, F, \<langle>f\<rangle>Q)"
          by metis
        moreover from fresh have "bn (Act \<alpha>) \<sharp>* AC (f, F, \<langle>f\<rangle>Q)"
          by (simp add: fresh_def fresh_star_def supp_Pair)
        moreover from fresh have "bn \<alpha> \<sharp>* (F, f)"
          by (simp add: fresh_star_Pair)
        with trans have "AC (f, F, \<langle>f\<rangle>P) \<rightarrow>\<^sub>L \<langle>Act \<alpha>, EF (L (\<alpha>,F,f), P')\<rangle>"
          by (metis L_transition.simps(1))
        ultimately obtain Q\<^sub>L'' where trans\<^sub>L': "AC (f, F, \<langle>f\<rangle>Q) \<rightarrow>\<^sub>L \<langle>Act \<alpha>, Q\<^sub>L''\<rangle>" and L_bisim': "EF (L (\<alpha>,F,f), P') \<sim>\<cdot>\<^sub>L Q\<^sub>L''"
          by (metis L_transform.bisimilar_simulation_step)

        have "finite (supp (\<langle>f\<rangle>Q, F, f))"
          by (fact finite_supp)
        with trans\<^sub>L' obtain \<alpha>' Q' where trans': "\<langle>f\<rangle>Q \<rightarrow> \<langle>\<alpha>',Q'\<rangle>" and alpha: "\<langle>Act \<alpha> :: ('act,'effect) L_action, Q\<^sub>L''\<rangle> = \<langle>Act \<alpha>', EF (L (\<alpha>',F,f), Q')\<rangle>" and fresh': "bn \<alpha>' \<sharp>* (\<langle>f\<rangle>Q, F,f)"
          by (metis L_transition_AC_strong)

        from alpha obtain p where p: "(Act \<alpha> :: ('act,'effect) L_action, Q\<^sub>L'') = p \<bullet> (Act \<alpha>', EF (L (\<alpha>',F,f), Q'))" and supp_p: "supp p \<subseteq> bn \<alpha> \<union> bn \<alpha>'"
          by (metis Un_commute bn_L_action.simps(1) residual_eq_iff_perm_renaming)
        from supp_p and fresh and fresh' have "supp p \<sharp>* (\<langle>f\<rangle>Q, F,f)"
          unfolding fresh_star_def by (metis (no_types, hide_lams) Un_iff subsetCE)
        then have p_fQ: "p \<bullet> \<langle>f\<rangle>Q = \<langle>f\<rangle>Q" and p_F: "p \<bullet> F = F" and p_f: "p \<bullet> f = f"
          by (simp add: fresh_star_def perm_supp_eq)+
        from p and p_F and p_f have p_\<alpha>': "p \<bullet> \<alpha>' = \<alpha>" and Q\<^sub>L'': "Q\<^sub>L'' = EF (L (p \<bullet> \<alpha>', F, f), p \<bullet> Q')"
          by auto

        from trans' and p_fQ and p_\<alpha>' have "\<langle>f\<rangle>Q \<rightarrow> \<langle>\<alpha>, p \<bullet> Q'\<rangle>"
          by (metis transition_eqvt')
        moreover from L_bisim' and Q\<^sub>L'' and p_\<alpha>' have "invL_FL_bisimilar (L (\<alpha>,F,f)) P' (p \<bullet> Q')"
          by (metis invL_FL_bisimilar_def)
        ultimately show "\<exists>Q'. \<langle>f\<rangle>Q \<rightarrow> \<langle>\<alpha>,Q'\<rangle> \<and> invL_FL_bisimilar (L (\<alpha>,F,f)) P' Q'"
          by metis
      qed
    ultimately show "?R \<and> ?S \<and> ?T"
      by metis
  qed

  theorem "P \<sim>\<cdot>[F] Q \<longleftrightarrow> EF (F,P) \<sim>\<cdot>\<^sub>L EF(F,Q)"
  proof
    assume "P \<sim>\<cdot>[F] Q"
    then have "L_bisimilar (EF (F,P)) (EF (F,Q))"
        by (metis L_bisimilar.intros(1))
    then show "EF (F,P) \<sim>\<cdot>\<^sub>L EF(F,Q)"
      by (metis L_bisimilar_is_L_transform_bisimulation L_transform.bisimilar_def)
  next
    assume "EF (F, P) \<sim>\<cdot>\<^sub>L EF (F, Q)"
    then have "invL_FL_bisimilar F P Q"
      by (metis invL_FL_bisimilar_def)
    then show "P \<sim>\<cdot>[F] Q"
      by (metis invL_FL_bisimilar_is_L_bisimulation FL_bisimilar_def)
  qed

end

text \<open>The following (alternative) proof of the ``$\leftarrow$'' direction of this equivalence,
namely that bisimilarity in the $L$-transform implies $F/L$-bisimilarity, uses the fact that the
$L$-transform preserves satisfaction of formulas, together with the fact that bisimilarity (in the
$L$-transform) implies logical equivalence. However, since we proved the latter in the context of
indexed nominal transition systems, this proof requires an indexed nominal transition system with
effects where, additionally, the cardinality of the state set of the $L$-transform is bounded. We
could re-organize our formalization to remove this assumption: the proof of
@{thm indexed_nominal_ts.bisimilarity_implies_equivalence} does not actually make use of the
cardinality assumptions provided by indexed nominal transition systems.\<close>

locale L_transform_indexed_effect_nominal_ts = indexed_effect_nominal_ts L satisfies transition effect_apply
  for L :: "('act::bn) \<times> ('effect::fs) fs_set \<times> 'effect \<Rightarrow> 'effect fs_set"
  and satisfies :: "'state::fs \<Rightarrow> 'pred::fs \<Rightarrow> bool" (infix "\<turnstile>" 70)
  and transition :: "'state \<Rightarrow> ('act,'state) residual \<Rightarrow> bool" (infix "\<rightarrow>" 70)
  and effect_apply :: "'effect \<Rightarrow> 'state \<Rightarrow> 'state" ("\<langle>_\<rangle>_" [0,101] 100) +
  assumes card_idx_L_transform_state: "|UNIV::('state, 'effect) L_state set| <o |UNIV::'idx set|"
begin

  interpretation L_transform: indexed_nominal_ts "(\<turnstile>\<^sub>L)" "(\<rightarrow>\<^sub>L)"
    by unfold_locales (fact L_satisfies_eqvt, fact L_transition_eqvt, fact card_idx_perm, fact card_idx_L_transform_state)

  notation L_transform.bisimilar (infix "\<sim>\<cdot>\<^sub>L" 100)

  theorem "EF (F,P) \<sim>\<cdot>\<^sub>L EF(F,Q) \<longrightarrow> P \<sim>\<cdot>[F] Q"
  proof
    assume "EF (F, P) \<sim>\<cdot>\<^sub>L EF (F, Q)"
    then have "L_transform.logically_equivalent (EF (F, P)) (EF (F, Q))"
      by (fact L_transform.bisimilarity_implies_equivalence)
    with FL_valid_iff_valid_L_transform have "FL_logically_equivalent F P Q"
      using FL_logically_equivalent_def L_transform.logically_equivalent_def by blast
    then show "P \<sim>\<cdot>[F] Q"
      by (fact FL_equivalence_implies_bisimilarity)
  qed

end

end