theory TickTock_Prefix
  imports TickTock_Core
begin

subsection {* Prefix *}

definition PrefixTT :: "'e \<Rightarrow> 'e ttobs list set \<Rightarrow> 'e ttobs list set" (infixr "\<rightarrow>\<^sub>C" 61) where
  "PrefixTT e P =
    {t. \<exists> s\<in>tocks({x. x \<noteq> Tock \<and> x \<noteq> Event e}). t = s \<or> (\<exists> X. Tock \<notin> X \<and> Event e \<notin> X \<and> t = s @ [[X]\<^sub>R])}
     \<union> {t. \<exists> s\<in>tocks({x. x \<noteq> Tock \<and> x \<noteq> Event e}). t = s \<or> (\<exists> \<sigma>\<in>P. t = s @ [[Event e]\<^sub>E] @ \<sigma>)}"

lemma PrefixTT_wf: "\<forall> t\<in>P. ttWF t \<Longrightarrow> \<forall> t\<in>PrefixTT e P. ttWF t"
  unfolding PrefixTT_def apply (auto simp add: tocks_wf tocks_append_wf)
  apply (metis (mono_tags, lifting) mem_Collect_eq tocks_wf)
  apply (metis (mono_tags, lifting) mem_Collect_eq tocks_append_wf ttWF.simps(2))
  apply (metis (mono_tags, lifting) mem_Collect_eq tocks_wf)
  by (metis (mono_tags, lifting) mem_Collect_eq tocks_append_wf ttWF.simps(4))

lemma TT1_Prefix:
  assumes "TT1 P"
  shows "TT1 (e \<rightarrow>\<^sub>C P)"
  unfolding TT1_def
proof auto
  fix \<rho> \<sigma> :: "'a ttobs list"
  show "\<rho> \<lesssim>\<^sub>C \<sigma> \<Longrightarrow> \<sigma> \<in> e \<rightarrow>\<^sub>C P \<Longrightarrow> \<rho> \<in> e \<rightarrow>\<^sub>C P"
    unfolding PrefixTT_def
  proof auto
    assume assm1: "\<rho> \<lesssim>\<^sub>C \<sigma>"
    assume assm2: "\<forall>s\<in>tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}. \<rho> \<noteq> s \<and> (\<forall>\<sigma>\<in>P. \<rho> \<noteq> s @ [Event e]\<^sub>E # \<sigma>)"
    assume assm3: "\<sigma> \<in> tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}"
    obtain s where "s\<in>tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}" "\<rho> = s \<or> (\<exists>Y. \<rho> = s @ [[Y]\<^sub>R] \<and> Y \<subseteq> {x. x \<noteq> Tock \<and> x \<noteq> Event e})"
      using assm1 assm3 tt_prefix_subset_tocks by blast
    then show "\<exists>s\<in>tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}. \<exists>X. Tock \<notin> X \<and> Event e \<notin> X \<and> \<rho> = s @ [[X]\<^sub>R]"
      using assm2 by auto
  next
    fix s X
    assume assm1: "\<rho> \<lesssim>\<^sub>C s @ [[X]\<^sub>R]"
    assume assm2: "\<forall>s\<in>tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}. \<rho> \<noteq> s \<and> (\<forall>\<sigma>\<in>P. \<rho> \<noteq> s @ [Event e]\<^sub>E # \<sigma>)"
    assume assm3: "s \<in> tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}"
    assume assm4: "Tock \<notin> X"
    assume assm5: "Event e \<notin> X"
    obtain t Z where "t\<in>tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}" "\<rho> = t \<or> \<rho> = t @ [[Z]\<^sub>R]" "Z \<subseteq> {x. x \<noteq> Tock \<and> x \<noteq> Event e} \<or> Z \<subseteq> X"
      using assm1 assm3 tt_prefix_subset_tocks_refusal by blast
    then show "\<exists>s\<in>tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}. \<exists>X. Tock \<notin> X \<and> Event e \<notin> X \<and> \<rho> = s @ [[X]\<^sub>R]"
      using assm2 assm4 assm5 by auto
  next
    assume assm1: "\<rho> \<lesssim>\<^sub>C \<sigma>"
    assume assm2: "\<forall>s\<in>tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}. \<rho> \<noteq> s \<and> (\<forall>\<sigma>\<in>P. \<rho> \<noteq> s @ [Event e]\<^sub>E # \<sigma>)"
    assume assm3: "\<sigma> \<in> tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}"
    obtain s where "s\<in>tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}" "\<rho> = s \<or> (\<exists>Y. \<rho> = s @ [[Y]\<^sub>R] \<and> Y \<subseteq> {x. x \<noteq> Tock \<and> x \<noteq> Event e})"
      using assm1 assm3 tt_prefix_subset_tocks by blast
    then show "\<exists>s\<in>tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}. \<exists>X. Tock \<notin> X \<and> Event e \<notin> X \<and> \<rho> = s @ [[X]\<^sub>R]"
      using assm2 by auto
  next
    fix s \<sigma>'
    assume assm1: "\<rho> \<lesssim>\<^sub>C s @ [Event e]\<^sub>E # \<sigma>'"
    assume assm2: "\<forall>s\<in>tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}. \<rho> \<noteq> s \<and> (\<forall>\<sigma>\<in>P. \<rho> \<noteq> s @ [Event e]\<^sub>E # \<sigma>)"
    assume assm3: "s \<in> tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}"
    assume assm4: "\<sigma>' \<in> P"
    thm tt_prefix_subset_append_split
    from assm1 have "\<rho> \<lesssim>\<^sub>C (s @ [[Event e]\<^sub>E]) @ \<sigma>'"
      by simp
    then obtain a b where a_b_assms: "\<rho> = a @ b" "a \<lesssim>\<^sub>C s @ [[Event e]\<^sub>E]" "b \<lesssim>\<^sub>C \<sigma>'"
      "length a = length (s @ [[Event e]\<^sub>E]) \<and> length [x\<leftarrow>a . x = [Tock]\<^sub>E] = length [x\<leftarrow>(s @ [[Event e]\<^sub>E]) . x = [Tock]\<^sub>E] \<or> b = []"
      using tt_prefix_subset_append_split by blast
    then obtain s' where s'_assms: "s'\<in>tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}"
            "s' \<lesssim>\<^sub>C s"
             "a = s' \<or>
              (\<exists>Y. a = s' @ [[Y]\<^sub>R] \<and> Y \<subseteq> {x. x \<noteq> Tock \<and> x \<noteq> Event e} \<and> length [x\<leftarrow>s' . x = [Tock]\<^sub>E] < length [x\<leftarrow>s . x = [Tock]\<^sub>E]) \<or>
              a = s' @ [[Event e]\<^sub>E] \<and> length [x\<leftarrow>s' . x = [Tock]\<^sub>E] = length [x\<leftarrow>s . x = [Tock]\<^sub>E]"
      using tt_prefix_subset_tocks_event assm3 by blast
    have b_in_P: "b \<in> P"
      using TT1_def a_b_assms(3) assm4 assms by blast
    from s'_assms have "b \<noteq> [] \<longrightarrow> a = s' @ [[Event e]\<^sub>E] \<and> length [x\<leftarrow>s' . x = [Tock]\<^sub>E] = length [x\<leftarrow>s . x = [Tock]\<^sub>E]"
      using a_b_assms(4) tt_prefix_subset_length by (auto, fastforce+)
    then have b_empty: "b = []"
      using b_in_P a_b_assms(1) assm2 s'_assms(1) by fastforce
    then have "\<exists>Y. a = s' @ [[Y]\<^sub>R] \<and> Y \<subseteq> {x. x \<noteq> Tock \<and> x \<noteq> Event e} \<and> length [x\<leftarrow>s' . x = [Tock]\<^sub>E] < length [x\<leftarrow>s . x = [Tock]\<^sub>E]"
      using a_b_assms(1) assm2 b_in_P s'_assms(1) s'_assms(3) by blast
    then show "\<exists>s\<in>tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}. \<exists>X. Tock \<notin> X \<and> Event e \<notin> X \<and> \<rho> = s @ [[X]\<^sub>R]"
      apply (auto, rule_tac x="s'" in bexI, rule_tac x="Y" in exI)
      using b_empty a_b_assms(1) s'_assms(1) by blast+
  qed
qed

lemma TT2_Prefix:
  assumes TT0_P: "TT0 P" and TT1_P: "TT1 P"
  assumes TT2_P: "TT2 P"
  shows "TT2 (e \<rightarrow>\<^sub>C P)"
  unfolding TT2_def
proof auto
  fix \<rho> \<sigma> X Y
  assume assm1: "\<rho> @ [X]\<^sub>R # \<sigma> \<in> e \<rightarrow>\<^sub>C P"
  assume assm2: "Y \<inter> {ea. ea \<noteq> Tock \<and> \<rho> @ [[ea]\<^sub>E] \<in> e \<rightarrow>\<^sub>C P \<or> ea = Tock \<and> \<rho> @ [[X]\<^sub>R, [ea]\<^sub>E] \<in> e \<rightarrow>\<^sub>C P} = {}"
  show "\<rho> @ [X \<union> Y]\<^sub>R # \<sigma> \<in> e \<rightarrow>\<^sub>C P"
    using assm1 unfolding PrefixTT_def
  proof auto
    assume case_assms: "\<rho> @ [X]\<^sub>R # \<sigma> \<in> tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}"
    then have 1: "\<rho> \<in> tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}"
      using tocks_mid_refusal_front_in_tocks by blast
    then have "Tock \<in> {ea. ea \<noteq> Tock \<and> \<rho> @ [[ea]\<^sub>E] \<in> e \<rightarrow>\<^sub>C P \<or> ea = Tock \<and> \<rho> @ [[X]\<^sub>R, [ea]\<^sub>E] \<in> e \<rightarrow>\<^sub>C P}"
      unfolding PrefixTT_def apply auto
      by (metis (no_types, lifting) case_assms tocks.empty_in_tocks tocks.tock_insert_in_tocks tocks_append_tocks tocks_mid_refusal)
    then have 2: "Tock \<notin> Y"
      using assm2 by blast
    then have "Event e \<in> {ea. ea \<noteq> Tock \<and> \<rho> @ [[ea]\<^sub>E] \<in> e \<rightarrow>\<^sub>C P \<or> ea = Tock \<and> \<rho> @ [[X]\<^sub>R, [ea]\<^sub>E] \<in> e \<rightarrow>\<^sub>C P}"
      using 1 unfolding PrefixTT_def apply auto
      using TT0_TT1_empty TT0_P TT1_P by (erule_tac x="\<rho>" in ballE, auto)+
    then have 3: "Event e \<notin> Y"
      using assm2 by blast
    have 4: "Tock \<notin> X"
      using case_assms tocks_mid_refusal by fastforce
    have 5: "Event e \<notin> X"
      using case_assms tocks_mid_refusal by fastforce
    then have "X \<union> Y \<subseteq> {x. x \<noteq> Tock \<and> x \<noteq> Event e}"
      using 1 2 3 4 5 by auto
    then show "\<forall>s\<in>tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}. \<rho> @ [X \<union> Y]\<^sub>R # \<sigma> \<noteq> s \<and> (\<forall>\<sigma>'\<in>P. \<rho> @ [X \<union> Y]\<^sub>R # \<sigma> \<noteq> s @ [Event e]\<^sub>E # \<sigma>') \<Longrightarrow>
      \<exists>s\<in>tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}. \<exists>Xa. Tock \<notin> Xa \<and> Event e \<notin> Xa \<and> \<rho> @ [X \<union> Y]\<^sub>R # \<sigma> = s @ [[Xa]\<^sub>R]"
      using case_assms apply (erule_tac x="\<rho> @ [X \<union> Y]\<^sub>R # \<sigma>" in ballE, auto)
      using tocks_mid_refusal_change by fastforce
  next
    assume case_assms: "\<rho> @ [X]\<^sub>R # \<sigma> \<in> tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}"
    then have 1: "\<rho> \<in> tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}"
      using tocks_mid_refusal_front_in_tocks by blast
    then have "Tock \<in> {ea. ea \<noteq> Tock \<and> \<rho> @ [[ea]\<^sub>E] \<in> e \<rightarrow>\<^sub>C P \<or> ea = Tock \<and> \<rho> @ [[X]\<^sub>R, [ea]\<^sub>E] \<in> e \<rightarrow>\<^sub>C P}"
      unfolding PrefixTT_def apply auto
      by (metis (no_types, lifting) case_assms tocks.empty_in_tocks tocks.tock_insert_in_tocks tocks_append_tocks tocks_mid_refusal)
    then have 2: "Tock \<notin> Y"
      using assm2 by blast
    then have "Event e \<in> {ea. ea \<noteq> Tock \<and> \<rho> @ [[ea]\<^sub>E] \<in> e \<rightarrow>\<^sub>C P \<or> ea = Tock \<and> \<rho> @ [[X]\<^sub>R, [ea]\<^sub>E] \<in> e \<rightarrow>\<^sub>C P}"
      using 1 unfolding PrefixTT_def apply auto
      using TT0_TT1_empty TT0_P TT1_P by (erule_tac x="\<rho>" in ballE, auto)+
    then have 3: "Event e \<notin> Y"
      using assm2 by blast
    have 4: "Tock \<notin> X"
      using case_assms tocks_mid_refusal by fastforce
    have 5: "Event e \<notin> X"
      using case_assms tocks_mid_refusal by fastforce
    then have "X \<union> Y \<subseteq> {x. x \<noteq> Tock \<and> x \<noteq> Event e}"
      using 1 2 3 4 5 by auto
    then show "\<forall>s\<in>tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}. \<rho> @ [X \<union> Y]\<^sub>R # \<sigma> \<noteq> s \<and> (\<forall>\<sigma>'\<in>P. \<rho> @ [X \<union> Y]\<^sub>R # \<sigma> \<noteq> s @ [Event e]\<^sub>E # \<sigma>') \<Longrightarrow>
      \<exists>s\<in>tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}. \<exists>Xa. Tock \<notin> Xa \<and> Event e \<notin> Xa \<and> \<rho> @ [X \<union> Y]\<^sub>R # \<sigma> = s @ [[Xa]\<^sub>R]"
      using case_assms apply (erule_tac x="\<rho> @ [X \<union> Y]\<^sub>R # \<sigma>" in ballE, auto)
      using tocks_mid_refusal_change by fastforce
  next
    fix s Xa
    assume case_assms: "s \<in> tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}" "Tock \<notin> Xa" "Event e \<notin> Xa" "\<rho> @ [X]\<^sub>R # \<sigma> = s @ [[Xa]\<^sub>R]"
    then have "(\<exists> \<sigma>'. s = \<rho> @ [X]\<^sub>R # \<sigma>') \<or> (s = \<rho> \<and> X = Xa \<and> \<sigma> = [])"
      by (metis append.right_neutral butlast.simps(2) butlast_append ttobs.inject(2) last_snoc list.distinct(1))
    then show "\<exists>s\<in>tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}. \<exists>Xa. Tock \<notin> Xa \<and> Event e \<notin> Xa \<and> \<rho> @ [X \<union> Y]\<^sub>R # \<sigma> = s @ [[Xa]\<^sub>R]"
      using case_assms
    proof auto
      fix \<sigma>'
      assume case_assms2: "s = \<rho> @ [X]\<^sub>R # \<sigma>'"
      have 1: "\<rho> \<in> tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}"
        using case_assms(1) case_assms2 tocks_mid_refusal_front_in_tocks by auto
      have "Tock \<in> {ea. ea \<noteq> Tock \<and> \<rho> @ [[ea]\<^sub>E] \<in> e \<rightarrow>\<^sub>C P \<or> ea = Tock \<and> \<rho> @ [[X]\<^sub>R, [ea]\<^sub>E] \<in> e \<rightarrow>\<^sub>C P}"
         unfolding PrefixTT_def apply auto
         using case_assms case_assms2 1 by (simp add: empty_in_tocks tock_insert_in_tocks tocks_append_tocks tocks_mid_refusal)
       then have 2:"Tock \<notin> Y"
         using assm2 by auto
      have "Event e \<in> {ea. ea \<noteq> Tock \<and> \<rho> @ [[ea]\<^sub>E] \<in> e \<rightarrow>\<^sub>C P \<or> ea = Tock \<and> \<rho> @ [[X]\<^sub>R, [ea]\<^sub>E] \<in> e \<rightarrow>\<^sub>C P}"
        unfolding PrefixTT_def using "1" TT0_TT1_empty TT0_P TT1_P by auto
      then have 3: "Event e \<notin> Y"
        using assm2 by auto
      have 4: "Tock \<notin> X"
        using case_assms(1) case_assms2 tocks_mid_refusal by fastforce
      have 5: "Event e \<notin> X"
        using case_assms(1) case_assms2 tocks_mid_refusal by fastforce
      have "X \<union> Y \<subseteq> {x. x \<noteq> Tock \<and> x \<noteq> Event e}"
        using 2 3 4 5 by auto
      then show "\<rho> @ [X \<union> Y]\<^sub>R # \<sigma>' \<in> tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}"
        using case_assms case_assms2 tocks_mid_refusal_change by fastforce
    next
      assume "\<rho> \<in> tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}" "s = \<rho>" "X = Xa" "\<sigma> = []"
      then have "Tock \<in> {ea. ea \<noteq> Tock \<and> \<rho> @ [[ea]\<^sub>E] \<in> e \<rightarrow>\<^sub>C P \<or> ea = Tock \<and> \<rho> @ [[X]\<^sub>R, [ea]\<^sub>E] \<in> e \<rightarrow>\<^sub>C P}"
         unfolding PrefixTT_def using case_assms apply auto
         by (metis (mono_tags, lifting) CollectI subsetI tocks.empty_in_tocks tocks.tock_insert_in_tocks tocks_append_tocks)
       then show "Tock \<in> Y \<Longrightarrow> False"
         using assm2 by auto
    next
      assume "\<rho> \<in> tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}" "s = \<rho>" "X = Xa" "\<sigma> = []"
      then have "Event e \<in> {ea. ea \<noteq> Tock \<and> \<rho> @ [[ea]\<^sub>E] \<in> e \<rightarrow>\<^sub>C P \<or> ea = Tock \<and> \<rho> @ [[X]\<^sub>R, [ea]\<^sub>E] \<in> e \<rightarrow>\<^sub>C P}"
         unfolding PrefixTT_def using case_assms TT0_TT1_empty TT0_P TT1_P by auto
      then show "Event e \<in> Y \<Longrightarrow> False"
        using assm2 by auto
    qed
  next
    fix s \<sigma>'
    assume case_assms: "s \<in> tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}" "\<sigma>' \<in> P" "\<rho> @ [X]\<^sub>R # \<sigma> = s @ [Event e]\<^sub>E # \<sigma>'"
    then have "(\<exists>t. \<rho> = s @ [Event e]\<^sub>E # t \<and> t \<le>\<^sub>C \<sigma>') \<or> (\<exists>t. s = \<rho> @ [X]\<^sub>R # t \<and> t \<le>\<^sub>C \<sigma>)"
      by (simp add: event_refusal_split)
    then show "\<forall>s\<in>tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}. \<rho> @ [X \<union> Y]\<^sub>R # \<sigma> \<noteq> s \<and> (\<forall>\<sigma>'\<in>P. \<rho> @ [X \<union> Y]\<^sub>R # \<sigma> \<noteq> s @ [Event e]\<^sub>E # \<sigma>') \<Longrightarrow>
            \<exists>s\<in>tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}. \<exists>Xa. Tock \<notin> Xa \<and> Event e \<notin> Xa \<and> \<rho> @ [X \<union> Y]\<^sub>R # \<sigma> = s @ [[Xa]\<^sub>R]"
    proof auto
      fix t
      assume case_assms2: "t \<le>\<^sub>C \<sigma>'" "\<rho> = s @ [Event e]\<^sub>E # t"
      then obtain \<rho>' where \<sigma>'_def: "\<sigma>' = \<rho>' @ [X]\<^sub>R # \<sigma>"
        using case_assms(3) by auto
      then have \<rho>_def: "\<rho> = s @ [Event e]\<^sub>E # \<rho>'"
        using case_assms(3) by auto
      then have "{ea. ea \<noteq> Tock \<and> \<rho>' @ [[ea]\<^sub>E] \<in> P \<or> ea = Tock \<and> \<rho>' @ [[X]\<^sub>R, [ea]\<^sub>E] \<in> P}
        \<subseteq> {ea. ea \<noteq> Tock \<and> \<rho> @ [[ea]\<^sub>E] \<in> e \<rightarrow>\<^sub>C P \<or> ea = Tock \<and> \<rho> @ [[X]\<^sub>R, [ea]\<^sub>E] \<in> e \<rightarrow>\<^sub>C P}"
      proof auto
        fix x
        assume "\<rho> = s @ [Event e]\<^sub>E # \<rho>'" "\<rho>' @ [[x]\<^sub>E] \<in> P" "x \<noteq> Tock"
        then show "s @ [Event e]\<^sub>E # \<rho>' @ [[x]\<^sub>E] \<in> e \<rightarrow>\<^sub>C P"
          unfolding PrefixTT_def using case_assms by auto
      next
          fix x
        assume "\<rho> = s @ [Event e]\<^sub>E # \<rho>'" "\<rho>' @ [[x]\<^sub>E] \<in> P" "x \<noteq> Tock"
        then show "s @ [Event e]\<^sub>E # \<rho>' @ [[x]\<^sub>E] \<in> e \<rightarrow>\<^sub>C P"
          unfolding PrefixTT_def using case_assms by auto
      next
        assume "\<rho> = s @ [Event e]\<^sub>E # \<rho>'" "\<rho>' @ [[X]\<^sub>R, [Tock]\<^sub>E] \<in> P"
        then show "s @ [Event e]\<^sub>E # \<rho>' @ [[X]\<^sub>R, [Tock]\<^sub>E] \<notin> e \<rightarrow>\<^sub>C P \<Longrightarrow> False"
          unfolding PrefixTT_def using case_assms by auto

      next
        assume "\<rho> = s @ [Event e]\<^sub>E # \<rho>'" "\<rho>' @ [[X]\<^sub>R, [Tock]\<^sub>E] \<in> P"
        then show "s @ [Event e]\<^sub>E # \<rho>' @ [[X]\<^sub>R, [Tock]\<^sub>E] \<notin> e \<rightarrow>\<^sub>C P \<Longrightarrow> s @ [Event e]\<^sub>E # \<rho>' @ [[Tock]\<^sub>E] \<in> e \<rightarrow>\<^sub>C P"
          unfolding PrefixTT_def using case_assms by auto
      qed
      then have 1: "Y \<inter> {ea. ea \<noteq> Tock \<and> \<rho>' @ [[ea]\<^sub>E] \<in> P \<or> ea = Tock \<and> \<rho>' @ [[X]\<^sub>R, [ea]\<^sub>E] \<in> P} = {}"
        using assm2 subsetCE by auto
      have 2: "\<rho>' @ [X]\<^sub>R # \<sigma> \<in> P"
        using \<sigma>'_def case_assms(2) by auto
      have "\<rho>' @ [X \<union> Y]\<^sub>R # \<sigma> \<in> P"
        using 1 2 TT2_P unfolding TT2_def by auto
      then show "\<forall>sa\<in>tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}.
          s @ [Event e]\<^sub>E # t @ [X \<union> Y]\<^sub>R # \<sigma> \<noteq> sa \<and> (\<forall>\<sigma>'\<in>P. s @ [Event e]\<^sub>E # t @ [X \<union> Y]\<^sub>R # \<sigma> \<noteq> sa @ [Event e]\<^sub>E # \<sigma>') \<Longrightarrow>
        \<exists>sa\<in>tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}. \<exists>Xa. Tock \<notin> Xa \<and> Event e \<notin> Xa \<and> s @ [Event e]\<^sub>E # t @ [X \<union> Y]\<^sub>R # \<sigma> = sa @ [[Xa]\<^sub>R]"
        using \<rho>_def case_assms(1) case_assms2(2) by blast
    next
      fix t
      assume case_assms2: "s = \<rho> @ [X]\<^sub>R # t" "t \<le>\<^sub>C \<sigma>"
      have 1: "\<rho> @ [X]\<^sub>R # t \<in> tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}"
        using case_assms(1) case_assms2(1) by auto
      then have 2: "\<rho> \<in> tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}"
        using tocks_mid_refusal_front_in_tocks by auto
      then have 3: "\<rho> @ [[Event e]\<^sub>E] \<in> e \<rightarrow>\<^sub>C P"
        unfolding PrefixTT_def using TT0_TT1_empty TT0_P TT1_P by fastforce
      have 4: "\<rho> @ [[X]\<^sub>R, [Tock]\<^sub>E] \<in> e \<rightarrow>\<^sub>C P"
        unfolding PrefixTT_def by (metis (mono_tags, lifting) "1" "2" CollectI UnI2 tocks.empty_in_tocks tocks.tock_insert_in_tocks tocks_append_tocks tocks_mid_refusal)
      have 5: "Y \<subseteq> {x. x \<noteq> Tock \<and> x \<noteq> Event e}"
        using assm2 3 4 by auto
      then have "\<rho> @ [X \<union> Y]\<^sub>R # t \<in> tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}"
        using "1" tocks_mid_refusal tocks_mid_refusal_change by fastforce
      then show "\<forall>s\<in>tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}. \<rho> @ [X \<union> Y]\<^sub>R # \<sigma> \<noteq> s \<and> (\<forall>\<sigma>'\<in>P. \<rho> @ [X \<union> Y]\<^sub>R # \<sigma> \<noteq> s @ [Event e]\<^sub>E # \<sigma>') \<Longrightarrow>
        \<exists>s\<in>tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}. \<exists>Xa. Tock \<notin> Xa \<and> Event e \<notin> Xa \<and> \<rho> @ [X \<union> Y]\<^sub>R # \<sigma> = s @ [[Xa]\<^sub>R]"
        using case_assms(2) case_assms(3) case_assms2(1) by fastforce
    qed
  qed
