(* Author: Andreas Lochbihler, ETH Zurich
   Author: Joshua Schneider, ETH Zurich *)

section \<open>Example: deterministic discrete system\<close>

theory DDS imports
  Concrete_Examples
  "HOL-Library.Rewrite"
  "HOL-Library.FSet"
begin

unbundle lifting_syntax

subsection \<open>Definition and generalised mapper and relator\<close>

codatatype ('a, 'b) dds = DDS (run: "'a \<Rightarrow> 'b \<times> ('a, 'b) dds")
  for map: map_dds'
      rel: rel_dds'

primcorec map_dds :: "('a' \<Rightarrow> 'a) \<Rightarrow> ('b \<Rightarrow> 'b') \<Rightarrow> ('a, 'b) dds \<Rightarrow> ('a', 'b') dds" where
  "run (map_dds f g S) = (\<lambda>a. map_prod g (map_dds f g) (run S (f a)))"

lemma map_dds_id: "map_dds id id S = S"
  by(coinduction arbitrary: S)(auto simp add: rel_fun_def prod.rel_map intro: prod.rel_refl_strong)

coinductive rel_dds :: "('a \<Rightarrow> 'a' \<Rightarrow> bool) \<Rightarrow> ('b \<Rightarrow> 'b' \<Rightarrow> bool) \<Rightarrow> ('a, 'b) dds \<Rightarrow> ('a', 'b') dds \<Rightarrow> bool"
  for A B where
  "rel_dds A B S S'" if "rel_fun A (rel_prod B (rel_dds A B)) (run S) (run S')"

lemma rel_dds'_rel_dds: "rel_dds' B = rel_dds (=) B"
  apply (intro ext iffI)
   apply (erule rel_dds.coinduct)
   apply (erule dds.rel_cases)
   apply (simp)
   apply (erule rel_fun_mono[THEN predicate2D, OF order_refl, rotated -1])
   apply (rule prod.rel_mono[OF order_refl])
   apply (blast)
  apply (erule dds.rel_coinduct)
  apply (erule rel_dds.cases)
  apply (simp)
  done

lemma rel_dds_eq [relator_eq]: "rel_dds (=) (=) = (=)"
  apply(rule ext iffI)+
  subgoal by(erule dds.coinduct)(erule rel_dds.cases; simp)
  subgoal by(erule rel_dds.coinduct)(auto simp add: rel_fun_def intro!: prod.rel_refl_strong)
  done

lemma rel_dds_mono [relator_mono]: "rel_dds A B \<le> rel_dds A' B'" if "A' \<le> A" "B \<le> B'"
  apply(rule predicate2I)
  apply(erule rel_dds.coinduct)
  apply(erule rel_dds.cases)
  apply simp
  apply(erule BNF_Def.rel_fun_mono)
   apply(auto intro: that[THEN predicate2D])
  done

lemma rel_dds_conversep: "rel_dds A\<inverse>\<inverse> B\<inverse>\<inverse> = (rel_dds A B)\<inverse>\<inverse>"
  apply(intro ext iffI; simp)
  subgoal
    apply(erule rel_dds.coinduct; erule rel_dds.cases; simp del: conversep_iff)
    apply(rewrite conversep_iff[symmetric])
    apply(fold rel_fun_conversep prod.rel_conversep)
    apply(erule BNF_Def.rel_fun_mono)
     apply(auto simp del: conversep_iff)
    done
  subgoal
    apply(erule rel_dds.coinduct; erule rel_dds.cases; clarsimp simp del: conversep_iff)
    apply(rewrite in asm conversep_iff[symmetric])
    apply(fold rel_fun_conversep prod.rel_conversep)
    apply(erule BNF_Def.rel_fun_mono)
     apply(auto simp del: conversep_iff)
    done
  done

lemma DDS_parametric [transfer_rule]:
  "((A ===> rel_prod B (rel_dds A B)) ===> rel_dds A B) DDS DDS"
  by(auto intro!: rel_dds.intros)

lemma run_parametric [transfer_rule]:
  "(rel_dds A B ===> A ===> rel_prod B (rel_dds A B)) run run"
  by(auto elim: rel_dds.cases)

