theory TickTock_Hiding
  imports TickTock_Core
begin

subsection {* Hiding *}

fun hide_trace :: "'a ttevent set \<Rightarrow> 'a ttobs list \<Rightarrow> 'a ttobs list set" where
  "hide_trace X [] = {[]}" |
  "hide_trace X ([Event e]\<^sub>E # s) =
    {t. (Event e \<in> X \<and> t \<in> hide_trace X s) \<or> (\<exists>s'. Event e \<notin> X \<and> s' \<in> hide_trace X s \<and> t = [Event e]\<^sub>E # s')}" |
  "hide_trace X ([[Tick]\<^sub>E]) =
    {t. (Tick \<in> X \<and> t = []) \<or> (Tick \<notin> X \<and> t = [[Tick]\<^sub>E])}" |
  "hide_trace X ([Y]\<^sub>R # [Tock]\<^sub>E # s) =
    {t. (Tock \<in> X \<and> t \<in> hide_trace X s)
    \<or> (\<exists> s'. \<exists> Z\<subseteq>Y. Tock \<notin> X \<and> X \<subseteq> Y \<and> t = [Z]\<^sub>R # [Tock]\<^sub>E # s' \<and> s' \<in> hide_trace X s)}" | (* fill in subsets to account for removed sets *)
    (* if X \<subseteq> Y is not true an event in X could happen so the hidden event takes priority over tock *)
  "hide_trace X [[Y]\<^sub>R] = {t. \<exists> Z\<subseteq>Y. X \<subseteq> Y \<and> t = [[Z]\<^sub>R]}" | (* fill in subsets to account for removed sets *)
    (* if X \<subseteq> Y is not true an event in X could happen so instability is introduced when it is hidden *)
  "hide_trace X ([Tock]\<^sub>E # t) = {}" |
  "hide_trace X ([Y]\<^sub>R # [Event e]\<^sub>E # t) = {}" |
  "hide_trace X ([Y]\<^sub>R # [Tick]\<^sub>E # t) = {}" |
  "hide_trace X ([Y]\<^sub>R # [Z]\<^sub>R # t) = {}" |
  "hide_trace X ([Tick]\<^sub>E # x # t) = {}"

definition HidingTT :: "'a ttobs list set \<Rightarrow> 'a ttevent set \<Rightarrow> 'a ttobs list set" (infixl "\<setminus>\<^sub>C" 53) where
  "HidingTT P X = \<Union> {hide_trace X p | p. p \<in> P}"

lemma HidingTT_wf:
  assumes "\<forall>x\<in>P. ttWF x"
  shows "\<forall>x\<in>(P \<setminus>\<^sub>C X). ttWF x"
  using assms unfolding HidingTT_def
proof auto
  fix x p
  show "\<And> P x. \<forall>x\<in>P. ttWF x \<Longrightarrow> x \<in> hide_trace X p \<Longrightarrow> p \<in> P \<Longrightarrow> ttWF x"
    apply (induct p rule:hide_trace.induct, simp_all)
    apply (metis ttWF.simps(4) mem_Collect_eq)
    using ttWF.simps(1) apply blast
    apply (metis (mono_tags, hide_lams) contra_subsetD mem_Collect_eq ttWF.simps(5))
    using ttWF.simps(2) by blast
qed

lemma TT0_Hiding:
  assumes "TT0 P" "TT1 P"
  shows "TT0 (P \<setminus>\<^sub>C X)"
  unfolding HidingTT_def TT0_def
proof auto
  have "[] \<in> P"
    by (simp add: TT0_TT1_empty assms(1) assms(2))
  then show "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> x \<noteq> {}"
    using hide_trace.simps(1) by blast
qed

lemma TT1_Hiding:
  shows "TT1 P \<Longrightarrow> TT1 (P \<setminus>\<^sub>C X)"
  unfolding HidingTT_def TT1_def
proof auto
  fix p
  show "\<And>P \<rho> \<sigma>. \<forall>\<rho>. (\<exists>\<sigma>. \<rho> \<lesssim>\<^sub>C \<sigma> \<and> \<sigma> \<in> P) \<longrightarrow> \<rho> \<in> P \<Longrightarrow> \<rho> \<lesssim>\<^sub>C \<sigma> \<Longrightarrow> \<sigma> \<in> hide_trace X p \<Longrightarrow> p \<in> P \<Longrightarrow> \<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> \<in> x"
  proof (induct p rule:hide_trace.induct, simp_all, safe, simp_all)
    fix X :: "'a ttevent set"
    fix \<rho> :: "'a ttobs list"
    fix P :: "'a ttobs list set"
    assume case_assms: "\<rho> \<lesssim>\<^sub>C []" "[] \<in> P"
    then have "\<rho> = []"
      by (induct \<rho>, auto)
    then show "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> \<in> x"
      using case_assms by auto
  next
    fix X e s P \<rho> \<sigma>
    assume ind_hyp: "\<And>P \<rho> \<sigma>. \<forall>\<rho>. (\<exists>\<sigma>. \<rho> \<lesssim>\<^sub>C \<sigma> \<and> \<sigma> \<in> P) \<longrightarrow> \<rho> \<in> P \<Longrightarrow>
                 \<rho> \<lesssim>\<^sub>C \<sigma> \<Longrightarrow> \<sigma> \<in> hide_trace X s \<Longrightarrow> s \<in> P \<Longrightarrow> \<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> \<in> x"
    assume case_assms: "\<forall>\<rho>. (\<exists>\<sigma>. \<rho> \<lesssim>\<^sub>C \<sigma> \<and> \<sigma> \<in> P) \<longrightarrow> \<rho> \<in> P" "\<rho> \<lesssim>\<^sub>C \<sigma>" "[Event e]\<^sub>E # s \<in> P" "Event e \<in> X" "\<sigma> \<in> hide_trace X s"
    have 1: "\<forall>\<rho>. (\<exists>\<sigma>. \<rho> \<lesssim>\<^sub>C \<sigma> \<and> \<sigma> \<in> {t. [Event e]\<^sub>E # t \<in> P}) \<longrightarrow> \<rho> \<in> {t. [Event e]\<^sub>E # t \<in> P}"
      using case_assms(1) tt_prefix_subset.simps(3) by blast
    have 2: "s \<in> {t. [Event e]\<^sub>E # t \<in> P}"
      using case_assms by auto
    obtain x p  where "x = hide_trace X p \<and> p \<in> {t. [Event e]\<^sub>E # t \<in> P} \<and> \<rho> \<in> x"
      using 1 2 case_assms ind_hyp[where P="{t. [Event e]\<^sub>E # t \<in> P}", where \<rho>=\<rho>, where \<sigma>=\<sigma>] by blast
    then show "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> \<in> x"
      apply (rule_tac x="hide_trace X ([Event e]\<^sub>E # p)" in exI)
      by (metis (no_types, lifting) case_assms(4) hide_trace.simps(2) mem_Collect_eq)
  next
    fix X e s P \<rho> s'
    assume ind_hyp: "\<And>P \<rho> \<sigma>. \<forall>\<rho>. (\<exists>\<sigma>. \<rho> \<lesssim>\<^sub>C \<sigma> \<and> \<sigma> \<in> P) \<longrightarrow> \<rho> \<in> P \<Longrightarrow>
                 \<rho> \<lesssim>\<^sub>C \<sigma> \<Longrightarrow> \<sigma> \<in> hide_trace X s \<Longrightarrow> s \<in> P \<Longrightarrow> \<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> \<in> x"
    assume case_assms: "\<forall>\<rho>. (\<exists>\<sigma>. \<rho> \<lesssim>\<^sub>C \<sigma> \<and> \<sigma> \<in> P) \<longrightarrow> \<rho> \<in> P" "\<rho> \<lesssim>\<^sub>C [Event e]\<^sub>E # s'"
      "[Event e]\<^sub>E # s \<in> P" "Event e \<notin> X" "s' \<in> hide_trace X s"
    have "(\<exists>\<rho>'. \<rho>' \<lesssim>\<^sub>C s' \<and> \<rho> = [Event e]\<^sub>E # \<rho>') \<or> \<rho> = []"
      using case_assms(2) by (cases \<rho>, auto, (case_tac a, auto)+)
    then show "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> \<in> x"
    proof auto
      fix \<rho>'
      assume case_assms2: "\<rho>' \<lesssim>\<^sub>C s'" "\<rho> = [Event e]\<^sub>E # \<rho>'"
      have 1: "\<forall>\<rho>. (\<exists>\<sigma>. \<rho> \<lesssim>\<^sub>C \<sigma> \<and> \<sigma> \<in> {t. [Event e]\<^sub>E # t \<in> P}) \<longrightarrow> \<rho> \<in> {t. [Event e]\<^sub>E # t \<in> P}"
        using case_assms(1) tt_prefix_subset.simps(3) by blast
      have 2: "s \<in> {t. [Event e]\<^sub>E # t \<in> P}"
        by (simp add: case_assms(3))
      obtain x p where "x = hide_trace X p \<and> p \<in> {t. [Event e]\<^sub>E # t \<in> P} \<and> \<rho>' \<in> x"
        using ind_hyp[where P="{t. [Event e]\<^sub>E # t \<in> P}", where \<rho>=\<rho>', where \<sigma>=s'] 1 2 case_assms2 case_assms(5) by blast
      then show "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> [Event e]\<^sub>E # \<rho>' \<in> x"
        by (rule_tac x="hide_trace X ([Event e]\<^sub>E # p)" in exI, auto, rule_tac x="[Event e]\<^sub>E # p" in exI, auto simp add: case_assms)
    next
      show "\<rho> = [] \<Longrightarrow> \<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> [] \<in> x"
        apply (rule_tac x="hide_trace X []" in exI, auto, rule_tac x="[]" in exI, auto)
        using case_assms(1) case_assms(3) tt_prefix_subset.simps(1) by blast
    qed
  next
    fix X :: "'a ttevent set"
    fix \<rho> :: "'a ttobs list"
    fix P :: "'a ttobs list set"
    assume case_assms: "\<rho> \<lesssim>\<^sub>C []" "[[Tick]\<^sub>E] \<in> P" "\<forall>\<rho>. (\<exists>\<sigma>. \<rho> \<lesssim>\<^sub>C \<sigma> \<and> \<sigma> \<in> P) \<longrightarrow> \<rho> \<in> P"
    then have "\<rho> = []"
      by (cases \<rho>, auto)
    then show "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> \<in> x"
      apply (rule_tac x="hide_trace X []" in exI, auto, rule_tac x="[]" in exI, auto)
      using case_assms(2) case_assms(3) tt_prefix_subset.simps(1) by blast
  next
    fix X :: "'a ttevent set"
    fix \<rho> :: "'a ttobs list"
    fix P :: "'a ttobs list set"
    assume case_assms: "\<forall>\<rho>. (\<exists>\<sigma>. \<rho> \<lesssim>\<^sub>C \<sigma> \<and> \<sigma> \<in> P) \<longrightarrow> \<rho> \<in> P" "\<rho> \<lesssim>\<^sub>C [[Tick]\<^sub>E]" "[[Tick]\<^sub>E] \<in> P" "Tick \<notin> X"
    then have "\<rho> = [] \<or> \<rho> = [[Tick]\<^sub>E]"
      by (cases \<rho>, simp, case_tac a, simp_all, case_tac list, simp_all)
    then show "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> \<in> x"
      apply (auto, rule_tac x="hide_trace X []" in exI, auto, rule_tac x="[]" in exI, auto)
      using case_assms tt_prefix_subset.simps(1) by (blast, auto)
  next
    fix X Y s P \<rho> \<sigma>
    assume ind_hyp: "\<And>P \<rho> \<sigma>. \<forall>\<rho>. (\<exists>\<sigma>. \<rho> \<lesssim>\<^sub>C \<sigma> \<and> \<sigma> \<in> P) \<longrightarrow> \<rho> \<in> P \<Longrightarrow>
                 \<rho> \<lesssim>\<^sub>C \<sigma> \<Longrightarrow> \<sigma> \<in> hide_trace X s \<Longrightarrow> s \<in> P \<Longrightarrow> \<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> \<in> x"
    assume case_assms: "\<forall>\<rho>. (\<exists>\<sigma>. \<rho> \<lesssim>\<^sub>C \<sigma> \<and> \<sigma> \<in> P) \<longrightarrow> \<rho> \<in> P" "\<rho> \<lesssim>\<^sub>C \<sigma>" "[Y]\<^sub>R # [Tock]\<^sub>E # s \<in> P" "Tock \<in> X" "\<sigma> \<in> hide_trace X s"
    have 1: "\<forall>\<rho>. (\<exists>\<sigma>. \<rho> \<lesssim>\<^sub>C \<sigma> \<and> \<sigma> \<in> {t. [Y]\<^sub>R # [Tock]\<^sub>E # t \<in> P}) \<longrightarrow> \<rho> \<in> {t. [Y]\<^sub>R # [Tock]\<^sub>E # t \<in> P}"
      by (metis case_assms(1) tt_prefix_subset.simps(2) tt_prefix_subset.simps(3) tt_subset.simps(2) tt_subset_refl mem_Collect_eq)
    have 2: "s \<in> {t. [Y]\<^sub>R # [Tock]\<^sub>E # t \<in> P}"
      by (simp add: case_assms(3))
    obtain x p where "x = hide_trace X p \<and> p \<in> {t. [Y]\<^sub>R # [Tock]\<^sub>E # t \<in> P} \<and> \<rho> \<in> x"
      using ind_hyp[where P="{t. [Y]\<^sub>R # [Tock]\<^sub>E # t \<in> P}", where \<rho>=\<rho>, where \<sigma>=\<sigma>] 1 2 case_assms by blast
    then show "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> \<in> x"
      apply (rule_tac x="hide_trace X ([Y]\<^sub>R # [Tock]\<^sub>E # p)" in exI, auto)
      by (rule_tac x="[Y]\<^sub>R # [Tock]\<^sub>E # p" in exI, auto simp add: case_assms(4))
  next
    fix X Y s P \<rho> s' Z
    assume ind_hyp: "\<And>P \<rho> \<sigma>. \<forall>\<rho>. (\<exists>\<sigma>. \<rho> \<lesssim>\<^sub>C \<sigma> \<and> \<sigma> \<in> P) \<longrightarrow> \<rho> \<in> P \<Longrightarrow>
                 \<rho> \<lesssim>\<^sub>C \<sigma> \<Longrightarrow> \<sigma> \<in> hide_trace X s \<Longrightarrow> s \<in> P \<Longrightarrow> \<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> \<in> x"
    assume case_assms: "\<forall>\<rho>. (\<exists>\<sigma>. \<rho> \<lesssim>\<^sub>C \<sigma> \<and> \<sigma> \<in> P) \<longrightarrow> \<rho> \<in> P" "\<rho> \<lesssim>\<^sub>C [Z]\<^sub>R # [Tock]\<^sub>E # s'"
      "[Y]\<^sub>R # [Tock]\<^sub>E # s \<in> P" "Z \<subseteq> Y" "Tock \<notin> X" "X \<subseteq> Y" "s' \<in> hide_trace X s"
    have 1: "\<forall>\<rho>. (\<exists>\<sigma>. \<rho> \<lesssim>\<^sub>C \<sigma> \<and> \<sigma> \<in> {t. [Y]\<^sub>R # [Tock]\<^sub>E # t \<in> P}) \<longrightarrow> \<rho> \<in> {t. [Y]\<^sub>R # [Tock]\<^sub>E # t \<in> P}"
      by (metis case_assms(1) tt_prefix_subset.simps(2) tt_prefix_subset.simps(3) mem_Collect_eq subset_refl)
    have 2: "s \<in> {t. [Y]\<^sub>R # [Tock]\<^sub>E # t \<in> P}"
      by (simp add: case_assms(3))
    have "(\<exists> \<rho>' W. \<rho> = [W]\<^sub>R # [Tock]\<^sub>E # \<rho>' \<and> W \<subseteq> Z) \<or> (\<exists> W. \<rho> = [[W]\<^sub>R] \<and> W \<subseteq> Z) \<or> (\<rho> = [])"
      using case_assms(2) by (cases \<rho> rule:ttWF.cases, simp_all)
    then show "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> \<in> x"
    proof auto
      fix \<rho>' W
      assume case_assms2: "W \<subseteq> Z" "\<rho> = [W]\<^sub>R # [Tock]\<^sub>E # \<rho>'"
      have "\<rho>' \<lesssim>\<^sub>C s'"
        using case_assms(2) case_assms2(2) by auto
      then obtain x p where "x = hide_trace X p \<and> p \<in> {t. [Y]\<^sub>R # [Tock]\<^sub>E # t \<in> P} \<and> \<rho>' \<in> x"
        using ind_hyp[where P="{t. [Y]\<^sub>R # [Tock]\<^sub>E # t \<in> P}", where \<rho>=\<rho>', where \<sigma>=s'] 1 2 case_assms(7) by blast
      then show "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> [W]\<^sub>R # [Tock]\<^sub>E # \<rho>' \<in> x"
        apply (rule_tac x="hide_trace X ([Y]\<^sub>R # [Tock]\<^sub>E # p)" in exI, safe)
        using case_assms2(1) case_assms(4) case_assms(5) case_assms(6) by (rule_tac x="[Y]\<^sub>R # [Tock]\<^sub>E # p" in exI, auto)
    next
      fix W
      assume case_assms2: "W \<subseteq> Z" "\<rho> = [[W]\<^sub>R]"
      then show "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> [[W]\<^sub>R] \<in> x"
        apply (rule_tac x="hide_trace X ([[Y]\<^sub>R])" in exI, safe)
        using case_assms(4) case_assms(5) case_assms(6) apply (rule_tac x="[[Y]\<^sub>R]" in exI, auto)
        using case_assms(1) case_assms(3) tt_prefix_subset.simps(1) tt_prefix_subset.simps(2) by blast
    next
      show "\<rho> = [] \<Longrightarrow> \<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> [] \<in> x"
        using case_assms(1) case_assms(3) tt_prefix_subset.simps(1) hide_trace.simps(1) by blast
    qed
  next
    fix X Y P \<rho> Z
    assume case_assms: "\<forall>\<rho>. (\<exists>\<sigma>. \<rho> \<lesssim>\<^sub>C \<sigma> \<and> \<sigma> \<in> P) \<longrightarrow> \<rho> \<in> P" "\<rho> \<lesssim>\<^sub>C [[Z]\<^sub>R]" "[[Y]\<^sub>R] \<in> P" "Z \<subseteq> Y" "X \<subseteq> Y "
    then have "(\<exists> W. \<rho> = [[W]\<^sub>R] \<and> W \<subseteq> Z) \<or> (\<rho> = [])"
      using case_assms(2) by (cases \<rho> rule:ttWF.cases, simp_all)
    then show "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> \<in> x"
      apply auto apply (rule_tac x="hide_trace X ([[Y]\<^sub>R])" in exI, safe)
      using case_assms apply (rule_tac x="[[Y]\<^sub>R]" in exI, auto)
      apply (rule_tac x="{[]}" in exI, simp, rule_tac x="[]" in exI, simp)
      using tt_prefix_subset.simps(1) by blast
  qed
qed

lemma TT2w_Hiding:
  assumes "TT2w P"
  shows "TT2w (P \<setminus>\<^sub>C X)"
  unfolding TT2w_def HidingTT_def
proof auto
  fix Xa Y p
  show "\<And> \<rho>. Y \<inter> {e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[e]\<^sub>E] \<in> x) \<or>
      e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)} = {} \<Longrightarrow>
    \<rho> @ [[Xa]\<^sub>R] \<in> hide_trace X p \<Longrightarrow> p \<in> P \<Longrightarrow> \<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa \<union> Y]\<^sub>R] \<in> x"
    using assms
  proof -
    show "\<And>P \<rho>. Y \<inter> {e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[e]\<^sub>E] \<in> x) \<or>
        e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)} = {} \<Longrightarrow>
      \<rho> @ [[Xa]\<^sub>R] \<in> hide_trace X p \<Longrightarrow> p \<in> P \<Longrightarrow> TT2w P \<Longrightarrow> \<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa \<union> Y]\<^sub>R] \<in> x"
    proof (induct p rule:ttWF.induct, simp_all, safe, simp_all)
      fix Xb P
      assume case_assms: "Y \<inter> {e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> [[e]\<^sub>E] \<in> x) \<or>
                      e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)} = {}"
        "[[Xb]\<^sub>R] \<in> P" "TT2w P" "Xa \<subseteq> Xb" "X \<subseteq> Xb"
      have "{e. e\<notin>X \<and> (e \<noteq> Tock \<and> [[e]\<^sub>E] \<in> P \<or> e = Tock \<and> [[Xb]\<^sub>R, [e]\<^sub>E] \<in> P)} \<subseteq>
        {e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> [[e]\<^sub>E] \<in> x) \<or>
          e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)}"
      proof auto
        fix x
        show "x \<notin> X \<Longrightarrow> [[x]\<^sub>E] \<in> P \<Longrightarrow> x \<noteq> Tock \<Longrightarrow> \<exists>xa. (\<exists>p. xa = hide_trace X p \<and> p \<in> P) \<and> [[x]\<^sub>E] \<in> xa"
          by (rule_tac x="hide_trace X [[x]\<^sub>E]" in exI, auto, cases x, auto)
      next
        fix x
        show "x \<notin> X \<Longrightarrow> [[x]\<^sub>E] \<in> P \<Longrightarrow> x \<noteq> Tock \<Longrightarrow> \<exists>xa. (\<exists>p. xa = hide_trace X p \<and> p \<in> P) \<and> [[x]\<^sub>E] \<in> xa"
          by (rule_tac x="hide_trace X [[x]\<^sub>E]" in exI, auto, cases x, auto)
      next
        show "Tock \<notin> X \<Longrightarrow> [[Xb]\<^sub>R, [Tock]\<^sub>E] \<in> P \<Longrightarrow> \<forall>x. (\<forall>p. x = hide_trace X p \<longrightarrow> p \<notin> P) \<or> [[Xa]\<^sub>R, [Tock]\<^sub>E] \<notin> x \<Longrightarrow> False"
          using case_assms by (erule_tac x="hide_trace X [[Xb]\<^sub>R, [Tock]\<^sub>E]" in allE, auto)
      next
        show "Tock \<notin> X \<Longrightarrow> [[Xb]\<^sub>R, [Tock]\<^sub>E] \<in> P \<Longrightarrow> \<forall>x. (\<forall>p. x = hide_trace X p \<longrightarrow> p \<notin> P) \<or> [[Xa]\<^sub>R, [Tock]\<^sub>E] \<notin> x \<Longrightarrow> \<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> [[Tock]\<^sub>E] \<in> x"
          using case_assms by (erule_tac x="hide_trace X [[Xb]\<^sub>R, [Tock]\<^sub>E]" in allE, auto)
      qed
      then have "{x. x \<notin> X} \<inter> Y \<inter> {e. e\<notin>X \<and> (e \<noteq> Tock \<and> [[e]\<^sub>E] \<in> P \<or> e = Tock \<and> [[Xb]\<^sub>R, [e]\<^sub>E] \<in> P)} = {}"
        using Int_empty_right case_assms(1) by auto
      then have "[[Xb \<union> ({x. x \<notin> X} \<inter> Y)]\<^sub>R] \<in> P"
        using case_assms unfolding TT2w_def by (erule_tac x="[]" in allE, erule_tac x="Xb" in allE, erule_tac x="{x. x \<notin> X} \<inter> Y" in allE, auto)
      also have "Xb \<union> ({x. x \<notin> X} \<inter> Y) = Xb \<union> Y"
        using case_assms by auto
      then have "[[Xb \<union> Y]\<^sub>R] \<in> P"
        using calculation by auto
      then show "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> [[Xa \<union> Y]\<^sub>R] \<in> x"
        using case_assms by (rule_tac x="hide_trace X [[Xb \<union> Y]\<^sub>R]" in exI, auto)
    next
      fix e \<sigma> P \<rho>
      assume ind_hyp: "\<And>P \<rho>. Y \<inter> {e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[e]\<^sub>E] \<in> x) \<or>
                       e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)} = {} \<Longrightarrow>
        \<rho> @ [[Xa]\<^sub>R] \<in> hide_trace X \<sigma> \<Longrightarrow> \<sigma> \<in> P \<Longrightarrow> TT2w P \<Longrightarrow> \<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa \<union> Y]\<^sub>R] \<in> x"
      assume case_assms: "Y \<inter> {e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[e]\<^sub>E] \<in> x) \<or>
                e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)} = {}"
        "[Event e]\<^sub>E # \<sigma> \<in> P" "TT2w P" "Event e \<in> X" "\<rho> @ [[Xa]\<^sub>R] \<in> hide_trace X \<sigma>"
      have "{ea. ea \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {\<sigma>. [Event e]\<^sub>E # \<sigma> \<in> P}) \<and> \<rho> @ [[ea]\<^sub>E] \<in> x) \<or>
              ea = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {\<sigma>. [Event e]\<^sub>E # \<sigma> \<in> P}) \<and> \<rho> @ [[Xa]\<^sub>R, [ea]\<^sub>E] \<in> x)} \<subseteq>
        {e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[e]\<^sub>E] \<in> x) \<or>
                e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)}"
        using case_assms(4) apply (safe, simp_all)
        apply (rule_tac x="hide_trace X ([Event e]\<^sub>E # p)" in exI, simp, rule_tac x="[Event e]\<^sub>E # p" in exI, simp)
        apply (rule_tac x="hide_trace X ([Event e]\<^sub>E # p)" in exI, simp, rule_tac x="[Event e]\<^sub>E # p" in exI, simp)
        apply (erule_tac x="hide_trace X ([Event e]\<^sub>E # p)" in allE, simp)
        by (erule_tac x="hide_trace X ([Event e]\<^sub>E # p)" in allE, simp)
      then have 1: "Y \<inter> {ea. ea \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {\<sigma>. [Event e]\<^sub>E # \<sigma> \<in> P}) \<and> \<rho> @ [[ea]\<^sub>E] \<in> x) \<or>
              ea = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {\<sigma>. [Event e]\<^sub>E # \<sigma> \<in> P}) \<and> \<rho> @ [[Xa]\<^sub>R, [ea]\<^sub>E] \<in> x)} = {}"
        by (smt case_assms(1) disjoint_iff_not_equal subsetCE)
      have 2: "TT2w {\<sigma>. [Event e]\<^sub>E # \<sigma> \<in> P}"
        using case_assms(3) unfolding TT2w_def by (auto, erule_tac x="[Event e]\<^sub>E # \<rho>" in allE, auto)
      show "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa \<union> Y]\<^sub>R] \<in> x"
        using ind_hyp[where P="{\<sigma>. [Event e]\<^sub>E # \<sigma> \<in> P}", where \<rho>=\<rho>] 1 2 case_assms by auto
    next
      fix e \<sigma> P \<rho> s'
      assume ind_hyp: "\<And>P \<rho>. Y \<inter> {e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[e]\<^sub>E] \<in> x) \<or>
                       e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)} = {} \<Longrightarrow>
        \<rho> @ [[Xa]\<^sub>R] \<in> hide_trace X \<sigma> \<Longrightarrow> \<sigma> \<in> P \<Longrightarrow> TT2w P \<Longrightarrow> \<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa \<union> Y]\<^sub>R] \<in> x"
      assume case_assms: "Y \<inter> {e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[e]\<^sub>E] \<in> x) \<or>
                e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)} = {}"
        "[Event e]\<^sub>E # \<sigma> \<in> P" "TT2w P" "Event e \<notin> X" "s' \<in> hide_trace X \<sigma>" "\<rho> @ [[Xa]\<^sub>R] = [Event e]\<^sub>E # s'"
      then obtain \<rho>' where \<rho>'_assms: "\<rho> = [Event e]\<^sub>E # \<rho>' \<and> \<rho>' @ [[Xa]\<^sub>R] \<in> hide_trace X \<sigma>"
        by (cases \<rho> rule:ttWF.cases, simp_all, blast)
      have "{ea. ea \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {\<sigma>. [Event e]\<^sub>E # \<sigma> \<in> P}) \<and> \<rho>' @ [[ea]\<^sub>E] \<in> x) \<or>
          ea = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {\<sigma>. [Event e]\<^sub>E # \<sigma> \<in> P}) \<and> \<rho>' @ [[Xa]\<^sub>R, [ea]\<^sub>E] \<in> x)} \<subseteq>
        {e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[e]\<^sub>E] \<in> x) \<or>
          e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)}"
        using \<rho>'_assms case_assms(4) by auto
      then have 1: "Y \<inter> {ea. ea \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {\<sigma>. [Event e]\<^sub>E # \<sigma> \<in> P}) \<and> \<rho>' @ [[ea]\<^sub>E] \<in> x) \<or>
          ea = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {\<sigma>. [Event e]\<^sub>E # \<sigma> \<in> P}) \<and> \<rho>' @ [[Xa]\<^sub>R, [ea]\<^sub>E] \<in> x)} = {}"
        by (smt case_assms(1) disjoint_iff_not_equal subsetCE)
      have 2: "TT2w {\<sigma>. [Event e]\<^sub>E # \<sigma> \<in> P}"
        using case_assms(3) unfolding TT2w_def by (auto, erule_tac x="[Event e]\<^sub>E # \<rho>" in allE, auto)
      have "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {\<sigma>. [Event e]\<^sub>E # \<sigma> \<in> P}) \<and> \<rho>' @ [[Xa \<union> Y]\<^sub>R] \<in> x"
        using ind_hyp[where P="{\<sigma>. [Event e]\<^sub>E # \<sigma> \<in> P}", where \<rho>="\<rho>'"] 1 2 \<rho>'_assms case_assms by auto
      then obtain x p where "x = hide_trace X p \<and> p \<in> {\<sigma>. [Event e]\<^sub>E # \<sigma> \<in> P} \<and> \<rho>' @ [[Xa \<union> Y]\<^sub>R] \<in> x"
        by auto
      then show "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa \<union> Y]\<^sub>R] \<in> x"
        using case_assms \<rho>'_assms by (rule_tac x="hide_trace X ([Event e]\<^sub>E # p)" in exI, auto)
    next
      fix Xb \<sigma> P \<rho>
      assume ind_hyp: "\<And>P \<rho>. Y \<inter> {e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[e]\<^sub>E] \<in> x) \<or>
                       e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)} = {} \<Longrightarrow>
        \<rho> @ [[Xa]\<^sub>R] \<in> hide_trace X \<sigma> \<Longrightarrow> \<sigma> \<in> P \<Longrightarrow> TT2w P \<Longrightarrow> \<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa \<union> Y]\<^sub>R] \<in> x"
      assume case_assms: "Y \<inter> {e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[e]\<^sub>E] \<in> x) \<or>
                e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)} = {}"
        "[Xb]\<^sub>R # [Tock]\<^sub>E # \<sigma> \<in> P" "TT2w P" "Tock \<in> X" "\<rho> @ [[Xa]\<^sub>R] \<in> hide_trace X \<sigma>"
      have "{e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {\<sigma>. [Xb]\<^sub>R # [Tock]\<^sub>E # \<sigma> \<in> P}) \<and> \<rho> @ [[e]\<^sub>E] \<in> x) \<or>
          e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {\<sigma>. [Xb]\<^sub>R # [Tock]\<^sub>E # \<sigma> \<in> P}) \<and> \<rho> @ [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)} \<subseteq>
        {e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[e]\<^sub>E] \<in> x) \<or>
          e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)}"
        using case_assms(2) case_assms(4) case_assms(5) by (auto)
      then have 1: "Y \<inter> {e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {\<sigma>. [Xb]\<^sub>R # [Tock]\<^sub>E # \<sigma> \<in> P}) \<and> \<rho> @ [[e]\<^sub>E] \<in> x) \<or>
          e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {\<sigma>. [Xb]\<^sub>R # [Tock]\<^sub>E # \<sigma> \<in> P}) \<and> \<rho> @ [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)} = {}"
        by (smt case_assms(1) disjoint_iff_not_equal subsetCE)
      have 2: "TT2w {\<sigma>. [Xb]\<^sub>R # [Tock]\<^sub>E # \<sigma> \<in> P}"
        using case_assms(3) unfolding TT2w_def by (auto, erule_tac x="[Xb]\<^sub>R # [Tock]\<^sub>E # \<rho>" in allE, auto)
      have "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {\<sigma>. [Xb]\<^sub>R # [Tock]\<^sub>E # \<sigma> \<in> P}) \<and> \<rho> @ [[Xa \<union> Y]\<^sub>R] \<in> x"
        using ind_hyp[where P="{\<sigma>. [Xb]\<^sub>R # [Tock]\<^sub>E # \<sigma> \<in> P}", where \<rho>=\<rho>] 1 2 case_assms by auto
      then obtain x p where "x = hide_trace X p \<and> p \<in> {\<sigma>. [Xb]\<^sub>R # [Tock]\<^sub>E # \<sigma> \<in> P} \<and> \<rho> @ [[Xa \<union> Y]\<^sub>R] \<in> x"
        by auto
      then show "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa \<union> Y]\<^sub>R] \<in> x"
        using case_assms by (rule_tac x="hide_trace X ([Xb]\<^sub>R # [Tock]\<^sub>E # p)" in exI, simp, rule_tac x="[Xb]\<^sub>R # [Tock]\<^sub>E # p" in exI, simp)
    next
      fix Xb \<sigma> P \<rho> s' Z
      assume ind_hyp: "\<And>P \<rho>. Y \<inter> {e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[e]\<^sub>E] \<in> x) \<or>
                       e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)} = {} \<Longrightarrow>
        \<rho> @ [[Xa]\<^sub>R] \<in> hide_trace X \<sigma> \<Longrightarrow> \<sigma> \<in> P \<Longrightarrow> TT2w P \<Longrightarrow> \<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa \<union> Y]\<^sub>R] \<in> x"
      assume case_assms: "Y \<inter> {e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[e]\<^sub>E] \<in> x) \<or>
                e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)} = {}"
        "[Xb]\<^sub>R # [Tock]\<^sub>E # \<sigma> \<in> P" "TT2w P" "Z \<subseteq> Xb" "Tock \<notin> X" "X \<subseteq> Xb" "\<rho> @ [[Xa]\<^sub>R] = [Z]\<^sub>R # [Tock]\<^sub>E # s'" "s' \<in> hide_trace X \<sigma>"
      then obtain \<rho>' where \<rho>'_assms: "\<rho> = [Z]\<^sub>R # [Tock]\<^sub>E # \<rho>' \<and> \<rho>' @ [[Xa]\<^sub>R] \<in> hide_trace X \<sigma>"
        by (cases \<rho> rule:ttWF.cases, simp_all, blast)
      have "{e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {\<sigma>. [Xb]\<^sub>R # [Tock]\<^sub>E # \<sigma> \<in> P}) \<and> \<rho>' @ [[e]\<^sub>E] \<in> x) \<or>
          e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {\<sigma>. [Xb]\<^sub>R # [Tock]\<^sub>E # \<sigma> \<in> P}) \<and> \<rho>' @ [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)} \<subseteq>
        {e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[e]\<^sub>E] \<in> x) \<or>
          e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)}"
        using case_assms \<rho>'_assms apply (safe, simp_all)
        apply (rule_tac x="hide_trace X ([Xb]\<^sub>R # [Tock]\<^sub>E # p)" in exI, simp, safe, rule_tac x="[Xb]\<^sub>R # [Tock]\<^sub>E # p" in exI, simp)
        apply (rule_tac x="hide_trace X ([Xb]\<^sub>R # [Tock]\<^sub>E # p)" in exI, simp, rule_tac x="[Xb]\<^sub>R # [Tock]\<^sub>E # p" in exI, simp)
        apply (erule_tac x="hide_trace X ([Xb]\<^sub>R # [Tock]\<^sub>E # p)" in allE, simp)
        by (erule_tac x="hide_trace X ([Xb]\<^sub>R # [Tock]\<^sub>E # p)" in allE, simp)
      then have 1: "Y \<inter> {e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {\<sigma>. [Xb]\<^sub>R # [Tock]\<^sub>E # \<sigma> \<in> P}) \<and> \<rho>' @ [[e]\<^sub>E] \<in> x) \<or>
          e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {\<sigma>. [Xb]\<^sub>R # [Tock]\<^sub>E # \<sigma> \<in> P}) \<and> \<rho>' @ [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)} = {}"
        by (smt case_assms(1) disjoint_iff_not_equal subsetCE)
      have 2: "TT2w {\<sigma>. [Xb]\<^sub>R # [Tock]\<^sub>E # \<sigma> \<in> P}"
        using case_assms(3) unfolding TT2w_def by (auto, erule_tac x="[Xb]\<^sub>R # [Tock]\<^sub>E # \<rho>" in allE, auto)
      have "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {\<sigma>. [Xb]\<^sub>R # [Tock]\<^sub>E # \<sigma> \<in> P}) \<and> \<rho>' @ [[Xa \<union> Y]\<^sub>R] \<in> x"
        using ind_hyp[where P="{\<sigma>. [Xb]\<^sub>R # [Tock]\<^sub>E # \<sigma> \<in> P}", where \<rho>=\<rho>'] 1 2 case_assms \<rho>'_assms by auto
      then obtain x p where "x = hide_trace X p \<and> p \<in> {\<sigma>. [Xb]\<^sub>R # [Tock]\<^sub>E # \<sigma> \<in> P} \<and> \<rho>' @ [[Xa \<union> Y]\<^sub>R] \<in> x"
        by auto
      then show "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa \<union> Y]\<^sub>R] \<in> x"
        using case_assms \<rho>'_assms by (rule_tac x="hide_trace X ([Xb]\<^sub>R # [Tock]\<^sub>E # p)" in exI, auto)
    qed
  qed
qed

lemma TT2_Hiding:
  assumes "TT2 P"
  shows "TT2 (P \<setminus>\<^sub>C X)"
  unfolding TT2_def HidingTT_def
proof auto
  fix Xa Y p
  show "\<And> \<rho> \<sigma>. Y \<inter> {e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[e]\<^sub>E] \<in> x) \<or>
                e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)} = {} \<Longrightarrow>
    \<rho> @ [Xa]\<^sub>R # \<sigma> \<in> hide_trace X p \<Longrightarrow> p \<in> P \<Longrightarrow> \<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [Xa \<union> Y]\<^sub>R # \<sigma> \<in> x"
    using assms
  proof -
    show "\<And>P \<rho> \<sigma>. Y \<inter> {e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[e]\<^sub>E] \<in> x) \<or>
                   e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)} = {} \<Longrightarrow>
           \<rho> @ [Xa]\<^sub>R # \<sigma> \<in> hide_trace X p \<Longrightarrow> p \<in> P \<Longrightarrow> TT2 P \<Longrightarrow> \<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [Xa \<union> Y]\<^sub>R # \<sigma> \<in> x"
    proof (induct p rule:ttWF.induct, simp_all, safe)
      fix Xb P \<rho> \<sigma> Z
      assume case_assms: "Y \<inter> {e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[e]\<^sub>E] \<in> x) \<or>
                e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)} = {}"
        "[[Xb]\<^sub>R] \<in> P" "TT2 P" "Z \<subseteq> Xb" "X \<subseteq> Xb" "\<rho> @ [Xa]\<^sub>R # \<sigma> = [[Z]\<^sub>R]"
      have 1: "Z = Xa \<and> \<rho> = [] \<and> \<sigma> = []"
        by (metis (no_types, lifting) Nil_is_append_conv append_eq_Cons_conv case_assms(6) ttobs.inject(2) list.distinct(1) list.inject)
      then have "{e. e \<notin> X \<and> (e \<noteq> Tock \<and> \<rho> @ [[e]\<^sub>E] \<in> P \<or> e = Tock \<and> \<rho> @ [[Xb]\<^sub>R, [e]\<^sub>E] \<in> P)}
        \<subseteq> {e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[e]\<^sub>E] \<in> x) \<or>
          e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)}"
      proof auto
        fix x
        assume "[[x]\<^sub>E] \<in> P" "x \<noteq> Tock" "x \<notin> X"
        then show "\<exists>xa. (\<exists>p. xa = hide_trace X p \<and> p \<in> P) \<and> [[x]\<^sub>E] \<in> xa"
          by (rule_tac x="hide_trace X [[x]\<^sub>E]" in exI, cases x, force+)
      next
        fix x
        assume "[[x]\<^sub>E] \<in> P" "x \<noteq> Tock" "x \<notin> X"
        then show "\<exists>xa. (\<exists>p. xa = hide_trace X p \<and> p \<in> P) \<and> [[x]\<^sub>E] \<in> xa"
          by (rule_tac x="hide_trace X [[x]\<^sub>E]" in exI, cases x, force+)
      next
        assume "[[Xb]\<^sub>R, [Tock]\<^sub>E] \<in> P" "Tock \<notin> X"
        then show "\<forall>x. (\<forall>p. x = hide_trace X p \<longrightarrow> p \<notin> P) \<or> [[Xa]\<^sub>R, [Tock]\<^sub>E] \<notin> x \<Longrightarrow> False"
          using 1 case_assms by (erule_tac x="hide_trace X [[Xb]\<^sub>R, [Tock]\<^sub>E]" in allE, auto)
      next
        assume "[[Xb]\<^sub>R, [Tock]\<^sub>E] \<in> P" "Tock \<notin> X"
        then show "\<forall>x. (\<forall>p. x = hide_trace X p \<longrightarrow> p \<notin> P) \<or> [[Xa]\<^sub>R, [Tock]\<^sub>E] \<notin> x \<Longrightarrow>
          \<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> [[Tock]\<^sub>E] \<in> x"
          using 1 case_assms by (erule_tac x="hide_trace X [[Xb]\<^sub>R, [Tock]\<^sub>E]" in allE, auto)
      qed
      then have "{e. e \<in> Y \<and> e \<notin> X} \<inter> {e. (e \<noteq> Tock \<and> \<rho> @ [[e]\<^sub>E] \<in> P \<or> e = Tock \<and> \<rho> @ [[Xb]\<^sub>R, [e]\<^sub>E] \<in> P)} = {}"
        using case_assms(1) by auto
      then have "[[Xb \<union> {e. e \<in> Y \<and> e \<notin> X}]\<^sub>R] \<in> P"
        using case_assms 1 unfolding TT2_def by (erule_tac x="[]" in allE, force)
      then have "Xb \<union> {e. e \<in> Y \<and> e \<notin> X} = Xb \<union> Y \<Longrightarrow> [[Xb \<union> Y]\<^sub>R] \<in> P"
        by auto
      then have "[[Xb \<union> Y]\<^sub>R] \<in> P"
        using case_assms by force
      then show "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [Xa \<union> Y]\<^sub>R # \<sigma> \<in> x"
        using 1 case_assms by force
    next
      fix P \<rho> \<sigma>
      assume "\<rho> @ [Xa]\<^sub>R # \<sigma> = [[Tick]\<^sub>E]"
      then have "False"
        by (meson append_eq_Cons_conv append_is_Nil_conv ttobs.simps(4) list.inject list.simps(3))
      then show "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [Xa \<union> Y]\<^sub>R # \<sigma> \<in> x"
        by auto
    next
      fix e \<sigma> P \<rho> \<sigma>'
      assume ind_hyp: "\<And>P \<rho> \<sigma>'. Y \<inter> {e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[e]\<^sub>E] \<in> x) \<or>
                          e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)} = {} \<Longrightarrow>
        \<rho> @ [Xa]\<^sub>R # \<sigma>' \<in> hide_trace X \<sigma> \<Longrightarrow> \<sigma> \<in> P \<Longrightarrow> TT2 P \<Longrightarrow> \<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [Xa \<union> Y]\<^sub>R # \<sigma>' \<in> x"
      assume case_assms: "Y \<inter> {e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[e]\<^sub>E] \<in> x) \<or>
                e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)} = {}"
        "[Event e]\<^sub>E # \<sigma> \<in> P" "TT2 P" "Event e \<in> X" "\<rho> @ [Xa]\<^sub>R # \<sigma>' \<in> hide_trace X \<sigma>"
      have  1: "TT2 {x. [Event e]\<^sub>E # x \<in> P}"
        by (simp add: TT2_init_event case_assms(3))
      then have "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {x. [Event e]\<^sub>E # x \<in> P}) \<and> \<rho> @ [Xa \<union> Y]\<^sub>R # \<sigma>' \<in> x"
        using case_assms 1 ind_hyp[where P ="{x. [Event e]\<^sub>E # x \<in> P}", where \<rho>=\<rho>, where \<sigma>'=\<sigma>'] by force
      then show "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [Xa \<union> Y]\<^sub>R # \<sigma>' \<in> x"
        using case_assms by auto
    next
      fix e \<sigma> P \<rho> \<sigma>' s'
      assume ind_hyp: "\<And>P \<rho> \<sigma>'. Y \<inter> {e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[e]\<^sub>E] \<in> x) \<or>
                          e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)} = {} \<Longrightarrow>
        \<rho> @ [Xa]\<^sub>R # \<sigma>' \<in> hide_trace X \<sigma> \<Longrightarrow> \<sigma> \<in> P \<Longrightarrow> TT2 P \<Longrightarrow> \<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [Xa \<union> Y]\<^sub>R # \<sigma>' \<in> x"
      assume case_assms: "Y \<inter> {e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[e]\<^sub>E] \<in> x) \<or>
                e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)} = {}"
        "[Event e]\<^sub>E # \<sigma> \<in> P" "TT2 P" "Event e \<notin> X" "s' \<in> hide_trace X \<sigma>" "\<rho> @ [Xa]\<^sub>R # \<sigma>' = [Event e]\<^sub>E # s'"
      obtain \<rho>' where s'_def: "s' = \<rho>' @ [Xa]\<^sub>R # \<sigma>'"
        using case_assms(6) by (cases \<rho> rule:ttWF.cases, auto)
      have "{ea. ea \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {x. [Event e]\<^sub>E # x \<in> P}) \<and> \<rho>' @ [[ea]\<^sub>E] \<in> x) \<or>
          ea = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {x. [Event e]\<^sub>E # x \<in> P}) \<and> \<rho>' @ [[Xa]\<^sub>R, [ea]\<^sub>E] \<in> x)}
        \<subseteq> {e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[e]\<^sub>E] \<in> x) \<or>
          e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)}"
        using s'_def case_assms(4) case_assms(6) by auto
      then have 1: "Y \<inter> {ea. ea \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {x. [Event e]\<^sub>E # x \<in> P}) \<and> \<rho>' @ [[ea]\<^sub>E] \<in> x) \<or>
          ea = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {x. [Event e]\<^sub>E # x \<in> P}) \<and> \<rho>' @ [[Xa]\<^sub>R, [ea]\<^sub>E] \<in> x)} = {}"
        by (smt case_assms(1) disjoint_iff_not_equal subsetCE)
      have 2: "TT2 {x. [Event e]\<^sub>E # x \<in> P}"
        by (simp add: TT2_init_event case_assms(3))
      have "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {x. [Event e]\<^sub>E # x \<in> P}) \<and> \<rho>' @ [Xa \<union> Y]\<^sub>R # \<sigma>' \<in> x"
        using case_assms 1 2 s'_def ind_hyp[where P ="{x. [Event e]\<^sub>E # x \<in> P}", where \<rho>=\<rho>', where \<sigma>'=\<sigma>'] by force
      then show "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [Xa \<union> Y]\<^sub>R # \<sigma>' \<in> x"
        using case_assms s'_def by force
    next
      fix Xb \<sigma> P \<rho> \<sigma>'
      assume ind_hyp: "\<And>P \<rho> \<sigma>'. Y \<inter> {e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[e]\<^sub>E] \<in> x) \<or>
          e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)} = {} \<Longrightarrow>
        \<rho> @ [Xa]\<^sub>R # \<sigma>' \<in> hide_trace X \<sigma> \<Longrightarrow> \<sigma> \<in> P \<Longrightarrow> TT2 P \<Longrightarrow> \<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [Xa \<union> Y]\<^sub>R # \<sigma>' \<in> x"
      assume case_assms: "Y \<inter> {e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[e]\<^sub>E] \<in> x) \<or>
                e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)} = {}"
        "[Xb]\<^sub>R # [Tock]\<^sub>E # \<sigma> \<in> P" "TT2 P" "Tock \<in> X" "\<rho> @ [Xa]\<^sub>R # \<sigma>' \<in> hide_trace X \<sigma>"
      have 1: "TT2 {x. [Xb]\<^sub>R # [Tock]\<^sub>E # x \<in> P}"
        by (simp add: TT2_init_tock case_assms(3))
      have "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {x. [Xb]\<^sub>R # [Tock]\<^sub>E # x \<in> P}) \<and> \<rho> @ [Xa \<union> Y]\<^sub>R # \<sigma>' \<in> x"
        using case_assms 1 ind_hyp[where P ="{x. [Xb]\<^sub>R # [Tock]\<^sub>E # x \<in> P}", where \<rho>=\<rho>, where \<sigma>'=\<sigma>'] by force
      then show "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [Xa \<union> Y]\<^sub>R # \<sigma>' \<in> x"
        using case_assms by force
    next
      fix Xb \<sigma> P \<rho> \<sigma>' s' Z
      assume ind_hyp: "\<And>P \<rho> \<sigma>'. Y \<inter> {e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[e]\<^sub>E] \<in> x) \<or>
                          e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)} = {} \<Longrightarrow>
        \<rho> @ [Xa]\<^sub>R # \<sigma>' \<in> hide_trace X \<sigma> \<Longrightarrow> \<sigma> \<in> P \<Longrightarrow> TT2 P \<Longrightarrow> \<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [Xa \<union> Y]\<^sub>R # \<sigma>' \<in> x"
      assume case_assms: "Y \<inter> {e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[e]\<^sub>E] \<in> x) \<or>
                e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)} = {}"
        "[Xb]\<^sub>R # [Tock]\<^sub>E # \<sigma> \<in> P" "TT2 P" "Z \<subseteq> Xb" "Tock \<notin> X" "X \<subseteq> Xb" "\<rho> @ [Xa]\<^sub>R # \<sigma>' = [Z]\<^sub>R # [Tock]\<^sub>E # s'" "s' \<in> hide_trace X \<sigma>"
      have 1: "TT2 {x. [Xb]\<^sub>R # [Tock]\<^sub>E # x \<in> P}"
          using TT2_init_tock case_assms(3) by blast
      have "(\<exists> \<rho>'. s' = \<rho>' @ [Xa]\<^sub>R # \<sigma>') \<or> (\<rho> = [] \<and> Z = Xa \<and> \<sigma>' = [Tock]\<^sub>E # s')"
        using case_assms(7) by (cases \<rho> rule:ttWF.cases, auto)
      then show "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [Xa \<union> Y]\<^sub>R # \<sigma>' \<in> x"
      proof auto
        fix \<rho>'
        assume case_assm2: "s' = \<rho>' @ [Xa]\<^sub>R # \<sigma>'"
        have "{ea. ea \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {x. [Xb]\<^sub>R # [Tock]\<^sub>E #  x \<in> P}) \<and> \<rho>' @ [[ea]\<^sub>E] \<in> x) \<or>
          ea = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {x. [Xb]\<^sub>R # [Tock]\<^sub>E #  x \<in> P}) \<and> \<rho>' @ [[Xa]\<^sub>R, [ea]\<^sub>E] \<in> x)}
        \<subseteq> {e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[e]\<^sub>E] \<in> x) \<or>
          e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)}"
          using case_assm2 case_assms by auto
        then have 2: "Y \<inter> {ea. ea \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {x. [Xb]\<^sub>R # [Tock]\<^sub>E #  x \<in> P}) \<and> \<rho>' @ [[ea]\<^sub>E] \<in> x) \<or>
          ea = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {x. [Xb]\<^sub>R # [Tock]\<^sub>E #  x \<in> P}) \<and> \<rho>' @ [[Xa]\<^sub>R, [ea]\<^sub>E] \<in> x)} = {}"
          by (smt case_assms(1) disjoint_iff_not_equal subsetCE)
        have "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {x. [Xb]\<^sub>R # [Tock]\<^sub>E # x \<in> P}) \<and> \<rho>' @ [Xa \<union> Y]\<^sub>R # \<sigma>' \<in> x"
          using case_assms case_assm2 1 2 ind_hyp[where P ="{x. [Xb]\<^sub>R # [Tock]\<^sub>E # x \<in> P}", where \<rho>=\<rho>', where \<sigma>'=\<sigma>'] by force
        then show "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [Xa \<union> Y]\<^sub>R # \<sigma>' \<in> x"
          using case_assms case_assm2 by force
      next
        assume case_assms2: "\<rho> = []" "Z = Xa" "\<sigma>' = [Tock]\<^sub>E # s'"
        have "{e. e \<notin> X \<and> (e \<noteq> Tock \<and> \<rho> @ [[e]\<^sub>E] \<in> P \<or> e = Tock \<and> \<rho> @ [[Xb]\<^sub>R, [e]\<^sub>E] \<in> P)}
          \<subseteq> {e. e \<noteq> Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[e]\<^sub>E] \<in> x) \<or>
                e = Tock \<and> (\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> \<rho> @ [[Xa]\<^sub>R, [e]\<^sub>E] \<in> x)}"
          using case_assms case_assms2 by (auto, (case_tac x, auto)+)
        then have "{e. e \<notin> X \<and> e \<in> Y} \<inter> {e. e \<noteq> Tock \<and> \<rho> @ [[e]\<^sub>E] \<in> P \<or> e = Tock \<and> \<rho> @ [[Xb]\<^sub>R, [e]\<^sub>E] \<in> P} = {}"
          using case_assms(1) by auto
        then have "[Xb \<union> {e. e \<notin> X \<and> e \<in> Y}]\<^sub>R # [Tock]\<^sub>E # \<sigma> \<in> P"
          using case_assms case_assms2 unfolding TT2_def by (erule_tac x="[]" in allE, force)
        then have "Xb \<union> {e. e \<notin> X \<and> e \<in> Y} = Xb \<union> Y \<Longrightarrow> [Xb \<union> Y]\<^sub>R # [Tock]\<^sub>E # \<sigma> \<in> P"
          by auto
        then have "[Xb \<union> Y]\<^sub>R # [Tock]\<^sub>E # \<sigma> \<in> P"
          using case_assms by force
        then show "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> [Xa \<union> Y]\<^sub>R # [Tock]\<^sub>E # s' \<in> x"
          using case_assms case_assms2 by force
      qed
    qed
  qed
