section \<open> Reactive Hoare Logic \<close>

theory utp_rea_hoare
  imports utp_rea_prog
begin

definition hoare_rp :: "'\<alpha> upred \<Rightarrow> ('\<alpha>, real pos) rdes \<Rightarrow> '\<alpha> upred \<Rightarrow> bool" ("\<lbrace>_\<rbrace>/ _/ \<lbrace>_\<rbrace>\<^sub>r") where
[upred_defs]: "hoare_rp p Q r = ((\<lceil>p\<rceil>\<^sub>S\<^sub>< \<Rightarrow> \<lceil>r\<rceil>\<^sub>S\<^sub>>) \<sqsubseteq> Q)"

lemma hoare_rp_conseq:
  "\<lbrakk> `p \<Rightarrow> p'`; `q' \<Rightarrow> q`; \<lbrace>p'\<rbrace>S\<lbrace>q'\<rbrace>\<^sub>r \<rbrakk> \<Longrightarrow> \<lbrace>p\<rbrace>S\<lbrace>q\<rbrace>\<^sub>r"
  by (rel_auto)

lemma hoare_rp_weaken:
  "\<lbrakk> `p \<Rightarrow> p'`; \<lbrace>p'\<rbrace>S\<lbrace>q\<rbrace>\<^sub>r \<rbrakk> \<Longrightarrow> \<lbrace>p\<rbrace>S\<lbrace>q\<rbrace>\<^sub>r"
  by (rel_auto)

lemma hoare_rp_strengthen:
  "\<lbrakk> `q' \<Rightarrow> q`; \<lbrace>p\<rbrace>S\<lbrace>q'\<rbrace>\<^sub>r \<rbrakk> \<Longrightarrow> \<lbrace>p\<rbrace>S\<lbrace>q\<rbrace>\<^sub>r"
  by (rel_auto)

lemma false_pre_hoare_rp [hoare_safe]: "\<lbrace>false\<rbrace>P\<lbrace>q\<rbrace>\<^sub>r"
  by (rel_auto)

lemma true_post_hoare_rp [hoare_safe]: "\<lbrace>p\<rbrace>Q\<lbrace>true\<rbrace>\<^sub>r"
  by (rel_auto)

lemma miracle_hoare_rp [hoare_safe]: "\<lbrace>p\<rbrace>false\<lbrace>q\<rbrace>\<^sub>r"
  by (rel_auto)

lemma assigns_hoare_rp [hoare_safe]: "`p \<Rightarrow> \<sigma> \<dagger> q` \<Longrightarrow> \<lbrace>p\<rbrace>\<langle>\<sigma>\<rangle>\<^sub>r\<lbrace>q\<rbrace>\<^sub>r"
  by rel_auto

lemma skip_hoare_rp [hoare_safe]: "\<lbrace>p\<rbrace>II\<^sub>r\<lbrace>p\<rbrace>\<^sub>r"
  by rel_auto

lemma seq_hoare_rp: "\<lbrakk> \<lbrace>p\<rbrace>Q\<^sub>1\<lbrace>s\<rbrace>\<^sub>r ; \<lbrace>s\<rbrace>Q\<^sub>2\<lbrace>r\<rbrace>\<^sub>r \<rbrakk> \<Longrightarrow> \<lbrace>p\<rbrace>Q\<^sub>1 ;; Q\<^sub>2\<lbrace>r\<rbrace>\<^sub>r"
  by (rel_auto)

lemma seq_est_hoare_rp [hoare_safe]:
  "\<lbrakk> \<lbrace>true\<rbrace>Q\<^sub>1\<lbrace>p\<rbrace>\<^sub>r ; \<lbrace>p\<rbrace>Q\<^sub>2\<lbrace>p\<rbrace>\<^sub>r \<rbrakk> \<Longrightarrow> \<lbrace>true\<rbrace>Q\<^sub>1 ;; Q\<^sub>2\<lbrace>p\<rbrace>\<^sub>r"
  by (rel_auto)

lemma seq_inv_hoare_rp [hoare_safe]:
  "\<lbrakk> \<lbrace>p\<rbrace>Q\<^sub>1\<lbrace>p\<rbrace>\<^sub>r ; \<lbrace>p\<rbrace>Q\<^sub>2\<lbrace>p\<rbrace>\<^sub>r \<rbrakk> \<Longrightarrow> \<lbrace>p\<rbrace>Q\<^sub>1 ;; Q\<^sub>2\<lbrace>p\<rbrace>\<^sub>r"
  by (rel_auto)

lemma cond_hoare_rp [hoare_safe]:
  "\<lbrakk> \<lbrace>b \<and> p\<rbrace>P\<lbrace>r\<rbrace>\<^sub>r; \<lbrace>\<not>b \<and> p\<rbrace>Q\<lbrace>r\<rbrace>\<^sub>r \<rbrakk> \<Longrightarrow> \<lbrace>p\<rbrace>P \<triangleleft> b \<triangleright>\<^sub>R Q\<lbrace>r\<rbrace>\<^sub>r"
  by (rel_auto)

lemma repeat_hoare_rp [hoare_safe]:
  "\<lbrace>p\<rbrace>Q\<lbrace>p\<rbrace>\<^sub>r \<Longrightarrow> \<lbrace>p\<rbrace>Q \<^bold>^ n\<lbrace>p\<rbrace>\<^sub>r"
  by (induct n, rel_auto+)

lemma UINF_ind_hoare_rp [hoare_safe]:
  "\<lbrakk> \<And> i. \<lbrace>p\<rbrace>Q(i)\<lbrace>r\<rbrace>\<^sub>r \<rbrakk> \<Longrightarrow> \<lbrace>p\<rbrace>\<Sqinter> i \<bullet> Q(i)\<lbrace>r\<rbrace>\<^sub>r"
  by (rel_auto)

lemma star_hoare_rp [hoare_safe]:
  "\<lbrace>p\<rbrace>Q\<lbrace>p\<rbrace>\<^sub>r \<Longrightarrow> \<lbrace>p\<rbrace>Q\<^sup>\<star>\<lbrace>p\<rbrace>\<^sub>r"
  by (simp add: ustar_def hoare_safe)

lemma conj_hoare_rp [hoare_safe]:
  "\<lbrakk> \<lbrace>p\<^sub>1\<rbrace>Q\<^sub>1\<lbrace>r\<^sub>1\<rbrace>\<^sub>r; \<lbrace>p\<^sub>2\<rbrace>Q\<^sub>2\<lbrace>r\<^sub>2\<rbrace>\<^sub>r \<rbrakk> \<Longrightarrow> \<lbrace>p\<^sub>1 \<and> p\<^sub>2\<rbrace>Q\<^sub>1 \<and> Q\<^sub>2\<lbrace>r\<^sub>1 \<and> r\<^sub>2\<rbrace>\<^sub>r"
  by (rel_auto)

lemma iter_hoare_rp [hoare_safe]:
  "\<lbrace>I\<rbrace> P \<lbrace>I\<rbrace>\<^sub>r \<Longrightarrow> \<lbrace>I\<rbrace> P\<^sup>\<star>\<^sup>r \<lbrace>I\<rbrace>\<^sub>r"
  by (metis rrel_theory.utp_star_def seq_hoare_rp skip_hoare_rp star_hoare_rp)

end


header{*Network Security Policy Verification*}
theory Network_Security_Policy_Verification
imports
  TopoS_Interface
  TopoS_Interface_impl
  TopoS_Library
  TopoS_Composition_Theory
  TopoS_Stateful_Policy
  TopoS_Composition_Theory_impl
  TopoS_Stateful_Policy_Algorithm
  TopoS_Stateful_Policy_impl
  TopoS_Impl
begin

section{*A small Tutorial*}

text{*We demonstrate usage of the executable theory.*}

subsection{*Policy*}
text{*The secuity policy is a directed graph.*}
definition policy :: "nat list_graph" where
    "policy \<equiv> \<lparr> nodesL = [1,2,3],
                edgesL = [(1,2), (2,2), (2,3)] \<rparr>"

text{*It is syntactically valid. *}
lemma "valid_list_graph policy" by eval

text{*In contrast, this is not a syntactically valid graph. *}
lemma "\<not> valid_list_graph \<lparr> nodesL = [1,2]::nat list, edgesL = [(1,2), (2,2), (2,3)] \<rparr>" by eval

text{*Our @{const policy} has three rules. *}
lemma "length (edgesL policy) = 3" by eval

subsection{*Security Invariants*}
text{*We construct a security invariant. Node @{term "2::nat"} has confidential data*}
definition BLP_m::"(nat SecurityInvariant)" where
    "BLP_m \<equiv> new_configured_list_SecurityInvariant SINVAR_LIB_BLPtrusted \<lparr>
          node_properties = [2 \<mapsto> \<lparr> privacy_level = 1, trusted = False \<rparr>],
          model_global_properties = ()
          \<rparr>"