qed

lemma TT3w_Prefix:
  "TT3w P \<Longrightarrow> TT3w (e \<rightarrow>\<^sub>C P)"
  unfolding PrefixTT_def TT3w_def
proof auto
  fix s
  assume "s \<in> tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}"
  then show "\<forall>sa\<in>tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}. add_Tick_refusal_trace s \<noteq> sa \<and>
      (\<forall>\<sigma>\<in>P. add_Tick_refusal_trace s \<noteq> sa @ [Event e]\<^sub>E # \<sigma>) \<Longrightarrow>
    \<exists>sa\<in>tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}. \<exists>X. Tock \<notin> X \<and> Event e \<notin> X \<and> add_Tick_refusal_trace s = sa @ [[X]\<^sub>R]"
    apply (erule_tac x="add_Tick_refusal_trace s" in ballE, auto)
    by (metis (mono_tags, lifting) TT3w_def TT3w_tocks ttevent.distinct(3) ttevent.simps(7) mem_Collect_eq)
next
  fix s X
  assume "s \<in> tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}" "Tock \<notin> X" "Event e \<notin> X"
  then show "\<exists>sa\<in>tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}.
    \<exists>Xa. Tock \<notin> Xa \<and> Event e \<notin> Xa \<and> add_Tick_refusal_trace (s @ [[X]\<^sub>R]) = sa @ [[Xa]\<^sub>R]"
    apply (rule_tac x="add_Tick_refusal_trace s" in bexI, rule_tac x="X \<union> {Tick}" in exI, auto simp add: add_Tick_refusal_trace_end_refusal)
    by (metis (mono_tags, lifting) TT3w_def TT3w_tocks ttevent.distinct(3) ttevent.simps(7) mem_Collect_eq)
next
  fix s
  assume "s \<in> tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}"
  then show "\<forall>sa\<in>tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}. add_Tick_refusal_trace s \<noteq> sa \<and>
      (\<forall>\<sigma>\<in>P. add_Tick_refusal_trace s \<noteq> sa @ [Event e]\<^sub>E # \<sigma>) \<Longrightarrow>
    \<exists>sa\<in>tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}. \<exists>X. Tock \<notin> X \<and> Event e \<notin> X \<and> add_Tick_refusal_trace s = sa @ [[X]\<^sub>R]"
    apply (erule_tac x="add_Tick_refusal_trace s" in ballE, auto)
    by (metis (mono_tags, lifting) TT3w_def TT3w_tocks ttevent.distinct(3) ttevent.simps(7) mem_Collect_eq)