qed

lemma ttWFx_Hiding:
  "ttWFx P \<Longrightarrow> ttWFx (P \<setminus>\<^sub>C X)"
  unfolding ttWFx_def HidingTT_def
proof (safe, simp_all)
  fix p
  show "\<And>P x. Ball P ttWFx_trace \<Longrightarrow> x \<in> hide_trace X p \<Longrightarrow> p \<in> P \<Longrightarrow> ttWFx_trace x"
  proof (induct p rule:ttWF.induct)
    fix P x
    show "Ball P ttWFx_trace \<Longrightarrow> x \<in> hide_trace X [] \<Longrightarrow> [] \<in> P \<Longrightarrow> ttWFx_trace x"
      by (cases x, simp_all)
  next
    fix Xa P x
    show "Ball P ttWFx_trace \<Longrightarrow> x \<in> hide_trace X [[Xa]\<^sub>R] \<Longrightarrow> [[Xa]\<^sub>R] \<in> P \<Longrightarrow> ttWFx_trace x"
      by (cases x, simp_all, case_tac a, simp_all)
  next
    fix P x
    show "Ball P ttWFx_trace \<Longrightarrow> x \<in> hide_trace X [[Tick]\<^sub>E] \<Longrightarrow> [[Tick]\<^sub>E] \<in> P \<Longrightarrow> ttWFx_trace x"
      by (cases x, simp_all)
  next
    fix e \<sigma> P x
    assume ind_hyp: "\<And>P x. Ball P ttWFx_trace \<Longrightarrow> x \<in> hide_trace X \<sigma> \<Longrightarrow> \<sigma> \<in> P \<Longrightarrow> ttWFx_trace x"
    assume case_assms: "Ball P ttWFx_trace" "x \<in> hide_trace X ([Event e]\<^sub>E # \<sigma>)" "[Event e]\<^sub>E # \<sigma> \<in> P"
    have 1: "Ball {\<sigma>. [Event e]\<^sub>E # \<sigma> \<in> P} ttWFx_trace"
      using case_assms(1)
      using ttWFx_trace_cons_imp_cons by blast
    show "ttWFx_trace x"
    proof (cases "Event e \<in> X")
      assume case_assms2: "Event e \<in> X"
      then have "x \<in> hide_trace X \<sigma>"
        using case_assms(2) by auto
      then show "ttWFx_trace x"
        using ind_hyp[where P="{\<sigma>. [Event e]\<^sub>E # \<sigma> \<in> P}", where x=x] case_assms(3) case_assms2 1 by blast
    next
      assume case_assms2: "Event e \<notin> X"
      then obtain x' where x'_assms: "x = [Event e]\<^sub>E # x' \<and> x' \<in> hide_trace X \<sigma>"
        using case_assms(2) by (cases x, auto)
      then have "ttWFx_trace x'"
        using ind_hyp[where P="{\<sigma>. [Event e]\<^sub>E # \<sigma> \<in> P}", where x=x'] case_assms(3) case_assms2 1 by blast
      then show "ttWFx_trace x"
        using x'_assms by (cases x', simp_all)
    qed
  next
    fix Xa \<sigma> P x
    assume ind_hyp: "\<And>P x. Ball P ttWFx_trace \<Longrightarrow> x \<in> hide_trace X \<sigma> \<Longrightarrow> \<sigma> \<in> P \<Longrightarrow> ttWFx_trace x"
    assume case_assms: "Ball P ttWFx_trace" "x \<in> hide_trace X ([Xa]\<^sub>R # [Tock]\<^sub>E # \<sigma>)" "[Xa]\<^sub>R # [Tock]\<^sub>E # \<sigma> \<in> P"
    have 1: "Ball {\<sigma>. [Xa]\<^sub>R # [Tock]\<^sub>E # \<sigma> \<in> P} ttWFx_trace"
      using case_assms(1) by auto
    have 2: "\<sigma> \<in> {\<sigma>. [Xa]\<^sub>R # [Tock]\<^sub>E # \<sigma> \<in> P}"
      using case_assms(3) by auto
    have 3: "Tock \<notin> Xa"
      using case_assms(1) case_assms(3) by auto
    have "(\<exists>X' x'. x = [X']\<^sub>R # [Tock]\<^sub>E # x' \<and> x' \<in> hide_trace X \<sigma> \<and> X' \<subseteq> Xa) \<or> (x \<in> hide_trace X \<sigma>)"
      using case_assms(2) by (cases "X \<subseteq> Xa", auto)
    then show "ttWFx_trace x"
    proof safe
      fix X' x'
      assume case_assms2: "x = [X']\<^sub>R # [Tock]\<^sub>E # x'" "x' \<in> hide_trace X \<sigma>" "X' \<subseteq> Xa"
      then have "ttWFx_trace x'"
        using ind_hyp[where P="{\<sigma>. [Xa]\<^sub>R # [Tock]\<^sub>E # \<sigma> \<in> P}", where x=x'] 1 2 by blast
      then show "ttWFx_trace ([X']\<^sub>R # [Tock]\<^sub>E # x')"
        using case_assms2 3 by auto
    next
      assume case_assms2: "x \<in> hide_trace X \<sigma>"
      then show "ttWFx_trace x"
        using ind_hyp[where P="{\<sigma>. [Xa]\<^sub>R # [Tock]\<^sub>E # \<sigma> \<in> P}", where x=x] 1 2 by blast
    qed
  next
    fix va P x
    show "x \<in> hide_trace X ([Tock]\<^sub>E # va) \<Longrightarrow> ttWFx_trace x"
      by simp
  next
    fix va P x
    show "x \<in> hide_trace X ([Tock]\<^sub>E # va) \<Longrightarrow> ttWFx_trace x"
      by simp
  next
    fix va P x
    show "x \<in> hide_trace X ([Tock]\<^sub>E # va) \<Longrightarrow> ttWFx_trace x"
      by simp
  next
    fix v vc P x
    show "x \<in> hide_trace X ([Tick]\<^sub>E # v # vc) \<Longrightarrow> ttWFx_trace x"
      by simp
  next
    fix v vc P x
    show "x \<in> hide_trace X ([Tick]\<^sub>E # v # vc) \<Longrightarrow> ttWFx_trace x"
      by simp
  next
    fix va vd vc P x
    show "x \<in> hide_trace X ([va]\<^sub>R # [Event vd]\<^sub>E # vc) \<Longrightarrow> ttWFx_trace x"
      by simp
  next
    fix va vc P x
    show "x \<in> hide_trace X ([va]\<^sub>R # [Tick]\<^sub>E # vc) \<Longrightarrow> ttWFx_trace x"
      by simp
  next
    fix va v vc P x
    show "x \<in> hide_trace X ([va]\<^sub>R # [v]\<^sub>R # vc) \<Longrightarrow> ttWFx_trace x"
      by simp
  qed
qed

lemma TT3w_Hiding:
  "TT1 P \<Longrightarrow> TT3w P \<Longrightarrow> TT3w (P \<setminus>\<^sub>C X)"
  unfolding TT3w_def HidingTT_def
proof (safe, simp_all)
  fix p
  show "\<And> \<rho> P. TT1 P \<Longrightarrow> \<forall>\<rho>. \<rho> \<in> P \<longrightarrow> add_Tick_refusal_trace \<rho> \<in> P \<Longrightarrow> \<rho> \<in> hide_trace X p \<Longrightarrow> p \<in> P \<Longrightarrow>
    \<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> add_Tick_refusal_trace \<rho> \<in> x"
  proof (induct p rule:hide_trace.induct, auto)
    fix X e s \<rho> P
    assume ind_hyp: "\<And>\<rho> P. TT1 P \<Longrightarrow> \<forall>\<rho>. \<rho> \<in> P \<longrightarrow> add_Tick_refusal_trace \<rho> \<in> P \<Longrightarrow>
               \<rho> \<in> hide_trace X s \<Longrightarrow> s \<in> P \<Longrightarrow> \<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> add_Tick_refusal_trace \<rho> \<in> x"
    assume case_assms: "TT1 P" "\<forall>\<rho>. \<rho> \<in> P \<longrightarrow> add_Tick_refusal_trace \<rho> \<in> P" "[Event e]\<^sub>E # s \<in> P" "Event e \<in> X" "\<rho> \<in> hide_trace X s"
    have 1: "\<forall>\<rho>. \<rho> \<in> {s. [Event e]\<^sub>E # s \<in> P} \<longrightarrow> add_Tick_refusal_trace \<rho> \<in> {s. [Event e]\<^sub>E # s \<in> P}"
      using case_assms(2) by force
    have 2: "s \<in> {s. [Event e]\<^sub>E # s \<in> P}"
      by (simp add: case_assms(3))
    have 3: "TT1 {s. [Event e]\<^sub>E # s \<in> P}"
      using case_assms(1) unfolding TT1_def apply auto by (erule_tac x="[Event e]\<^sub>E # \<rho>" in allE, auto)
    have "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {s. [Event e]\<^sub>E # s \<in> P}) \<and> add_Tick_refusal_trace \<rho> \<in> x"
      using ind_hyp[where P="{s. [Event e]\<^sub>E # s \<in> P}", where \<rho>=\<rho>] 1 2 3 case_assms by blast
    then show "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> add_Tick_refusal_trace \<rho> \<in> x"
      using case_assms by auto
  next
    fix X e s P s'
    assume ind_hyp: "\<And>\<rho> P. TT1 P \<Longrightarrow> \<forall>\<rho>. \<rho> \<in> P \<longrightarrow> add_Tick_refusal_trace \<rho> \<in> P \<Longrightarrow>
               \<rho> \<in> hide_trace X s \<Longrightarrow> s \<in> P \<Longrightarrow> \<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> add_Tick_refusal_trace \<rho> \<in> x"
    assume case_assms: "TT1 P" "\<forall>\<rho>. \<rho> \<in> P \<longrightarrow> add_Tick_refusal_trace \<rho> \<in> P" "[Event e]\<^sub>E # s \<in> P" "Event e \<notin> X" "s' \<in> hide_trace X s"
    have 1: "\<forall>\<rho>. \<rho> \<in> {s. [Event e]\<^sub>E # s \<in> P} \<longrightarrow> add_Tick_refusal_trace \<rho> \<in> {s. [Event e]\<^sub>E # s \<in> P}"
      using case_assms(2) by force
    have 2: "s \<in> {s. [Event e]\<^sub>E # s \<in> P}"
      by (simp add: case_assms(3))
    have 3: "TT1 {s. [Event e]\<^sub>E # s \<in> P}"
      using case_assms(1) unfolding TT1_def apply auto by (erule_tac x="[Event e]\<^sub>E # \<rho>" in allE, auto)
    have "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {s. [Event e]\<^sub>E # s \<in> P}) \<and> add_Tick_refusal_trace s' \<in> x"
      using ind_hyp[where P="{s. [Event e]\<^sub>E # s \<in> P}", where \<rho>=s'] 1 2 3 case_assms by blast
    then show "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> [Event e]\<^sub>E # add_Tick_refusal_trace s' \<in> x"
      using case_assms by auto
  next
    fix X Y s \<rho> P
    assume ind_hyp: "\<And>\<rho> P. TT1 P \<Longrightarrow> \<forall>\<rho>. \<rho> \<in> P \<longrightarrow> add_Tick_refusal_trace \<rho> \<in> P \<Longrightarrow>
               \<rho> \<in> hide_trace X s \<Longrightarrow> s \<in> P \<Longrightarrow> \<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> add_Tick_refusal_trace \<rho> \<in> x"
    assume case_assms: "TT1 P" "\<forall>\<rho>. \<rho> \<in> P \<longrightarrow> add_Tick_refusal_trace \<rho> \<in> P" "[Y]\<^sub>R # [Tock]\<^sub>E # s \<in> P" "Tock \<in> X" "\<rho> \<in> hide_trace X s"
    have 1: "\<forall>\<rho>. \<rho> \<in> {s. [Y\<union>{Tick}]\<^sub>R # [Tock]\<^sub>E # s \<in> P} \<longrightarrow> add_Tick_refusal_trace \<rho> \<in> {s. [Y\<union>{Tick}]\<^sub>R # [Tock]\<^sub>E # s \<in> P}"
      using case_assms(2) by force
    have 2: "s \<in> {s. [Y\<union>{Tick}]\<^sub>R # [Tock]\<^sub>E # s \<in> P}"
      using TT3w_TT1_add_Tick_ref_Tock TT3w_def case_assms(1) case_assms(2) case_assms(3) by blast
    have 3: "TT1 {s. [Y\<union>{Tick}]\<^sub>R # [Tock]\<^sub>E # s \<in> P}"
      using case_assms(1) unfolding TT1_def apply auto by (erule_tac x="[insert Tick Y]\<^sub>R # [Tock]\<^sub>E # \<rho>" in allE, auto)
    have "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {s. [Y \<union> {Tick}]\<^sub>R # [Tock]\<^sub>E # s \<in> P}) \<and> add_Tick_refusal_trace \<rho> \<in> x"
      using ind_hyp[where P="{s. [Y\<union>{Tick}]\<^sub>R # [Tock]\<^sub>E # s \<in> P}", where \<rho>=\<rho>] 1 2 3 case_assms by blast
    then show "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> add_Tick_refusal_trace \<rho> \<in> x"
      using case_assms(4) by auto
  next
    fix X Y s P s' Z
    assume ind_hyp: "\<And>\<rho> P. TT1 P \<Longrightarrow> \<forall>\<rho>. \<rho> \<in> P \<longrightarrow> add_Tick_refusal_trace \<rho> \<in> P \<Longrightarrow>
               \<rho> \<in> hide_trace X s \<Longrightarrow> s \<in> P \<Longrightarrow> \<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> add_Tick_refusal_trace \<rho> \<in> x"
    assume case_assms: "TT1 P" "\<forall>\<rho>. \<rho> \<in> P \<longrightarrow> add_Tick_refusal_trace \<rho> \<in> P" "[Y]\<^sub>R # [Tock]\<^sub>E # s \<in> P" "Z \<subseteq> Y" "Tock \<notin> X" "X \<subseteq> Y" "s' \<in> hide_trace X s"
    have 1: "\<forall>\<rho>. \<rho> \<in> {s. [Y\<union>{Tick}]\<^sub>R # [Tock]\<^sub>E # s \<in> P} \<longrightarrow> add_Tick_refusal_trace \<rho> \<in> {s. [Y\<union>{Tick}]\<^sub>R # [Tock]\<^sub>E # s \<in> P}"
      using case_assms(2) by force
    have 2: "s \<in> {s. [Y\<union>{Tick}]\<^sub>R # [Tock]\<^sub>E # s \<in> P}"
      using TT3w_TT1_add_Tick_ref_Tock TT3w_def case_assms(1) case_assms(2) case_assms(3) by blast
    have 3: "TT1 {s. [Y\<union>{Tick}]\<^sub>R # [Tock]\<^sub>E # s \<in> P}"
      using case_assms(1) unfolding TT1_def apply auto by (erule_tac x="[insert Tick Y]\<^sub>R # [Tock]\<^sub>E # \<rho>" in allE, auto)
    have "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> {s. [Y \<union> {Tick}]\<^sub>R # [Tock]\<^sub>E # s \<in> P}) \<and> add_Tick_refusal_trace s' \<in> x"
      using ind_hyp[where P="{s. [Y\<union>{Tick}]\<^sub>R # [Tock]\<^sub>E # s \<in> P}", where \<rho>=s'] 1 2 3 case_assms by blast
    then show "\<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> [insert Tick Z]\<^sub>R # [Tock]\<^sub>E # add_Tick_refusal_trace s' \<in> x"
      using case_assms apply (auto)
      by (rule_tac x="hide_trace X ([insert Tick Y]\<^sub>R # [Tock]\<^sub>E # p)" in exI, auto, rule_tac x="[insert Tick Y]\<^sub>R # [Tock]\<^sub>E # p" in exI, auto)
  next
    fix X Y P Z
    show "\<forall>\<rho>. \<rho> \<in> P \<longrightarrow> add_Tick_refusal_trace \<rho> \<in> P \<Longrightarrow> [[Y]\<^sub>R] \<in> P \<Longrightarrow> Z \<subseteq> Y \<Longrightarrow> X \<subseteq> Y \<Longrightarrow> \<exists>x. (\<exists>p. x = hide_trace X p \<and> p \<in> P) \<and> [[insert Tick Z]\<^sub>R] \<in> x"
      by (rule_tac x="hide_trace X [[Y\<union>{Tick}]\<^sub>R]" in exI, auto, rule_tac x="[[Y\<union>{Tick}]\<^sub>R]" in exI, auto)
  qed
qed

lemma TT3_Hiding: "TT1 P \<Longrightarrow> TT3 P \<Longrightarrow> TT3 (P \<setminus>\<^sub>C X)"
  by (simp add: TT1_Hiding TT1_TT3w_equiv_TT3 TT3w_Hiding)

lemma Hiding_Mono: "P \<sqsubseteq>\<^sub>C Q \<Longrightarrow> P \<setminus>\<^sub>C X \<sqsubseteq>\<^sub>C Q \<setminus>\<^sub>C X"
  unfolding RefinesTT_def HidingTT_def by auto

lemma Hiding_Union_dist:
  "S \<noteq> {} \<Longrightarrow> \<Union>S \<setminus>\<^sub>C X = \<Union>{R. \<exists>P. P \<in> S \<and> R = P \<setminus>\<^sub>C X}"
  unfolding HidingTT_def by auto

end


theory Iterate_GPV imports
  "HOL-Library.BNF_Axiomatization"
  "HOL-Library.BNF_Corec"
begin

declare [[typedef_overloaded]]

datatype 'a spmf = return_spmf 'a

primrec (transfer) bind_spmf where
  "bind_spmf (return_spmf a) f = f a"

datatype (generat_pures: 'a, generat_outs: 'b, generat_conts: 'c) generat
  = Pure (result: 'a)
  | IO ("output": 'b) (continuation: "'c")

codatatype (results'_gpv: 'a, outs'_gpv: 'out, 'in) gpv
  = GPV (the_gpv: "('a, 'out, 'in \<Rightarrow> ('a, 'out, 'in) gpv) generat spmf")

declare gpv.rel_eq [relator_eq]

primcorec bind_gpv :: "('a, 'out, 'in) gpv \<Rightarrow> ('a \<Rightarrow> ('b, 'out, 'in) gpv) \<Rightarrow> ('b, 'out, 'in) gpv"
where
  "bind_gpv r f = GPV (map_spmf (map_generat id id ((\<circ>) (case_sum id (\<lambda>r. bind_gpv r f))))
     (bind_spmf (the_gpv r)
      (case_generat
        (\<lambda>x. map_spmf (map_generat id id ((\<circ>) Inl)) (the_gpv (f x)))
        (\<lambda>out c. return_spmf (IO out (\<lambda>input. Inr (c input)))))))"

context includes lifting_syntax begin

lemma bind_gpv_parametric [transfer_rule]:
  "(rel_gpv A C ===> (A ===> rel_gpv B C) ===> rel_gpv B C) bind_gpv bind_gpv"
unfolding bind_gpv_def by transfer_prover

end

lemma [friend_of_corec_simps]:
  "map_spmf f (bind_spmf x h) = bind_spmf x (map_spmf f o h)"
  by (cases x) auto

lemma [friend_of_corec_simps]:
  "bind_spmf (map_spmf f x) h = bind_spmf x (h o f)"
  by (cases x) auto

friend_of_corec bind_gpv :: "('a, 'out, 'in) gpv \<Rightarrow> ('a \<Rightarrow> ('a, 'out, 'in) gpv) \<Rightarrow> ('a, 'out, 'in) gpv"
where "bind_gpv r f = GPV (map_spmf (map_generat id id ((\<circ>) (case_sum id (\<lambda>r. bind_gpv r f))))
     (bind_spmf (the_gpv r)
      (case_generat
        (\<lambda>x. map_spmf (map_generat id id ((\<circ>) Inl)) (the_gpv (f x)))
        (\<lambda>out c. return_spmf (IO out (\<lambda>input. Inr (c input)))))))"
apply(rule bind_gpv.ctr)
apply transfer_prover
apply transfer_prover
done

end


section "Examples"

theory Examples imports DivLogicSoundness

begin

definition pure_loop :: prog where
  "pure_loop = While (\<lambda>_. 1) Skip"

lemma pure_loop_correct:
  "pohjola (\<lambda>s. output_of s = []) pure_loop (\<lambda>l. l = LNil)"
  unfolding pure_loop_def
  apply (rule p_while1)
  apply (rule_tac x="\<lambda>i s. True" in exI)
  apply (simp add: ignores_output_def guard_def)
  apply (rule_tac x="\<lambda>_. []" in exI, simp)
  done

definition zero :: prog where
  "zero = While (\<lambda>_. 1) (Print (\<lambda>_. 0))"

definition zero_llist :: "nat llist" where
  "zero_llist = iterates id 0"

lemma zero_correct:
  "pohjola (\<lambda>s. output_of s = []) zero (\<lambda>l. l = zero_llist)"
  unfolding zero_def
  apply (rule p_while1)
  apply (rule_tac x="\<lambda>i s. True" in exI)
  apply (simp add: ignores_output_def guard_def)
  apply (rule_tac x="\<lambda>_. [0]" in exI)
  apply (rule conjI; clarsimp)
   apply (simp add: Coinductive_List.inf_llist_def zero_llist_def)
   apply (simp add: lmap_iterates_id)
  apply (rule h_weaken)
    prefer 2
    apply (rule h_print)
  by (auto simp: print_def)

(* example of p_while2 *)
definition ex2 where
  "ex2 = While (\<lambda>_. 1) zero"

lemma ex2_correct:
  "pohjola (\<lambda>s. output_of s = []) ex2 (\<lambda>l. l = zero_llist)"
  unfolding ex2_def
  apply (rule p_while2[where R="\<lambda>x y. (x, y) \<in> (measure (\<lambda>x. 0))" and b="\<lambda>_. False"])
     apply (simp_all add: guard_def)
   apply (rule hoare_pre_False)
  apply (rule zero_correct)
  done

end


theory Pierson      (*Benzmüller, Fuenmayor & Lomfeld, 2020*)
  imports GeneralKnowledge
begin (*** pro-Pierson's theory, cf. Pierson v. Post wild animal case **)

typedecl e (*type for entities*)
consts \<alpha>::"e" (*appropriated animal (fox, parrot, whale, etc.*)

(*case-specific 'world-vocabulary'*)
consts Animal::"e\<Rightarrow>\<sigma>"
consts Domestic::"e\<Rightarrow>\<sigma>"
consts Fox::"e\<Rightarrow>\<sigma>"
consts Pet::"e\<Rightarrow>\<sigma>"
consts FreeRoaming::"e\<Rightarrow>\<sigma>"
consts Pursues::"c\<Rightarrow>e\<Rightarrow>\<sigma>"
consts Captures::"c\<Rightarrow>e\<Rightarrow>\<sigma>"

(*case-specific taxonomic (legal domain) knowledge*)
axiomatization where
 CW1: "\<lfloor>\<^bold>\<forall>a. Fox a \<^bold>\<rightarrow> Animal a\<rfloor>" and
 CW2: "\<lfloor>\<^bold>\<forall>a. (Animal a \<^bold>\<and> FreeRoaming a \<^bold>\<and> \<^bold>\<not>Pet a) \<^bold>\<rightarrow> \<^bold>\<not>Domestic a\<rfloor>" and
 CW3: "\<lfloor>(\<^bold>\<exists>c. Captures c \<alpha> \<^bold>\<and> \<^bold>\<not>Domestic \<alpha>) \<^bold>\<rightarrow> appWildAnimal\<rfloor>" and
 CW4: "\<lfloor>\<^bold>\<forall>c. Pursues c \<alpha> \<^bold>\<rightarrow> Intent c\<rfloor>" and
 CW5: "\<lfloor>\<^bold>\<forall>c. Captures c \<alpha> \<^bold>\<rightarrow> Poss c\<rfloor>"
(* ... others as needed*)

lemma True nitpick[satisfy,card i=4] oops (*satisfiable*)

(*case-specific legal corpus*)
axiomatization where
CL1: "\<lfloor>appAnimal \<^bold>\<rightarrow> (p\<upharpoonleft>STAB  \<^bold>\<prec> d\<upharpoonleft>STAB)\<rfloor>"
(* ... others as needed*)

(******************Pierson v. Post****************)
abbreviation "Pierson_facts \<equiv> Fox \<alpha> \<^bold>\<and> (FreeRoaming \<alpha>) \<^bold>\<and> (\<^bold>\<not>Pet \<alpha>) \<^bold>\<and>
                       Pursues p \<alpha> \<^bold>\<and> (\<^bold>\<not>Pursues d \<alpha>) \<^bold>\<and> Captures d \<alpha>"

(* a decision for defendant (Pierson) is prima facie compatible with premises*)
lemma "\<lfloor>Pierson_facts \<^bold>\<and> For d\<rfloor>"
  nitpick[satisfy,show_all,card i=3] oops (*non-trivial model*)

(*TODO: is a decision for plaintiff (Post) prima facie compatible with premises?*)
lemma "\<lfloor>Pierson_facts \<^bold>\<and> For p\<rfloor>"
  nitpick[satisfy,show_all,card i=3] oops (*non-trivial model?*)
lemma "\<not>\<lfloor>Pierson_facts \<^bold>\<and> For p\<rfloor>"
  by (metis CW1 CW2 CW3 CW4 L2 R1 other.simps(2) rBR) (*using \<^bold>\<succ>\<^sub>E\<^sub>A variant*)
  (* nitpick oops (* countermodel? *) *)

(* TODO: (optional: by placing the burden of consistency on the plaintiff)
a decision for the defendant (Pierson) should become provable*)
lemma (*assumes "\<lfloor>\<^bold>\<not>INCONS p\<rfloor>"*)
      shows "\<lfloor>Pierson_facts \<^bold>\<rightarrow> For d\<rfloor>" nitpick oops (* countermodel? *)

(* TODO: and a decision for the plaintiff (Post) should become incompatible*)
lemma (*assumes "\<lfloor>\<^bold>\<not>INCONS p\<rfloor>"*)
      shows "\<lfloor>Pierson_facts \<^bold>\<rightarrow> \<^bold>\<not>For p\<rfloor>" nitpick oops (* countermodel? *)

end


theory ARMv8_Rules
  imports "../Soundness" ARMv8 "HOL-Eisbach.Eisbach"
begin

section \<open>Wellformedness\<close>

definition stabilize
  where "stabilize R P \<equiv> {m. \<forall>m'. (glb m,glb m') \<in> R \<longrightarrow> rg m = rg m' \<longrightarrow> m' \<in> P}"

definition reflexive
  where "reflexive R \<equiv> \<forall>m. (m,m) \<in> R"

definition transitive
  where "transitive R \<equiv> \<forall>m m' m''. (m,m') \<in> R \<longrightarrow> (m',m'') \<in> R \<longrightarrow> (m,m'') \<in> R"

definition assert
  where "assert b \<equiv> {m. b}"

text \<open>Lift a relational predicate and assume it preserves the thread state\<close>
definition step\<^sub>t :: "('v,'a) grel \<Rightarrow> ('v,'r,'a) trel"
  where "step\<^sub>t R \<equiv> {(m,m'). (glb m, glb m') \<in> R \<and> rg m = rg m'}"

text \<open>Lift a relational predicate\<close>
definition step :: "('v,'a) grel \<Rightarrow> ('v,'r,'a) trel"
  where "step R \<equiv> {(m,m'). (glb m, glb m') \<in> R}"

text \<open>Define stability in terms of a relational predicate that preserves the thread state\<close>
abbreviation stable\<^sub>t
  where "stable\<^sub>t R P \<equiv> stable (step\<^sub>t R) P"

text \<open>Lift an invariant to a relation\<close>
definition inv :: "(('v,'a) gstate set) \<Rightarrow> ('v,'a) grel"
  where "inv I \<equiv> {(m,m'). m \<in> I \<longrightarrow> m' \<in> I}"

text \<open>Convert a global predicate into a thread local predicate by ignoring the local state\<close>
definition all\<^sub>t :: "(('v,'a) gstate set) \<Rightarrow> ('v,'r,'a) pred"
  where "all\<^sub>t I \<equiv> {m. (glb m) \<in> I}"

text \<open>Couple all wellformedness conditions into a single definition\<close>
abbreviation wellformed :: "('v,'a) grel \<Rightarrow> ('v,'a) grel \<Rightarrow> bool"
  where "wellformed R G \<equiv> reflexive R \<and> transitive R \<and> reflexive G"

text \<open>Show that a stabilized predicate is stable\<close>
lemma stabilize_stable [intro]:
  assumes wf: "wellformed R G"
  shows "stable\<^sub>t R (stabilize R Q)"
  unfolding stable_def step\<^sub>t_def
proof (clarsimp)
  fix m m'
  assume a: "m \<in> stabilize R Q" "(glb m, glb m') \<in> R" "rg m = rg m'"
  have "\<forall>g''. (glb m',g'') \<in> R \<longrightarrow> (glb m,g'') \<in> R"
    using assms a(2) unfolding transitive_def by blast
  thus "m' \<in> stabilize R Q" using a(1,3) by (auto simp: stabilize_def)
qed

text \<open>The conjunction of two stable predicates is stable\<close>
lemma stable\<^sub>t_conj [intro]:
  assumes "stable\<^sub>t R P" "stable\<^sub>t R Q"
  shows "stable\<^sub>t R (P \<inter> Q)"
  using assms by (auto simp: stable_def)

text \<open>Elimination rule to ignore the stabilization process\<close>
lemma stabilizeE:
  assumes "m \<in> stabilize R P"
  assumes "reflexive R"
  obtains "m \<in> P"
proof -
  have "\<forall>g. (glb m, glb g) \<in> R \<longrightarrow> rg m = rg g \<longrightarrow> g \<in> P" "(glb m, glb m) \<in>  R"
    using assms by (auto simp: reflexive_def stabilize_def)
  thus ?thesis using that by auto
qed

text \<open>Stabilization preserves entailment\<close>
lemma stabilize_entail :
  assumes "m \<in> stabilize R P"
  assumes "reflexive R"
  assumes "P \<subseteq> Q"
  shows "m \<in> stabilize R Q"
  using assms by (auto simp: stabilize_def)

section \<open>Predicate Transformations\<close>

text \<open>Transform a predicate based on an sub-operation\<close>
fun wp\<^sub>i :: "('v,'r) subop \<Rightarrow> ('v,'r,'a) trans"
  where
    "wp\<^sub>i (load v e) Q = {m. st m (Glb v) = ev\<^sub>E (rg m) e \<longrightarrow> m \<in> Q}" |
    "wp\<^sub>i (cstore b v e) Q = {m. ev\<^sub>B (rg m) b \<longrightarrow> (m(Glb v :=\<^sub>s ev\<^sub>E (rg m) e)) \<in> Q}" |
    "wp\<^sub>i (op r e) Q = {m. m(Reg r :=\<^sub>s ev\<^sub>E (rg m) e) \<in> Q}" |
    "wp\<^sub>i (cmp b) Q = {m. ev\<^sub>B (rg m) b \<longrightarrow> m \<in> Q}" |
    "wp\<^sub>i (cas\<^sub>T v e\<^sub>1 e\<^sub>2) Q = {m. st m (Glb v) = ev\<^sub>E (rg m) e\<^sub>1 \<longrightarrow> m(Glb v :=\<^sub>s ev\<^sub>E (rg m) e\<^sub>2) \<in> Q}" |
    "wp\<^sub>i (cas\<^sub>F v e\<^sub>1) Q = {m. st m (Glb v) \<noteq> ev\<^sub>E (rg m) e\<^sub>1 \<longrightarrow> m \<in> Q}" |
    "wp\<^sub>i _ Q = Q"

text \<open>Transform a predicate based on an auxiliary state update\<close>
fun wp\<^sub>a :: "('v,'r,'a) auxfn \<Rightarrow> ('v,'r,'a) trans"
  where "wp\<^sub>a a Q = {m. (m(aux: a)) \<in> Q}"

datatype ('v,'r,'a) insts =
  ld "('v,'r,'a) pred" "('v,'r) exp" 'r "('v,'r,'a) auxfn"
  | sr "('v,'r,'a) pred" "('v,'r) bexp" "('v,'r) exp" 'r "('v,'r,'a) auxfn"
  | ir 'r "('v,'r) exp"
  | cm "('v,'r) bexp"
  | ncm "('v,'r) bexp"
  | env "('v,'a) grel"
  | cs "('v,'r,'a) pred" 'r 'r 'r 'r 'v 'v "('v,'r,'a) auxfn"

text \<open>Transform a predicate based on a successful CAS instruction\<close>
abbreviation wp_CAS\<^sub>T :: "('v,'r,'a) pred \<Rightarrow> 'r \<Rightarrow> 'r \<Rightarrow> 'r \<Rightarrow> 'r \<Rightarrow> 'v \<Rightarrow> 'v \<Rightarrow> ('v,'r,'a) auxfn \<Rightarrow> ('v,'r,'a) trans"
  where "wp_CAS\<^sub>T v r\<^sub>a r\<^sub>1 r\<^sub>2 r T F a Q \<equiv>
    {m. m \<in> v \<and> (st m (Glb (rg m r\<^sub>a)) = st m (Reg r\<^sub>1) \<longrightarrow> (m(Glb (rg m r\<^sub>a) :=\<^sub>s rg m r\<^sub>2, Reg r :=\<^sub>s T, aux: a)) \<in> Q)}"

text \<open>Transform a predicate based on a failed CAS instruction\<close>
abbreviation wp_CAS\<^sub>F :: "('v,'r,'a) pred \<Rightarrow> 'r \<Rightarrow> 'r \<Rightarrow> 'r \<Rightarrow> 'r \<Rightarrow> 'v \<Rightarrow> 'v \<Rightarrow> ('v,'r,'a) auxfn \<Rightarrow> ('v,'r,'a) trans"
  where "wp_CAS\<^sub>F v r\<^sub>a r\<^sub>1 r\<^sub>2 r T F a Q \<equiv>
    {m. m \<in> v \<and> (st m (Glb (rg m r\<^sub>a)) \<noteq> st m (Reg r\<^sub>1) \<longrightarrow> (m(Reg r :=\<^sub>s F, aux: a)) \<in> Q)}"

fun wpre :: "('v,'r,'a) insts \<Rightarrow> ('v,'r,'a) trans"
  where
    "wpre (ld v r\<^sub>a r a) Q = {m. m \<in> v \<and> (m (Reg r :=\<^sub>s st m (Glb (ev\<^sub>E (rg m) r\<^sub>a)), aux: a)) \<in> Q}" |
    "wpre (sr v b r\<^sub>a r a) Q = {m. m \<in> v \<and> (ev\<^sub>B (rg m) b \<longrightarrow> (m (Glb (ev\<^sub>E (rg m) r\<^sub>a) :=\<^sub>s rg m r, aux: a)) \<in> Q)}" |
    "wpre (ir r e) Q = wp\<^sub>i (op r e) Q" |
    "wpre (cm b) Q = wp\<^sub>i (cmp b) Q" |
    "wpre (ncm b) Q = wp\<^sub>i (ncmp b) Q" |
    "wpre (env R) Q = stabilize R Q" |
    "wpre (cs v r\<^sub>a r\<^sub>1 r\<^sub>2 r T F a) Q = wp_CAS\<^sub>T v r\<^sub>a r\<^sub>1 r\<^sub>2 r T F a Q \<inter> wp_CAS\<^sub>F v r\<^sub>a r\<^sub>1 r\<^sub>2 r T F a Q"

text \<open>Transform a predicate based on a program c within an environment R\<close>
fun wp :: "('v,'a) grel \<Rightarrow> ('v,'r,'a) com_armv8 \<Rightarrow> ('v,'r,'a) trans"
  where
    "wp R Skip Q = Q" |
    "wp R Fence Q = Q" |
    "wp R (Load v d r\<^sub>a r a) Q = stabilize R (wpre (ld (v \<inter> {m. ev\<^sub>E (rg m) r\<^sub>a \<in> d}) r\<^sub>a r a) Q)" |
    "wp R (Store v d r\<^sub>a r a) Q = stabilize R (wpre (sr  (v \<inter> {m. ev\<^sub>E (rg m) r\<^sub>a \<in> d}) True\<^sub>B r\<^sub>a r a) Q)" |
    "wp R (Op r e) Q = wpre (ir r e) Q" |
    "wp R (CAS v d r\<^sub>a r\<^sub>1 r\<^sub>2 r T F a) Q = stabilize R (wpre (cs (v \<inter> {m. rg m r\<^sub>a \<in> d}) r\<^sub>a r\<^sub>1 r\<^sub>2 r T F a) Q)" |
    "wp R (Seq c\<^sub>1 c\<^sub>2) Q = wp R c\<^sub>1 (wp R c\<^sub>2 Q)" |
    "wp R (If b c\<^sub>1 c\<^sub>2) Q = (wpre (cm b) (wp R c\<^sub>1 Q) \<inter> wpre (ncm b) (wp R c\<^sub>2 Q))"

text \<open>Convert a predicate transformer into a relational predicate transformer\<close>
definition wp\<^sub>r :: "('v,'r,'a) trans \<Rightarrow> ('v,'r,'a) rtrans"
  where "wp\<^sub>r f G \<equiv> {(m,m'). m' \<in> f {m'. (m,m') \<in> G}}"

subsection \<open>Guarantee Checks\<close>

text \<open>Convert a predicate transformer into a guarantee check\<close>
abbreviation guar
  where "guar f G \<equiv> {m. (m,m) \<in> (wp\<^sub>r f G)}"

text \<open>Ensure all global operations in a thread conform to its guarantee\<close>
fun guar\<^sub>c
  where
    "guar\<^sub>c (Load v d r\<^sub>a r a) G = (v \<inter> {m. ev\<^sub>E (rg m) r\<^sub>a \<in> d} \<subseteq> guar (wpre (ld UNIV r\<^sub>a r a)) (step G))" |
    "guar\<^sub>c (Store v d r\<^sub>a r a) G = (v \<inter> {m. ev\<^sub>E (rg m) r\<^sub>a \<in> d} \<subseteq> guar (wpre (sr UNIV True\<^sub>B r\<^sub>a r a)) (step G))" |
    "guar\<^sub>c (CAS v d r\<^sub>a r\<^sub>1 r\<^sub>2 r T F a) G = (v \<inter> {m. (rg m) r\<^sub>a \<in> d} \<subseteq> guar (wpre (cs UNIV r\<^sub>a r\<^sub>1 r\<^sub>2 r T F a)) (step G))" |
    "guar\<^sub>c (Seq c\<^sub>1 c\<^sub>2) G = (guar\<^sub>c c\<^sub>1 G \<and> guar\<^sub>c c\<^sub>2 G)" |
    "guar\<^sub>c (If b c\<^sub>1 c\<^sub>2) G = (guar\<^sub>c c\<^sub>1 G \<and> guar\<^sub>c c\<^sub>2 G)" |
    "guar\<^sub>c _ _ = True"

section \<open>Locale Interpretation\<close>

text \<open>Convert the ARMv8 language into the abstract language expected by the underlying logic\<close>
fun lift\<^sub>c :: "('v,'r,'a) com_armv8 \<Rightarrow> (('v,'r,'a) auxop, ('v,'r,'a) state) com"
  where
    "lift\<^sub>c Skip = com.Nil" |
    "lift\<^sub>c Fence = Basic (\<lfloor>fence\<rfloor>)" |
    "lift\<^sub>c (Op r e) = Basic (\<lfloor>op r e\<rfloor>)" |
    "lift\<^sub>c (Load c d r\<^sub>a r a) = \<Sqinter> {[
      \<lfloor>eq r\<^sub>a (Val v\<^sub>a)\<rfloor>,
      \<lfloor>{m. ev\<^sub>E (rg m) r\<^sub>a = v\<^sub>a} \<inter> c,load v\<^sub>a (Val v), (\<lambda>m. a (m(Reg r :=\<^sub>s v)))\<rfloor>,
      \<lfloor>op r (Val v)\<rfloor>] |v v\<^sub>a. v\<^sub>a \<in> d}" |
    "lift\<^sub>c (Store c d r\<^sub>a r a) = \<Sqinter> {[
      \<lfloor>eq r\<^sub>a (Val v\<^sub>a)\<rfloor>,
      \<lfloor>{m. ev\<^sub>E (rg m) r\<^sub>a = v\<^sub>a} \<inter> c,cstore True\<^sub>B v\<^sub>a (Var r), a\<rfloor>] |v\<^sub>a. v\<^sub>a \<in> d}" |
    "lift\<^sub>c (CAS c d r\<^sub>a r\<^sub>1 r\<^sub>2 r T F a) = (Choice
      (\<Sqinter> {[
        \<lfloor>eq (Var r\<^sub>a) (Val v\<^sub>a)\<rfloor>,
        \<lfloor>{m. rg m r\<^sub>a = v\<^sub>a} \<inter> c,cas\<^sub>T v\<^sub>a (Var r\<^sub>1) (Var r\<^sub>2),(\<lambda>m. a (m(Reg r :=\<^sub>s T)))\<rfloor>,
        \<lfloor>op r (Val T)\<rfloor>] |v\<^sub>a. v\<^sub>a \<in> d})
      (\<Sqinter> {[
        \<lfloor>eq (Var r\<^sub>a) (Val v\<^sub>a)\<rfloor>,
        \<lfloor>{m. rg m r\<^sub>a = v\<^sub>a} \<inter> c,cas\<^sub>F v\<^sub>a (Var r\<^sub>1),(\<lambda>m. a (m(Reg r :=\<^sub>s F)))\<rfloor>,
        \<lfloor>op r (Val F)\<rfloor>] |v\<^sub>a. v\<^sub>a \<in> d}))" |
    "lift\<^sub>c (Seq c\<^sub>1 c\<^sub>2) = (lift\<^sub>c c\<^sub>1 ;; lift\<^sub>c c\<^sub>2)" |
    "lift\<^sub>c (If b c\<^sub>1 c\<^sub>2) = (Choice
      (com.Seq (Basic (\<lfloor>cmp b\<rfloor>)) (lift\<^sub>c c\<^sub>1))
      (com.Seq (Basic (\<lfloor>ncmp b\<rfloor>)) (lift\<^sub>c c\<^sub>2)))"

