(*  Title:       Conflict analysis/Acquisition histories
    Author:      Peter Lammich <peter.lammich@uni-muenster.de>
    Maintainer:  Peter Lammich <peter.lammich@uni-muenster.de>
*)
section "Acquisition Histories"
theory AcquisitionHistory
imports ConsInterleave
begin
text_raw \<open>\label{thy:AcquisitionHistory}\<close>

text \<open>The concept of {\em acquisition histories} was introduced by Kahlon, Ivancic, and Gupta \cite{KIG05} as a bounded size abstraction of executions that acquire and release locks that contains enough information
  to decide consistent interleavability. In this work, we use this concept for reentrant monitors.
  As in Section~\ref{thy:ConsInterleave}, we encode monitor usage information in pairs of sets of monitors, and regard lists of such pairs as (abstract) executions.
  An item @{term "(E,U)"} of such a list describes a sequence of steps of the concrete execution that first enters the monitors in @{term E} and then passes through the monitors in @{term U}. The monitors in @{term E} are
  never left by the execution. Note that due to the syntactic binding of monitors to the program structure, any execution of a single thread can be abstracted to a sequence of @{term "(E,U)"}-pairs.
  Restricting the possible schedules (see Section \ref{thy:Normalization}) will allow us to also abstract executions reaching a single program point to a sequence of such pairs.

  We want to decide whether two executions are interleavable. The key observation of \cite{KIG05} is, that two executions @{term "e"} and @{term "e'"} are {\em not} interleavable if and only if
  there is a conflicting pair @{term "(m,m')"} of monitors, such that @{term e} enters (and never leaves) @{term m} and then uses @{term m'} and @{term e'} enters (and never leaves) @{term m'} and then uses @{term m}.

  An acquisition history is a map from monitors to set of monitors. The acquisition history of an execution maps a monitor @{term m} that is allocated at the end of the execution to all monitors that are used after or in the
  same step that finally enters @{term m}. Monitors that are not allocated at the end of an execution are mapped to the empty set. Though originally used for a setting without reentrant monitors, acquisition histories also work
  for our setting with reentrant monitors.

  This theory contains the definition of acquisition histories and acquisition history interleavability, an ordering on acquisition histories that reflects the blocking potential of acquisition histories,
  and a mapping function from paths to acquisition histories that is shown to be compatible with monitor consistent interleaving.\<close>

subsection "Definitions"
text \<open>Acquisition histories are modeled as functions from monitors to sets of monitors. Intuitively @{term "m'\<in>h m"} models that an execution finally is in @{term m}, and monitor @{term m'} has been used (i.e. passed or entered)
  after or at the same time @{term m} has been finally entered. By convention, we have @{term "m\<in>h m"} or @{term "h m = {}"}.
\<close>

  (* TODO: Make acquisition histories an own type, with access and update operator of sort order  *)
definition "ah == { (h::'m \<Rightarrow> 'm set) . \<forall> m. h m = {} \<or> m\<in>h m }"

lemma ah_cases[cases set]: "\<lbrakk>h\<in>ah; h m = {} \<Longrightarrow> P ; m \<in> h m \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
  by (unfold ah_def) blast

subsection "Interleavability"
text \<open>Two acquisition histories @{term h1} and @{term h2} are considered interleavable, iff there is no conflicting pair of monitors @{term m1} and @{term m2},
  where a pair of monitors @{term m1} and @{term m2} is called {\em conflicting} iff @{term m1} is used in @{term h2} after entering @{term m2} and, vice versa, @{term m2} is used in @{term h1} after entering @{term m1}.\<close>
definition
  ah_il :: "('m \<Rightarrow> 'm set) \<Rightarrow> ('m \<Rightarrow> 'm set) \<Rightarrow> bool" (infix "[*]" 65)
  where
  "h1 [*] h2 == \<not>(\<exists>m1 m2. m1\<in>h2 m2 \<and> m2 \<in> h1 m1)"

text \<open>From our convention, it follows (as expected) that the sets of entered monitors (lock-sets) of two interleavable acquisition histories are disjoint\<close>
lemma ah_il_lockset_disjoint:
  "\<lbrakk> h1\<in>ah; h2\<in>ah; h1 [*] h2 \<rbrakk> \<Longrightarrow> h1 m = {} \<or> h2 m = {}"
  by (unfold ah_il_def) (auto elim: ah_cases)

text \<open>Of course, acquisition history interleavability is commutative\<close>
lemma ah_il_commute: "h1 [*] h2 \<Longrightarrow> h2 [*] h1"
  by (unfold ah_il_def) auto

subsection "Used monitors"
text \<open>Let's define the monitors of an acquisition history, as all monitors that occur in the acquisition history\<close>
definition
  mon_ah :: "('m \<Rightarrow> 'm set) \<Rightarrow> 'm set"
  where
  "mon_ah h == \<Union>{ h(m) | m. True}"

subsection "Ordering"
text \<open>The element-wise subset-ordering on acquisition histories intuitively reflects the blocking potential: The bigger the acquisition history, the fewer acquisition histories are interleavable with it.\<close>
text \<open>Note that the Isabelle standard library automatically lifts the subset ordering to functions, so we need no explicit definition here.\<close>

\<comment> \<open>The ordering is compatible with interleavability, i.e.\ smaller acquisition histories are more likely to be interleavable.\<close>
lemma ah_leq_il: "\<lbrakk> h1 [*] h2; h1' \<le> h1; h2' \<le> h2 \<rbrakk> \<Longrightarrow> h1' [*] h2'"
  by (unfold ah_il_def le_fun_def [where 'b="'a set"]) blast+
lemma ah_leq_il_left: "\<lbrakk> h1 [*] h2; h1' \<le> h1 \<rbrakk> \<Longrightarrow> h1' [*] h2" and
      ah_leq_il_right: "\<lbrakk> h1 [*] h2; h2' \<le> h2 \<rbrakk> \<Longrightarrow> h1 [*] h2'"
  by (unfold ah_il_def le_fun_def [where 'b="'a set"]) blast+

subsection "Acquisition histories of executions"
text \<open>Next we define a function that abstracts from executions (lists of enter/use pairs) to acquisition histories\<close>
primrec \<alpha>ah :: "('m set \<times> 'm set) list \<Rightarrow> 'm \<Rightarrow> 'm set" where
  "\<alpha>ah [] m = {}"
| "\<alpha>ah (e#w) m = (if m\<in>fst e then fst e \<union> snd e \<union> mon_pl w else \<alpha>ah w m)"

\<comment> \<open>@{term \<alpha>ah} generates valid acquisition histories\<close>
lemma \<alpha>ah_ah: "\<alpha>ah w \<in> ah"
  apply (induct w)
  apply (unfold ah_def)
  apply simp
  apply (fastforce split: if_split_asm)
  done

lemma \<alpha>ah_hd: "\<lbrakk>m\<in>fst e; x\<in>fst e \<union> snd e \<union> mon_pl w\<rbrakk> \<Longrightarrow> x\<in>\<alpha>ah (e#w) m"
  by auto
lemma \<alpha>ah_tl: "\<lbrakk>m\<notin>fst e; x\<in>\<alpha>ah w m\<rbrakk> \<Longrightarrow> x\<in>\<alpha>ah (e#w) m"
  by auto

lemma \<alpha>ah_cases[cases set, case_names hd tl]: "\<lbrakk>
    x\<in>\<alpha>ah w m;
    !!e w'. \<lbrakk>w=e#w'; m\<in>fst e; x\<in>fst e \<union> snd e \<union> mon_pl w'\<rbrakk> \<Longrightarrow> P;
    !!e w'. \<lbrakk>w=e#w'; m\<notin>fst e; x\<in>\<alpha>ah w' m\<rbrakk> \<Longrightarrow> P
  \<rbrakk> \<Longrightarrow> P"
  by (cases w) (simp_all split: if_split_asm)

lemma \<alpha>ah_cons_cases[cases set, case_names hd tl]: "\<lbrakk>
    x\<in>\<alpha>ah (e#w') m;
    \<lbrakk>m\<in>fst e; x\<in>fst e \<union> snd e \<union> mon_pl w'\<rbrakk> \<Longrightarrow> P;
    \<lbrakk>m\<notin>fst e; x\<in>\<alpha>ah w' m\<rbrakk> \<Longrightarrow> P
  \<rbrakk> \<Longrightarrow> P"
  by (simp_all split: if_split_asm)

lemma mon_ah_subset: "mon_ah (\<alpha>ah w) \<subseteq> mon_pl w"
  by (induct w) (auto simp add: mon_ah_def)

\<comment> \<open>Subwords generate smaller acquisition histories\<close>
lemma \<alpha>ah_ileq: "w1\<preceq>w2 \<Longrightarrow> \<alpha>ah w1 \<le> \<alpha>ah w2"
proof (induct rule: less_eq_list_induct)
  case empty thus ?case by (unfold le_fun_def [where 'b="'a set"], simp)
next
  case (drop l' l a) show ?case
  proof (unfold le_fun_def  [where 'b="'a set"], intro allI subsetI)
    fix m x
    assume A: "x \<in> \<alpha>ah l' m"
    with drop(2) have "x\<in>\<alpha>ah l m" by (unfold le_fun_def  [where 'b="'a set"], auto)
    moreover hence "x\<in>mon_pl l" using mon_ah_subset[unfolded mon_ah_def] by fast
    ultimately show "x\<in>\<alpha>ah (a # l) m" by auto
  qed
next
  case (take a b l' l) show ?case
  proof (unfold le_fun_def [where 'b="'a set"], intro allI subsetI)
    fix m x
    assume A: "x\<in>\<alpha>ah (a#l') m"
    thus "x \<in> \<alpha>ah (b # l) m"
    proof (cases rule: \<alpha>ah_cons_cases)
      case hd
      with mon_pl_ileq[OF take.hyps(2)] and \<open>a = b\<close>
      show ?thesis by auto
    next
      case tl
      with take.hyps(3)[unfolded le_fun_def [where 'b="'a set"]] and \<open>a = b\<close>
      show ?thesis by auto
    qed
  qed
qed

text \<open>We can now prove the relation of monitor consistent interleavability and interleavability of the acquisition histories.\<close>
lemma ah_interleavable1:
  "w \<in> w1 \<otimes>\<^bsub>\<alpha>\<^esub> w2 \<Longrightarrow> \<alpha>ah (map \<alpha> w1) [*] \<alpha>ah (map \<alpha> w2)"
  \<comment> \<open>The lemma is shown by induction on the structure of the monitor consistent interleaving operator\<close>
proof (induct w \<alpha> w1 w2 rule: cil_set_induct_fix\<alpha>)
  case empty show ?case by (simp add: ah_il_def) \<comment> \<open>The base case is trivial by the definition of @{term "([*])"}\<close>
next
  \<comment> \<open>Case: First step comes from the left word\<close>
  case (left e w' w1' w2) show ?case
  proof (rule ccontr) \<comment> \<open>We do a proof by contradiction\<close>
    \<comment> \<open>Assume there is a conflicting pair in the acquisition histories\<close>
    assume "\<not> \<alpha>ah (map \<alpha> (e # w1')) [*] \<alpha>ah (map \<alpha> w2)"
    then obtain m1 m2 where CPAIR: "m1 \<in> \<alpha>ah (map \<alpha> (e#w1')) m2" "m2 \<in> \<alpha>ah (map \<alpha> w2) m1" by (unfold ah_il_def, blast)
    \<comment> \<open>It comes either from the first step or not\<close>
    from CPAIR(1) have "(m2\<in>fst (\<alpha> e) \<and> m1 \<in> fst (\<alpha> e) \<union> snd (\<alpha> e) \<union> mon_pl (map \<alpha> w1')) \<or> (m2\<notin>fst (\<alpha> e) \<and> m1 \<in> \<alpha>ah (map \<alpha> w1') m2)" (is "?CASE1 \<or> ?CASE2")
      by (auto split: if_split_asm)
    moreover {
      \<comment> \<open>Case: One monitor of the conflicting pair is entered in the first step of the left path\<close>
      assume ?CASE1 hence C: "m2\<in>fst (\<alpha> e)" ..
      \<comment> \<open>Because the paths are consistently interleavable, the monitors entered in the first step must not occur in the other path\<close>
      from left(2) mon_ah_subset[of "map \<alpha> w2"] have "fst (\<alpha> e) \<inter> mon_ah (\<alpha>ah (map \<alpha> w2)) = {}" by auto
      \<comment> \<open>But this is a contradiction to being a conflicting pair\<close>
      with C CPAIR(2) have False by (unfold mon_ah_def, blast)
    } moreover {
      \<comment> \<open>Case: The first monitor of the conflicting pair is entered after the first step of the left path\<close>
      assume ?CASE2 hence C: "m1 \<in> \<alpha>ah (map \<alpha> w1') m2" ..
      \<comment> \<open>But this is a contradiction to the induction hypothesis, that says that the acquisition histories of the tail of the left path and the
        right path are interleavable\<close>
      with left(3) CPAIR(2) have False by (unfold ah_il_def, blast)
    } ultimately show False ..
  qed
next
  \<comment> \<open>Case: First step comes from the right word. This case is shown completely analogous\<close>
  case (right e w' w2' w1) show ?case
  proof (rule ccontr)
    assume "\<not> \<alpha>ah (map \<alpha> w1) [*] \<alpha>ah (map \<alpha> (e#w2'))"
    then obtain m1 m2 where CPAIR: "m1 \<in> \<alpha>ah (map \<alpha> w1) m2" "m2 \<in> \<alpha>ah (map \<alpha> (e#w2')) m1" by (unfold ah_il_def, blast)
    from CPAIR(2) have "(m1\<in>fst (\<alpha> e) \<and> m2 \<in> fst (\<alpha> e) \<union> snd (\<alpha> e) \<union> mon_pl (map \<alpha> w2')) \<or> (m1\<notin>fst (\<alpha> e) \<and> m2 \<in> \<alpha>ah (map \<alpha> w2') m1)" (is "?CASE1 \<or> ?CASE2")
      by (auto split: if_split_asm)
    moreover {
      assume ?CASE1 hence C: "m1\<in>fst (\<alpha> e)" ..
      from right(2) mon_ah_subset[of "map \<alpha> w1"] have "fst (\<alpha> e) \<inter> mon_ah (\<alpha>ah (map \<alpha> w1)) = {}" by auto
      with C CPAIR(1) have False by (unfold mon_ah_def, blast)
    } moreover {
      assume ?CASE2 hence C: "m2 \<in> \<alpha>ah (map \<alpha> w2') m1" ..
      with right(3) CPAIR(1) have False by (unfold ah_il_def, blast)
    } ultimately show False ..
  qed
qed

lemma ah_interleavable2:
  assumes A: "\<alpha>ah (map \<alpha> w1) [*] \<alpha>ah (map \<alpha> w2)"
  shows "w1 \<otimes>\<^bsub>\<alpha>\<^esub> w2 \<noteq> {}"
  \<comment> \<open>This lemma is shown by induction on the sum of the word lengths\<close>
proof -
  \<comment> \<open>To apply this induction in Isabelle, we have to rewrite the lemma a bit\<close>
  { fix n
    have "!!w1 w2. \<lbrakk>\<alpha>ah (map \<alpha> w1) [*] \<alpha>ah (map \<alpha> w2); n=length w1 + length w2\<rbrakk> \<Longrightarrow> w1 \<otimes>\<^bsub>\<alpha>\<^esub> w2 \<noteq> {}"
    proof (induct n rule: nat_less_induct[case_names I])
      \<comment> \<open>We first rule out the cases that one of the words is empty\<close>
      case (I n w1 w2) show ?case proof (cases w1)
        \<comment> \<open>If the first word is empty, the lemma is trivial\<close>
        case Nil with I.prems show ?thesis by simp
      next
        case (Cons e1 w1') note CONS1=this show ?thesis proof (cases w2)
          \<comment> \<open>If the second word is empty, the lemma is also trivial\<close>
          case Nil with I.prems show ?thesis by simp
        next
          \<comment> \<open>The interesting case is if both words are not empty\<close>
          case (Cons e2 w2') note CONS2=this
          \<comment> \<open>In this case, we check whether the first step of one of the words can safely be executed without blocking any steps of the other word\<close>
          show ?thesis proof (cases "fst (\<alpha> e1) \<inter> mon_pl (map \<alpha> w2) = {}")
            case True \<comment> \<open>The first step of the first word can safely be executed\<close>
            \<comment> \<open>From the induction hypothesis, we get that there is a consistent interleaving of the rest of the first word and the second word\<close>
            have "w1'\<otimes>\<^bsub>\<alpha>\<^esub>w2 \<noteq> {}" proof -
              from I.prems(1) CONS1 ah_leq_il_left[OF _ \<alpha>ah_ileq[OF le_list_map, OF less_eq_list_drop[OF order_refl]]] have "\<alpha>ah (map \<alpha> w1') [*] \<alpha>ah (map \<alpha> w2)" by fast
              moreover from CONS1 I.prems(2) have "length w1'+length w2 < n" by simp
              ultimately show ?thesis using I.hyps by blast
            qed
            \<comment> \<open>And because the first step of the first word can be safely executed, we can prepend it to that consistent interleaving\<close>
            with cil_cons1[OF _ True] CONS1 show ?thesis by blast
          next
            case False note C1=this
            show ?thesis proof (cases "fst (\<alpha> e2) \<inter> mon_pl (map \<alpha> w1) = {}")
              case True \<comment> \<open>The first step of the second word can safely be executed\<close>
              \<comment> \<open>This case is shown analogously to the latter one\<close>
              have "w1\<otimes>\<^bsub>\<alpha>\<^esub>w2' \<noteq> {}" proof -
                from I.prems(1) CONS2 ah_leq_il_right[OF _ \<alpha>ah_ileq[OF le_list_map, OF less_eq_list_drop[OF order_refl]]] have "\<alpha>ah (map \<alpha> w1) [*] \<alpha>ah (map \<alpha> w2')" by fast
                moreover from CONS2 I.prems(2) have "length w1+length w2' < n" by simp
                ultimately show ?thesis using I.hyps by blast
              qed
              with cil_cons2[OF _ True] CONS2 show ?thesis by blast
            next
              case False note C2=this \<comment> \<open>Neither first step can safely be executed. This is exactly the situation from that we can extract a conflicting pair\<close>
              from C1 C2 obtain m1 m2 where "m1\<in>fst (\<alpha> e1)" "m1\<in>mon_pl (map \<alpha> w2)" "m2\<in>fst (\<alpha> e2)" "m2\<in>mon_pl (map \<alpha> w1)" by blast
              with CONS1 CONS2 have "m2 \<in> \<alpha>ah (map \<alpha> w1) m1" "m1 \<in> \<alpha>ah (map \<alpha> w2) m2" by auto
              \<comment> \<open>But by assumption, there are no conflicting pairs, thus we get a contradiction\<close>
              with I.prems(1) have False by (unfold ah_il_def) blast
              thus ?thesis ..
            qed
          qed
        qed
      qed
    qed
  } with A show ?thesis by blast
qed

text \<open>Finally, we can state the relationship between monitor consistent interleaving and interleaving of acquisition histories\<close>
theorem ah_interleavable:
  "(\<alpha>ah (map \<alpha> w1) [*] \<alpha>ah (map \<alpha> w2)) \<longleftrightarrow> (w1\<otimes>\<^bsub>\<alpha>\<^esub>w2\<noteq>{})"
  using ah_interleavable1 ah_interleavable2 by blast

subsection "Acquisition history backward update"
text \<open>We define a function to update an acquisition history backwards. This function is useful for constructing acquisition histories in backward constraint systems.\<close>
definition
  ah_update :: "('m \<Rightarrow> 'm set) \<Rightarrow> ('m set * 'm set) \<Rightarrow> 'm set \<Rightarrow> ('m \<Rightarrow> 'm set)"
  where
  "ah_update h F M m == if m\<in>fst F then fst F \<union> snd F \<union> M else h m"

text \<open>
  Intuitively, @{term "ah_update h (E,U) M m"} means to prepend a step @{term "(E,U)"} to the acquisition history @{term h} of a path that uses monitors @{term M}. Note that we need the extra parameter @{term M}, since
  an acquisition history does not contain information about the monitors that are used on a path before the first monitor that will not be left has been entered.
\<close>
lemma ah_update_cons: "\<alpha>ah (e#w) = ah_update (\<alpha>ah w) e (mon_pl w)"
  by (auto intro!: ext simp add: ah_update_def)

text \<open>The backward-update function is monotonic in the first and third argument as well as in the used monitors of the second argument.
  Note that it is, in general, not monotonic in the entered monitors of the second argument.\<close>
lemma ah_update_mono: "\<lbrakk>h \<le> h'; F=F'; M\<subseteq>M'\<rbrakk>
  \<Longrightarrow> ah_update h F M \<le> ah_update h' F' M'"
  by (auto simp add: ah_update_def le_fun_def [where 'b="'a set"])
lemma ah_update_mono2: "\<lbrakk>h \<le> h'; U\<subseteq>U'; M\<subseteq>M'\<rbrakk>
  \<Longrightarrow> ah_update h (E,U) M \<le> ah_update h' (E,U') M'"
  by (auto simp add: ah_update_def le_fun_def [where 'b="'a set"])

end


section\<open>Forcing extension satisfying the Continuum Hypothesis\<close>

theory CH
  imports
    Kappa_Closed_Notions
    Cohen_Posets_Relative
begin

context M_ctm2_AC
begin

declare Fn_rel_closed[simp del, rule del, simplified setclass_iff, simp, intro]
declare Fnle_rel_closed[simp del, rule del, simplified setclass_iff, simp, intro]

abbreviation
  Coll :: "i" where
  "Coll \<equiv> Fn\<^bsup>M\<^esup>(\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M\<^esup> 2)"

abbreviation
  Colleq :: "i" where
  "Colleq \<equiv> Fnle\<^bsup>M\<^esup>(\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M\<^esup> 2)"

lemma Coll_in_M[intro,simp]: "Coll \<in> M" by simp

lemma Colleq_refl : "refl(Coll,Colleq)"
  unfolding Fnle_rel_def Fnlerel_def refl_def
  using RrelI by simp

subsection\<open>Collapse forcing is sufficiently closed\<close>

\<comment> \<open>Kunen IV.7.14, only for \<^term>\<open>\<aleph>\<^bsub>1\<^esub>\<close>\<close>
lemma succ_omega_closed_Coll: "succ(\<omega>)-closed\<^bsup>M\<^esup>(Coll,Colleq)"
proof -
  \<comment> \<open>Case for finite sequences\<close>
  have "n\<in>\<omega> \<Longrightarrow> \<forall>f \<in> n \<^sub><\<rightarrow>\<^bsup>M\<^esup> (Coll,converse(Colleq)).
          \<exists>q\<in>M. q \<in> Coll \<and> (\<forall>\<alpha>\<in>M. \<alpha> \<in> n \<longrightarrow> \<langle>q, f ` \<alpha>\<rangle> \<in> Colleq)" for n
  proof (induct rule:nat_induct)
    case 0
    then
    show ?case
      using zero_lt_Aleph_rel1 zero_in_Fn_rel
      by (auto simp del:setclass_iff) (rule bexI[OF _ zero_in_M], auto)
  next
    case (succ x)
    then
    have "\<forall>f\<in>succ(x) \<^sub><\<rightarrow>\<^bsup>M\<^esup> (Coll,converse(Colleq)). \<forall>\<alpha> \<in> succ(x). \<langle>f`x, f ` \<alpha>\<rangle> \<in> Colleq"
    proof(intro ballI)
      fix f \<alpha>
      assume "f\<in>succ(x) \<^sub><\<rightarrow>\<^bsup>M\<^esup> (Coll,converse(Colleq))" "\<alpha>\<in>succ(x)"
      moreover from \<open>x\<in>\<omega>\<close> this
      have "f\<in>succ(x) \<^sub><\<rightarrow> (Coll,converse(Colleq))"
        using mono_seqspace_rel_char nat_into_M
        by simp
      moreover from calculation succ
      consider "\<alpha>\<in>x" | "\<alpha>=x"
        by auto
      then
      show "\<langle>f`x, f ` \<alpha>\<rangle> \<in> Colleq"
      proof(cases)
        case 1
        then
        have "\<langle>\<alpha>, x\<rangle> \<in> Memrel(succ(x))" "x\<in>succ(x)" "\<alpha>\<in>succ(x)"
          by auto
        with \<open>f\<in>succ(x) \<^sub><\<rightarrow> (Coll,converse(Colleq))\<close>
        show ?thesis
          using mono_mapD(2)[OF _ \<open>\<alpha>\<in>succ(x)\<close> _ \<open>\<langle>\<alpha>, x\<rangle> \<in> Memrel(succ(x))\<close>]
          unfolding mono_seqspace_def
          by auto
      next
        case 2
        with \<open>f\<in>succ(x) \<^sub><\<rightarrow> (Coll,converse(Colleq))\<close>
        show ?thesis
          using Colleq_refl mono_seqspace_is_fun[THEN apply_type]
          unfolding refl_def
          by simp
      qed
    qed
    moreover
    note \<open>x\<in>\<omega>\<close>
    moreover from this
    have "f`x \<in> Coll" if "f: succ(x) \<^sub><\<rightarrow>\<^bsup>M\<^esup> (Coll,converse(Colleq))" for f
      using that mono_seqspace_rel_char[simplified, of "succ(x)" Coll "converse(Colleq)"]
        nat_into_M[simplified] mono_seqspace_is_fun[of "converse(Colleq)"]
      by (intro apply_type[of _ "succ(x)"]) (auto simp del:setclass_iff)
    ultimately
    show ?case
      using transM[of _ Coll]
      by (auto dest:transM simp del:setclass_iff, rule_tac x="f`x" in bexI)
        (auto simp del:setclass_iff, simp)
  qed
  moreover
    \<comment> \<open>Interesting case: Countably infinite sequences.\<close>
  have "\<forall>f\<in>M. f \<in> \<omega> \<^sub><\<rightarrow>\<^bsup>M\<^esup> (Coll,converse(Colleq)) \<longrightarrow>
                  (\<exists>q\<in>M. q \<in> Coll \<and> (\<forall>\<alpha>\<in>M. \<alpha> \<in> \<omega> \<longrightarrow> \<langle>q, f ` \<alpha>\<rangle> \<in> Colleq))"
  proof(intro ballI impI)
    fix f
    let ?rnf="f``\<omega>"
    assume "f\<in>M" "f \<in> \<omega> \<^sub><\<rightarrow>\<^bsup>M\<^esup> (Coll,converse(Colleq))"
    moreover from this
    have "f\<in>\<omega> \<^sub><\<rightarrow> (Coll,converse(Colleq))" "f\<in>\<omega> \<rightarrow> Coll"
      using mono_seqspace_rel_char mono_mapD(2) nat_in_M
      by auto
    moreover from this
    have "countable\<^bsup>M\<^esup>(f`x)" if "x\<in>\<omega>" for x
      using that Fn_rel_is_function countable_iff_lesspoll_rel_Aleph_rel_one
      by auto
    moreover from calculation
    have "?rnf \<in> M" "f\<subseteq>\<omega>\<times>Coll"
      using nat_in_M image_closed Pi_iff
      by simp_all
    moreover from calculation
    have 1:"\<exists>d\<in>?rnf. d \<supseteq> h \<and> d \<supseteq> g" if "h \<in> ?rnf" "g \<in> ?rnf" for h g
    proof -
      from calculation
      have "?rnf={f`x . x\<in>\<omega>}"
        using  image_function[of f \<omega>] Pi_iff domain_of_fun
        by auto
      from \<open>?rnf=_\<close> that
      obtain m n where eq:"h=f`m" "g=f`n" "n\<in>\<omega>" "m\<in>\<omega>"
        by auto
      then
      have "m\<union>n\<in>\<omega>" "m\<le>m\<union>n" "n\<le>m\<union>n"
        using Un_upper1_le Un_upper2_le nat_into_Ord by simp_all
      with calculation eq \<open>?rnf=_\<close>
      have "f`(m\<union>n)\<in>?rnf" "f`(m\<union>n) \<supseteq> h" "f`(m\<union>n) \<supseteq> g"
        using Fnle_relD mono_map_lt_le_is_mono converse_refl[OF Colleq_refl]
        by auto
      then
      show ?thesis
        by auto
    qed
    moreover from calculation
    have "?rnf \<subseteq> (\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<rightharpoonup>\<^bsup>##M\<^esup> (nat \<rightarrow>\<^bsup>M\<^esup> 2))"
      using subset_trans[OF image_subset[OF \<open>f\<subseteq>_\<close>,of \<omega>] Fn_rel_subset_PFun_rel]
      by simp
    moreover
    have "\<Union> ?rnf \<in> (\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<rightharpoonup>\<^bsup>##M\<^esup> (nat \<rightarrow>\<^bsup>M\<^esup> 2))"
      using pfun_Un_filter_closed'[OF \<open>?rnf\<subseteq>_\<close> 1]  \<open>?rnf\<in>M\<close>
      by simp
    moreover from calculation
    have "\<Union>?rnf \<prec>\<^bsup>M\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
      using countable_fun_imp_countable_image[of f]
        mem_function_space_rel_abs[simplified,OF nat_in_M Coll_in_M \<open>f\<in>M\<close>]
        countableI[OF lepoll_rel_refl]
        countable_iff_lesspoll_rel_Aleph_rel_one[of "\<Union>?rnf"]
      by auto
    moreover from calculation
    have "\<Union>?rnf\<in>Coll"
      unfolding Fn_rel_def
      by simp
    moreover from calculation
    have "\<Union>?rnf \<supseteq> f ` \<alpha> " if "\<alpha>\<in>\<omega>" for \<alpha>
      using that image_function[OF fun_is_function] domain_of_fun
      by auto
    ultimately
    show "\<exists>q\<in>M. q \<in> Coll \<and> (\<forall>\<alpha>\<in>M. \<alpha> \<in> \<omega> \<longrightarrow> \<langle>q, f ` \<alpha>\<rangle> \<in> Colleq)"
      using Fn_rel_is_function Fnle_relI
      by auto
  qed
  ultimately
  show ?thesis
    unfolding kappa_closed_rel_def by (auto elim!:leE dest:ltD)
qed

end \<comment> \<open>\<^locale>\<open>M_ctm2_AC\<close>\<close>

locale collapse_CH = G_generic3_AC_CH "Fn\<^bsup>M\<^esup>(\<aleph>\<^bsub>1\<^esub>\<^bsup>##M\<^esup>, \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M\<^esup> 2)" "Fnle\<^bsup>M\<^esup>(\<aleph>\<^bsub>1\<^esub>\<^bsup>##M\<^esup>, \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M\<^esup> 2)" 0

sublocale collapse_CH \<subseteq> forcing_notion "Coll" "Colleq" 0
  using zero_lt_Aleph_rel1 by unfold_locales

context collapse_CH
begin

notation Leq (infixl "\<preceq>" 50)
notation Incompatible (infixl "\<bottom>" 50)

abbreviation
  f_G :: "i" (\<open>f\<^bsub>G\<^esub>\<close>) where
  "f\<^bsub>G\<^esub> \<equiv> \<Union>G"

lemma f_G_in_MG[simp]:
  shows "f\<^bsub>G\<^esub> \<in> M[G]"
  using G_in_MG by simp

abbreviation
  dom_dense :: "i\<Rightarrow>i" where
  "dom_dense(x) \<equiv> { p\<in>Coll . x \<in> domain(p) }"

lemma dom_dense_closed[intro,simp]: "x\<in>M \<Longrightarrow> dom_dense(x) \<in> M"
  using separation_in_domain[of x]
  by simp

lemma domain_f_G: assumes "x \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
  shows "x \<in> domain(f\<^bsub>G\<^esub>)"
proof -
  have "(\<lambda>n\<in>\<omega>. 0) \<in> \<omega> \<rightarrow>\<^bsup>M\<^esup> 2"
    using function_space_rel_nonempty[of 0 2 \<omega>]
    by auto
  with assms
  have "dense(dom_dense(x))" "x\<in>M"
    using dense_dom_dense InfCard_rel_Aleph_rel[of 1] transitivity[OF _
       Aleph_rel_closed[of 1,THEN setclass_iff[THEN iffD1]]]
    unfolding dense_def
     by auto
  with assms
  obtain p where "p\<in>dom_dense(x)" "p\<in>G"
    using M_generic_denseD[of "dom_dense(x)"]
    by auto
  then
  show "x \<in> domain(f\<^bsub>G\<^esub>)" by blast
qed

lemma Un_filter_is_function:
  assumes "filter(G)"
  shows "function(\<Union>G)"
proof -
  have "Coll \<subseteq> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<rightharpoonup>\<^bsup>##M\<^esup> (\<omega> \<rightarrow>\<^bsup>M\<^esup> 2)"
    using Fn_rel_subset_PFun_rel
    by simp
  moreover
  have "\<exists> d \<in> Coll. d \<supseteq> f \<and> d \<supseteq> g" if "f\<in>G" "g\<in>G" for f g
    using filter_imp_compat[OF assms \<open>f\<in>G\<close> \<open>g\<in>G\<close>] filterD[OF assms]
    unfolding compat_def compat_in_def
    by auto
  ultimately
  have "\<exists>d \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<rightharpoonup>\<^bsup>##M\<^esup> (\<omega> \<rightarrow>\<^bsup>M\<^esup> 2). d \<supseteq> f \<and> d \<supseteq> g" if "f\<in>G" "g\<in>G" for f g
    using rex_mono[of Coll] that by simp
  moreover
  have "G\<subseteq>Coll"
    using assms
    unfolding filter_def
    by simp
  moreover from this
  have "G \<subseteq> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<rightharpoonup>\<^bsup>##M\<^esup> (\<omega> \<rightarrow>\<^bsup>M\<^esup> 2)"
    using assms unfolding Fn_rel_def
    by auto
  ultimately
  show ?thesis
    using pfun_Un_filter_closed[of G]
    by simp
qed

lemma f_G_funtype:
  shows "f\<^bsub>G\<^esub> : \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<rightarrow> \<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2"
proof -
  have "x \<in> B \<Longrightarrow> B \<in> G \<Longrightarrow> x \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<times> (\<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2)" for B x
  proof -
    assume "x\<in>B" "B\<in>G"
    moreover from this
    have "x \<in> M[G]"
      by (auto dest!: ext.transM simp add:G_in_MG)
    moreover from calculation
    have "x \<in> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<times> (\<omega> \<rightarrow> 2)"
      using Fn_rel_subset_Pow[of "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<omega> \<rightarrow>\<^bsup>M\<^esup> 2",
          OF _ _ function_space_rel_closed] function_space_rel_char
      by (auto dest!: M_genericD)
    moreover from this
    obtain z w where "x=\<langle>z,w\<rangle>" "z\<in>\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "w:\<omega> \<rightarrow> 2" by auto
    moreover from calculation
    have "w \<in> M[G]" by (auto dest:ext.transM)
    ultimately
    show ?thesis using ext.function_space_rel_char by auto
  qed
  moreover
  have "function(f\<^bsub>G\<^esub>)"
    using Un_filter_is_function generic
    by fast
  ultimately
  show ?thesis
    using generic domain_f_G Pi_iff by auto
qed

abbreviation
  surj_dense :: "i\<Rightarrow>i" where
  "surj_dense(x) \<equiv> { p\<in>Coll . x \<in> range(p) }"

lemma surj_dense_closed[intro,simp]:
  "x \<in> \<omega> \<rightarrow>\<^bsup>M\<^esup> 2 \<Longrightarrow> surj_dense(x) \<in> M"
  using separation_in_range transM[of x] by simp

lemma reals_sub_image_f_G:
  assumes "x \<in> \<omega> \<rightarrow>\<^bsup>M\<^esup> 2"
  shows "\<exists>\<alpha>\<in>\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>. f\<^bsub>G\<^esub> ` \<alpha> = x"
proof -
  from assms
  have "dense(surj_dense(x))"
    using dense_surj_dense lepoll_rel_refl InfCard_rel_Aleph_rel
    unfolding dense_def
    by auto
  with \<open>x \<in> \<omega> \<rightarrow>\<^bsup>M\<^esup> 2\<close>
  obtain p where "p\<in>surj_dense(x)" "p\<in>G"
    using M_generic_denseD[of "surj_dense(x)"]
    by blast
  then
  show ?thesis
    using succ_omega_closed_Coll f_G_funtype function_apply_equality[of _ x f_G]
      succ_omega_closed_imp_no_new_reals[symmetric]
    by (auto, rule_tac bexI) (auto simp:Pi_def)
qed

lemma f_G_surj_Aleph_rel1_reals: "f\<^bsub>G\<^esub> \<in> surj\<^bsup>M[G]\<^esup>(\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2)"
  using Aleph_rel_sub_closed
proof (intro ext.mem_surj_abs[THEN iffD2],simp_all)
  show "f\<^bsub>G\<^esub> \<in> surj(\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>, \<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2)"
    using f_G_funtype G_in_MG ext.nat_into_M f_G_in_MG
      reals_sub_image_f_G succ_omega_closed_Coll
      succ_omega_closed_imp_no_new_reals
    unfolding surj_def
    by auto
qed

lemma continuum_rel_le_Aleph1_extension:
  includes G_generic1_lemmas
  shows "2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup> \<le> \<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup>"
proof -
  have "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup> \<in> M[G]" "Ord(\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>)"
    using Card_rel_is_Ord by auto
  moreover from this
  have "\<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2 \<lesssim>\<^bsup>M[G]\<^esup> \<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>"
    using ext.surj_rel_implies_inj_rel[OF f_G_surj_Aleph_rel1_reals]
      f_G_in_MG unfolding lepoll_rel_def by auto
  with \<open>Ord(\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>)\<close>
  have "|\<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2|\<^bsup>M[G]\<^esup> \<le> |\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>|\<^bsup>M[G]\<^esup>"
    using M_subset_MG[OF one_in_G] Aleph_rel_closed[of 1]
    by (rule_tac ext.lepoll_rel_imp_cardinal_rel_le) simp_all
  ultimately
  have "2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup> \<le> |\<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup>|\<^bsup>M[G]\<^esup>"
    using ext.lepoll_rel_imp_cardinal_rel_le[of "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<omega> \<rightarrow>\<^bsup>M[G]\<^esup> 2"]
      ext.Aleph_rel_zero succ_omega_closed_Coll
      succ_omega_closed_imp_Aleph_1_preserved
    unfolding cexp_rel_def by simp
  then
  show "2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup> \<le> \<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup>" by simp
qed

theorem CH: "\<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup> = 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup>"
  using continuum_rel_le_Aleph1_extension ext.Aleph_rel_succ[of 0]
    ext.Aleph_rel_zero ext.csucc_rel_le[of "2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup>" \<omega>]
    ext.Card_rel_cexp_rel ext.cantor_cexp_rel[of \<omega>] ext.Card_rel_nat
    le_anti_sym
  by auto

end \<comment> \<open>\<^locale>\<open>collapse_CH\<close>\<close>

subsection\<open>Models of fragments of $\ZFC + \CH$\<close>

theorem ctm_of_CH:
  assumes
    "M \<approx> \<omega>" "Transset(M)"
    "M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead_CH}"
    "\<Phi> \<subseteq> formula" "M \<Turnstile> { \<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> \<Phi>}"
  shows
    "\<exists>N.
      M \<subseteq> N \<and> N \<approx> \<omega> \<and> Transset(N) \<and> N \<Turnstile> ZC \<union> {\<cdot>CH\<cdot>} \<union> { \<cdot>Replacement(\<phi>)\<cdot> . \<phi> \<in> \<Phi>} \<and>
      (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> (\<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N))"
proof -
  from \<open>M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead_CH}\<close>
  interpret M_ZFC3 M
    using M_satT_overhead_imp_M_ZF3 unfolding overhead_CH_def overhead_notCH_def by auto
  from \<open>M \<Turnstile> ZC \<union> {\<cdot>Replacement(p)\<cdot> . p \<in> overhead_CH}\<close> \<open>Transset(M)\<close>
  interpret M_ZF_ground_CH_trans M
    using M_satT_imp_M_ZF_ground_CH_trans
    unfolding ZC_def by auto
  from \<open>M \<approx> \<omega>\<close>
  obtain enum where "enum \<in> bij(\<omega>,M)"
    using eqpoll_sym unfolding eqpoll_def by blast
  then
  interpret M_ctm2_AC_CH M enum by unfold_locales
  interpret forcing_data1 "Coll" "Colleq" 0 M enum
    using zero_in_Fn_rel[of "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<omega> \<rightarrow>\<^bsup>M\<^esup> 2"]
      zero_top_Fn_rel[of _ "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<omega> \<rightarrow>\<^bsup>M\<^esup> 2"]
      preorder_on_Fnle_rel[of "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<aleph>\<^bsub>1\<^esub>\<^bsup>M\<^esup>" "\<omega> \<rightarrow>\<^bsup>M\<^esup> 2"]
      zero_lt_Aleph_rel1
    by unfold_locales simp_all
  obtain G where "M_generic(G)"
    using generic_filter_existence[OF one_in_P]
    by auto
  moreover from this
  interpret collapse_CH M enum G by unfold_locales
  have "\<aleph>\<^bsub>1\<^esub>\<^bsup>M[G]\<^esup> = 2\<^bsup>\<up>\<aleph>\<^bsub>0\<^esub>\<^bsup>M[G]\<^esup>,M[G]\<^esup>"
    using CH .
  then
  have "M[G], [] \<Turnstile> \<cdot>CH\<cdot>"
    using ext.is_ContHyp_iff
    by (simp add:ContHyp_rel_def)
  then
  have "M[G] \<Turnstile> ZC \<union> {\<cdot>CH\<cdot>}"
    using ext.M_satT_ZC by auto
  moreover
  have "Transset(M[G])" using Transset_MG .
  moreover
  have "M \<subseteq> M[G]" using M_subset_MG[OF one_in_G] generic by simp
  moreover
  note \<open>M \<Turnstile> { \<cdot>Replacement(ground_repl_fm(\<phi>))\<cdot> . \<phi> \<in> \<Phi>}\<close> \<open>\<Phi> \<subseteq> formula\<close>
  ultimately
  show ?thesis
    using Ord_MG_iff MG_eqpoll_nat satT_ground_repl_fm_imp_satT_ZF_replacement_fm[of \<Phi>]
    by (rule_tac x="M[G]" in exI,blast)
qed

corollary ctm_ZFC_imp_ctm_CH:
  assumes
    "M \<approx> \<omega>" "Transset(M)" "M \<Turnstile> ZFC"
  shows
    "\<exists>N.
      M \<subseteq> N \<and> N \<approx> \<omega> \<and> Transset(N) \<and> N \<Turnstile> ZFC \<union> {\<cdot>CH\<cdot>} \<and>
      (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> (\<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N))"
proof -
  from assms
  have "\<exists>N.
      M \<subseteq> N \<and>
        N \<approx> \<omega> \<and>
        Transset(N) \<and>
        N \<Turnstile> ZC \<and> N \<Turnstile> {\<cdot>CH\<cdot>} \<and> N \<Turnstile> {\<cdot>Replacement(x)\<cdot> . x \<in> formula} \<and> (\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)"
    using ctm_of_CH[of M formula] satT_ZFC_imp_satT_ZC[of M]
      satT_mono[OF _ ground_repl_fm_sub_ZFC, of M]
      satT_mono[OF _ ZF_replacement_overhead_CH_sub_ZFC, of M]
      satT_mono[OF _ ZF_replacement_fms_sub_ZFC, of M]
    by (simp add: satT_Un_iff)
  then
  obtain N where "N \<Turnstile> ZC" "N \<Turnstile> {\<cdot>CH\<cdot>}" "N \<Turnstile> {\<cdot>Replacement(x)\<cdot> . x \<in> formula}"
    "M \<subseteq> N" "N \<approx> \<omega>" "Transset(N)" "(\<forall>\<alpha>. Ord(\<alpha>) \<longrightarrow> \<alpha> \<in> M \<longleftrightarrow> \<alpha> \<in> N)"
    by auto
  moreover from this
  have "N \<Turnstile> ZFC"
    using satT_ZC_ZF_replacement_imp_satT_ZFC
    by auto
  moreover from this and \<open>N \<Turnstile> {\<cdot>CH\<cdot>}\<close>
  have "N \<Turnstile> ZFC \<union> {\<cdot>CH\<cdot>}"
    using satT_ZC_ZF_replacement_imp_satT_ZFC
    by auto
  ultimately
  show ?thesis
    by auto
qed

end


            (*-------------------------------------------*
            |                                            |
            |          Liveness of Specifications        |
            |                                            |
            *-------------------------------------------*)

theory SeqCtrl_all
  imports MBP_spec
begin

(*************************************************************

         1. ParaAlgo
         2.
         3.
         4.

 *************************************************************)

(* ----------------------------------------- *
 |                deadlock free              |
 * ----------------------------------------- *)

theorem SeqCtrl_DeadlockFree:
  "finite Blks ==> dag Blks Deps
   ==> DeadlockFree (SeqCtrl Blks Deps) (obsEvent Blks) finish"
  apply (simp add: DeadlockFree_def)
  apply (simp add: failures_def)
  apply (intro allI impI)
  apply (elim exE conjE)
  apply (simp add: SeqCtrl_def)
  apply (insert Seq_trns[of Blks Deps])
   apply (drule_tac x="s" in spec)
   apply (drule_tac x="{}" in spec)
   apply (drule_tac x="P'" in spec)

  apply (simp)
  apply (elim exE conjE disjE)

  (* 1 *)
   apply (simp)
   apply (simp add: refs_def)
   apply (rotate_tac 5)
   apply (erule contrapos_pp)
   apply (simp (no_asm) add: subset_iff)

   apply (case_tac "S' = Blks")

    (* finish *)
    apply (rule_tac x="finish" in exI)
    apply (simp add: obsEvent_def)
    apply (simp add: trn_ex_def)
    apply (rule_tac x="STOP" in exI)
    apply (simp add: Seq_trn_finish)

    (* blk *)
    apply (insert enable_nonempty_all[of Blks Deps])
    apply (drule_tac x="S'" in spec)
    apply (simp)
    apply (drule mp)
     apply (force)
    apply (subgoal_tac "EX n. n : enable Blks Deps S'")
    apply (erule exE)
    apply (rule_tac x="blk n" in exI)
    apply (simp add: obsEvent_def)
    apply (rule conjI)
     apply (simp add: enable_def)
    apply (simp add: trn_ex_def)
    apply (rule_tac x="$Seq Blks Deps (insert n S')" in exI)
    apply (simp add: Seq_trn_blk)

    apply (simp add: enable_def)
    apply (force)

   apply (simp add: rem_tau_append)
  done

end