lemma corec_dds_parametric [transfer_rule]:
  "((S ===> A ===> rel_prod B (rel_sum (rel_dds A B) S)) ===> S ===> rel_dds A B) corec_dds corec_dds"
  apply(rule rel_funI)+
  subgoal premises prems for f g s s' using prems(2)
    apply(coinduction arbitrary: s s')
    apply simp
    apply(rule comp_transfer[THEN rel_funD, THEN rel_funD, rotated])
     apply(erule prems(1)[THEN rel_funD])
    apply(rule prod.map_transfer[THEN rel_funD, THEN rel_funD, OF id_transfer])
    apply(fastforce elim!: rel_sum.cases)
    done
  done

lemma map_dds_parametric [transfer_rule]:
  "((A' ===> A) ===> (B ===> B') ===> rel_dds A B ===> rel_dds A' B') map_dds map_dds"
  unfolding map_dds_def by transfer_prover

lemmas map_dds_rel_cong = map_dds_parametric[unfolded rel_fun_def, rule_format, rotated -1]

lemma rel_dds_Grp:
  "rel_dds (Grp UNIV f)\<inverse>\<inverse> (Grp UNIV g) = Grp UNIV (map_dds f g)"
  apply(rule ext iffI)+
   apply(simp add: Grp_apply)
   apply(rule sym)
   apply(fold rel_dds_eq)
   apply(rewrite in "rel_dds _ _ _ \<hole>" map_dds_id[symmetric])
   apply(erule map_dds_parametric[THEN rel_funD, THEN rel_funD, THEN rel_funD, rotated -1];
      simp add: Grp_apply rel_fun_def)
  apply(erule GrpE; clarsimp)
  apply(rewrite in "rel_dds _ _ \<hole>" map_dds_id[symmetric])
  apply(rule map_dds_parametric[THEN rel_funD, THEN rel_funD, THEN rel_funD, rotated -1])
    apply(subst rel_dds_eq; simp)
   apply(simp_all add: Grp_apply rel_fun_def)
  done

lemma rel_dds_pos_distr [relator_distr]:
  "rel_dds A B OO rel_dds C D \<le> rel_dds (A OO C) (B OO D)"
  apply (rule predicate2I)
  apply (erule relcomppE)
  subgoal for x y z
    apply (coinduction arbitrary: x y z)
    apply (simp)
    apply (rule rel_fun_mono[THEN predicate2D, OF order_refl,
          of "rel_prod B (rel_dds A B) OO rel_prod D (rel_dds C D)"])
     apply (rule order_trans)
      apply (rule prod.rel_compp[symmetric, THEN eq_refl])
     apply (rule prod.rel_mono[OF order_refl])
     apply (blast)
    apply (rule rel_fun_pos_distr[THEN predicate2D])
     apply (simp)
    apply (rule relcomppI)
     apply (auto elim: rel_dds.cases)
    done
  done

lemma Quotient_dds [quot_map]:
  assumes "Quotient R1 Abs1 Rep1 T1" and "Quotient R2 Abs2 Rep2 T2"
  shows "Quotient (rel_dds R1 R2) (map_dds Rep1 Abs2) (map_dds Abs1 Rep2) (rel_dds T1 T2)"
  unfolding Quotient_alt_def5
proof (intro conjI, goal_cases)
  case 1
  have "rel_dds T1 T2 \<le> rel_dds (Grp UNIV Rep1)\<inverse>\<inverse> (Grp UNIV Abs2)"
    apply (rule rel_dds_mono)
     apply (rule assms(1)[unfolded Quotient_alt_def5, THEN conjunct2, THEN conjunct1,
          unfolded conversep_le_swap])
    apply (rule assms(2)[unfolded Quotient_alt_def5, THEN conjunct1])
    done
  also have "... = Grp UNIV (map_dds Rep1 Abs2)" using rel_dds_Grp .
  finally show ?case .
next
  case 2
  have "Grp UNIV (map_dds Abs1 Rep2) = rel_dds (Grp UNIV Abs1)\<inverse>\<inverse> (Grp UNIV Rep2)"
    using rel_dds_Grp[symmetric] .
  also have "... \<le> rel_dds T1\<inverse>\<inverse> T2\<inverse>\<inverse>"
    apply (rule rel_dds_mono)
     apply (simp)
     apply (rule assms(1)[unfolded Quotient_alt_def5, THEN conjunct1])
    apply (rule assms(2)[unfolded Quotient_alt_def5, THEN conjunct2, THEN conjunct1])
    done
  finally show ?case by (simp add: rel_dds_conversep)
next
  case 3
  show ?case
    apply (rule antisym)
     apply (rule predicate2I)
     apply (rule relcomppI)
      apply (subst map_dds_id[symmetric])
      apply (erule map_dds_rel_cong)
       apply (simp_all)[2]
       apply (erule assms(1)[THEN Quotient_rep_equiv1])
      apply (erule assms(2)[THEN Quotient_equiv_abs1])
     apply (subst rel_dds_conversep[symmetric])
    subgoal for x y
      apply (subgoal_tac "map_dds Rep1 Abs2 y = map_dds Rep1 Abs2 x")
       apply (simp)
       apply (subst (3) map_dds_id[symmetric])
       apply (erule map_dds_rel_cong)
        apply (simp_all)
        apply (erule assms(1)[THEN Quotient_rep_equiv2])
       apply (erule assms(2)[THEN Quotient_equiv_abs2])
      apply (rule sym)
      apply (subst rel_dds_eq[symmetric])
      apply (erule map_dds_rel_cong)
       apply (simp, rule assms(1)[THEN Quotient_rep_reflp])
      apply (erule assms(2)[THEN Quotient_rel_abs])
      done
    apply (unfold rel_dds_conversep[symmetric]
        assms[unfolded Quotient_alt_def5, THEN conjunct2, THEN conjunct2])
    apply (rule rel_dds_pos_distr)
    done
qed

text \<open>This is just the co-iterator.\<close>

primcorec dds_of :: "('s \<Rightarrow> 'a \<Rightarrow> ('b \<times> 's)) \<Rightarrow> 's \<Rightarrow> ('a, 'b) dds" where
  "run (dds_of f s) = map_prod id (dds_of f) \<circ> f s"

lemma dds_of_parametric [transfer_rule]:
  "((S ===> A ===> rel_prod B S) ===> S ===> rel_dds A B) dds_of dds_of"
  unfolding dds_of_def by transfer_prover

subsection \<open>Evenness of partial sums\<close>

definition even_psum :: "(int, bool) dds" where
  "even_psum = dds_of (\<lambda>psum n. (even (psum + n), psum + n)) 0"

definition even_psum_nat :: "(nat, bool) dds" where
  "even_psum_nat = map_dds int id even_psum"

subsection \<open>Composition\<close>

primcorec compose :: "('a, 'b) dds \<Rightarrow> ('b, 'c) dds \<Rightarrow> ('a, 'c) dds" (infixl "\<bullet>" 120) where
  "run (S1 \<bullet> S2) = (\<lambda>a. let (b, S1') = run S1 a; (c, S2') = run S2 b in (c, S1' \<bullet> S2'))"

lemma compose_parametric [transfer_rule]:
  "(rel_dds A B ===> rel_dds B C ===> rel_dds A C) (\<bullet>) (\<bullet>)"
  unfolding compose_def by transfer_prover

text \<open>
  For the following lemma, a direct proof by induction is easy as the inner functor of
  the @{type dds} codatatype is fairly simple.
\<close>

lemma "map_dds f g S1 \<bullet> S2 = map_dds f id (S1 \<bullet> map_dds g id S2)"
  apply(coinduction arbitrary: S1 S2)
  apply(auto simp add: case_prod_map_prod rel_fun_def split: prod.split)
  done

text \<open>However, we can also follow the systematic route via parametricity:\<close>

lemma compose_map1: "map_dds f g S1 \<bullet> S2 = map_dds f id (S1 \<bullet> map_dds g id S2)"
  for S1 :: "('a, 'b) dds" and S2 :: "('b, 'c) dds"
  using compose_parametric[of "(Grp UNIV f)\<inverse>\<inverse>" "Grp UNIV g" "Grp UNIV id :: 'c \<Rightarrow> 'c \<Rightarrow> bool"]
  apply(rewrite in "_ ===> rel_dds \<hole> _ ===> _" in asm conversep_conversep[symmetric])
  apply(rewrite in "_ ===> rel_dds _ \<hole> ===> _" in asm conversep_Grp_id[symmetric])
  apply(simp only: rel_dds_conversep rel_dds_Grp)
  apply(simp add: rel_fun_def Grp_apply)
  done

lemma compose_map2: "S1 \<bullet> map_dds f g S2 = map_dds id g (map_dds id f S1 \<bullet> S2)"
  for S1 :: "('a, 'b) dds" and S2 :: "('b, 'c) dds"
  using compose_parametric[of "Grp UNIV id :: 'a \<Rightarrow> 'a \<Rightarrow> bool" "(Grp UNIV f)\<inverse>\<inverse>" "Grp UNIV g"]
  apply(rewrite in "rel_dds \<hole> _ ===> _" in asm conversep_conversep[symmetric])
  apply(rewrite in "_ ===> _ ===> rel_dds \<hole> _" in asm conversep_Grp_id[symmetric])
  apply(simp only: rel_dds_conversep rel_dds_Grp)
  apply(simp add: rel_fun_def Grp_apply)
  done

primcorec parallel :: "('a, 'b) dds \<Rightarrow> ('c, 'd) dds \<Rightarrow> ('a + 'c, 'b + 'd) dds" (infixr "\<parallel>" 130) where
  "run (S1 \<parallel> S2) = (\<lambda>x. case x of
     Inl a \<Rightarrow> let (b, S1') = run S1 a in (Inl b, S1' \<parallel> S2)
   | Inr c \<Rightarrow> let (d, S2') = run S2 c in (Inr d, S1 \<parallel> S2'))"