text{*We define the list of all security invariants of type @{typ "nat SecurityInvariant list"}.
     The type @{typ nat} is because the policy's nodes are of type @{typ nat}.*}
definition "security_invariants = [BLP_m]"

text{*We can see that the policy does not fulfill the security invariants. *}
lemma "\<not> all_security_requirements_fulfilled security_invariants policy" by eval

text{*We ask why. Obviously, node 2 leaks confidential data to node 3.*}
value "implc_get_offending_flows security_invariants policy"
lemma "implc_get_offending_flows security_invariants policy = [[(2, 3)]]" by eval

text{*
Visualization of the violation (only in interactive mode)
*}
ML{*
vizualize_graph @{context} @{term "security_invariants"} @{term "policy"};
*}

text{*
The policy has a flaw. We throw it away and generate a new one which fulfills the invariants.
*}
definition "max_policy = generate_valid_topology security_invariants \<lparr>nodesL = nodesL policy, edgesL = List.product (nodesL policy) (nodesL policy) \<rparr>"

text{*Calculating the maximum policy*}
value "max_policy"
lemma "max_policy = \<lparr>nodesL = [1, 2, 3], edgesL = [(1, 1), (1, 2), (1, 3), (2, 2), (3, 1), (3, 2), (3, 3)]\<rparr>" by eval

text{*
Visualizing the maximum policy (only in interactive mode)
*}
ML{*
vizualize_graph @{context} @{term "security_invariants"} @{term "max_policy"};
*}

text{*Of course, all security invariants hold for the maximum policy. *}
lemma "all_security_requirements_fulfilled security_invariants max_policy" by eval

subsection{*A stateful implementation*}
text{*We generate a stateful policy*}
definition "stateful_policy = generate_valid_stateful_policy_IFSACS policy security_invariants"

text{*When thinking about it carefully, no flow can be stateful without introducing an information leakage here!*}
value "stateful_policy"
lemma "stateful_policy = \<lparr>hostsL = [1, 2, 3], flows_fixL = [(1, 2), (2, 2), (2, 3)], flows_stateL = []\<rparr>" by eval

text{*
Visualizing the stateful policy (only in interactive mode)
*}
ML_val{*
visualize_edges @{context} @{term "flows_fixL stateful_policy"}
    [("edge [dir=\"arrow\", style=dashed, color=\"#FF8822\", constraint=false]", @{term "flows_stateL stateful_policy"})];
*}

hide_const policy security_invariants max_policy stateful_policy

end


(* Title: Partial_Function_Set.thy
  Author: Andreas Lochbihler, ETH Zurich *)

theory Partial_Function_Set imports Main begin

subsection \<open>Setup for \<open>partial_function\<close> for sets\<close>

lemma (in complete_lattice) lattice_partial_function_definition:
  "partial_function_definitions (\<le>) Sup"
by(unfold_locales)(auto intro: Sup_upper Sup_least)

interpretation set: partial_function_definitions "(\<subseteq>)" Union
by(rule lattice_partial_function_definition)

lemma set_admissible: "set.admissible (\<lambda>f :: 'a \<Rightarrow> 'b set. \<forall>x y. y \<in> f x \<longrightarrow> P x y)"
by(rule ccpo.admissibleI)(auto simp add: fun_lub_Sup)

abbreviation "mono_set \<equiv> monotone (fun_ord (\<subseteq>)) (\<subseteq>)"

lemma fixp_induct_set_scott:
  fixes F :: "'c \<Rightarrow> 'c"
  and U :: "'c \<Rightarrow> 'b \<Rightarrow> 'a set"
  and C :: "('b \<Rightarrow> 'a set) \<Rightarrow> 'c"
  and P :: "'b \<Rightarrow> 'a \<Rightarrow> bool"
  and x and y
  assumes mono: "\<And>x. mono_set (\<lambda>f. U (F (C f)) x)"
  and eq: "f \<equiv> C (ccpo.fixp (fun_lub Sup) (fun_ord (\<le>)) (\<lambda>f. U (F (C f))))"
  and inverse2: "\<And>f. U (C f) = f"
  and step: "\<And>f x y. \<lbrakk> \<And>x y. y \<in> U f x \<Longrightarrow> P x y; y \<in> U (F f) x \<rbrakk> \<Longrightarrow> P x y"
  and enforce_variable_ordering: "x = x"
  and elem: "y \<in> U f x"
  shows "P x y"
using step elem set.fixp_induct_uc[of U F C, OF mono eq inverse2 set_admissible, of P]
by blast

lemma fixp_Sup_le:
  defines "le \<equiv> ((\<le>) :: _ :: complete_lattice \<Rightarrow> _)"
  shows "ccpo.fixp Sup le = ccpo_class.fixp"
proof -
  have "class.ccpo Sup le (<)" unfolding le_def by unfold_locales
  thus ?thesis
    by(simp add: ccpo.fixp_def fixp_def ccpo.iterates_def iterates_def ccpo.iteratesp_def iteratesp_def fun_eq_iff le_def)
qed

lemma fun_ord_le: "fun_ord (\<le>) = (\<le>)"
by(auto simp add: fun_ord_def fun_eq_iff le_fun_def)

lemma fixp_induct_set:
  fixes F :: "'c \<Rightarrow> 'c"
  and U :: "'c \<Rightarrow> 'b \<Rightarrow> 'a set"
  and C :: "('b \<Rightarrow> 'a set) \<Rightarrow> 'c"
  and P :: "'b \<Rightarrow> 'a \<Rightarrow> bool"
  and x and y
  assumes mono: "\<And>x. mono_set (\<lambda>f. U (F (C f)) x)"
  and eq: "f \<equiv> C (ccpo.fixp (fun_lub Sup) (fun_ord (\<le>)) (\<lambda>f. U (F (C f))))"
  and inverse2: "\<And>f. U (C f) = f"

  and step: "\<And>f' x y. \<lbrakk> \<And>x. U f' x = U f' x; y \<in> U (F (C (inf (U f) (\<lambda>x. {y. P x y})))) x \<rbrakk> \<Longrightarrow> P x y"
    \<comment> \<open>partial\_function requires a quantifier over f', so let's have a fake one\<close>
  and elem: "y \<in> U f x"
  shows "P x y"
proof -
  from mono
  have mono': "mono (\<lambda>f. U (F (C f)))"
    by(simp add: fun_ord_le mono_def le_fun_def)
  hence eq': "f \<equiv> C (lfp (\<lambda>f. U (F (C f))))"
    using eq unfolding fun_ord_le fun_lub_Sup fixp_Sup_le by(simp add: lfp_eq_fixp)

  let ?f = "C (lfp (\<lambda>f. U (F (C f))))"
  have step': "\<And>x y. \<lbrakk> y \<in> U (F (C (inf (U ?f) (\<lambda>x. {y. P x y})))) x \<rbrakk> \<Longrightarrow> P x y"
    unfolding eq'[symmetric] by(rule step[OF refl])

  let ?P = "\<lambda>x. {y. P x y}"
  from mono' have "lfp (\<lambda>f. U (F (C f))) \<le> ?P"
    by(rule lfp_induct)(auto intro!: le_funI step' simp add: inverse2)
  with elem show ?thesis
    by(subst (asm) eq')(auto simp add: inverse2 le_fun_def)
qed

declaration \<open>Partial_Function.init "set" @{term set.fixp_fun}
  @{term set.mono_body} @{thm set.fixp_rule_uc} @{thm set.fixp_induct_uc}
  (SOME @{thm fixp_induct_set})\<close>

partial_function (set) test :: "'a list \<Rightarrow> nat \<Rightarrow> bool \<Rightarrow> int set"
where
  "test xs i j = insert 4 (test [] 0 j \<union> test [] 1 True \<inter> test [] 2 False - {5} \<union> uminus ` test [undefined] 0 True \<union> uminus -` test [] 1 False)"

interpretation coset: partial_function_definitions "(\<supseteq>)" Inter
by(rule complete_lattice.lattice_partial_function_definition[OF dual_complete_lattice])

lemma fun_lub_Inf: "fun_lub Inf = (Inf :: _ \<Rightarrow> _ :: complete_lattice)"
by(auto simp add: fun_lub_def fun_eq_iff Inf_fun_def intro: Inf_eqI INF_lower INF_greatest)

lemma fun_ord_ge: "fun_ord (\<ge>) = (\<ge>)"
by(auto simp add: fun_ord_def fun_eq_iff le_fun_def)

lemma coset_admissible: "coset.admissible (\<lambda>f :: 'a \<Rightarrow> 'b set. \<forall>x y. P x y \<longrightarrow> y \<in> f x)"
by(rule ccpo.admissibleI)(auto simp add: fun_lub_Inf)

abbreviation "mono_coset \<equiv> monotone (fun_ord (\<supseteq>)) (\<supseteq>)"

lemma gfp_eq_fixp:
  fixes f :: "'a :: complete_lattice \<Rightarrow> 'a"
  assumes f: "monotone (\<ge>) (\<ge>) f"
  shows "gfp f = ccpo.fixp Inf (\<ge>) f"
proof (rule antisym)
  from f have f': "mono f" by(simp add: mono_def monotone_def)

  interpret ccpo Inf "(\<ge>)" "mk_less (\<ge>) :: 'a \<Rightarrow> _"
    by(rule ccpo)(rule complete_lattice.lattice_partial_function_definition[OF dual_complete_lattice])
  show "ccpo.fixp Inf (\<ge>) f \<le> gfp f"
    by(rule gfp_upperbound)(subst fixp_unfold[OF f], rule order_refl)

  show "gfp f \<le> ccpo.fixp Inf (\<ge>) f"
    by(rule fixp_lowerbound[OF f])(subst gfp_unfold[OF f'], rule order_refl)
qed

lemma fixp_coinduct_set:
  fixes F :: "'c \<Rightarrow> 'c"
  and U :: "'c \<Rightarrow> 'b \<Rightarrow> 'a set"
  and C :: "('b \<Rightarrow> 'a set) \<Rightarrow> 'c"
  and P :: "'b \<Rightarrow> 'a \<Rightarrow> bool"
  and x and y
  assumes mono: "\<And>x. mono_coset (\<lambda>f. U (F (C f)) x)"
  and eq: "f \<equiv> C (ccpo.fixp (fun_lub Inter) (fun_ord (\<ge>)) (\<lambda>f. U (F (C f))))"
  and inverse2: "\<And>f. U (C f) = f"

  and step: "\<And>f' x y. \<lbrakk> \<And>x. U f' x = U f' x; \<not> P x y \<rbrakk> \<Longrightarrow> y \<in> U (F (C (sup (\<lambda>x. {y. \<not> P x y}) (U f)))) x"
    \<comment> \<open>partial\_function requires a quantifier over f', so let's have a fake one\<close>
  and elem: "y \<notin> U f x"
  shows "P x y"
using elem
proof(rule contrapos_np)
  have mono': "monotone (\<ge>) (\<ge>) (\<lambda>f. U (F (C f)))"
    and mono'': "mono (\<lambda>f. U (F (C f)))"
    using mono by(simp_all add: monotone_def fun_ord_def le_fun_def mono_def)
  hence eq': "U f = gfp (\<lambda>f. U (F (C f)))"
    by(subst eq)(simp add: fun_lub_Inf fun_ord_ge gfp_eq_fixp inverse2)

  let ?P = "\<lambda>x. {y. \<not> P x y}"
  have "?P \<le> gfp (\<lambda>f. U (F (C f)))"
    using mono'' by(rule coinduct)(auto intro!:  le_funI dest: step[OF refl] simp add: eq')
  moreover
  assume "\<not> P x y"
  ultimately show "y \<in> U f x" by(auto simp add: le_fun_def eq')
qed

declaration \<open>Partial_Function.init "coset" @{term coset.fixp_fun}
  @{term coset.mono_body} @{thm coset.fixp_rule_uc} @{thm coset.fixp_induct_uc}
  (SOME @{thm fixp_coinduct_set})\<close>

abbreviation "mono_set' \<equiv> monotone (fun_ord (\<supseteq>)) (\<supseteq>)"

lemma [partial_function_mono]:
  shows insert_mono': "mono_set' A \<Longrightarrow> mono_set' (\<lambda>f. insert x (A f))"
  and UNION_mono': "\<lbrakk>mono_set' B; \<And>y. mono_set' (\<lambda>f. C y f)\<rbrakk> \<Longrightarrow> mono_set' (\<lambda>f. \<Union>y\<in>B f. C y f)"
  and set_bind_mono': "\<lbrakk>mono_set' B; \<And>y. mono_set' (\<lambda>f. C y f)\<rbrakk> \<Longrightarrow> mono_set' (\<lambda>f. Set.bind (B f) (\<lambda>y. C y f))"
  and Un_mono': "\<lbrakk> mono_set' A; mono_set' B \<rbrakk> \<Longrightarrow> mono_set' (\<lambda>f. A f \<union> B f)"
  and Int_mono': "\<lbrakk> mono_set' A; mono_set' B \<rbrakk> \<Longrightarrow> mono_set' (\<lambda>f. A f \<inter> B f)"
unfolding bind_UNION by(fast intro!: monotoneI dest: monotoneD)+

context begin
private partial_function (coset) test2 :: "nat \<Rightarrow> nat set"
where "test2 x = insert x (test2 (Suc x))"

private lemma test2_coinduct:
  assumes "P x y"
  and *: "\<And>x y. P x y \<Longrightarrow> y = x \<or> (P (Suc x) y \<or> y \<in> test2 (Suc x))"
  shows "y \<in> test2 x"
using \<open>P x y\<close>
apply(rule contrapos_pp)
apply(erule test2.raw_induct[rotated])
apply(simp add: *)
done

end

end


theory ArityAnalysisSig
imports Launchbury.Terms AEnv "Arity-Nominal" "Launchbury.Nominal-HOLCF"  Launchbury.Substitution
begin

locale ArityAnalysis =
  fixes Aexp :: "exp \<Rightarrow> Arity \<rightarrow> AEnv"
begin
  abbreviation Aexp_syn ("\<A>\<^bsub>_\<^esub>")where "\<A>\<^bsub>a\<^esub> e \<equiv> Aexp e\<cdot>a"
  abbreviation Aexp_bot_syn ("\<A>\<^sup>\<bottom>\<^bsub>_\<^esub>")
    where "\<A>\<^sup>\<bottom>\<^bsub>a\<^esub> e \<equiv> fup\<cdot>(Aexp e)\<cdot>a"

end

locale ArityAnalysisHeap =
  fixes Aheap :: "heap \<Rightarrow> exp \<Rightarrow> Arity \<rightarrow> AEnv"

locale EdomArityAnalysis = ArityAnalysis +
  assumes Aexp_edom: "edom (\<A>\<^bsub>a\<^esub> e) \<subseteq> fv e"
begin

  lemma fup_Aexp_edom: "edom (\<A>\<^sup>\<bottom>\<^bsub>a\<^esub> e) \<subseteq> fv e"
    by (cases a) (auto dest:subsetD[OF Aexp_edom])

  lemma Aexp_fresh_bot[simp]: assumes "atom v \<sharp> e" shows "\<A>\<^bsub>a\<^esub> e v = \<bottom>"
  proof-
    from assms have "v \<notin> fv e" by (metis fv_not_fresh)
    with Aexp_edom have "v \<notin> edom (\<A>\<^bsub>a\<^esub> e)" by auto
    thus ?thesis unfolding edom_def by simp
  qed
end

locale ArityAnalysisHeapEqvt = ArityAnalysisHeap +
  assumes Aheap_eqvt[eqvt]: "\<pi> \<bullet> Aheap = Aheap"

end


(*  Title:      HOL/MicroJava/BV/JVM.thy

    Author:     Tobias Nipkow, Gerwin Klein
    Copyright   2000 TUM
*)

section \<open>Kildall for the JVM \label{sec:JVM}\<close>

theory BVExec
imports "../DFA/Abstract_BV" TF_JVM "../DFA/Typing_Framework_2"
begin

definition kiljvm :: "jvm_prog \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> ty \<Rightarrow>
             instr list \<Rightarrow> ex_table \<Rightarrow> ty\<^sub>i' err list \<Rightarrow> ty\<^sub>i' err list"
where
  "kiljvm P mxs mxl T\<^sub>r is xt \<equiv>
  kildall (JVM_SemiType.le P mxs mxl) (JVM_SemiType.sup P mxs mxl)
          (exec P mxs T\<^sub>r xt is)"

definition wt_kildall :: "jvm_prog \<Rightarrow> cname \<Rightarrow> ty list \<Rightarrow> ty \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow>
                 instr list \<Rightarrow> ex_table \<Rightarrow> bool"
where
  "wt_kildall P C' Ts T\<^sub>r mxs mxl\<^sub>0 is xt \<equiv>
   0 < size is \<and>
   (let first  = Some ([],[OK (Class C')]@(map OK Ts)@(replicate mxl\<^sub>0 Err));
        start  = OK first#(replicate (size is - 1) (OK None));
        result = kiljvm P mxs (1+size Ts+mxl\<^sub>0) T\<^sub>r is xt  start
    in \<forall>n < size is. result!n \<noteq> Err)"

definition wf_jvm_prog\<^sub>k :: "jvm_prog \<Rightarrow> bool"
where
  "wf_jvm_prog\<^sub>k P \<equiv>
  wf_prog (\<lambda>P C' (M,Ts,T\<^sub>r,(mxs,mxl\<^sub>0,is,xt)). wt_kildall P C' Ts T\<^sub>r mxs mxl\<^sub>0 is xt) P"

context start_context
begin

lemma Cons_less_Conss3 [simp]:
  "x#xs [\<sqsubset>\<^bsub>r\<^esub>] y#ys = (x \<sqsubset>\<^bsub>r\<^esub> y \<and> xs [\<sqsubseteq>\<^bsub>r\<^esub>] ys \<or> x = y \<and> xs [\<sqsubset>\<^bsub>r\<^esub>] ys)"
  apply (unfold lesssub_def )
  apply auto
  apply (insert sup_state_opt_err)
  apply (unfold lesssub_def lesub_def sup_state_opt_def sup_state_def sup_ty_opt_def)
  apply (simp only: JVM_le_unfold )
  apply fastforce
  done

lemma acc_le_listI3 [intro!]:
  " acc r \<Longrightarrow> acc (Listn.le r)"
apply (unfold acc_def)
apply (subgoal_tac
 "wf(UN n. {(ys,xs). size xs = n \<and> size ys = n \<and> xs <_(Listn.le r) ys})")
   apply (erule wf_subset)
 apply (blast intro: lesssub_lengthD)
apply (rule wf_UN)
 prefer 2
 apply (rename_tac m n)
 apply (case_tac "m=n")
  apply simp
 apply (fast intro!: equals0I dest: not_sym)
apply (rename_tac n)
apply (induct_tac n)
 apply (simp add: lesssub_def cong: conj_cong)
apply (rename_tac k)
apply (simp add: wf_eq_minimal del: r_def f_def step_def A_def)
apply (simp (no_asm) add: length_Suc_conv cong: conj_cong del: r_def f_def step_def A_def)
apply clarify
apply (rename_tac M m)
apply (case_tac "\<exists>x xs. size xs = k \<and> x#xs \<in> M")
 prefer 2
 apply (erule thin_rl)
 apply (erule thin_rl)
 apply blast
apply (erule_tac x = "{a. \<exists>xs. size xs = k \<and> a#xs:M}" in allE)
apply (erule impE)
 apply blast
apply (thin_tac "\<exists>x xs. P x xs" for P)
apply clarify
apply (rename_tac maxA xs)
apply (erule_tac x = "{ys. size ys = size xs \<and> maxA#ys \<in> M}" in allE)
apply (erule impE)
 apply blast
apply clarify
apply (thin_tac "m \<in> M")
apply (thin_tac "maxA#xs \<in> M")
apply (rule bexI)
 prefer 2
 apply assumption
apply clarify
apply (simp del: r_def f_def step_def A_def)
apply blast
  done

lemma wf_jvm: " wf {(ss', ss). ss [\<sqsubset>\<^bsub>r\<^esub>] ss'}"
  apply (insert acc_le_listI3 acc_JVM [OF wf])
  by (simp add: acc_def r_def)

lemma iter_properties_bv[rule_format]:
shows "\<lbrakk> \<forall>p\<in>w0. p < n; ss0 \<in> nlists n A; \<forall>p<n. p \<notin> w0 \<longrightarrow> stable r step ss0 p \<rbrakk> \<Longrightarrow>
         iter f step ss0 w0 = (ss',w') \<longrightarrow>
         ss' \<in> nlists n A \<and> stables r step ss' \<and> ss0 [\<sqsubseteq>\<^sub>r] ss' \<and>
         (\<forall>ts\<in>nlists n A. ss0 [\<sqsubseteq>\<^sub>r] ts \<and> stables r step ts \<longrightarrow> ss' [\<sqsubseteq>\<^sub>r] ts)"
(*<*) (is "PROP ?P")

proof -
  show "PROP ?P"
    apply (insert semi bounded_step exec_pres_type step_mono[OF wf])
    apply (unfold iter_def stables_def)

    apply (rule_tac P = "\<lambda>(ss,w).
                ss \<in> nlists n A \<and> (\<forall>p<n. p \<notin> w \<longrightarrow> stable r step ss p) \<and> ss0 [\<sqsubseteq>\<^sub>r] ss \<and>
   (\<forall>ts\<in>nlists n A. ss0 [\<sqsubseteq>\<^sub>r] ts \<and> stables r step ts \<longrightarrow> ss [\<sqsubseteq>\<^sub>r] ts) \<and>
   (\<forall>p\<in>w. p < n)" and
   r = "{(ss',ss) . ss [\<sqsubset>\<^sub>r] ss'} <*lex*> finite_psubset"
         in while_rule)

  \<comment> \<open>Invariant holds initially:\<close>
        apply (simp add:stables_def  semilat_Def   del: n_def A_def r_def f_def step_def)
        apply (blast intro:le_list_refl')

  \<comment> \<open>Invariant is preserved:\<close>
       apply(simp add: stables_def split_paired_all del: A_def r_def f_def step_def n_def)
       apply(rename_tac ss w)
       apply(subgoal_tac "(SOME p. p \<in> w) \<in> w")
        prefer 2 apply (fast intro: someI)
       apply(subgoal_tac "\<forall>(q,t) \<in> set (step (SOME p. p \<in> w) (ss ! (SOME p. p \<in> w))). q < length ss \<and> t \<in> A")
        prefer 2
        apply clarify
        apply (rule conjI)
         apply(clarsimp, blast dest!: boundedD)
        apply (subgoal_tac "(SOME p. p \<in> w) < n")
         apply (subgoal_tac "(ss ! (SOME p. p \<in> w)) \<in> A")
          apply (fastforce simp only:n_def dest:pres_typeD )
         apply simp
        apply simp
       apply (subst decomp_propa)
        apply blast
       apply (simp del:A_def r_def f_def step_def n_def)
       apply (rule conjI)
        apply (rule Semilat.merges_preserves_type[OF Semilat.intro, OF semi])
         apply blast
        apply clarify
        apply (rule conjI)
         apply(clarsimp, blast dest!: boundedD)
        apply (erule pres_typeD)
          prefer 3
          apply assumption
         apply (erule nlistsE_nth_in)
         apply blast
        apply (simp only:n_def)
       apply (rule conjI)
        apply clarify
        apply (subgoal_tac "ss \<in> nlists (length is) A" "\<forall>p\<in>w. p <  (length is) " "\<forall>p<(length is). p \<notin> w \<longrightarrow> stable r step ss p "
 "p < length is")
            apply (blast   intro!: Semilat.stable_pres_lemma[OF Semilat.intro, OF semi])
           apply (simp only:n_def)
          apply (simp only:n_def)
         apply (simp only:n_def)
        apply (simp only:n_def)
       apply (rule conjI)
        apply (subgoal_tac "ss \<in> nlists (length is) A"
               "\<forall>(q,t)\<in>set (step (SOME p. p \<in> w) (ss ! (SOME p. p \<in> w))). q < length is \<and> t \<in> A"
               "ss [\<sqsubseteq>\<^bsub>r\<^esub>] merges f (step (SOME p. p \<in> w) (ss ! (SOME p. p \<in> w))) ss" "ss0\<in> nlists (size is) A"
               "merges f (step (SOME p. p \<in> w) (ss ! (SOME p. p \<in> w))) ss \<in> nlists (size is) A"
               "ss \<in>nlists (size is) A" "order r A" "ss0 [\<sqsubseteq>\<^bsub>r\<^esub>] ss ")
                apply (blast dest: le_list_trans)
               apply simp
              apply (simp only:semilat_Def)
             apply (simp only:n_def)
            apply (fastforce simp only: n_def dest:Semilat.merges_preserves_type[OF Semilat.intro, OF semi] )
           apply (simp only:n_def)
          apply (blast intro:Semilat.merges_incr[OF Semilat.intro, OF semi])
         apply (subgoal_tac "length ss = n")
          apply (simp only:n_def)
         apply (subgoal_tac "ss \<in>nlists n A")
          defer
          apply simp
         apply (simp only:n_def)
        prefer 5
        apply (simp only:nlistsE_length n_def)
       apply(rule conjI)
        apply (clarsimp simp del: A_def r_def f_def step_def)
        apply (blast intro!: Semilat.merges_bounded_lemma[OF Semilat.intro, OF semi])
       apply (subgoal_tac "bounded step n")
        apply (blast dest!: boundedD)
       apply (simp only:n_def)

  \<comment> \<open>Postcondition holds upon termination:\<close>
      apply(clarsimp simp add: stables_def split_paired_all)

  \<comment> \<open>Well-foundedness of the termination relation:\<close>
      apply (rule wf_lex_prod)
     apply (simp only:wf_jvm)
    apply (rule wf_finite_psubset)

  \<comment> \<open>Loop decreases along termination relation:\<close>
     apply(simp add: stables_def split_paired_all del: A_def r_def f_def step_def)
     apply(rename_tac ss w)
     apply(subgoal_tac "(SOME p. p \<in> w) \<in> w")
      prefer 2 apply (fast intro: someI)
     apply(subgoal_tac "\<forall>(q,t) \<in> set (step (SOME p. p \<in> w) (ss ! (SOME p. p \<in> w))). q < length ss \<and> t \<in> A")
      prefer 2
      apply clarify
      apply (rule conjI)
       apply(clarsimp, blast dest!: boundedD)
      apply (erule pres_typeD)
        prefer 3
        apply assumption
       apply (erule nlistsE_nth_in)
       apply blast
      apply blast
     apply (subst decomp_propa)
      apply blast
     apply clarify
  apply (simp del: nlistsE_length  A_def r_def f_def step_def
      add: lex_prod_def finite_psubset_def
           bounded_nat_set_is_finite)
     apply (rule termination_lemma)
        apply (insert Semilat.intro)
        apply assumption+
      defer
      apply assumption
     defer
     apply clarsimp
    done
qed

(*>*)

lemma kildall_properties_bv:
shows "\<lbrakk> ss0 \<in> nlists n A \<rbrakk> \<Longrightarrow>
  kildall r f step ss0 \<in> nlists n A \<and>
  stables r step (kildall r f step ss0) \<and>
  ss0 [\<sqsubseteq>\<^sub>r] kildall r f step ss0 \<and>
  (\<forall>ts\<in>nlists n A. ss0 [\<sqsubseteq>\<^sub>r] ts \<and> stables r step ts \<longrightarrow>
                 kildall r f step ss0 [\<sqsubseteq>\<^sub>r] ts)"
(*<*) (is "PROP ?P")
proof -
  show "PROP ?P"
  apply (unfold kildall_def)
    apply(case_tac "iter f step ss0 (unstables r step ss0)")
    apply (simp del:r_def f_def n_def step_def A_def)
    apply (rule iter_properties_bv)
     apply (simp_all add: unstables_def stable_def)
    done
qed

end

lemma (in start_context) is_bcv_kiljvm:
shows "is_bcv r Err step (size is) A (kiljvm P mxs mxl T\<^sub>r is xt)"
  apply (insert wf)
  apply (unfold kiljvm_def)
  apply (fold r_def f_def step_def_exec n_def)
  apply(unfold is_bcv_def wt_step_def)
  apply(insert semi  kildall_properties_bv)
  apply(simp only:stables_def)
  apply clarify
  apply(subgoal_tac "kildall r f step \<tau>s\<^sub>0 \<in> nlists n A")
   prefer 2
   apply (fastforce intro: kildall_properties_bv)
  apply (rule iffI)
   apply (rule_tac x = "kildall r f step \<tau>s\<^sub>0" in bexI)
    apply (rule conjI)
     apply (fastforce intro: kildall_properties_bv)
  apply (force intro: kildall_properties_bv)
   apply simp
  apply clarify
  apply(subgoal_tac "kildall r f step \<tau>s\<^sub>0!pa <=_r \<tau>s!pa")
   defer
   apply (blast intro!: le_listD less_lengthI)
  apply (subgoal_tac "\<tau>s!pa \<noteq> Err")
   defer
   apply simp
  apply (rule ccontr)
  apply (simp only:top_def r_def JVM_le_unfold)
  apply fastforce
  done

(* FIXME: move? *)
lemma subset_replicate [intro?]: "set (replicate n x) \<subseteq> {x}"
  by (induct n) auto

lemma in_set_replicate:
  assumes "x \<in> set (replicate n y)"
  shows "x = y"
(*<*)
proof -
  note assms
  also have "set (replicate n y) \<subseteq> {y}" ..
  finally show ?thesis by simp
qed
(*>*)

lemma (in start_context) start_in_A [intro?]:
  "0 < size is \<Longrightarrow> start \<in> nlists (size is) A"
  using Ts C
(*<*)
  apply (simp add: JVM_states_unfold)
  apply (force intro!: nlistsI nlists_appendI dest!: in_set_replicate)
  done
(*>*)

theorem (in start_context) wt_kil_correct:
  assumes wtk: "wt_kildall P C Ts T\<^sub>r mxs mxl\<^sub>0 is xt"
  shows "\<exists>\<tau>s. wt_method P C Ts T\<^sub>r mxs mxl\<^sub>0 is xt \<tau>s"
(*<*)
proof -
  from wtk obtain res where
    result:   "res = kiljvm P mxs mxl T\<^sub>r is xt start" and
    success:  "\<forall>n < size is. res!n \<noteq> Err" and
    instrs:   "0 < size is"
    by (unfold wt_kildall_def) simp

  have bcv: "is_bcv r Err step (size is) A (kiljvm P mxs mxl T\<^sub>r is xt)"
    by (rule is_bcv_kiljvm)

  from instrs have "start \<in> nlists (size is) A" ..
  with bcv success result have
    "\<exists>ts\<in>nlists (size is) A. start [\<sqsubseteq>\<^sub>r] ts \<and> wt_step r Err step ts"
    by (unfold is_bcv_def) blast
  then obtain \<tau>s' where
    in_A: "\<tau>s' \<in> nlists (size is) A" and
    s:    "start [\<sqsubseteq>\<^sub>r] \<tau>s'" and
    w:    "wt_step r Err step \<tau>s'"
    by blast
  hence wt_err_step: "wt_err_step (sup_state_opt P) step \<tau>s'"
    by (simp add: wt_err_step_def JVM_le_Err_conv)

  from in_A have l: "size \<tau>s' = size is" by simp
  moreover {
    from in_A  have "check_types P mxs mxl \<tau>s'" by (simp add: check_types_def)
    also from w have "\<forall>x \<in> set \<tau>s'. x \<noteq> Err"
      by (auto simp add: wt_step_def all_set_conv_all_nth)
    hence [symmetric]: "map OK (map ok_val \<tau>s') = \<tau>s'"
      by (auto intro!: map_idI simp add: wt_step_def)
    finally  have "check_types P mxs mxl (map OK (map ok_val \<tau>s'))" .
  }
  moreover {
    from s have "start!0 \<sqsubseteq>\<^sub>r \<tau>s'!0" by (rule le_listD) simp
    moreover
    from instrs w l
    have "\<tau>s'!0 \<noteq> Err" by (unfold wt_step_def) simp
    then obtain \<tau>s0 where "\<tau>s'!0 = OK \<tau>s0" by auto
    ultimately
    have "wt_start P C Ts mxl\<^sub>0 (map ok_val \<tau>s')" using l instrs
      by (unfold wt_start_def)
         (simp add: lesub_def JVM_le_Err_conv Err.le_def)
  }
  moreover
  from in_A have "set \<tau>s' \<subseteq> A" by simp
  with wt_err_step bounded_step
  have "wt_app_eff (sup_state_opt P) app eff (map ok_val \<tau>s')"
    by (auto intro: wt_err_imp_wt_app_eff simp add: l)
  ultimately
  have "wt_method P C Ts T\<^sub>r mxs mxl\<^sub>0 is xt (map ok_val \<tau>s')"
    using instrs by (simp add: wt_method_def2 check_types_def del: map_map)
  thus ?thesis by blast
qed
(*>*)

theorem (in start_context) wt_kil_complete:
  assumes wtm: "wt_method P C Ts T\<^sub>r mxs mxl\<^sub>0 is xt \<tau>s"
  shows "wt_kildall P C Ts T\<^sub>r mxs mxl\<^sub>0 is xt"
(*<*)
proof -
  from wtm obtain
    instrs:   "0 < size is" and
    length:   "length \<tau>s = length is" and
    ck_type:  "check_types P mxs mxl (map OK \<tau>s)" and
    wt_start: "wt_start P C Ts mxl\<^sub>0 \<tau>s" and
    app_eff:  "wt_app_eff (sup_state_opt P) app eff \<tau>s"
    by (simp add: wt_method_def2 check_types_def)

  from ck_type
  have in_A: "set (map OK \<tau>s) \<subseteq> A"
    by (simp add: check_types_def)
  with app_eff in_A bounded_step
  have "wt_err_step (sup_state_opt P) (err_step (size \<tau>s) app eff) (map OK \<tau>s)"
    by - (erule wt_app_eff_imp_wt_err,
          auto simp add: exec_def length states_def)
  hence wt_err: "wt_err_step (sup_state_opt P) step (map OK \<tau>s)"
    by (simp add: length)
  have is_bcv: "is_bcv r Err step (size is) A (kiljvm P mxs mxl T\<^sub>r is xt)"
    by (rule is_bcv_kiljvm)
  moreover from instrs have "start \<in> nlists (size is) A" ..
  moreover
  let ?\<tau>s = "map OK \<tau>s"
  have less_\<tau>s: "start [\<sqsubseteq>\<^sub>r] ?\<tau>s"
  proof (rule le_listI)
    from length instrs
    show "length start = length (map OK \<tau>s)" by simp
  next
    fix n
    from wt_start have "P \<turnstile> ok_val (start!0) \<le>' \<tau>s!0"
      by (simp add: wt_start_def)
    moreover from instrs length have "0 < length \<tau>s" by simp
    ultimately have "start!0 \<sqsubseteq>\<^sub>r ?\<tau>s!0"
      by (simp add: JVM_le_Err_conv lesub_def)
    moreover {
      fix n'
      have "OK None \<sqsubseteq>\<^sub>r ?\<tau>s!n"
        by (auto simp add: JVM_le_Err_conv Err.le_def lesub_def
                 split: err.splits)
      hence "\<lbrakk>n = Suc n'; n < size start\<rbrakk> \<Longrightarrow> start!n \<sqsubseteq>\<^sub>r ?\<tau>s!n" by simp
    }
    ultimately
    show "n < size start \<Longrightarrow> start!n \<sqsubseteq>\<^sub>r ?\<tau>s!n" by (cases n, blast+)
  qed
  moreover
  from ck_type length
  have "?\<tau>s \<in> nlists (size is) A"
    by (auto intro!: nlistsI simp add: check_types_def)
  moreover
  from wt_err have "wt_step r Err step ?\<tau>s"
    by (simp add: wt_err_step_def JVM_le_Err_conv)
  ultimately
  have "\<forall>p. p < size is \<longrightarrow> kiljvm P  mxs mxl T\<^sub>r is xt start ! p \<noteq> Err"
    by (unfold is_bcv_def) blast
  with instrs
  show "wt_kildall P C Ts T\<^sub>r mxs mxl\<^sub>0 is xt" by (unfold wt_kildall_def) simp
qed
(*>*)

theorem jvm_kildall_correct:
  "wf_jvm_prog\<^sub>k P = wf_jvm_prog P"
(*<*)
proof
  let ?\<Phi> = "\<lambda>C M. let (C,Ts,T\<^sub>r,(mxs,mxl\<^sub>0,is,xt)) = method P C M in
              SOME \<tau>s. wt_method P C Ts T\<^sub>r mxs mxl\<^sub>0 is xt \<tau>s"

  \<comment> \<open>soundness\<close>
  assume wt: "wf_jvm_prog\<^sub>k P"
  hence "wf_jvm_prog\<^bsub>?\<Phi>\<^esub> P"
    apply (unfold wf_jvm_prog_phi_def wf_jvm_prog\<^sub>k_def)
    apply (erule wf_prog_lift)
    apply (auto dest!: start_context.wt_kil_correct [OF start_context.intro]
                intro: someI)
    apply (erule sees_method_is_class)
    done
  thus "wf_jvm_prog P" by (unfold wf_jvm_prog_def) fast
next
  \<comment> \<open>completeness\<close>
  assume wt: "wf_jvm_prog P"
  thus "wf_jvm_prog\<^sub>k P"
    apply (unfold wf_jvm_prog_def wf_jvm_prog_phi_def wf_jvm_prog\<^sub>k_def)
    apply (clarify)
    apply (erule wf_prog_lift)
    apply (auto intro!: start_context.wt_kil_complete start_context.intro)
    apply (erule sees_method_is_class)
    done
qed
(*>*)

end


section \<open>The Multi-Mutator Case\<close>

theory Mul_Gar_Coll imports Graph OG_Syntax begin

text \<open>The full theory takes aprox. 18 minutes.\<close>

record mut =
  Z :: bool
  R :: nat
  T :: nat

text \<open>Declaration of variables:\<close>

record mul_gar_coll_state =
  M :: nodes
  E :: edges
  bc :: "nat set"
  obc :: "nat set"
  Ma :: nodes
  ind :: nat
  k :: nat
  q :: nat
  l :: nat
  Muts :: "mut list"

subsection \<open>The Mutators\<close>

definition Mul_mut_init :: "mul_gar_coll_state \<Rightarrow> nat \<Rightarrow> bool" where
  "Mul_mut_init \<equiv> \<guillemotleft> \<lambda>n. n=length \<acute>Muts \<and> (\<forall>i<n. R (\<acute>Muts!i)<length \<acute>E
                          \<and> T (\<acute>Muts!i)<length \<acute>M) \<guillemotright>"

definition Mul_Redirect_Edge  :: "nat \<Rightarrow> nat \<Rightarrow> mul_gar_coll_state ann_com" where
  "Mul_Redirect_Edge j n \<equiv>
  \<lbrace>\<acute>Mul_mut_init n \<and> Z (\<acute>Muts!j)\<rbrace>
  \<langle>IF T(\<acute>Muts!j) \<in> Reach \<acute>E THEN
  \<acute>E:= \<acute>E[R (\<acute>Muts!j):= (fst (\<acute>E!R(\<acute>Muts!j)), T (\<acute>Muts!j))] FI,,
  \<acute>Muts:= \<acute>Muts[j:= (\<acute>Muts!j) \<lparr>Z:=False\<rparr>]\<rangle>"

definition Mul_Color_Target :: "nat \<Rightarrow> nat \<Rightarrow> mul_gar_coll_state ann_com" where
  "Mul_Color_Target j n \<equiv>
  \<lbrace>\<acute>Mul_mut_init n \<and> \<not> Z (\<acute>Muts!j)\<rbrace>
  \<langle>\<acute>M:=\<acute>M[T (\<acute>Muts!j):=Black],, \<acute>Muts:=\<acute>Muts[j:= (\<acute>Muts!j) \<lparr>Z:=True\<rparr>]\<rangle>"

definition Mul_Mutator :: "nat \<Rightarrow> nat \<Rightarrow>  mul_gar_coll_state ann_com" where
  "Mul_Mutator j n \<equiv>
  \<lbrace>\<acute>Mul_mut_init n \<and> Z (\<acute>Muts!j)\<rbrace>
  WHILE True
    INV \<lbrace>\<acute>Mul_mut_init n \<and> Z (\<acute>Muts!j)\<rbrace>
  DO Mul_Redirect_Edge j n ;;
     Mul_Color_Target j n
  OD"

lemmas mul_mutator_defs = Mul_mut_init_def Mul_Redirect_Edge_def Mul_Color_Target_def

subsubsection \<open>Correctness of the proof outline of one mutator\<close>

lemma Mul_Redirect_Edge: "0\<le>j \<and> j<n \<Longrightarrow>
  \<turnstile> Mul_Redirect_Edge j n
     pre(Mul_Color_Target j n)"
apply (unfold mul_mutator_defs)
apply annhoare
apply(simp_all)
apply clarify
apply(simp add:nth_list_update)
done

lemma Mul_Color_Target: "0\<le>j \<and> j<n \<Longrightarrow>
  \<turnstile>  Mul_Color_Target j n
    \<lbrace>\<acute>Mul_mut_init n \<and> Z (\<acute>Muts!j)\<rbrace>"
apply (unfold mul_mutator_defs)
apply annhoare
apply(simp_all)
apply clarify
apply(simp add:nth_list_update)
done

lemma Mul_Mutator: "0\<le>j \<and> j<n \<Longrightarrow>
 \<turnstile> Mul_Mutator j n \<lbrace>False\<rbrace>"
apply(unfold Mul_Mutator_def)
apply annhoare
apply(simp_all add:Mul_Redirect_Edge Mul_Color_Target)
apply(simp add:mul_mutator_defs Mul_Redirect_Edge_def)
done

subsubsection \<open>Interference freedom between mutators\<close>

lemma Mul_interfree_Redirect_Edge_Redirect_Edge:
  "\<lbrakk>0\<le>i; i<n; 0\<le>j; j<n; i\<noteq>j\<rbrakk> \<Longrightarrow>
  interfree_aux (Some (Mul_Redirect_Edge i n),{}, Some(Mul_Redirect_Edge j n))"
apply (unfold mul_mutator_defs)
apply interfree_aux
apply safe
apply(simp_all add: nth_list_update)
done

lemma Mul_interfree_Redirect_Edge_Color_Target:
  "\<lbrakk>0\<le>i; i<n; 0\<le>j; j<n; i\<noteq>j\<rbrakk> \<Longrightarrow>
  interfree_aux (Some(Mul_Redirect_Edge i n),{},Some(Mul_Color_Target j n))"
apply (unfold mul_mutator_defs)
apply interfree_aux
apply safe
apply(simp_all add: nth_list_update)
done

lemma Mul_interfree_Color_Target_Redirect_Edge:
  "\<lbrakk>0\<le>i; i<n; 0\<le>j; j<n; i\<noteq>j\<rbrakk> \<Longrightarrow>
  interfree_aux (Some(Mul_Color_Target i n),{},Some(Mul_Redirect_Edge j n))"
apply (unfold mul_mutator_defs)
apply interfree_aux
apply safe
apply(simp_all add:nth_list_update)
done

lemma Mul_interfree_Color_Target_Color_Target:
  " \<lbrakk>0\<le>i; i<n; 0\<le>j; j<n; i\<noteq>j\<rbrakk> \<Longrightarrow>
  interfree_aux (Some(Mul_Color_Target i n),{},Some(Mul_Color_Target j n))"
apply (unfold mul_mutator_defs)
apply interfree_aux
apply safe
apply(simp_all add: nth_list_update)
done

lemmas mul_mutator_interfree =
  Mul_interfree_Redirect_Edge_Redirect_Edge Mul_interfree_Redirect_Edge_Color_Target
  Mul_interfree_Color_Target_Redirect_Edge Mul_interfree_Color_Target_Color_Target

lemma Mul_interfree_Mutator_Mutator: "\<lbrakk>i < n; j < n; i \<noteq> j\<rbrakk> \<Longrightarrow>
  interfree_aux (Some (Mul_Mutator i n), {}, Some (Mul_Mutator j n))"
apply(unfold Mul_Mutator_def)
apply(interfree_aux)
apply(simp_all add:mul_mutator_interfree)
apply(simp_all add: mul_mutator_defs)
apply(tactic \<open>TRYALL (interfree_aux_tac \<^context>)\<close>)
apply(tactic \<open>ALLGOALS (clarify_tac \<^context>)\<close>)
apply (simp_all add:nth_list_update)
done

subsubsection \<open>Modular Parameterized Mutators\<close>

lemma Mul_Parameterized_Mutators: "0<n \<Longrightarrow>
 \<parallel>- \<lbrace>\<acute>Mul_mut_init n \<and> (\<forall>i<n. Z (\<acute>Muts!i))\<rbrace>
 COBEGIN
 SCHEME  [0\<le> j< n]
  Mul_Mutator j n
 \<lbrace>False\<rbrace>
 COEND
 \<lbrace>False\<rbrace>"
apply oghoare
apply(force simp add:Mul_Mutator_def mul_mutator_defs nth_list_update)
apply(erule Mul_Mutator)
apply(simp add:Mul_interfree_Mutator_Mutator)
apply(force simp add:Mul_Mutator_def mul_mutator_defs nth_list_update)
done

subsection \<open>The Collector\<close>

definition Queue :: "mul_gar_coll_state \<Rightarrow> nat" where
 "Queue \<equiv> \<guillemotleft> length (filter (\<lambda>i. \<not> Z i \<and> \<acute>M!(T i) \<noteq> Black) \<acute>Muts) \<guillemotright>"

consts  M_init :: nodes

definition Proper_M_init :: "mul_gar_coll_state \<Rightarrow> bool" where
  "Proper_M_init \<equiv> \<guillemotleft> Blacks M_init=Roots \<and> length M_init=length \<acute>M \<guillemotright>"

definition Mul_Proper :: "mul_gar_coll_state \<Rightarrow> nat \<Rightarrow> bool" where
  "Mul_Proper \<equiv> \<guillemotleft> \<lambda>n. Proper_Roots \<acute>M \<and> Proper_Edges (\<acute>M, \<acute>E) \<and> \<acute>Proper_M_init \<and> n=length \<acute>Muts \<guillemotright>"

definition Safe :: "mul_gar_coll_state \<Rightarrow> bool" where
  "Safe \<equiv> \<guillemotleft> Reach \<acute>E \<subseteq> Blacks \<acute>M \<guillemotright>"

lemmas mul_collector_defs = Proper_M_init_def Mul_Proper_def Safe_def

subsubsection \<open>Blackening Roots\<close>

definition Mul_Blacken_Roots :: "nat \<Rightarrow>  mul_gar_coll_state ann_com" where
  "Mul_Blacken_Roots n \<equiv>
  \<lbrace>\<acute>Mul_Proper n\<rbrace>
  \<acute>ind:=0;;
  \<lbrace>\<acute>Mul_Proper n \<and> \<acute>ind=0\<rbrace>
  WHILE \<acute>ind<length \<acute>M
    INV \<lbrace>\<acute>Mul_Proper n \<and> (\<forall>i<\<acute>ind. i\<in>Roots \<longrightarrow> \<acute>M!i=Black) \<and> \<acute>ind\<le>length \<acute>M\<rbrace>
  DO \<lbrace>\<acute>Mul_Proper n \<and> (\<forall>i<\<acute>ind. i\<in>Roots \<longrightarrow> \<acute>M!i=Black) \<and> \<acute>ind<length \<acute>M\<rbrace>
       IF \<acute>ind\<in>Roots THEN
     \<lbrace>\<acute>Mul_Proper n \<and> (\<forall>i<\<acute>ind. i\<in>Roots \<longrightarrow> \<acute>M!i=Black) \<and> \<acute>ind<length \<acute>M \<and> \<acute>ind\<in>Roots\<rbrace>
       \<acute>M:=\<acute>M[\<acute>ind:=Black] FI;;
     \<lbrace>\<acute>Mul_Proper n \<and> (\<forall>i<\<acute>ind+1. i\<in>Roots \<longrightarrow> \<acute>M!i=Black) \<and> \<acute>ind<length \<acute>M\<rbrace>
       \<acute>ind:=\<acute>ind+1
  OD"

lemma Mul_Blacken_Roots:
  "\<turnstile> Mul_Blacken_Roots n
  \<lbrace>\<acute>Mul_Proper n \<and> Roots \<subseteq> Blacks \<acute>M\<rbrace>"
apply (unfold Mul_Blacken_Roots_def)
apply annhoare
apply(simp_all add:mul_collector_defs Graph_defs)
apply safe
apply(simp_all add:nth_list_update)
  apply (erule less_SucE)
   apply simp+
 apply force
apply force
done

subsubsection \<open>Propagating Black\<close>

definition Mul_PBInv :: "mul_gar_coll_state \<Rightarrow> bool" where
  "Mul_PBInv \<equiv>  \<guillemotleft>\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>M \<or> \<acute>l<\<acute>Queue
                 \<or> (\<forall>i<\<acute>ind. \<not>BtoW(\<acute>E!i,\<acute>M)) \<and> \<acute>l\<le>\<acute>Queue\<guillemotright>"

definition Mul_Auxk :: "mul_gar_coll_state \<Rightarrow> bool" where
  "Mul_Auxk \<equiv> \<guillemotleft>\<acute>l<\<acute>Queue \<or> \<acute>M!\<acute>k\<noteq>Black \<or> \<not>BtoW(\<acute>E!\<acute>ind, \<acute>M) \<or> \<acute>obc\<subset>Blacks \<acute>M\<guillemotright>"

definition Mul_Propagate_Black :: "nat \<Rightarrow>  mul_gar_coll_state ann_com" where
  "Mul_Propagate_Black n \<equiv>
 \<lbrace>\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M
  \<and> (\<acute>Safe \<or> \<acute>l\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M)\<rbrace>
 \<acute>ind:=0;;
 \<lbrace>\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M
   \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> Blacks \<acute>M\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M
   \<and> (\<acute>Safe \<or> \<acute>l\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M) \<and> \<acute>ind=0\<rbrace>
 WHILE \<acute>ind<length \<acute>E
  INV \<lbrace>\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M
        \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M
        \<and> \<acute>Mul_PBInv \<and> \<acute>ind\<le>length \<acute>E\<rbrace>
 DO \<lbrace>\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M
     \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M
     \<and> \<acute>Mul_PBInv \<and> \<acute>ind<length \<acute>E\<rbrace>
   IF \<acute>M!(fst (\<acute>E!\<acute>ind))=Black THEN
   \<lbrace>\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M
     \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M
     \<and> \<acute>Mul_PBInv \<and> (\<acute>M!fst(\<acute>E!\<acute>ind))=Black \<and> \<acute>ind<length \<acute>E\<rbrace>
    \<acute>k:=snd(\<acute>E!\<acute>ind);;
   \<lbrace>\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M
     \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M
     \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>M \<or> \<acute>l<\<acute>Queue \<or> (\<forall>i<\<acute>ind. \<not>BtoW(\<acute>E!i,\<acute>M))
        \<and> \<acute>l\<le>\<acute>Queue \<and> \<acute>Mul_Auxk ) \<and> \<acute>k<length \<acute>M \<and> \<acute>M!fst(\<acute>E!\<acute>ind)=Black
     \<and> \<acute>ind<length \<acute>E\<rbrace>
   \<langle>\<acute>M:=\<acute>M[\<acute>k:=Black],,\<acute>ind:=\<acute>ind+1\<rangle>
   ELSE \<lbrace>\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M
         \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M
         \<and> \<acute>Mul_PBInv \<and> \<acute>ind<length \<acute>E\<rbrace>
         \<langle>IF \<acute>M!(fst (\<acute>E!\<acute>ind))\<noteq>Black THEN \<acute>ind:=\<acute>ind+1 FI\<rangle> FI
 OD"

lemma Mul_Propagate_Black:
  "\<turnstile> Mul_Propagate_Black n
   \<lbrace>\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M
     \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>M \<or> \<acute>l<\<acute>Queue \<and> (\<acute>l\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M))\<rbrace>"
apply(unfold Mul_Propagate_Black_def)
apply annhoare
apply(simp_all add:Mul_PBInv_def mul_collector_defs Mul_Auxk_def Graph6 Graph7 Graph8 Graph12 mul_collector_defs Queue_def)
\<comment> \<open>8 subgoals left\<close>
apply force
apply force
apply force
apply(force simp add:BtoW_def Graph_defs)
\<comment> \<open>4 subgoals left\<close>
apply clarify
apply(simp add: mul_collector_defs Graph12 Graph6 Graph7 Graph8)
apply(disjE_tac)
 apply(simp_all add:Graph12 Graph13)
 apply(case_tac "M x! k x=Black")
  apply(simp add: Graph10)
 apply(rule disjI2, rule disjI1, erule subset_psubset_trans, erule Graph11, force)
apply(case_tac "M x! k x=Black")
 apply(simp add: Graph10 BtoW_def)
 apply(rule disjI2, clarify, erule less_SucE, force)
 apply(case_tac "M x!snd(E x! ind x)=Black")
  apply(force)
 apply(force)
apply(rule disjI2, rule disjI1, erule subset_psubset_trans, erule Graph11, force)
\<comment> \<open>2 subgoals left\<close>
apply clarify
apply(conjI_tac)
apply(disjE_tac)
 apply (simp_all)
apply clarify
apply(erule less_SucE)
 apply force
apply (simp add:BtoW_def)
\<comment> \<open>1 subgoal left\<close>
apply clarify
apply simp
apply(disjE_tac)
apply (simp_all)
apply(rule disjI1 , rule Graph1)
 apply simp_all
done

subsubsection \<open>Counting Black Nodes\<close>

definition Mul_CountInv :: "mul_gar_coll_state \<Rightarrow> nat \<Rightarrow> bool" where
  "Mul_CountInv \<equiv> \<guillemotleft> \<lambda>ind. {i. i<ind \<and> \<acute>Ma!i=Black}\<subseteq>\<acute>bc \<guillemotright>"

definition Mul_Count :: "nat \<Rightarrow>  mul_gar_coll_state ann_com" where
  "Mul_Count n \<equiv>
  \<lbrace>\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M
    \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M
    \<and> length \<acute>Ma=length \<acute>M
    \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>Ma \<or> \<acute>l<\<acute>q \<and> (\<acute>q\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M) )
    \<and> \<acute>q<n+1 \<and> \<acute>bc={}\<rbrace>
  \<acute>ind:=0;;
  \<lbrace>\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M
    \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M
    \<and> length \<acute>Ma=length \<acute>M
    \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>Ma \<or> \<acute>l<\<acute>q \<and> (\<acute>q\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M) )
    \<and> \<acute>q<n+1 \<and> \<acute>bc={} \<and> \<acute>ind=0\<rbrace>
  WHILE \<acute>ind<length \<acute>M
     INV \<lbrace>\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M
          \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M
          \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>Mul_CountInv \<acute>ind
          \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>Ma \<or> \<acute>l<\<acute>q \<and> (\<acute>q\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M))
          \<and> \<acute>q<n+1 \<and> \<acute>ind\<le>length \<acute>M\<rbrace>
  DO \<lbrace>\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M
       \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M
       \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>Mul_CountInv \<acute>ind
       \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>Ma \<or> \<acute>l<\<acute>q \<and> (\<acute>q\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M))
       \<and> \<acute>q<n+1 \<and> \<acute>ind<length \<acute>M\<rbrace>
     IF \<acute>M!\<acute>ind=Black
     THEN \<lbrace>\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M
            \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M
            \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>Mul_CountInv \<acute>ind
            \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>Ma \<or> \<acute>l<\<acute>q \<and> (\<acute>q\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M))
            \<and> \<acute>q<n+1 \<and> \<acute>ind<length \<acute>M \<and> \<acute>M!\<acute>ind=Black\<rbrace>
          \<acute>bc:=insert \<acute>ind \<acute>bc
     FI;;
  \<lbrace>\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M
    \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M
    \<and> length \<acute>Ma=length \<acute>M \<and> \<acute>Mul_CountInv (\<acute>ind+1)
    \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>Ma \<or> \<acute>l<\<acute>q \<and> (\<acute>q\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M))
    \<and> \<acute>q<n+1 \<and> \<acute>ind<length \<acute>M\<rbrace>
  \<acute>ind:=\<acute>ind+1
  OD"

lemma Mul_Count:
  "\<turnstile> Mul_Count n
  \<lbrace>\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M
    \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M
    \<and> length \<acute>Ma=length \<acute>M \<and> Blacks \<acute>Ma\<subseteq>\<acute>bc
    \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>Ma \<or> \<acute>l<\<acute>q \<and> (\<acute>q\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M))
    \<and> \<acute>q<n+1\<rbrace>"
apply (unfold Mul_Count_def)
apply annhoare
apply(simp_all add:Mul_CountInv_def mul_collector_defs Mul_Auxk_def Graph6 Graph7 Graph8 Graph12 mul_collector_defs Queue_def)
\<comment> \<open>7 subgoals left\<close>
apply force
apply force
apply force
\<comment> \<open>4 subgoals left\<close>
apply clarify
apply(conjI_tac)
apply(disjE_tac)
 apply simp_all
apply(simp add:Blacks_def)
apply clarify
apply(erule less_SucE)
 back
 apply force
apply force
\<comment> \<open>3 subgoals left\<close>
apply clarify
apply(conjI_tac)
apply(disjE_tac)
 apply simp_all
apply clarify
apply(erule less_SucE)
 back
 apply force
apply simp
apply(rotate_tac -1)
apply (force simp add:Blacks_def)
\<comment> \<open>2 subgoals left\<close>
apply force
\<comment> \<open>1 subgoal left\<close>
apply clarify
apply(drule_tac x = "ind x" in le_imp_less_or_eq)
apply (simp_all add:Blacks_def)
done

subsubsection \<open>Appending garbage nodes to the free list\<close>

axiomatization Append_to_free :: "nat \<times> edges \<Rightarrow> edges"
where
  Append_to_free0: "length (Append_to_free (i, e)) = length e" and
  Append_to_free1: "Proper_Edges (m, e)
                    \<Longrightarrow> Proper_Edges (m, Append_to_free(i, e))" and
  Append_to_free2: "i \<notin> Reach e
           \<Longrightarrow> n \<in> Reach (Append_to_free(i, e)) = ( n = i \<or> n \<in> Reach e)"

definition Mul_AppendInv :: "mul_gar_coll_state \<Rightarrow> nat \<Rightarrow> bool" where
  "Mul_AppendInv \<equiv> \<guillemotleft> \<lambda>ind. (\<forall>i. ind\<le>i \<longrightarrow> i<length \<acute>M \<longrightarrow> i\<in>Reach \<acute>E \<longrightarrow> \<acute>M!i=Black)\<guillemotright>"

definition Mul_Append :: "nat \<Rightarrow>  mul_gar_coll_state ann_com" where
  "Mul_Append n \<equiv>
  \<lbrace>\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>Safe\<rbrace>
  \<acute>ind:=0;;
  \<lbrace>\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>Safe \<and> \<acute>ind=0\<rbrace>
  WHILE \<acute>ind<length \<acute>M
    INV \<lbrace>\<acute>Mul_Proper n \<and> \<acute>Mul_AppendInv \<acute>ind \<and> \<acute>ind\<le>length \<acute>M\<rbrace>
  DO \<lbrace>\<acute>Mul_Proper n \<and> \<acute>Mul_AppendInv \<acute>ind \<and> \<acute>ind<length \<acute>M\<rbrace>
      IF \<acute>M!\<acute>ind=Black THEN
     \<lbrace>\<acute>Mul_Proper n \<and> \<acute>Mul_AppendInv \<acute>ind \<and> \<acute>ind<length \<acute>M \<and> \<acute>M!\<acute>ind=Black\<rbrace>
      \<acute>M:=\<acute>M[\<acute>ind:=White]
      ELSE
     \<lbrace>\<acute>Mul_Proper n \<and> \<acute>Mul_AppendInv \<acute>ind \<and> \<acute>ind<length \<acute>M \<and> \<acute>ind\<notin>Reach \<acute>E\<rbrace>
      \<acute>E:=Append_to_free(\<acute>ind,\<acute>E)
      FI;;
  \<lbrace>\<acute>Mul_Proper n \<and> \<acute>Mul_AppendInv (\<acute>ind+1) \<and> \<acute>ind<length \<acute>M\<rbrace>
   \<acute>ind:=\<acute>ind+1
  OD"

lemma Mul_Append:
  "\<turnstile> Mul_Append n
     \<lbrace>\<acute>Mul_Proper n\<rbrace>"
apply(unfold Mul_Append_def)
apply annhoare
apply(simp_all add: mul_collector_defs Mul_AppendInv_def
      Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
apply(force simp add:Blacks_def)
apply(force simp add:Blacks_def)
apply(force simp add:Blacks_def)
apply(force simp add:Graph_defs)
apply force
apply(force simp add:Append_to_free1 Append_to_free2)
apply force
apply force
done

subsubsection \<open>Collector\<close>

definition Mul_Collector :: "nat \<Rightarrow>  mul_gar_coll_state ann_com" where
  "Mul_Collector n \<equiv>
\<lbrace>\<acute>Mul_Proper n\<rbrace>
WHILE True INV \<lbrace>\<acute>Mul_Proper n\<rbrace>
DO
Mul_Blacken_Roots n ;;
\<lbrace>\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M\<rbrace>
 \<acute>obc:={};;
\<lbrace>\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc={}\<rbrace>
 \<acute>bc:=Roots;;
\<lbrace>\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc={} \<and> \<acute>bc=Roots\<rbrace>
 \<acute>l:=0;;
\<lbrace>\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>obc={} \<and> \<acute>bc=Roots \<and> \<acute>l=0\<rbrace>
 WHILE \<acute>l<n+1
   INV \<lbrace>\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M \<and>
         (\<acute>Safe \<or> (\<acute>l\<le>\<acute>Queue \<or> \<acute>bc\<subset>Blacks \<acute>M) \<and> \<acute>l<n+1)\<rbrace>
 DO \<lbrace>\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M
      \<and> (\<acute>Safe \<or> \<acute>l\<le>\<acute>Queue \<or> \<acute>bc\<subset>Blacks \<acute>M)\<rbrace>
    \<acute>obc:=\<acute>bc;;
    Mul_Propagate_Black n;;
    \<lbrace>\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M
      \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M
      \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>M \<or> \<acute>l<\<acute>Queue
      \<and> (\<acute>l\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M))\<rbrace>
    \<acute>bc:={};;
    \<lbrace>\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M
      \<and> \<acute>obc\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M
      \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>M \<or> \<acute>l<\<acute>Queue
      \<and> (\<acute>l\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M)) \<and> \<acute>bc={}\<rbrace>
       \<langle> \<acute>Ma:=\<acute>M,, \<acute>q:=\<acute>Queue \<rangle>;;
    Mul_Count n;;
    \<lbrace>\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M
      \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M
      \<and> length \<acute>Ma=length \<acute>M \<and> Blacks \<acute>Ma\<subseteq>\<acute>bc
      \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>Ma \<or> \<acute>l<\<acute>q \<and> (\<acute>q\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M))
      \<and> \<acute>q<n+1\<rbrace>
    IF \<acute>obc=\<acute>bc THEN
    \<lbrace>\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M
      \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M
      \<and> length \<acute>Ma=length \<acute>M \<and> Blacks \<acute>Ma\<subseteq>\<acute>bc
      \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>Ma \<or> \<acute>l<\<acute>q \<and> (\<acute>q\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M))
      \<and> \<acute>q<n+1 \<and> \<acute>obc=\<acute>bc\<rbrace>
    \<acute>l:=\<acute>l+1
    ELSE \<lbrace>\<acute>Mul_Proper n \<and> Roots\<subseteq>Blacks \<acute>M
          \<and> \<acute>obc\<subseteq>Blacks \<acute>Ma \<and> Blacks \<acute>Ma\<subseteq>Blacks \<acute>M \<and> \<acute>bc\<subseteq>Blacks \<acute>M
          \<and> length \<acute>Ma=length \<acute>M \<and> Blacks \<acute>Ma\<subseteq>\<acute>bc
          \<and> (\<acute>Safe \<or> \<acute>obc\<subset>Blacks \<acute>Ma \<or> \<acute>l<\<acute>q \<and> (\<acute>q\<le>\<acute>Queue \<or> \<acute>obc\<subset>Blacks \<acute>M))
          \<and> \<acute>q<n+1 \<and> \<acute>obc\<noteq>\<acute>bc\<rbrace>
        \<acute>l:=0 FI
 OD;;
 Mul_Append n