interpretation rules fwd\<^sub>s re\<^sub>a by (unfold_locales) (auto)

abbreviation rules_abv ("_,_ \<turnstile> _ {_} _" [20,0,0,0,20] 20)
  where "rules_abv \<equiv> rules"

abbreviation lifted_abv ("_,_,_ \<turnstile>\<^sub>s _ {_} _" [20,0,0,0,0,20] 20)
  where "lifted_abv R G I P c Q \<equiv> step\<^sub>t (inv I \<inter> R),step (inv I \<inter> G) \<turnstile> all\<^sub>t I \<inter> P {lift\<^sub>c c} all\<^sub>t I \<inter> Q"

abbreviation validity_abv  ("\<Turnstile> _ SAT [_, _, _, _, _]" [60,0,0,0,0] 45)
  where "validity_abv c P R G Q I \<equiv> validity (lift\<^sub>c c) (all\<^sub>t I \<inter> P) (step\<^sub>t (inv I \<inter> R)) (step (inv I \<inter> G)) (all\<^sub>t I \<inter> Q)"

text \<open>The language is always thread-local\<close>
lemma local_lift [intro]:
  "local (lift\<^sub>c c)"
  by (induct c) auto

text \<open>Correctness of the guarantee check\<close>
lemma com_guar:
  "wellformed R G \<Longrightarrow> guar\<^sub>c c G \<Longrightarrow> \<forall>\<beta>\<in>basics (lift\<^sub>c c). guar\<^sub>\<alpha> \<beta> (step G)"
  by (induct c) (auto simp: guar_def step_def reflexive_def wp\<^sub>r_def liftl_def liftg_def)

