Theory CSP_PTick_Deadlock_Results

(***********************************************************************************
 * Copyright (c) 2025 Université Paris-Saclay
 *
 * Author: Benoît Ballenghien, Université Paris-Saclay,
 *         CNRS, ENS Paris-Saclay, LMF
 *
 * All rights reserved.
 *
 * Redistribution and use in source and binary forms, with or without
 * modification, are permitted provided that the following conditions are met:
 *
 * * Redistributions of source code must retain the above copyright notice, this
 *
 * * Redistributions in binary form must reproduce the above copyright notice,
 *   this list of conditions and the following disclaimer in the documentation
 *   and/or other materials provided with the distribution.
 *
 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
 * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
 * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
 * SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
 * CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
 * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 *
 * SPDX-License-Identifier: BSD-2-Clause
 ***********************************************************************************)


chapter ‹Deadlock Results›

(*<*)
theory CSP_PTick_Deadlock_Results
  imports "HOL-CSP_RS" Read_Write_CSP_PTick_Laws CSP_PTick_Monotonicities
    "HOL-CSP_OpSem" Events_Ticks_CSP_PTick_Laws
begin                                                                      
  (*>*)


section ‹First Results›

subsection ‹Non Terminating›

text ‹Keep in mind @{thm lifelock_freeSKIPS_iff_div_free[no_vars]}.›

subsubsection ‹Sequential Composition›

lemma ‹non_terminating P ⟹ P ;✓ Q = RenamingTick P g›
  ― ‹Already proven earlier.›
  by (fact non_terminating_Seqptick)



subsubsection ‹Synchronization Product›

lemma (in Syncptick_locale) non_terminating_Syncptick :
  ‹non_terminating P ⟹ lifelock_freeSKIPS Q ⟹ non_terminating (P ⟦A⟧✓ Q)›
  ‹lifelock_freeSKIPS P ⟹ non_terminating Q ⟹ non_terminating (P ⟦A⟧✓ Q)›
  by (simp add: lifelock_freeSKIPS_iff_div_free T_Syncptick
      non_terminating_is_right nonterminating_implies_div_free,
      use setinterleavesptick_tickFree_imp in blast)+



subsection ‹Deadlock Free›

subsubsection ‹Sequential Composition›

lemma ‹deadlock_free P ⟹ deadlock_free (P ;✓ Q)›
  by (metis deadlock_free_imp_deadlock_free_Renaming deadlock_free_implies_lifelock_free
            lifelock_free_is_non_terminating non_terminating_Seqptick)


text ‹The next lemma is of course more interesting.›

lemma deadlock_freeSKIPS_Seqptick :
  ‹deadlock_freeSKIPS (P ;✓ Q)›
  if df_assms : ‹deadlock_freeSKIPS P› ‹⋀r. r ∈ ✓s(P) ⟹ deadlock_freeSKIPS (Q r)›
proof (unfold deadlock_freeSKIPS_is_right, intro ballI impI)
  show ‹t ∈ 𝒯 (P ;✓ Q) ⟹ tF t ⟹ (t, UNIV) ∉ ℱ (P ;✓ Q)› for t
  proof (induct t rule: rev_induct)
    from df_assms show ‹([], UNIV) ∉ ℱ (P ;✓ Q)›
      by (simp add: Seqptick_projs deadlock_freeSKIPS_implies_div_free deadlock_freeSKIPS_is_right ref_Seqptick_UNIV)
        (metis F_T append_Nil deadlock_freeSKIPS_implies_div_free
               deadlock_freeSKIPS_is_right empty_iff strict_ticks_of_memI tickFree_Nil)
  next
    from df_assms(1) have ‹𝒟 P = {}›
      by (simp add: deadlock_freeSKIPS_implies_div_free)
    fix t e assume hyp : ‹t ∈ 𝒯 (P ;✓ Q) ⟹ tF t ⟹ (t, UNIV) ∉ ℱ (P ;✓ Q)›
    assume ‹t @ [e] ∈ 𝒯 (P ;✓ Q)› ‹tF (t @ [e])›
    then consider u v where ‹t @ [e] = map (ev ∘ of_ev) u› ‹u ∈ 𝒯 P› ‹tF u›
      | u r v where ‹t @ [e] = map (ev ∘ of_ev) u @ v› ‹u @ [✓(r)] ∈ 𝒯 P› ‹tF u› ‹v ∈ 𝒯 (Q r)›
      by (auto simp add: Seqptick_projs ‹𝒟 P = {}›)
    thus ‹(t @ [e], UNIV) ∉ ℱ (P ;✓ Q)›
      by (cases; simp_all add: Seqptick_projs ref_Seqptick_UNIV)
        (metis (no_types) F_T ‹𝒟 P = {}› ‹tF (t @ [e])› deadlock_freeSKIPS_is_right
                          empty_iff strict_ticks_of_memI that tickFree_append_iff)+
  qed
