section {*FUNCTION\_\_DPDA\_DFA\_CC\_\_fp\_one\_\_DPDA\_DFA\_CONSTRUCT\_CONTROLLER\_FP\_ONE*}
theory
  FUNCTION__DPDA_DFA_CC__fp_one__DPDA_DFA_CONSTRUCT_CONTROLLER_FP_ONE

imports
  PRJ_14_02__ENTRY

begin

definition FPiteratorMarked__SpecInput :: "
  'event DES
  \<Rightarrow> 'event DES
  \<Rightarrow> 'event DES
  \<Rightarrow> bool"
  where
    "FPiteratorMarked__SpecInput C S P \<equiv>
  IsDES C
  \<and> IsDES S
  \<and> IsDES P
  \<and> DES_nonblockingness C
  \<and> DES_specification_satisfied S C
  \<and> C \<le> P"

definition FPiteratorMarked__SpecOutput_Alt :: "
  'event DES
  \<Rightarrow> 'event DES
  \<Rightarrow> 'event DES
  \<Rightarrow> 'event set
  \<Rightarrow> 'event DES
  \<Rightarrow> bool
  \<Rightarrow> bool"
  where
    "FPiteratorMarked__SpecOutput_Alt C S P \<Sigma>UC C' unchanged \<equiv>
  IsDES C'
  \<and> DES_specification_satisfied S C'
  \<and> (C = C' \<longleftrightarrow> unchanged)
  \<and> (if C = C' then DES_nonblockingness C' \<and> DES_controllability \<Sigma>UC P C' else True)"

definition FPiteratorMarked__SpecOutput :: "
  'event DES
  \<Rightarrow> 'event DES
  \<Rightarrow> 'event DES
  \<Rightarrow> 'event set
  \<Rightarrow> 'event DES
  \<Rightarrow> bool
  \<Rightarrow> bool"
  where
    "FPiteratorMarked__SpecOutput C S P \<Sigma>UC C' unchanged \<equiv>
  IsDES C'
  \<and> DES_specification_satisfied S C'
  \<and> (C = C' \<longleftrightarrow> unchanged)
  \<and> (C = C' \<longrightarrow> DES_nonblockingness C' \<and> DES_controllability \<Sigma>UC P C')"

definition F_DPDA_DFA_CC__fp_one__SpecInput :: "
  ('state DT_symbol, 'event DT_symbol, 'stack DT_symbol) epda
  \<Rightarrow> ('state DT_symbol, 'event DT_symbol, 'stack DT_symbol) epda
  \<Rightarrow> ('state DT_symbol, 'event DT_symbol, nat) epda
  \<Rightarrow> bool"
  where
    "F_DPDA_DFA_CC__fp_one__SpecInput C S P \<equiv>
  valid_dpda C
  \<and> valid_dpda S
  \<and> valid_dfa P
  \<and> FPiteratorMarked__SpecInput (epda_to_des C) (epda_to_des S) (epda_to_des P)
  \<and> \<not> epdaH_livelock C
  \<and> epdaH.accessible C"

definition F_DPDA_DFA_CC__fp_one__SpecOutput :: "
  ('state DT_symbol, 'event DT_symbol, 'stack DT_symbol) epda
  \<Rightarrow> ('state DT_symbol, 'event DT_symbol, 'stack DT_symbol) epda
  \<Rightarrow> ('state DT_symbol, 'event DT_symbol, nat) epda
  \<Rightarrow> 'event DT_symbol set
  \<Rightarrow> ((('state DT_symbol, 'event DT_symbol, 'stack DT_symbol) epda option)
      \<times> bool)
  \<Rightarrow> bool"
  where
    "F_DPDA_DFA_CC__fp_one__SpecOutput C S P \<Sigma>UC C' \<equiv>
  case C' of
    (None, changed) \<Rightarrow>
      FPiteratorMarked \<Sigma>UC (epda_to_des P) (epda_to_des C) = DES {} {}
    | (Some C', changed) \<Rightarrow>
      FPiteratorMarked \<Sigma>UC (epda_to_des P) (epda_to_des C) = epda_to_des C'
      \<and> FPiteratorMarked__SpecOutput
          (epda_to_des C)
          (epda_to_des S)
          (epda_to_des P)
          \<Sigma>UC
          (epda_to_des C')
          (\<not> changed)
      \<and> F_DPDA_DFA_CC__fp_one__SpecInput C' S P
      \<and> epda_to_des C' \<le> epda_to_des C
      \<and> (\<not> changed \<longleftrightarrow> C = C')
      \<and> (\<not> changed \<longrightarrow> epda_operational_controllable C' P \<Sigma>UC)"

lemma leq_le_trans_DES: "
  a \<le> b \<Longrightarrow> b < (c::('a)DES) \<Longrightarrow>  a \<le> c"
  apply(force)
  done

theorem F_DPDA_DFA_CC__fp_one__SOUND: "
  F_DPDA_DFA_CC__fp_one__SpecInput C S P
  \<Longrightarrow> F_DPDA_DFA_CC__fp_one__SpecOutput C S P \<Sigma>UC (F_DPDA_DFA_CC__fp_one C P \<Sigma>UC)"
  apply(simp add: F_DPDA_DFA_CC__fp_one_def)
  apply(subgoal_tac "X" for X)
   prefer 2
   apply(rule_tac
      S="C"
      and P="P"
      and \<Sigma>UC="\<Sigma>UC"
      in F_DPDA_EC__SOUND)
    apply(simp add: FPiteratorMarked__SpecInput_def F_DPDA_DFA_CC__fp_one__SpecInput_def F_DPDA_EC__SpecInput_def DES_specification_satisfied_def epda_to_des_def des_langUM_def des_langM_def less_eq_DES_ext_def lesseqDES_def)
    apply(clarsimp)
    apply(rule_tac
      s="epdaH.unmarked_language C"
      and t="epdaS.unmarked_language C"
      in ssubst)
     apply(rule epdaS_to_epdaH_unmarked_language)
     apply (metis valid_dpda_to_valid_pda PDA_to_epda)
    apply(rule_tac
      s="epdaH.unmarked_language P"
      and t="epdaS.unmarked_language P"
      in ssubst)
     apply(rule epdaS_to_epdaH_unmarked_language)
     apply (metis valid_dfa_def valid_dpda_to_valid_pda PDA_to_epda)
    apply(rule_tac
      s="epdaH.marked_language C"
      and t="epdaS.marked_language C"
      in ssubst)
     apply(rule epdaS_to_epdaH_mlang)
     apply (metis valid_dpda_to_valid_pda PDA_to_epda)
    apply(rule_tac
      s="epdaH.marked_language P"
      and t="epdaS.marked_language P"
      in ssubst)
     apply(rule epdaS_to_epdaH_mlang)
     apply (metis valid_dfa_def valid_dpda_to_valid_pda PDA_to_epda)
    apply(rule conjI)
     apply(force)
    apply(simp add: DES_nonblockingness_def nonblockingness_language_def)
   apply(force)
  apply(case_tac "F_DPDA_EC C P \<Sigma>UC")
  apply(rename_tac a b)(*strict*)
  apply(clarsimp)
  apply(case_tac a)
   apply(rename_tac a b)(*strict*)
   apply(clarsimp)
   apply(rename_tac b)(*strict*)
   apply(simp add: FPiteratorMarked__SpecOutput_def F_DPDA_DFA_CC__fp_one__SpecOutput_def F_DPDA_EC__SpecOutput_def F_DPDA_DFA_CC__fp_one__SpecInput_def FPiteratorMarked__SpecInput_def)
   apply(clarsimp)
   apply(simp add: FPiteratorMarked_def epda_to_des_def)
   apply(simp add: ifcomp_def)
   apply(rule conjI)
    apply(rename_tac b)(*strict*)
    apply(clarsimp)
    apply(simp add: FPiteratorMarked__SpecInput_def F_DPDA_DFA_CC__fp_one__SpecInput_def F_DPDA_EC__SpecInput_def DES_specification_satisfied_def epda_to_des_def des_langUM_def des_langM_def less_eq_DES_ext_def lesseqDES_def DES_nonblockingness_def nonblockingness_language_def)
    apply(simp add: prefix_closure_def prefix_def)
   apply(rename_tac b)(*strict*)
   apply(clarsimp)
   apply(simp add: FPiteratorMarked__SpecInput_def F_DPDA_DFA_CC__fp_one__SpecInput_def F_DPDA_EC__SpecInput_def DES_specification_satisfied_def epda_to_des_def des_langUM_def des_langM_def less_eq_DES_ext_def lesseqDES_def DES_nonblockingness_def prefix_closure_def prefix_def Enforce_Nonblockingness_DES_def)
  apply(rename_tac a b aa)(*strict*)
  apply(clarsimp)
  apply(rename_tac b aa)(*strict*)
  apply(rename_tac C')
  apply(rename_tac b C')(*strict*)
  apply(subgoal_tac "X" for X)
   apply(rename_tac b C')(*strict*)
   prefer 2
   apply(rule_tac
      G="C'"
      in F_DPDA_EB_OPT__SOUND)
   apply(simp add: F_DPDA_EB_OPT__SpecInput_def F_DPDA_EC__SpecOutput_def)
  apply(rename_tac b C')(*strict*)
  apply(subgoal_tac "X" for X)
   apply(rename_tac b C')(*strict*)
   prefer 2
   apply(rule_tac
      \<Sigma>UC="\<Sigma>UC"
      and P="epda_to_des P"
      in Characteristic_Fixed_Point_Iterator_Enforce_Marked_Controllable_Subset)
   apply(simp add: F_DPDA_EC__SpecOutput_def FPiteratorMarked__SpecOutput_def F_DPDA_DFA_CC__fp_one__SpecInput_def FPiteratorMarked__SpecInput_def)
  apply(rename_tac b C')(*strict*)
  apply(case_tac b)
   apply(rename_tac b C')(*strict*)
   apply(clarsimp)
   apply(simp only: F_DPDA_EC__SpecOutput_def FPiteratorMarked__SpecOutput_def F_DPDA_DFA_CC__fp_one__SpecInput_def FPiteratorMarked__SpecInput_def)
   apply(clarsimp)
   apply(rename_tac b)(*strict*)
   apply(subgoal_tac "(\<forall>X. IsDES X \<and> DES_nonblockingness X \<longrightarrow> DES_controllability \<Sigma>UC (epda_to_des P) X = (Enforce_Marked_Controllable_Subset \<Sigma>UC (des_langUM (epda_to_des P)) X = X))")
    apply(rename_tac b)(*strict*)
    prefer 2
    apply(simp add: Characteristic_Fixed_Point_Iterator_def)
   apply(rename_tac b)(*strict*)
   apply(erule_tac
      x="(epda_to_des C)"
      in allE)
   apply(clarsimp)
   apply(simp add: F_DPDA_DFA_CC__fp_one__SpecOutput_def)
   apply(rename_tac b)(*strict*)
   apply(simp add: epda_to_des_def F_DPDA_DFA_CC__fp_one__SpecOutput_def F_DPDA_EC__SpecOutput_def FPiteratorMarked__SpecOutput_def F_DPDA_DFA_CC__fp_one__SpecInput_def FPiteratorMarked__SpecInput_def)
   apply(simp add: FPiteratorMarked__SpecInput_def F_DPDA_DFA_CC__fp_one__SpecInput_def F_DPDA_EC__SpecInput_def DES_specification_satisfied_def epda_to_des_def des_langUM_def des_langM_def less_eq_DES_ext_def lesseqDES_def prefix_closure_def prefix_def)
   apply(clarsimp)
   apply(simp add: FPiteratorMarked_def)
   apply(simp add: ifcomp_def)
  apply(clarsimp)
  apply(simp add: FPiteratorMarked__SpecInput_def F_DPDA_DFA_CC__fp_one__SpecInput_def F_DPDA_EC__SpecInput_def DES_specification_satisfied_def epda_to_des_def des_langUM_def des_langM_def less_eq_DES_ext_def lesseqDES_def DES_nonblockingness_def)
  apply(rename_tac b C')(*strict*)
  apply(clarsimp)
  apply(simp only: F_DPDA_DFA_CC__fp_one__SpecOutput_def F_DPDA_EC__SpecOutput_def F_DPDA_DFA_CC__fp_one__SpecInput_def FPiteratorMarked__SpecInput_def)
  apply(clarsimp)
  apply(simp add: F_DPDA_EB_OPT__SpecOutput_def)
  apply(subgoal_tac "epdaS.marked_language C' = epdaH.marked_language C'")
   apply(rename_tac b C')(*strict*)
   prefer 2
   apply(rule epdaS_to_epdaH_mlang)
   apply (metis valid_dpda_to_valid_pda PDA_to_epda)
  apply(rename_tac b C')(*strict*)
  apply(subgoal_tac "epdaS.unmarked_language C' = epdaH.unmarked_language C'")
   apply(rename_tac b C')(*strict*)
   prefer 2
   apply(rule epdaS_to_epdaH_unmarked_language)
   apply (metis valid_dpda_to_valid_pda PDA_to_epda)
  apply(rename_tac b C')(*strict*)
  apply(case_tac "F_DPDA_EB_OPT C'")
   apply(rename_tac b C')(*strict*)
   apply(clarsimp)
   apply(simp add: epda_to_des_def FPiteratorMarked__SpecOutput_def IsDES_def)
   apply(clarsimp)
   apply(simp add: FPiteratorMarked__SpecInput_def F_DPDA_DFA_CC__fp_one__SpecInput_def F_DPDA_EC__SpecInput_def DES_specification_satisfied_def epda_to_des_def des_langUM_def des_langM_def less_eq_DES_ext_def lesseqDES_def prefix_closure_def prefix_def)
   apply(simp add: FPiteratorMarked_def)
   apply(simp add: ifcomp_def)
   apply(rule conjI)
    apply(rename_tac b C')(*strict*)
    apply(clarsimp)
   apply(rename_tac b C')(*strict*)
   apply(clarsimp)
   apply(simp add: FPiteratorMarked__SpecInput_def F_DPDA_DFA_CC__fp_one__SpecInput_def F_DPDA_EC__SpecInput_def DES_specification_satisfied_def epda_to_des_def des_langUM_def des_langM_def less_eq_DES_ext_def lesseqDES_def DES_nonblockingness_def prefix_closure_def prefix_def Enforce_Nonblockingness_DES_def)
  apply(rename_tac b C' a)(*strict*)
  apply(clarsimp)
  apply(rename_tac C'')
  apply(rename_tac b C' C'')(*strict*)
  apply(subgoal_tac "epdaS.marked_language C'' = epdaH.marked_language C''")
   apply(rename_tac b C' C'')(*strict*)
   prefer 2
   apply(rule epdaS_to_epdaH_mlang)
   apply (metis valid_dpda_to_valid_pda PDA_to_epda)
  apply(rename_tac b C' C'')(*strict*)
  apply(subgoal_tac "epdaS.unmarked_language C'' = epdaH.unmarked_language C''")
   apply(rename_tac b C' C'')(*strict*)
   prefer 2
   apply(rule epdaS_to_epdaH_unmarked_language)
   apply (metis valid_dpda_to_valid_pda PDA_to_epda)
  apply(rename_tac b C' C'')(*strict*)
  apply(subgoal_tac "epda_to_des C > epda_to_des C'")
   apply(rename_tac b C' C'')(*strict*)
   prefer 2
   apply(subgoal_tac "epda_to_des C' \<le> epda_to_des C")
    apply(rename_tac b C' C'')(*strict*)
    apply(subgoal_tac "epda_to_des C' \<noteq> epda_to_des C")
     apply(rename_tac b C' C'')(*strict*)
     apply(force)
    apply(rename_tac b C' C'')(*strict*)
    apply(force)
   apply(rename_tac b C' C'')(*strict*)
   apply(simp add: Enforce_Marked_Controllable_Subset_def)
   apply(simp add: epda_to_des_def)
   apply(clarsimp)
   apply(simp add: FPiteratorMarked__SpecInput_def F_DPDA_DFA_CC__fp_one__SpecInput_def F_DPDA_EC__SpecInput_def DES_specification_satisfied_def epda_to_des_def des_langUM_def des_langM_def less_eq_DES_ext_def lesseqDES_def nonblockingness_language_def DES_nonblockingness_def)
   apply(rule conjI)
    apply(rename_tac b C' C'')(*strict*)
    apply(rule_tac
      t="epdaH.unmarked_language C'"
      and s="{w \<in> epdaH.unmarked_language C. controllable_sublanguage ((prefix_closure {w}) - {w}) (alphabet_to_language \<Sigma>UC) (epdaH.unmarked_language P) (epdaH.unmarked_language C)}"
      in ssubst)
     apply(rename_tac b C' C'')(*strict*)
     apply(force)
    apply(rename_tac b C' C'')(*strict*)
    apply(force)
   apply(rename_tac b C' C'')(*strict*)
   apply(simp add: controllable_subset_def)
   apply(rule_tac
      t="epdaH.marked_language C''"
      and s="{w \<in> epdaH.unmarked_language C. controllable_sublanguage (prefix_closure {w}) \<langle>\<Sigma>UC\<rangle> (epdaH.unmarked_language P) (epdaH.unmarked_language C)} \<inter> epdaH.marked_language C"
      in ssubst)
    apply(rename_tac b C' C'')(*strict*)
    apply(force)
   apply(rename_tac b C' C'')(*strict*)
   apply(force)
  apply(rename_tac b C' C'')(*strict*)
  apply(subgoal_tac "epda_to_des C' \<ge> epda_to_des C''")
   apply(rename_tac b C' C'')(*strict*)
   prefer 2
   apply(simp add: FPiteratorMarked__SpecInput_def F_DPDA_DFA_CC__fp_one__SpecInput_def F_DPDA_EC__SpecInput_def DES_specification_satisfied_def epda_to_des_def des_langUM_def des_langM_def less_eq_DES_ext_def lesseqDES_def)
   apply(clarsimp)
   apply(rename_tac b C' C'' x)(*strict*)
   apply(simp add: IsDES_def)
   apply(clarsimp)
   apply(simp add: FPiteratorMarked__SpecInput_def F_DPDA_DFA_CC__fp_one__SpecInput_def F_DPDA_EC__SpecInput_def DES_specification_satisfied_def epda_to_des_def des_langUM_def des_langM_def less_eq_DES_ext_def lesseqDES_def nonblockingness_language_def DES_nonblockingness_def)
   apply(rule_tac
      A="prefix_closure (epdaH.marked_language C'')"
      in set_mp)
    apply(rename_tac b C' C'' x)(*strict*)
    prefer 2
    apply(force)
   apply(rename_tac b C' C'' x)(*strict*)
   apply(rule_tac
      t="prefix_closure (epdaH.marked_language C'')"
      and s="prefix_closure (epdaH.marked_language C')"
      in ssubst)
    apply(rename_tac b C' C'' x)(*strict*)
    apply(force)
   apply(rename_tac b C' C'' x)(*strict*)
   apply(simp (no_asm) add: prefix_closure_def prefix_def)
   apply(clarsimp)
   apply(rename_tac b C' C'' x xa c)(*strict*)
   apply(rule_tac
      v="c"
      in epdaH_unmarked_languageuage_prefix_closed)
    apply(rename_tac b C' C'' x xa c)(*strict*)
    apply (metis valid_dpda_to_valid_pda PDA_to_epda)
   apply(rename_tac b C' C'' x xa c)(*strict*)
   apply(rule_tac
      A="X" for X
      in set_mp)
    apply(rename_tac b C' C'' x xa c)(*strict*)
    apply(rule epdaH.lang_inclusion)
    apply (metis valid_dpda_to_valid_pda PDA_to_epda)
   apply(rename_tac b C' C'' x xa c)(*strict*)
   apply(force)
  apply(rename_tac b C' C'')(*strict*)
  apply(rule_tac t="FPiteratorMarked__SpecOutput (epda_to_des C) (epda_to_des S) (epda_to_des P) \<Sigma>UC
        (epda_to_des C'') False" and s="FPiteratorMarked__SpecOutput_Alt (epda_to_des C) (epda_to_des S) (epda_to_des P) \<Sigma>UC
        (epda_to_des C'') False" in ssubst)
   apply(simp add: FPiteratorMarked__SpecOutput_def FPiteratorMarked__SpecOutput_Alt_def)
  apply(simp add: FPiteratorMarked__SpecOutput_Alt_def)
  apply(rule context_conjI)
   apply(rename_tac b C' C'')(*strict*)
   apply(force)
  apply(rename_tac b C' C'')(*strict*)
  apply(clarsimp)
  apply(subgoal_tac "FPiteratorMarked \<Sigma>UC (epda_to_des P) (epda_to_des C) = epda_to_des C'' \<and> IsDES (epda_to_des C'') \<and> DES_specification_satisfied (epda_to_des S) (epda_to_des C'') \<and> DES_nonblockingness (epda_to_des C'') \<and> epda_to_des C'' \<le> epda_to_des P \<and> epdaH.accessible C''")
   apply(rename_tac b C' C'')(*strict*)
   apply(simp add: DES_specification_satisfied_def)
   apply(clarsimp)
   apply(rule context_conjI)
    apply(simp add: prefix_closure_def prefix_def F_DPDA_EC__SpecInput_def DES_specification_satisfied_def epda_to_des_def des_langUM_def des_langM_def less_eq_DES_ext_def  Enforce_Nonblockingness_DES_def)
   apply(rule conjI)
    apply(simp add: prefix_closure_def prefix_def lesseqDES_def F_DPDA_EC__SpecInput_def DES_specification_satisfied_def epda_to_des_def des_langUM_def des_langM_def less_eq_DES_ext_def  Enforce_Nonblockingness_DES_def)
   apply(force)
  apply(rename_tac b C' C'')(*strict*)
  apply(rule conjI)
   apply(rename_tac b C' C'')(*strict*)
   apply(simp add: FPiteratorMarked_def ifcomp_def)
   apply(rule conjI)
    apply(rename_tac b C' C'')(*strict*)
    apply(simp add: FPiteratorMarked__SpecOutput_Alt_def IsDES_def FPiteratorMarked__SpecInput_def F_DPDA_DFA_CC__fp_one__SpecInput_def F_DPDA_EC__SpecInput_def DES_specification_satisfied_def epda_to_des_def des_langUM_def des_langM_def)
    apply(clarsimp)
   apply(rename_tac b C' C'')(*strict*)
   apply(clarsimp)
   apply(simp add: nonblockingness_language_def)
   apply(simp add: prefix_closure_def prefix_def F_DPDA_EC__SpecInput_def DES_specification_satisfied_def epda_to_des_def des_langUM_def des_langM_def less_eq_DES_ext_def  Enforce_Nonblockingness_DES_def)
   apply(clarsimp)
   apply(rename_tac b C' C'' x c)(*strict*)
   apply(rule_tac
      v="c"
      in epdaH_prefixes_of_marked_words_are_unmarked_words)
    apply(rename_tac b C' C'' x c)(*strict*)
    apply (metis valid_dpda_to_valid_pda PDA_to_epda)
   apply(rename_tac b C' C'' x c)(*strict*)
   apply(force)
  apply(rename_tac b C' C'')(*strict*)
  apply(rule conjI)
   apply(rename_tac b C' C'')(*strict*)
   apply(rule epda_to_des_enforces_IsDES)
   apply (metis valid_dpda_to_valid_pda PDA_to_epda)
  apply(rename_tac b C' C'')(*strict*)
  apply(rule conjI)
   apply(rename_tac b C' C'')(*strict*)
   apply(simp add: DES_specification_satisfied_def epda_to_des_def)
   apply(simp add: less_eq_DES_ext_def lesseqDES_def less_DES_ext_def lessDES_def FPiteratorMarked__SpecOutput_Alt_def IsDES_def FPiteratorMarked__SpecInput_def F_DPDA_DFA_CC__fp_one__SpecInput_def F_DPDA_EC__SpecInput_def DES_specification_satisfied_def epda_to_des_def des_langUM_def des_langM_def nonblockingness_language_def)
   apply(clarsimp)
   apply(force)
  apply(rename_tac b C' C'')(*strict*)
  apply(rule conjI)
   apply(rename_tac b C' C'')(*strict*)
   apply(simp add: FPiteratorMarked__SpecInput_def F_DPDA_DFA_CC__fp_one__SpecInput_def F_DPDA_EC__SpecInput_def DES_specification_satisfied_def epda_to_des_def des_langUM_def des_langM_def less_eq_DES_ext_def lesseqDES_def)
   apply(simp add: less_eq_DES_ext_def lesseqDES_def less_DES_ext_def lessDES_def FPiteratorMarked__SpecOutput_Alt_def IsDES_def FPiteratorMarked__SpecInput_def F_DPDA_DFA_CC__fp_one__SpecInput_def F_DPDA_EC__SpecInput_def DES_specification_satisfied_def epda_to_des_def des_langUM_def des_langM_def nonblockingness_language_def)
   apply(clarsimp)
   apply(simp add: FPiteratorMarked__SpecInput_def F_DPDA_DFA_CC__fp_one__SpecInput_def F_DPDA_EC__SpecInput_def DES_specification_satisfied_def epda_to_des_def des_langUM_def des_langM_def less_eq_DES_ext_def lesseqDES_def nonblockingness_language_def DES_nonblockingness_def)
  apply(rename_tac b C' C'')(*strict*)
  apply(rule conjI)
   apply(rename_tac b C' C'')(*strict*)
   apply(simp add: IsDES_def FPiteratorMarked__SpecInput_def F_DPDA_DFA_CC__fp_one__SpecInput_def F_DPDA_EC__SpecInput_def DES_specification_satisfied_def epda_to_des_def des_langUM_def des_langM_def less_DES_ext_def lessDES_def less_eq_DES_ext_def lesseqDES_def nonblockingness_language_def DES_nonblockingness_def)
   apply(clarsimp)
   apply(force)
  apply(rename_tac b C' C'')(*strict*)
  apply(rule epdaS_to_epdaH_accessible)
   apply(rename_tac b C' C'')(*strict*)
   apply (metis valid_dpda_to_valid_pda PDA_to_epda)
  apply(rename_tac b C' C'')(*strict*)
  apply(force)
  done

end


(*
 * Copyright 2014, NICTA
 *
 * This software may be distributed and modified according to the terms of
 * the GNU General Public License version 2. Note that NO WARRANTY is provided.
 * See "LICENSE_GPLv2.txt" for details.
 *
 * @TAG(NICTA_GPL)
 *)

theory ExampleSystemPolicyFlows
imports
  Noninterference
  "../access-control/ExampleSystem"
begin

subsection {* Example 1 -- similar to Sys1 in ../access-control/ExampleSystem.thy *}

subsubsection {* Definitions *}

datatype Sys3Labels = UT3 | T3 | EP3 | IRQ3

definition Sys3AuthGraph_aux :: "Sys3Labels subject_label auth_graph"
where
  "Sys3AuthGraph_aux \<equiv>
   { (OrdinaryLabel (UT3), auth.SyncSend, OrdinaryLabel (EP3)),
     (OrdinaryLabel (UT3), auth.Reset, OrdinaryLabel (EP3)),
     (OrdinaryLabel (T3), auth.Receive, OrdinaryLabel (EP3)),
     (OrdinaryLabel (T3), auth.Reset, OrdinaryLabel (EP3)) }"

definition Sys3AuthGraph :: "Sys3Labels subject_label auth_graph"
where
  "Sys3AuthGraph \<equiv> complete_AuthGraph Sys3AuthGraph_aux {OrdinaryLabel (T3),
                                                         OrdinaryLabel (UT3)}"

definition Sys3PolicyFlows :: "(Sys3Labels partition \<times> Sys3Labels partition) set"
where
  "Sys3PolicyFlows \<equiv>
   { (Partition UT3, Partition UT3),
     (Partition UT3, Partition EP3),
     (Partition UT3, Partition T3),
     (Partition T3, Partition T3),
     (Partition T3, Partition UT3),
     (Partition T3, Partition EP3),
     (Partition EP3, Partition UT3),
     (Partition EP3, Partition EP3),
     (Partition EP3, Partition T3),
     (Partition IRQ3, Partition IRQ3),
     (PSched, Partition EP3),
     (PSched, Partition UT3),
     (PSched, Partition T3),
     (PSched, Partition IRQ3),
     (PSched, PSched) }"

subsubsection {* Generalisations *}

definition Sys3Reads where
  "Sys3Reads \<equiv> { (OrdinaryLabel (UT3)), (OrdinaryLabel (EP3)), (OrdinaryLabel (T3)) }"

definition Sys3Affects where
  "Sys3Affects \<equiv> { (OrdinaryLabel (UT3)), (OrdinaryLabel (EP3)), (OrdinaryLabel (T3)) }"

lemma Sys3Reads_correct_fw : "\<lbrakk>x \<in> subjectReads Sys3AuthGraph (OrdinaryLabel (l)); l \<in> {T3, UT3, EP3}\<rbrakk> \<Longrightarrow> x \<in> Sys3Reads"
  apply (induct x rule:subjectReads.induct)
         apply (auto simp:Sys3AuthGraph_def Sys3AuthGraph_aux_def complete_AuthGraph_def Sys3Reads_def)
  done

lemma Sys3Affects_correct_fw : "\<lbrakk>x \<in> subjectAffects Sys3AuthGraph (OrdinaryLabel (l)); l \<in> {T3, UT3}\<rbrakk> \<Longrightarrow> x \<in> Sys3Affects"
  apply (induct x rule:subjectAffects.induct)
        apply (auto simp:Sys3AuthGraph_def Sys3AuthGraph_aux_def complete_AuthGraph_def Sys3Affects_def)
  done

subsubsection {* UT3 *}

lemma Sys3UT3Reads_correct_bw : "x \<in> Sys3Reads \<Longrightarrow> x \<in> subjectReads Sys3AuthGraph (OrdinaryLabel (UT3))"
  apply (simp add: Sys3AuthGraph_def Sys3AuthGraph_aux_def complete_AuthGraph_def Sys3Reads_def)
  apply (erule disjE)
   (* UT3 reads UT3 *)
   apply (simp add: reads_lrefl)
  (* UT3 reads EP3 *)
  apply (erule disjE)
   apply (rule_tac auth = SyncSend in reads_ep)
    apply (simp)
    apply (simp add:insertI1)
  (* UT3 reads T3 *)
  apply (rule_tac auth = SyncSend and ep = "OrdinaryLabel (EP3)" and a = "OrdinaryLabel (UT3)" in read_sync_ep_read_receivers)
     apply (simp)
     apply (simp)
    apply (rule_tac auth = SyncSend in reads_ep)
    apply (simp)
    apply (rule insertI1)
    apply (simp add: insertI1)
  done

lemma Sys3UT3Affects_correct_bw : "x \<in> Sys3Affects \<Longrightarrow> x \<in> subjectAffects Sys3AuthGraph (OrdinaryLabel (UT3))"
  apply (simp add:Sys3AuthGraph_def Sys3AuthGraph_aux_def complete_AuthGraph_def Sys3Affects_def)
  apply (erule disjE)
   (* UT3 affects UT3 *)
   apply (simp add:affects_lrefl)
  (* UT3 affects EP3 *)
  apply (erule disjE)
   apply (rule_tac auth=SyncSend in affects_ep)
    apply simp
   apply (simp add:insertI1)
  (* UT3 affects T3 *)
  apply (rule_tac auth=SyncSend and l' = "OrdinaryLabel (T3)" and ep="OrdinaryLabel (EP3)" in affects_send)
     apply (simp_all add:insertI1)
  done

subsubsection {* T3 *}

lemma Sys3T3Reads_correct_bw : "x \<in> Sys3Reads \<Longrightarrow> x \<in> subjectReads Sys3AuthGraph (OrdinaryLabel (T3))"
  apply (simp add: Sys3AuthGraph_def Sys3AuthGraph_aux_def complete_AuthGraph_def Sys3Reads_def)
  apply (erule disjE)
   (* T3 reads UT3 *)
   apply (rule_tac auth = Receive and ep = "OrdinaryLabel (EP3)" and a = "OrdinaryLabel (T3)" in read_sync_ep_read_senders)
      apply (simp)
     apply (simp)
    apply (rule_tac auth = Receive in reads_ep)
     apply (simp)
     apply (simp add:insertI1)
   apply (simp add: insertI1)
   (* T3 reads EP3 *)
  apply (erule disjE)
  apply (rule_tac auth = Receive in reads_ep)
    apply (simp)
    apply (simp add:insertI1)
   (* T3 reads T3 *)
  apply (simp add: reads_lrefl)
  done

lemma Sys3T3Affects_correct_bw : "x \<in> Sys3Affects \<Longrightarrow> x \<in> subjectAffects Sys3AuthGraph (OrdinaryLabel (T3))"
  apply (simp add:Sys3AuthGraph_def Sys3AuthGraph_aux_def complete_AuthGraph_def Sys3Affects_def)
  apply (erule disjE)
   (* T3 affects UT3 *)
   apply simp
   apply (rule_tac l = "OrdinaryLabel (T3)" and l' = "OrdinaryLabel (UT3)" and ep="OrdinaryLabel (EP3)" in affects_recv)
    apply (simp_all add:insertI1)
  (* T3 affects EP3 *)
  apply (erule disjE)
   apply (rule_tac auth=Receive in affects_ep)
    apply simp
   apply (simp add:insertI1)
  (* T3 affects T3 *)
  apply (simp add:affects_lrefl)
  done

subsubsection {* EP3 *}

definition Sys3EP3Affects :: "(Sys3Labels subject_label) set"
where
  "Sys3EP3Affects \<equiv> { OrdinaryLabel (EP3) }"

lemma Sys3EP3Reads_correct_bw : "x \<in> Sys3Reads \<Longrightarrow> x \<in> subjectReads Sys3AuthGraph (OrdinaryLabel (EP3))"
  apply (simp add: Sys3AuthGraph_def Sys3AuthGraph_aux_def complete_AuthGraph_def Sys3Reads_def)
  apply (erule disjE)
   (* EP3 reads UT3 *)
   apply simp
   apply (rule_tac a = "OrdinaryLabel (T3)" and auth=Receive and ep = "OrdinaryLabel (EP3)" and b = "OrdinaryLabel (UT3)" in read_sync_ep_read_senders)
      apply (simp)
     apply (simp add:insertI1)
    apply (simp add:reads_lrefl)
   apply simp
  (* EP3 reads EP3 *)
  apply (erule disjE)
   apply (simp add: reads_lrefl)
  (* EP3 reads T3 *)
  apply (rule_tac a = "OrdinaryLabel (UT3)" and auth = SyncSend and ep = "OrdinaryLabel (EP3)" and a = "OrdinaryLabel (T3)" in read_sync_ep_read_receivers)
     apply (simp_all add:reads_lrefl)
  done

lemma Sys3EP3Affects_correct_fw : "x \<in> subjectAffects Sys3AuthGraph (OrdinaryLabel (EP3)) \<Longrightarrow> x \<in> Sys3EP3Affects"
  apply (induct x rule:subjectAffects.induct)
        apply (auto simp:Sys3AuthGraph_def Sys3AuthGraph_aux_def complete_AuthGraph_def Sys3EP3Affects_def)
  done

lemma Sys3EP3Affects_correct_bw : "x \<in> Sys3EP3Affects \<Longrightarrow> x \<in> subjectAffects Sys3AuthGraph (OrdinaryLabel (EP3))"
  by (simp add:Sys3AuthGraph_def Sys3AuthGraph_aux_def complete_AuthGraph_def Sys3EP3Affects_def affects_lrefl)

lemma Sys3EP3Affects_correct : "subjectAffects Sys3AuthGraph (OrdinaryLabel (EP3)) = Sys3EP3Affects"
  apply (rule subset_antisym)
   apply (simp_all add:subsetI Sys3EP3Affects_correct_fw Sys3EP3Affects_correct_bw)
  done

subsubsection {* Generalisations pt2 *}

lemma Sys3Reads_correct : "l \<in> {T3, UT3, EP3} \<Longrightarrow> subjectReads Sys3AuthGraph (OrdinaryLabel (l)) = Sys3Reads"
  by (auto simp:subsetI Sys3Reads_correct_fw Sys3UT3Reads_correct_bw Sys3T3Reads_correct_bw Sys3EP3Reads_correct_bw)

lemma Sys3Affects_correct : "l \<in> {T3, UT3} \<Longrightarrow> subjectAffects Sys3AuthGraph (OrdinaryLabel (l)) = Sys3Affects"
  by (auto simp:subsetI Sys3Affects_correct_fw Sys3UT3Affects_correct_bw Sys3T3Affects_correct_bw)

subsubsection {* IRQ3 *}

lemma IRQ3Reads : " d \<in> subjectReads Sys3AuthGraph (OrdinaryLabel (IRQ3)) \<Longrightarrow> d = OrdinaryLabel (IRQ3)"
  apply (simp add: Sys3AuthGraph_def Sys3AuthGraph_aux_def complete_AuthGraph_def)
  apply (induct d rule: subjectReads.induct, auto)
  done

lemma IRQ3Affects : "d \<in> subjectAffects Sys3AuthGraph (OrdinaryLabel (IRQ3)) \<Longrightarrow> d = OrdinaryLabel (IRQ3)"
  apply (simp add: Sys3AuthGraph_def Sys3AuthGraph_aux_def complete_AuthGraph_def)
  apply (induct d rule: subjectAffects.induct, auto)
  done

lemma IRQ3ReadsAndAffects :
  "\<lbrakk> d \<in> subjectAffects Sys3AuthGraph (OrdinaryLabel (l))
   ; d \<in> subjectReads Sys3AuthGraph (OrdinaryLabel (IRQ3))
   \<rbrakk> \<Longrightarrow> l = IRQ3"
  apply (drule IRQ3Reads)
  apply (simp add: Sys3AuthGraph_def Sys3AuthGraph_aux_def complete_AuthGraph_def)
  apply (erule subjectAffects.cases, auto)
  done

subsubsection {* Policy flows *}

lemma Sys3_policyFlows_correct_fw : "(a,b) \<in> policyFlows Sys3AuthGraph \<Longrightarrow> (a,b) \<in> Sys3PolicyFlows"
  apply (induct a b rule:policyFlows.induct)
   apply (simp add:partsSubjectAffects_def label_can_affect_partition_def)
   (* Partition l *)
   apply (erule imageE)
   apply simp
   apply (case_tac "x \<in> {T3, UT3, EP3}")
    (* x in {T3, UT3, EP3} *)
    apply (simp add:Sys3Reads_correct Sys3Reads_def)
    apply (case_tac "l \<in> {T3, UT3}")
     (* l in {T3, UT3} *)
     apply (simp add:Sys3Affects_correct Sys3Affects_def Sys3PolicyFlows_def)
     apply (erule exE)
     apply ((erule disjE)+, simp, simp, simp)+
    (* l not in {T3, UT3} *)
    apply (simp)
    apply (case_tac l)
    apply (simp, simp, simp)
       apply (auto simp:Sys3PolicyFlows_def)[1]
     apply (simp add:Sys3PolicyFlows_def)
    apply (erule exE)
    apply (erule conjE, drule IRQ3Affects)
    apply (blast)
    (* x not in {T3, UT3, EP3} *)
    apply (case_tac x)
    apply (simp, simp, simp, simp)
   apply (erule exE)
   apply (erule conjE)
      apply (frule IRQ3ReadsAndAffects, assumption)
   apply (simp add: Sys3PolicyFlows_def)
   (* PSched *)
   apply (case_tac d, simp add: Sys3PolicyFlows_def)
  apply (rename_tac a)
  apply (case_tac a)
  apply (auto simp: Sys3PolicyFlows_def)
  done

lemma Sys3_policyFlows_correct_bw : "(a,b) \<in> Sys3PolicyFlows \<Longrightarrow> (a,b) \<in> policyFlows Sys3AuthGraph"
  apply (simp add:Sys3PolicyFlows_def)
  (* All UT3/T3 cases *)
  apply (erule disjE, simp, rule policy_affects, simp add: partsSubjectAffects_def label_can_affect_partition_def, rule imageI, simp add: Sys3Affects_correct Sys3Reads_correct Sys3Affects_def Sys3Reads_def, blast)+
  (* All EP3 cases *)
  apply (erule disjE,simp, rule policy_affects, simp add: partsSubjectAffects_def label_can_affect_partition_def, rule imageI, simp add: Sys3EP3Affects_correct Sys3Reads_correct Sys3Reads_def Sys3EP3Affects_def)+
   (* IRQ3 case *)
   apply (rule_tac x = "OrdinaryLabel (IRQ3)" in exI)
   apply (rule conjI)
   apply (rule affects_lrefl)
  apply (rule reads_lrefl)
  (* All PSched cases *)
  apply (erule disjE, simp add: PSched_flows_to_all)+
  apply (simp add: PSched_flows_to_all)
  done

lemma Sys3_policyFlows_correct : "policyFlows Sys3AuthGraph = Sys3PolicyFlows"
  by (auto simp:Sys3_policyFlows_correct_fw Sys3_policyFlows_correct_bw)

end


section {* Timed Designs *}

theory utp_time_designs
  imports utp_time_rel
begin

named_theorems td_simps and tdes

text {* We define timed designs via an embedding into reactive designs, where the pericondition
  is simply false: an instantaneous reactive design. The healthiness condition is therefore
  simply @{term ISRD}.  This allows us to reuse much of the infrastructure. *}

type_synonym 's tdes = "('s, real pos) rdes"

definition time_design :: "'s tdes \<Rightarrow> 's tdes \<Rightarrow> 's tdes" (infixl "\<turnstile>\<^sub>t" 60) where
[upred_defs]: "time_design P Q = \<^bold>R\<^sub>s(P \<turnstile> false \<diamondop> Q)"

abbreviation time_skip :: "'s tdes" ("II\<^sub>t") where
"II\<^sub>t \<equiv> II\<^sub>R"

definition time_wait :: "(real pos, 's) uexpr \<Rightarrow> 's tdes" ("wait\<^sub>t") where
[upred_defs, td_simps]: "wait\<^sub>t(n) = true\<^sub>r \<turnstile>\<^sub>t wait\<^sub>r(n)"

abbreviation time_pre :: "'s tdes \<Rightarrow> 's tdes" ("pre\<^sub>t") where
"pre\<^sub>t(P) \<equiv> pre\<^sub>R(P)"

abbreviation time_post :: "'s tdes \<Rightarrow> 's tdes" ("post\<^sub>t") where
"post\<^sub>t(P) \<equiv> post\<^sub>R(P)"

lemma pre_time_design [tdes]:
  assumes "P is RC" "Q is RR"
  shows "pre\<^sub>t(P \<turnstile>\<^sub>t Q) = P"
  by (simp add: time_design_def rdes assms closure)

lemma post_time_design [tdes]:
  assumes "P is RC" "Q is RR"
  shows "post\<^sub>t(P \<turnstile>\<^sub>t Q) = (P \<Rightarrow>\<^sub>r Q)"
  by (simp add: time_design_def rdes assms closure)

definition TD :: "'s tdes \<Rightarrow> 's tdes" where
[upred_defs]: "TD = ISRD"

lemma TD_implies_ISRD [closure]: "P is TD \<Longrightarrow> P is ISRD"
  by (simp add: TD_def)

lemma TD_elim: "\<lbrakk> P is TD; Q(pre\<^sub>t(P) \<turnstile>\<^sub>t post\<^sub>t(P)) \<rbrakk> \<Longrightarrow> Q(P)"
  by (simp add: TD_def time_design_def ISRD_elim)

thm RHS_tri_normal_design_composition'

lemma skip_time_design [td_simps]:
  "II\<^sub>t = true\<^sub>r \<turnstile>\<^sub>t II\<^sub>r"
  by (simp add: rdes_def time_design_def)

lemma seq_time_design [td_simps]:
  assumes "P\<^sub>1 is RC" "P\<^sub>2 is RR" "Q\<^sub>1 is RC" "Q\<^sub>2 is RR"
  shows "(P\<^sub>1 \<turnstile>\<^sub>t P\<^sub>2) ;; (Q\<^sub>1 \<turnstile>\<^sub>t Q\<^sub>2) = (P\<^sub>1 \<and> P\<^sub>2 wp\<^sub>R Q\<^sub>1) \<turnstile>\<^sub>t P\<^sub>2 ;; Q\<^sub>2"
  by (simp add: time_design_def RHS_tri_normal_design_composition' assms closure unrest)

lemma time_design_eq_intro: "\<lbrakk> P\<^sub>1 = Q\<^sub>1; (P\<^sub>1 \<Rightarrow>\<^sub>r P\<^sub>2) = (Q\<^sub>1 \<Rightarrow>\<^sub>r Q\<^sub>2) \<rbrakk> \<Longrightarrow> (P\<^sub>1 \<turnstile>\<^sub>t P\<^sub>2) = (Q\<^sub>1 \<turnstile>\<^sub>t Q\<^sub>2)"
  by (rel_auto, blast+)

lemma time_design_refine_intro:
  assumes "`P\<^sub>1 \<Rightarrow> Q\<^sub>1`" "`P\<^sub>1 \<and> Q\<^sub>2 \<Rightarrow> P\<^sub>2`"
  shows "(P\<^sub>1 \<turnstile>\<^sub>t P\<^sub>2) \<sqsubseteq> (Q\<^sub>1 \<turnstile>\<^sub>t Q\<^sub>2)"
  by (simp add: time_design_def srdes_tri_refine_intro assms)

method td_expand uses cls = (insert cls, (erule TD_elim)+)

method td_simp uses cls =
  ((td_expand cls: cls)?, (simp add: cls td_simps closure rpred alpha usubst unrest wp prod.case_eq_if))

method td_refine uses cls =
  (td_simp cls: cls; rule_tac time_design_refine_intro; (insert cls; rel_simp; auto?))

method td_eq uses cls =
  (td_simp cls: cls; rule_tac time_design_eq_intro; (insert cls; rel_simp; auto?))

lemma time_skip_left_unit [simp]:
  assumes "P is TD"
  shows "II\<^sub>t ;; P = P"
  by (td_simp cls: assms)

lemma time_skip_right_unit [simp]:
  assumes "P is TD"
  shows "P ;; II\<^sub>t = P"
  by (td_simp cls: assms)

lemma time_wait_0 [simp]: "wait\<^sub>t(0) = II\<^sub>t"
  by (td_simp, simp add: wait_zero)

lemma time_wait_seq [simp]: "wait\<^sub>t(m) ;; wait\<^sub>t(n) = wait\<^sub>t(m + n)"
  by (td_simp, simp add: wait_plus)

definition time_spec :: "('a \<Longrightarrow> 's) \<Rightarrow> 's upred \<Rightarrow> real pos \<Rightarrow> 's upred \<Rightarrow> real pos set \<Rightarrow> 's tdes" where
[upred_defs]: "time_spec x p t\<^sub>0 r T = ([p]\<^sub>S\<^sub>< \<and> R1(&tt <\<^sub>u \<guillemotleft>t\<^sub>0\<guillemotright>) \<triangleleft> \<guillemotleft>t\<^sub>0 = 0\<guillemotright> \<triangleright>\<^sub>R true\<^sub>r) \<turnstile>\<^sub>t ([x:[\<lceil>r\<rceil>\<^sub>>]]\<^sub>S \<and> R1(&tt \<in>\<^sub>u \<guillemotleft>T\<guillemotright>))"

syntax
  "_time_spec" :: "salpha \<Rightarrow> logic \<Rightarrow> logic \<Rightarrow> logic \<Rightarrow> logic \<Rightarrow> logic" ("_:[_, _ \<turnstile> _, _]\<^sub>t" [200,0,0,0,0] 200)

translations
  "_time_spec x p t\<^sub>0 r T" == "CONST time_spec x p t\<^sub>0 r T"

lemma srd_cond_true [simp]: "P \<triangleleft> true \<triangleright>\<^sub>R Q = P"
  by (rel_auto)

lemma srd_cond_false [simp]: "P \<triangleleft> false \<triangleright>\<^sub>R Q = Q"
  by (rel_auto)

lemma tt_strict_prefix_RR [closure]: "R1(&tt <\<^sub>u \<guillemotleft>v\<guillemotright>) is RC"
  by (rel_auto, meson le_less_trans minus_cancel_le)

lemma tt_elem_RR [closure]: "R1(&tt \<in>\<^sub>u \<guillemotleft>T\<guillemotright>) is RR"
  by (rel_auto)

lemma time_spec_TD_closed: "x:[p,t\<^sub>0 \<turnstile> r,T]\<^sub>t is TD"
  apply (simp add: TD_def time_spec_def time_design_def)
  apply (case_tac "t\<^sub>0 = 0")
  apply (simp_all add: true_alt_def[THEN sym] false_alt_def[THEN sym] closure unrest rdes)
done

definition hoare_time :: "'s upred \<Rightarrow> real pos \<Rightarrow> 's tdes \<Rightarrow> 's upred \<Rightarrow> real pos set \<Rightarrow> bool" where
[td_simps]: "hoare_time p t\<^sub>0 Q r T = (\<Sigma>:[p,t\<^sub>0 \<turnstile> r,T]\<^sub>t \<sqsubseteq> Q)"

syntax
  "_time_var" :: "logic"
  "_hoare_time" :: "logic \<Rightarrow> logic \<Rightarrow> logic \<Rightarrow> logic" ("\<lbrace>_\<rbrace>/ _/ \<lbrace>_\<rbrace>\<^sub>t")

parse_translation {*
let
  fun time_var_tr [] = Syntax.free "ti"
    | time_var_tr _  = raise Match;
in
[(@{syntax_const "_time_var"}, K time_var_tr)]
end
*}

translations
  "_hoare_time p Q r" => "CONST hoare_time p Q (\<lambda> _time_var. r)"

end


theory Labeled_Graphs
  imports TA_Library.Graphs \<^cancel>\<open>"Transition_Systems_and_Automata.Sequence_LTL"\<close>
begin

locale Graph_Defs =
  fixes E :: "'a \<Rightarrow> 'l \<Rightarrow> 'a \<Rightarrow> bool"
begin

abbreviation "E\<^sub>u \<equiv> \<lambda>a b. \<exists> l. E a l b"

sublocale UL: Graphs.Graph_Defs E\<^sub>u .

end

locale Simulation_Defs =
  fixes A :: "'a \<Rightarrow> 'l \<Rightarrow> 'a \<Rightarrow> bool" and B :: "'b \<Rightarrow> 'l \<Rightarrow> 'b \<Rightarrow> bool"
    and sim :: "'a \<Rightarrow> 'b \<Rightarrow> bool" (infixr "\<sim>" 60)
begin

sublocale A: Graph_Defs A .

sublocale B: Graph_Defs B .

sublocale UL: Graphs.Simulation_Defs A.E\<^sub>u B.E\<^sub>u sim .

end

locale Simulation = Simulation_Defs +
  assumes A_B_step: "\<And> l a b a'. A a l b \<Longrightarrow> a \<sim> a' \<Longrightarrow> (\<exists> b'. B a' l b' \<and> b \<sim> b')"
begin

\<^cancel>\<open>lemma simulation_reaches:
  "\<exists> b'. B\<^sup>*\<^sup>* b l b' \<and> a' \<sim> b'" if "A\<^sup>*\<^sup>* a l a'" "a \<sim> b"
  using that by (induction rule: rtranclp_induct) (auto intro: rtranclp.intros(2) dest: A_B_step)

lemma simulation_reaches1:
  "\<exists> b'. B\<^sup>+\<^sup>+ b b' \<and> a' \<sim> b'" if "A\<^sup>+\<^sup>+ a a'" "a \<sim> b"
  using that by (induction rule: tranclp_induct) (auto 4 3 intro: tranclp.intros(2) dest: A_B_step)

lemma simulation_steps:
  "\<exists> bs. B.steps (b # bs) \<and> list_all2 (\<lambda> a b. a \<sim> b) as bs" if "A.steps (a # as)" "a \<sim> b"
  using that
  apply (induction "a # as" arbitrary: a b as)
   apply force
  apply (frule A_B_step, auto)
  done

lemma simulation_run:
  "\<exists> ys. B.run (y ## ys) \<and> stream_all2 (\<sim>) xs ys" if "A.run (x ## xs)" "x \<sim> y"
proof -
  let ?ys = "sscan (\<lambda> a' b. SOME b'. B b b' \<and> a' \<sim> b') xs y"
  have "B.run (y ## ?ys)"
    using that by (coinduction arbitrary: x y xs) (force dest!: someI_ex A_B_step elim: A.run.cases)
  moreover have "stream_all2 (\<sim>) xs ?ys"
    using that by (coinduction arbitrary: x y xs) (force dest!: someI_ex A_B_step elim: A.run.cases)
  ultimately show ?thesis by blast
qed\<close>

sublocale UL: Graphs.Simulation A.E\<^sub>u B.E\<^sub>u sim
  by standard (blast dest: A_B_step)

end (* Simulation *)

locale Graph_Invariant = Graph_Defs +
  fixes P :: "'a \<Rightarrow> bool"
  assumes invariant: "P a \<Longrightarrow> E a l b \<Longrightarrow> P b"
begin

sublocale UL: Graphs.Graph_Invariant E\<^sub>u
  by standard (blast dest: invariant)

\<^cancel>\<open>lemma invariant_steps:
  "list_all P as" if "steps (a # as)" "P a"
  using that by (induction "a # as" arbitrary: as a) (auto intro: invariant)

lemma invariant_reaches:
  "P b" if "a \<rightarrow>* b" "P a"
  using that by (induction; blast intro: invariant)

lemma invariant_run:
  assumes run: "run (x ## xs)" and P: "P x"
  shows "pred_stream P (x ## xs)"
  using run P by (coinduction arbitrary: x xs) (auto 4 3 elim: invariant run.cases)

text \<open>Every graph invariant induces a subgraph.\<close>
sublocale Subgraph_Node_Defs where E = E and V = P .

lemma subgraph':
  assumes "x \<rightarrow> y" "P x"
  shows "E' x y"
  using assms by (intro subgraph') (auto intro: invariant)

lemma invariant_steps_iff:
  "G'.steps (v # vs) \<longleftrightarrow> steps (v # vs)" if "P v"
  apply (rule iffI)
  subgoal
    using G'.steps_alt_induct steps_appendI by blast
  subgoal premises prems
    using prems \<open>P v\<close> by (induction "v # vs" arbitrary: v vs) (auto intro: subgraph' invariant)
  done

lemma invariant_reaches_iff:
  "G'.reaches u v \<longleftrightarrow> reaches u v" if "P u"
  using that by (simp add: reaches_steps_iff2 G'.reaches_steps_iff2 invariant_steps_iff)

lemma invariant_reaches1_iff:
  "G'.reaches1 u v \<longleftrightarrow> reaches1 u v" if "P u"
  using that by (simp add: reaches1_steps_iff G'.reaches1_steps_iff invariant_steps_iff)\<close>

end (* Graph Invariant *)

locale Graph_Invariants = Graph_Defs +
  fixes P Q :: "'a \<Rightarrow> bool"
  assumes invariant: "P a \<Longrightarrow> E a l b \<Longrightarrow> Q b" and Q_P: "Q a \<Longrightarrow> P a"
begin

sublocale Pre: Graph_Invariant E P
  by standard (blast intro: invariant Q_P)

sublocale Post: Graph_Invariant E Q
  by standard (blast intro: invariant Q_P)

\<^cancel>\<open>
lemma invariant_steps:
  "list_all Q as" if "steps (a # as)" "P a"
  using that by (induction "a # as" arbitrary: as a) (auto intro: invariant Q_P)

lemma invariant_run:
  assumes run: "run (x ## xs)" and P: "P x"
  shows "pred_stream Q xs"
  using run P by (coinduction arbitrary: x xs) (auto 4 4 elim: invariant run.cases intro: Q_P)

lemma invariant_reaches1:
  "Q b" if "a \<rightarrow>\<^sup>+ b" "P a"
  using that by (induction; blast intro: invariant Q_P)\<close>

end (* Graph Invariants *)

locale Simulation_Invariant = Simulation_Defs A B sim
  for A :: "'a \<Rightarrow> 'l \<Rightarrow> 'a \<Rightarrow> bool"
  and B :: "'b \<Rightarrow> 'l \<Rightarrow> 'b \<Rightarrow> bool"
  and sim :: "'a \<Rightarrow> 'b \<Rightarrow> bool" (infixr "\<sim>" 60) +
  fixes PA :: "'a \<Rightarrow> bool" and PB :: "'b \<Rightarrow> bool"
  assumes A_B_step:
    "\<And> l a b a'. A a l b \<Longrightarrow> PA a \<Longrightarrow> PB a' \<Longrightarrow> a \<sim> a' \<Longrightarrow> (\<exists>b'. B a' l b' \<and> b \<sim> b')"
  assumes A_invariant[intro]: "\<And> l a b. PA a \<Longrightarrow> A a l b \<Longrightarrow> PA b"
  assumes B_invariant[intro]: "\<And> l a b. PB a \<Longrightarrow> B a l b \<Longrightarrow> PB b"
begin

definition "equiv' \<equiv> \<lambda> a b. a \<sim> b \<and> PA a \<and> PB b"

sublocale Simulation A B equiv' by standard (auto dest: A_B_step simp: equiv'_def)

sublocale PA_invariant: Graph_Invariant A PA by standard blast

sublocale PB_invariant: Graph_Invariant B PB by standard blast

\<^cancel>\<open>lemma simulation_reaches:
  "\<exists> b'. B\<^sup>*\<^sup>* b b' \<and> a' \<sim> b' \<and> PA a' \<and> PB b'" if "A\<^sup>*\<^sup>* a a'" "a \<sim> b" "PA a" "PB b"
  using simulation_reaches[of a a' b] that unfolding equiv'_def by simp

lemma simulation_steps:
  "\<exists> bs. B.steps (b # bs) \<and> list_all2 (\<lambda> a b. a \<sim> b \<and> PA a \<and> PB b) as bs"
  if "A.steps (a # as)" "a \<sim> b" "PA a" "PB b"
  using simulation_steps[of a as b] that unfolding equiv'_def by simp

lemma simulation_steps':
  "\<exists> bs. B.steps (b # bs) \<and> list_all2 (\<lambda> a b. a \<sim> b) as bs \<and> list_all PA as \<and> list_all PB bs"
  if "A.steps (a # as)" "a \<sim> b" "PA a" "PB b"
  using simulation_steps[OF that]
  by (force dest: list_all2_set1 list_all2_set2 simp: list_all_iff elim: list_all2_mono)

context
  fixes f
  assumes eq: "a \<sim> b \<Longrightarrow> b = f a"
begin

lemma simulation_steps'_map:
  "\<exists> bs.
    B.steps (b # bs) \<and> bs = map f as
    \<and> list_all2 (\<lambda> a b. a \<sim> b) as bs
    \<and> list_all PA as \<and> list_all PB bs"
  if "A.steps (a # as)" "a \<sim> b" "PA a" "PB b"
proof -
  from simulation_steps'[OF that] obtain bs where guessed:
    "B.steps (b # bs)"
    "list_all2 (\<sim>) as bs"
    "list_all PA as"
    "list_all PB bs"
    by safe
  from this(2) have "bs = map f as"
    by (induction; simp add: eq)
  with guessed show ?thesis
    by auto
qed\<close>

\<^cancel>\<open>end (* Context for Equality Relation *)\<close>

end (* Simulation Invariant *)

locale Simulation_Invariants = Simulation_Defs A B sim
  for A :: "'a \<Rightarrow> 'l \<Rightarrow> 'a \<Rightarrow> bool"
  and B :: "'b \<Rightarrow> 'l \<Rightarrow> 'b \<Rightarrow> bool"
  and sim :: "'a \<Rightarrow> 'b \<Rightarrow> bool" (infixr "\<sim>" 60) +
  fixes PA QA :: "'a \<Rightarrow> bool" and PB QB :: "'b \<Rightarrow> bool"
  assumes A_B_step:
    "\<And> a b l a'. A a l b \<Longrightarrow> PA a \<Longrightarrow> PB a' \<Longrightarrow> a \<sim> a' \<Longrightarrow> (\<exists> b'. B a' l b' \<and> b \<sim> b')"
  assumes A_invariant[intro]: "\<And> a b. PA a \<Longrightarrow> A a l b \<Longrightarrow> QA b"
  assumes B_invariant[intro]: "\<And> a b. PB a \<Longrightarrow> B a l b \<Longrightarrow> QB b"
  assumes PA_QA[intro]: "\<And> a. QA a \<Longrightarrow> PA a" and PB_QB[intro]: "\<And> a. QB a \<Longrightarrow> PB a"
begin
print_locale Simulation_Invariant
sublocale Pre: Simulation_Invariant A B "(\<sim>)" PA PB
  by standard (auto intro: A_B_step)

sublocale Post: Simulation_Invariant A B "(\<sim>)" QA QB
  by standard (auto intro: A_B_step)

sublocale A_invs: Graph_Invariants A PA QA
  by standard auto

sublocale B_invs: Graph_Invariants B PB QB
  by standard auto

\<^cancel>\<open>lemma simulation_reaches1:
  "\<exists> b2. B.reaches1 b1 b2 \<and> a2 \<sim> b2 \<and> QB b2" if "A.reaches1 a1 a2" "a1 \<sim> b1" "PA a1" "PB b1"
  using that
  by - (drule Pre.simulation_reaches1, auto intro: B_invs.invariant_reaches1 simp: Pre.equiv'_def)

lemma reaches1_unique:
  assumes unique: "\<And> b2. a \<sim> b2 \<Longrightarrow> QB b2 \<Longrightarrow> b2 = b"
    and that: "A.reaches1 a a" "a \<sim> b" "PA a" "PB b"
  shows "B.reaches1 b b"
  using that by (auto dest: unique simulation_reaches1)\<close>

end (* Simualation Invariants *)

locale Bisimulation = Simulation_Defs +
  assumes A_B_step: "\<And> l a b a'. A a l b \<Longrightarrow> a \<sim> a' \<Longrightarrow> (\<exists> b'. B a' l b' \<and> b \<sim> b')"
  assumes B_A_step: "\<And> l a a' b'. B a' l b' \<Longrightarrow> a \<sim> a' \<Longrightarrow> (\<exists> b. A a l b \<and> b \<sim> b')"
begin

sublocale A_B: Simulation A B "(\<sim>)" by standard (rule A_B_step)

sublocale B_A: Simulation B A "\<lambda> x y. y \<sim> x" by standard (rule B_A_step)

\<^cancel>\<open>lemma A_B_reaches:
  "\<exists> b'. B\<^sup>*\<^sup>* b b' \<and> a' \<sim> b'" if "A\<^sup>*\<^sup>* a a'" "a \<sim> b"
  using A_B.simulation_reaches[OF that] .

lemma B_A_reaches:
  "\<exists> b'. A\<^sup>*\<^sup>* b b' \<and> b' \<sim> a'" if "B\<^sup>*\<^sup>* a a'" "b \<sim> a"
  using B_A.simulation_reaches[OF that] .\<close>

end (* Bisim *)

locale Bisimulation_Invariant = Simulation_Defs A B sim
  for A :: "'a \<Rightarrow> 'l \<Rightarrow> 'a \<Rightarrow> bool"
  and B :: "'b \<Rightarrow> 'l \<Rightarrow> 'b \<Rightarrow> bool"
  and sim :: "'a \<Rightarrow> 'b \<Rightarrow> bool" (infixr "\<sim>" 60) +
  fixes PA :: "'a \<Rightarrow> bool" and PB :: "'b \<Rightarrow> bool"
  assumes A_B_step: "\<And> l a b a'. A a l b \<Longrightarrow> a \<sim> a' \<Longrightarrow> PA a \<Longrightarrow> PB a' \<Longrightarrow> (\<exists> b'. B a' l b' \<and> b \<sim> b')"
  assumes B_A_step: "\<And> l a a' b'. B a' l b' \<Longrightarrow> a \<sim> a' \<Longrightarrow> PA a \<Longrightarrow> PB a' \<Longrightarrow> (\<exists> b. A a l b \<and> b \<sim> b')"
  assumes A_invariant[intro]: "\<And> l a b. PA a \<Longrightarrow> A a l b \<Longrightarrow> PA b"
  assumes B_invariant[intro]: "\<And> l a b. PB a \<Longrightarrow> B a l b \<Longrightarrow> PB b"
begin

sublocale PA_invariant: Graph_Invariant A PA by standard blast

sublocale PB_invariant: Graph_Invariant B PB by standard blast

\<^cancel>\<open>lemmas B_steps_invariant[intro] = PB_invariant.invariant_reaches\<close>

definition "equiv' \<equiv> \<lambda> a b. a \<sim> b \<and> PA a \<and> PB b"

sublocale bisim: Bisimulation A B equiv'
  by standard (clarsimp simp add: equiv'_def, frule A_B_step B_A_step, assumption; auto)+

sublocale A_B: Simulation_Invariant A B "(\<sim>)" PA PB
  by (standard; blast intro: A_B_step B_A_step)

sublocale B_A: Simulation_Invariant B A "\<lambda> x y. y \<sim> x" PB PA
  by (standard; blast intro: A_B_step B_A_step)

\<^cancel>\<open>context
  fixes f
  assumes eq: "a \<sim> b \<longleftrightarrow> b = f a"
    and inj: "\<forall> a b. PB (f a) \<and> PA b \<and> f a = f b \<longrightarrow> a = b"
begin

lemma list_all2_inj_map_eq:
  "as = bs" if "list_all2 (\<lambda>a b. a = f b) (map f as) bs" "list_all PB (map f as)" "list_all PA bs"
  using that inj
  by (induction "map f as" bs arbitrary: as rule: list_all2_induct) (auto simp: inj_on_def)

lemma steps_map_equiv:
  "A.steps (a # as) \<longleftrightarrow> B.steps (b # map f as)" if "a \<sim> b" "PA a" "PB b"
  using A_B.simulation_steps'_map[of f a as b] B_A.simulation_steps'[of b "map f as" a] that eq
  by (auto dest: list_all2_inj_map_eq)

lemma steps_map:
  "\<exists> as. bs = map f as" if "B.steps (f a # bs)" "PA a" "PB (f a)"
proof -
  have "a \<sim> f a" unfolding eq ..
  from B_A.simulation_steps'[OF that(1) this \<open>PB _\<close> \<open>PA _\<close>] obtain as where
    "A.steps (a # as)"
    "list_all2 (\<lambda>a b. b \<sim> a) bs as"
    "list_all PB bs"
    "list_all PA as"
    by safe
  from this(2) show ?thesis
    unfolding eq by (inst_existentials as, induction rule: list_all2_induct, auto)
qed

lemma reaches_equiv:
  "A.reaches a a' \<longleftrightarrow> B.reaches (f a) (f a')" if "PA a" "PB (f a)"
  apply safe
   apply (drule A_B.simulation_reaches[of a a' "f a"]; simp add: eq that)
  apply (drule B_A.simulation_reaches)
     defer
     apply (rule that | clarsimp simp: eq | metis inj)+
  done

end (* Context for Equality Relation *)\<close>

lemma equiv'_D:
  "a \<sim> b" if "A_B.equiv' a b"
  using that unfolding A_B.equiv'_def by auto

lemma equiv'_rotate_1:
  "B_A.equiv' b a" if "A_B.equiv' a b"
  using that by (auto simp: B_A.equiv'_def A_B.equiv'_def)

lemma equiv'_rotate_2:
  "A_B.equiv' a b" if "B_A.equiv' b a"
  using that by (auto simp: B_A.equiv'_def A_B.equiv'_def)

lemma stream_all2_equiv'_D:
  "stream_all2 (\<sim>) xs ys" if "stream_all2 A_B.equiv' xs ys"
  using stream_all2_weaken[OF that equiv'_D] by fast

lemma stream_all2_equiv'_D2:
  "stream_all2 B_A.equiv' ys xs \<Longrightarrow> stream_all2 ((\<sim>)\<inverse>\<inverse>) ys xs"
  by (coinduction arbitrary: xs ys) (auto simp: B_A.equiv'_def)

lemma stream_all2_rotate_1:
  "stream_all2 B_A.equiv' ys xs \<Longrightarrow> stream_all2 A_B.equiv' xs ys"
  by (coinduction arbitrary: xs ys) (auto simp: B_A.equiv'_def A_B.equiv'_def)

lemma stream_all2_rotate_2:
  "stream_all2 A_B.equiv' xs ys \<Longrightarrow> stream_all2 B_A.equiv' ys xs"
  by (coinduction arbitrary: xs ys) (auto simp: B_A.equiv'_def A_B.equiv'_def)

end (* Bisim Invariant *)

lemma Bisimulation_Invariant_composition:
  assumes
    "Bisimulation_Invariant A B sim1 PA PB"
    "Bisimulation_Invariant B C sim2 PB PC"
  shows
    "Bisimulation_Invariant A C (\<lambda> a c. \<exists> b. PB b \<and> sim1 a b \<and> sim2 b c) PA PC"
proof -
  interpret A: Bisimulation_Invariant A B sim1 PA PB
    by (rule assms(1))
  interpret B: Bisimulation_Invariant B C sim2 PB PC
    by (rule assms(2))
  show ?thesis
    by (standard; (blast dest: A.A_B_step B.A_B_step | blast dest: A.B_A_step B.B_A_step))
qed

lemma Bisimulation_Invariant_filter:
  assumes
    "Bisimulation_Invariant A B sim PA PB"
    "\<And> l a b. sim a b \<Longrightarrow> PA a \<Longrightarrow> PB b \<Longrightarrow> FA a \<longleftrightarrow> FB b"
    "\<And> l a b. A a l b \<and> FA b \<longleftrightarrow> A' a l b"
    "\<And> l a b. B a l b \<and> FB b \<longleftrightarrow> B' a l b"
  shows
    "Bisimulation_Invariant A' B' sim PA PB"
proof -
  interpret Bisimulation_Invariant A B sim PA PB
    by (rule assms(1))
  have unfold:
    "A' = (\<lambda> a l b. A a l b \<and> FA b)" "B' = (\<lambda> a l b. B a l b \<and> FB b)"
    using assms(3,4) by auto
  show ?thesis
    unfolding unfold
    apply standard
    using assms(2) apply (blast dest: A_B_step)
    using assms(2) apply (blast dest: B_A_step)
    by blast+
qed

lemma Bisimulation_Invariant_strengthen_post:
  assumes
    "Bisimulation_Invariant A B sim PA PB"
    "\<And> l a b. PA' a \<Longrightarrow> PA b \<Longrightarrow> A a l b \<Longrightarrow> PA' b"
    "\<And> a. PA' a \<Longrightarrow> PA a"
  shows "Bisimulation_Invariant A B sim PA' PB"
proof -
  interpret Bisimulation_Invariant A B sim PA PB
    by (rule assms)
  show ?thesis
    by (standard; blast intro: A_B_step B_A_step assms)
qed

lemma Bisimulation_Invariant_strengthen_post':
  assumes
    "Bisimulation_Invariant A B sim PA PB"
    "\<And> l a b. PB' a \<Longrightarrow> PB b \<Longrightarrow> B a l b \<Longrightarrow> PB' b"
    "\<And> a. PB' a \<Longrightarrow> PB a"
  shows "Bisimulation_Invariant A B sim PA PB'"
proof -
  interpret Bisimulation_Invariant A B sim PA PB
    by (rule assms)
  show ?thesis
    by (standard; blast intro: A_B_step B_A_step assms)
qed

lemma Simulation_Invariant_strengthen_post:
  assumes
    "Simulation_Invariant A B sim PA PB"
    "\<And> l a b. PA a \<Longrightarrow> PA b \<Longrightarrow> A a l b \<Longrightarrow> PA' b"
    "\<And> a. PA' a \<Longrightarrow> PA a"
  shows "Simulation_Invariant A B sim PA' PB"
proof -
  interpret Simulation_Invariant A B sim PA PB
    by (rule assms)
  show ?thesis
    by (standard; blast intro: A_B_step assms)
qed

lemma Simulation_Invariant_strengthen_post':
  assumes
    "Simulation_Invariant A B sim PA PB"
    "\<And> l a b. PB a \<Longrightarrow> PB b \<Longrightarrow> B a l b \<Longrightarrow> PB' b"
    "\<And> a. PB' a \<Longrightarrow> PB a"
  shows "Simulation_Invariant A B sim PA PB'"
proof -
  interpret Simulation_Invariant A B sim PA PB
    by (rule assms)
  show ?thesis
    by (standard; blast intro: A_B_step assms)
qed

lemma Simulation_Invariants_strengthen_post:
  assumes
    "Simulation_Invariants A B sim PA QA PB QB"
    "\<And> l a b. PA a \<Longrightarrow> QA b \<Longrightarrow> A a l b \<Longrightarrow> QA' b"
    "\<And> a. QA' a \<Longrightarrow> QA a"
  shows "Simulation_Invariants A B sim PA QA' PB QB"
proof -
  interpret Simulation_Invariants A B sim PA QA PB QB
    by (rule assms)
  show ?thesis
    by (standard; blast intro: A_B_step assms)
qed

lemma Bisimulation_Invariant_sim_replace:
  assumes "Bisimulation_Invariant A B sim PA PB"
      and "\<And> a b. PA a \<Longrightarrow> PB b \<Longrightarrow> sim a b \<longleftrightarrow> sim' a b"
    shows "Bisimulation_Invariant A B sim' PA PB"
proof -
  interpret Bisimulation_Invariant A B sim PA PB
    by (rule assms(1))
  from assms(2) show ?thesis
    apply unfold_locales
    using assms(2) apply (blast dest: A_B_step)
    using assms(2) apply (blast dest: B_A_step)
    by blast+
qed

lemma (in Bisimulation) Bisimulation_Bisimulation_Invariant:
  shows "Bisimulation_Invariant A B sim (\<lambda>_. True) (\<lambda>_. True)"
  by standard (auto intro: A_B_step B_A_step)

lemma Simulation_Invariant_composition:
  assumes
    "Simulation_Invariant A B sim1 PA PB"
    "Simulation_Invariant B C sim2 PB PC"
  shows
    "Simulation_Invariant A C (\<lambda> a c. \<exists> b. PB b \<and> sim1 a b \<and> sim2 b c) PA PC"
proof -
  interpret A: Simulation_Invariant A B sim1 PA PB
    by (rule assms(1))
  interpret B: Simulation_Invariant B C sim2 PB PC
    by (rule assms(2))
  show ?thesis
    by (standard; (blast dest: A.A_B_step B.A_B_step))
qed

lemma (in Simulation) Simulation_Invariant:
  "Simulation_Invariant A B sim (\<lambda>_. True) (\<lambda>_. True)"
  by unfold_locales (rule A_B_step)

lemma Simulation_Invariant_sim_replace:
  assumes "Simulation_Invariant A B sim PA PB"
      and "\<And> a b. PA a \<Longrightarrow> PB b \<Longrightarrow> sim a b \<longleftrightarrow> sim' a b"
    shows "Simulation_Invariant A B sim' PA PB"
proof -
  interpret Simulation_Invariant A B sim PA PB
    by (rule assms(1))
  from assms(2) show ?thesis
    by (unfold_locales; blast dest: A_B_step)
qed

end


header {* \isaheader{Dynamic Weak Control Dependence} *}

theory DynWeakControlDependence imports Postdomination begin

context StrongPostdomination begin

definition
  dyn_weak_control_dependence :: "'node \<Rightarrow> 'node \<Rightarrow> 'edge list \<Rightarrow> bool"
  ("_ weakly controls _ via _" [51,0,0])
where dyn_weak_control_dependence_def:"n weakly controls n' via as \<equiv>
    (\<exists>a a' as'. (as = a#as') \<and> (n' \<notin> set(sourcenodes as)) \<and> (n -as\<rightarrow>* n') \<and>
                   (n' strongly-postdominates (targetnode a)) \<and>
                   (valid_edge a') \<and> (sourcenode a' = n) \<and>
                   (\<not> n' strongly-postdominates (targetnode a')))"

lemma Exit_not_dyn_weak_control_dependent:
  assumes control:"n weakly controls (_Exit_) via as" shows "False"
proof -
  from control obtain as a as' where path:"n -as\<rightarrow>* (_Exit_)" and as:"as = a#as'"
    and pd:"(_Exit_) postdominates (targetnode a)"
    by(auto simp:dyn_weak_control_dependence_def strong_postdominate_def)
  from path as have "n -[]@a#as'\<rightarrow>* (_Exit_)" by simp
  hence "valid_edge a" by(fastforce dest:path_split)
  with pd show False by -(rule Exit_no_postdominator,auto)
qed

end

end