text \<open>An ordering property on contexts\<close>
definition context_order
  ("_,_ \<turnstile>\<^sub>w _ \<ge> _" [100,0,0,100] 60)
  where "context_order R G P Q \<equiv>
    (stable\<^sub>t R Q \<and> wellformed R G) \<longrightarrow> ((P \<subseteq> Q) \<and> stable\<^sub>t R P)"

text \<open>The validity property we intend to show, abstracts over the preservation of wellformedness\<close>
definition valid :: "('v,'a) grel \<Rightarrow> ('v,'a) grel \<Rightarrow> ('v,'a) gpred \<Rightarrow> ('v,'r,'a) pred \<Rightarrow> ('v,'r,'a) com_armv8 \<Rightarrow> ('v,'r,'a) pred \<Rightarrow> bool"
  ("_,_,_ \<turnstile>\<^sub>w _ {_} _" [100,0,0,0,0,100] 60)
  where "valid R G I P c Q \<equiv>
    (wellformed R G \<and> stable\<^sub>t R Q \<and> guar\<^sub>c c (inv I \<inter> G)) \<longrightarrow> (stable\<^sub>t R P \<and> (R,G,I \<turnstile>\<^sub>s P {c} Q))"

section \<open>Soundness\<close>

subsection \<open>Sub-operations\<close>