next
  fix s \<sigma>
  assume "s \<in> tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}" "\<sigma> \<in> P"
  also assume "\<forall>\<rho>. \<rho> \<in> P \<longrightarrow> add_Tick_refusal_trace \<rho> \<in> P"
  then have "add_Tick_refusal_trace \<sigma> \<in> P"
    using calculation by auto
  then show "\<forall>sa\<in>tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}. add_Tick_refusal_trace (s @ [Event e]\<^sub>E # \<sigma>) \<noteq> sa \<and>
      (\<forall>\<sigma>'\<in>P. add_Tick_refusal_trace (s @ [Event e]\<^sub>E # \<sigma>) \<noteq> sa @ [Event e]\<^sub>E # \<sigma>') \<Longrightarrow>
    \<exists>sa\<in>tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}.
      \<exists>X. Tock \<notin> X \<and> Event e \<notin> X \<and> add_Tick_refusal_trace (s @ [Event e]\<^sub>E # \<sigma>) = sa @ [[X]\<^sub>R]"
    using calculation apply (erule_tac x="add_Tick_refusal_trace s" in ballE, auto)
    apply (erule_tac x="add_Tick_refusal_trace \<sigma>" in ballE, auto simp add: add_Tick_refusal_trace_end_event_trace)
    by (metis (mono_tags, lifting) TT3w_def TT3w_tocks ttevent.distinct(3) ttevent.simps(7) mem_Collect_eq)
qed

lemma TT3_Prefix: "TT1 P \<Longrightarrow> TT3 P \<Longrightarrow> TT3 (e \<rightarrow>\<^sub>C P)"
  by (simp add: TT1_Prefix TT1_TT3w_equiv_TT3 TT3w_Prefix)

lemma TT_Prefix:
  assumes "TT P"
  shows "TT (e \<rightarrow>\<^sub>C P)"
  unfolding TT_defs
proof auto
  fix x
  show "x \<in> e \<rightarrow>\<^sub>C P \<Longrightarrow> ttWF x"
    by (meson TT_def PrefixTT_wf assms)
next
  show "e \<rightarrow>\<^sub>C P = {} \<Longrightarrow> False"
    unfolding PrefixTT_def using tocks.empty_in_tocks by (blast)
next
  fix \<rho> \<sigma>
  show "\<rho> \<lesssim>\<^sub>C \<sigma> \<Longrightarrow> \<sigma> \<in> e \<rightarrow>\<^sub>C P \<Longrightarrow> \<rho> \<in> e \<rightarrow>\<^sub>C P"
    by (meson TT1_Prefix TT1_def TT_TT1 assms)
next
  fix \<rho> X Y
  assume assm1: "Y \<inter> {ea. ea \<noteq> Tock \<and> \<rho> @ [[ea]\<^sub>E] \<in> e \<rightarrow>\<^sub>C P \<or> ea = Tock \<and> \<rho> @ [[X]\<^sub>R, [ea]\<^sub>E] \<in> e \<rightarrow>\<^sub>C P} = {}"
  assume "\<rho> @ [[X]\<^sub>R] \<in> e \<rightarrow>\<^sub>C P"
  then have "(\<rho> \<in> tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e} \<and> Tock \<notin> X \<and> Event e \<notin> X) \<or>
    (\<exists> s \<sigma>. s \<in> tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e} \<and> \<sigma> \<in> P \<and> \<rho> @ [[X]\<^sub>R] = s @ [Event e]\<^sub>E # \<sigma>)"
    unfolding PrefixTT_def using end_refusal_notin_tocks by auto
  then show "\<rho> @ [[X \<union> Y]\<^sub>R] \<in> e \<rightarrow>\<^sub>C P"
  proof auto
    assume assm2: "\<rho> \<in> tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}"
    assume assm3: "Tock \<notin> X"
    assume assm4: "Event e \<notin> X"

    have "Tock \<in> {ea. ea \<noteq> Tock \<and> \<rho> @ [[ea]\<^sub>E] \<in> e \<rightarrow>\<^sub>C P \<or> ea = Tock \<and> \<rho> @ [[X]\<^sub>R, [ea]\<^sub>E] \<in> e \<rightarrow>\<^sub>C P}"
      unfolding PrefixTT_def by (auto, smt assm2 assm3 assm4 mem_Collect_eq subset_iff tocks.simps tocks_append_tocks)
    then have 1: "Tock \<notin> Y"
      using assm1 by auto
    have "Event e \<in> {ea. ea \<noteq> Tock \<and> \<rho> @ [[ea]\<^sub>E] \<in> e \<rightarrow>\<^sub>C P \<or> ea = Tock \<and> \<rho> @ [[X]\<^sub>R, [ea]\<^sub>E] \<in> e \<rightarrow>\<^sub>C P}"
      unfolding PrefixTT_def apply (auto)
      using TT_empty assm2 assms by blast
    then have 2: "Event e \<notin> Y"
      using assm1 by auto
    show "\<rho> @ [[X \<union> Y]\<^sub>R] \<in> e \<rightarrow>\<^sub>C P"
      unfolding PrefixTT_def using 1 2 assm2 assm3 assm4 by (auto)
  next
    fix s \<sigma>
    assume assm2: "s \<in> tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}"
    assume assm3: "\<sigma> \<in> P"
    assume assm4: "\<rho> @ [[X]\<^sub>R] = s @ [Event e]\<^sub>E # \<sigma>"
    obtain \<sigma>' where \<sigma>'_assm: "\<sigma> = \<sigma>' @ [[X]\<^sub>R]"
      by (metis append_butlast_last_id assm4 ttobs.distinct(1) last.simps last_appendR list.distinct(1))
    have \<rho>_def: "\<rho> = s @ [Event e]\<^sub>E # \<sigma>'"
      using \<sigma>'_assm assm4 by auto
    have 1: "\<And>x. s @ [Event e]\<^sub>E # \<sigma>' @ [[x]\<^sub>E] \<notin> tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}"
      using mid_event_notin_tocks by force
    have 2: "s @ [Event e]\<^sub>E # \<sigma>' @ [[X]\<^sub>R, [Tock]\<^sub>E] \<notin> tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}"
      using mid_event_notin_tocks by force
    have "{ea. ea \<noteq> Tock \<and> \<sigma>' @ [[ea]\<^sub>E] \<in> P \<or> ea = Tock \<and> \<sigma>' @ [[X]\<^sub>R, [ea]\<^sub>E] \<in> P} = {ea. ea \<noteq> Tock \<and> \<rho> @ [[ea]\<^sub>E] \<in> e \<rightarrow>\<^sub>C P \<or> ea = Tock \<and> \<rho> @ [[X]\<^sub>R, [ea]\<^sub>E] \<in> e \<rightarrow>\<^sub>C P}"
      unfolding PrefixTT_def apply auto
      using \<sigma>'_assm assm2 assm4  apply (auto simp add: 1 2)
      by (metis (lifting) append_Cons append_Nil equal_traces_imp_equal_tocks)+
    then have "Y \<inter> {ea. ea \<noteq> Tock \<and> \<sigma>' @ [[ea]\<^sub>E] \<in> P \<or> ea = Tock \<and> \<sigma>' @ [[X]\<^sub>R, [ea]\<^sub>E] \<in> P} = {}"
      using assm1 by auto
    then have "\<sigma>' @ [[X \<union> Y]\<^sub>R] \<in> P"
      using \<sigma>'_assm assm3 assms by (auto simp add: TT2w_def TT_def)
    then show "\<rho> @ [[X \<union> Y]\<^sub>R] \<in> e \<rightarrow>\<^sub>C P"
      unfolding PrefixTT_def using \<rho>_def assm2 by auto
  qed
next
  fix x
  have "\<forall>x\<in>P. ttWFx_trace x"
    using ttWFx_def TT_ttWFx assms by blast
  also have "\<forall>x \<in> tocks {x. x \<noteq> Tock \<and> x \<noteq> Event e}. ttWFx_trace x"
    by (metis (mono_tags, lifting) ttWFx_def ttWFx_tocks mem_Collect_eq)
  then show "x \<in> e \<rightarrow>\<^sub>C P \<Longrightarrow> ttWFx_trace x"
    unfolding PrefixTT_def using calculation apply auto
    using ttWFx_append ttWFx_trace.simps(2) ttWF.simps(2) apply blast
    by (metis (no_types, lifting) ttWFx_append ttWFx_trace.simps(2) ttWFx_trace.simps(4) TT_wf assms ttWF.elims(2) ttWF.simps(4))
qed

lemma Prefix_Union_dist:
  "S \<noteq> {} \<Longrightarrow> (e \<rightarrow>\<^sub>C \<Union>S) = \<Union>{R. \<exists>Q. Q \<in> S \<and> R = e \<rightarrow>\<^sub>C Q}"
    unfolding PrefixTT_def by (safe, simp_all, blast+)

definition TockPrefixTT :: "'e ttobs list set \<Rightarrow> 'e ttobs list set" ("tock \<rightarrow>\<^sub>C _") where
  "TockPrefixTT P = {t. \<exists> s\<in>tocks({x. x \<noteq> Tock \<and> x \<noteq> Tock}). t = s \<or> (\<exists> X. Tock \<notin> X \<and> Tock \<notin> X \<and> t = s @ [[X]\<^sub>R])}
     \<union> {t. \<exists> s\<in>tocks({x. x \<noteq> Tock \<and> x \<noteq> Tock}). t = s \<or> (\<exists> \<sigma>\<in>P. \<exists> X. Tock \<notin> X \<and> t = s @ [[X]\<^sub>R, [Tock]\<^sub>E] @ \<sigma>)}"

lemma TockPrefixTT_wf: "(\<forall> t\<in>P. ttWF t) \<Longrightarrow> \<forall> t\<in>(tock \<rightarrow>\<^sub>C P). ttWF t"
  unfolding TockPrefixTT_def using tocks_wf apply auto
  apply (smt mem_Collect_eq tocks_wf)
  apply (smt mem_Collect_eq tocks_append_wf ttWF.simps(2))
  apply (smt mem_Collect_eq tocks_wf)
  by (smt mem_Collect_eq tocks_append_wf ttWF.simps(5))

lemma TT0_TockPrefixTT: "TT0 P \<Longrightarrow> TT0 (tock \<rightarrow>\<^sub>C P)"
  unfolding TockPrefixTT_def TT0_def apply auto
  using tocks.simps by blast

lemma TT1_TockPrefixTT:
  assumes "TT1 P"
  shows "TT1 (tock \<rightarrow>\<^sub>C P)"
  unfolding TT1_def TockPrefixTT_def
proof auto
  fix \<rho> s :: "'a ttobs list"
  show "\<rho> \<lesssim>\<^sub>C s \<Longrightarrow> s \<in> tocks {x. x \<noteq> Tock} \<Longrightarrow>
    \<forall>s\<in>tocks {x. x \<noteq> Tock}. \<rho> \<noteq> s \<and> (\<forall>\<sigma>\<in>P. \<forall>X. Tock \<in> X \<or> \<rho> \<noteq> s @ [X]\<^sub>R # [Tock]\<^sub>E # \<sigma>) \<Longrightarrow>
    \<exists>s\<in>tocks {x. x \<noteq> Tock}. \<exists>X. Tock \<notin> X \<and> \<rho> = s @ [[X]\<^sub>R]"
    using tt_prefix_subset_tocks2[where s=s, where t=\<rho>, where X="{x. x \<noteq> Tock}"] by auto
next
  fix \<rho> s X
  show "\<rho> \<lesssim>\<^sub>C s @ [[X]\<^sub>R] \<Longrightarrow>
    \<forall>s\<in>tocks {x. x \<noteq> Tock}. \<rho> \<noteq> s \<and> (\<forall>\<sigma>\<in>P. \<forall>X. Tock \<in> X \<or> \<rho> \<noteq> s @ [X]\<^sub>R # [Tock]\<^sub>E # \<sigma>) \<Longrightarrow>
    s \<in> tocks {x. x \<noteq> Tock} \<Longrightarrow> Tock \<notin> X \<Longrightarrow> \<exists>s\<in>tocks {x. x \<noteq> Tock}. \<exists>X. Tock \<notin> X \<and> \<rho> = s @ [[X]\<^sub>R]"
    using tt_prefix_subset_tocks_refusal2[where s=s, where \<rho>=\<rho>, where X="{x. x \<noteq> Tock}", where Y=X] by auto
next
  fix \<rho> s
  show "\<rho> \<lesssim>\<^sub>C s \<Longrightarrow>
    \<forall>s\<in>tocks {x. x \<noteq> Tock}. \<rho> \<noteq> s \<and> (\<forall>\<sigma>\<in>P. \<forall>X. Tock \<in> X \<or> \<rho> \<noteq> s @ [X]\<^sub>R # [Tock]\<^sub>E # \<sigma>) \<Longrightarrow>
    s \<in> tocks {x. x \<noteq> Tock} \<Longrightarrow> \<exists>s\<in>tocks {x. x \<noteq> Tock}. \<exists>X. Tock \<notin> X \<and> \<rho> = s @ [[X]\<^sub>R]"
    using tt_prefix_subset_tocks2[where s=s, where t=\<rho>, where X="{x. x \<noteq> Tock}"] by auto
next
  fix \<rho> s \<sigma>' X
  assume case_assms: "\<rho> \<lesssim>\<^sub>C s @ [X]\<^sub>R # [Tock]\<^sub>E # \<sigma>'" "s \<in> tocks {x. x \<noteq> Tock}" "\<sigma>' \<in> P" "Tock \<notin> X"
  have "\<rho> \<lesssim>\<^sub>C s @ [[X]\<^sub>R, [Tock]\<^sub>E] \<or> (\<exists>t'. t' \<lesssim>\<^sub>C \<sigma>' \<and> \<rho> \<subseteq>\<^sub>C (s @ [[X]\<^sub>R, [Tock]\<^sub>E]) @ t')"
    using case_assms tt_prefix_subset_concat[where r="\<rho>", where s="s @ [[X]\<^sub>R, [Tock]\<^sub>E]", where t=\<sigma>'] by auto
  then show "\<forall>s\<in>tocks {x. x \<noteq> Tock}. \<rho> \<noteq> s \<and> (\<forall>\<sigma>\<in>P. \<forall>X. Tock \<in> X \<or> \<rho> \<noteq> s @ [X]\<^sub>R # [Tock]\<^sub>E # \<sigma>) \<Longrightarrow>
    \<exists>s\<in>tocks {x. x \<noteq> Tock}. \<exists>X. Tock \<notin> X \<and> \<rho> = s @ [[X]\<^sub>R]"
  proof auto
    have "s @ [[X]\<^sub>R, [Tock]\<^sub>E] \<in> tocks {x. x \<noteq> Tock}"
      by (metis (mono_tags, lifting) case_assms(2) case_assms(4) mem_Collect_eq subsetI tocks.simps tocks_append_tocks)
    then show "\<forall>s\<in>tocks {x. x \<noteq> Tock}. \<rho> \<noteq> s \<and> (\<forall>\<sigma>\<in>P. \<forall>X. Tock \<in> X \<or> \<rho> \<noteq> s @ [X]\<^sub>R # [Tock]\<^sub>E # \<sigma>) \<Longrightarrow>
      \<rho> \<lesssim>\<^sub>C s @ [[X]\<^sub>R, [Tock]\<^sub>E] \<Longrightarrow> \<exists>s\<in>tocks {x. x \<noteq> Tock}. \<exists>X. Tock \<notin> X \<and> \<rho> = s @ [[X]\<^sub>R]"
      using tt_prefix_subset_tocks2[where s="s @ [[X]\<^sub>R, [Tock]\<^sub>E]", where t=\<rho>, where X="{x. x \<noteq> Tock}"] by auto
  next
    fix t'
    assume case_assms2: "t' \<lesssim>\<^sub>C \<sigma>'" "\<rho> \<subseteq>\<^sub>C s @ [X]\<^sub>R # [Tock]\<^sub>E # t'"
    then obtain s' t'' Y where obtain1:  "\<rho> = s' @ t'' \<and> s' \<subseteq>\<^sub>C s @ [[X]\<^sub>R, [Tock]\<^sub>E] \<and> t'' \<subseteq>\<^sub>C t'"
      using tt_subset_split[where r=\<rho>, where s="s @ [[X]\<^sub>R, [Tock]\<^sub>E]", where t=t'] by auto
    then obtain s'' Y where obtain2: "s' = s'' @ [[Y]\<^sub>R, [Tock]\<^sub>E] \<and> s'' \<subseteq>\<^sub>C s \<and> Y \<subseteq> X"
      using tt_subset_split[where r=s', where s=s, where t="[[X]\<^sub>R, [Tock]\<^sub>E]"] apply auto
      by (case_tac t'a rule:ttWF.cases, auto, metis tt_subset.simps(6) neq_Nil_conv)
    have "t'' \<in> P"
      by (meson TT1_def assms case_assms(3) case_assms2(1) tt_subset_imp_prefix_subset obtain1)
    then show "\<forall>s\<in>tocks {x. x \<noteq> Tock}. \<rho> \<noteq> s \<and> (\<forall>\<sigma>\<in>P. \<forall>X. Tock \<in> X \<or> \<rho> \<noteq> s @ [X]\<^sub>R # [Tock]\<^sub>E # \<sigma>) \<Longrightarrow>
      \<exists>s\<in>tocks {x. x \<noteq> Tock}. \<exists>X. Tock \<notin> X \<and> \<rho> = s @ [[X]\<^sub>R]"
      by (smt obtain2 append.assoc append_Cons case_assms(2) case_assms(4) contra_subsetD tt_subset_in_tocks obtain1 self_append_conv2)
  qed
qed

thm TockPrefixTT_def

lemma TT2_TockPrefix:
  assumes "TT2 P"
  shows "TT2 (tock \<rightarrow>\<^sub>C P)"
  unfolding TT2_def
proof auto
  fix \<rho> \<sigma> X Y
  assume assm1: "\<rho> @ [X]\<^sub>R # \<sigma> \<in> tock \<rightarrow>\<^sub>C P"
  assume assm2: "Y \<inter> {e. e \<noteq> Tock \<and> \<rho> @ [[e]\<^sub>E] \<in> tock \<rightarrow>\<^sub>C P \<or> e = Tock \<and> \<rho> @ [[X]\<^sub>R, [e]\<^sub>E] \<in> tock \<rightarrow>\<^sub>C P} = {}"
  show "\<rho> @ [X \<union> Y]\<^sub>R # \<sigma> \<in> tock \<rightarrow>\<^sub>C P"
    using assm1 unfolding TockPrefixTT_def
  proof auto
    assume case_assms: "\<rho> @ [X]\<^sub>R # \<sigma> \<in> tocks {x. x \<noteq> Tock}"
    then have 1: "\<rho> \<in> tocks {x. x \<noteq> Tock}"
      using tocks_mid_refusal_front_in_tocks by blast
    then have "Tock \<in> {ea. ea \<noteq> Tock \<and> \<rho> @ [[ea]\<^sub>E] \<in> tock \<rightarrow>\<^sub>C P \<or> ea = Tock \<and> \<rho> @ [[X]\<^sub>R, [ea]\<^sub>E] \<in> tock \<rightarrow>\<^sub>C P}"
      unfolding TockPrefixTT_def apply auto
      by (metis (no_types, lifting) case_assms tocks.empty_in_tocks tocks.tock_insert_in_tocks tocks_append_tocks tocks_mid_refusal)
    then have 2: "Tock \<notin> Y"
      using assm2 by blast
    then have "Tock \<in> {ea. ea \<noteq> Tock \<and> \<rho> @ [[ea]\<^sub>E] \<in> tock \<rightarrow>\<^sub>C P \<or> ea = Tock \<and> \<rho> @ [[X]\<^sub>R, [ea]\<^sub>E] \<in> tock \<rightarrow>\<^sub>C P}"
      using 1 unfolding TockPrefixTT_def apply auto
      by (metis case_assms tocks.empty_in_tocks tocks.tock_insert_in_tocks tocks_append_tocks tocks_mid_refusal)
    have 3: "Tock \<notin> X"
      using case_assms tocks_mid_refusal by fastforce
    then have "X \<union> Y \<subseteq> {x. x \<noteq> Tock}"
      using 1 2 3 by auto
    then show "\<forall>s\<in>tocks {x. x \<noteq> Tock}. \<rho> @ [X \<union> Y]\<^sub>R # \<sigma> \<noteq> s \<and> (\<forall>\<sigma>'\<in>P. \<forall>Xa. Tock \<in> Xa \<or> \<rho> @ [X \<union> Y]\<^sub>R # \<sigma> \<noteq> s @ [Xa]\<^sub>R # [Tock]\<^sub>E # \<sigma>') \<Longrightarrow>
      \<exists>s\<in>tocks {x. x \<noteq> Tock}. \<exists>Xa. Tock \<notin> Xa \<and> \<rho> @ [X \<union> Y]\<^sub>R # \<sigma> = s @ [[Xa]\<^sub>R]"
      using case_assms apply (erule_tac x="\<rho> @ [X \<union> Y]\<^sub>R # \<sigma>" in ballE, auto)
      using tocks_mid_refusal_change by fastforce
  next
    assume case_assms: "\<rho> @ [X]\<^sub>R # \<sigma> \<in> tocks {x. x \<noteq> Tock}"
    then have 1: "\<rho> \<in> tocks {x. x \<noteq> Tock}"
      using tocks_mid_refusal_front_in_tocks by blast
    then have "Tock \<in> {ea. ea \<noteq> Tock \<and> \<rho> @ [[ea]\<^sub>E] \<in> tock \<rightarrow>\<^sub>C P \<or> ea = Tock \<and> \<rho> @ [[X]\<^sub>R, [ea]\<^sub>E] \<in> tock \<rightarrow>\<^sub>C P}"
      unfolding TockPrefixTT_def apply auto
      by (metis (no_types, lifting) case_assms tocks.empty_in_tocks tocks.tock_insert_in_tocks tocks_append_tocks tocks_mid_refusal)
    then have 2: "Tock \<notin> Y"
      using assm2 by blast
    have 3: "Tock \<notin> X"
      using case_assms tocks_mid_refusal by fastforce
    then have "X \<union> Y \<subseteq> {x. x \<noteq> Tock}"
      using 1 2 3 by auto
    then show "\<forall>s\<in>tocks {x. x \<noteq> Tock}. \<rho> @ [X \<union> Y]\<^sub>R # \<sigma> \<noteq> s \<and> (\<forall>\<sigma>'\<in>P. \<forall>Xa. Tock \<in> Xa \<or> \<rho> @ [X \<union> Y]\<^sub>R # \<sigma> \<noteq> s @ [Xa]\<^sub>R # [Tock]\<^sub>E # \<sigma>') \<Longrightarrow>
      \<rho> @ [X]\<^sub>R # \<sigma> \<in> tocks {x. x \<noteq> Tock} \<Longrightarrow> \<exists>s\<in>tocks {x. x \<noteq> Tock}. \<exists>Xa. Tock \<notin> Xa \<and> \<rho> @ [X \<union> Y]\<^sub>R # \<sigma> = s @ [[Xa]\<^sub>R]"
      using case_assms apply (erule_tac x="\<rho> @ [X \<union> Y]\<^sub>R # \<sigma>" in ballE, auto)
      using tocks_mid_refusal_change by fastforce
  next
    fix s Xa
    assume case_assms: "s \<in> tocks {x. x \<noteq> Tock}" "Tock \<notin> Xa" "\<rho> @ [X]\<^sub>R # \<sigma> = s @ [[Xa]\<^sub>R]"
    then have "(\<exists> \<sigma>'. s = \<rho> @ [X]\<^sub>R # \<sigma>') \<or> (s = \<rho> \<and> X = Xa \<and> \<sigma> = [])"
      by (metis append.right_neutral butlast.simps(2) butlast_append ttobs.inject(2) last_snoc list.distinct(1))
    then show "\<exists>s\<in>tocks {x. x \<noteq> Tock}. \<exists>Xa. Tock \<notin> Xa \<and> \<rho> @ [X \<union> Y]\<^sub>R # \<sigma> = s @ [[Xa]\<^sub>R]"
      using case_assms
    proof auto
      fix \<sigma>'
      assume case_assms2: "s = \<rho> @ [X]\<^sub>R # \<sigma>'"
      have 1: "\<rho> \<in> tocks {x. x \<noteq> Tock}"
        using case_assms(1) case_assms2 tocks_mid_refusal_front_in_tocks by auto
      have "Tock \<in> {ea. ea \<noteq> Tock \<and> \<rho> @ [[ea]\<^sub>E] \<in> tock \<rightarrow>\<^sub>C P \<or> ea = Tock \<and> \<rho> @ [[X]\<^sub>R, [ea]\<^sub>E] \<in> tock \<rightarrow>\<^sub>C P}"
         unfolding TockPrefixTT_def apply auto
         using case_assms case_assms2 1 by (simp add: empty_in_tocks tock_insert_in_tocks tocks_append_tocks tocks_mid_refusal)
       then have 2:"Tock \<notin> Y"
         using assm2 by auto
      have 3: "Tock \<notin> X"
        using case_assms(1) case_assms2 tocks_mid_refusal by fastforce
      have "X \<union> Y \<subseteq> {x. x \<noteq> Tock}"
        using 2 3 by auto
      then show "\<rho> @ [X \<union> Y]\<^sub>R # \<sigma>' \<in> tocks {x. x \<noteq> Tock}"
        using case_assms case_assms2 tocks_mid_refusal_change by fastforce
    next
      assume "\<rho> \<in> tocks {x. x \<noteq> Tock}" "s = \<rho>" "X = Xa" "\<sigma> = []"
      then have "Tock \<in> {ea. ea \<noteq> Tock \<and> \<rho> @ [[ea]\<^sub>E] \<in> tock \<rightarrow>\<^sub>C P \<or> ea = Tock \<and> \<rho> @ [[X]\<^sub>R, [ea]\<^sub>E] \<in> tock \<rightarrow>\<^sub>C P}"
         unfolding TockPrefixTT_def using case_assms apply auto
         by (metis (mono_tags, lifting) CollectI subsetI tocks.empty_in_tocks tocks.tock_insert_in_tocks tocks_append_tocks)
       then show "Tock \<in> Y \<Longrightarrow> False"
         using assm2 by auto
    qed
  next
    fix s \<sigma>' Xa
    assume case_assms: "s \<in> tocks {x. x \<noteq> Tock}" "\<sigma>' \<in> P" "\<rho> @ [X]\<^sub>R # \<sigma> = s @ [Xa]\<^sub>R # [Tock]\<^sub>E # \<sigma>'" "Tock \<notin> Xa"
    then have "(\<exists>t2'. \<rho> = (s @ [[Xa]\<^sub>R]) @ [Tock]\<^sub>E # t2' \<and> t2' \<le>\<^sub>C \<sigma>') \<or> (\<exists>s2'. s @ [[Xa]\<^sub>R] = \<rho> @ [X]\<^sub>R # s2' \<and> s2' \<le>\<^sub>C \<sigma>)"
      using event_refusal_split[where ?s1.0=\<rho>, where ?s2.0=\<sigma>, where X=X, where ?t1.0="s @ [[Xa]\<^sub>R]", where e=Tock, where ?t2.0=\<sigma>']
      by (simp)
    then show "\<forall>s\<in>tocks {x. x \<noteq> Tock}.
        \<rho> @ [X \<union> Y]\<^sub>R # \<sigma> \<noteq> s \<and> (\<forall>\<sigma>'\<in>P. \<forall>Xa. Tock \<in> Xa \<or> \<rho> @ [X \<union> Y]\<^sub>R # \<sigma> \<noteq> s @ [Xa]\<^sub>R # [Tock]\<^sub>E # \<sigma>') \<Longrightarrow>
      \<rho> @ [X]\<^sub>R # \<sigma> = s @ [Xa]\<^sub>R # [Tock]\<^sub>E # \<sigma>' \<Longrightarrow> \<exists>s\<in>tocks {x. x \<noteq> Tock}. \<exists>Xa. Tock \<notin> Xa \<and> \<rho> @ [X \<union> Y]\<^sub>R # \<sigma> = s @ [[Xa]\<^sub>R]"
    proof auto
      fix t2'
      assume case_assms2: "\<rho> = s @ [Xa]\<^sub>R # [Tock]\<^sub>E # t2'" "\<sigma>' = t2' @ [X]\<^sub>R # \<sigma>"
      then have "{ea. ea \<noteq> Tock \<and> t2' @ [[ea]\<^sub>E] \<in> P \<or> ea = Tock \<and> t2' @ [[X]\<^sub>R, [ea]\<^sub>E] \<in> P}
        \<subseteq> {ea. ea \<noteq> Tock \<and> \<rho> @ [[ea]\<^sub>E] \<in> tock \<rightarrow>\<^sub>C P \<or> ea = Tock \<and> \<rho> @ [[X]\<^sub>R, [ea]\<^sub>E] \<in> tock \<rightarrow>\<^sub>C P}"
      proof auto
        fix x :: "'a ttevent"
        assume "\<rho> = s @ [Xa]\<^sub>R # [Tock]\<^sub>E # t2'" "\<sigma>' = t2' @ [X]\<^sub>R # \<sigma>" "t2' @ [[x]\<^sub>E] \<in> P" "x \<noteq> Tock"
        then show "s @ [Xa]\<^sub>R # [Tock]\<^sub>E # t2' @ [[x]\<^sub>E] \<in> tock \<rightarrow>\<^sub>C P"
          unfolding TockPrefixTT_def using case_assms by auto
      next
        fix x :: "'a ttevent"
        assume "\<rho> = s @ [Xa]\<^sub>R # [Tock]\<^sub>E # t2'" "\<sigma>' = t2' @ [X]\<^sub>R # \<sigma>" "t2' @ [[x]\<^sub>E] \<in> P" "x \<noteq> Tock"
        then show "s @ [Xa]\<^sub>R # [Tock]\<^sub>E # t2' @ [[x]\<^sub>E] \<in> tock \<rightarrow>\<^sub>C P"
          unfolding TockPrefixTT_def using case_assms by auto
      next
        assume "\<rho> = s @ [Xa]\<^sub>R # [Tock]\<^sub>E # t2'" "t2' @ [[X]\<^sub>R, [Tock]\<^sub>E] \<in> P"
        then show "s @ [Xa]\<^sub>R # [Tock]\<^sub>E # t2' @ [[X]\<^sub>R, [Tock]\<^sub>E] \<notin> tock \<rightarrow>\<^sub>C P \<Longrightarrow> False"
          unfolding TockPrefixTT_def using case_assms by auto
      next
        assume "\<rho> = s @ [Xa]\<^sub>R # [Tock]\<^sub>E # t2'" "t2' @ [[X]\<^sub>R, [Tock]\<^sub>E] \<in> P"
        then show "s @ [Xa]\<^sub>R # [Tock]\<^sub>E # t2' @ [[X]\<^sub>R, [Tock]\<^sub>E] \<notin> tock \<rightarrow>\<^sub>C P \<Longrightarrow>
          s @ [Xa]\<^sub>R # [Tock]\<^sub>E # t2' @ [[Tock]\<^sub>E] \<in> tock \<rightarrow>\<^sub>C P"
          unfolding TockPrefixTT_def using case_assms by auto
      qed
      then have 1: "Y \<inter> {ea. ea \<noteq> Tock \<and> t2' @ [[ea]\<^sub>E] \<in> P \<or> ea = Tock \<and> t2' @ [[X]\<^sub>R, [ea]\<^sub>E] \<in> P} = {}"
        using assm2 subsetCE by auto
      have 2: "t2' @ [X]\<^sub>R # \<sigma> \<in> P"
        using case_assms(2) case_assms2 by auto
      have "t2' @ [X \<union> Y]\<^sub>R # \<sigma> \<in> P"
        using 1 2 assms unfolding TT2_def by auto
      then show "\<forall>sa\<in>tocks {x. x \<noteq> Tock}. s @ [Xa]\<^sub>R # [Tock]\<^sub>E # t2' @ [X \<union> Y]\<^sub>R # \<sigma> \<noteq> sa \<and>
          (\<forall>\<sigma>'\<in>P. \<forall>Xaa. Tock \<in> Xaa \<or> s @ [Xa]\<^sub>R # [Tock]\<^sub>E # t2' @ [X \<union> Y]\<^sub>R # \<sigma> \<noteq> sa @ [Xaa]\<^sub>R # [Tock]\<^sub>E # \<sigma>') \<Longrightarrow>
        \<exists>sa\<in>tocks {x. x \<noteq> Tock}. \<exists>Xaa. Tock \<notin> Xaa \<and> s @ [Xa]\<^sub>R # [Tock]\<^sub>E # t2' @ [X \<union> Y]\<^sub>R # \<sigma> = sa @ [[Xaa]\<^sub>R]"
        using case_assms case_assms2 by blast
    next
      fix s2'
      assume case_assms2: "\<rho> @ [X]\<^sub>R # \<sigma> = s @ [Xa]\<^sub>R # [Tock]\<^sub>E # \<sigma>'" "s @ [[Xa]\<^sub>R] = \<rho> @ [X]\<^sub>R # s2'" "s2' \<le>\<^sub>C \<sigma>"
      obtain s2'' where s2''_cases: "s2' = s2'' @ [[Xa]\<^sub>R] \<or> (s2' = [] \<and> Xa = X)"
        by (metis append_butlast_last_id case_assms2(2) ttobs.inject(2) last.simps last_appendR list.distinct(1))
      then have 1: "\<rho> @ [X]\<^sub>R # s2'' \<in> tocks {x. x \<noteq> Tock} \<or> \<rho> \<in> tocks {x. x \<noteq> Tock}"
        using case_assms case_assms2 by auto
      then have 2: "\<rho> \<in> tocks {x. x \<noteq> Tock}"
        using tocks_mid_refusal_front_in_tocks by auto
      have 3: "\<rho> @ [[X]\<^sub>R, [Tock]\<^sub>E] \<in> tock \<rightarrow>\<^sub>C P"
        unfolding TockPrefixTT_def using s2''_cases apply auto
        apply (metis (no_types, lifting) "2" Nil_is_append_conv butlast.simps(2) butlast_append butlast_snoc case_assms(1) case_assms2(2) tocks.empty_in_tocks tocks.tock_insert_in_tocks tocks_append_tocks tocks_mid_refusal)
        by (metis (mono_tags, lifting) "2" CollectI case_assms(4) subsetI tocks.empty_in_tocks tocks.tock_insert_in_tocks tocks_append_tocks)
      have 5: "Y \<subseteq> {x. x \<noteq> Tock}"
        using assm2 3 by auto
      then have 6: "X \<union> Y \<subseteq> {x. x \<noteq> Tock}"
      proof -
        have "Tock \<notin> X"
          using 3 unfolding TockPrefixTT_def apply auto
          using tocks_mid_refusal apply force
          using tocks_mid_refusal apply force
          using case_assms(1) case_assms(4) case_assms2(2) s2''_cases tocks_mid_refusal by fastforce
        then show ?thesis using 5 by auto
      qed
      show "\<forall>s\<in>tocks {x. x \<noteq> Tock}.
          \<rho> @ [X \<union> Y]\<^sub>R # \<sigma> \<noteq> s \<and> (\<forall>\<sigma>'\<in>P. \<forall>Xa. Tock \<in> Xa \<or> \<rho> @ [X \<union> Y]\<^sub>R # \<sigma> \<noteq> s @ [Xa]\<^sub>R # [Tock]\<^sub>E # \<sigma>') \<Longrightarrow>
        \<exists>s\<in>tocks {x. x \<noteq> Tock}. \<exists>Xa. Tock \<notin> Xa \<and> \<rho> @ [X \<union> Y]\<^sub>R # \<sigma> = s @ [[Xa]\<^sub>R]"
        using s2''_cases
      proof auto
        assume case_assms3: "s2' = s2'' @ [[Xa]\<^sub>R]"
        obtain s2''' where s2'''_def: "s2'' = [Tock]\<^sub>E # s2'''"
          apply (cases s2'' rule:ttWF.cases, auto)
          using case_assms(1) case_assms2(2) case_assms3 end_refusal_notin_tocks apply force
          using "2" case_assms(1) case_assms2(2) case_assms3 tocks_append_wfw tocks_append_wfw2 ttWFw.simps(2) apply fastforce
          using "2" case_assms(1) case_assms2(2) case_assms3 second_tick_notin_tocks tocks_append_nontocks apply fastforce
          using "2" case_assms(1) case_assms2(2) case_assms3 second_event_notin_tocks tocks_append_nontocks apply fastforce
          using "2" case_assms(1) case_assms2(2) case_assms3 double_refusal_start_notin_tocks tocks_append_nontocks apply fastforce
          using "2" case_assms(1) case_assms2(2) case_assms3 second_tick_notin_tocks tocks_append_nontocks apply fastforce
          using "2" case_assms(1) case_assms2(2) case_assms3 second_tick_notin_tocks tocks_append_nontocks apply fastforce
          using "2" case_assms(1) case_assms2(2) case_assms3 double_refusal_start_notin_tocks tocks_append_nontocks apply fastforce
          using "2" case_assms(1) case_assms2(2) case_assms3 double_refusal_start_notin_tocks tocks_append_nontocks apply fastforce
          using "2" case_assms(1) case_assms2(2) case_assms3 double_refusal_start_notin_tocks tocks_append_nontocks by fastforce
        then have "s2''' \<in> tocks {x. x \<noteq> Tock}"
          by (metis (no_types, lifting) "2" Nil_is_append_conv butlast.simps(2) butlast_append butlast_snoc case_assms(1) case_assms2(2) case_assms3 list.distinct(1) list.sel(3) tocks.cases tocks_append_nontocks)
        then show "\<forall>s\<in>tocks {x. x \<noteq> Tock}.
            \<rho> @ [X \<union> Y]\<^sub>R # \<sigma> \<noteq> s \<and> (\<forall>\<sigma>'\<in>P. \<forall>Xa. Tock \<in> Xa \<or> \<rho> @ [X \<union> Y]\<^sub>R # \<sigma> \<noteq> s @ [Xa]\<^sub>R # [Tock]\<^sub>E # \<sigma>') \<Longrightarrow>
          \<exists>s\<in>tocks {x. x \<noteq> Tock}. \<exists>Xa. Tock \<notin> Xa \<and> \<rho> @ [X \<union> Y]\<^sub>R # \<sigma> = s @ [[Xa]\<^sub>R]"
          apply (erule_tac x="\<rho> @ [X \<union> Y]\<^sub>R # [Tock]\<^sub>E # s2'''" in ballE, auto)
          apply (erule_tac x="\<sigma>'" in ballE, erule_tac x="Xa" in allE, auto simp add: case_assms)
          using case_assms2(1) case_assms2(2) case_assms3 s2'''_def apply auto
          using "6" case_assms(1) tocks_mid_refusal_change by fastforce
      next
        assume case_assms3: "s2' = []" "Xa = X"
        then show "\<forall>s\<in>tocks {x. x \<noteq> Tock}.
            \<rho> @ [X \<union> Y]\<^sub>R # \<sigma> \<noteq> s \<and> (\<forall>\<sigma>'\<in>P. \<forall>Xa. Tock \<in> Xa \<or> \<rho> @ [X \<union> Y]\<^sub>R # \<sigma> \<noteq> s @ [Xa]\<^sub>R # [Tock]\<^sub>E # \<sigma>') \<Longrightarrow>
          \<exists>s\<in>tocks {x. x \<noteq> Tock}. \<exists>Xa. Tock \<notin> Xa \<and> \<rho> @ [X \<union> Y]\<^sub>R # \<sigma> = s @ [[Xa]\<^sub>R]"
          using case_assms(4) case_assms2 2 5 apply (erule_tac x="\<rho>" in ballE, auto)
          by (erule_tac x="\<sigma>'" in ballE, auto simp add: case_assms)
      qed
    qed
  qed
qed

lemma ttWFx_TockPrefix:
  assumes "ttWFx P"
  shows "ttWFx (tock \<rightarrow>\<^sub>C P)"
  unfolding TockPrefixTT_def ttWFx_def
proof (safe, simp_all)
  show "\<And>s. s \<in> tocks {x. x \<noteq> Tock} \<Longrightarrow> ttWFx_trace s"
    by (metis (mono_tags, lifting) ttWFx_def ttWFx_tocks mem_Collect_eq)
next
  show "\<And>s X. s \<in> tocks {x. x \<noteq> Tock} \<Longrightarrow> Tock \<notin> X \<Longrightarrow> ttWFx_trace (s @ [[X]\<^sub>R])"
    by (metis (mono_tags, lifting) ttWFx_append ttWFx_def ttWFx_tocks ttWFx_trace.simps(2) ttWF.simps(2) mem_Collect_eq)
next
  show "\<And>s. s \<in> tocks {x. x \<noteq> Tock} \<Longrightarrow> ttWFx_trace s"
    by (metis (mono_tags, lifting) ttWFx_def ttWFx_tocks mem_Collect_eq)
next
  fix s \<sigma> :: "'a ttobs list"
  fix X :: "'a ttevent set"
  assume case_assms: "s \<in> tocks {x. x \<noteq> Tock}" "\<sigma> \<in> P" "Tock \<notin> X"
  have "ttWFx_trace \<sigma>"
    using case_assms assms unfolding ttWFx_def by blast
  then show "ttWFx_trace (s @ [X]\<^sub>R # [Tock]\<^sub>E # \<sigma>)"
    using case_assms(1) case_assms(3) apply - apply (induct s rule:ttWFx_trace.induct, simp_all add: notin_tocks)
    using list.distinct(1) tocks.cases apply blast
    apply (smt ttWFx_trace.simps(3) append_Cons list.inject list.simps(3) mem_Collect_eq subset_eq tocks.simps)
    apply (metis ttobs.simps(4) list.inject list.simps(3) tocks.simps)
    done
qed

lemma TT3w_TockPrefix:
  assumes "TT3w P"
  shows "TT3w (tock \<rightarrow>\<^sub>C P)"
  unfolding TockPrefixTT_def TT3w_def
proof auto
  fix s :: "'a ttobs list"
  assume "s \<in> tocks {x. x \<noteq> Tock}"
  then have "add_Tick_refusal_trace s \<in> tocks {x. x \<noteq> Tock}"
    by (induct s rule:tocks.induct, auto simp add: tocks.intros)
  then show "\<forall>sa\<in>tocks {x. x \<noteq> Tock}.
      add_Tick_refusal_trace s \<noteq> sa \<and> (\<forall>\<sigma>\<in>P. \<forall>X. Tock \<in> X \<or> add_Tick_refusal_trace s \<noteq> sa @ [X]\<^sub>R # [Tock]\<^sub>E # \<sigma>) \<Longrightarrow>
    \<exists>sa\<in>tocks {x. x \<noteq> Tock}. \<exists>X. Tock \<notin> X \<and> add_Tick_refusal_trace s = sa @ [[X]\<^sub>R]"
    by (erule_tac x="add_Tick_refusal_trace s" in ballE, auto)
next
  fix s :: "'a ttobs list"
  fix X :: "'a ttevent set"
  assume case_assms: "s \<in> tocks {x. x \<noteq> Tock}" "Tock \<notin> X"
  then have "add_Tick_refusal_trace s \<in> tocks {x. x \<noteq> Tock}"
    by (induct s rule:tocks.induct, auto simp add: tocks.intros)
  then show "\<exists>sa\<in>tocks {x. x \<noteq> Tock}. \<exists>Xa. Tock \<notin> Xa \<and> add_Tick_refusal_trace (s @ [[X]\<^sub>R]) = sa @ [[Xa]\<^sub>R]"
    using case_assms apply (rule_tac x="add_Tick_refusal_trace s" in bexI, rule_tac x="X \<union> {Tick}" in exI, simp_all)
    using add_Tick_refusal_trace_end_refusal by force
next
  fix s :: "'a ttobs list"
  assume "s \<in> tocks {x. x \<noteq> Tock}"
  then have "add_Tick_refusal_trace s \<in> tocks {x. x \<noteq> Tock}"
    by (induct s rule:tocks.induct, auto simp add: tocks.intros)
  then show "\<forall>sa\<in>tocks {x. x \<noteq> Tock}.
      add_Tick_refusal_trace s \<noteq> sa \<and> (\<forall>\<sigma>\<in>P. \<forall>X. Tock \<in> X \<or> add_Tick_refusal_trace s \<noteq> sa @ [X]\<^sub>R # [Tock]\<^sub>E # \<sigma>) \<Longrightarrow>
    \<exists>sa\<in>tocks {x. x \<noteq> Tock}. \<exists>X. Tock \<notin> X \<and> add_Tick_refusal_trace s = sa @ [[X]\<^sub>R]"
    by (erule_tac x="add_Tick_refusal_trace s" in ballE, auto)
next
  fix s \<sigma> :: "'a ttobs list"
  fix X  :: "'a ttevent set"
  assume case_assms: "s \<in> tocks {x. x \<noteq> Tock}" "\<sigma> \<in> P" "Tock \<notin> X"
  then have 1: "add_Tick_refusal_trace s \<in> tocks {x. x \<noteq> Tock}"
    by (induct s rule:tocks.induct, auto simp add: tocks.intros)
  have 2: "add_Tick_refusal_trace \<sigma> \<in> P"
    using assms case_assms unfolding TT3w_def by auto
  show "\<forall>sa\<in>tocks {x. x \<noteq> Tock}. add_Tick_refusal_trace (s @ [X]\<^sub>R # [Tock]\<^sub>E # \<sigma>) \<noteq> sa \<and>
      (\<forall>\<sigma>'\<in>P. \<forall>Xa. Tock \<in> Xa \<or> add_Tick_refusal_trace (s @ [X]\<^sub>R # [Tock]\<^sub>E # \<sigma>) \<noteq> sa @ [Xa]\<^sub>R # [Tock]\<^sub>E # \<sigma>') \<Longrightarrow>
    \<exists>sa\<in>tocks {x. x \<noteq> Tock}. \<exists>Xa. Tock \<notin> Xa \<and> add_Tick_refusal_trace (s @ [X]\<^sub>R # [Tock]\<^sub>E # \<sigma>) = sa @ [[Xa]\<^sub>R]"
    using 1 2 case_assms(3) apply (erule_tac x="add_Tick_refusal_trace s" in ballE, auto)
    apply (erule_tac x="add_Tick_refusal_trace \<sigma>" in ballE, erule_tac x="X \<union> {Tick}" in allE, auto)
    by (metis Un_commute add_Tick_refusal_trace.simps(2) add_Tick_refusal_trace.simps(3) add_Tick_refusal_trace_concat insert_is_Un)
qed

lemma TT3_TockPrefix: "TT1 P \<Longrightarrow> TT3 P \<Longrightarrow> TT3 (tock \<rightarrow>\<^sub>C P)"
  by (simp add: TT1_TT3w_equiv_TT3 TT1_TockPrefixTT TT3w_TockPrefix)

lemma TT_TockPrefix:
  assumes "TT P" "TT2 P" "TT3w P"
  shows "TT (tock \<rightarrow>\<^sub>C P)"
  using assms unfolding TT_def
  using TT0_TockPrefixTT TT1_TockPrefixTT TT2_TockPrefix TT2_imp_TT2w ttWFx_TockPrefix TockPrefixTT_wf by blast

lemma TockPrefix_Union_dist:
  "S \<noteq> {} \<Longrightarrow> (tock \<rightarrow>\<^sub>C \<Union>S) = \<Union>{R. \<exists>Q. Q \<in> S \<and> R = tock \<rightarrow>\<^sub>C Q}"
  unfolding TockPrefixTT_def by (safe, simp_all, blast+)

lemma Prefix_mono:
  "P \<sqsubseteq>\<^sub>C Q \<Longrightarrow> e \<rightarrow>\<^sub>C P \<sqsubseteq>\<^sub>C e \<rightarrow>\<^sub>C Q"
  unfolding RefinesTT_def PrefixTT_def by auto

end


(*
  Title:      Publisher_Subscriber.thy
  Author:     Diego Marmsoler
*)
section "A Theory of Publisher-Subscriber Architectures"
text\<open>
  In the following, we formalize the specification of the publisher subscriber pattern as described in~\cite{Marmsoler2018c}.
\<close>

theory Publisher_Subscriber
imports Singleton
begin

subsection "Subscriptions"

datatype 'evt subscription = sub 'evt | unsub 'evt

subsection "Publisher-Subscriber Architectures"

locale publisher_subscriber =
  pb: singleton pbactive pbcmp +
  sb: dynamic_component sbcmp sbactive
    for pbactive :: "'pid \<Rightarrow> cnf \<Rightarrow> bool" ("\<parallel>_\<parallel>\<^bsub>_\<^esub>" [0,110]60)
    and pbcmp :: "'pid \<Rightarrow> cnf \<Rightarrow> 'PB" ("\<sigma>\<^bsub>_\<^esub>(_)" [0,110]60)
    and sbactive :: "'sid \<Rightarrow> cnf \<Rightarrow> bool" ("\<parallel>_\<parallel>\<^bsub>_\<^esub>" [0,110]60)
    and sbcmp :: "'sid \<Rightarrow> cnf \<Rightarrow> 'SB" ("\<sigma>\<^bsub>_\<^esub>(_)" [0,110]60) +
  fixes pbsb :: "'PB \<Rightarrow> ('evt set) subscription set"
    and pbnt :: "'PB \<Rightarrow> ('evt \<times> 'msg)"
    and sbnt :: "'SB \<Rightarrow> ('evt \<times> 'msg) set"
    and sbsb :: "'SB \<Rightarrow> ('evt set) subscription"
  assumes conn1: "\<And>k pid. \<parallel>pid\<parallel>\<^bsub>k\<^esub>
      \<Longrightarrow> pbsb (\<sigma>\<^bsub>pid\<^esub>(k)) = (\<Union>sid\<in>{sid. \<parallel>sid\<parallel>\<^bsub>k\<^esub>}. {sbsb (\<sigma>\<^bsub>sid\<^esub>(k))})"
    and conn2: "\<And>t n n'' sid pid E e m.
      \<lbrakk>t \<in> arch; \<parallel>pid\<parallel>\<^bsub>t n\<^esub>; \<parallel>sid\<parallel>\<^bsub>t n\<^esub>; sub E = sbsb (\<sigma>\<^bsub>sid\<^esub>(t n)); n''\<ge> n; e \<in> E;
      \<nexists>n' E'. n' \<ge> n \<and> n' \<le> n'' \<and> \<parallel>sid\<parallel>\<^bsub>t n'\<^esub> \<and>
        unsub E' = sbsb (\<sigma>\<^bsub>sid\<^esub>(t n')) \<and> e \<in> E';
      (e, m) = pbnt (\<sigma>\<^bsub>pid\<^esub>(t n'')); \<parallel>sid\<parallel>\<^bsub>t n''\<^esub>\<rbrakk>
      \<Longrightarrow> pbnt (\<sigma>\<^bsub>pid\<^esub>(t n'')) \<in> sbnt (\<sigma>\<^bsub>sid\<^esub>(t n''))"
begin

subsubsection "Calculus Interpretation"
text \<open>
\noindent
@{thm[source] pb.baIA}: @{thm pb.baIA [no_vars]}
\<close>
text \<open>
\noindent
@{thm[source] sb.baIA}: @{thm sb.baIA [no_vars]}
\<close>
subsubsection "Results from Singleton"
abbreviation the_pb :: "'pid" where
"the_pb \<equiv> pb.the_singleton"

text \<open>
\noindent
@{thm[source] pb.ts_prop(1)}: @{thm pb.ts_prop(1) [no_vars]}
\<close>
text \<open>
\noindent
@{thm[source] pb.ts_prop(2)}: @{thm pb.ts_prop(2) [no_vars]}
\<close>

subsubsection "Architectural Guarantees"
text \<open>
  The following theorem ensures that a subscriber indeed receives all messages associated with an event for which he is subscribed.
\<close>

text \<open>
  Since a publisher is actually a singleton, we can provide an alternative version of constraint @{thm[source] conn1}.
\<close>
lemma conn1A:
  fixes k
  shows "pbsb (\<sigma>\<^bsub>the_pb\<^esub>(k)) = (\<Union>sid\<in>{sid. \<parallel>sid\<parallel>\<^bsub>k\<^esub>}. {sbsb (\<sigma>\<^bsub>sid\<^esub>(k))})"
  using conn1[OF pb.ts_prop(2)] .
end

end


theory crdt_examples2
  imports crdt_specs2
    app_verification_helpers
begin

section "Difference Between CRDT Specifications"

subsection \<open>Struct example\<close>

text \<open>This is a struct with two fields: a counter and a set.\<close>

datatype val =
    I int
  | Bool bool
  | String string
  | ListVal "val list"
  | Undef

instance val :: countable
  by countable_datatype

definition [simp]: "uniqueIds_val_r (x::val) = ({}::uniqueId set)"

instantiation val :: valueType begin
definition [simp]: "uniqueIds_val \<equiv> uniqueIds_val_r"
definition [simp]: "default_val \<equiv> Undef"

instance by (standard, auto)
end

instantiation val :: from_bool begin
definition [simp]: "from_bool_val \<equiv> Bool"

instance by (standard, auto)
end

instantiation val :: from_int begin
definition [simp]: "from_int_val \<equiv> I"

instance by (standard, auto)
end

datatype messageDataOp =
    Author "val registerOp"
  | Content "val registerOp"

instance messageDataOp :: countable
  by countable_datatype
instantiation messageDataOp :: crdt_op begin
definition "uniqueIds_messageDataOp x \<equiv>
  case x of
     Author x \<Rightarrow> uniqueIds x
   | Content x \<Rightarrow> uniqueIds x"

definition [simp]: "default_messageDataOp = Author default"

definition "is_update_messageDataOp x \<equiv> case x of Author x \<Rightarrow> is_update x | Content x \<Rightarrow> is_update x"

lemma is_update_messageDataOp_simp[simp]:
  "is_update (Author x) = is_update x"
  "is_update (Content y) = is_update y"
  by (auto simp add: is_update_messageDataOp_def)

instance by (standard, auto)
end

datatype operation =
      Chat "val setOp"
    | Message "(val, messageDataOp) mapOp"

instance operation :: countable
  by countable_datatype
instantiation operation :: crdt_op begin
definition "uniqueIds_operation x \<equiv>
  case x of
     Chat x \<Rightarrow> uniqueIds x
   | Message x \<Rightarrow> uniqueIds x"

lemma [simp]: "uniqueIds (Chat x) = uniqueIds x"
  "uniqueIds (Message y) = uniqueIds y"
  by (auto simp add: uniqueIds_operation_def)

definition [simp]: "default_operation = Chat default"

definition "is_update_operation x \<equiv> case x of Chat x \<Rightarrow> is_update x | Message x \<Rightarrow> is_update x"

instance by (standard, auto)
end

definition messageStruct :: "(messageDataOp, val) crdtSpec" where
  "messageStruct \<equiv>
      struct_field Author (register_spec Undef)
  .\<or>. struct_field Content (register_spec Undef)
"

definition crdtSpec :: "(operation, val) crdtSpec" where
"crdtSpec \<equiv>
      struct_field Message (map_sdw_spec messageStruct)
  .\<or>. struct_field Chat set_rw_spec
"

definition messageStruct'  :: "('a, messageDataOp, val) ccrdtSpec"  where
  "messageStruct' \<equiv>
       struct_field' Author (register_spec' Undef)
  .\<or>.. struct_field' Content (register_spec' Undef)
"

definition crdtSpec' :: "(operation, operation, val) ccrdtSpec" where
"crdtSpec' \<equiv>
        struct_field' Message (map_sdw_spec' messageStruct')
  .\<or>.. struct_field'  Chat set_rw_spec'
"

lemma inj_fields[simp]: "inj Chat"
  "inj Message"
  "inj Author"
  "inj Content"
  by (auto simp add: inj_def)

text \<open>\DefineSnippet{first_order_spec_example_term}{
@{term "crdtSpec' (Message (NestedOp msg (Author Read))) vis op hb id (String author)"}
}%EndSnippet\<close>

lemma
  assumes "crdtSpec' (Message (NestedOp msg (Author Read))) vis op hb id (String author)"
  shows "???"
proof -
  from assms
  text_raw \<open>\DefineSnippet{first_order_spec_example1}{\<close>
  obtain a
    where "a \<in> vis"
      and  "\<forall>d\<in>vis. op d = Message (DeleteKey msg) \<longrightarrow> (d, a) \<in> hb"
      and  "op a = Message (NestedOp msg (Author (Assign (String author))))"
      and  "\<forall>c'. c' \<in> vis \<longrightarrow>
             (\<exists>d\<in>vis. op d = Message (DeleteKey msg) \<and> (d, c') \<notin> hb)
           \<or> (\<forall>v'. op c' \<noteq> Message (NestedOp msg (Author (Assign v'))))
           \<or> (a, c') \<notin> hb"
    text_raw \<open>}%EndSnippet\<close>

    apply (auto simp add: crdtSpec'_def map_sdw_spec'_def map_spec'_def messageStruct'_def register_spec'_def)
    apply (auto simp add: is_from_not_initial latest_values'_def latest_assignments'_def)
    apply (auto simp add: restrict_calls_def deleted_calls_sdw'_def)
    done
  oops

lemma
  assumes "crdtSpec (Message (NestedOp msg (Author Read))) \<lparr>calls = cs, happensBefore = hb\<rparr> (String author)"
  shows ???
proof -
text_raw \<open>\DefineSnippet{first_order_spec_example2}{\<close>
  (*<*)define sub_ctxt where (*>*)
  "sub_ctxt \<equiv>
      (restrict_ctxt_op (select_field Author)
               (sub_context (nested_op_on_key msg)
                 (- deleted_calls_sdw (restrict_ctxt_op (select_field Message)
                                            \<lparr>calls = cs, happensBefore = hb\<rparr>) msg)
                 (restrict_ctxt_op (select_field Message)
                                            \<lparr>calls = cs, happensBefore = hb\<rparr>)))"

  (*<*)from assms(*>*)
  obtain c where "Op sub_ctxt c \<triangleq> Assign (String author)"
    and "\<forall>c'. (\<forall>v'. Op sub_ctxt c' \<noteq> Some (Assign v'))
        \<or> (c, c') \<notin> happensBefore sub_ctxt"
text_raw \<open>}%EndSnippet\<close>
    apply (auto simp add: crdtSpec_def struct_field_def select_field_def)
    apply (auto simp add: map_sdw_spec_def map_spec_def messageStruct_def
        struct_field_def select_field_def)
    apply (auto simp add: register_spec_def split: if_splits)
    apply (thin_tac "\<not>_")
    apply (thin_tac "x \<in> _")
    apply (auto simp add: latestValues_def2 )
    apply (auto simp add: Op_restrict_ctxt_op_eq sub_ctxt_def)
    done

  have "(x,y) \<in> happensBefore sub_ctxt \<longleftrightarrow> ???"
    for x y
    apply (auto simp add: sub_ctxt_def happensBefore_restrict_ctxt_op2)
    apply (auto simp add: happens_before_sub_context happensBefore_restrict_ctxt_op2 calls_sub_context calls_restrict_ctxt_op2)
    oops

end


(*  Title:      HOL/Library/Old_Recdef.thy
    Author:     Konrad Slind and Markus Wenzel, TU Muenchen
*)

section \<open>TFL: recursive function definitions\<close>

theory Old_Recdef
imports Main
keywords
  "recdef" :: thy_decl and
  "permissive" "congs" "hints"
begin

subsection \<open>Lemmas for TFL\<close>

lemma tfl_wf_induct: "ALL R. wf R -->
       (ALL P. (ALL x. (ALL y. (y,x):R --> P y) --> P x) --> (ALL x. P x))"
apply clarify
apply (rule_tac r = R and P = P and a = x in wf_induct, assumption, blast)
done

lemma tfl_cut_def: "cut f r x \<equiv> (\<lambda>y. if (y,x) \<in> r then f y else undefined)"
  unfolding cut_def .

lemma tfl_cut_apply: "ALL f R. (x,a):R --> (cut f R a)(x) = f(x)"
apply clarify
apply (rule cut_apply, assumption)
done

lemma tfl_wfrec:
     "ALL M R f. (f=wfrec R M) --> wf R --> (ALL x. f x = M (cut f R x) x)"
apply clarify
apply (erule wfrec)
done

lemma tfl_eq_True: "(x = True) --> x"
  by blast

lemma tfl_rev_eq_mp: "(x = y) --> y --> x"
  by blast

lemma tfl_simp_thm: "(x --> y) --> (x = x') --> (x' --> y)"
  by blast

lemma tfl_P_imp_P_iff_True: "P ==> P = True"
  by blast

lemma tfl_imp_trans: "(A --> B) ==> (B --> C) ==> (A --> C)"
  by blast

lemma tfl_disj_assoc: "(a \<or> b) \<or> c == a \<or> (b \<or> c)"
  by simp

lemma tfl_disjE: "P \<or> Q ==> P --> R ==> Q --> R ==> R"
  by blast

lemma tfl_exE: "\<exists>x. P x ==> \<forall>x. P x --> Q ==> Q"
  by blast

ML_file "old_recdef.ML"

subsection \<open>Rule setup\<close>

lemmas [recdef_simp] =
  inv_image_def
  measure_def
  lex_prod_def
  same_fst_def
  less_Suc_eq [THEN iffD2]

lemmas [recdef_cong] =
  if_cong let_cong image_cong INF_cong SUP_cong bex_cong ball_cong imp_cong
  map_cong filter_cong takeWhile_cong dropWhile_cong foldl_cong foldr_cong

lemmas [recdef_wf] =
  wf_trancl
  wf_less_than
  wf_lex_prod
  wf_inv_image
  wf_measure
  wf_measures
  wf_pred_nat
  wf_same_fst
  wf_empty

end


(*  Title:      ZF/UNITY/Follows.thy
    Author:     Sidi O Ehmety, Cambridge University Computer Laboratory
    Copyright   2002  University of Cambridge

Theory ported from HOL.
*)

section\<open>The "Follows" relation of Charpentier and Sivilotte\<close>

theory Follows imports SubstAx Increasing begin

definition
  Follows :: "[i, i, i=>i, i=>i] => i"  where
  "Follows(A, r, f, g) ==
            Increasing(A, r, g) Int
            Increasing(A, r,f) Int
            Always({s \<in> state. <f(s), g(s)>:r}) Int
           (\<Inter>k \<in> A. {s \<in> state. <k, g(s)>:r} \<longmapsto>w {s \<in> state. <k,f(s)>:r})"

abbreviation
  Incr :: "[i=>i]=>i" where
  "Incr(f) == Increasing(list(nat), prefix(nat), f)"

abbreviation
  n_Incr :: "[i=>i]=>i" where
  "n_Incr(f) == Increasing(nat, Le, f)"

abbreviation
  s_Incr :: "[i=>i]=>i" where
  "s_Incr(f) == Increasing(Pow(nat), SetLe(nat), f)"

abbreviation
  m_Incr :: "[i=>i]=>i" where
  "m_Incr(f) == Increasing(Mult(nat), MultLe(nat, Le), f)"

abbreviation
  n_Fols :: "[i=>i, i=>i]=>i"   (infixl "n'_Fols" 65)  where
  "f n_Fols g == Follows(nat, Le, f, g)"

abbreviation
  Follows' :: "[i=>i, i=>i, i, i] => i"
        ("(_ /Fols _ /Wrt (_ /'/ _))" [60, 0, 0, 60] 60)  where
  "f Fols g Wrt r/A == Follows(A,r,f,g)"

(*Does this hold for "invariant"?*)

lemma Follows_cong:
     "[|A=A'; r=r'; !!x. x \<in> state ==> f(x)=f'(x); !!x. x \<in> state ==> g(x)=g'(x)|] ==> Follows(A, r, f, g) = Follows(A', r', f', g')"
by (simp add: Increasing_def Follows_def)

lemma subset_Always_comp:
"[| mono1(A, r, B, s, h); \<forall>x \<in> state. f(x):A & g(x):A |] ==>
   Always({x \<in> state. <f(x), g(x)> \<in> r})<=Always({x \<in> state. <(h comp f)(x), (h comp g)(x)> \<in> s})"
apply (unfold mono1_def metacomp_def)
apply (auto simp add: Always_eq_includes_reachable)
done

lemma imp_Always_comp:
"[| F \<in> Always({x \<in> state. <f(x), g(x)> \<in> r});
    mono1(A, r, B, s, h); \<forall>x \<in> state. f(x):A & g(x):A |] ==>
    F \<in> Always({x \<in> state. <(h comp f)(x), (h comp g)(x)> \<in> s})"
by (blast intro: subset_Always_comp [THEN subsetD])

lemma imp_Always_comp2:
"[| F \<in> Always({x \<in> state. <f1(x), f(x)> \<in> r});
    F \<in> Always({x \<in> state. <g1(x), g(x)> \<in> s});
    mono2(A, r, B, s, C, t, h);
    \<forall>x \<in> state. f1(x):A & f(x):A & g1(x):B & g(x):B |]
  ==> F \<in> Always({x \<in> state. <h(f1(x), g1(x)), h(f(x), g(x))> \<in> t})"
apply (auto simp add: Always_eq_includes_reachable mono2_def)
apply (auto dest!: subsetD)
done

(* comp LeadsTo *)

lemma subset_LeadsTo_comp:
"[| mono1(A, r, B, s, h); refl(A,r); trans[B](s);
        \<forall>x \<in> state. f(x):A & g(x):A |] ==>
  (\<Inter>j \<in> A. {s \<in> state. <j, g(s)> \<in> r} \<longmapsto>w {s \<in> state. <j,f(s)> \<in> r}) <=
 (\<Inter>k \<in> B. {x \<in> state. <k, (h comp g)(x)> \<in> s} \<longmapsto>w {x \<in> state. <k, (h comp f)(x)> \<in> s})"

apply (unfold mono1_def metacomp_def, clarify)
apply (simp_all (no_asm_use) add: INT_iff)
apply auto
apply (rule single_LeadsTo_I)
prefer 2 apply (blast dest: LeadsTo_type [THEN subsetD], auto)
apply (rotate_tac 5)
apply (drule_tac x = "g (sa) " in bspec)
apply (erule_tac [2] LeadsTo_weaken)
apply (auto simp add: part_order_def refl_def)
apply (rule_tac b = "h (g (sa))" in trans_onD)
apply blast
apply auto
done

lemma imp_LeadsTo_comp:
"[| F:(\<Inter>j \<in> A. {s \<in> state. <j, g(s)> \<in> r} \<longmapsto>w {s \<in> state. <j,f(s)> \<in> r});
    mono1(A, r, B, s, h); refl(A,r); trans[B](s);
    \<forall>x \<in> state. f(x):A & g(x):A |] ==>
   F:(\<Inter>k \<in> B. {x \<in> state. <k, (h comp g)(x)> \<in> s} \<longmapsto>w {x \<in> state. <k, (h comp f)(x)> \<in> s})"
apply (rule subset_LeadsTo_comp [THEN subsetD], auto)
done

lemma imp_LeadsTo_comp_right:
"[| F \<in> Increasing(B, s, g);
  \<forall>j \<in> A. F: {s \<in> state. <j, f(s)> \<in> r} \<longmapsto>w {s \<in> state. <j,f1(s)> \<in> r};
  mono2(A, r, B, s, C, t, h); refl(A, r); refl(B, s); trans[C](t);
  \<forall>x \<in> state. f1(x):A & f(x):A & g(x):B; k \<in> C |] ==>
  F:{x \<in> state. <k, h(f(x), g(x))> \<in> t} \<longmapsto>w {x \<in> state. <k, h(f1(x), g(x))> \<in> t}"
apply (unfold mono2_def Increasing_def)
apply (rule single_LeadsTo_I, auto)
apply (drule_tac x = "g (sa) " and A = B in bspec)
apply auto
apply (drule_tac x = "f (sa) " and P = "%j. F \<in> X(j) \<longmapsto>w Y(j)" for X Y in bspec)
apply auto
apply (rule PSP_Stable [THEN LeadsTo_weaken], blast, blast)
apply auto
apply (force simp add: part_order_def refl_def)
apply (force simp add: part_order_def refl_def)
apply (drule_tac x = "f1 (x)" and x1 = "f (sa) " and P2 = "%x y. \<forall>u\<in>B. P (x,y,u)" for P in bspec [THEN bspec])
apply (drule_tac [3] x = "g (x) " and x1 = "g (sa) " and P2 = "%x y. P (x,y) \<longrightarrow> d (x,y) \<in> t" for P d in bspec [THEN bspec])
apply auto
apply (rule_tac b = "h (f (sa), g (sa))" and A = C in trans_onD)
apply (auto simp add: part_order_def)
done

lemma imp_LeadsTo_comp_left:
"[| F \<in> Increasing(A, r, f);
  \<forall>j \<in> B. F: {x \<in> state. <j, g(x)> \<in> s} \<longmapsto>w {x \<in> state. <j,g1(x)> \<in> s};
  mono2(A, r, B, s, C, t, h); refl(A,r); refl(B, s); trans[C](t);
  \<forall>x \<in> state. f(x):A & g1(x):B & g(x):B; k \<in> C |] ==>
  F:{x \<in> state. <k, h(f(x), g(x))> \<in> t} \<longmapsto>w {x \<in> state. <k, h(f(x), g1(x))> \<in> t}"
apply (unfold mono2_def Increasing_def)
apply (rule single_LeadsTo_I, auto)
apply (drule_tac x = "f (sa) " and P = "%k. F \<in> Stable (X (k))" for X in bspec)
apply auto
apply (drule_tac x = "g (sa) " in bspec)
apply auto
apply (rule PSP_Stable [THEN LeadsTo_weaken], blast, blast)
apply auto
apply (force simp add: part_order_def refl_def)
apply (force simp add: part_order_def refl_def)
apply (drule_tac x = "f (x) " and x1 = "f (sa) " in bspec [THEN bspec])
apply (drule_tac [3] x = "g1 (x) " and x1 = "g (sa) " and P2 = "%x y. P (x,y) \<longrightarrow> d (x,y) \<in> t" for P d in bspec [THEN bspec])
apply auto
apply (rule_tac b = "h (f (sa), g (sa))" and A = C in trans_onD)
apply (auto simp add: part_order_def)
done

(**  This general result is used to prove Follows Un, munion, etc. **)
lemma imp_LeadsTo_comp2:
"[| F \<in> Increasing(A, r, f1) \<inter>  Increasing(B, s, g);
  \<forall>j \<in> A. F: {s \<in> state. <j, f(s)> \<in> r} \<longmapsto>w {s \<in> state. <j,f1(s)> \<in> r};
  \<forall>j \<in> B. F: {x \<in> state. <j, g(x)> \<in> s} \<longmapsto>w {x \<in> state. <j,g1(x)> \<in> s};
  mono2(A, r, B, s, C, t, h); refl(A,r); refl(B, s); trans[C](t);
  \<forall>x \<in> state. f(x):A & g1(x):B & f1(x):A &g(x):B; k \<in> C |]
  ==> F:{x \<in> state. <k, h(f(x), g(x))> \<in> t} \<longmapsto>w {x \<in> state. <k, h(f1(x), g1(x))> \<in> t}"
apply (rule_tac B = "{x \<in> state. <k, h (f1 (x), g (x))> \<in> t}" in LeadsTo_Trans)
apply (blast intro: imp_LeadsTo_comp_right)
apply (blast intro: imp_LeadsTo_comp_left)
done

(* Follows type *)
lemma Follows_type: "Follows(A, r, f, g)<=program"
apply (unfold Follows_def)
apply (blast dest: Increasing_type [THEN subsetD])
done

lemma Follows_into_program [TC]: "F \<in> Follows(A, r, f, g) ==> F \<in> program"
by (blast dest: Follows_type [THEN subsetD])

lemma FollowsD:
"F \<in> Follows(A, r, f, g)==>
  F \<in> program & (\<exists>a. a \<in> A) & (\<forall>x \<in> state. f(x):A & g(x):A)"
apply (unfold Follows_def)
apply (blast dest: IncreasingD)
done

lemma Follows_constantI:
 "[| F \<in> program; c \<in> A; refl(A, r) |] ==> F \<in> Follows(A, r, %x. c, %x. c)"
apply (unfold Follows_def, auto)
apply (auto simp add: refl_def)
done

lemma subset_Follows_comp:
"[| mono1(A, r, B, s, h); refl(A, r); trans[B](s) |]
   ==> Follows(A, r, f, g) \<subseteq> Follows(B, s,  h comp f, h comp g)"
apply (unfold Follows_def, clarify)
apply (frule_tac f = g in IncreasingD)
apply (frule_tac f = f in IncreasingD)
apply (rule IntI)
apply (rule_tac [2] h = h in imp_LeadsTo_comp)
prefer 5 apply assumption
apply (auto intro: imp_Increasing_comp imp_Always_comp simp del: INT_simps)
done

lemma imp_Follows_comp:
"[| F \<in> Follows(A, r, f, g);  mono1(A, r, B, s, h); refl(A, r); trans[B](s) |]
  ==>  F \<in> Follows(B, s,  h comp f, h comp g)"
apply (blast intro: subset_Follows_comp [THEN subsetD])
done

(* 2-place monotone operation \<in> this general result is used to prove Follows_Un, Follows_munion *)

(* 2-place monotone operation \<in> this general result is
   used to prove Follows_Un, Follows_munion *)
lemma imp_Follows_comp2:
"[| F \<in> Follows(A, r, f1, f);  F \<in> Follows(B, s, g1, g);
   mono2(A, r, B, s, C, t, h); refl(A,r); refl(B, s); trans[C](t) |]
   ==> F \<in> Follows(C, t, %x. h(f1(x), g1(x)), %x. h(f(x), g(x)))"
apply (unfold Follows_def, clarify)
apply (frule_tac f = g in IncreasingD)
apply (frule_tac f = f in IncreasingD)
apply (rule IntI, safe)
apply (rule_tac [3] h = h in imp_Always_comp2)
prefer 5 apply assumption
apply (rule_tac [2] h = h in imp_Increasing_comp2)
prefer 4 apply assumption
apply (rule_tac h = h in imp_Increasing_comp2)
prefer 3 apply assumption
apply simp_all
apply (blast dest!: IncreasingD)
apply (rule_tac h = h in imp_LeadsTo_comp2)
prefer 4 apply assumption
apply auto
  prefer 3 apply (simp add: mono2_def)
apply (blast dest: IncreasingD)+
done

lemma Follows_trans:
     "[| F \<in> Follows(A, r, f, g);  F \<in> Follows(A,r, g, h);
         trans[A](r) |] ==> F \<in> Follows(A, r, f, h)"
apply (frule_tac f = f in FollowsD)
apply (frule_tac f = g in FollowsD)
apply (simp add: Follows_def)
apply (simp add: Always_eq_includes_reachable INT_iff, auto)
apply (rule_tac [2] B = "{s \<in> state. <k, g (s) > \<in> r}" in LeadsTo_Trans)
apply (rule_tac b = "g (x) " in trans_onD)
apply blast+
done

(** Destruction rules for Follows **)

lemma Follows_imp_Increasing_left:
     "F \<in> Follows(A, r, f,g) ==> F \<in> Increasing(A, r, f)"
by (unfold Follows_def, blast)

lemma Follows_imp_Increasing_right:
     "F \<in> Follows(A, r, f,g) ==> F \<in> Increasing(A, r, g)"
by (unfold Follows_def, blast)

lemma Follows_imp_Always:
 "F :Follows(A, r, f, g) ==> F \<in> Always({s \<in> state. <f(s),g(s)> \<in> r})"
by (unfold Follows_def, blast)

lemma Follows_imp_LeadsTo:
 "[| F \<in> Follows(A, r, f, g); k \<in> A |]  ==>
  F: {s \<in> state. <k,g(s)> \<in> r } \<longmapsto>w {s \<in> state. <k,f(s)> \<in> r}"
by (unfold Follows_def, blast)

lemma Follows_LeadsTo_pfixLe:
     "[| F \<in> Follows(list(nat), gen_prefix(nat, Le), f, g); k \<in> list(nat) |]
   ==> F \<in> {s \<in> state. k pfixLe g(s)} \<longmapsto>w {s \<in> state. k pfixLe f(s)}"
by (blast intro: Follows_imp_LeadsTo)

lemma Follows_LeadsTo_pfixGe:
     "[| F \<in> Follows(list(nat), gen_prefix(nat, Ge), f, g); k \<in> list(nat) |]
   ==> F \<in> {s \<in> state. k pfixGe g(s)} \<longmapsto>w {s \<in> state. k pfixGe f(s)}"
by (blast intro: Follows_imp_LeadsTo)

lemma Always_Follows1:
"[| F \<in> Always({s \<in> state. f(s) = g(s)}); F \<in> Follows(A, r, f, h);
    \<forall>x \<in> state. g(x):A |] ==> F \<in> Follows(A, r, g, h)"
apply (unfold Follows_def Increasing_def Stable_def)
apply (simp add: INT_iff, auto)
apply (rule_tac [3] C = "{s \<in> state. f(s)=g(s)}"
        and A = "{s \<in> state. <k, h (s)> \<in> r}"
        and A' = "{s \<in> state. <k, f(s)> \<in> r}" in Always_LeadsTo_weaken)
apply (erule_tac A = "{s \<in> state. <k,f(s) > \<in> r}"
           and A' = "{s \<in> state. <k,f(s) > \<in> r}" in Always_Constrains_weaken)
apply auto
apply (drule Always_Int_I, assumption)
apply (erule_tac A = "{s \<in> state. f(s)=g(s)} \<inter> {s \<in> state. <f(s), h(s)> \<in> r}"
       in Always_weaken)
apply auto
done

lemma Always_Follows2:
"[| F \<in> Always({s \<in> state. g(s) = h(s)});
  F \<in> Follows(A, r, f, g); \<forall>x \<in> state. h(x):A |] ==> F \<in> Follows(A, r, f, h)"
apply (unfold Follows_def Increasing_def Stable_def)
apply (simp add: INT_iff, auto)
apply (rule_tac [3] C = "{s \<in> state. g (s) =h (s) }"
            and A = "{s \<in> state. <k, g (s) > \<in> r}"
            and A' = "{s \<in> state. <k, f (s) > \<in> r}" in Always_LeadsTo_weaken)
apply (erule_tac A = "{s \<in> state. <k, g(s)> \<in> r}"
         and A' = "{s \<in> state. <k, g(s)> \<in> r}" in Always_Constrains_weaken)
apply auto
apply (drule Always_Int_I, assumption)
apply (erule_tac A = "{s \<in> state. g(s)=h(s)} \<inter> {s \<in> state. <f(s), g(s)> \<in> r}"
       in Always_weaken)
apply auto
done

(** Union properties (with the subset ordering) **)

lemma refl_SetLe [simp]: "refl(Pow(A), SetLe(A))"
by (unfold refl_def SetLe_def, auto)

lemma trans_on_SetLe [simp]: "trans[Pow(A)](SetLe(A))"
by (unfold trans_on_def SetLe_def, auto)

lemma antisym_SetLe [simp]: "antisym(SetLe(A))"
by (unfold antisym_def SetLe_def, auto)

lemma part_order_SetLe [simp]: "part_order(Pow(A), SetLe(A))"
by (unfold part_order_def, auto)

lemma increasing_Un:
     "[| F \<in> Increasing.increasing(Pow(A), SetLe(A), f);
         F \<in> Increasing.increasing(Pow(A), SetLe(A), g) |]
     ==> F \<in> Increasing.increasing(Pow(A), SetLe(A), %x. f(x) \<union> g(x))"
by (rule_tac h = "op Un" in imp_increasing_comp2, auto)

lemma Increasing_Un:
     "[| F \<in> Increasing(Pow(A), SetLe(A), f);
         F \<in> Increasing(Pow(A), SetLe(A), g) |]
     ==> F \<in> Increasing(Pow(A), SetLe(A), %x. f(x) \<union> g(x))"
by (rule_tac h = "op Un" in imp_Increasing_comp2, auto)

lemma Always_Un:
     "[| F \<in> Always({s \<in> state. f1(s) \<subseteq> f(s)});
     F \<in> Always({s \<in> state. g1(s) \<subseteq> g(s)}) |]
      ==> F \<in> Always({s \<in> state. f1(s) \<union> g1(s) \<subseteq> f(s) \<union> g(s)})"
by (simp add: Always_eq_includes_reachable, blast)

lemma Follows_Un:
"[| F \<in> Follows(Pow(A), SetLe(A), f1, f);
     F \<in> Follows(Pow(A), SetLe(A), g1, g) |]
     ==> F \<in> Follows(Pow(A), SetLe(A), %s. f1(s) \<union> g1(s), %s. f(s) \<union> g(s))"
by (rule_tac h = "op Un" in imp_Follows_comp2, auto)

(** Multiset union properties (with the MultLe ordering) **)

lemma refl_MultLe [simp]: "refl(Mult(A), MultLe(A,r))"
by (unfold MultLe_def refl_def, auto)

lemma MultLe_refl1 [simp]:
 "[| multiset(M); mset_of(M)<=A |] ==> <M, M> \<in> MultLe(A, r)"
apply (unfold MultLe_def id_def lam_def)
apply (auto simp add: Mult_iff_multiset)
done

lemma MultLe_refl2 [simp]: "M \<in> Mult(A) ==> <M, M> \<in> MultLe(A, r)"
by (unfold MultLe_def id_def lam_def, auto)

lemma trans_on_MultLe [simp]: "trans[Mult(A)](MultLe(A,r))"
apply (unfold MultLe_def trans_on_def)
apply (auto intro: trancl_trans simp add: multirel_def)
done

lemma MultLe_type: "MultLe(A, r)<= (Mult(A) * Mult(A))"
apply (unfold MultLe_def, auto)
apply (drule multirel_type [THEN subsetD], auto)
done

lemma MultLe_trans:
     "[| <M,K> \<in> MultLe(A,r); <K,N> \<in> MultLe(A,r) |] ==> <M,N> \<in> MultLe(A,r)"
apply (cut_tac A=A in trans_on_MultLe)
apply (drule trans_onD, assumption)
apply (auto dest: MultLe_type [THEN subsetD])
done

lemma part_order_imp_part_ord:
     "part_order(A, r) ==> part_ord(A, r-id(A))"
apply (unfold part_order_def part_ord_def)
apply (simp add: refl_def id_def lam_def irrefl_def, auto)
apply (simp (no_asm) add: trans_on_def)
apply auto
apply (blast dest: trans_onD)
apply (simp (no_asm_use) add: antisym_def)
apply auto
done

lemma antisym_MultLe [simp]:
  "part_order(A, r) ==> antisym(MultLe(A,r))"
apply (unfold MultLe_def antisym_def)
apply (drule part_order_imp_part_ord, auto)
apply (drule irrefl_on_multirel)
apply (frule multirel_type [THEN subsetD])
apply (drule multirel_trans)
apply (auto simp add: irrefl_def)
done

lemma part_order_MultLe [simp]:
     "part_order(A, r) ==>  part_order(Mult(A), MultLe(A, r))"
apply (frule antisym_MultLe)
apply (auto simp add: part_order_def)
done

lemma empty_le_MultLe [simp]:
"[| multiset(M); mset_of(M)<= A|] ==> <0, M> \<in> MultLe(A, r)"
apply (unfold MultLe_def)
apply (case_tac "M=0")
apply (auto simp add: FiniteFun.intros)
apply (subgoal_tac "<0 +# 0, 0 +# M> \<in> multirel (A, r - id (A))")
apply (rule_tac [2] one_step_implies_multirel)
apply (auto simp add: Mult_iff_multiset)
done

lemma empty_le_MultLe2 [simp]: "M \<in> Mult(A) ==> <0, M> \<in> MultLe(A, r)"
by (simp add: Mult_iff_multiset)

lemma munion_mono:
"[| <M, N> \<in> MultLe(A, r); <K, L> \<in> MultLe(A, r) |] ==>
  <M +# K, N +# L> \<in> MultLe(A, r)"
apply (unfold MultLe_def)
apply (auto intro: munion_multirel_mono1 munion_multirel_mono2
       munion_multirel_mono multiset_into_Mult simp add: Mult_iff_multiset)
done

lemma increasing_munion:
     "[| F \<in> Increasing.increasing(Mult(A), MultLe(A,r), f);
         F \<in> Increasing.increasing(Mult(A), MultLe(A,r), g) |]
     ==> F \<in> Increasing.increasing(Mult(A),MultLe(A,r), %x. f(x) +# g(x))"
by (rule_tac h = munion in imp_increasing_comp2, auto)

lemma Increasing_munion:
     "[| F \<in> Increasing(Mult(A), MultLe(A,r), f);
         F \<in> Increasing(Mult(A), MultLe(A,r), g)|]
     ==> F \<in> Increasing(Mult(A),MultLe(A,r), %x. f(x) +# g(x))"
by (rule_tac h = munion in imp_Increasing_comp2, auto)

lemma Always_munion:
"[| F \<in> Always({s \<in> state. <f1(s),f(s)> \<in> MultLe(A,r)});
          F \<in> Always({s \<in> state. <g1(s), g(s)> \<in> MultLe(A,r)});
  \<forall>x \<in> state. f1(x):Mult(A)&f(x):Mult(A) & g1(x):Mult(A) & g(x):Mult(A)|]
      ==> F \<in> Always({s \<in> state. <f1(s) +# g1(s), f(s) +# g(s)> \<in> MultLe(A,r)})"
apply (rule_tac h = munion in imp_Always_comp2, simp_all)
apply (blast intro: munion_mono, simp_all)
done

lemma Follows_munion:
"[| F \<in> Follows(Mult(A), MultLe(A, r), f1, f);
    F \<in> Follows(Mult(A), MultLe(A, r), g1, g) |]
  ==> F \<in> Follows(Mult(A), MultLe(A, r), %s. f1(s) +# g1(s), %s. f(s) +# g(s))"
by (rule_tac h = munion in imp_Follows_comp2, auto)

(** Used in ClientImp **)

lemma Follows_msetsum_UN:
"!!f. [| \<forall>i \<in> I. F \<in> Follows(Mult(A), MultLe(A, r), f'(i), f(i));
  \<forall>s. \<forall>i \<in> I. multiset(f'(i, s)) & mset_of(f'(i, s))<=A &
                        multiset(f(i, s)) & mset_of(f(i, s))<=A ;
   Finite(I); F \<in> program |]
        ==> F \<in> Follows(Mult(A),
                        MultLe(A, r), %x. msetsum(%i. f'(i, x), I, A),
                                      %x. msetsum(%i. f(i,  x), I, A))"
apply (erule rev_mp)
apply (drule Finite_into_Fin)
apply (erule Fin_induct)
apply (simp (no_asm_simp))
apply (rule Follows_constantI)
apply (simp_all (no_asm_simp) add: FiniteFun.intros)
apply auto
apply (rule Follows_munion, auto)
done

end