lemma parallel_parametric [transfer_rule]:
  "(rel_dds A B ===> rel_dds C D ===> rel_dds (rel_sum A C) (rel_sum B D)) (\<parallel>) (\<parallel>)"
  unfolding parallel_def by transfer_prover

lemma map_parallel:
  "map_dds f h S1 \<parallel> map_dds g k S2 = map_dds (map_sum f g) (map_sum h k) (S1 \<parallel> S2)"
  using parallel_parametric[where A="(Grp UNIV f)\<inverse>\<inverse>" and B="Grp UNIV h" and
      C="(Grp UNIV g)\<inverse>\<inverse>" and D="Grp UNIV k"]
  by(simp add: sum.rel_conversep sum.rel_Grp rel_dds_Grp)(simp add: rel_fun_def Grp_apply)

subsection \<open>Graph traversal: refinement and quotients\<close>

lemma finite_Image:
  "finite A \<Longrightarrow> finite (R `` A) \<longleftrightarrow> (\<forall>x\<in>A. finite {y. (x, y) \<in> R})"
  by(simp add: Image_def)

context includes fset.lifting begin
lift_definition fImage :: "('a \<times> 'b) fset \<Rightarrow> 'a fset \<Rightarrow> 'b fset" is Image parametric Image_parametric
  by(auto simp add: finite_Image intro: finite_subset[OF _ finite_imageI])