lemma stable\<^sub>t_local_op [intro!]:
  assumes "stable\<^sub>t R Q"
  shows "stable\<^sub>t R {m. (m(Reg r :=\<^sub>s f (rg m))) \<in> Q}"
  using assms by (auto simp: stable_def step\<^sub>t_def)

lemma stable\<^sub>t_local_cmp [intro!]:
  "stable\<^sub>t R Q \<Longrightarrow> stable\<^sub>t R {m. f (rg m) \<longrightarrow> m \<in> Q}"
  by (auto simp add: stable_def step\<^sub>t_def)

fun local_op
  where
    "local_op (load _ _) = False" |
    "local_op (cstore _ _ _) = False" |
    "local_op (cas\<^sub>T _ _ _) = False" |
    "local_op (cas\<^sub>F _ _) = False" |
    "local_op _ = True"

lemma [intro]:
  "(m,m) \<in> inv I"
  by (auto simp: inv_def)

lemma [intro!]:
  "stable\<^sub>t R Q \<Longrightarrow> stable\<^sub>t ({(m, m'). m \<in> I \<longrightarrow> m' \<in> I} \<inter> R) ({m. glb m \<in> I} \<inter> Q)"
  by (auto simp: stable_def step\<^sub>t_def inv_def)

lemma [intro!]:
  "stable\<^sub>t R Q \<Longrightarrow> stable\<^sub>t (inv I \<inter> R) (all\<^sub>t I \<inter> Q)"
  by (auto simp: stable_def step\<^sub>t_def inv_def all\<^sub>t_def)