OD"

lemmas mul_modules = Mul_Redirect_Edge_def Mul_Color_Target_def
 Mul_Blacken_Roots_def Mul_Propagate_Black_def
 Mul_Count_def Mul_Append_def

lemma Mul_Collector:
  "\<turnstile> Mul_Collector n
  \<lbrace>False\<rbrace>"
apply(unfold Mul_Collector_def)
apply annhoare
apply(simp_all only:pre.simps Mul_Blacken_Roots
       Mul_Propagate_Black Mul_Count Mul_Append)
apply(simp_all add:mul_modules)
apply(simp_all add:mul_collector_defs Queue_def)
apply force
apply force
apply force
apply (force simp add: less_Suc_eq_le)
apply force
apply (force dest:subset_antisym)
apply force
apply force
apply force
done

subsection \<open>Interference Freedom\<close>

lemma le_length_filter_update[rule_format]:
 "\<forall>i. (\<not>P (list!i) \<or> P j) \<and> i<length list
 \<longrightarrow> length(filter P list) \<le> length(filter P (list[i:=j]))"
apply(induct_tac "list")
 apply(simp)
apply(clarify)
apply(case_tac i)
 apply(simp)
apply(simp)
done

lemma less_length_filter_update [rule_format]:
 "\<forall>i. P j \<and> \<not>(P (list!i)) \<and> i<length list
 \<longrightarrow> length(filter P list) < length(filter P (list[i:=j]))"