qed


corollary deadlock_free_Seqptick :
  ‹⟦deadlock_freeSKIPS P; ⋀r. r ∈ ✓s(P) ⟹ deadlock_free (Q r)⟧
   ⟹ deadlock_free (P ;✓ Q)›
  by (simp add: AfterExt.deadlock_free_iff_empty_ticks_of_and_deadlock_freeSKIPS ticks_of_Seqptick)
    (meson deadlock_freeSKIPS_Seqptick deadlock_freeSKIPS_implies_div_free)



subsubsection ‹Synchronization Product›

context Syncptick_locale begin

lemma deadlock_free_Det_bis :
  ‹P = STOP ∧ Q ≠ STOP ∨ deadlock_free P ⟹
   Q = STOP ∧ P ≠ STOP ∨ deadlock_free Q ⟹ deadlock_free (P □ Q)›
  using deadlock_free_Det by auto

lemma deadlock_free_Mprefix_Syncptick_Mprefix :
  assumes not_all_empty: ‹¬ A ⊆ S ∨ ¬ B ⊆ S ∨ A ∩ B ∩ S ≠ {}›
    and ‹⋀a. a ∈ A - S ⟹ deadlock_free (P a ⟦S⟧✓ □b∈B → Q b)›
    and ‹⋀b. b ∈ B - S ⟹ deadlock_free (□a∈A → P a ⟦S⟧✓ Q b)›
    and ‹⋀x. x ∈ A ∩ B ∩ S ⟹ deadlock_free (P x ⟦S⟧✓ Q x)› 
  shows ‹deadlock_free (□a∈A → P a ⟦S⟧✓ □b ∈ B → Q b)›
  unfolding Mprefix_Syncptick_Mprefix using not_all_empty
  by (auto intro!: deadlock_free_Det_bis
      simp add: Mprefix_is_STOP_iff Det_is_STOP_iff deadlock_free_Mprefix_iff assms(2-4))


lemma deadlock_free_Mprefix_Syncptick_Mprefix_subset :
  ‹⟦A ⊆ S; B ⊆ S; A ∩ B ≠ {};
    ⋀x. x ∈ A ∩ B ∩ S ⟹ deadlock_free (P x ⟦S⟧✓ Q x)⟧
   ⟹ deadlock_free (□a∈A → P a ⟦S⟧✓ □b∈B → Q b)›
  and deadlock_free_Mprefix_Syncptick_Mprefix_indep :
  ‹⟦A ∩ S = {}; B ∩ S = {}; A ≠ {} ∨ B ≠ {};
    ⋀a. a ∈ A - S ⟹ deadlock_free (P a ⟦S⟧✓ □b∈B → Q b);
    ⋀b. b ∈ B - S ⟹ deadlock_free (□a∈A → P a ⟦S⟧✓ Q b)⟧
   ⟹ deadlock_free (□a∈A → P a ⟦S⟧✓ □b∈B → Q b)›
  and deadlock_free_Mprefix_Syncptick_Mprefix_right :
  ‹⟦A ⊆ S; B ∩ S = {}; B ≠ {};
    ⋀b. b ∈ B - S ⟹ deadlock_free (□a∈A → P a ⟦S⟧✓ Q b)⟧
   ⟹ deadlock_free (□a∈A → P a ⟦S⟧✓ □b∈B → Q b)›
  and deadlock_free_Mprefix_Syncptick_Mprefix_left :
  ‹⟦A ∩ S = {}; B ⊆ S; A ≠ {};
    ⋀a. a ∈ A - S ⟹ deadlock_free (P a ⟦S⟧✓ □b∈B → Q b)⟧
   ⟹ deadlock_free (□a∈A → P a ⟦S⟧✓ □b∈B → Q b)›
  by (auto intro!: deadlock_free_Mprefix_Syncptick_Mprefix)