lemma [intro!]:
  "reflexive G \<Longrightarrow> reflexive (inv I \<inter> G)"
  by (auto simp: reflexive_def inv_def)

text \<open>Basic Rule for global operations\<close>
lemma basic_wp\<^sub>i_global:
  assumes "P \<subseteq> stabilize R (c \<inter> wp\<^sub>i \<alpha> (wp\<^sub>a a Q))" "wellformed R G" "stable\<^sub>t R Q"
  assumes "c \<subseteq> guar (wp\<^sub>i \<alpha> o wp\<^sub>a a) (step (inv I \<inter> G))"
  shows "step\<^sub>t (inv I \<inter> R),step (inv I \<inter> G) \<turnstile> all\<^sub>t I \<inter> P {Basic (\<lfloor>c, \<alpha>, a\<rfloor>)} all\<^sub>t I \<inter> Q"
proof -
  have "step\<^sub>t (inv I \<inter> R),step (inv I \<inter> G) \<turnstile>\<^sub>A all\<^sub>t I \<inter> stabilize R (c \<inter> wp\<^sub>i \<alpha> (wp\<^sub>a a Q)) {\<lfloor>c, \<alpha>, a\<rfloor>} all\<^sub>t I \<inter> Q"
    using assms by (cases \<alpha>) (auto simp: atomic_rule_def guar_def wp_def
                                         step_def wp\<^sub>r_def o_def liftg_def all\<^sub>t_def inv_def
                                   elim!: stabilizeE)
  thus ?thesis using assms by (intro conseq[OF basic]) (auto)