lemmas fImage_iff = Image_iff[Transfer.transferred]
lemmas fImageI [intro] = ImageI[Transfer.transferred]
lemmas fImageE [elim!] = ImageE[Transfer.transferred]
lemmas rev_fImageI = rev_ImageI[Transfer.transferred]
lemmas fImage_mono = Image_mono[Transfer.transferred]

lifting_update fset.lifting
lifting_forget fset.lifting
end

type_synonym 'a graph = "('a \<times> 'a) fset"

definition traverse :: "'a graph \<Rightarrow> ('a fset, 'a fset) dds" where
  "traverse E = dds_of (\<lambda>visited A. ((fImage E A) |-| visited, visited |\<union>| A)) {||}"

type_synonym 'a graph' = "('a \<times> 'a) list"

definition traverse_impl :: "'a graph' \<Rightarrow> ('a list, 'a list) dds" where
  "traverse_impl E =
   dds_of (\<lambda>visited A. (map snd [(x, y)\<leftarrow>E . x \<in> set A \<and> y |\<notin>| visited],
    visited |\<union>| fset_of_list A)) {||}"

definition list_fset_rel :: "'a list \<Rightarrow> 'a fset \<Rightarrow> bool" where
  "list_fset_rel xs A \<longleftrightarrow> fset_of_list xs = A"

lemma traverse_refinement: \<comment> \<open>This is the refinement lemma.\<close>
  "(list_fset_rel ===> rel_dds list_fset_rel list_fset_rel) traverse_impl traverse"
  unfolding traverse_impl_def traverse_def
  apply(rule rel_funI)
  apply(rule dds_of_parametric[where S="(=)", THEN rel_funD, THEN rel_funD])
   apply(auto simp add: rel_fun_def list_fset_rel_def fset_of_list_elem intro: rev_fimage_eqI)
  done

lemma fset_of_list_parametric [transfer_rule]:
  "(list_all2 A ===> rel_fset A) fset_of_list fset_of_list"
  including fset.lifting unfolding rel_fun_def
  by transfer(rule list.set_transfer[unfolded rel_fun_def])

lemma traverse_impl_parametric [transfer_rule]:
  assumes [transfer_rule]: "bi_unique A"
  shows "(list_all2 (rel_prod A A) ===> rel_dds (list_all2 A) (list_all2 A)) traverse_impl traverse_impl"
  unfolding traverse_impl_def by transfer_prover

text \<open>
  By constructing finite sets as a quotient of lists, we can synthesise an abstract version
  of @{const traverse_impl} automatically, together with a polymorphic refinement lemma.
\<close>

quotient_type 'a fset' = "'a list" / "vimage2p set set (=)"
  by (auto intro: equivpI reflpI sympI transpI simp add: vimage2p_def)

lift_definition traverse'' :: "('a \<times> 'a) fset' \<Rightarrow> ('a fset', 'a fset') dds"
  is "traverse_impl :: 'a graph' \<Rightarrow> _" parametric traverse_impl_parametric
  unfolding traverse_impl_def
  apply (rule dds_of_parametric[where S="(=)", THEN rel_funD, THEN rel_funD])
   apply (auto simp add: rel_fun_def vimage2p_def fset_of_list_elem)
  done

subsection \<open>Generalised rewriting\<close>

definition accumulate :: "('a fset, 'a fset) dds" where
  "accumulate = dds_of (\<lambda>A X. (A |\<union>| X, A |\<union>| X)) {||}"

lemma accumulate_mono: "rel_dds (|\<subseteq>|) (|\<subseteq>|) accumulate accumulate"
  unfolding accumulate_def
  apply (rule dds_of_parametric[THEN rel_funD, THEN rel_funD, of "(|\<subseteq>|)"])
   apply (intro rel_funI rel_prod.intros)
    apply (erule (1) funion_mono)+
  apply (simp)
  done

lemma traverse_mono: "((|\<subseteq>|) ===> rel_dds (=) (|\<subseteq>|)) traverse traverse"
  unfolding traverse_def
  apply (rule rel_funI)
  apply (rule dds_of_parametric[THEN rel_funD, THEN rel_funD, of "(=)"])
   apply (intro rel_funI rel_prod.intros)
    apply (simp)
    apply (rule fminus_mono)
     apply (erule fImage_mono)
     apply (simp_all)
  done

lemma
  assumes "G |\<subseteq>| H"
  shows "rel_dds (=) (|\<subseteq>|) (traverse G \<bullet> accumulate) (traverse H \<bullet> accumulate)"
  apply (rule compose_parametric[THEN rel_funD, THEN rel_funD])
   apply (rule traverse_mono[THEN rel_funD])
   apply (rule assms)
  apply (rule accumulate_mono)
  done

definition seen :: "('a fset, 'a fset) dds" where
  "seen = dds_of (\<lambda>S X. (S |\<inter>| X, S |\<union>| X)) {||}"

lemma seen_mono: "rel_dds (|\<subseteq>|) (|\<subseteq>|) seen seen"
  unfolding seen_def
  apply (rule dds_of_parametric[THEN rel_funD, THEN rel_funD, of "(|\<subseteq>|)"])
   apply (intro rel_funI rel_prod.intros)
    apply (erule (1) finter_mono funion_mono)+
  apply (simp)
  done