end



section ‹Renaming and reference Processes›

― ‹Should have been declared simp earlier.›
lemma DF_empty        [simp] : ‹DF {} = STOP›
  and DFSKIPS_empty    [simp] : ‹DFSKIPS {} {} = STOP›
  and RUN_empty       [simp] : ‹RUN {} = STOP›
  and CHAOS_empty     [simp] : ‹CHAOS {} = STOP›
  and CHAOSSKIPS_empty [simp] : ‹CHAOSSKIPS {} {} = STOP›
  by (subst DF_unfold DFSKIPS_unfold RUN_unfold CHAOS_unfold CHAOSSKIPS_unfold, simp)+



subsection ‹Alternative Definitions with restriction fixed-point Operator›

text ‹
For now, we have lemmas such as @{thm DF_FD_Renaming_DF[no_vars]}, but the other refinement is
requiring const‹finitary› assumptions (@{thm Renaming_DF_FD_DF[no_vars]}).
›

lemma DF_restriction_fix_def : ‹DF A = (υ X. ⊓a ∈ A → X)›
  unfolding DF_def by (rule restriction_fix_is_fix[symmetric]) simp_all

lemma DFSKIPS_restriction_fix_def : ‹DFSKIPS A R = (υ X. (⊓a ∈ A → X) ⊓ SKIPS R)›
  unfolding DFSKIPS_def by (rule restriction_fix_is_fix[symmetric]) simp_all

lemma RUN_restriction_fix_def : ‹RUN A = (υ X. □a ∈ A → X)›
  unfolding RUN_def by (rule restriction_fix_is_fix[symmetric]) simp_all

lemma CHAOS_restriction_fix_def : ‹CHAOS A = (υ X. STOP ⊓ (□a ∈ A → X))›
  unfolding CHAOS_def by (rule restriction_fix_is_fix[symmetric]) simp_all

lemma CHAOSSKIPS_restriction_fix_def : ‹CHAOSSKIPS A R = (υ X. SKIPS R ⊓ STOP ⊓ (□a ∈ A → X))›
  unfolding CHAOSSKIPS_def by (rule restriction_fix_is_fix[symmetric]) simp_all



subsection ‹Stronger Results›

text ‹With const‹restriction_fix› induction, removing these assumptions is trivial.›

lemma Renaming_DF : ‹Renaming (DF A) f g = DF (f ` A)›
proof (unfold DF_restriction_fix_def, induct rule: parallel_restriction_fix_ind)
  show ‹Renaming STOP f g = STOP› by simp
qed (auto simp add: Renaming_Mndetprefix intro!: mono_Mndetprefix_eq)

lemma Renaming_DFSKIPS : ‹Renaming (DFSKIPS A R) f g = DFSKIPS (f ` A) (g ` R)›
proof (unfold DFSKIPS_restriction_fix_def, induct rule: parallel_restriction_fix_ind)
  show ‹Renaming STOP f g = STOP› by simp
qed (auto simp add: Renaming_Mndetprefix Renaming_Ndet
    intro!: mono_Mndetprefix_eq arg_cong2[where f = ‹(⊓)›])

lemma Renaming_RUN : ‹Renaming (RUN A) f g = RUN (f ` A)›
proof (unfold RUN_restriction_fix_def, induct rule: parallel_restriction_fix_ind)
  show ‹Renaming STOP f g = STOP› by simp
qed (auto simp add: Renaming_Mprefix intro!: mono_Mprefix_eq)