qed

text \<open>Basic Rule for local operations\<close>
lemma basic_wp\<^sub>i_local:
  assumes "P \<subseteq> wp\<^sub>i \<alpha> Q" "wellformed R G" "stable\<^sub>t R Q" "local_op \<alpha>"
  shows "step\<^sub>t (inv I \<inter> R),step (inv I \<inter> G) \<turnstile> all\<^sub>t I \<inter> P {Basic (\<lfloor>\<alpha>\<rfloor>)} all\<^sub>t I \<inter> Q"
proof -
  have "step\<^sub>t (inv I \<inter> R),step (inv I \<inter> G) \<turnstile>\<^sub>A  all\<^sub>t I \<inter> wp\<^sub>i \<alpha> Q {\<lfloor>\<alpha>\<rfloor>} all\<^sub>t I \<inter> Q"
    using assms by (cases \<alpha>) (auto simp: atomic_rule_def guar_def wp_def reflexive_def
                                         step_def liftl_def all\<^sub>t_def inv_def
                                         elim!: stabilizeE)
  thus ?thesis using assms by (intro conseq[OF basic]) (auto)
qed

text \<open>Automation to assist with Load/Store/CAS\<close>
lemma stabilize_cmp:
  "P \<subseteq> wp\<^sub>i (cmp b) Q \<Longrightarrow> stabilize R P \<subseteq> wp\<^sub>i (cmp b) (stabilize R Q)"
  by (auto simp: stabilize_def)

method expand_seq =
  (clarsimp, intro rules.choice rules.seqset; (clarsimp, intro rules.ord, (auto)[1]))

method basic_wp\<^sub>i =
  ((rule basic_wp\<^sub>i_local | rule basic_wp\<^sub>i_global),
   (rule stabilize_cmp | rule subset_refl);
   auto simp: wp\<^sub>r_def step_def)

text \<open>A rule for cmp operations, used for If/While/DoWhile\<close>
lemma cmp_sound [intro!]:
  assumes "wellformed R G" "stable\<^sub>t R Q"
  assumes "P \<subseteq> wp\<^sub>i (cmp b) Q"
  shows "step\<^sub>t (inv I \<inter> R),step (inv I \<inter> G) \<turnstile> all\<^sub>t I \<inter> P {Basic (\<lfloor>cmp b\<rfloor>)} all\<^sub>t I \<inter> Q"
  using assms by (intro basic_wp\<^sub>i_local) auto

subsection \<open>State Ordering\<close>

text \<open>Properties of the state ordering. Essentially entailment with preservation of stability\<close>

text \<open>The ordering is reflexive\<close>
lemma refl_ord:
  "R,G \<turnstile>\<^sub>w P \<ge> P"
  unfolding context_order_def by auto

text \<open>It is possible to strengthen the RHS\<close>
lemma assert_ord:
  "R,G \<turnstile>\<^sub>w P \<inter> assert A \<ge> P"
  by (cases A) (auto simp: context_order_def assert_def)

text \<open>Stabilize Ordering\<close>
lemma stabilize_ord [intro]:
  assumes "P \<subseteq> Q"
  shows "R,G \<turnstile>\<^sub>w stabilize R P \<ge> Q"
  using assms stabilizeE unfolding context_order_def
  by blast

subsection \<open>Rules\<close>