lemma
  assumes "G |\<subseteq>| H"
  shows "rel_dds (=) (|\<subseteq>|) (traverse G \<bullet> seen) (traverse H \<bullet> seen)"
  apply (rule compose_parametric[THEN rel_funD, THEN rel_funD])
   apply (rule traverse_mono[THEN rel_funD])
   apply (rule assms)
  apply (rule seen_mono)
  done

end


theory Exp
imports
  Main
  "~~/src/HOL/Library/Monad_Syntax"
  "~~/src/HOL/Word/Word"
  Type
begin

definition "assert \<Phi> \<equiv> if \<Phi> then Some () else None"
lemma assert_simps[simp]:
  "assert True = Some ()"
  "assert False = None"
  "assert \<Phi> = Some () \<longleftrightarrow> \<Phi>"
  "assert \<Phi> = None \<longleftrightarrow> \<not>\<Phi>"
  unfolding assert_def
  by auto

section \<open>Expressions\<close>

subsection \<open>Type definitions \<close>

text \<open>Variable names are strings, Addresses are a pair conformed by a natural number and an integer
  these represent the (block_id, offset). We only work with one integer type, we use the
  @{term word} type of width 64, because we are using a 64 bit architecture to execute our programs.
  the width of the word can be changed by changing @{term int_width}. The words used here are
  interpreted as signed integers\<close>

type_synonym vname = string
type_synonym addr = "nat \<times> int"
type_synonym int_width = 64
type_synonym int_val = "int_width word"

type_synonym vdecl = "type \<times> vname"

text \<open>We're using signed longs in the translation to C, this are the min, and max values that it's
  possible to represent with signed longs.

  Note: We are assuming 2's complement representation here.
  TODO: The C99-draft requires less numbers to be representable,
    we need to insert a check in the generated program that ensures a
    compiler implementation compatible with these numbers.
\<close>

abbreviation "int_width \<equiv> len_of TYPE(int_width)"
abbreviation INT_MIN :: int where "INT_MIN \<equiv> - ((2^(int_width - 1)))"
abbreviation INT_MAX :: int where "INT_MAX \<equiv> ((2^(int_width - 1)) - 1)"

subsection \<open>Expressions definition\<close>
text \<open>An expression can be:
  *  @{term "Const i"} to represent an integer constant.
  *  @{term Null} to represent the null address, this separates the value 0 from the address null.
  *  @{term "V x"} to represent a variable.
  *  @{term "Plus i\<^sub>1 i\<^sub>2"} to represent the addition of two expressions.
  *  @{term "Subst i\<^sub>1 i\<^sub>2"} to represent the substraction of two expressions.
  *  @{term "Minus i"} to represent unary minus over an expression.
  *  @{term "Div i\<^sub>1 i\<^sub>2"} to represent the division of two expressions.
  *  @{term "Mod i\<^sub>1 i\<^sub>2"} to represent the modulo operation over two expressions.
  *  @{term "Mult i\<^sub>1 i\<^sub>2"} to represent the multiplication of two expressions.
  *  @{term "Less i\<^sub>1 i\<^sub>2"} to represent the less than operation over two expressions.
  *  @{term "Not b"} to represent the not operation over an expression.
  *  @{term "And b\<^sub>1 b\<^sub>2"} to represent the and operation over two  expressions.
  *  @{term "Or b\<^sub>1 b\<^sub>2"} to represent the or operation over two expressions.
  *  @{term "Eq b\<^sub>1 b\<^sub>2"} to represent the equality operation over two expressions.
  *  @{term "New t e"} to represent the allocation of a new memory block of e elements of type t.
  *  @{term "Deref e"} to represent the dereferencing operation over an expression (@{term "op *"} in C)
    this expression is used as an rvalue.
  *  @{term "Ref le"} to represent the referencing operation over an expression (@{term "op &"} in C).
  *  @{term "Index a ofs"} to represent the indexing of an array a in the ofs position (@{term "a[ofs]"} in C).
  *  @{term "Derefl e"} to represent the dereferencing operation over an expression (@{term "op *"} in C)
    this expression is used as an lvalue.
  *  @{term "Indexl a ofs"} to represent the indexing of an array a in the ofs position (@{term "a[ofs]"} in C)
    this expression is used as an lvalue.
\<close>

datatype exp = Const int
             | Null
             | V     vname
             | Plus  exp exp
             | Subst exp exp
             | Minus exp
             | Div   exp exp
             | Mod   exp exp
             | Mult  exp exp
             | Less  exp exp
             | Not   exp
             | And   exp exp
             | Or    exp exp
             | Eq    exp exp
             | New   type exp
             | Deref exp    (* * *)
             | Ref   lexp    (* & *)
             | Index exp exp (* e[e] *)

and lexp = Derefl exp
         | Indexl exp exp

end


section {* The Multi-Mutator Case *}

theory Mul_Gar_Coll imports Graph OG_Syntax begin

text {*  The full theory takes aprox. 18 minutes.  *}

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

text {* Declaration of variables: *}

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 {* The Mutators *}

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 {* Correctness of the proof outline of one mutator *}

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 {* Interference freedom between mutators *}

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 {* TRYALL (interfree_aux_tac @{context}) *})
apply(tactic {* ALLGOALS (clarify_tac @{context}) *})
apply (simp_all add:nth_list_update)
done