lemma Renaming_CHAOS : ‹Renaming (CHAOS A) f g = CHAOS (f ` A)›
proof (unfold CHAOS_restriction_fix_def, induct rule: parallel_restriction_fix_ind)
  show ‹Renaming STOP f g = STOP› by simp
qed (auto simp add: Renaming_Mprefix Renaming_Ndet
    intro!: mono_Mprefix_eq arg_cong2[where f = ‹(⊓)›])

lemma Renaming_CHAOSSKIPS : ‹Renaming (CHAOSSKIPS A R) f g = CHAOSSKIPS (f ` A) (g ` R)›
proof (unfold CHAOSSKIPS_restriction_fix_def, induct rule: parallel_restriction_fix_ind)
  show ‹Renaming STOP f g = STOP› by simp
qed (auto simp add: Renaming_Mprefix Renaming_Ndet
    intro!: mono_Mprefix_eq arg_cong2[where f = ‹(⊓)›])



section ‹Data Independence›

text (in Syncptick_locale) ‹
When working with the new interleaving term‹P |||✓ Q›, we intuitively expect it to be
const‹deadlock_free› when both term‹P› and term‹Q› are.
The purpose of this section is to prove it.
›

subsection ‹An interesting equivalence›

lemma (in Syncptick_locale) deadlock_free_of_Syncptick_iff_DF_FD_DF_Syncptick_DF:
  ‹(∀P Q. deadlock_free P ⟶ deadlock_free Q ⟶ deadlock_free (P ⟦S⟧✓ Q))
   ⟷ DF UNIV ⊑FD (DF UNIV ⟦S⟧✓ DF UNIV)› (is ‹?lhs ⟷ ?rhs›)
proof (rule iffI)
  assume ?lhs
  show ?rhs by (fold deadlock_free_def, rule ‹?lhs›[rule_format])
      (simp_all add: deadlock_free_def)
next
  assume ?rhs
  show ?lhs unfolding deadlock_free_def
    by (intro allI impI trans_FD[OF ‹?rhs›]) (rule mono_Syncptick_FD)
qed



subsection ‹const‹STOP› and const‹SKIP› synchronized with term‹DF A››

text ‹The two results below form a stronger (and generalized)
      version of @{thm DF_FD_DF_Sync_SKIP_iff[of r s A S]}.›

context Syncptick_locale begin

lemma (in Syncptick_locale) DF_FD_DF_Syncptick_SKIPS_imp_disjoint :
  ‹A ∩ S = {}› if ‹DF A ⊑FD DF A ⟦S⟧✓ SKIPS R›
proof (rule ccontr)
  assume ‹A ∩ S ≠ {}›
  then obtain a where ‹a ∈ A› and ‹a ∈ S› by blast
  have ‹DF A ⟦S⟧✓ SKIPS R ⊑FD DF {a} ⟦S⟧✓ SKIPS R›
    by (intro mono_Syncptick_FD[OF _ idem_FD]) (simp add: DF_subset ‹a ∈ A›)
  also have ‹… = STOP›
    by (subst DF_unfold)
      (simp add: ‹a ∈ S› SKIPS_def Syncptick_distrib_GlobalNdet_left
        write0_Syncptick_STOP write0_Syncptick_SKIP)
  finally show False
    by (metis that ‹a ∈ A› DF_Univ_freeness empty_iff non_deadlock_free_STOP trans_FD)
qed


lemma disjoint_imp_DF_eq_DF_Syncptick_SKIPS :
  ‹DF A = DF A ⟦S⟧✓ SKIPS R› if ‹A ∩ S = {}›
proof (subst DF_restriction_fix_def, induct rule: restriction_fix_ind)
  show ‹X = DF A ⟦S⟧✓ SKIPS R ⟹ ⊓a∈A → X = DF A ⟦S⟧✓ SKIPS R› for X
    by (subst DF_unfold)
      (auto simp add: SKIPS_def Syncptick_distrib_GlobalNdet_left
        Mndetprefix_Syncptick_SKIP Mndetprefix_Syncptick_STOP
        ‹A ∩ S = {}› Mndetprefix_distrib_GlobalNdet)
qed simp_all


corollary DF_FD_DF_Syncptick_STOP_imp_disjoint :
  ‹DF A ⊑FD DF A ⟦S⟧✓ STOP ⟹ A ∩ S = {}›
  and DF_FD_DF_Syncptick_SKIP_imp_disjoint :
  ‹DF A ⊑FD DF A ⟦S⟧✓ SKIP r ⟹ A ∩ S = {}›
  and disjoint_imp_DF_eq_DF_Syncptick_STOP :
  ‹A ∩ S = {} ⟹ DF A = DF A ⟦S⟧✓ STOP›
  and disjoint_imp_DF_eq_DF_Syncptick_SKIP :
  ‹A ∩ S = {} ⟹ DF A = DF A ⟦S⟧✓ SKIP r›
  by (fact DF_FD_DF_Syncptick_SKIPS_imp_disjoint[where R = ‹{}›, simplified]
      DF_FD_DF_Syncptick_SKIPS_imp_disjoint[where R = ‹{r}›, simplified]
      disjoint_imp_DF_eq_DF_Syncptick_SKIPS[where R = ‹{}›, simplified]
      disjoint_imp_DF_eq_DF_Syncptick_SKIPS[where R = ‹{r}›, simplified])+


end

corollary (in Syncptick_locale) DF_FD_SKIPS_Syncptick_DF_imp_disjoint :
  ‹DF A ⊑FD SKIPS R ⟦S⟧✓ DF A ⟹ A ∩ S = {}›
  by (metis Syncptick_locale_sym.DF_FD_DF_Syncptick_SKIPS_imp_disjoint Syncptick_sym)


lemma (in Syncptick_locale) disjoint_imp_DF_eq_SKIPS_Syncptick_DF :
  ‹A ∩ S = {} ⟹ DF A = SKIPS R ⟦S⟧✓ DF A›
  by (metis Syncptick_locale_sym.disjoint_imp_DF_eq_DF_Syncptick_SKIPS Syncptick_sym)


corollary (in Syncptick_locale) DF_FD_STOP_Syncptick_DF_imp_disjoint :
  ‹DF A ⊑FD STOP ⟦S⟧✓ DF A ⟹ A ∩ S = {}›
  and DF_FD_SKIP_Syncptick_DF_imp_disjoint :
  ‹DF A ⊑FD SKIP r ⟦S⟧✓ DF A ⟹ A ∩ S = {}›
  and disjoint_imp_DF_eq_STOP_Syncptick_DF :
  ‹A ∩ S = {} ⟹ DF A = STOP ⟦S⟧✓ DF A›
  and disjoint_imp_DF_eq_SKIP_Syncptick_DF :
  ‹A ∩ S = {} ⟹ DF A = SKIP r ⟦S⟧✓ DF A›
  by (fact DF_FD_SKIPS_Syncptick_DF_imp_disjoint[where R = ‹{}›, simplified]
      DF_FD_SKIPS_Syncptick_DF_imp_disjoint[where R = ‹{r}›, simplified]
      disjoint_imp_DF_eq_SKIPS_Syncptick_DF[where R = ‹{}›, simplified]
      disjoint_imp_DF_eq_SKIPS_Syncptick_DF[where R = ‹{r}›, simplified])+




subsection ‹Finally, term‹deadlock_free (P ||| Q)››

theorem (in Syncptick_locale) DF_F_DF_Syncptick_DF_weak : ‹DF (A ∪ B) ⊑F DF A ⟦S⟧✓ DF B›
  if nonempty: ‹A ≠ {}› ‹B ≠ {}›
    and intersect_hyp: ‹B ∩ S = {} ∨ (∃y. B ∩ S = {y} ∧ A ∩ S ⊆ {y})›
proof -
  have ‹⟦(u, X) ∈ ℱ (DF A); (v, Y) ∈ ℱ (DF B); t setinterleaves✓⇘(⊗✓)⇙ ((u, v), S)⟧
        ⟹ (t, super_ref_Syncptick (⊗✓) X S Y) ∈ ℱ (DF (A ∪ B))› for v t u X Y
  proof (induct t arbitrary: u v)
    case Nil
    from Nil.prems(3) have ‹u = []› ‹v = []› by (simp_all add: Nil_setinterleavesptick)
    from Nil.prems(1) obtain a where ‹a ∈ A› ‹ev a ∉ X›
      by (subst (asm) F_DF) (auto simp add: nonempty ‹u = []›)
    moreover from Nil.prems(2) obtain b where ‹b ∈ B› ‹ev b ∉ Y›
      by (subst (asm) F_DF) (auto simp add: nonempty ‹v = []›)
    ultimately show ?case
      using intersect_hyp
      by (subst F_DF, simp add: nonempty super_ref_Syncptick_def subset_iff)
        (metis Int_iff empty_iff insert_iff)
  next
    case (Cons e t)
    from Cons.prems(3) consider (mv_left) a u' where ‹a ∉ S› ‹e = ev a› ‹u = ev a # u'›
      ‹t setinterleaves✓⇘(⊗✓)⇙ ((u', v), S)›
    | (mv_right) b v' where ‹b ∉ S› ‹e = ev b› ‹v = ev b # v'›
      ‹t setinterleaves✓⇘(⊗✓)⇙ ((u, v'), S)›
    | (mv_both_ev) a u' v' where ‹a ∈ S› ‹e = ev a› ‹u = ev a # u'› ‹v = ev a # v'›
      ‹t setinterleaves✓⇘(⊗✓)⇙ ((u', v'), S)›
    | (mv_both_tick) r s r_s u' v' where ‹r ⊗✓ s = Some r_s› ‹e = ✓(r_s)›
      ‹u = ✓(r) # u'› ‹v = ✓(s) # v'› ‹t setinterleaves✓⇘(⊗✓)⇙ ((u', v'), S)›
      by (cases e) (auto elim: Cons_ev_setinterleavesptickE Cons_tick_setinterleavesptickE)
    thus ?case
    proof cases
      case mv_left
      from Cons.prems(1) have ‹a ∈ A›
        by (subst (asm) F_DF) (simp add: mv_left(3) split: if_split_asm)
      from Cons.prems(1)[unfolded mv_left(3), THEN Cons_F_DF] have ‹(u', X) ∈ ℱ (DF A)› .
      from Cons.hyps[OF this Cons.prems(2) mv_left(4)] show ?thesis
        by (subst F_DF) (simp add: nonempty ‹e = ev a› ‹a ∈ A›)
    next
      case mv_right
      from Cons.prems(2) have ‹b ∈ B›
        by (subst (asm) F_DF) (simp add: mv_right(3) split: if_split_asm)
      from Cons.prems(2)[unfolded mv_right(3), THEN Cons_F_DF] have ‹(v', Y) ∈ ℱ (DF B)› .
      from Cons.hyps[OF Cons.prems(1) this mv_right(4)] show ?thesis
        by (subst F_DF) (simp add: nonempty ‹e = ev b› ‹b ∈ B›)
    next
      case mv_both_ev
      from Cons.prems(1) have ‹a ∈ A›
        by (subst (asm) F_DF) (simp add: mv_both_ev(3) split: if_split_asm)
      from Cons.prems(1)[unfolded mv_both_ev(3), THEN Cons_F_DF]
        Cons.prems(2)[unfolded mv_both_ev(4), THEN Cons_F_DF]
      have ‹(u', X) ∈ ℱ (DF A)› ‹(v', Y) ∈ ℱ (DF B)› .
      from Cons.hyps[OF this mv_both_ev(5)] show ?thesis
        by (subst F_DF) (simp add: nonempty ‹e = ev a› ‹a ∈ A›)
    next
      case mv_both_tick
      from Cons.prems(1) have False
        by (subst (asm) F_DF) (simp add: mv_both_tick(3) split: if_split_asm)
      thus ?thesis ..
    qed
  qed
  thus ‹DF (A ∪ B) ⊑F DF A ⟦S⟧✓ DF B›
    by (simp add: failure_refine_def F_Syncptick div_free_DF)
      (use is_processT4 in blast)
qed


theorem (in Syncptick_locale) DF_F_DF_Syncptick_DF :
  ‹DF (A ∪ B) ⊑F DF A ⟦S⟧✓ DF B› if ‹A ≠ {}› ‹B ≠ {}›
  and ‹A ∩ S = {} ∨ (∃a. A ∩ S = {a} ∧ B ∩ S ⊆ {a}) ∨
       B ∩ S = {} ∨ (∃b. B ∩ S = {b} ∧ A ∩ S ⊆ {b})›
proof -
  from that(3) consider ‹A ∩ S = {} ∨ (∃a. A ∩ S = {a} ∧ B ∩ S ⊆ {a})›
    | ‹B ∩ S = {} ∨ (∃b. B ∩ S = {b} ∧ A ∩ S ⊆ {b})› by metis
  thus ‹DF (A ∪ B) ⊑F DF A ⟦S⟧✓ DF B›
  proof cases
    from that(1, 2) show ‹B ∩ S = {} ∨ (∃b. B ∩ S = {b} ∧ A ∩ S ⊆ {b}) ⟹
                          DF (A ∪ B) ⊑F DF A ⟦S⟧✓ DF B›
      by (rule DF_F_DF_Syncptick_DF_weak)
  next
    from that(1, 2) show ‹A ∩ S = {} ∨ (∃a. A ∩ S = {a} ∧ B ∩ S ⊆ {a}) ⟹
                          DF (A ∪ B) ⊑F DF A ⟦S⟧✓ DF B›
      by (fold Syncptick_sym, subst Un_commute)
        (simp add: Syncptick_locale_sym.DF_F_DF_Syncptick_DF_weak)
  qed
qed


lemma (in Syncptick_locale) DF_FD_DF_Syncptick_DF :
  ‹DF (A ∪ B) ⊑FD DF A ⟦S⟧✓ DF B› if ‹A ≠ {}› ‹B ≠ {}›
  and ‹A ∩ S = {} ∨ (∃a. A ∩ S = {a} ∧ B ∩ S ⊆ {a}) ∨
       B ∩ S = {} ∨ (∃b. B ∩ S = {b} ∧ A ∩ S ⊆ {b})›
  using DF_F_DF_Syncptick_DF[OF that]
  by (simp add: refine_defs div_free_DF D_Syncptick)


theorem (in Syncptick_locale) DF_FD_DF_Syncptick_DF_iff:
  ‹DF (A ∪ B) ⊑FD DF A ⟦S⟧✓ DF B ⟷ 
   (     if A = {} then B ∩ S = {}
    else if B = {} then A ∩ S = {}
    else A ∩ S = {} ∨ (∃a. A ∩ S = {a} ∧ B ∩ S ⊆ {a}) ∨
         B ∩ S = {} ∨ (∃b. B ∩ S = {b} ∧ A ∩ S ⊆ {b}))›
  (is ‹?FD_ref ⟷ (     if A = {} then B ∩ S = {}
                    else if B = {} then A ∩ S = {} 
                    else ?cases)›)
proof -
  { assume ‹A ≠ {}› and ‹B ≠ {}› and ?FD_ref and ‹¬ ?cases›
    from ‹¬ ?cases›[simplified] 
    obtain a and b where ‹a ∈ A› ‹a ∈ S› ‹b ∈ B› ‹b ∈ S› ‹a ≠ b› by blast
    have ‹DF A ⟦S⟧✓ DF B ⊑FD (a → DF A) ⟦S⟧✓ (b → DF B)›
      by (intro mono_Syncptick_FD; subst DF_unfold, meson Mndetprefix_FD_write0 ‹a ∈ A› ‹b ∈ B›)
    also have ‹… = STOP› by (simp add: ‹a ∈ S› ‹a ≠ b› ‹b ∈ S› write0_Syncptick_write0_subset)
    finally have False
      by (metis DF_Univ_freeness Un_empty ‹A ≠ {}›
          trans_FD[OF ‹?FD_ref›] non_deadlock_free_STOP)
  } note * = this
  show ?thesis
  proof (cases ‹A = {}›; cases ‹B = {}›)
    show ‹A = {} ⟹ B = {} ⟹ ?thesis› by simp
  next
    show ‹A = {} ⟹ B ≠ {} ⟹ ?thesis›
      by simp (metis DF_FD_STOP_Syncptick_DF_imp_disjoint
          disjoint_imp_DF_eq_STOP_Syncptick_DF order_refl)
  next
    show ‹A ≠ {} ⟹ B = {} ⟹ ?thesis›
      by simp (metis DF_FD_DF_Syncptick_STOP_imp_disjoint
          disjoint_imp_DF_eq_DF_Syncptick_STOP order_refl)
  next
    show ‹A ≠ {} ⟹ B ≠ {} ⟹ ?thesis›
      by simp (metis "*" DF_FD_DF_Syncptick_DF)
  qed
qed



lemma DF_FD_DF_MultiSyncptick_DF :
  ‹⟦⋀l. l ∈ set L ⟹ X l ≠ {}; ∃s. (⋃ l ∈ set L. X l) ∩ S ⊆ {s}⟧
   ⟹ DF (⋃ l ∈ set L. X l) ⊑FD ⟦S⟧✓ l ∈@ L. (DF (X l) :: ('a, 'r) processptick)›
proof (induct L rule: induct_list012)
  case 1 show ?case by simp
next
  case (2 l0) show ?case by (simp add: Renaming_DF)
next
  case (3 l0 l1 L)
  have ‹(DF (⋃ l ∈ set (l0 # l1 # L). X l) :: ('a, 'r list) processptick) =
        DF (X l0 ∪ (⋃ l ∈ set (l1 # L). X l))› by simp
  also have ‹… ⊑FD DF (X l0) ⟦S⟧✓Rlist DF (⋃ l ∈ set (l1 # L). X l)›
    by (rule SyncRlist.DF_FD_DF_Syncptick_DF_iff[THEN iffD2])
      (use "3.prems"(2) in ‹simp add: "3.prems"(1) subset_singleton_iff
                                      Int_Un_distrib2 Un_singleton_iff, safe, simp_all›)
  also have ‹… ⊑FD DF (X l0) ⟦S⟧✓Rlist ⟦S⟧✓ l∈@(l1 # L). (DF (X l))›
    by (intro SyncRlist.mono_Syncptick_FD[OF idem_FD] "3.hyps"(2))
      (use "3.prems" in auto)
  also have ‹… = ⟦S⟧✓ l∈@(l0 # l1 # L). DF (X l)› by simp
  finally show ?case .
qed





lemma (in Syncptick_locale) ‹DF {a} = DF {a} ⟦S⟧✓ STOP ⟷ a ∉ S›
  by (metis DF_FD_DF_Syncptick_STOP_imp_disjoint boolean_algebra.conj_zero_left
      disjoint_imp_DF_eq_DF_Syncptick_STOP insert_disjoint(1) order_refl)

lemma (in Syncptick_locale) ‹DF {a} ⟦S⟧✓ STOP = STOP ⟷ a ∈ S›
  by (metis DF_unfold Diff_eq_empty_iff Diff_triv Int_empty_left Int_insert_left
      Mndetprefix_Syncptick_Mprefix_right Mndetprefix_Syncptick_STOP
      Mndetprefix_is_STOP_iff Mprefix_empty empty_not_insert insert_Diff1)


corollary (in Syncptick_locale) DF_FD_DF_Interptick_DF : ‹DF A ⊑FD DF A |||✓ DF A›
  by (metis DF_FD_DF_Syncptick_DF_iff inf_bot_right sup.idem)

corollary (in Syncptick_locale) DF_UNIV_FD_DF_UNIV_Interptick_DF_UNIV:
  ‹DF UNIV ⊑FD DF UNIV |||✓ DF UNIV›
  by (fact DF_FD_DF_Interptick_DF)

corollary (in Syncptick_locale) Interptick_deadlock_free :
  ‹deadlock_free P ⟹ deadlock_free Q ⟹ deadlock_free (P |||✓ Q)›
  using DF_FD_DF_Interptick_DF deadlock_free_of_Syncptick_iff_DF_FD_DF_Syncptick_DF by blast


theorem MultiInterptick_deadlock_free :
  ‹⟦L ≠ []; ⋀l. l ∈ set L ⟹ deadlock_free (P l)⟧ ⟹
   deadlock_free (|||✓ l ∈@ L. P l)›
proof (induct L rule: induct_list012)
  case 1
  from "1.prems"(1) have False by simp
  thus ?case ..
next
  case (2 l0)
  from "2.prems"(2) show ?case
    by (simp add: deadlock_free_imp_deadlock_free_Renaming)
next
  case (3 l0 l1 L)
  have ‹|||✓ l ∈@ (l0 # l1 # L). P l = P l0 |||✓Rlist |||✓ l ∈@ (l1 # L). P l› by simp
  moreover have ‹deadlock_free (P l0)› by (simp add: "3.prems"(2))
  moreover have ‹deadlock_free (|||✓ l ∈@ (l1 # L). P l)›
    by (rule "3.hyps"(2)) (simp_all add: "3.prems"(2))
  ultimately show ?case
    by (simp add: SyncRlist.Interptick_deadlock_free)
qed



(*<*)
end
  (*>*)