section Executions

text \<open>This section contains all definitions required for reasoning about executions in the concurrent
  revisions model. It also contains a number of proofs for inductive variants. One of these
  proves the equivalence of the two definitions of the operational semantics. The others are
  required for proving determinacy.\<close>

theory Executions
  imports OperationalSemantics
begin

context substitution
begin

subsection \<open>Generalizing the original transition\<close>

subsubsection Definition

definition steps :: "('r,'l,'v) global_state rel" ("[\<leadsto>]") where
  "steps = { (s,s') | s s'. \<exists>r. revision_step r s s' }"

abbreviation valid_step :: "('r,'l,'v) global_state \<Rightarrow> ('r,'l,'v) global_state \<Rightarrow> bool" (infix "\<leadsto>" 60) where
  "s \<leadsto> s' \<equiv> (s,s') \<in> [\<leadsto>]"

lemma valid_stepI [intro]:
  "revision_step r s s' \<Longrightarrow> s \<leadsto> s'"
  using steps_def by auto

lemma valid_stepE [dest]:
  "s \<leadsto> s' \<Longrightarrow> \<exists>r. revision_step r s s'"
  by (simp add: steps_def)

subsubsection Closures

abbreviation refl_trans_step_rel :: "('r,'l,'v) global_state \<Rightarrow> ('r,'l,'v) global_state \<Rightarrow> bool"(infix "\<leadsto>\<^sup>*" 60) where
  "s \<leadsto>\<^sup>* s' \<equiv> (s,s') \<in> [\<leadsto>]\<^sup>*"

abbreviation refl_step_rel :: "('r,'l,'v) global_state \<Rightarrow> ('r,'l,'v) global_state \<Rightarrow> bool" (infix "\<leadsto>\<^sup>=" 60) where
  "s \<leadsto>\<^sup>= s' \<equiv> (s,s') \<in> [\<leadsto>]\<^sup>="

lemma refl_rewritesI [intro]: "s \<leadsto> s' \<Longrightarrow> s \<leadsto>\<^sup>= s'" by blast

subsection Properties

abbreviation program_expr :: "('r,'l,'v) expr \<Rightarrow> bool" where
  "program_expr e \<equiv> LID\<^sub>E e = {} \<and> RID\<^sub>E e = {}"

abbreviation initializes :: "('r,'l,'v) global_state \<Rightarrow> ('r,'l,'v) expr \<Rightarrow> bool" where
  "initializes s e \<equiv> \<exists>r. s = (\<epsilon>(r \<mapsto>(\<epsilon>,\<epsilon>,e))) \<and> program_expr e"

abbreviation initial_state :: "('r,'l,'v) global_state \<Rightarrow> bool" where
  "initial_state s \<equiv> \<exists>e. initializes s e"

definition execution :: "('r,'l,'v) expr \<Rightarrow> ('r,'l,'v) global_state \<Rightarrow> ('r,'l,'v) global_state \<Rightarrow> bool" where
  "execution e s s' \<equiv> initializes s e \<and> s \<leadsto>\<^sup>* s'"

definition maximal_execution :: "('r,'l,'v) expr \<Rightarrow> ('r,'l,'v) global_state \<Rightarrow> ('r,'l,'v) global_state \<Rightarrow> bool" where
  "maximal_execution e s s' \<equiv> execution e s s' \<and> (\<nexists>s''. s' \<leadsto> s'')"

definition reachable :: "('r,'l,'v) global_state \<Rightarrow> bool" where
  "reachable s \<equiv> \<exists>e s'. execution e s' s"

definition terminates_in :: "('r,'l,'v) expr \<Rightarrow> ('r,'l,'v) global_state \<Rightarrow> bool" (infix "\<down>" 60) where
  "e \<down> s' \<equiv> \<exists>s. maximal_execution e s s'"

subsection Invariants

subsubsection \<open>Inductive invariance\<close>

definition inductive_invariant :: "(('r,'l,'v) global_state \<Rightarrow> bool) \<Rightarrow> bool" where
  "inductive_invariant P \<equiv> (\<forall>s. initial_state s \<longrightarrow> P s) \<and> (\<forall>s s'. s \<leadsto> s' \<longrightarrow> P s \<longrightarrow> P s')"

lemma inductive_invariantI [intro]:
  "(\<And>s. initial_state s \<Longrightarrow> P s) \<Longrightarrow> (\<And>s s'. s \<leadsto> s' \<Longrightarrow> P s \<Longrightarrow> P s') \<Longrightarrow> inductive_invariant P"
  by (auto simp add: inductive_invariant_def)

lemma inductive_invariant_is_execution_invariant: "reachable s \<Longrightarrow> inductive_invariant P \<Longrightarrow> P s"
proof -
  assume reach: "reachable s" and ind_inv: "inductive_invariant P"
  then obtain e initial n where initializes: "initializes initial e" and trace: "(initial,s) \<in> [\<leadsto>]^^n"
    by (metis execution_def reachable_def rtrancl_power)
  thus "P s"
  proof (induct n arbitrary: s)
    case 0
    have "initial = s"   using "0.prems"(2) by auto
    hence "initial_state s" using initializes by blast
    then show ?case using ind_inv inductive_invariant_def by auto
  next
    case (Suc n)
    obtain s' where nfold: "(initial, s') \<in> [\<leadsto>]^^n" and step: "s' \<leadsto> s" using Suc.prems(2) by auto
    have "P s'" using Suc(1) nfold initializes by blast
    then show ?case using ind_inv step inductive_invariant_def by auto
  qed
qed

subsubsection \<open>Subsumption is invariant\<close>