apply(induct_tac "list")
 apply(simp)
apply(clarify)
apply(case_tac i)
 apply(simp)
apply(simp)
done

lemma Mul_interfree_Blacken_Roots_Redirect_Edge: "\<lbrakk>0\<le>j; j<n\<rbrakk> \<Longrightarrow>
  interfree_aux (Some(Mul_Blacken_Roots n),{},Some(Mul_Redirect_Edge j n))"
apply (unfold mul_modules)
apply interfree_aux
apply safe
apply(simp_all add:Graph6 Graph9 Graph12 nth_list_update mul_mutator_defs mul_collector_defs)
done

lemma Mul_interfree_Redirect_Edge_Blacken_Roots: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>
  interfree_aux (Some(Mul_Redirect_Edge j n ),{},Some (Mul_Blacken_Roots n))"
apply (unfold mul_modules)
apply interfree_aux
apply safe
apply(simp_all add:mul_mutator_defs nth_list_update)
done

lemma Mul_interfree_Blacken_Roots_Color_Target: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>
  interfree_aux (Some(Mul_Blacken_Roots n),{},Some (Mul_Color_Target j n ))"
apply (unfold mul_modules)
apply interfree_aux
apply safe
apply(simp_all add:mul_mutator_defs mul_collector_defs nth_list_update Graph7 Graph8 Graph9 Graph12)
done