subsubsection {* Modular Parameterized Mutators *}

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 {* The Collector *}

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 {* Blackening Roots *}

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 {* Propagating Black *}

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)
--{* 8 subgoals left *}
apply force
apply force
apply force
apply(force simp add:BtoW_def Graph_defs)
--{* 4 subgoals left *}
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)
--{* 2 subgoals left *}
apply clarify
apply(conjI_tac)
apply(disjE_tac)
 apply (simp_all)
apply clarify
apply(erule less_SucE)
 apply force
apply (simp add:BtoW_def)
--{* 1 subgoal left *}
apply clarify
apply simp
apply(disjE_tac)
apply (simp_all)
apply(rule disjI1 , rule Graph1)
 apply simp_all
done

subsubsection {* Counting Black Nodes *}

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)
--{* 7 subgoals left *}
apply force
apply force
apply force
--{* 4 subgoals left *}
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
--{* 3 subgoals left *}
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)
--{* 2 subgoals left *}
apply force
--{* 1 subgoal left *}
apply clarify
apply(drule_tac x = "ind x" in le_imp_less_or_eq)
apply (simp_all add:Blacks_def)
done

subsubsection {* Appending garbage nodes to the free list *}

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 {* Collector *}

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 {* Interference Freedom *}

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)
--{* 7 subgoals left *}
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)
--{* 6 subgoals left *}
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)
--{* 5 subgoals left *}
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)
--{* 4 subgoals left *}
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)
--{* 3 subgoals left *}
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)
--{* 2 subgoals left *}
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
--{* 1 subgoal left *}
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)
--{* 7 subgoals left *}
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)
--{* 6 subgoals left *}
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)
--{* 5 subgoals left *}
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)
--{* 4 subgoals left *}
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)
--{* 3 subgoals left *}
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)
--{* 2 subgoals left *}
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)
--{* 1 subgoal left *}
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
--{* 9 subgoals left *}
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)
--{* 8 subgoals left *}
apply(simp add:mul_mutator_defs nth_list_update)
--{* 7 subgoals left *}
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)
--{* 6 subgoals left *}
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)
--{* 5 subgoals left *}
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)
--{* 4 subgoals left *}
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)
--{* 3 subgoals left *}
apply(simp add:mul_mutator_defs nth_list_update)
--{* 2 subgoals left *}
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)
--{* 1 subgoal left *}
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)
--{* 6 subgoals left *}
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)
--{* 5 subgoals left *}
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)
--{* 4 subgoals left *}
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)
--{* 3 subgoals left *}
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)
--{* 2 subgoals left *}
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)
--{* 1 subgoal left *}
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 {* ALLGOALS (clarify_tac @{context}) *})
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 {* ALLGOALS (clarify_tac @{context}) *})
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 {* ALLGOALS (clarify_tac @{context}) *})
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 {* ALLGOALS (clarify_tac @{context}) *})
apply(simp_all add: mul_mutator_defs nth_list_update)
apply(simp add:Mul_AppendInv_def Append_to_free0)
done