lemma nice_ind_inv_is_inductive_invariant: "inductive_invariant (\<lambda>s. \<S>\<^sub>G s \<and> \<A>\<^sub>G s)"
proof (rule inductive_invariantI)
  fix s
  assume "initial_state s"
  then obtain e r where s: "s = \<epsilon>(r \<mapsto> (\<epsilon>, \<epsilon>, e))" and prog_expr_e: "program_expr e" by blast
  show "\<S>\<^sub>G s \<and> \<A>\<^sub>G s"
  proof (rule conjI)
    show "\<S>\<^sub>G s"
    proof (rule domains_subsume_globallyI)
      fix r' \<sigma>' \<tau>' e'
      assume s_r': "s r' = Some (\<sigma>',\<tau>',e')"
      have "r' = r" using s s_r' prog_expr_e by (meson domI domIff fun_upd_other)
      hence "LID\<^sub>L (\<sigma>',\<tau>',e') = LID\<^sub>L (\<epsilon>, \<epsilon>, e)" using s s_r' by auto
      also have "... = {}" using prog_expr_e by auto
      also have "... = dom \<sigma>' \<union> dom \<tau>'" using \<open>r' = r\<close> s s_r' by auto
      finally show "\<S> (\<sigma>', \<tau>', e')" by (simp add: domains_subsume_def)
    qed
    show "\<A>\<^sub>G s"
    proof (rule subsumes_accessible_globallyI)
      fix r\<^sub>1 \<sigma>\<^sub>1 \<tau>\<^sub>1 e\<^sub>1 r\<^sub>2 \<sigma>\<^sub>2 \<tau>\<^sub>2 e\<^sub>2
      assume s_r1: "s r\<^sub>1 = Some (\<sigma>\<^sub>1, \<tau>\<^sub>1, e\<^sub>1)" and s_r2: "s r\<^sub>2 = Some (\<sigma>\<^sub>2, \<tau>\<^sub>2, e\<^sub>2)"
      have "r\<^sub>2 = r" using s s_r2 prog_expr_e  by (meson domI domIff fun_upd_other)
      hence "\<sigma>\<^sub>2 = \<epsilon>" using s s_r2 by auto
      hence "LID\<^sub>S \<sigma>\<^sub>2 = {}" by auto
      thus "\<A> r\<^sub>1 r\<^sub>2 s" using s_r2 by auto
    qed
  qed
qed (use step_preserves_\<S>\<^sub>G_and_\<A>\<^sub>G in auto)

corollary reachable_imp_\<S>\<^sub>G: "reachable s \<Longrightarrow> \<S>\<^sub>G s"
proof -
  assume reach: "reachable s"
  have "\<S>\<^sub>G s \<and> \<A>\<^sub>G s" by (rule inductive_invariant_is_execution_invariant[OF reach nice_ind_inv_is_inductive_invariant])
  thus ?thesis by auto
qed

lemma transition_relations_equivalent: "reachable s \<Longrightarrow> revision_step r s s' = revision_step_relaxed r s s'"
proof -
  assume reach: "reachable s"
  have doms_sub_local: "\<S>\<^sub>G s" by (rule reachable_imp_\<S>\<^sub>G[OF reach])
  show "revision_step r s s' = revision_step_relaxed r s s'"
  proof (rule iffI)
    assume step: "revision_step r s s'"
    show "revision_step_relaxed r s s'"
    proof (use step in \<open>induct rule: revision_stepE\<close>)
      case (new \<sigma> \<tau> \<E> v l)
      have "revision_step_relaxed r s (s(r \<mapsto> (\<sigma>, \<tau>(l \<mapsto> v), \<E> [VE (Loc l)])))"
      proof (rule revision_step_relaxed.new)
        show "l \<notin> \<Union> { doms ls | ls. ls \<in> ran s}"
        proof
          assume "l \<in> \<Union> { doms ls | ls. ls \<in> ran s}"
          then obtain ls where in_ran: "ls \<in> ran s" and in_doms: "l \<in> doms ls" by blast
          from in_doms have "l \<in> LID\<^sub>L ls" by (cases ls) auto
          have "l \<in> LID\<^sub>G s"
          proof -
            have "ls \<in> {ls. \<exists>r. s r = Some ls}" by (metis (full_types) in_ran ran_def)
            then show ?thesis using \<open>l \<in> LID\<^sub>L ls\<close> by blast
          qed
          thus False using new by auto
        qed
      qed (simp add: new.hyps(2))
      thus ?thesis using new.hyps(1) by blast
    qed (use revision_step_relaxed.intros in simp)+
  next
    assume step: "revision_step_relaxed r s s'"
    show "revision_step r s s'"
    proof (use step in \<open>induct rule: revision_step_relaxedE\<close>)
      case (new \<sigma> \<tau> \<E> v l)
      have "revision_step r s (s(r \<mapsto> (\<sigma>, \<tau>(l \<mapsto> v), \<E> [VE (Loc l)])))"
      proof (rule revision_step.new)
        show "s r = Some (\<sigma>, \<tau>, \<E> [Ref (VE v)])" by (simp add: new.hyps(2))
        show "l \<notin> LID\<^sub>G s"
        proof
          assume "l \<in> LID\<^sub>G s"
          then obtain r' \<sigma>' \<tau>' e' where s_r': "s r' = Some (\<sigma>',\<tau>',e')" and l_in_local: "l \<in> LID\<^sub>L (\<sigma>',\<tau>',e')" by auto
          hence "l \<in> dom \<sigma>' \<union> dom \<tau>'"
            by (metis (no_types, lifting) domains_subsume_def domains_subsume_globally_def doms.simps doms_sub_local rev_subsetD)
          thus False by (meson s_r' new.hyps(3) ranI)
        qed
      qed
      then show ?case using new.hyps(1) by blast
    next
      case (get \<sigma> \<tau> \<E> l)
      have "revision_step r s (s(r \<mapsto> (\<sigma>, \<tau>, \<E> [VE (the ((\<sigma>;;\<tau>) l))])))"
      proof
       show "s r = Some (\<sigma>, \<tau>, \<E> [Read (VE (Loc l))])" by (simp add: get.hyps(2))
       show "l \<in> dom (\<sigma>;;\<tau>)"
       proof -
         have "l \<in> LID\<^sub>L (\<sigma>, \<tau>, \<E> [Read (VE (Loc l))])"  by simp
         hence "l \<in> dom \<sigma> \<union> dom \<tau>"
           using domains_subsume_def domains_subsume_globally_def doms_sub_local get.hyps(2) by fastforce
         thus "l \<in> dom (\<sigma>;;\<tau>)" by (simp add: dom_combination_dom_union)
       qed
     qed
     then show ?case using get.hyps(1) by auto
    next
      case (set \<sigma> \<tau> \<E> l v)
      have "revision_step r s (s(r \<mapsto> (\<sigma>, \<tau>(l \<mapsto> v), \<E> [VE (CV Unit)])))"
      proof
       show "s r = Some (\<sigma>, \<tau>, \<E> [Assign (VE (Loc l)) (VE v)])" by (simp add: set.hyps(2))
       show "l \<in> dom (\<sigma>;;\<tau>)"
       proof -
         have "l \<in> LID\<^sub>L (\<sigma>, \<tau>, \<E> [Assign (VE (Loc l)) (VE v)])"  by simp
         hence "l \<in> dom \<sigma> \<union> dom \<tau>"
           using domains_subsume_def domains_subsume_globally_def doms_sub_local set.hyps(2) by fastforce
         thus "l \<in> dom (\<sigma>;;\<tau>)" by (simp add: dom_combination_dom_union)
       qed
     qed
     then show ?case using set.hyps(1) by blast
    qed (simp add: revision_step.intros)+
  qed
qed

subsubsection \<open>Finitude is invariant\<close>

lemma finite_occurrences_val_expr [simp]:
  fixes
    v :: "('r,'l,'v) val" and
    e :: "('r,'l,'v) expr"
  shows
  "finite (RID\<^sub>V v)"
  "finite (RID\<^sub>E e)"
  "finite (LID\<^sub>V v)"
  "finite (LID\<^sub>E e)"
proof -
  have "(finite (RID\<^sub>V v) \<and> finite (LID\<^sub>V v)) \<and> finite (RID\<^sub>E e) \<and> finite (LID\<^sub>E e)"
    by (induct rule: val_expr.induct) auto
  thus
    "finite (RID\<^sub>V v)"
    "finite (RID\<^sub>E e)"
    "finite (LID\<^sub>V v)"
    "finite (LID\<^sub>E e)"
    by auto
qed

lemma store_finite_upd [intro]:
  "finite (RID\<^sub>S \<tau>) \<Longrightarrow> finite (RID\<^sub>S (\<tau>(l := None)))"
  "finite (LID\<^sub>S \<tau>) \<Longrightarrow> finite (LID\<^sub>S (\<tau>(l := None)))"
  apply (meson ID_restricted_store_subset_store(1) finite_subset)
  by (simp add: ID_restricted_store_subset_store(2) rev_finite_subset)

lemma finite_state_imp_restriction_finite [intro]:
  "finite (RID\<^sub>G s) \<Longrightarrow> finite (RID\<^sub>G (s(r := None)))"
  "finite (LID\<^sub>G s) \<Longrightarrow> finite (LID\<^sub>G (s(r := None)))"
proof -
  assume "finite (RID\<^sub>G s)"
  thus "finite (RID\<^sub>G (s(r := None)))" by (meson infinite_super ID_restricted_global_subset_unrestricted)
next
  assume fin: "finite (LID\<^sub>G s)"
  have "LID\<^sub>G (s(r := None)) \<subseteq> LID\<^sub>G s" by auto
  thus "finite (LID\<^sub>G (s(r := None)))" using fin finite_subset by auto
qed

lemma local_state_of_finite_restricted_global_state_is_finite [intro]:
  "s r' = Some ls \<Longrightarrow> finite (RID\<^sub>G (s(r := None))) \<Longrightarrow> r \<noteq> r' \<Longrightarrow> finite (RID\<^sub>L ls)"
  "s r' = Some ls \<Longrightarrow> finite (LID\<^sub>G (s(r := None))) \<Longrightarrow> r \<noteq> r' \<Longrightarrow> finite (LID\<^sub>L ls)"
   apply (metis (no_types, lifting) ID_distr_global(1) finite_Un finite_insert fun_upd_triv fun_upd_twist)
  by (metis ID_distr_global(2) finite_Un fun_upd_triv fun_upd_twist)

lemma empty_map_finite [simp]:
  "finite (RID\<^sub>S \<epsilon>)"
  "finite (LID\<^sub>S \<epsilon>)"
  "finite (RID\<^sub>G \<epsilon>)"
  "finite (LID\<^sub>G \<epsilon>)"
  by (simp add: RID\<^sub>S_def LID\<^sub>S_def RID\<^sub>G_def LID\<^sub>G_def)+

lemma finite_combination [intro]:
  "finite (RID\<^sub>S \<sigma>) \<Longrightarrow> finite (RID\<^sub>S \<tau>) \<Longrightarrow> finite (RID\<^sub>S (\<sigma>;;\<tau>))"
  "finite (LID\<^sub>S \<sigma>) \<Longrightarrow> finite (LID\<^sub>S \<tau>) \<Longrightarrow> finite (LID\<^sub>S (\<sigma>;;\<tau>))"
  by (meson finite_UnI rev_finite_subset ID_combination_subset_union)+

lemma RID\<^sub>G_finite_invariant:
  assumes
    step: "revision_step r s s'" and
    fin: "finite (RID\<^sub>G s)"
shows
    "finite (RID\<^sub>G s')"
proof (use step in \<open>cases rule: revision_stepE\<close>)
  case (join \<sigma> \<tau> \<E> r' \<sigma>' \<tau>' v)
  hence "r \<noteq> r'" by auto
  then show ?thesis
    by (metis (mono_tags, lifting) ID_distr_global(1) ID_distr_local(2) fin finite_Un finite_combination(1) finite_insert finite_occurrences_val_expr(2) finite_state_imp_restriction_finite(1) join local_state_of_finite_restricted_global_state_is_finite(1))
qed (use fin in \<open>auto simp add: ID_distr_global_conditional\<close>)

lemma RID\<^sub>L_finite_invariant:
  assumes
    step: "revision_step r s s'" and
    fin: "finite (LID\<^sub>G s)"
shows
    "finite (LID\<^sub>G s')"
proof (use step in \<open>cases rule: revision_stepE\<close>)
  case (join \<sigma> \<tau> \<E> r' \<sigma>' \<tau>' v)
  hence "r \<noteq> r'" by auto
  then show ?thesis
    using join assms
    by (metis (mono_tags, lifting) ID_distr_global(2) ID_distr_local(1) fin finite_Un finite_combination(2) finite_occurrences_val_expr(4) finite_state_imp_restriction_finite(2) join local_state_of_finite_restricted_global_state_is_finite(2))
qed (use fin in \<open>auto simp add: ID_distr_global_conditional\<close>)

lemma reachable_imp_identifiers_finite:
  assumes reach: "reachable s"
  shows
    "finite (RID\<^sub>G s)"
    "finite (LID\<^sub>G s)"
proof -
  from reach obtain e r where exec: "execution e (\<epsilon>(r \<mapsto> (\<epsilon>,\<epsilon>,e))) s" using reachable_def execution_def by auto
  hence prog_exp: "program_expr e" by (meson execution_def)
  obtain n where n_reachable: "(\<epsilon>(r \<mapsto> (\<epsilon>,\<epsilon>,e)), s) \<in> [\<leadsto>]^^n" using exec by (meson execution_def rtrancl_imp_relpow)
  hence "finite (RID\<^sub>G s) \<and> finite (LID\<^sub>G s)"
  proof (induct n arbitrary: s)
    case 0
    hence s: "s = \<epsilon>(r \<mapsto> (\<epsilon>, \<epsilon>, e))" by auto
    hence rid_dom: "dom s = {r}" by auto
    hence rid_ran: "\<Union> (RID\<^sub>L ` ran s) = {}" using s by (auto simp add: prog_exp)
    have rids: "RID\<^sub>G s = {r}" by (unfold RID\<^sub>G_def, use rid_dom rid_ran in auto)
    have lid_ran: "\<Union> (LID\<^sub>L ` ran s) = {}" using s by (auto simp add: prog_exp)
    hence lids: "LID\<^sub>G s = {}" by (unfold LID\<^sub>G_def, simp)
    thus ?case using rids lids by simp
  next
    case (Suc n)
    then obtain s' where
      n_steps: "(\<epsilon>(r \<mapsto> (\<epsilon>, \<epsilon>, e)), s') \<in> [\<leadsto>]^^n" and
      step: "s' \<leadsto> s"
      by (meson relpow_Suc_E)
    have fin_rid: "finite (RID\<^sub>G s')" using Suc.hyps n_steps by blast
    have fin_lid: "finite (LID\<^sub>G s')" using Suc.hyps n_steps by blast
    thus ?case by (meson RID\<^sub>G_finite_invariant RID\<^sub>L_finite_invariant fin_rid local.step valid_stepE)
  qed
  thus "finite (RID\<^sub>G s)" "finite (LID\<^sub>G s)" by auto
qed

lemma reachable_imp_identifiers_available:
  assumes
    "reachable (s :: ('r,'l,'v) global_state)"
  shows
    "infinite (UNIV :: 'r set) \<Longrightarrow> \<exists>r. r \<notin> RID\<^sub>G s"
    "infinite (UNIV :: 'l set) \<Longrightarrow> \<exists>l. l \<notin> LID\<^sub>G s"
  by (simp add: assms ex_new_if_finite reachable_imp_identifiers_finite)+

subsubsection \<open>Reachability is invariant\<close>

lemma initial_state_reachable:
  assumes "program_expr e"
  shows "reachable (\<epsilon>(r \<mapsto> (\<epsilon>,\<epsilon>,e)))"
proof -
  have "initializes (\<epsilon>(r \<mapsto> (\<epsilon>,\<epsilon>,e))) e" using assms by auto
  hence "execution e (\<epsilon>(r \<mapsto> (\<epsilon>,\<epsilon>,e))) (\<epsilon>(r \<mapsto> (\<epsilon>,\<epsilon>,e)))" by (simp add: execution_def)
  thus ?thesis using reachable_def by blast
qed

lemma reachability_closed_under_execution_step:
  assumes
    reach: "reachable s" and
    step: "revision_step r s s'"
  shows "reachable s'"
proof -
  obtain init e where exec: "execution e init s" using reach reachable_def by blast
  hence init_s:"init \<leadsto>\<^sup>* s" by (simp add: execution_def)
  have s_s': "s \<leadsto> s'" using step by blast
  have "init \<leadsto>\<^sup>* s'" using init_s s_s' by auto
  hence "execution e init s'" using exec by (simp add: execution_def)
  thus ?thesis using reachable_def by auto
qed

lemma reachability_closed_under_execution: "reachable s \<Longrightarrow> s \<leadsto>\<^sup>* s' \<Longrightarrow> reachable s'"
proof -
  assume reach: "reachable s" and "s \<leadsto>\<^sup>* s'"
  then obtain n where "(s, s') \<in> [\<leadsto>]^^n" using rtrancl_imp_relpow by blast
  thus "reachable s'"
  proof (induct n arbitrary: s')
    case 0
    thus ?case using reach by auto
  next
    case (Suc n)
    obtain s'' where "(s,s'') \<in> [\<leadsto>]^^n" "s'' \<leadsto> s'" using Suc.prems by auto
    have "reachable s''" by (simp add: Suc.hyps \<open>(s, s'') \<in> [\<leadsto>]^^n\<close>)
    then show ?case using \<open>s'' \<leadsto> s'\<close> reachability_closed_under_execution_step by blast
  qed
qed

end (* substitution locale *)

end (* theory *)


(*  Title:      HOL/HOLCF/IOA/ABP/Correctness.thy
    Author:     Olaf Müller
*)

section \<open>The main correctness proof: System_fin implements System\<close>

theory Correctness
imports IOA.IOA Env Impl Impl_finite
begin

ML_file \<open>Check.ML\<close>

primrec reduce :: "'a list => 'a list"
where
  reduce_Nil:  "reduce [] = []"
| reduce_Cons: "reduce(x#xs) =
                 (case xs of
                     [] => [x]
               |   y#ys => (if (x=y)
                              then reduce xs
                              else (x#(reduce xs))))"

definition
  abs where
    "abs  =
      (%p.(fst(p),(fst(snd(p)),(fst(snd(snd(p))),
       (reduce(fst(snd(snd(snd(p))))),reduce(snd(snd(snd(snd(p))))))))))"

definition
  system_ioa :: "('m action, bool * 'm impl_state)ioa" where
  "system_ioa = (env_ioa \<parallel> impl_ioa)"

definition
  system_fin_ioa :: "('m action, bool * 'm impl_state)ioa" where
  "system_fin_ioa = (env_ioa \<parallel> impl_fin_ioa)"

axiomatization where
  sys_IOA: "IOA system_ioa" and
  sys_fin_IOA: "IOA system_fin_ioa"

declare split_paired_All [simp del] Collect_empty_eq [simp del]

lemmas [simp] =
  srch_asig_def rsch_asig_def rsch_ioa_def srch_ioa_def ch_ioa_def
  ch_asig_def srch_actions_def rsch_actions_def rename_def rename_set_def asig_of_def
  actions_def exis_elim srch_trans_def rsch_trans_def ch_trans_def
  trans_of_def asig_projections set_lemmas

lemmas abschannel_fin [simp] =
  srch_fin_asig_def rsch_fin_asig_def
  rsch_fin_ioa_def srch_fin_ioa_def
  ch_fin_ioa_def ch_fin_trans_def ch_fin_asig_def

lemmas impl_ioas = sender_ioa_def receiver_ioa_def
  and impl_trans = sender_trans_def receiver_trans_def
  and impl_asigs = sender_asig_def receiver_asig_def

declare let_weak_cong [cong]
declare ioa_triple_proj [simp] starts_of_par [simp]

lemmas env_ioas = env_ioa_def env_asig_def env_trans_def
lemmas hom_ioas =
  env_ioas [simp] impl_ioas [simp] impl_trans [simp] impl_asigs [simp]
  asig_projections set_lemmas

subsection \<open>lemmas about reduce\<close>

lemma l_iff_red_nil: "(reduce l = []) = (l = [])"
  by (induct l) (auto split: list.split)

lemma hd_is_reduce_hd: "s ~= [] --> hd s = hd (reduce s)"
  by (induct s) (auto split: list.split)

text \<open>to be used in the following Lemma\<close>
lemma rev_red_not_nil [rule_format]:
    "l ~= [] --> reverse (reduce l) ~= []"
  by (induct l) (auto split: list.split)

text \<open>shows applicability of the induction hypothesis of the following Lemma 1\<close>
lemma last_ind_on_first:
    "l ~= [] ==> hd (reverse (reduce (a # l))) = hd (reverse (reduce l))"
  apply simp
  apply (tactic \<open>auto_tac (put_simpset HOL_ss \<^context>
    addsimps (@{thms reverse.simps} @ [@{thm hd_append}, @{thm rev_red_not_nil}])
    |> Splitter.add_split @{thm list.split})\<close>)
  done

text \<open>Main Lemma 1 for \<open>S_pkt\<close> in showing that reduce is refinement.\<close>
lemma reduce_hd:
   "if x=hd(reverse(reduce(l))) & reduce(l)~=[] then
       reduce(l@[x])=reduce(l) else
       reduce(l@[x])=reduce(l)@[x]"
apply (simplesubst if_split)
apply (rule conjI)
txt \<open>\<open>-->\<close>\<close>
apply (induct_tac "l")
apply (simp (no_asm))
apply (case_tac "list=[]")
 apply simp
 apply (rule impI)
apply (simp (no_asm))
apply (cut_tac l = "list" in cons_not_nil)
 apply (simp del: reduce_Cons)
 apply (erule exE)+
 apply hypsubst
apply (simp del: reduce_Cons add: last_ind_on_first l_iff_red_nil)
txt \<open>\<open><--\<close>\<close>
apply (simp (no_asm) add: and_de_morgan_and_absorbe l_iff_red_nil)
apply (induct_tac "l")
apply (simp (no_asm))
apply (case_tac "list=[]")
apply (cut_tac [2] l = "list" in cons_not_nil)
apply simp
apply (auto simp del: reduce_Cons simp add: last_ind_on_first l_iff_red_nil split: if_split)
apply simp
done

text \<open>Main Lemma 2 for R_pkt in showing that reduce is refinement.\<close>
lemma reduce_tl: "s~=[] ==>
     if hd(s)=hd(tl(s)) & tl(s)~=[] then
       reduce(tl(s))=reduce(s) else
       reduce(tl(s))=tl(reduce(s))"
apply (cut_tac l = "s" in cons_not_nil)
apply simp
apply (erule exE)+
apply (auto split: list.split)
done

subsection \<open>Channel Abstraction\<close>

declare if_split [split del]

lemma channel_abstraction: "is_weak_ref_map reduce ch_ioa ch_fin_ioa"
apply (simp (no_asm) add: is_weak_ref_map_def)
txt \<open>main-part\<close>
apply (rule allI)+
apply (rule imp_conj_lemma)
apply (induct_tac "a")
txt \<open>2 cases\<close>
apply (simp_all (no_asm) cong del: if_weak_cong add: externals_def)
txt \<open>fst case\<close>
 apply (rule impI)
 apply (rule disjI2)
apply (rule reduce_hd)
txt \<open>snd case\<close>
 apply (rule impI)
 apply (erule conjE)+
 apply (erule disjE)
apply (simp add: l_iff_red_nil)
apply (erule hd_is_reduce_hd [THEN mp])
apply (simp add: l_iff_red_nil)
apply (rule conjI)
apply (erule hd_is_reduce_hd [THEN mp])
apply (rule bool_if_impl_or [THEN mp])
apply (erule reduce_tl)
done

declare if_split [split]

lemma sender_abstraction: "is_weak_ref_map reduce srch_ioa srch_fin_ioa"
apply (tactic \<open>
  simp_tac (put_simpset HOL_ss \<^context>
    addsimps [@{thm srch_fin_ioa_def}, @{thm rsch_fin_ioa_def},
      @{thm srch_ioa_def}, @{thm rsch_ioa_def}, @{thm rename_through_pmap},
      @{thm channel_abstraction}]) 1\<close>)
done

lemma receiver_abstraction: "is_weak_ref_map reduce rsch_ioa rsch_fin_ioa"
apply (tactic \<open>
  simp_tac (put_simpset HOL_ss \<^context>
    addsimps [@{thm srch_fin_ioa_def}, @{thm rsch_fin_ioa_def},
      @{thm srch_ioa_def}, @{thm rsch_ioa_def}, @{thm rename_through_pmap},
      @{thm channel_abstraction}]) 1\<close>)
done

text \<open>3 thms that do not hold generally! The lucky restriction here is
   the absence of internal actions.\<close>
lemma sender_unchanged: "is_weak_ref_map (%id. id) sender_ioa sender_ioa"
apply (simp (no_asm) add: is_weak_ref_map_def)
txt \<open>main-part\<close>
apply (rule allI)+
apply (induct_tac a)
txt \<open>7 cases\<close>
apply (simp_all (no_asm) add: externals_def)
done

text \<open>2 copies of before\<close>
lemma receiver_unchanged: "is_weak_ref_map (%id. id) receiver_ioa receiver_ioa"
apply (simp (no_asm) add: is_weak_ref_map_def)
txt \<open>main-part\<close>
apply (rule allI)+
apply (induct_tac a)
txt \<open>7 cases\<close>
apply (simp_all (no_asm) add: externals_def)
done

lemma env_unchanged: "is_weak_ref_map (%id. id) env_ioa env_ioa"
apply (simp (no_asm) add: is_weak_ref_map_def)
txt \<open>main-part\<close>
apply (rule allI)+
apply (induct_tac a)
txt \<open>7 cases\<close>
apply (simp_all (no_asm) add: externals_def)
done

lemma compat_single_ch: "compatible srch_ioa rsch_ioa"
apply (simp add: compatible_def Int_def)
apply (rule set_eqI)
apply (induct_tac x)
apply simp_all
done

text \<open>totally the same as before\<close>
lemma compat_single_fin_ch: "compatible srch_fin_ioa rsch_fin_ioa"
apply (simp add: compatible_def Int_def)
apply (rule set_eqI)
apply (induct_tac x)
apply simp_all
done

lemmas del_simps = trans_of_def srch_asig_def rsch_asig_def
  asig_of_def actions_def srch_trans_def rsch_trans_def srch_ioa_def
  srch_fin_ioa_def rsch_fin_ioa_def rsch_ioa_def sender_trans_def
  receiver_trans_def set_lemmas

lemma compat_rec: "compatible receiver_ioa (srch_ioa \<parallel> rsch_ioa)"
apply (simp del: del_simps
  add: compatible_def asig_of_par asig_comp_def actions_def Int_def)
apply simp
apply (rule set_eqI)
apply (induct_tac x)
apply simp_all
done

text \<open>5 proofs totally the same as before\<close>
lemma compat_rec_fin: "compatible receiver_ioa (srch_fin_ioa \<parallel> rsch_fin_ioa)"
apply (simp del: del_simps
  add: compatible_def asig_of_par asig_comp_def actions_def Int_def)
apply simp
apply (rule set_eqI)
apply (induct_tac x)
apply simp_all
done

lemma compat_sen: "compatible sender_ioa
       (receiver_ioa \<parallel> srch_ioa \<parallel> rsch_ioa)"
apply (simp del: del_simps
  add: compatible_def asig_of_par asig_comp_def actions_def Int_def)
apply simp
apply (rule set_eqI)
apply (induct_tac x)
apply simp_all
done

lemma compat_sen_fin: "compatible sender_ioa
       (receiver_ioa \<parallel> srch_fin_ioa \<parallel> rsch_fin_ioa)"
apply (simp del: del_simps
  add: compatible_def asig_of_par asig_comp_def actions_def Int_def)
apply simp
apply (rule set_eqI)
apply (induct_tac x)
apply simp_all
done

lemma compat_env: "compatible env_ioa
       (sender_ioa \<parallel> receiver_ioa \<parallel> srch_ioa \<parallel> rsch_ioa)"
apply (simp del: del_simps
  add: compatible_def asig_of_par asig_comp_def actions_def Int_def)
apply simp
apply (rule set_eqI)
apply (induct_tac x)
apply simp_all
done

lemma compat_env_fin: "compatible env_ioa
       (sender_ioa \<parallel> receiver_ioa \<parallel> srch_fin_ioa \<parallel> rsch_fin_ioa)"
apply (simp del: del_simps
  add: compatible_def asig_of_par asig_comp_def actions_def Int_def)
apply simp
apply (rule set_eqI)
apply (induct_tac x)
apply simp_all
done

text \<open>lemmata about externals of channels\<close>
lemma ext_single_ch: "externals(asig_of(srch_fin_ioa)) = externals(asig_of(srch_ioa)) &
    externals(asig_of(rsch_fin_ioa)) = externals(asig_of(rsch_ioa))"
  by (simp add: externals_def)

subsection \<open>Soundness of Abstraction\<close>

lemmas ext_simps = externals_of_par ext_single_ch
  and compat_simps = compat_single_ch compat_single_fin_ch compat_rec
    compat_rec_fin compat_sen compat_sen_fin compat_env compat_env_fin
  and abstractions = env_unchanged sender_unchanged
    receiver_unchanged sender_abstraction receiver_abstraction

(* FIX: this proof should be done with compositionality on trace level, not on
        weak_ref_map level, as done here with fxg_is_weak_ref_map_of_product_IOA

Goal "is_weak_ref_map  abs  system_ioa  system_fin_ioa"

by (simp_tac (impl_ss delsimps ([srch_ioa_def, rsch_ioa_def, srch_fin_ioa_def,
                                 rsch_fin_ioa_def] @ env_ioas @ impl_ioas)
                      addsimps [system_def, system_fin_def, abs_def,
                                impl_ioa_def, impl_fin_ioa_def, sys_IOA,
                                sys_fin_IOA]) 1);

by (REPEAT (EVERY[rtac fxg_is_weak_ref_map_of_product_IOA 1,
                  simp_tac (ss addsimps abstractions) 1,
                  rtac conjI 1]));

by (ALLGOALS (simp_tac (ss addsimps ext_ss @ compat_ss)));

qed "system_refinement";
*)

end


section \<open>Refinement for Imperative-HOL Programs\<close>
theory Refine_Imp_Hol
  imports "Hoare_Triple"
            "HOL-Eisbach.Eisbach"
begin

  subsection \<open>Assertions\<close>

  text \<open>We add assertions that consume no time to Imperative HOL Time.

    Note that the original \<^const>\<open>assert\<close> consumes one time unit, i.e., is designed for
    actually being checked at runtime. On the other hand, our assertions are not executable,
    and must be refined before code generation.
  \<close>
  definition [code del]: "assert' P \<equiv> if P then ureturn () else raise ''assert''"

  lemma execute_assert'[execute_simps]: "execute (assert' P) h = (if P then Some ((),h,0) else None)"
    by (auto simp: assert'_def execute_simps)

  lemma assert'_rule: "\<lbrakk>\<And>h. h\<Turnstile>P \<Longrightarrow> \<phi>\<rbrakk> \<Longrightarrow> <P> assert' \<phi> <\<lambda>_. P>"
    apply rule
    apply (auto simp: execute_simps in_range.simps relH_refl)
    done

  lemma assert'_bind_rule:
    assumes "\<And>h. h\<Turnstile>P \<Longrightarrow> \<phi>"
    assumes "\<phi> \<Longrightarrow> <P> c <Q>"
    shows "<P> do {assert' \<phi>; c} <Q>"
    apply rule
    using assms
    apply (auto simp: execute_simps in_range.simps relH_refl elim!: hoare_tripleE)
    done

  subsection \<open>Refinement Predicate\<close>
  text \<open>An imperative-HOL program \<open>p\<close> refines a program \<open>q\<close>, if either \<open>q\<close> fails, or \<open>p\<close> returns the
    same result as \<open>q\<close>. In case \<open>q\<close> is already proved correct (in particular does not fail), this
    implies correctness of \<open>p\<close>. Moreover, for the refinement proof, we can assume that \<open>q\<close> does not fail,
    in particular, that all assertions in \<open>q\<close> hold. This can be used to transfer knowledge from the
    correctness proof (proving the assertions) to the refinement proof (assuming the assertions).
  \<close>
  definition "refines p q \<equiv> \<forall>h. case execute q h of None \<Rightarrow> True | Some (r,h',t) \<Rightarrow> execute p h = Some (r,h',t)"

  lemma hoare_triple_refines:
    assumes "<P> c <Q>"
    assumes "refines c' c"
    shows "<P> c' <Q>"
    apply rule
    using assms
    by (auto simp: refines_def elim!: hoare_tripleE split: option.splits)

  subsubsection \<open>Admissibility\<close>
  context begin

  private lemma refines_adm_aux: "option.admissible (\<lambda>xa. \<forall>h a aa b. xa h = Some (a, aa, b) \<longrightarrow> execute (t x) h = Some (a, aa, b))"
  proof-
    have "option.admissible (\<lambda>xa. \<forall>h y. xa h = Some y \<longrightarrow> execute (t x) h = Some y)"
      using option_admissible by metis
    thus ?thesis by auto
  qed

  lemma refines_adm: "heap.admissible (\<lambda>f. \<forall>x. refines (t x) (f x) )"
    unfolding refines_def
    apply (rule admissible_fun[OF heap_interpretation])

    unfolding Heap_lub_def Heap_ord_def
    apply (rule admissible_image)
    using option.partial_function_definitions_axioms partial_function_lift apply auto[1]
      apply(simp split: option.splits)
      apply auto[3]
    subgoal for x
      apply (simp add: comp_def)
      apply(rule refines_adm_aux)
      done
    subgoal for xa y
      apply (metis Heap_execute)
      done
    done

  end

  subsection \<open>Syntactic rules for \<^const>\<open>refines\<close>\<close>

  named_theorems refines_rule

  lemma refines_assert'[refines_rule]: "refines (ureturn ()) (assert' \<phi>)"
    unfolding refines_def
    by (simp add: execute_simps)

  lemma refines_assert'_bind[refines_rule]: "refines p q \<Longrightarrow> refines p (do {assert' \<phi>; q})"
    unfolding refines_def
    apply (cases \<phi>)
    apply (auto simp add: execute_simps split: option.splits)
    done

  lemma refines_bind[refines_rule]: "refines m m' \<Longrightarrow> (\<And>x. refines (f x) (f' x)) \<Longrightarrow> refines (do {x\<leftarrow>m; f x}) (do {x\<leftarrow>m'; f' x})"
    unfolding refines_def
    apply clarsimp
    subgoal for h
      apply (cases "execute m' h"; cases "execute m h")
      apply (auto simp add: execute_simps split: option.splits)
      by (smt (verit, best) option.case(2) prod.simps(2) timeFrame.elims)
    done

  lemma refines_If[refines_rule]: "\<lbrakk>b\<Longrightarrow>refines t t'\<rbrakk> \<Longrightarrow> \<lbrakk>\<not>b\<Longrightarrow>refines e e'\<rbrakk> \<Longrightarrow> refines (If b t e) (If b t' e')" by auto
  lemma refines_Let[refines_rule]: "\<lbrakk> \<And>x. \<lbrakk>x=v\<rbrakk> \<Longrightarrow> refines (f x) (f' x) \<rbrakk> \<Longrightarrow> refines (let x=v in f x) (let x=v in f' x)" by auto

  lemma refines_refl: "refines p p"
    unfolding refines_def
    by (auto split: option.splits)

  lemma refines_empty[simp]: "refines m  (Heap.Heap Map.empty)"
    apply(simp add: refines_def)
    done

  lemma refines_let_right: assumes "refines m (m' a)"
    shows "refines m (let x = a in m' x)"
    using assms by simp

  lemma refines_case_prod_right: assumes "\<And> a b. refines m (m' a b)"
    shows "refines m (case t of (a,b) \<Rightarrow> m' a b)"
    using assms apply(cases t)
    by simp

  lemma refines_option[refines_rule]: assumes "a=a'" "refines m1 m1'" "\<And> x. refines (m2 x) (m2' x)"
    shows "refines (case a of None \<Rightarrow> m1 | Some x \<Rightarrow> m2 x)  (case a' of None \<Rightarrow> m1' | Some x \<Rightarrow> m2' x)"
    using assms apply(cases a')
     apply simp_all
    done

  lemma prod_case_refines[refines_rule]: assumes "p= p'" " \<And> a b. refines (f a b) (f' a b)"
    shows " refines (case p of (a, b) \<Rightarrow> f a b) (case p' of (a, b) \<Rightarrow> f' a b )"
    using assms apply(cases p') by simp

subsection \<open>Automation\<close>

  method refines_step= determ\<open>rule refines_rule refl refines_refl refines_let_right refines_case_prod_right
                               | assumption | simp only:\<close>

  method refines = refines_step+

end


\<^marker>\<open>creator "Kevin Kappelmann"\<close>
subsection \<open>Restriction\<close>
theory TSFunctions_Extend_Restrict
  imports TSFunctions_Base
begin

unbundle no_restrict_syntax

lemma restrict_Dep_Function_type [type]:
  "set_restrict_left : ((x : A) \<rightarrow>s B x) \<Rightarrow> (P : Set \<Rightarrow> Bool) \<Rightarrow>
    ((x : (A & type P)) \<rightarrow>s B x) "
proof (intro Dep_fun_typeI Dep_FunctionI)
  fix f P assume f_type: "f : (x : A) \<rightarrow>s B x"
  let ?A' = "A & type P"
  have "type_pred ?A' = (\<lambda>x. x : A \<and> P x)" by unfold_types
  with f_type show "set_left_total_on ?A' f\<restriction>\<^bsub>P\<^esub>"
    by (auto intro: set_left_total_on_inf_restrict_leftI)
  from f_type have "set_right_unique_on (type_pred A) f"
    by (auto dest: Dep_Function_set_right_unique_on)
  then have "set_right_unique_on (type_pred A) f\<restriction>\<^bsub>P\<^esub>"
    using antimonoD[OF antimono_set_right_unique_on_set]
    by (rule le_boolD'') auto
  then have "set_right_unique_on (type_pred ?A') f\<restriction>\<^bsub>P\<^esub>"
    using antimonoD[OF antimono_set_right_unique_on_pred]
    by (rule le_boolD'') (auto dest: Int_typeD1)
  then show "set_right_unique_on ?A' f\<restriction>\<^bsub>P\<^esub>" by simp
  fix x assume "x : A & type P"
  then have "x : A" and "P x" by unfold_types
  then have "f\<restriction>\<^bsub>P\<^esub>`x = f`x" by simp
  with f_type show "f\<restriction>\<^bsub>P\<^esub>`x : B x" by auto
qed

lemma restrict_Dep_Function_set_type [type]:
  "set_restrict_left : Dep_Function A B \<Rightarrow> (A' : Set) \<Rightarrow>
    Dep_Function (A & Element A') B"
  (*TODO: should be proved with lemma above*)
  by unfold_types force

lemma restrict_Dep_Function_type_type [type]:
  "set_restrict_left : Dep_Function A B \<Rightarrow> (T : Any) \<Rightarrow> Dep_Function (A & T) B"
  (*TODO: should be proved with lemma above*)
  by unfold_types force

lemma restrict_CDep_Function_if_Dep_Function [derive]:
  assumes "f : (x : A) \<rightarrow>s B x"
  shows "f\<restriction>\<^bsub>A\<^esub> : (x : A) \<rightarrow>cs B x"
proof (rule CDep_FunctionI)
  have "f\<restriction>\<^bsub>A\<^esub> : (x : A & A) \<rightarrow>s B x" by discharge_types
  then show "f\<restriction>\<^bsub>A\<^esub> : (x : A) \<rightarrow>s B x"
    by (elim Dep_Function_contravariant_dom) discharge_types
  show "f\<restriction>\<^bsub>A\<^esub> : Dep_Bin_Rel A B"
  proof (rule Dep_Bin_RelI)
    fix p assume "p \<in> f\<restriction>\<^bsub>A\<^esub>"
    then obtain x y where "p = \<langle>x, y\<rangle>" "\<langle>x, y\<rangle> \<in> f" "x : A" by auto
    moreover with assms have "y : B x" by auto
    ultimately show "p : \<Sum>x : A. (B x)" by simp
  qed
qed

end


section {*FUNCTION\_\_DPDA\_DFA\_CC\_\_DPDA\_DFA\_CONSTRUCT\_CONTROLLER*}
theory
  FUNCTION__DPDA_DFA_CC__DPDA_DFA_CONSTRUCT_CONTROLLER

imports
  PRJ_14_04__ENTRY

begin

definition F_DPDA_DFA_CC__SpecInput :: "
  ('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> bool"
  where
    "F_DPDA_DFA_CC__SpecInput S P \<Sigma>UC \<equiv>
  valid_dpda S
  \<and> valid_dfa P"

definition F_DPDA_DFA_CC__SpecOutput :: "
  ('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
  \<Rightarrow> bool"
  where
    "F_DPDA_DFA_CC__SpecOutput S P \<Sigma>UC R \<equiv>
  case R of
  None \<Rightarrow>
    FPiteratorMarked__fp__SpecOutput (epda_to_des S) (epda_to_des P) \<Sigma>UC bot
  | Some C' \<Rightarrow>
    FPiteratorMarked__fp__SpecOutput (epda_to_des S) (epda_to_des P) \<Sigma>UC (epda_to_des C')
    \<and> valid_dpda C'
    \<and> \<not> epdaH_livelock C'
    \<and> epdaH.accessible C'
    \<and> epda_operational_controllable C' P \<Sigma>UC"

definition F_DPDA_DFA_CC__fp_start__SpecInput :: "
  ('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_start__SpecInput S P \<equiv>
  valid_dpda S
  \<and> valid_dfa P"

definition F_DPDA_DFA_CC__fp_start__SpecOutput :: "
  ('state DT_symbol, 'event DT_symbol, 'stack DT_symbol) epda
  \<Rightarrow> ('state DT_symbol, 'event DT_symbol, nat) epda
  \<Rightarrow> ('state DT_symbol, 'event DT_symbol, 'stack DT_symbol) epda option
  \<Rightarrow> bool"
  where
    "F_DPDA_DFA_CC__fp_start__SpecOutput S P R \<equiv>
  case R of
  None \<Rightarrow>
    bot = FPinit (epda_to_des P) (epda_to_des S)
  | Some C' \<Rightarrow>
    epda_to_des C' = FPinit (epda_to_des P) (epda_to_des S)
    \<and> valid_dpda C'
    \<and> \<not> epdaH_livelock C'
    \<and> epdaH.accessible C'
    \<and> FPiteratorMarked__SpecInput (epda_to_des C') (epda_to_des S) (epda_to_des P)"

lemma F_DPDA_DFA_CC__fp_start__corresponds_to__FPiteratorMarked__fp_start: "
  valid_dpda S
  \<Longrightarrow> valid_dfa P
  \<Longrightarrow> epda_to_des_opt (F_DPDA_DFA_CC__fp_start S P) = FPinit (epda_to_des P) (epda_to_des S)"
  apply(simp add: epda_to_des_opt_def FPinit_def FPiteratorInit_def F_DPDA_DFA_CC__fp_start_def)
  apply(subgoal_tac "X" for X)
   prefer 2
   apply(rule_tac
      Gi="S"
      and D="P"
      in F_DPDA_DFA_PRODUCT__SOUND1)
   apply(simp add: FUN_DPDA_DFA_PRODUCT__SpecInput1_def F_DPDA_DFA_CC__SpecInput_def)
  apply(simp add: FUN_DPDA_DFA_PRODUCT__SpecOutput1_def)
  apply(clarsimp)
  apply(subgoal_tac "X" for X)
   prefer 2
   apply(rule_tac
      G="F_DPDA_DFA_PRODUCT S P"
      in F_EPDA_TC__SOUND)
   apply(simp add: F_EPDA_TC__SpecInput_def)
  apply(simp add: F_EPDA_TC__SpecOutput_def)
  apply(subgoal_tac "X" for X)
   prefer 2
   apply(rule_tac
      G="F_EPDA_TC (F_DPDA_DFA_PRODUCT S P)::('a DT_symbol, 'b DT_symbol, 'c DT_symbol) epda"
      in F_DPDA_EB_OPT__SOUND)
   apply(simp add: F_DPDA_EB_OPT__SpecInput_def)
   apply(force)
  apply(simp add: F_DPDA_EB_OPT__SpecOutput_def)
  apply(subgoal_tac "epdaH.marked_language (F_DPDA_DFA_PRODUCT S P) = epdaH.marked_language (F_EPDA_TC (F_DPDA_DFA_PRODUCT S P)::('a DT_symbol, 'b DT_symbol, 'c DT_symbol) epda)")
   apply(subgoal_tac "epdaS.marked_language (F_DPDA_DFA_PRODUCT S P) = epdaH.marked_language (F_DPDA_DFA_PRODUCT S P)")
    apply(subgoal_tac "epdaS.marked_language (F_EPDA_TC (F_DPDA_DFA_PRODUCT S P)) = epdaH.marked_language (F_EPDA_TC (F_DPDA_DFA_PRODUCT S P))")
     apply(case_tac "F_DPDA_DFA_CC__fp_start S P::('a DT_symbol, 'b DT_symbol, 'c DT_symbol) epda option")
      apply(clarsimp)
      apply(simp add: F_DPDA_DFA_CC__fp_start_def)
      apply(simp add: IsDES_def bot_DES_ext_def botDES_def)
      apply(simp add: epda_to_des_def)
      apply(simp add: prefix_closure_def prefix_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_eq_DES_ext_def lesseqDES_def nonblockingness_language_def DES_nonblockingness_def DES_controllability_def append_alphabet_def SCP_Controller_Least_Restrictive_Adapted_Specification_def SCP_Controller_Least_Restrictive_Direct_def inf_DES_ext_def infDES_def Enforce_Nonblockingness_DES_def Enforce_Specification_Satisfaction_def)
      apply(simp (no_asm) add: DES_nonblockingness_def epda_to_des_def DES_specification_satisfied_def Enforce_Nonblockingness_DES_def Enforce_Specification_Satisfaction_def des_langM_def des_langUM_def inf_DES_ext_def infDES_def top_DES_ext_def topDES_def)
      apply(force)
     apply(rename_tac a)(*strict*)
     apply(clarsimp)
     apply(simp add: F_DPDA_DFA_CC__fp_start_def)
     apply(simp add: epda_to_des_def)
     apply(simp add: prefix_closure_def prefix_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_eq_DES_ext_def lesseqDES_def nonblockingness_language_def DES_nonblockingness_def DES_controllability_def append_alphabet_def SCP_Controller_Least_Restrictive_Adapted_Specification_def SCP_Controller_Least_Restrictive_Direct_def inf_DES_ext_def infDES_def Enforce_Specification_Satisfaction_def Enforce_Nonblockingness_DES_def)
     apply(simp (no_asm) add: DES_nonblockingness_def epda_to_des_def DES_specification_satisfied_def Enforce_Nonblockingness_DES_def Enforce_Specification_Satisfaction_def des_langM_def des_langUM_def inf_DES_ext_def infDES_def top_DES_ext_def topDES_def)
     apply(clarsimp)
     apply(subgoal_tac "epdaS.unmarked_language a = epdaH.unmarked_language a")
      apply(rename_tac a)(*strict*)
      apply(subgoal_tac "epdaS.marked_language a = epdaH.marked_language a")
       apply(rename_tac a)(*strict*)
       apply(clarsimp)
       apply(rule propSym)
       apply(rule context_conjI)
        apply(rename_tac a)(*strict*)
        apply(rule_tac
      t="epdaH.marked_language a"
      and s="epdaH.marked_language S \<inter> epdaH.marked_language P"
      in ssubst)
         apply(rename_tac a)(*strict*)
         apply(force)
        apply(rename_tac a)(*strict*)
        apply(rule inf.commute)
       apply(rename_tac a)(*strict*)
       apply(clarsimp)
       apply(rename_tac a x c)(*strict*)
       apply(subgoal_tac "x@c \<in> epdaH.marked_language a")
        apply(rename_tac a x c)(*strict*)
        prefer 2
        apply(force)
       apply(rename_tac a x c)(*strict*)
       apply(rule_tac
      v="c"
      in epdaH_unmarked_languageuage_prefix_closed)
        apply(rename_tac a x c)(*strict*)
        apply(simp add: valid_dpda_def valid_pda_def)
       apply(rename_tac a x c)(*strict*)
       apply(rule_tac set_mp)
        apply(rename_tac a x c)(*strict*)
        apply(rule epdaH.lang_inclusion)
        apply (simp add: valid_dpda_def PDA_to_epda)
       apply(rename_tac a x c)(*strict*)
       apply(force)
      apply(rename_tac a)(*strict*)
      apply(rule_tac
      t="epdaH.marked_language SSX"
      and s="epdaS.marked_language SSX" for SSX
      in subst)
       apply(rename_tac a)(*strict*)
       apply(rule epdaS_to_epdaH_mlang)
       apply (simp add: valid_dpda_to_valid_pda PDA_to_epda)
      apply(rename_tac a)(*strict*)
      apply(force)
     apply(rename_tac a)(*strict*)
     apply(rule_tac
      t="epdaH.unmarked_language SSX"
      and s="epdaS.unmarked_language SSX" for SSX
      in subst)
      apply(rename_tac a)(*strict*)
      apply(rule epdaS_to_epdaH_unmarked_language)
      apply (simp add: valid_dpda_to_valid_pda PDA_to_epda)
     apply(rename_tac a)(*strict*)
     apply(force)
    apply(rule_tac
      t="epdaH.marked_language SSX"
      and s="epdaS.marked_language SSX" for SSX
      in subst)
     apply(rule epdaS_to_epdaH_mlang)
     apply(simp add: valid_dpda_def valid_pda_def)
     apply(force)
    apply(force)
   apply(rule_tac
      t="epdaH.marked_language SSX"
      and s="epdaS.marked_language SSX" for SSX
      in subst)
    apply(rule epdaS_to_epdaH_mlang)
    apply(simp add: valid_dpda_def valid_pda_def)
   apply(force)
  apply(subgoal_tac "epdaH.marked_language (F_DPDA_DFA_PRODUCT S P) = epdaS.marked_language (F_DPDA_DFA_PRODUCT S P)")
   apply(subgoal_tac "epdaH.marked_language (F_EPDA_TC (F_DPDA_DFA_PRODUCT S P)) = epdaS.marked_language (F_EPDA_TC (F_DPDA_DFA_PRODUCT S P))")
    apply(force)
   apply(rule_tac
      t="epdaH.marked_language SSX"
      and s="epdaS.marked_language SSX" for SSX
      in subst)
    apply(rule epdaS_to_epdaH_mlang)
    apply(simp add: valid_dpda_def valid_pda_def)
   apply(force)
  apply(rule_tac
      t="epdaH.marked_language SSX"
      and s="epdaS.marked_language SSX" for SSX
      in subst)
   apply(rule epdaS_to_epdaH_mlang)
   apply(simp add: valid_dpda_def valid_pda_def)
  apply(force)
  done

theorem F_DPDA_DFA_CC__fp_start__SOUND: "
  F_DPDA_DFA_CC__fp_start__SpecInput S P
  \<Longrightarrow> R = F_DPDA_DFA_CC__fp_start S P
  \<Longrightarrow> F_DPDA_DFA_CC__fp_start__SpecOutput S P R"
  apply(subgoal_tac "X" for X)
   prefer 2
   apply(rule_tac
      S="S"
      and P="P"
      in F_DPDA_DFA_CC__fp_start__corresponds_to__FPiteratorMarked__fp_start)
    apply(simp add: F_DPDA_DFA_CC__fp_start__SpecInput_def)
   apply(simp add: F_DPDA_DFA_CC__fp_start__SpecInput_def)
  apply(simp add: F_DPDA_DFA_CC__fp_start__SpecOutput_def)
  apply(case_tac "F_DPDA_DFA_CC__fp_start S P")
   apply(clarsimp)
   apply(simp add: epda_to_des_opt_def)
  apply(rename_tac a)(*strict*)
  apply(clarsimp)
  apply(simp add: epda_to_des_opt_def)
  apply(simp add: F_DPDA_DFA_CC__fp_start_def)
  apply(subgoal_tac "X" for X)
   apply(rename_tac a)(*strict*)
   prefer 2
   apply(rule_tac
      Gi="S"
      and D="P"
      in F_DPDA_DFA_PRODUCT__SOUND1)
   apply(simp add: F_DPDA_DFA_CC__fp_start__SpecInput_def FUN_DPDA_DFA_PRODUCT__SpecInput1_def F_DPDA_DFA_CC__SpecInput_def)
  apply(rename_tac a)(*strict*)
  apply(simp add: FUN_DPDA_DFA_PRODUCT__SpecOutput1_def)
  apply(clarsimp)
  apply(subgoal_tac "X" for X)
   apply(rename_tac a)(*strict*)
   prefer 2
   apply(rule_tac
      G="F_DPDA_DFA_PRODUCT S P"
      in F_EPDA_TC__SOUND)
   apply(simp add: F_EPDA_TC__SpecInput_def)
  apply(rename_tac a)(*strict*)
  apply(simp add: F_EPDA_TC__SpecOutput_def)
  apply(subgoal_tac "X" for X)
   apply(rename_tac a)(*strict*)
   prefer 2
   apply(rule_tac
      G="F_EPDA_TC (F_DPDA_DFA_PRODUCT S P)::('a DT_symbol, 'b DT_symbol, 'c DT_symbol) epda"
      in F_DPDA_EB_OPT__SOUND)
   apply(simp add: F_DPDA_EB_OPT__SpecInput_def)
   apply(force)
  apply(rename_tac a)(*strict*)
  apply(simp add: F_DPDA_EB_OPT__SpecOutput_def)
  apply(clarsimp)
  apply(rule conjI)
   apply(rename_tac a)(*strict*)
   apply (metis valid_dpda_def PDA_to_epda epdaS_to_epdaH_accessible)
  apply(rename_tac a)(*strict*)
  apply(simp add: FPiteratorMarked__SpecInput_def)
  apply(rule_tac
      t="FPinit (epda_to_des P) (epda_to_des S)"
      and s="epda_to_des a"
      in ssubst)
   apply(rename_tac a)(*strict*)
   apply(force)
  apply(rename_tac a)(*strict*)
  apply(rule conjI)
   apply(rename_tac a)(*strict*)
   apply(rule epda_to_des_enforces_IsDES)
   apply (metis valid_dpda_def PDA_to_epda)
  apply(rename_tac a)(*strict*)
  apply(rule conjI)
   apply(rename_tac a)(*strict*)
   apply(rule epda_to_des_enforces_IsDES)
   apply (metis valid_dpda_def PDA_to_epda F_DPDA_DFA_CC__fp_start__SpecInput_def)
  apply(rename_tac a)(*strict*)
  apply(rule conjI)
   apply(rename_tac a)(*strict*)
   apply(rule epda_to_des_enforces_IsDES)
   apply (metis valid_dpda_def PDA_to_epda valid_dfa_def F_DPDA_DFA_CC__fp_start__SpecInput_def)
  apply(rename_tac a)(*strict*)
  apply(rule conjI)
   apply(rename_tac a)(*strict*)
   apply(simp add: DES_nonblockingness_def nonblockingness_language_def)
   apply(rule_tac
      t="FPinit (epda_to_des P) (epda_to_des S)"
      and s="epda_to_des a"
      in ssubst)
    apply(rename_tac a)(*strict*)
    apply(force)
   apply(rename_tac a)(*strict*)
   apply(subgoal_tac "epdaS.unmarked_language a = epdaH.unmarked_language a")
    apply(rename_tac a)(*strict*)
    apply(subgoal_tac "epdaS.marked_language a = epdaH.marked_language a")
     apply(rename_tac a)(*strict*)
     apply(simp (no_asm) add: des_langM_def des_langUM_def epda_to_des_def)
     apply(force)
    apply(rename_tac a)(*strict*)
    apply(rule_tac
      t="epdaH.marked_language SSX"
      and s="epdaS.marked_language SSX" for SSX
      in subst)
     apply(rename_tac a)(*strict*)
     apply(rule epdaS_to_epdaH_mlang)
     apply(simp add: valid_dpda_def valid_pda_def)
    apply(rename_tac a)(*strict*)
    apply(force)
   apply(rename_tac a)(*strict*)
   apply(rule_tac
      t="epdaH.unmarked_language SSX"
      and s="epdaS.unmarked_language SSX" for SSX
      in subst)
    apply(rename_tac a)(*strict*)
    apply(rule epdaS_to_epdaH_unmarked_language)
    apply(simp add: valid_dpda_def valid_pda_def)
   apply(rename_tac a)(*strict*)
   apply(force)
  apply(rename_tac a)(*strict*)
  apply(rule conjI)
   apply(rename_tac a)(*strict*)
   apply(simp add: DES_specification_satisfied_def nonblockingness_language_def)
   apply(rule_tac
      t="FPinit (epda_to_des P) (epda_to_des S)"
      and s="epda_to_des a"
      in ssubst)
    apply(rename_tac a)(*strict*)
    apply(force)
   apply(rename_tac a)(*strict*)
   apply(simp (no_asm) add: des_langM_def des_langUM_def epda_to_des_def)
   apply(subgoal_tac "epdaS.unmarked_language a = epdaH.unmarked_language a")
    apply(rename_tac a)(*strict*)
    apply(subgoal_tac "epdaS.unmarked_language S = epdaH.unmarked_language S")
     apply(rename_tac a)(*strict*)
     apply(subgoal_tac "epdaS.marked_language a = epdaH.marked_language a")
      apply(rename_tac a)(*strict*)
      apply(subgoal_tac "epdaS.marked_language S = epdaH.marked_language S")
       apply(rename_tac a)(*strict*)
       apply(subgoal_tac "epdaS.marked_language (F_DPDA_DFA_PRODUCT S P) = epdaH.marked_language (F_DPDA_DFA_PRODUCT S P)")
        apply(rename_tac a)(*strict*)
        apply(simp (no_asm) 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 valid_dpda_def valid_pda_def valid_dfa_def prefix_closure_def prefix_def)
        apply(rule conjI)
         apply(rename_tac a)(*strict*)
         apply(rule_tac
      B="prefix_closure (epdaS.marked_language a)"
      in subset_trans)
          apply(rename_tac a)(*strict*)
          apply(force)
         apply(rename_tac a)(*strict*)
         apply(rule_tac
      B="prefix_closure (epdaS.marked_language S)"
      in subset_trans)
          apply(rename_tac a)(*strict*)
          apply(rule prefix_closure_preserves_subseteq)
          apply(rule_tac
      t="epdaS.marked_language a"
      and s="epdaS.marked_language (F_DPDA_DFA_PRODUCT S P)"
      in ssubst)
           apply(rename_tac a)(*strict*)
           apply(force)
          apply(rename_tac a)(*strict*)
          apply(rule_tac
      t="epdaS.marked_language (F_DPDA_DFA_PRODUCT S P)"
      and s="epdaH.marked_language S \<inter> epdaH.marked_language P"
      in ssubst)
           apply(rename_tac a)(*strict*)
           apply(force)
          apply(rename_tac a)(*strict*)
          apply(force)
         apply(rename_tac a)(*strict*)
         apply(simp only: F_DPDA_DFA_CC__fp_start__SpecInput_def)
         apply(erule conjE)+
         apply (metis Nonblockingness2_def epda_Nonblockingness2 valid_dpda_def PDA_to_epda )
        apply(rename_tac a)(*strict*)
        apply(rule_tac
      t="epdaH.marked_language a"
      and s="epdaS.marked_language a"
      in ssubst)
         apply(rename_tac a)(*strict*)
         apply(force)
        apply(rename_tac a)(*strict*)
        apply(rule_tac
      t="epdaS.marked_language a"
      and s="epdaS.marked_language (F_DPDA_DFA_PRODUCT S P)"
      in ssubst)
         apply(rename_tac a)(*strict*)
         apply(force)
        apply(rename_tac a)(*strict*)
        apply(rule_tac
      t="epdaS.marked_language (F_DPDA_DFA_PRODUCT S P)"
      and s="epdaH.marked_language (F_DPDA_DFA_PRODUCT S P)"
      in ssubst)
         apply(rename_tac a)(*strict*)
         apply(force)
        apply(rename_tac a)(*strict*)
        apply(rule_tac
      t="epdaH.marked_language (F_DPDA_DFA_PRODUCT S P)"
      and s="epdaH.marked_language S \<inter> epdaH.marked_language P"
      in ssubst)
         apply(rename_tac a)(*strict*)
         apply(force)
        apply(rename_tac a)(*strict*)
        apply(force)
       apply(rename_tac a)(*strict*)
       apply(rule_tac
      t="epdaH.marked_language SSX"
      and s="epdaS.marked_language SSX" for SSX
      in subst)
        apply(rename_tac a)(*strict*)
        apply(rule epdaS_to_epdaH_mlang)
        apply(simp add: valid_dpda_def valid_pda_def)
       apply(rename_tac a)(*strict*)
       apply(force)
      apply(rename_tac a)(*strict*)
      apply(simp only: F_DPDA_DFA_CC__fp_start__SpecInput_def)
      apply(erule conjE)+
      apply(rule_tac
      t="epdaH.marked_language SSX"
      and s="epdaS.marked_language SSX" for SSX
      in subst)
       apply(rename_tac a)(*strict*)
       apply(rule epdaS_to_epdaH_mlang)
       apply(simp add: valid_dpda_def valid_pda_def)
      apply(rename_tac a)(*strict*)
      apply(force)
     apply(rename_tac a)(*strict*)
     apply(rule_tac
      t="epdaH.marked_language SSX"
      and s="epdaS.marked_language SSX" for SSX
      in subst)
      apply(rename_tac a)(*strict*)
      apply(rule epdaS_to_epdaH_mlang)
      apply(simp add: valid_dpda_def valid_pda_def)
     apply(rename_tac a)(*strict*)
     apply(force)
    apply(rename_tac a)(*strict*)
    apply(simp only: F_DPDA_DFA_CC__fp_start__SpecInput_def)
    apply(erule conjE)+
    apply(rule_tac
      t="epdaH.unmarked_language SSX"
      and s="epdaS.unmarked_language SSX" for SSX
      in subst)
     apply(rename_tac a)(*strict*)
     apply(rule epdaS_to_epdaH_unmarked_language)
     apply(simp add: valid_dpda_def valid_pda_def)
    apply(rename_tac a)(*strict*)
    apply(force)
   apply(rename_tac a)(*strict*)
   apply(rule_tac
      t="epdaH.unmarked_language SSX"
      and s="epdaS.unmarked_language SSX" for SSX
      in subst)
    apply(rename_tac a)(*strict*)
    apply(rule epdaS_to_epdaH_unmarked_language)
    apply(simp add: valid_dpda_def valid_pda_def)
   apply(rename_tac a)(*strict*)
   apply(force)
  apply(rename_tac a)(*strict*)
  apply(simp (no_asm) add: prefix_closure_def prefix_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_eq_DES_ext_def lesseqDES_def nonblockingness_language_def DES_nonblockingness_def DES_controllability_def append_alphabet_def SCP_Controller_Least_Restrictive_Adapted_Specification_def SCP_Controller_Least_Restrictive_Direct_def inf_DES_ext_def infDES_def)
  apply(simp add: nonblockingness_language_def)
  apply(subgoal_tac "epdaS.unmarked_language a = epdaH.unmarked_language a")
   apply(rename_tac a)(*strict*)
   apply(subgoal_tac "epdaS.unmarked_language P = epdaH.unmarked_language P")
    apply(rename_tac a)(*strict*)
    apply(subgoal_tac "epdaS.marked_language a = epdaH.marked_language a")
     apply(rename_tac a)(*strict*)
     apply(subgoal_tac "epdaS.marked_language P = epdaH.marked_language P")
      apply(rename_tac a)(*strict*)
      apply(subgoal_tac "epdaS.marked_language (F_DPDA_DFA_PRODUCT S P) = epdaH.marked_language (F_DPDA_DFA_PRODUCT S P)")
       apply(rename_tac a)(*strict*)
       apply(rule conjI)
        apply(rename_tac a)(*strict*)
        apply(rule_tac
      B="prefix_closure (epdaS.marked_language a)"
      in subset_trans)
         apply(rename_tac a)(*strict*)
         apply(force)
        apply(rename_tac a)(*strict*)
        apply(rule_tac
      B="prefix_closure (epdaS.marked_language P)"
      in subset_trans)
         apply(rename_tac a)(*strict*)
         apply(rule prefix_closure_preserves_subseteq)
         apply(rule_tac
      t="epdaS.marked_language a"
      and s="epdaS.marked_language (F_DPDA_DFA_PRODUCT S P)"
      in ssubst)
          apply(rename_tac a)(*strict*)
          apply(force)
         apply(rename_tac a)(*strict*)
         apply(rule_tac
      t="epdaS.marked_language (F_DPDA_DFA_PRODUCT S P)"
      and s="epdaH.marked_language S \<inter> epdaH.marked_language P"
      in ssubst)
          apply(rename_tac a)(*strict*)
          apply(force)
         apply(rename_tac a)(*strict*)
         apply(force)
        apply(rename_tac a)(*strict*)
        apply(simp only: F_DPDA_DFA_CC__fp_start__SpecInput_def valid_dfa_def)
        apply(erule conjE)+
        apply (metis Nonblockingness2_def epda_Nonblockingness2 valid_dpda_def PDA_to_epda)
       apply(rename_tac a)(*strict*)
       apply(rule_tac
      t="epdaH.marked_language a"
      and s="epdaS.marked_language a"
      in ssubst)
        apply(rename_tac a)(*strict*)
        apply(force)
       apply(rename_tac a)(*strict*)
       apply(rule_tac
      t="epdaS.marked_language a"
      and s="epdaS.marked_language (F_DPDA_DFA_PRODUCT S P)"
      in ssubst)
        apply(rename_tac a)(*strict*)
        apply(force)
       apply(rename_tac a)(*strict*)
       apply(rule_tac
      t="epdaS.marked_language (F_DPDA_DFA_PRODUCT S P)"
      and s="epdaH.marked_language (F_DPDA_DFA_PRODUCT S P)"
      in ssubst)
        apply(rename_tac a)(*strict*)
        apply(force)
       apply(rename_tac a)(*strict*)
       apply(rule_tac
      t="epdaH.marked_language (F_DPDA_DFA_PRODUCT S P)"
      and s="epdaH.marked_language S \<inter> epdaH.marked_language P"
      in ssubst)
        apply(rename_tac a)(*strict*)
        apply(force)
       apply(rename_tac a)(*strict*)
       apply(force)
      apply(rename_tac a)(*strict*)
      apply(rule_tac
      t="epdaH.marked_language SSX"
      and s="epdaS.marked_language SSX" for SSX
      in subst)
       apply(rename_tac a)(*strict*)
       apply(rule epdaS_to_epdaH_mlang)
       apply(simp add: valid_dpda_def valid_pda_def)
      apply(rename_tac a)(*strict*)
      apply(force)
     apply(rename_tac a)(*strict*)
     apply(simp only: F_DPDA_DFA_CC__fp_start__SpecInput_def)
     apply(erule conjE)+
     apply(rule_tac
      t="epdaH.marked_language SSX"
      and s="epdaS.marked_language SSX" for SSX
      in subst)
      apply(rename_tac a)(*strict*)
      apply(rule epdaS_to_epdaH_mlang)
      apply(simp add: valid_dpda_def valid_pda_def valid_dfa_def)
     apply(rename_tac a)(*strict*)
     apply(force)
    apply(rename_tac a)(*strict*)
    apply(rule_tac
      t="epdaH.marked_language SSX"
      and s="epdaS.marked_language SSX" for SSX
      in subst)
     apply(rename_tac a)(*strict*)
     apply(rule epdaS_to_epdaH_mlang)
     apply(simp add: valid_dpda_def valid_pda_def)
    apply(rename_tac a)(*strict*)
    apply(force)
   apply(rename_tac a)(*strict*)
   apply(simp only: F_DPDA_DFA_CC__fp_start__SpecInput_def)
   apply(erule conjE)+
   apply(rule_tac
      t="epdaH.unmarked_language SSX"
      and s="epdaS.unmarked_language SSX" for SSX
      in subst)
    apply(rename_tac a)(*strict*)
    apply(rule epdaS_to_epdaH_unmarked_language)
    apply(simp add: valid_dpda_def valid_pda_def valid_dfa_def)
   apply(rename_tac a)(*strict*)
   apply(force)
  apply(rename_tac a)(*strict*)
  apply(rule_tac
      t="epdaH.unmarked_language SSX"
      and s="epdaS.unmarked_language SSX" for SSX
      in subst)
   apply(rename_tac a)(*strict*)
   apply(rule epdaS_to_epdaH_unmarked_language)
   apply(simp add: valid_dpda_def valid_pda_def)
  apply(rename_tac a)(*strict*)
  apply(force)
  done

lemma F_DPDA_DFA_CC__SpecOutput__vs__F_DPDA_DFA_CC__fp__SpecOutput: "
  F_DPDA_DFA_CC__SpecOutput S P \<Sigma>UC C = F_DPDA_DFA_CC__fp__SpecOutput S P \<Sigma>UC C"
  apply(simp add: F_DPDA_DFA_CC__SpecOutput_def F_DPDA_DFA_CC__fp__SpecOutput_def)
  apply(case_tac C)
   apply(simp add: botDES_def bot_DES_ext_def)
  apply(force)
  done

theorem F_DPDA_DFA_CC__SOUND: "
  F_DPDA_DFA_CC__SpecInput S P \<Sigma>UC
  \<Longrightarrow> (\<And>C. F_DPDA_DFA_CC__fp_start S P = Some C \<Longrightarrow> FB_iterate_dom (\<lambda>X. F_DPDA_DFA_CC__fp_one X P \<Sigma>UC, C))
  \<Longrightarrow> F_DPDA_DFA_CC__SpecOutput S P \<Sigma>UC (F_DPDA_DFA_CC S P \<Sigma>UC)"
  apply(subgoal_tac "X" for X)
   prefer 2
   apply(rule_tac
      S="S"
      and P="P"
      in F_DPDA_DFA_CC__fp_start__SOUND)
    apply(simp add: F_DPDA_DFA_CC__fp_start__SpecInput_def F_DPDA_DFA_CC__SpecInput_def)
   apply(force)
  apply(simp add: F_DPDA_DFA_CC_def)
  apply(case_tac "F_DPDA_DFA_CC__fp_start S P::('a DT_symbol, 'b DT_symbol, 'c DT_symbol) epda option")
   apply(clarsimp)
   apply(simp add: F_DPDA_DFA_CC__SpecInput_def F_DPDA_DFA_CC__fp_start_def F_DPDA_DFA_CC__SpecOutput_def FPiteratorMarked__fp__SpecOutput_def)
   apply(simp add: SCP_Closed_Loop_Satisfactory_Direct_def IsDES_def bot_DES_ext_def botDES_def)
   apply(simp add: SCP_Closed_Loop_Satisfactory_Direct_def prefix_closure_def prefix_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_eq_DES_ext_def lesseqDES_def nonblockingness_language_def DES_nonblockingness_def DES_controllability_def append_alphabet_def SCP_Controller_Least_Restrictive_Adapted_Specification_def SCP_Controller_Least_Restrictive_Direct_def inf_DES_ext_def infDES_def append_language_def controllable_language_def)
   apply(rule conjI)
    apply(simp add: IsDES_def)
    apply(simp add: prefix_closure_def prefix_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_eq_DES_ext_def lesseqDES_def nonblockingness_language_def DES_nonblockingness_def DES_controllability_def append_alphabet_def SCP_Controller_Least_Restrictive_Adapted_Specification_def SCP_Controller_Least_Restrictive_Direct_def)
   apply(rule order_antisym)
    apply(rule Sup_upper)
    apply(clarsimp)
    apply(simp add: IsDES_def bot_DES_ext_def botDES_def)
    apply(simp add: prefix_closure_def prefix_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_eq_DES_ext_def lesseqDES_def nonblockingness_language_def DES_nonblockingness_def DES_controllability_def append_alphabet_def SCP_Controller_Least_Restrictive_Adapted_Specification_def SCP_Controller_Least_Restrictive_Direct_def inf_DES_ext_def infDES_def)
   apply(rule Sup_least)
   apply(rename_tac x)(*strict*)
   apply(clarsimp)
   apply(simp add: prefix_closure_def prefix_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_eq_DES_ext_def lesseqDES_def nonblockingness_language_def DES_nonblockingness_def DES_controllability_def append_alphabet_def SCP_Controller_Least_Restrictive_Adapted_Specification_def SCP_Controller_Least_Restrictive_Direct_def inf_DES_ext_def infDES_def)
   apply(case_tac x)
   apply(rename_tac x fun1 fun2)(*strict*)
   apply(clarsimp)
   apply(rename_tac fun1 fun2)(*strict*)
   apply(subgoal_tac "epdaH.marked_language S \<inter> epdaH.marked_language P = {}")
    apply(rename_tac fun1 fun2)(*strict*)
    apply(subgoal_tac "fun2={}")
     apply(rename_tac fun1 fun2)(*strict*)
     prefer 2
     apply(force)
    apply(rename_tac fun1 fun2)(*strict*)
    apply(clarsimp)
   apply(rename_tac fun1 fun2)(*strict*)
   apply(subgoal_tac "X" for X)
    apply(rename_tac fun1 fun2)(*strict*)
    prefer 2
    apply(rule_tac
      Gi="S"
      and D="P"
      in F_DPDA_DFA_PRODUCT__SOUND1)
    apply(simp add: FUN_DPDA_DFA_PRODUCT__SpecInput1_def F_DPDA_DFA_CC__SpecInput_def)
   apply(rename_tac fun1 fun2)(*strict*)
   apply(simp add: FUN_DPDA_DFA_PRODUCT__SpecOutput1_def)
   apply(clarsimp)
   apply(subgoal_tac "X" for X)
    apply(rename_tac fun1 fun2)(*strict*)
    prefer 2
    apply(rule_tac
      G="F_DPDA_DFA_PRODUCT S P"
      in F_EPDA_TC__SOUND)
    apply(simp add: F_EPDA_TC__SpecInput_def)
   apply(rename_tac fun1 fun2)(*strict*)
   apply(simp add: F_EPDA_TC__SpecOutput_def)
   apply(subgoal_tac "epdaH.marked_language (F_DPDA_DFA_PRODUCT S P) = epdaH.marked_language (F_EPDA_TC (F_DPDA_DFA_PRODUCT S P)::('a DT_symbol, 'b DT_symbol, 'c DT_symbol) epda)")
    apply(rename_tac fun1 fun2)(*strict*)
    apply(subgoal_tac "X" for X)
     apply(rename_tac fun1 fun2)(*strict*)
     prefer 2
     apply(rule_tac
      G="F_EPDA_TC (F_DPDA_DFA_PRODUCT S P)::('a DT_symbol, 'b DT_symbol, 'c DT_symbol) epda"
      in F_DPDA_EB_OPT__SOUND)
     apply(simp add: F_DPDA_EB_OPT__SpecInput_def)
     apply(force)
    apply(rename_tac fun1 fun2)(*strict*)
    apply(simp add: F_DPDA_EB_OPT__SpecOutput_def)
    apply(clarsimp)
    apply(subgoal_tac "epdaS.marked_language (F_DPDA_DFA_PRODUCT S P) = epdaH.marked_language (F_DPDA_DFA_PRODUCT S P)")
     apply(rename_tac fun1 fun2)(*strict*)
     apply(clarsimp)
    apply(rename_tac fun1 fun2)(*strict*)
    apply(rule epdaS_to_epdaH_mlang)
    apply (metis valid_dpda_to_valid_pda PDA_to_epda)
   apply(rename_tac fun1 fun2)(*strict*)
   apply(rule_tac
      t="epdaH.marked_language (F_EPDA_TC (F_DPDA_DFA_PRODUCT S P))"
      and s="epdaS.marked_language (F_EPDA_TC (F_DPDA_DFA_PRODUCT S P))"
      in subst)
    apply(rename_tac fun1 fun2)(*strict*)
    apply(rule epdaS_to_epdaH_mlang)
    apply (metis valid_dpda_to_valid_pda PDA_to_epda)
   apply(rename_tac fun1 fun2)(*strict*)
   apply(rule_tac
      t="epdaH.marked_language ((F_DPDA_DFA_PRODUCT S P))"
      and s="epdaS.marked_language ((F_DPDA_DFA_PRODUCT S P))"
      in subst)
    apply(rename_tac fun1 fun2)(*strict*)
    apply(rule epdaS_to_epdaH_mlang)
    apply (metis valid_dpda_to_valid_pda PDA_to_epda)
   apply(rename_tac fun1 fun2)(*strict*)
   apply(force)
  apply(rename_tac a)(*strict*)
  apply(clarsimp)
  apply(erule_tac
      x="a"
      in meta_allE)
  apply(clarsimp)
  apply(rename_tac C)
  apply(rename_tac C)(*strict*)
  apply(simp add: F_DPDA_DFA_CC__fp_start__SpecOutput_def)
  apply(clarsimp)
  apply(subgoal_tac "X" for X)
   apply(rename_tac C)(*strict*)
   prefer 2
   apply(rule_tac
      C="C"
      and P="P"
      and \<Sigma>UC="\<Sigma>UC"
      and S="S"
      in F_DPDA_DFA_CC__fp__SOUND)
      apply(rename_tac C)(*strict*)
      prefer 4
      apply(force)
     apply(rename_tac C)(*strict*)
     apply(force)
    apply(rename_tac C)(*strict*)
    apply(force)
   apply(rename_tac C)(*strict*)
   apply(simp add: F_DPDA_DFA_CC__fp__SpecInput_def F_DPDA_DFA_CC__fp_one__SpecInput_def F_DPDA_DFA_CC__SpecInput_def)
  apply(rename_tac C)(*strict*)
  apply(simp add: F_DPDA_DFA_CC__SpecOutput_def botDES_def bot_DES_ext_def)
  apply(simp add: F_DPDA_DFA_CC__fp__SpecOutput_def F_DPDA_DFA_CC__SpecOutput_def botDES_def bot_DES_ext_def)
  apply(case_tac "F_DPDA_DFA_CC__fp C P \<Sigma>UC")
   apply(rename_tac C)(*strict*)
   prefer 2
   apply(rename_tac C a)(*strict*)
   apply(clarsimp)
  apply(simp add: FPiteratorMarked__fp__SpecOutput_def)
  apply(rename_tac C)(*strict*)
  apply(simp add: FPiteratorMarked__fp__SpecOutput_def botDES_def bot_DES_ext_def)
  done

lemma F_DPDA_DFA_CC__SpecOutput__TO__SCP_Closed_Loop_Satisfactory_Direct_adapted: "
  F_DPDA_DFA_CC__SpecInput S P \<Sigma>UC
  \<Longrightarrow> F_DPDA_DFA_CC__SpecOutput S P \<Sigma>UC (Some SOL)
  \<Longrightarrow> epda_to_des (F_DPDA_DFA_PRODUCT SOL P) = Sup (SCP_Closed_Loop_Satisfactory_Direct (epda_to_des P) (inf (epda_to_des P) (epda_to_des S)) \<Sigma>UC)"
  apply(simp add: SCP_SATISFACTORY_CONTROLLER_DPDA_def F_DPDA_DFA_CC__SpecOutput_def F_DPDA_DFA_CC__SpecInput_def FPiteratorMarked__fp__SpecOutput_def SCP_Controller_Least_Restrictive_Adapted_Specification_def SCP_Controller_Least_Restrictive_Direct_def)
  apply(clarsimp)
  apply(subgoal_tac "inf (epda_to_des SOL) (epda_to_des P) = epda_to_des (F_DPDA_DFA_PRODUCT SOL P)")
   prefer 2
   apply(rule F_DPDA_DFA_PRODUCT__epda_to_des)
    apply(force)
   apply(force)
  apply(clarsimp)
  done

lemma F_DPDA_DFA_CC__SpecOutput__TO__SCP_Closed_Loop_Satisfactory_Direct: "
  F_DPDA_DFA_CC__SpecInput S P \<Sigma>UC
  \<Longrightarrow> F_DPDA_DFA_CC__SpecOutput S P \<Sigma>UC (Some SOL)
  \<Longrightarrow> epda_to_des (F_DPDA_DFA_PRODUCT SOL P) = Sup (SCP_Closed_Loop_Satisfactory_Direct (epda_to_des P) (epda_to_des S) \<Sigma>UC)"
  apply(simp add: SCP_SATISFACTORY_CONTROLLER_DPDA_def F_DPDA_DFA_CC__SpecOutput_def F_DPDA_DFA_CC__SpecInput_def FPiteratorMarked__fp__SpecOutput_def SCP_Controller_Least_Restrictive_Direct_def)
  apply(subgoal_tac "inf (epda_to_des SOL) (epda_to_des P) = epda_to_des (F_DPDA_DFA_PRODUCT SOL P)")
   prefer 2
   apply(rule F_DPDA_DFA_PRODUCT__epda_to_des)
    apply(force)
   apply(force)
  apply(subgoal_tac "epda_to_des SOL = epda_to_des (F_DPDA_DFA_PRODUCT SOL P)")
   prefer 2
   apply (metis inf.absorb2 inf.commute)
  apply(clarsimp)
  apply(subgoal_tac "SCP_Controller_Least_Restrictive_Adapted_Specification (epda_to_des P) (epda_to_des S) \<Sigma>UC = SCP_Controller_Least_Restrictive_Direct (epda_to_des P) (epda_to_des S) \<Sigma>UC")
   prefer 2
   apply(rule SCP_Controller_Least_Restrictive_Adapted_Specification_is_equal_to_SCP_Controller_Least_Restrictive_Direct)
   apply(rule epda_to_des_enforces_IsDES)
   apply(simp add: valid_dfa_def valid_pda_def valid_dpda_def)
  apply(simp add: SCP_Controller_Least_Restrictive_Adapted_Specification_def)
  apply(simp add: SCP_SATISFACTORY_CONTROLLER_DPDA_def F_DPDA_DFA_CC__SpecOutput_def F_DPDA_DFA_CC__SpecInput_def FPiteratorMarked__fp__SpecOutput_def SCP_Controller_Least_Restrictive_Adapted_Specification_def SCP_Controller_Least_Restrictive_Direct_def)
  done

lemma F_DPDA_DFA_CC__SpecOutput__TO__SCP_Closed_Loop_Satisfactory: "
  F_DPDA_DFA_CC__SpecInput S P \<Sigma>UC
  \<Longrightarrow> F_DPDA_DFA_CC__SpecOutput S P \<Sigma>UC (Some SOL)
  \<Longrightarrow> epda_to_des (F_DPDA_DFA_PRODUCT SOL P) = Sup (SCP_Closed_Loop_Satisfactory (epda_to_des P) (epda_to_des S) \<Sigma>UC)"
  apply(rule_tac t="SCP_Closed_Loop_Satisfactory (epda_to_des P) (epda_to_des S) \<Sigma>UC" and s="SCP_Closed_Loop_Satisfactory_Direct (epda_to_des P) (epda_to_des S) \<Sigma>UC" in subst)
   apply(rule SCP_Closed_Loop_Satisfactory__vs__SCP_Closed_Loop_Satisfactory_Direct)
    apply(simp add: SCP_SATISFACTORY_CONTROLLER_DPDA_def F_DPDA_DFA_CC__SpecOutput_def F_DPDA_DFA_CC__SpecInput_def FPiteratorMarked__fp__SpecOutput_def SCP_Controller_Least_Restrictive_Direct_def)
    apply (metis epda_to_des_enforces_IsDES valid_dfa_def valid_dpda_def valid_pda_def)
   apply(simp add: SCP_SATISFACTORY_CONTROLLER_DPDA_def F_DPDA_DFA_CC__SpecOutput_def F_DPDA_DFA_CC__SpecInput_def FPiteratorMarked__fp__SpecOutput_def SCP_Controller_Least_Restrictive_Direct_def)
   apply (metis epda_to_des_enforces_IsDES valid_dpda_def valid_pda_def)
  apply(rule F_DPDA_DFA_CC__SpecOutput__TO__SCP_Closed_Loop_Satisfactory_Direct)
   apply(force)
  apply(force)
  done

lemma F_DPDA_DFA_CC__SpecOutput__TO__SCP_SATISFACTORY_CONTROLLER_DPDA: "
  F_DPDA_DFA_CC__SpecInput S P \<Sigma>UC
  \<Longrightarrow> F_DPDA_DFA_CC__SpecOutput S P \<Sigma>UC (Some SOL)
  \<Longrightarrow> SOL \<in> SCP_SATISFACTORY_CONTROLLER_DPDA S P \<Sigma>UC"
  apply(simp add: SCP_SATISFACTORY_CONTROLLER_DPDA_def F_DPDA_DFA_CC__SpecOutput_def F_DPDA_DFA_CC__SpecInput_def FPiteratorMarked__fp__SpecOutput_def SCP_Controller_Least_Restrictive_Adapted_Specification_def SCP_Controller_Least_Restrictive_Direct_def)
  apply(clarsimp)
  apply(subgoal_tac "inf (epda_to_des SOL) (epda_to_des P) = epda_to_des (F_DPDA_DFA_PRODUCT SOL P)")
   prefer 2
   apply(rule F_DPDA_DFA_PRODUCT__epda_to_des)
    apply(force)
   apply(force)
  apply(subgoal_tac "inf (epda_to_des SOL) (epda_to_des P)
   \<in> (SCP_Closed_Loop_Satisfactory_Direct (epda_to_des P)
         (inf (epda_to_des P) (epda_to_des S)) \<Sigma>UC)")
   prefer 2
   apply (metis SCP_Closed_Loop_Satisfactory_Direct_supremum_contained)
  apply(thin_tac "inf (epda_to_des SOL) (epda_to_des P) =
   Sup (SCP_Closed_Loop_Satisfactory_Direct (epda_to_des P)
         (inf (epda_to_des P) (epda_to_des S)) \<Sigma>UC)")
  apply(subgoal_tac "epdaH_specification_satisfaction
    (F_DPDA_DFA_PRODUCT SOL P) S")
   prefer 2
   apply(thin_tac "ATS_Destinations.accessible epdaH_initial_configurations
    epdaH_step_relation epda_destinations
    epdaH_get_destinations SOL")
   apply(rule DES_specification_satisfied_to_epdaH_specification_satisfaction)
        apply(force)
       apply(force)
      apply(force)
     apply(force)
    apply(force)
   apply(force)
  apply(clarsimp)
  apply(subgoal_tac "epdaH_livelock_freedom (F_DPDA_DFA_PRODUCT SOL P)")
   prefer 2
   apply(rule no_epdaH_livelock_implies_F_DPDA_DFA_PRODUCT__epdaH_livelock_freedom)
     apply(force)
    apply(force)
   apply(force)
  apply(clarsimp)
  apply(subgoal_tac "X" for X)
   prefer 2
   apply(rule F_DPDA_DFA_PRODUCT__Nonblockingness_branching)
         apply(force)
        apply(force)
       apply(force)
      apply(force)
     apply(force)
    apply(force)
   apply(force)
  apply(clarsimp)
  apply(subgoal_tac "epdaH_deadlock_freedom (F_DPDA_DFA_PRODUCT SOL P)")
   prefer 2
   apply(rule epdaHNonblockingness_branching__to__epdaH_deadlock_freedom)
     apply(force)
    apply(force)
   apply(force)
  apply(clarsimp)
  done

lemma F_DPDA_DFA_CC__SpecOutput__TO__SCP_SATISFACTORY_CLOSED_LOOP_DPDA: "
  F_DPDA_DFA_CC__SpecInput S P \<Sigma>UC
  \<Longrightarrow> F_DPDA_DFA_CC__SpecOutput S P \<Sigma>UC (Some SOL)
  \<Longrightarrow> F_DPDA_DFA_PRODUCT SOL P \<in> SCP_SATISFACTORY_CLOSED_LOOP_DPDA S P \<Sigma>UC"
  apply(simp add: SCP_SATISFACTORY_CLOSED_LOOP_DPDA_def)
  apply(rule_tac x="SOL" in exI)
  apply(clarsimp)
  apply(rule F_DPDA_DFA_CC__SpecOutput__TO__SCP_SATISFACTORY_CONTROLLER_DPDA)
   apply(force)
  apply(force)
  done

theorem Operational_Soundness2: "
  F_DPDA_DFA_CC__SpecInput S P \<Sigma>UC
  \<Longrightarrow> F_DPDA_DFA_CC__SpecOutput S P \<Sigma>UC None
  \<Longrightarrow> \<not>(\<exists>SOL. SOL \<in> SCP_DPDA_DFA_LEAST_RESTRICTIVE_SATISFACTORY S P \<Sigma>UC)"
  apply(simp add: F_DPDA_DFA_CC__SpecOutput_def FPiteratorMarked__fp__SpecOutput_def SCP_DPDA_DFA_LEAST_RESTRICTIVE_SATISFACTORY_def SCP_Controller_Least_Restrictive_Adapted_Specification_def SCP_Controller_Least_Restrictive_Direct_def)
  apply(clarsimp)
  apply(simp add: F_DPDA_DFA_CC__SpecInput_def SCP_SATISFACTORY_CLOSED_LOOP_DPDA_def SCP_Closed_Loop_Satisfactory_Direct_def)
  apply(erule_tac x="epda_to_des(F_DPDA_DFA_PRODUCT SOL P)" in allE)
  apply(thin_tac "DES_specification_satisfied (epda_to_des S) bot")
  apply(thin_tac "DES_nonblockingness bot")
  apply(thin_tac "DES_controllability \<Sigma>UC (epda_to_des P) bot")
  apply(thin_tac "IsDES bot")
  apply(clarsimp)
  apply(thin_tac "SCP_DPDA_DFA_IS_SUPREMUM (F_DPDA_DFA_PRODUCT C P)
              {F_DPDA_DFA_PRODUCT C P |C. C \<in> SCP_SATISFACTORY_CONTROLLER_DPDA S P \<Sigma>UC}")
  apply(subgoal_tac "valid_dpda (F_DPDA_DFA_PRODUCT SOL P)")
   prefer 2
   apply (rule F_DPDA_DFA_PRODUCT__generates__DPDA)
     prefer 3
     apply(force)
    apply(simp add: SCP_SATISFACTORY_CONTROLLER_DPDA_def)
   apply(force)
  apply(subgoal_tac "epda_to_des (F_DPDA_DFA_PRODUCT C P) \<noteq> bot")
   prefer 2
   apply(rule epda_to_des__of__valid_epda__not_empty)
   apply (simp add:  valid_dpda_def valid_pda_def)
  apply(clarsimp)
  apply(subgoal_tac "IsDES (epda_to_des (F_DPDA_DFA_PRODUCT C P))")
   prefer 2
   apply(rule epda_to_des_enforces_IsDES)
   apply(simp add: SCP_SATISFACTORY_CONTROLLER_DPDA_def)
   apply(clarsimp)
   apply (metis valid_dpda_def valid_pda_def)
  apply(clarsimp)
  apply(subgoal_tac "inf (epda_to_des C) (epda_to_des P) = epda_to_des (F_DPDA_DFA_PRODUCT C P)")
   prefer 2
   apply(rule F_DPDA_DFA_PRODUCT__epda_to_des)
    apply(simp add: F_DPDA_DFA_CC__SpecInput_def F_DPDA_DFA_CC__SpecOutput_def FPiteratorMarked__fp__SpecOutput_def SCP_Controller_Least_Restrictive_Adapted_Specification_def SCP_Controller_Least_Restrictive_Direct_def)
   apply(simp add: SCP_SATISFACTORY_CONTROLLER_DPDA_def)
  apply(subgoal_tac "inf (epda_to_des SOL) (epda_to_des P) = epda_to_des (F_DPDA_DFA_PRODUCT SOL P)")
   prefer 2
   apply(rule F_DPDA_DFA_PRODUCT__epda_to_des)
    apply(simp add: F_DPDA_DFA_CC__SpecInput_def F_DPDA_DFA_CC__SpecOutput_def FPiteratorMarked__fp__SpecOutput_def SCP_Controller_Least_Restrictive_Adapted_Specification_def SCP_Controller_Least_Restrictive_Direct_def)
   apply(simp add: SCP_SATISFACTORY_CONTROLLER_DPDA_def)
  apply(subgoal_tac "epda_to_des (F_DPDA_DFA_PRODUCT C P) \<le> epda_to_des P")
   prefer 2
   apply (metis inf.commute inf_le1)
  apply(subgoal_tac "DES_nonblockingness (epda_to_des (F_DPDA_DFA_PRODUCT C P))")
   prefer 2
   apply(rule SCP_SATISFACTORY_CONTROLLER_DPDA__TO__DES_nonblockingness)
      apply(force)
     apply(force)
    apply(force)
   apply(force)
  apply(clarsimp)
  apply(subgoal_tac "DES_specification_satisfied (inf (epda_to_des P) (epda_to_des S))
           (epda_to_des (F_DPDA_DFA_PRODUCT C P))")
   prefer 2
   apply(rule SCP_SATISFACTORY_CONTROLLER_DPDA__TO__DES_specification_satisfied)
      apply(force)
     apply(force)
    apply(force)
   apply(force)
  apply(clarsimp)
  apply(subgoal_tac "DES_controllability \<Sigma>UC (epda_to_des P) (epda_to_des (F_DPDA_DFA_PRODUCT C P))")
   prefer 2
   apply(rule SCP_SATISFACTORY_CONTROLLER_DPDA__TO_DES_controllability)
     apply(force)
    apply(force)
   apply(force)
  apply(force)
  done

theorem Operational_Soundness: "
  F_DPDA_DFA_CC__SpecInput S P \<Sigma>UC
  \<Longrightarrow> F_DPDA_DFA_CC__SpecOutput S P \<Sigma>UC (Some SOL)
  \<Longrightarrow> SOL \<in> SCP_DPDA_DFA_LEAST_RESTRICTIVE_SATISFACTORY S P \<Sigma>UC
    \<and> epdaH_accessible SOL
    \<and> epdaH_accessible_in_closed_loop SOL (F_DPDA_DFA_PRODUCT SOL P)
    \<and> epda_to_des (F_DPDA_DFA_PRODUCT SOL P) = Sup (SCP_Closed_Loop_Satisfactory (epda_to_des P) (epda_to_des S) \<Sigma>UC)"
  apply(rule context_conjI)
   apply(simp add: SCP_DPDA_DFA_LEAST_RESTRICTIVE_SATISFACTORY_def SCP_DPDA_DFA_IS_SUPREMUM_def)
   apply(rule context_conjI)
    apply(rule F_DPDA_DFA_CC__SpecOutput__TO__SCP_SATISFACTORY_CONTROLLER_DPDA)
     apply(force)
    apply(force)
   apply(subgoal_tac "X" for X)
    prefer 2
    apply(rule F_DPDA_DFA_CC__SpecOutput__TO__SCP_SATISFACTORY_CLOSED_LOOP_DPDA)
     apply(force)
    apply(force)
   apply(clarsimp)
   apply(rule context_conjI)
    apply(subgoal_tac "Sup (epda_to_des ` SCP_SATISFACTORY_CLOSED_LOOP_DPDA S P \<Sigma>UC) = epda_to_des (F_DPDA_DFA_PRODUCT SOL P)")
     apply(force)
    apply(rule antisym)
     apply(rule Sup_least)
     apply(clarsimp)
     apply(simp add: SCP_SATISFACTORY_CLOSED_LOOP_DPDA_def)
     apply(clarsimp)
     apply(rename_tac C1 C2)
     apply(subgoal_tac "inf (epda_to_des C1) (epda_to_des P) = epda_to_des (F_DPDA_DFA_PRODUCT C1 P)")
      prefer 2
      apply(rule F_DPDA_DFA_PRODUCT__epda_to_des)
       apply(simp add: F_DPDA_DFA_CC__SpecInput_def F_DPDA_DFA_CC__SpecOutput_def FPiteratorMarked__fp__SpecOutput_def SCP_Controller_Least_Restrictive_Adapted_Specification_def SCP_Controller_Least_Restrictive_Direct_def)
      apply(simp add: F_DPDA_DFA_CC__SpecInput_def F_DPDA_DFA_CC__SpecOutput_def FPiteratorMarked__fp__SpecOutput_def SCP_Controller_Least_Restrictive_Adapted_Specification_def SCP_Controller_Least_Restrictive_Direct_def)
      apply(simp add: SCP_SATISFACTORY_CONTROLLER_DPDA_def)
     apply(subgoal_tac "inf (epda_to_des SOL) (epda_to_des P) = epda_to_des (F_DPDA_DFA_PRODUCT SOL P)")
      prefer 2
      apply(rule F_DPDA_DFA_PRODUCT__epda_to_des)
       apply(simp add: F_DPDA_DFA_CC__SpecInput_def F_DPDA_DFA_CC__SpecOutput_def FPiteratorMarked__fp__SpecOutput_def SCP_Controller_Least_Restrictive_Adapted_Specification_def SCP_Controller_Least_Restrictive_Direct_def)
      apply(simp add: F_DPDA_DFA_CC__SpecInput_def F_DPDA_DFA_CC__SpecOutput_def FPiteratorMarked__fp__SpecOutput_def SCP_Controller_Least_Restrictive_Adapted_Specification_def SCP_Controller_Least_Restrictive_Direct_def)
     apply(subgoal_tac "inf (epda_to_des C2) (epda_to_des P) = epda_to_des (F_DPDA_DFA_PRODUCT C2 P)")
      prefer 2
      apply(rule F_DPDA_DFA_PRODUCT__epda_to_des)
       apply(simp add: F_DPDA_DFA_CC__SpecInput_def F_DPDA_DFA_CC__SpecOutput_def FPiteratorMarked__fp__SpecOutput_def SCP_Controller_Least_Restrictive_Adapted_Specification_def SCP_Controller_Least_Restrictive_Direct_def)
      apply(simp add: F_DPDA_DFA_CC__SpecInput_def F_DPDA_DFA_CC__SpecOutput_def FPiteratorMarked__fp__SpecOutput_def SCP_Controller_Least_Restrictive_Adapted_Specification_def SCP_Controller_Least_Restrictive_Direct_def)
      apply(simp add: SCP_SATISFACTORY_CONTROLLER_DPDA_def)
     apply(simp add: F_DPDA_DFA_CC__SpecOutput_def FPiteratorMarked__fp__SpecOutput_def SCP_Controller_Least_Restrictive_Adapted_Specification_def SCP_Controller_Least_Restrictive_Direct_def)
     apply(clarsimp)
     apply(rule Sup_upper)
     apply(simp add: SCP_Closed_Loop_Satisfactory_Direct_def F_DPDA_DFA_CC__SpecInput_def)
     apply(rule context_conjI)
      apply(rule epda_to_des_enforces_IsDES)
      apply(simp add: SCP_SATISFACTORY_CONTROLLER_DPDA_def)
      apply(clarsimp)
      apply (metis F_DPDA_DFA_PRODUCT__generates__DPDA valid_dpda_def valid_pda_def)
     apply(rule context_conjI)
      apply(simp add: inf_DES_ext_def infDES_def less_eq_DES_ext_def lesseqDES_def des_langUM_def des_langM_def epda_to_des_def)
      apply(force)
     apply(subgoal_tac "DES_nonblockingness (epda_to_des (F_DPDA_DFA_PRODUCT C2 P))")
      prefer 2
      apply(rule SCP_SATISFACTORY_CONTROLLER_DPDA__TO__DES_nonblockingness)
         apply(force)
        apply(force)
       apply(force)
      apply(force)
     apply(clarsimp)
     apply(subgoal_tac "DES_specification_satisfied (inf (epda_to_des P) (epda_to_des S))
           (epda_to_des (F_DPDA_DFA_PRODUCT C2 P))")
      prefer 2
      apply(rule SCP_SATISFACTORY_CONTROLLER_DPDA__TO__DES_specification_satisfied)
         apply(force)
        apply(force)
       apply(force)
      apply(force)
     apply(clarsimp)
     apply(rule SCP_SATISFACTORY_CONTROLLER_DPDA__TO_DES_controllability)
       apply(force)
      apply(force)
     apply(force)
    apply(rule Sup_upper)
    apply(clarsimp)
   apply(rule F_DPDA_DFA_CC__SpecOutput__TO__SCP_Closed_Loop_Satisfactory)
    apply(force)
   apply(force)
  apply(rule context_conjI)
   apply(simp add: F_DPDA_DFA_CC__SpecOutput_def)
   apply(rule epdaHaccessible__to__epdaH_accessible)
   apply(force)
  apply(rule context_conjI)
   apply(rule epdaH_accessible__implies__epdaH_accessible_in_closed_loop__for__F_DPDA_DFA_PRODUCT__if__language_inclusion)
      apply(simp add: F_DPDA_DFA_CC__SpecInput_def F_DPDA_DFA_CC__SpecOutput_def)
     apply(simp add: F_DPDA_DFA_CC__SpecInput_def F_DPDA_DFA_CC__SpecOutput_def)
    apply(simp add: F_DPDA_DFA_CC__SpecInput_def F_DPDA_DFA_CC__SpecOutput_def FPiteratorMarked__fp__SpecOutput_def)
    apply(simp add: prefix_closure_def prefix_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_eq_DES_ext_def lesseqDES_def nonblockingness_language_def DES_nonblockingness_def DES_controllability_def append_alphabet_def SCP_Controller_Least_Restrictive_Adapted_Specification_def SCP_Controller_Least_Restrictive_Direct_def inf_DES_ext_def infDES_def Enforce_Nonblockingness_DES_def Enforce_Specification_Satisfaction_def)
   apply(force)
  apply(rule F_DPDA_DFA_CC__SpecOutput__TO__SCP_Closed_Loop_Satisfactory)
   apply(force)
  apply(force)
  done

hide_fact F_DPDA_DFA_CC__fp_start__corresponds_to__FPiteratorMarked__fp_start
hide_fact F_DPDA_DFA_CC__fp_start__SOUND
hide_fact F_DPDA_DFA_CC__SOUND

end


theory NumberWang_IPv6
imports
  "../Word_Lib/Word_Lemmas"
begin

section\<open>Helper Lemmas for Low-Level Operations on Machine Words\<close>
text\<open>Needed for IPv6 Syntax\<close>

lemma length_drop_bl: "length (dropWhile Not (to_bl (of_bl bs))) \<le> length bs"
proof -
  have length_takeWhile_Not_replicate_False:
    "length (takeWhile Not (replicate n False @ ls)) = n + length (takeWhile Not ls)"
  for n ls by(subst takeWhile_append2) simp+
  show ?thesis by(simp add: word_rep_drop dropWhile_eq_drop length_takeWhile_Not_replicate_False)
qed

lemma bl_drop_leading_zeros:
      "(of_bl:: bool list \<Rightarrow> 'a::len word) (dropWhile Not bs) =
       (of_bl:: bool list \<Rightarrow> 'a::len word) bs"
by(induction bs) simp_all

lemma bl_length_drop_bound: assumes "length (dropWhile Not bs) \<le> n"
  shows "length (dropWhile Not (to_bl ((of_bl:: bool list \<Rightarrow> 'a::len word) bs))) \<le> n"
proof -
  have bl_length_drop_twice:
      "length (dropWhile Not (to_bl ((of_bl:: bool list \<Rightarrow> 'a::len word) (dropWhile Not bs)))) =
       length (dropWhile Not (to_bl ((of_bl:: bool list \<Rightarrow> 'a::len word) bs)))"
    by(simp add: bl_drop_leading_zeros)
  from length_drop_bl
  have *: "length (dropWhile Not (to_bl ((of_bl:: bool list \<Rightarrow> 'a::len word) bs))) \<le> length (dropWhile Not bs)"
   apply(rule dual_order.trans)
   apply(subst bl_length_drop_twice)
   ..
  show ?thesis
  apply(rule order.trans, rule *)
  using assms by(simp)
qed

lemma length_drop_mask_outer: fixes ip::"'a::len word"
  shows "len_of TYPE('a) - n' = len \<Longrightarrow> length (dropWhile Not (to_bl (ip AND (mask n << n') >> n'))) \<le> len"
  apply(subst Word_Lemmas.word_and_mask_shiftl)
  apply(subst Word_Lib.shiftl_shiftr1)
   apply(simp; fail)
  apply(simp)
  apply(subst Word_Lib.and_mask)
  apply(simp add: word_size)
  apply(simp add: length_drop_mask)
  done
lemma length_drop_mask_inner: fixes ip::"'a::len word"
  shows "n \<le> len_of TYPE('a) - n' \<Longrightarrow> length (dropWhile Not (to_bl (ip AND (mask n << n') >> n'))) \<le> n"
  apply(subst Word_Lemmas.word_and_mask_shiftl)
  apply(subst Word_Lemmas.shiftl_shiftr3)
   apply(simp; fail)
  apply(simp)
  apply(simp add: word_size)
  apply(simp add: Word_Lemmas.mask_twice)
  apply(simp add: length_drop_mask)
  done

lemma mask128: "0xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF = mask 128"
  by(simp add: mask_def)

(*-------------- things for ipv6 syntax round trip property two ------------------*)

(*n small, m large*)
lemma helper_masked_ucast_generic:
  fixes b::"16 word"
  assumes "n + 16 \<le> m" and "m < 128"
  shows "((ucast:: 16 word \<Rightarrow> 128 word) b << n) && (mask 16 << m) = 0"
proof -
  have "x < 2 ^ (m - n)" if mnh2: "x < 0x10000"
    for x::"128 word"
  proof -
    from assms(1) have mnh3: "16 \<le> m - n" by fastforce
    have power_2_16_nat: "(16::nat) \<le> n \<Longrightarrow> (65535::nat) < 2 ^ n" if a:"16 \<le> n"for n
    proof -
      have power2_rule: "a \<le> b \<Longrightarrow> (2::nat)^a \<le> 2 ^ b" for a b by fastforce
      show ?thesis
       apply(subgoal_tac "65536 \<le> 2 ^ n")
        apply(subst Nat.less_eq_Suc_le)
        apply(simp; fail)
       apply(subgoal_tac "(65536::nat) = 2^16")
        subgoal using power2_rule \<open>16 \<le> n\<close> by presburger
       by(simp)
    qed
    have "65536 = unat (65536::128 word)" by auto
    moreover from mnh2 have "unat x <  unat (65536::128 word)" by(rule Word.unat_mono)
    ultimately have x: "unat x < 65536" by simp
    with mnh3 have "unat x < 2 ^ (m - n)"
      apply(rule_tac b=65535 in Orderings.order_class.order.strict_trans1)
       apply(simp_all)
      using power_2_16_nat apply blast
      done
    with assms(2) show ?thesis by(subst word_less_nat_alt) simp
  qed
  hence mnhelper2: "(of_bl::bool list \<Rightarrow> 128 word) (to_bl b) < 2 ^ (m - n)"
    apply(subgoal_tac "(of_bl::bool list \<Rightarrow> 128 word) (to_bl b) < 2^(len_of TYPE(16))")
     apply(simp; fail)
    by(rule Word.of_bl_length_less) simp+
  have mnhelper3: "(of_bl::bool list \<Rightarrow> 128 word) (to_bl b) * 2 ^ n < 2 ^ m"
    apply(rule Word.div_lt_mult)
     apply(rule Word_Lemmas.word_less_two_pow_divI)
       using assms by(simp_all add: mnhelper2 Word_Lib.p2_gt_0)

  from assms show ?thesis
    apply(subst Word.ucast_bl)+
    apply(subst Word.shiftl_of_bl)
    apply(subst Word.of_bl_append)
    apply simp
    apply(subst Word_Lemmas.word_and_mask_shiftl)
    apply(subst Word_Lib.shiftr_div_2n_w)
     subgoal by(simp add: word_size; fail)
    apply(subst Word_Lemmas.word_div_less)
     subgoal by(rule mnhelper3)
    apply simp
    done
qed

lemma unat_of_bl_128_16_less_helper:
  fixes b::"16 word"
  shows "unat ((of_bl::bool list \<Rightarrow> 128 word) (to_bl b)) < 2^16"
proof -
  from Word.word_bl_Rep' have 1: "length (to_bl b) = 16" by simp
  have "unat ((of_bl::bool list \<Rightarrow> 128 word) (to_bl b)) < 2^(length (to_bl b))"
    by(fact Word_Lemmas.unat_of_bl_length)
  with 1 show ?thesis by auto
qed
lemma unat_of_bl_128_16_le_helper: "unat ((of_bl:: bool list \<Rightarrow> 128 word) (to_bl (b::16 word))) \<le> 65535"
proof -
  from unat_of_bl_128_16_less_helper[of b] have
    "unat ((of_bl:: bool list \<Rightarrow> 128 word) (to_bl b)) < 65536" by simp
  from Nat.Suc_leI[OF this] show ?thesis by simp
qed

(*reverse*)
 lemma helper_masked_ucast_reverse_generic:
   fixes b::"16 word"
   assumes "m + 16 \<le> n" and "n \<le> 128 - 16"
   shows "((ucast:: 16 word \<Rightarrow> 128 word) b << n) && (mask 16 << m) = 0"
 proof -

   have power_less_128_helper: "2 ^ n * unat ((of_bl::bool list \<Rightarrow> 128 word) (to_bl b)) < 2 ^ len_of TYPE(128)"
     if n: "n \<le> 128 - 16" for n
   proof -
     have help_mult: "n \<le> l \<Longrightarrow> 2 ^ n * x < 2 ^ l \<longleftrightarrow> x < 2 ^ (l - n)" for x::nat and l
       by (simp add: nat_mult_power_less_eq semiring_normalization_rules(7))
     from n show ?thesis
       apply(subst help_mult)
        subgoal by (simp)
       apply(rule order_less_le_trans)
        apply(rule unat_of_bl_128_16_less_helper)
       apply(rule Power.power_increasing)
        apply(simp_all)
       done
   qed

   have *: "2 ^ m * (2 ^ (n - m) * unat ((of_bl::bool list \<Rightarrow> 128 word) (to_bl b))) =
            2 ^ n * unat ((of_bl::bool list \<Rightarrow> 128 word) (to_bl b))"
   proof(cases "unat ((of_bl::bool list \<Rightarrow> 128 word) (to_bl b)) = 0")
   case True thus ?thesis by simp
   next
   case False
    have help_mult: "x \<noteq> 0 \<Longrightarrow> b * (c * x) = a * (x::nat)  \<longleftrightarrow> b * c = a" for x a b c by simp
    from assms show ?thesis
     apply(subst help_mult[OF False])
     apply(subst Power.monoid_mult_class.power_add[symmetric])
     apply(simp)
     done
   qed

  from assms have "unat ((2 ^ n)::128 word) * unat ((of_bl::bool list \<Rightarrow> 128 word) (to_bl b)) mod 2 ^ len_of TYPE(128) =
        2 ^ m * (2 ^ (n - m) * unat ((of_bl::bool list \<Rightarrow> 128 word) (to_bl b)) mod 2 ^ len_of TYPE(128))"
     apply(subst Word_Miscellaneous.nat_mod_eq')
      subgoal apply(subst Aligned.unat_power_lower)
       subgoal by(simp; fail)
      subgoal by (rule power_less_128_helper) simp
      done
     apply(subst Word_Miscellaneous.nat_mod_eq')
      subgoal by(rule power_less_128_helper) simp
     apply(subst Aligned.unat_power_lower)
      apply(simp; fail)
     apply(simp only: *)
     done
   hence ex_k: "\<exists>k. unat ((2 ^ n)::128 word) * unat ((of_bl::bool list \<Rightarrow> 128 word) (to_bl b)) mod 2 ^ len_of TYPE(128) = 2 ^ m * k"
     by blast

   hence aligned: "is_aligned ((of_bl::bool list \<Rightarrow> 128 word) (to_bl b) << n) m"
     unfolding is_aligned_def
     unfolding dvd_def
     unfolding Word.shiftl_t2n
     unfolding Word.unat_word_ariths(2)
     by assumption

   from assms have of_bl_to_bl_shift_mask: "((of_bl::bool list \<Rightarrow> 128 word) (to_bl b) << n) && mask (16 + m) = 0"
    using is_aligned_mask is_aligned_shiftl by force (*sledgehammer*)

   show ?thesis
    apply(subst Word.ucast_bl)+
    apply(subst Word_Lemmas.word_and_mask_shiftl)
    apply(subst Aligned.aligned_shiftr_mask_shiftl)
     subgoal by (fact aligned)
    subgoal by (fact of_bl_to_bl_shift_mask)
    done
qed

lemma helper_masked_ucast_equal_generic:
  fixes b::"16 word"
  assumes "n \<le> 128 - 16"
  shows "ucast (((ucast:: 16 word \<Rightarrow> 128 word) b << n) && (mask 16 << n) >> n) = b"
proof -
 have ucast_mask: "(ucast:: 16 word \<Rightarrow> 128 word) b && mask 16 = ucast b"
  apply(subst Word_Lib.and_mask_eq_iff_le_mask)
  apply(subst Word.ucast_bl)
  apply(simp add: mask_def)
  thm Word.word_uint_eqI word_le_nat_alt
  apply(subst word_le_nat_alt)
  apply(simp)
  using unat_of_bl_128_16_le_helper by simp

 from assms have "ucast (((ucast:: 16 word \<Rightarrow> 128 word) b && mask (128 - n) && mask 16) && mask (128 - n)) = b"
  apply(subst Word_Lemmas.mask_and_mask)
  apply(simp)
  apply(subst Word.word_bool_alg.conj.assoc)
  apply(subst Word_Lemmas.mask_and_mask)
  apply(simp)
  apply(simp add: ucast_mask Word_Lemmas.ucast_ucast_mask)
  apply(subst Word.mask_eq_iff)
  apply(rule order_less_trans)
   apply(rule Word.uint_lt)
  apply(simp; fail)
  done

 thus ?thesis
  apply(subst Word_Lemmas.word_and_mask_shiftl)
  apply(subst Word_Lemmas.shiftl_shiftr3)
   apply(simp; fail)
  apply(simp)
  apply(subst Word_Lemmas.shiftl_shiftr3)
   apply(simp; fail)
  apply(simp add: word_size)
  apply(subst Word.word_bool_alg.conj.assoc)
  apply assumption
  done
qed

end


(* @SUITE wp *)

theory wp_more
imports "../Hoare_Tactics"
begin

lemma
  assumes "hoare {$z=0} skip {$z+1+2+3+4+5=15}"
  shows "hoare {$z=0} z:=z+1; (z:=z+2; z:=z+3; z:=z+4); z:=z+5 {$z=15}"
  apply wp
  by (fact assms)

end