lemma Mul_interfree_Color_Target_Blacken_Roots: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>
  interfree_aux (Some(Mul_Color_Target j n ),{},Some (Mul_Blacken_Roots n ))"
apply (unfold mul_modules)
apply interfree_aux
apply safe
apply(simp_all add:mul_mutator_defs nth_list_update)
done

lemma Mul_interfree_Propagate_Black_Redirect_Edge: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>
  interfree_aux (Some(Mul_Propagate_Black n),{},Some (Mul_Redirect_Edge j n ))"
apply (unfold mul_modules)
apply interfree_aux
apply(simp_all add:mul_mutator_defs mul_collector_defs Mul_PBInv_def nth_list_update Graph6)
\<comment> \<open>7 subgoals left\<close>
apply clarify
apply(disjE_tac)
  apply(simp_all add:Graph6)
 apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
apply(rule conjI)
 apply(rule impI,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
apply(rule impI,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
\<comment> \<open>6 subgoals left\<close>
apply clarify
apply(disjE_tac)
  apply(simp_all add:Graph6)
 apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
apply(rule conjI)
 apply(rule impI,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
apply(rule impI,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
\<comment> \<open>5 subgoals left\<close>
apply clarify
apply(disjE_tac)
  apply(simp_all add:Graph6)
 apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
apply(rule conjI)
 apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule less_le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule less_le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
apply(erule conjE)
apply(case_tac "M x!(T (Muts x!j))=Black")
 apply(rule conjI)
  apply(rule impI,(rule disjI2)+,rule conjI)
   apply clarify
   apply(case_tac "R (Muts x! j)=i")
    apply (force simp add: nth_list_update BtoW_def)
   apply (force simp add: nth_list_update)
  apply(erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
 apply(rule impI,(rule disjI2)+, erule le_trans)
 apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
apply(rule conjI)
 apply(rule impI,rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
 apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
apply(rule impI,rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
\<comment> \<open>4 subgoals left\<close>
apply clarify
apply(disjE_tac)
  apply(simp_all add:Graph6)
 apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
apply(rule conjI)
 apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule less_le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule less_le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
apply(erule conjE)
apply(case_tac "M x!(T (Muts x!j))=Black")
 apply(rule conjI)
  apply(rule impI,(rule disjI2)+,rule conjI)
   apply clarify
   apply(case_tac "R (Muts x! j)=i")
    apply (force simp add: nth_list_update BtoW_def)
   apply (force simp add: nth_list_update)
  apply(erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
 apply(rule impI,(rule disjI2)+, erule le_trans)
 apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
apply(rule conjI)
 apply(rule impI,rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
 apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
apply(rule impI,rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
\<comment> \<open>3 subgoals left\<close>
apply clarify
apply(disjE_tac)
  apply(simp_all add:Graph6)
  apply (rule impI)
   apply(rule conjI)
    apply(rule disjI1,rule subset_trans,erule Graph3,simp,simp)
   apply(case_tac "R (Muts x ! j)= ind x")
    apply(simp add:nth_list_update)
   apply(simp add:nth_list_update)
  apply(case_tac "R (Muts x ! j)= ind x")
   apply(simp add:nth_list_update)
  apply(simp add:nth_list_update)
 apply(case_tac "M x!(T (Muts x!j))=Black")
  apply(rule conjI)
   apply(rule impI)
   apply(rule conjI)
    apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
    apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   apply(case_tac "R (Muts x ! j)= ind x")
    apply(simp add:nth_list_update)
   apply(simp add:nth_list_update)
  apply(rule impI)
  apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
 apply(rule conjI)
  apply(rule impI)
   apply(rule conjI)
    apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
    apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
   apply(case_tac "R (Muts x ! j)= ind x")
    apply(simp add:nth_list_update)
   apply(simp add:nth_list_update)
  apply(rule impI)
  apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
 apply(erule conjE)
 apply(rule conjI)
  apply(case_tac "M x!(T (Muts x!j))=Black")
   apply(rule impI,rule conjI,(rule disjI2)+,rule conjI)
    apply clarify
    apply(case_tac "R (Muts x! j)=i")
     apply (force simp add: nth_list_update BtoW_def)
    apply (force simp add: nth_list_update)
   apply(erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
  apply(case_tac "R (Muts x ! j)= ind x")
   apply(simp add:nth_list_update)
  apply(simp add:nth_list_update)
 apply(rule impI,rule conjI)
  apply(rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
  apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
 apply(case_tac "R (Muts x! j)=ind x")
  apply (force simp add: nth_list_update)
 apply (force simp add: nth_list_update)
apply(rule impI, (rule disjI2)+, erule le_trans)
apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
\<comment> \<open>2 subgoals left\<close>
apply clarify
apply(rule conjI)
 apply(disjE_tac)
  apply(simp_all add:Mul_Auxk_def Graph6)
  apply (rule impI)
   apply(rule conjI)
    apply(rule disjI1,rule subset_trans,erule Graph3,simp,simp)
   apply(case_tac "R (Muts x ! j)= ind x")
    apply(simp add:nth_list_update)
   apply(simp add:nth_list_update)
  apply(case_tac "R (Muts x ! j)= ind x")
   apply(simp add:nth_list_update)
  apply(simp add:nth_list_update)
 apply(case_tac "M x!(T (Muts x!j))=Black")
  apply(rule impI)
  apply(rule conjI)
   apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
   apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
  apply(case_tac "R (Muts x ! j)= ind x")
   apply(simp add:nth_list_update)
  apply(simp add:nth_list_update)
 apply(rule impI)
 apply(rule conjI)
  apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
 apply(case_tac "R (Muts x ! j)= ind x")
  apply(simp add:nth_list_update)
 apply(simp add:nth_list_update)
apply(rule impI)
apply(rule conjI)
 apply(erule conjE)+
 apply(case_tac "M x!(T (Muts x!j))=Black")
  apply((rule disjI2)+,rule conjI)
   apply clarify
   apply(case_tac "R (Muts x! j)=i")
    apply (force simp add: nth_list_update BtoW_def)
   apply (force simp add: nth_list_update)
  apply(rule conjI)
   apply(erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
  apply(rule impI)
  apply(case_tac "R (Muts x ! j)= ind x")
   apply(simp add:nth_list_update BtoW_def)
  apply (simp  add:nth_list_update)
  apply(rule impI)
  apply simp
  apply(disjE_tac)
   apply(rule disjI1, erule less_le_trans)
   apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
  apply force
 apply(rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
 apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
 apply(case_tac "R (Muts x ! j)= ind x")
  apply(simp add:nth_list_update)
 apply(simp add:nth_list_update)
apply(disjE_tac)
apply simp_all
apply(conjI_tac)
 apply(rule impI)
 apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
 apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
apply(erule conjE)+
apply(rule impI,(rule disjI2)+,rule conjI)
 apply(erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
apply(rule impI)+
apply simp
apply(disjE_tac)
 apply(rule disjI1, erule less_le_trans)
 apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
apply force
\<comment> \<open>1 subgoal left\<close>
apply clarify
apply(disjE_tac)
  apply(simp_all add:Graph6)
 apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
apply(rule conjI)
 apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule less_le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule less_le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
apply(erule conjE)
apply(case_tac "M x!(T (Muts x!j))=Black")
 apply(rule conjI)
  apply(rule impI,(rule disjI2)+,rule conjI)
   apply clarify
   apply(case_tac "R (Muts x! j)=i")
    apply (force simp add: nth_list_update BtoW_def)
   apply (force simp add: nth_list_update)
  apply(erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
 apply(rule impI,(rule disjI2)+, erule le_trans)
 apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
apply(rule conjI)
 apply(rule impI,rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
 apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
apply(rule impI,rule disjI2,rule disjI2,rule disjI1, erule le_less_trans)
apply(force simp add:Queue_def less_Suc_eq_le less_length_filter_update)
done

lemma Mul_interfree_Redirect_Edge_Propagate_Black: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>
  interfree_aux (Some(Mul_Redirect_Edge j n ),{},Some (Mul_Propagate_Black n))"
apply (unfold mul_modules)
apply interfree_aux
apply safe
apply(simp_all add:mul_mutator_defs nth_list_update)
done

lemma Mul_interfree_Propagate_Black_Color_Target: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>
  interfree_aux (Some(Mul_Propagate_Black n),{},Some (Mul_Color_Target j n ))"
apply (unfold mul_modules)
apply interfree_aux
apply(simp_all add: mul_collector_defs mul_mutator_defs)
\<comment> \<open>7 subgoals left\<close>
apply clarify
apply (simp add:Graph7 Graph8 Graph12)
apply(disjE_tac)
  apply(simp add:Graph7 Graph8 Graph12)
 apply(case_tac "M x!(T (Muts x!j))=Black")
  apply(rule disjI2,rule disjI1, erule le_trans)
  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
 apply((rule disjI2)+,erule subset_psubset_trans, erule Graph11, simp)
apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
\<comment> \<open>6 subgoals left\<close>
apply clarify
apply (simp add:Graph7 Graph8 Graph12)
apply(disjE_tac)
  apply(simp add:Graph7 Graph8 Graph12)
 apply(case_tac "M x!(T (Muts x!j))=Black")
  apply(rule disjI2,rule disjI1, erule le_trans)
  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
 apply((rule disjI2)+,erule subset_psubset_trans, erule Graph11, simp)
apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
\<comment> \<open>5 subgoals left\<close>
apply clarify
apply (simp add:mul_collector_defs Mul_PBInv_def Graph7 Graph8 Graph12)
apply(disjE_tac)
   apply(simp add:Graph7 Graph8 Graph12)
  apply(rule disjI2,rule disjI1, erule psubset_subset_trans,simp add:Graph9)
 apply(case_tac "M x!(T (Muts x!j))=Black")
  apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
 apply(rule disjI2,rule disjI1,erule subset_psubset_trans, erule Graph11, simp)
apply(erule conjE)
apply(case_tac "M x!(T (Muts x!j))=Black")
 apply((rule disjI2)+)
 apply (rule conjI)
  apply(simp add:Graph10)
 apply(erule le_trans)
 apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
apply(rule disjI2,rule disjI1,erule subset_psubset_trans, erule Graph11, simp)
\<comment> \<open>4 subgoals left\<close>
apply clarify
apply (simp add:mul_collector_defs Mul_PBInv_def Graph7 Graph8 Graph12)
apply(disjE_tac)
   apply(simp add:Graph7 Graph8 Graph12)
  apply(rule disjI2,rule disjI1, erule psubset_subset_trans,simp add:Graph9)
 apply(case_tac "M x!(T (Muts x!j))=Black")
  apply(rule disjI2,rule disjI2,rule disjI1, erule less_le_trans)
  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
 apply(rule disjI2,rule disjI1,erule subset_psubset_trans, erule Graph11, simp)
apply(erule conjE)
apply(case_tac "M x!(T (Muts x!j))=Black")
 apply((rule disjI2)+)
 apply (rule conjI)
  apply(simp add:Graph10)
 apply(erule le_trans)
 apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
apply(rule disjI2,rule disjI1,erule subset_psubset_trans, erule Graph11, simp)
\<comment> \<open>3 subgoals left\<close>
apply clarify
apply (simp add:mul_collector_defs Mul_PBInv_def Graph7 Graph8 Graph12)
apply(case_tac "M x!(T (Muts x!j))=Black")
 apply(simp add:Graph10)
 apply(disjE_tac)
  apply simp_all
  apply(rule disjI2, rule disjI2, rule disjI1,erule less_le_trans)
  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
 apply(erule conjE)
 apply((rule disjI2)+,erule le_trans)
 apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
apply(rule conjI)
 apply(rule disjI2,rule disjI1, erule subset_psubset_trans,simp add:Graph11)
apply (force simp add:nth_list_update)
\<comment> \<open>2 subgoals left\<close>
apply clarify
apply(simp add:Mul_Auxk_def Graph7 Graph8 Graph12)
apply(case_tac "M x!(T (Muts x!j))=Black")
 apply(simp add:Graph10)
 apply(disjE_tac)
  apply simp_all
  apply(rule disjI2, rule disjI2, rule disjI1,erule less_le_trans)
  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
 apply(erule conjE)+
 apply((rule disjI2)+,rule conjI, erule le_trans)
  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
 apply((rule impI)+)
 apply simp
 apply(erule disjE)
  apply(rule disjI1, erule less_le_trans)
  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
 apply force
apply(rule conjI)
 apply(rule disjI2,rule disjI1, erule subset_psubset_trans,simp add:Graph11)
apply (force simp add:nth_list_update)
\<comment> \<open>1 subgoal left\<close>
apply clarify
apply (simp add:mul_collector_defs Mul_PBInv_def Graph7 Graph8 Graph12)
apply(case_tac "M x!(T (Muts x!j))=Black")
 apply(simp add:Graph10)
 apply(disjE_tac)
  apply simp_all
  apply(rule disjI2, rule disjI2, rule disjI1,erule less_le_trans)
  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
 apply(erule conjE)
 apply((rule disjI2)+,erule le_trans)
 apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
apply(rule disjI2,rule disjI1, erule subset_psubset_trans,simp add:Graph11)
done

lemma Mul_interfree_Color_Target_Propagate_Black: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>
  interfree_aux (Some(Mul_Color_Target j n),{},Some(Mul_Propagate_Black n ))"
apply (unfold mul_modules)
apply interfree_aux
apply safe
apply(simp_all add:mul_mutator_defs nth_list_update)
done

lemma Mul_interfree_Count_Redirect_Edge: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>
  interfree_aux (Some(Mul_Count n ),{},Some(Mul_Redirect_Edge j n))"
apply (unfold mul_modules)
apply interfree_aux
\<comment> \<open>9 subgoals left\<close>
apply(simp add:mul_mutator_defs mul_collector_defs Mul_CountInv_def Graph6)
apply clarify
apply disjE_tac
   apply(simp add:Graph6)
  apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
 apply(simp add:Graph6)
apply clarify
apply disjE_tac
 apply(simp add:Graph6)
 apply(rule conjI)
  apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
 apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
apply(simp add:Graph6)
\<comment> \<open>8 subgoals left\<close>
apply(simp add:mul_mutator_defs nth_list_update)
\<comment> \<open>7 subgoals left\<close>
apply(simp add:mul_mutator_defs mul_collector_defs)
apply clarify
apply disjE_tac
   apply(simp add:Graph6)
  apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
 apply(simp add:Graph6)
apply clarify
apply disjE_tac
 apply(simp add:Graph6)
 apply(rule conjI)
  apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
 apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
apply(simp add:Graph6)
\<comment> \<open>6 subgoals left\<close>
apply(simp add:mul_mutator_defs mul_collector_defs Mul_CountInv_def)
apply clarify
apply disjE_tac
   apply(simp add:Graph6 Queue_def)
  apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
 apply(simp add:Graph6)
apply clarify
apply disjE_tac
 apply(simp add:Graph6)
 apply(rule conjI)
  apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
 apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
apply(simp add:Graph6)
\<comment> \<open>5 subgoals left\<close>
apply(simp add:mul_mutator_defs mul_collector_defs Mul_CountInv_def)
apply clarify
apply disjE_tac
   apply(simp add:Graph6)
  apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
 apply(simp add:Graph6)
apply clarify
apply disjE_tac
 apply(simp add:Graph6)
 apply(rule conjI)
  apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
 apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
apply(simp add:Graph6)
\<comment> \<open>4 subgoals left\<close>
apply(simp add:mul_mutator_defs mul_collector_defs Mul_CountInv_def)
apply clarify
apply disjE_tac
   apply(simp add:Graph6)
  apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
 apply(simp add:Graph6)
apply clarify
apply disjE_tac
 apply(simp add:Graph6)
 apply(rule conjI)
  apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
 apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
apply(simp add:Graph6)
\<comment> \<open>3 subgoals left\<close>
apply(simp add:mul_mutator_defs nth_list_update)
\<comment> \<open>2 subgoals left\<close>
apply(simp add:mul_mutator_defs mul_collector_defs Mul_CountInv_def)
apply clarify
apply disjE_tac
   apply(simp add:Graph6)
  apply(rule impI,rule disjI1,rule subset_trans,erule Graph3,simp,simp)
 apply(simp add:Graph6)
apply clarify
apply disjE_tac
 apply(simp add:Graph6)
 apply(rule conjI)
  apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
 apply(rule impI,rule disjI2,rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
apply(simp add:Graph6)
\<comment> \<open>1 subgoal left\<close>
apply(simp add:mul_mutator_defs nth_list_update)
done

lemma Mul_interfree_Redirect_Edge_Count: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>
  interfree_aux (Some(Mul_Redirect_Edge j n),{},Some(Mul_Count n ))"
apply (unfold mul_modules)
apply interfree_aux
apply safe
apply(simp_all add:mul_mutator_defs nth_list_update)
done

lemma Mul_interfree_Count_Color_Target: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>
  interfree_aux (Some(Mul_Count n ),{},Some(Mul_Color_Target j n))"
apply (unfold mul_modules)
apply interfree_aux
apply(simp_all add:mul_collector_defs mul_mutator_defs Mul_CountInv_def)
\<comment> \<open>6 subgoals left\<close>
apply clarify
apply disjE_tac
  apply (simp add: Graph7 Graph8 Graph12)
 apply (simp add: Graph7 Graph8 Graph12)
apply clarify
apply disjE_tac
 apply (simp add: Graph7 Graph8 Graph12)
 apply(case_tac "M x!(T (Muts x!j))=Black")
  apply(rule disjI2,rule disjI2, rule disjI1, erule le_trans)
  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
 apply((rule disjI2)+,(erule subset_psubset_trans)+, simp add: Graph11)
apply (simp add: Graph7 Graph8 Graph12)
apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
\<comment> \<open>5 subgoals left\<close>
apply clarify
apply disjE_tac
  apply (simp add: Graph7 Graph8 Graph12)
 apply (simp add: Graph7 Graph8 Graph12)
apply clarify
apply disjE_tac
 apply (simp add: Graph7 Graph8 Graph12)
 apply(case_tac "M x!(T (Muts x!j))=Black")
  apply(rule disjI2,rule disjI2, rule disjI1, erule le_trans)
  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
 apply((rule disjI2)+,(erule subset_psubset_trans)+, simp add: Graph11)
apply (simp add: Graph7 Graph8 Graph12)
apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
\<comment> \<open>4 subgoals left\<close>
apply clarify
apply disjE_tac
  apply (simp add: Graph7 Graph8 Graph12)
 apply (simp add: Graph7 Graph8 Graph12)
apply clarify
apply disjE_tac
 apply (simp add: Graph7 Graph8 Graph12)
 apply(case_tac "M x!(T (Muts x!j))=Black")
  apply(rule disjI2,rule disjI2, rule disjI1, erule le_trans)
  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
 apply((rule disjI2)+,(erule subset_psubset_trans)+, simp add: Graph11)
apply (simp add: Graph7 Graph8 Graph12)
apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
\<comment> \<open>3 subgoals left\<close>
apply clarify
apply disjE_tac
  apply (simp add: Graph7 Graph8 Graph12)
 apply (simp add: Graph7 Graph8 Graph12)
apply clarify
apply disjE_tac
 apply (simp add: Graph7 Graph8 Graph12)
 apply(case_tac "M x!(T (Muts x!j))=Black")
  apply(rule disjI2,rule disjI2, rule disjI1, erule le_trans)
  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
 apply((rule disjI2)+,(erule subset_psubset_trans)+, simp add: Graph11)
apply (simp add: Graph7 Graph8 Graph12)
apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
\<comment> \<open>2 subgoals left\<close>
apply clarify
apply disjE_tac
  apply (simp add: Graph7 Graph8 Graph12 nth_list_update)
 apply (simp add: Graph7 Graph8 Graph12 nth_list_update)
apply clarify
apply disjE_tac
 apply (simp add: Graph7 Graph8 Graph12)
 apply(rule conjI)
  apply(case_tac "M x!(T (Muts x!j))=Black")
   apply(rule disjI2,rule disjI2, rule disjI1, erule le_trans)
   apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
  apply((rule disjI2)+,(erule subset_psubset_trans)+, simp add: Graph11)
 apply (simp add: nth_list_update)
apply (simp add: Graph7 Graph8 Graph12)
apply(rule conjI)
 apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
apply (simp add: nth_list_update)
\<comment> \<open>1 subgoal left\<close>
apply clarify
apply disjE_tac
  apply (simp add: Graph7 Graph8 Graph12)
 apply (simp add: Graph7 Graph8 Graph12)
apply clarify
apply disjE_tac
 apply (simp add: Graph7 Graph8 Graph12)
 apply(case_tac "M x!(T (Muts x!j))=Black")
  apply(rule disjI2,rule disjI2, rule disjI1, erule le_trans)
  apply(force simp add:Queue_def less_Suc_eq_le le_length_filter_update Graph10)
 apply((rule disjI2)+,(erule subset_psubset_trans)+, simp add: Graph11)
apply (simp add: Graph7 Graph8 Graph12)
apply((rule disjI2)+,erule psubset_subset_trans, simp add: Graph9)
done

lemma Mul_interfree_Color_Target_Count: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>
  interfree_aux (Some(Mul_Color_Target j n),{}, Some(Mul_Count n ))"
apply (unfold mul_modules)
apply interfree_aux
apply safe
apply(simp_all add:mul_mutator_defs nth_list_update)
done

lemma Mul_interfree_Append_Redirect_Edge: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>
  interfree_aux (Some(Mul_Append n),{}, Some(Mul_Redirect_Edge j n))"
apply (unfold mul_modules)
apply interfree_aux
apply(tactic \<open>ALLGOALS (clarify_tac \<^context>)\<close>)
apply(simp_all add:Graph6 Append_to_free0 Append_to_free1 mul_collector_defs mul_mutator_defs Mul_AppendInv_def)
apply(erule_tac x=j in allE, force dest:Graph3)+
done

lemma Mul_interfree_Redirect_Edge_Append: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>
  interfree_aux (Some(Mul_Redirect_Edge j n),{},Some(Mul_Append n))"
apply (unfold mul_modules)
apply interfree_aux
apply(tactic \<open>ALLGOALS (clarify_tac \<^context>)\<close>)
apply(simp_all add:mul_collector_defs Append_to_free0 Mul_AppendInv_def  mul_mutator_defs nth_list_update)
done

lemma Mul_interfree_Append_Color_Target: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>
  interfree_aux (Some(Mul_Append n),{}, Some(Mul_Color_Target j n))"
apply (unfold mul_modules)
apply interfree_aux
apply(tactic \<open>ALLGOALS (clarify_tac \<^context>)\<close>)
apply(simp_all add:mul_mutator_defs mul_collector_defs Mul_AppendInv_def Graph7 Graph8 Append_to_free0 Append_to_free1
              Graph12 nth_list_update)
done

lemma Mul_interfree_Color_Target_Append: "\<lbrakk>0\<le>j; j<n\<rbrakk>\<Longrightarrow>
  interfree_aux (Some(Mul_Color_Target j n),{}, Some(Mul_Append n))"
apply (unfold mul_modules)
apply interfree_aux
apply(tactic \<open>ALLGOALS (clarify_tac \<^context>)\<close>)
apply(simp_all add: mul_mutator_defs nth_list_update)
apply(simp add:Mul_AppendInv_def Append_to_free0)
done

subsubsection \<open>Interference freedom Collector-Mutator\<close>

lemmas mul_collector_mutator_interfree =
 Mul_interfree_Blacken_Roots_Redirect_Edge Mul_interfree_Blacken_Roots_Color_Target
 Mul_interfree_Propagate_Black_Redirect_Edge Mul_interfree_Propagate_Black_Color_Target
 Mul_interfree_Count_Redirect_Edge Mul_interfree_Count_Color_Target
 Mul_interfree_Append_Redirect_Edge Mul_interfree_Append_Color_Target
 Mul_interfree_Redirect_Edge_Blacken_Roots Mul_interfree_Color_Target_Blacken_Roots
 Mul_interfree_Redirect_Edge_Propagate_Black Mul_interfree_Color_Target_Propagate_Black
 Mul_interfree_Redirect_Edge_Count Mul_interfree_Color_Target_Count
 Mul_interfree_Redirect_Edge_Append Mul_interfree_Color_Target_Append

lemma Mul_interfree_Collector_Mutator: "j<n  \<Longrightarrow>
  interfree_aux (Some (Mul_Collector n), {}, Some (Mul_Mutator j n))"
apply(unfold Mul_Collector_def Mul_Mutator_def)
apply interfree_aux
apply(simp_all add:mul_collector_mutator_interfree)
apply(unfold mul_modules mul_collector_defs mul_mutator_defs)
apply(tactic  \<open>TRYALL (interfree_aux_tac \<^context>)\<close>)
\<comment> \<open>42 subgoals left\<close>
apply (clarify,simp add:Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)+
\<comment> \<open>24 subgoals left\<close>
apply(simp_all add:Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
\<comment> \<open>14 subgoals left\<close>
apply(tactic \<open>TRYALL (clarify_tac \<^context>)\<close>)
apply(simp_all add:Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
apply(tactic \<open>TRYALL (resolve_tac \<^context> [conjI])\<close>)
apply(tactic \<open>TRYALL (resolve_tac \<^context> [impI])\<close>)
apply(tactic \<open>TRYALL (eresolve_tac \<^context> [disjE])\<close>)
apply(tactic \<open>TRYALL (eresolve_tac \<^context> [conjE])\<close>)
apply(tactic \<open>TRYALL (eresolve_tac \<^context> [disjE])\<close>)
apply(tactic \<open>TRYALL (eresolve_tac \<^context> [disjE])\<close>)
\<comment> \<open>72 subgoals left\<close>
apply(simp_all add:Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
\<comment> \<open>35 subgoals left\<close>
apply(tactic \<open>TRYALL(EVERY'[resolve_tac \<^context> [disjI1],
    resolve_tac \<^context> [subset_trans],
    eresolve_tac \<^context> @{thms Graph3},
    force_tac \<^context>,
    assume_tac \<^context>])\<close>)
\<comment> \<open>28 subgoals left\<close>
apply(tactic \<open>TRYALL (eresolve_tac \<^context> [conjE])\<close>)
apply(tactic \<open>TRYALL (eresolve_tac \<^context> [disjE])\<close>)
\<comment> \<open>34 subgoals left\<close>
apply(rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
apply(rule disjI2,rule disjI1,erule le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update)
apply(case_tac [!] "M x!(T (Muts x ! j))=Black")
apply(simp_all add:Graph10)
\<comment> \<open>47 subgoals left\<close>
apply(tactic \<open>TRYALL(EVERY'[REPEAT o resolve_tac \<^context> [disjI2],
    eresolve_tac \<^context> @{thms subset_psubset_trans},
    eresolve_tac \<^context> @{thms Graph11},
    force_tac \<^context>])\<close>)
\<comment> \<open>41 subgoals left\<close>
apply(tactic \<open>TRYALL(EVERY'[resolve_tac \<^context> [disjI2],
    resolve_tac \<^context> [disjI1],
    eresolve_tac \<^context> @{thms le_trans},
    force_tac (\<^context> addsimps @{thms Queue_def less_Suc_eq_le le_length_filter_update})])\<close>)
\<comment> \<open>35 subgoals left\<close>
apply(tactic \<open>TRYALL(EVERY'[resolve_tac \<^context> [disjI2],
    resolve_tac \<^context> [disjI1],
    eresolve_tac \<^context> @{thms psubset_subset_trans},
    resolve_tac \<^context> @{thms Graph9},
    force_tac \<^context>])\<close>)
\<comment> \<open>31 subgoals left\<close>
apply(tactic \<open>TRYALL(EVERY'[resolve_tac \<^context> [disjI2],
    resolve_tac \<^context> [disjI1],
    eresolve_tac \<^context> @{thms subset_psubset_trans},
    eresolve_tac \<^context> @{thms Graph11},
    force_tac \<^context>])\<close>)
\<comment> \<open>29 subgoals left\<close>
apply(tactic \<open>TRYALL(EVERY'[REPEAT o resolve_tac \<^context> [disjI2],
    eresolve_tac \<^context> @{thms subset_psubset_trans},
    eresolve_tac \<^context> @{thms subset_psubset_trans},
    eresolve_tac \<^context> @{thms Graph11},
    force_tac \<^context>])\<close>)
\<comment> \<open>25 subgoals left\<close>
apply(tactic \<open>TRYALL(EVERY'[resolve_tac \<^context> [disjI2],
    resolve_tac \<^context> [disjI2],
    resolve_tac \<^context> [disjI1],
    eresolve_tac \<^context> @{thms le_trans},
    force_tac (\<^context> addsimps @{thms Queue_def less_Suc_eq_le le_length_filter_update})])\<close>)
\<comment> \<open>10 subgoals left\<close>
apply(rule disjI2,rule disjI2,rule conjI,erule less_le_trans,force simp add:Queue_def less_Suc_eq_le le_length_filter_update, rule disjI1, rule less_imp_le, erule less_le_trans, force simp add:Queue_def less_Suc_eq_le le_length_filter_update)+
done

subsubsection \<open>Interference freedom Mutator-Collector\<close>

lemma Mul_interfree_Mutator_Collector: " j < n \<Longrightarrow>
  interfree_aux (Some (Mul_Mutator j n), {}, Some (Mul_Collector n))"
apply(unfold Mul_Collector_def Mul_Mutator_def)
apply interfree_aux
apply(simp_all add:mul_collector_mutator_interfree)
apply(unfold mul_modules mul_collector_defs mul_mutator_defs)
apply(tactic  \<open>TRYALL (interfree_aux_tac \<^context>)\<close>)
\<comment> \<open>76 subgoals left\<close>
apply (clarsimp simp add: nth_list_update)+
\<comment> \<open>56 subgoals left\<close>
apply (clarsimp simp add: Mul_AppendInv_def Append_to_free0 nth_list_update)+
done

subsubsection \<open>The Multi-Mutator Garbage Collection Algorithm\<close>

text \<open>The total number of verification conditions is 328\<close>

lemma Mul_Gar_Coll:
 "\<parallel>- \<lbrace>\<acute>Mul_Proper n \<and> \<acute>Mul_mut_init n \<and> (\<forall>i<n. Z (\<acute>Muts!i))\<rbrace>
 COBEGIN
  Mul_Collector n
 \<lbrace>False\<rbrace>
 \<parallel>
 SCHEME  [0\<le> j< n]
  Mul_Mutator j n
 \<lbrace>False\<rbrace>
 COEND
 \<lbrace>False\<rbrace>"
apply oghoare
\<comment> \<open>Strengthening the precondition\<close>
apply(rule Int_greatest)
 apply (case_tac n)
  apply(force simp add: Mul_Collector_def mul_mutator_defs mul_collector_defs nth_append)
 apply(simp add: Mul_Mutator_def mul_collector_defs mul_mutator_defs nth_append)
 apply force
apply clarify
apply(case_tac i)
 apply(simp add:Mul_Collector_def mul_mutator_defs mul_collector_defs nth_append)
apply(simp add: Mul_Mutator_def mul_mutator_defs mul_collector_defs nth_append nth_map_upt)
\<comment> \<open>Collector\<close>
apply(rule Mul_Collector)
\<comment> \<open>Mutator\<close>
apply(erule Mul_Mutator)
\<comment> \<open>Interference freedom\<close>
apply(simp add:Mul_interfree_Collector_Mutator)
apply(simp add:Mul_interfree_Mutator_Collector)
apply(simp add:Mul_interfree_Mutator_Mutator)
\<comment> \<open>Weakening of the postcondition\<close>
apply(case_tac n)
 apply(simp add:Mul_Collector_def mul_mutator_defs mul_collector_defs nth_append)
apply(simp add:Mul_Mutator_def mul_mutator_defs mul_collector_defs nth_append)
done

end