text \<open>If Rule\<close>
lemma if_wp:
  "R,G,I \<turnstile>\<^sub>w P\<^sub>1 {c\<^sub>1} Q \<Longrightarrow> R,G,I \<turnstile>\<^sub>w P\<^sub>2 {c\<^sub>2} Q \<Longrightarrow> R,G,I \<turnstile>\<^sub>w wp\<^sub>i (cmp b) P\<^sub>1 \<inter> wp\<^sub>i (ncmp b) P\<^sub>2 {If b c\<^sub>1 c\<^sub>2} Q"
  unfolding valid_def by clarsimp (intro conjI rules.choice rules.seq, auto)

text \<open>False Rule\<close>
lemma false_wp:
  assumes "P \<subseteq> {}"
  shows "R,G,I \<turnstile>\<^sub>w P {c} Q"
  using assms unfolding valid_def
  by (intro conjI impI com_guar rules.conseq[OF falseI, where ?G="step (inv I \<inter> G)"]) (auto)

text \<open>Rewrite Rule\<close>
lemma rewrite_wp:
  "R,G,I \<turnstile>\<^sub>w P {c} Q \<Longrightarrow> R,G \<turnstile>\<^sub>w M \<ge> P \<Longrightarrow> R,G,I \<turnstile>\<^sub>w M {c} Q"
  by (auto simp: valid_def context_order_def)

text \<open>Assert Rule\<close>
lemma assert_wp:
  assumes "A \<Longrightarrow> R,G,I \<turnstile>\<^sub>w P {c} Q"
  shows "R,G,I \<turnstile>\<^sub>w (P \<inter> assert A) {c} Q"
proof (cases A)
  case True
  then show ?thesis using assms by (intro rewrite_wp[OF _ assert_ord], simp)
next
  case False
  then show ?thesis by (intro false_wp, auto simp: assert_def)
qed

text \<open>Com Rule\<close>
theorem com_wp:
  shows "R,G,I \<turnstile>\<^sub>w wp R c Q {c} Q"
proof (induct c arbitrary: Q)
  case Fence
  thus ?case unfolding valid_def lift\<^sub>c.simps by (intro conjI impI basic_wp\<^sub>i_local) auto
next
  case (Op r e)
  thus ?case unfolding valid_def lift\<^sub>c.simps
    by (intro conjI impI basic_wp\<^sub>i_local) (auto)
next
  case (Load c r\<^sub>a r a)
  thus ?case unfolding valid_def by (intro conjI impI, force) (expand_seq, basic_wp\<^sub>i+)
next
  case (Store c r\<^sub>a r a)
  thus ?case unfolding valid_def by (intro conjI impI, force) (expand_seq, basic_wp\<^sub>i+)
next
  case (CAS c r\<^sub>a r\<^sub>1 r\<^sub>2 r T F a)
  thus ?case unfolding valid_def by (intro conjI impI, force) (expand_seq, basic_wp\<^sub>i+)
next
  case (If b c\<^sub>1 c\<^sub>2)
  thus ?case unfolding wp.simps wpre.simps by (blast intro: if_wp)
qed (auto simp: valid_def)

subsection \<open>High-Level Theorem\<close>

text \<open>Soundness lemma for WP reasoning over ARMv8\<close>
theorem armv8_wp_sound:
  assumes wf: "transitive R" "reflexive R" "reflexive G"
  assumes st: "stable\<^sub>t R Q"
  assumes g: "guar\<^sub>c c (inv I \<inter> G)"
  assumes P: "P \<subseteq> wp R c Q"
  shows "\<Turnstile> c SAT [P, R, G, Q, I]"
proof -
  have "R,G,I \<turnstile>\<^sub>s wp R c Q {c} Q" using wf st g com_wp unfolding valid_def by blast
  hence "R,G,I \<turnstile>\<^sub>s P {c} Q" by (rule rules.conseq) (insert P, auto)
  thus ?thesis by (intro sound thread) auto
qed

end


section "Small-Step Semantics of Commands"

theory Small_Step imports "~~/src/HOL/IMP/Star" "./Big_Step" begin

subsection "The transition relation"

inductive
  small_step :: "com * state \<Rightarrow> com * state \<Rightarrow> bool" (infix "\<rightarrow>" 55)
where
Assign:  "(x ::= a, s) \<rightarrow> (SKIP, s(x := aval a s))" |

Seq1:    "(SKIP;;c\<^sub>2,s) \<rightarrow> (c\<^sub>2,s)" |
Seq2:    "(c\<^sub>1,s) \<rightarrow> (c\<^sub>1',s') \<Longrightarrow> (c\<^sub>1;;c\<^sub>2,s) \<rightarrow> (c\<^sub>1';;c\<^sub>2,s')" |

IfTrue:  "bval b s \<Longrightarrow> (IF b THEN c\<^sub>1 ELSE c\<^sub>2,s) \<rightarrow> (c\<^sub>1,s)" |
IfFalse: "\<not>bval b s \<Longrightarrow> (IF b THEN c\<^sub>1 ELSE c\<^sub>2,s) \<rightarrow> (c\<^sub>2,s)" |

While:   "(WHILE b DO c,s) \<rightarrow>
            (IF b THEN c;; WHILE b DO c ELSE SKIP,s)" |

Repeat: "(REPEAT c UNTIL b, s) \<rightarrow> (c;; IF b THEN SKIP ELSE REPEAT c UNTIL b, s)"

abbreviation
  small_steps :: "com * state \<Rightarrow> com * state \<Rightarrow> bool" (infix "\<rightarrow>*" 55)
where "x \<rightarrow>* y == star small_step x y"

subsection{* Executability *}

code_pred small_step .

values "{(c',map t [''x'',''y'',''z'']) |c' t.
   (''x'' ::= V ''z'';; ''y'' ::= V ''x'',
    <''x'' := 3, ''y'' := 7, ''z'' := 5>) \<rightarrow>* (c',t)}"

subsection{* Proof infrastructure *}

subsubsection{* Induction rules *}

text{* The default induction rule @{thm[source] small_step.induct} only works
for lemmas of the form @{text"a \<rightarrow> b \<Longrightarrow> \<dots>"} where @{text a} and @{text b} are
not already pairs @{text"(DUMMY,DUMMY)"}. We can generate a suitable variant
of @{thm[source] small_step.induct} for pairs by ``splitting'' the arguments
@{text"\<rightarrow>"} into pairs: *}
lemmas small_step_induct = small_step.induct[split_format(complete)]

subsubsection{* Proof automation *}

declare small_step.intros[simp,intro]

text{* Rule inversion: *}

inductive_cases SkipE[elim!]: "(SKIP,s) \<rightarrow> ct"
thm SkipE
inductive_cases AssignE[elim!]: "(x::=a,s) \<rightarrow> ct"
thm AssignE
inductive_cases SeqE[elim]: "(c1;;c2,s) \<rightarrow> ct"
thm SeqE
inductive_cases IfE[elim!]: "(IF b THEN c1 ELSE c2,s) \<rightarrow> ct"
inductive_cases WhileE[elim]: "(WHILE b DO c, s) \<rightarrow> ct"
inductive_cases RepeatE[elim]: "(REPEAT c UNTIL b, s) \<rightarrow> ct"

text{* A simple property: *}
lemma deterministic:
  "cs \<rightarrow> cs' \<Longrightarrow> cs \<rightarrow> cs'' \<Longrightarrow> cs'' = cs'"
apply(induction arbitrary: cs'' rule: small_step.induct)
apply blast+
done

subsection "Equivalence with big-step semantics"

lemma star_seq2: "(c1,s) \<rightarrow>* (c1',s') \<Longrightarrow> (c1;;c2,s) \<rightarrow>* (c1';;c2,s')"
proof(induction rule: star_induct)
  case refl thus ?case by simp
next
  case step
  thus ?case by (metis Seq2 star.step)
qed

lemma seq_comp:
  "\<lbrakk> (c1,s1) \<rightarrow>* (SKIP,s2); (c2,s2) \<rightarrow>* (SKIP,s3) \<rbrakk>
   \<Longrightarrow> (c1;;c2, s1) \<rightarrow>* (SKIP,s3)"
by(blast intro: star.step star_seq2 star_trans)

text{* The following proof corresponds to one on the board where one would
show chains of @{text "\<rightarrow>"} and @{text "\<rightarrow>*"} steps. *}

lemma big_to_small:
  "cs \<Rightarrow> t \<Longrightarrow> cs \<rightarrow>* (SKIP,t)"
proof (induction rule: big_step.induct)
  fix s show "(SKIP,s) \<rightarrow>* (SKIP,s)" by simp
next
  fix x a s show "(x ::= a,s) \<rightarrow>* (SKIP, s(x := aval a s))" by auto
next
  fix c1 c2 s1 s2 s3
  assume "(c1,s1) \<rightarrow>* (SKIP,s2)" and "(c2,s2) \<rightarrow>* (SKIP,s3)"
  thus "(c1;;c2, s1) \<rightarrow>* (SKIP,s3)" by (rule seq_comp)
next
  fix s::state and b c0 c1 t
  assume "bval b s"
  hence "(IF b THEN c0 ELSE c1,s) \<rightarrow> (c0,s)" by simp
  moreover assume "(c0,s) \<rightarrow>* (SKIP,t)"
  ultimately
  show "(IF b THEN c0 ELSE c1,s) \<rightarrow>* (SKIP,t)" by (metis star.simps)
next
  fix s::state and b c0 c1 t
  assume "\<not>bval b s"
  hence "(IF b THEN c0 ELSE c1,s) \<rightarrow> (c1,s)" by simp
  moreover assume "(c1,s) \<rightarrow>* (SKIP,t)"
  ultimately
  show "(IF b THEN c0 ELSE c1,s) \<rightarrow>* (SKIP,t)" by (metis star.simps)
next
  fix b c and s::state
  assume b: "\<not>bval b s"
  let ?if = "IF b THEN c;; WHILE b DO c ELSE SKIP"
  have "(WHILE b DO c,s) \<rightarrow> (?if, s)" by blast
  moreover have "(?if,s) \<rightarrow> (SKIP, s)" by (simp add: b)
  ultimately show "(WHILE b DO c,s) \<rightarrow>* (SKIP,s)" by(metis star.refl star.step)
next
  fix b c s s' t
  let ?w  = "WHILE b DO c"
  let ?if = "IF b THEN c;; ?w ELSE SKIP"
  assume w: "(?w,s') \<rightarrow>* (SKIP,t)"
  assume c: "(c,s) \<rightarrow>* (SKIP,s')"
  assume b: "bval b s"
  have "(?w,s) \<rightarrow> (?if, s)" by blast
  moreover have "(?if, s) \<rightarrow> (c;; ?w, s)" by (simp add: b)
  moreover have "(c;; ?w,s) \<rightarrow>* (SKIP,t)" by(rule seq_comp[OF c w])
  ultimately show "(WHILE b DO c,s) \<rightarrow>* (SKIP,t)" by (metis star.simps)
next
  case (RepeatFalse b s2 c s1)
  let ?rep = "REPEAT c UNTIL b"
  let ?exp = "IF b THEN SKIP ELSE ?rep"
  have "(?rep, s1) \<rightarrow>* (c;; ?exp, s1)" by auto
  moreover have "(c;; ?exp, s1) \<rightarrow>* (SKIP;; ?exp, s2)" using RepeatFalse.IH RepeatFalse.hyps star_seq2 by auto
  moreover have "(SKIP;; ?exp, s2) \<rightarrow>* (?exp, s2)" by auto
  moreover have "(?exp, s2) \<rightarrow>* (SKIP, s2)" using `bval b s2` by auto
  ultimately show ?case by (metis star_trans)
next
  case (RepeatTrue b s2 c s1 s3)
  let ?rep = "REPEAT c UNTIL b"
  let ?exp = "IF b THEN SKIP ELSE ?rep"
  have rep_big: "(?rep, s1) \<Rightarrow> s3" using RepeatTrue.hyps by blast
  have "(?rep, s1) \<rightarrow>* (c;; ?exp, s1)" by auto
  moreover have "(c;; ?exp, s1) \<rightarrow>* (SKIP;; ?exp, s2)" using `(c, s1) \<rightarrow>* (SKIP, s2)` star_seq2 by auto
  moreover have "(SKIP;; ?exp, s2) \<rightarrow>* (?exp, s2)" by auto
  moreover have "(?exp, s2) \<rightarrow>* (?rep, s2)" using `\<not>bval b s2` by auto
  moreover have "(?rep, s2) \<rightarrow>* (SKIP, s3)" using `(?rep, s2) \<rightarrow>* (SKIP, s3)` by auto
  ultimately show ?case by (metis star_trans)
qed

text{* Each case of the induction can be proved automatically: *}
lemma  "cs \<Rightarrow> t \<Longrightarrow> cs \<rightarrow>* (SKIP,t)"
proof (induction rule: big_step.induct)
  case Skip show ?case by blast
next
  case Assign show ?case by blast
next
  case Seq thus ?case by (blast intro: seq_comp)
next
  case IfTrue thus ?case by (blast intro: star.step)
next
  case IfFalse thus ?case by (blast intro: star.step)
next
  case WhileFalse thus ?case
    by (metis star.step star_step1 small_step.IfFalse small_step.While)
next
  case WhileTrue
  thus ?case
    by(metis While seq_comp small_step.IfTrue star.step[of small_step])
next
  case RepeatFalse
  thus ?case by (simp add: RepeatFalse.hyps(1) RepeatFalse.hyps(2) big_step.RepeatFalse big_to_small)
next
  case RepeatTrue
  thus ?case using big_step.RepeatTrue big_to_small by auto
qed

lemma small1_big_continue:
  "cs \<rightarrow> cs' \<Longrightarrow> cs' \<Rightarrow> t \<Longrightarrow> cs \<Rightarrow> t"
apply (induction arbitrary: t rule: small_step.induct)
apply auto
done

lemma small_to_big:
  "cs \<rightarrow>* (SKIP,t) \<Longrightarrow> cs \<Rightarrow> t"
apply (induction cs "(SKIP,t)" rule: star.induct)
apply (auto intro: small1_big_continue)
done

text {*
  Finally, the equivalence theorem:
*}
theorem big_iff_small:
  "cs \<Rightarrow> t = cs \<rightarrow>* (SKIP,t)"
by(metis big_to_small small_to_big)

subsection "Final configurations and infinite reductions"

definition "final cs \<longleftrightarrow> \<not>(EX cs'. cs \<rightarrow> cs')"

lemma finalD: "final (c,s) \<Longrightarrow> c = SKIP"
apply(simp add: final_def)
apply(induction c)
apply blast+
done

lemma final_iff_SKIP: "final (c,s) = (c = SKIP)"
by (metis SkipE finalD final_def)

text{* Now we can show that @{text"\<Rightarrow>"} yields a final state iff @{text"\<rightarrow>"}
terminates: *}

lemma big_iff_small_termination:
  "(EX t. cs \<Rightarrow> t) \<longleftrightarrow> (EX cs'. cs \<rightarrow>* cs' \<and> final cs')"
by(simp add: big_iff_small final_iff_SKIP)

text{* This is the same as saying that the absence of a big step result is
equivalent with absence of a terminating small step sequence, i.e.\ with
nontermination.  Since @{text"\<rightarrow>"} is determininistic, there is no difference
between may and must terminate. *}

end