subsubsection {* Interference freedom Collector-Mutator *}

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  {* TRYALL (interfree_aux_tac @{context}) *})
--{* 42 subgoals left *}
apply (clarify,simp add:Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)+
--{* 24 subgoals left *}
apply(simp_all add:Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
--{* 14 subgoals left *}
apply(tactic {* TRYALL (clarify_tac @{context}) *})
apply(simp_all add:Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
apply(tactic {* TRYALL (rtac conjI) *})
apply(tactic {* TRYALL (rtac impI) *})
apply(tactic {* TRYALL (etac disjE) *})
apply(tactic {* TRYALL (etac conjE) *})
apply(tactic {* TRYALL (etac disjE) *})
apply(tactic {* TRYALL (etac disjE) *})
--{* 72 subgoals left *}
apply(simp_all add:Graph6 Graph7 Graph8 Append_to_free0 Append_to_free1 Graph12)
--{* 35 subgoals left *}
apply(tactic {* TRYALL(EVERY'[rtac disjI1,rtac subset_trans,etac @{thm Graph3},force_tac @{context}, assume_tac @{context}]) *})
--{* 28 subgoals left *}
apply(tactic {* TRYALL (etac conjE) *})
apply(tactic {* TRYALL (etac disjE) *})
--{* 34 subgoals left *}
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)
--{* 47 subgoals left *}
apply(tactic {* TRYALL(EVERY'[REPEAT o (rtac disjI2),etac @{thm subset_psubset_trans}, etac @{thm Graph11},force_tac @{context}]) *})
--{* 41 subgoals left *}
apply(tactic {* TRYALL(EVERY'[rtac disjI2, rtac disjI1, etac @{thm le_trans},
    force_tac (@{context} addsimps
      [@{thm Queue_def}, @{thm less_Suc_eq_le}, @{thm le_length_filter_update}])]) *})
--{* 35 subgoals left *}
apply(tactic {* TRYALL(EVERY'[rtac disjI2,rtac disjI1,etac @{thm psubset_subset_trans},rtac @{thm Graph9},force_tac @{context}]) *})
--{* 31 subgoals left *}
apply(tactic {* TRYALL(EVERY'[rtac disjI2,rtac disjI1,etac @{thm subset_psubset_trans},etac @{thm Graph11},force_tac @{context}]) *})
--{* 29 subgoals left *}
apply(tactic {* TRYALL(EVERY'[REPEAT o (rtac disjI2),etac @{thm subset_psubset_trans},etac @{thm subset_psubset_trans},etac @{thm Graph11},force_tac @{context}]) *})
--{* 25 subgoals left *}
apply(tactic {* TRYALL(EVERY'[rtac disjI2, rtac disjI2, rtac disjI1, etac @{thm le_trans},
    force_tac (@{context} addsimps
      [@{thm Queue_def}, @{thm less_Suc_eq_le}, @{thm le_length_filter_update}])]) *})
--{* 10 subgoals left *}
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 {* Interference freedom Mutator-Collector *}

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  {* TRYALL (interfree_aux_tac @{context}) *})
--{* 76 subgoals left *}
apply (clarsimp simp add: nth_list_update)+
--{* 56 subgoals left *}
apply (clarsimp simp add: Mul_AppendInv_def Append_to_free0 nth_list_update)+
done

subsubsection {* The Multi-Mutator Garbage Collection Algorithm *}

text {* The total number of verification conditions is 328 *}

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
--{* Strengthening the precondition *}
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)
--{* Collector *}
apply(rule Mul_Collector)
--{* Mutator *}
apply(erule Mul_Mutator)
--{* Interference freedom *}
apply(simp add:Mul_interfree_Collector_Mutator)
apply(simp add:Mul_interfree_Mutator_Collector)
apply(simp add:Mul_interfree_Mutator_Mutator)
--{* Weakening of the postcondition *}
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


           (*-------------------------------------------*
            |        CSP-Prover on Isabelle2005         |
            |               December 2005               |
            |                  April 2006  (modified)   |
            |                                           |
            |        Yoshinao Isobe (AIST JAPAN)        |
            *-------------------------------------------*)

theory CSP_T_law_DIV
imports CSP_T_law_basic
begin

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

         1. DIV |[X]| DIV
         2. DIV |[X]| P
         3. P |[X]| DIV
         4. DIV -- X
         5. DIV [[r]]
         6. DIV ;; P
         7. P ;; DIV
         8. DIV |. n

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

(*********************************************************
                       DIV |[X]| DIV
 *********************************************************)

(* T *)

lemma cspT_DIV_Parallel:
   "DIV |[X]| DIV =T[M1,M2] DIV"
apply (simp add: cspT_semantics)
apply (rule order_antisym)
apply (rule, simp add: in_traces)+
done

(*********************************************************
                       DIV |[X]| P
 *********************************************************)

lemma cspT_DIV_Parallel_step_l:
   "DIV |[X]| (? :Y -> Qf) =T[M,M] (? x:(Y-X) -> (DIV |[X]| Qf x)) [+] DIV"
apply (simp add: cspT_semantics)
apply (rule order_antisym)

(* => *)
 apply (rule)
 apply (simp add: in_traces)
 apply (insert trace_nil_or_Tick_or_Ev)
 apply (elim disjE conjE exE)
  apply (simp_all)

  apply (drule_tac x="t" in spec)
  apply (erule disjE, simp)
  apply (erule disjE, simp)
  apply (elim conjE exE, simp)
  apply (simp add: par_tr_head)
  apply (rule_tac x="s" in exI, simp)

(* <= *)

 apply (rule)
 apply (simp add: in_traces)
 apply (elim disjE conjE exE)
  apply (simp_all)

  apply (rule_tac x="<Ev a> ^^^ ta" in exI, simp)
  apply (simp add: par_tr_head)
done

(*** r ***)

lemma cspT_DIV_Parallel_step_r:
  "(? :Y -> Pf) |[X]| DIV =T[M,M]
   (? x:(Y - X) -> (Pf x |[X]| DIV)) [+] DIV"
apply (rule cspT_rw_left)
apply (rule cspT_commut)
apply (rule cspT_rw_left)
apply (rule cspT_DIV_Parallel_step_l)
apply (rule cspT_rw_left)
apply (rule cspT_decompo)
apply (rule cspT_decompo)
apply (simp)
apply (rule cspT_commut)
apply (rule cspT_reflex)
apply (rule cspT_reflex)
done

lemmas cspT_DIV_Parallel_step =
       cspT_DIV_Parallel_step_l cspT_DIV_Parallel_step_r

(*********************************************************
                      DIV and Parallel
 *********************************************************)

lemma cspT_DIV_Parallel_Ext_choice_DIV_l:
  "(P [+] DIV) |[X]| DIV =T[M,M] (P |[X]| DIV)"
apply (simp add: cspT_semantics)
apply (rule order_antisym)

(* => *)
 apply (rule, simp add: in_traces)
 apply (elim conjE exE disjE)
 apply (simp_all)
 apply (fast)

(* <= *)
 apply (rule, simp add: in_traces)
 apply (fast)
done

lemma cspT_DIV_Parallel_Ext_choice_DIV_r:
  "DIV |[X]| (P [+] DIV) =T[M,M] (DIV |[X]| P)"
apply (rule cspT_rw_left)
apply (rule cspT_commut)
apply (rule cspT_rw_left)
apply (rule cspT_DIV_Parallel_Ext_choice_DIV_l)
apply (rule cspT_commut)
done

lemmas cspT_DIV_Parallel_Ext_choice_DIV =
       cspT_DIV_Parallel_Ext_choice_DIV_l
       cspT_DIV_Parallel_Ext_choice_DIV_r

(*********************************************************
                      DIV -- X
 *********************************************************)

lemma cspT_DIV_Hiding_Id:
   "DIV -- X =T[M1,M2] DIV"
apply (simp add: cspT_semantics)
apply (rule order_antisym)

(* => *)
 apply (rule)
 apply (simp add: in_traces)

(* <= *)
 apply (rule)
 apply (simp add: in_traces)
done

(*** div-hide-step ***)

lemma cspT_DIV_Hiding_step:
  "((? :Y -> Pf) [+] DIV) -- X =T[M,M]
   (((? x:(Y-X) -> (Pf x -- X)) [+] DIV) |~| (! x:(Y Int X) .. (Pf x -- X)))"
apply (simp add: cspT_semantics)
apply (rule order_antisym)

(* => *)
 apply (rule, simp add: in_traces)
 apply (elim conjE exE disjE)
 apply (simp_all)

  apply (case_tac "a : X", force)
  apply (force)

(* <= *)
 apply (rule)
  apply (simp add: in_traces)
  apply (elim conjE exE bexE disjE)
  apply (simp_all)

   apply (force)

   apply (rule_tac x="<Ev a> ^^^ sa" in exI)
   apply (simp)

   apply (force)

   apply (rule_tac x="<Ev a> ^^^ s" in exI)
   apply (simp)
done

(*********************************************************
                      DIV [[r]]
 *********************************************************)

lemma cspT_DIV_Renaming_Id:
   "DIV [[r]] =T[M1,M2] DIV"
apply (simp add: cspT_semantics)
apply (rule order_antisym)

(* => *)
 apply (rule)
 apply (simp add: in_traces)

(* <= *)
 apply (rule)
 apply (simp add: in_traces)
done

(*********************************************************
                       DIV ;; P
 *********************************************************)

lemma cspT_DIV_Seq_compo: "DIV ;; P =T[M1,M2] DIV"
apply (simp add: cspT_semantics)
apply (rule order_antisym)

(* => *)
 apply (rule, simp add: in_traces)
 apply (force)

(* <= *)
 apply (rule, simp add: in_traces)
done

(*********************************************************
               DIV and Sequential composition
 *********************************************************)

lemma cspT_DIV_Seq_compo_step:
  "((? :X -> Pf) [> DIV) ;; Q =T[M,M] (? x:X -> (Pf x ;; Q)) [> DIV"
apply (simp add: cspT_semantics)
apply (rule order_antisym)

(* => *)
 apply (rule, simp add: in_traces)

 apply (elim conjE exE disjE)
 apply (simp_all)

  apply (rule disjI1)
  apply (fast)

  apply (rule disjI2)
  apply (rule disjI1)
  apply (insert trace_nil_or_Tick_or_Ev)
  apply (drule_tac x="s" in spec)

  apply (elim disjE conjE exE)
  apply (simp_all)

  apply (simp add: appt_assoc)
  apply (rule disjI2)

  apply (rule_tac x="sb" in exI)
  apply (rule_tac x="ta" in exI)
  apply (simp)

(* <= *)
 apply (rule, simp add: in_traces)

 apply (elim conjE exE disjE)
 apply (simp_all)

 apply (rule disjI1)
 apply (rule_tac x="<>" in exI)
 apply (simp)

 apply (rule disjI1)
 apply (rule_tac x="<Ev a> ^^^ sa" in exI)
 apply (simp)

 apply (rule disjI2)
 apply (rule_tac x="<Ev a> ^^^ sa" in exI)
 apply (rule_tac x="ta" in exI)
 apply (simp add: appt_assoc)

 apply (rule disjI1)
 apply (rule_tac x="<>" in exI)
 apply (simp)
done

(*********************************************************
                      DIV |. n
 *********************************************************)

lemma cspT_DIV_Depth_rest:
   "DIV |. n =T[M1,M2] DIV"
apply (simp add: cspT_semantics)
apply (rule order_antisym)

(* => *)
 apply (rule)
 apply (simp add: in_traces)

(* <= *)
 apply (rule)
 apply (simp add: in_traces)
done

(*********************************************************
                      cspT_DIV
 *********************************************************)

lemmas cspT_DIV =
       cspT_DIV_Parallel
       cspT_DIV_Parallel_step
       cspT_DIV_Parallel_Ext_choice_DIV
       cspT_DIV_Hiding_Id
       cspT_DIV_Hiding_step
       cspT_DIV_Renaming_Id
       cspT_DIV_Seq_compo
       cspT_DIV_Seq_compo_step
       cspT_DIV_Depth_rest

(*********************************************************
                       P [+] DIV
 *********************************************************)

lemma cspT_Ext_choice_DIV_resolve: "P [+] DIV =T[M,M] P [> DIV"
apply (simp add: cspT_semantics)
apply (rule order_antisym)

(* => *)
 apply (rule, simp add: in_traces)

(* <= *)
 apply (rule, simp add: in_traces)
done

end