(*
 * Copyright 2018, Data61
 * Commonwealth Scientific and Industrial Research Organisation (CSIRO)
 * ABN 41 687 119 230.
 *
 * This software may be distributed and modified according to the terms of
 * the BSD 2-Clause license. Note that NO WARRANTY is provided.
 * See "LICENSE_BSD2.txt" for details.
 *
 * @TAG(DATA61_BSD)
 *)

(* Preprocess AutoCorres translation of Cogent compiler's output code. *)
theory Tidy
  imports
    "AutoCorres.AutoCorres"
    "Cogent.ML_Old"
begin

(* Each Cogent_Corres rule expects (at most) one guard *)
lemma join_guards:
  "do g1 <- guard G1; g2 <- guard G2; P g1 g2 od
    =
   do g1 <- guard (\<lambda>s. G1 s \<and> G2 s); P g1 g1 od"
  by monad_eq

(* C-parser function epilogue *)
lemma return_exn_simp:
  "do ret <- A;
      _ <- gets (\<lambda>_. x :: c_exntype);
      _ <- gets (\<lambda>_. ());
      gets (\<lambda>_. ret) od = A"
  by simp

(* Cogent function epilogue *)
lemma return_cogent_simp:
  "do a \<leftarrow> A;
      r \<leftarrow> gets (\<lambda>_. a);
      gets (\<lambda>_. r) od = A"
  by simp

lemma simp_unit_return:
  "\<And>A. (do (x::unit) \<leftarrow> A; gets (\<lambda>_. ()) od) = A"
  by simp

(* Compose variant constructor with the gets immediately after it *)
(* TODO: this should be more specific, and only instantiated when variant_init is an actual variant constructor *)
lemma compose_gets_variant_con:
  "do a \<leftarrow> select UNIV;
      b \<leftarrow> gets (\<lambda>_. payload_update (\<lambda>_. payload) (tag_update (\<lambda>_. tag) variant_init));
      c \<leftarrow> gets (\<lambda>_. b);
      A c
   od =
   do
      b \<leftarrow> gets (\<lambda>_. payload_update (\<lambda>_. payload) (tag_update (\<lambda>_. tag) variant_init));
      A b
  od"
  by monad_eq
lemma compose_gets_variant_con_2:
  "do a \<leftarrow> select UNIV;
      b \<leftarrow> gets (\<lambda>_. payload_update (\<lambda>_. payload) (tag_update (\<lambda>_. tag) variant_init));
      gets (\<lambda>_. b)
   od =
      gets (\<lambda>_. payload_update (\<lambda>_. payload) (tag_update (\<lambda>_. tag) variant_init))"
  by monad_eq

(* Cogent compiler adds one assignment at the end of every block; remove it *)
definition "simp_last_bind = id"

lemma simp_last_bind:
  "\<And>A B C. simp_last_bind (do x \<leftarrow> A; y \<leftarrow> B x; C x y od) = do x \<leftarrow> A; simp_last_bind (do y \<leftarrow> B x; C x y od) od"
  "\<And>A. simp_last_bind (do x \<leftarrow> A; gets (\<lambda>_. x) od) = A"
  "\<And>A. simp_last_bind A = A"
  by (simp_all add: simp_last_bind_def)

lemma simp_last_bindI:
  "simp_last_bind A = B \<Longrightarrow> A = B"
  by (simp add: simp_last_bind_def)
lemma simp_last_bind_recI:
  "condition C (simp_last_bind L) R = B \<Longrightarrow> condition C L R = B"
  by (simp add: simp_last_bind_def)

(* Simplify uninitialised variables. *)
lemma unknown_bind_ignore:
  "select UNIV >>= (\<lambda>_. A) = A"
  by monad_eq

(* The True condition will also be instantiated with LET_TRUE and LET_BANG_TRUE per program *)
lemma unknown_bind_if_True:
  "do x \<leftarrow> select UNIV;
      condition (\<lambda>_. True) T (F x) >>= R od
   = condition (\<lambda>_. True) T (F undefined) >>= R"
  by monad_eq

ML \<open>
fun tidy_C_fun_def f ctxt = let
  val fun_term = Syntax.read_term ctxt (f ^ "'")
  (* Guess whether the function is recursive.
   * FIXME: use AutoCorresFunctionInfo instead *)
  val ([fun_def], fun_rec) = (Proof_Context.get_thms ctxt (f ^ "'.simps"), true)
                             handle ERROR _ => (Proof_Context.get_thms ctxt (f ^ "'_def"), false)

  (* Helper theorems for LET_TRUE and LETBANG_TRUE, if they exist *)
  val unknown_bind_more_thms = ["LET_TRUE", "LETBANG_TRUE"]
        |> maps (fn c => case Syntax.read_term ctxt c of
                             c' as Const _ => [Goal.prove ctxt [] []
                                                (@{mk_term "True \<equiv> (?c \<noteq> 0)" (c)} c')
                                                (K (simp_tac (ctxt addsimps (Proof_Context.get_thms ctxt (c ^ "_def"))) 1))]
                           | _ => [])
        |> map (fn thm => Simplifier.rewrite_rule ctxt [thm] @{thm unknown_bind_if_True})

  (* Use a schematic lemma to rewrite AutoCorres function defs.
   * We can assume the Cogent compiler generates all functions with only one argument. *)
  val prop = if fun_rec then @{mk_term "Trueprop (?f m a = ?A)" f} fun_term
                        else @{mk_term "Trueprop (?f a = ?A)" f} fun_term

  fun subst thms = EqSubst.eqsubst_tac ctxt [0] thms 1

  (* clarsimp won't touch the schematic ?A *)
  fun subst' thms = Clasimp.clarsimp_tac (put_simpset HOL_basic_ss ctxt addsimps thms) 1

  val tacs = subst [fun_def] (* get function definition *)
             THEN subst' @{thms bind_assoc}          (* normalise binds *)
             THEN subst' @{thms join_guards}         (* normalise guards *)
             THEN subst' @{thms simp_thms(21-22,25)} (* simplify conj in guards *)
             THEN subst' @{thms guard_True_bind}     (* remove unnecessary guards *)
             THEN subst @{thms return_exn_simp}      (* remove C parser's function epilogue *)
             (* Remove exactly one bind-gets from the end of the program,
              * which is inserted by the Cogent code generator *)
             THEN rtac (if fun_rec then @{thm simp_last_bind_recI} else @{thm simp_last_bindI}) 1
             THEN subst' @{thms simp_last_bind(1-2) simp_unit_return}
             (* Cleanup any remaining @{term simp_last_bind}s *)
             THEN subst' @{thms simp_last_bind(3)}
             (* Compose variant constructor with the gets immediately after it *)
             THEN subst' @{thms compose_gets_variant_con compose_gets_variant_con_2}
             (* Simplify uninitialised variables *)
             THEN subst' (@{thms unknown_bind_ignore unknown_bind_if_True} @ unknown_bind_more_thms)
             THEN rtac @{thm refl} 1 (* final definition *)
  in Goal.prove ctxt (if fun_rec then ["m", "a"] else ["a"]) [] prop (K tacs) end

fun tidy_C_fun_def' f ctxt =
  Utils.define_lemmas (f ^ "'_def'") [tidy_C_fun_def f ctxt] ctxt |> snd
\<close>

end


theory Capabilities_lemmas
imports Capabilities
begin

subsection \<open>Helper definitions and lemmas\<close>

locale Capabilities =
  fixes CC :: "'cap Capability_class"
  assumes is_tagged_set_tag[simp]: "\<And>c tag. is_tagged_method CC (set_tag_method CC c tag) = tag"
    and is_tagged_set_seal[simp]: "\<And>c s. is_tagged_method CC (set_seal_method CC c s) = is_tagged_method CC c"
    and is_tagged_set_obj_type[simp]: "\<And>c t. is_tagged_method CC (set_obj_type_method CC c t) = is_tagged_method CC c"
    and is_tagged_set_perms[simp]: "\<And>c p. is_tagged_method CC (set_perms_method CC c p) = is_tagged_method CC c"
    and is_tagged_cap_of_mem_bytes[simp]: "\<And>c bytes tag. cap_of_mem_bytes_method CC bytes tag = Some c \<Longrightarrow> is_tagged_method CC c \<longleftrightarrow> tag = B1"
begin

inductive_set derivable :: "'cap set \<Rightarrow> 'cap set" for C :: "'cap set" where
  Copy: "c \<in> C \<Longrightarrow> c \<in> derivable C"
| Restrict: "c' \<in> derivable C \<Longrightarrow> leq_cap CC c c' \<Longrightarrow> c \<in> derivable C"
| Unseal:
    "\<lbrakk>c' \<in> derivable C; c'' \<in> derivable C; is_tagged_method CC c'; is_tagged_method CC c'';
      \<not>is_sealed_method CC c''; is_sealed_method CC c'; permit_unseal (get_perms_method CC c'');
      get_obj_type_method CC c' = get_cursor_method CC c''\<rbrakk> \<Longrightarrow>
     unseal CC c' (get_global_method CC c'') \<in> derivable C"
| Seal:
    "\<lbrakk>c' \<in> derivable C; c'' \<in> derivable C; is_tagged_method CC c'; is_tagged_method CC c'';
      \<not>is_sealed_method CC c''; \<not>is_sealed_method CC c'; permit_seal (get_perms_method CC c'')\<rbrakk> \<Longrightarrow>
     seal CC c' (get_cursor_method CC c'') \<in> derivable C"

lemma leq_cap_refl[simp, intro]:
  "leq_cap CC c c"
  by (simp add: leq_cap_def)

lemma leq_cap_tag_imp[intro]:
  assumes "leq_cap CC c c'"
    and "is_tagged_method CC c"
  shows "is_tagged_method CC c'"
  using assms
  by (auto simp: leq_cap_def)

lemma derivable_mono:
  assumes "C \<subseteq> C'"
  shows "derivable C \<subseteq> derivable C'"
proof
  fix c
  assume "c \<in> derivable C"
  then show "c \<in> derivable C'" using assms by induction (auto intro: derivable.intros)
qed

lemma cap_derivable_bounded_gteq:
  assumes c: "cap_derivable_bounded CC n C c"
    and m: "m \<ge> n"
  shows "cap_derivable_bounded CC m C c"
proof -
  from m obtain k where "m = n + k" using less_iff_Suc_add[of n m] by auto
  also have "cap_derivable_bounded CC (n + k) C c" using c by (induction k) (auto)
  finally show ?thesis .
qed

lemma derivable_refl: "C \<subseteq> derivable C" by (auto intro: derivable.intros)

lemma derivable_union_subseteq_absorb:
  assumes "C' \<subseteq> derivable C"
  shows "derivable (C \<union> C') = derivable C"
proof
  show "derivable (C \<union> C') \<subseteq> derivable C"
  proof
    fix c
    assume "c \<in> derivable (C \<union> C')"
    then show "c \<in> derivable C" using assms by induction (auto intro: derivable.intros)
  qed
  show "derivable C \<subseteq> derivable (C \<union> C')" by (intro derivable_mono) auto
qed

lemma derivable_minus_subseteq: "derivable (C - C') \<subseteq> derivable C"
proof
  fix c
  assume "c \<in> derivable (C - C')"
  then show "c \<in> derivable C" by induction (auto intro: derivable.intros)
qed

lemma cap_derivable_iff_derivable: "cap_derivable CC C c \<longleftrightarrow> c \<in> derivable C"
proof
  assume "cap_derivable CC C c"
  then obtain n where c: "cap_derivable_bounded CC n C c" by (auto simp: cap_derivable_def)
  then show "c \<in> derivable C"
    by (induction CC \<equiv> CC n C c rule: cap_derivable_bounded.induct)
       (auto intro: derivable.intros)
next
  assume c: "c \<in> derivable C"
  then have "\<exists>n. cap_derivable_bounded CC n C c"
  proof (induction rule: derivable.induct)
    case (Copy c)
    then have "cap_derivable_bounded CC 0 C c" by auto
    then show ?case by blast
  next
    case (Restrict c' c)
    then obtain n where "cap_derivable_bounded CC n C c'" by auto
    then have "cap_derivable_bounded CC (Suc n) C c" using Restrict.hyps by auto
    then show ?case by blast
  next
    case (Unseal c' c'')
    then obtain n' n''
      where "cap_derivable_bounded CC n' C c'" and "cap_derivable_bounded CC n'' C c''"
      by blast
    then have "cap_derivable_bounded CC (max n' n'') C c'"
      and "cap_derivable_bounded CC (max n' n'') C c''"
      by (auto intro: cap_derivable_bounded_gteq)
    then have "cap_derivable_bounded CC (Suc (max n' n'')) C (unseal CC c' (get_global_method CC c''))"
      using Unseal.hyps
      by auto
    then show ?case by blast
  next
    case (Seal c' c'')
    then obtain n' n''
      where "cap_derivable_bounded CC n' C c'" and "cap_derivable_bounded CC n'' C c''"
      by blast
    then have "cap_derivable_bounded CC (max n' n'') C c'"
      and "cap_derivable_bounded CC (max n' n'') C c''"
      by (auto intro: cap_derivable_bounded_gteq)
    then have "cap_derivable_bounded CC (Suc (max n' n'')) C (seal CC c' (get_cursor_method CC c''))"
      using Seal.hyps
      by auto
    then show ?case by blast
  qed
  then show "cap_derivable CC C c" by (simp add: cap_derivable_def)
qed

end

end


theory DeadCodeRemovalCorrect
imports Launchbury LaunchburyAbstractTransformation DeadCodeRemoval
begin

definition rdcH :: "var set \<Rightarrow> heap \<Rightarrow> heap"
  where "rdcH S \<Gamma> = [ (x, remove_dead_code e) . (x,e) \<leftarrow> \<Gamma>, x \<notin> S]"

inductive dc_rel :: "(heap \<times> exp) \<Rightarrow> var list \<Rightarrow> (heap \<times> exp) \<Rightarrow>  bool" ("_ \<triangleright>\<^bsub>_\<^esub> _" [50,50,50] 50 )
  where "S \<subseteq> domA \<Gamma> \<union> set L \<Longrightarrow> S \<inter> fv (rdcH S \<Gamma>, remove_dead_code e, L) = {} \<Longrightarrow> (\<Gamma>, e) \<triangleright>\<^bsub>L\<^esub> (rdcH S \<Gamma>, remove_dead_code e)"

lemma map_of_rdcH: "map_of (rdcH S \<Gamma>) x = (if x \<in> S then None else map_option remove_dead_code (map_of \<Gamma> x))"
  by (induction \<Gamma>) (auto simp add: rdcH_def split: if_splits)

lemma delete_rdcH[simp]: "delete x (rdcH S \<Gamma>) = rdcH S (delete x \<Gamma>)"
  by (induction \<Gamma>) (auto simp add: rdcH_def split: if_splits)

lemma rdcH_append[simp]: "rdcH S (as @ \<Gamma>) = rdcH S as @ rdcH S \<Gamma>"
  unfolding rdcH_def by simp

lemma rdcH_nil[simp]: "rdcH S [] = []"
  unfolding rdcH_def by simp

lemma rdcH_is_nil: "domA \<Gamma> \<subseteq> S \<Longrightarrow>  rdcH S \<Gamma> = []"
  by (induction \<Gamma>) (auto simp add: rdcH_def split: if_splits)

lemma rdcH_cong_set: "S \<inter> domA \<Gamma> = S' \<inter> domA \<Gamma> \<Longrightarrow> rdcH S \<Gamma> = rdcH S' \<Gamma>"
by(induction \<Gamma> rule: heapToAssn.induct)(auto simp add: rdcH_def split: if_splits )

interpretation rel_lambda_cong dc_rel
  by default (auto elim!: dc_rel.cases simp del: exp_assn.eq_iff(4))
interpretation rel_app_cong dc_rel
  by default (auto elim: dc_rel.cases)
interpretation rel_var_cong dc_rel
  by default (auto elim: dc_rel.cases)

lemma rdcH_eqvt[eqvt]: "\<pi> \<bullet> (rdcH S \<Gamma>) = rdcH (\<pi> \<bullet> S) (\<pi> \<bullet> \<Gamma>)"
  unfolding rdcH_def by perm_simp rule

lemma rdch_fresh[intro]: "a \<sharp> \<Gamma> \<Longrightarrow> a \<sharp> rdcH S \<Gamma>"
  by (induction \<Gamma>)
     (auto simp add:  rdcH_def fresh_Nil fresh_Pair fresh_Cons  eqvt_fresh_cong1[OF remove_dead_code.eqvt] )

lemma rdch_fv_subset: "fv (rdcH S \<Gamma>) \<subseteq> fv \<Gamma>"
  using rdch_fresh unfolding fresh_def fv_def by auto

interpretation reds_rel_fresh dc_rel
  by default (auto elim!: dc_rel.cases intro: eqvt_fresh_cong1[OF remove_dead_code.eqvt])

interpretation rel_lambda_case dc_rel by default

lemma Lam_eq_same_var[simp]: "Lam [y]. e = Lam [y]. e' \<longleftrightarrow>  e = e'"
  by auto (metis fresh_PairD(2) obtain_fresh)

interpretation rel_app_case dc_rel
proof
  fix \<Gamma> e x L \<Gamma>' e''
  assume "(\<Gamma>, App e x) \<triangleright>\<^bsub>L\<^esub> (\<Gamma>', App e'' x)"
  thus "(\<Gamma>, e) \<triangleright>\<^bsub>x # L\<^esub> (\<Gamma>', e'')"
    by (fastforce elim!: dc_rel.cases intro!: dc_rel.intros)
next
  fix \<Gamma> y body x L \<Gamma>' body'
  assume "(\<Gamma>, Lam [y]. body) \<triangleright>\<^bsub>x # L\<^esub> (\<Gamma>', Lam [y]. body')"
  thus "(\<Gamma>, body[y::=x]) \<triangleright>\<^bsub>L\<^esub> (\<Gamma>', body'[y::=x])"
    apply (auto elim!: dc_rel.cases intro!: dc_rel.intros dest: set_mp  simp del: exp_assn.eq_iff(4) simp add: subst_remove_dead_code disjoint_iff_not_equal fv_subst_eq split: if_splits)
    apply (auto simp add: subst_remove_dead_code[symmetric] fv_subst_eq  split: if_splits)
    done
qed

interpretation rel_var_case dc_rel
proof
  case (goal1 \<Gamma> x L \<Gamma>' e thesis)
  show thesis
  proof (rule goal1)

    from goal1(1)
    obtain S where "\<Gamma>' = rdcH S \<Gamma>"
      and "S \<subseteq> domA \<Gamma> \<union> set L" and "S \<inter> fv (rdcH S \<Gamma>, Var x, L) = {}" by (auto elim!: dc_rel.cases)
    hence "x \<notin> S" by auto

    from `map_of \<Gamma> x = Some e` and `\<Gamma>' = _` and `x \<notin> S`
    show "map_of \<Gamma>' x = Some (remove_dead_code e)" by (auto simp add: map_of_rdcH)

    have *: "\<And> S . fv (rdcH S (delete x \<Gamma>)) \<subseteq> fv (rdcH S \<Gamma>)" by (metis delete_rdcH fv_delete_subset)

    from `map_of \<Gamma>' x = Some (remove_dead_code e)`
    have **: "fv (remove_dead_code e) \<subseteq> fv \<Gamma>'" by (metis domA_from_set map_of_fv_subset map_of_is_SomeD option.sel)

    from goal1(1)
    show "(delete x \<Gamma>, e) \<triangleright>\<^bsub>x # L\<^esub> (delete x \<Gamma>', remove_dead_code e)"
      by (fastforce elim!: dc_rel.cases intro!: dc_rel.intros dest: set_mp[OF *]  set_mp[OF **]  simp add: disjoint_iff_not_equal)
  qed
next
  fix \<Gamma> z x L \<Gamma>' z'
  assume "(\<Gamma>, z) \<triangleright>\<^bsub>x # L\<^esub> (\<Gamma>', z')"
  then obtain S where "\<Gamma>' = rdcH S \<Gamma>" and "z' = remove_dead_code z"
      and "S \<subseteq> insert x (domA \<Gamma> \<union> set L)" and "S \<inter> fv (rdcH S \<Gamma>, remove_dead_code z, x # L) = {}" by (auto elim!: dc_rel.cases)

  from this(4)
  have "x \<notin> S" by auto
  hence [simp]: "rdcH S ((x, z) # \<Gamma>) = (x,remove_dead_code z) # rdcH S \<Gamma>"
    unfolding rdcH_def by auto

  have  "((x, z) # \<Gamma>, z) \<triangleright>\<^bsub>L\<^esub> (rdcH S ((x, z) # \<Gamma>), remove_dead_code z)"
    apply (rule dc_rel.intros) using `S \<subseteq>  _` `S \<inter> _ = _`  by auto
  thus "((x, z) # \<Gamma>, z) \<triangleright>\<^bsub>L\<^esub> ((x, z') # \<Gamma>', z')"
    unfolding `\<Gamma>' = _` `z' = _` by auto
qed

locale let_removed =
  fixes \<Gamma> as body
  assumes "domA as \<inter> fv body = {} "

lemma map_fst_map_ran[simp]: "map fst (map_ran f l) = map fst l" by (induction l) auto

lemma permute_list_id: "supp p \<subseteq> set xs \<Longrightarrow>  p \<bullet> xs = xs \<Longrightarrow> p = 0"
proof (induction xs)
  case Nil
  hence "supp p = {}" by auto
  thus "p = 0" by (metis empty_subsetI supp_perm_singleton)
next
  case (Cons x xs)
  hence "p \<bullet> x = x" by auto
  hence "x \<notin> supp p" by (metis fresh_def fresh_perm)
  with Cons show "p = 0" by auto
qed

lemma Abs_lst_same[simp]: "[xs]lst. (y::'a::fs) = [xs]lst. y' \<longleftrightarrow> y = y'"
  apply rule
  prefer 2
  apply simp
  unfolding Abs_eq_iff2
  apply (erule exE)
  apply auto
  unfolding alpha_lst.simps
  apply (subgoal_tac "p = 0")
  apply auto[1]
  apply (auto simp add: permute_list_id)
  done

lemma Let_eq_same_var[simp]:
  assumes "map fst as = map fst as'"
  shows "Let as e = Let as' e' \<longleftrightarrow> (as = as' \<and> e = e')"
proof-
  from assms have  "map (\<lambda>x. atom (fst x)) as = map (\<lambda>x. atom (fst x)) as'"
    by (induction as as' rule: list_induct2') auto
  thus ?thesis by auto
qed

locale let_not_removed =
  fixes as :: heap and  body :: exp
  assumes let_not_removed: " domA as \<inter> fv body \<noteq> {} "
begin
  sublocale rel_let_cong dc_rel  \<Gamma> as body for \<Gamma>
  by default (auto elim!: dc_rel.cases simp add: if_not_P[OF let_not_removed] simp del: Let_eq_iff)

  sublocale rel_let_case dc_rel  \<Gamma> as body for \<Gamma>
  proof
    fix L \<Gamma>' as' body'
    assume "(\<Gamma>, Let as body) \<triangleright>\<^bsub>L\<^esub> (\<Gamma>', Let as' body')" and "map fst as = map fst as'"
    then obtain S where "\<Gamma>' = rdcH S \<Gamma>" and "body' = remove_dead_code body" and "as' = map_ran (\<lambda>_. remove_dead_code) as"
      and "S \<subseteq> domA \<Gamma> \<union> set L" and "S \<inter> fv (rdcH S \<Gamma>, remove_dead_code (Let as body), L) = {}"
      by (fastforce elim!: dc_rel.cases simp add: if_not_P[OF let_not_removed] simp del: Let_eq_iff)

    assume fresh: "atom ` domA as \<sharp>* \<Gamma>"
    hence "domA as \<inter> domA \<Gamma> = {}" by (metis fresh_distinct)
    moreover
    assume "atom ` domA as \<sharp>* L"
    hence "domA as \<inter> set L = {}" by (induction L) (auto simp add: fresh_star_Cons fresh_star_at_base)
    ultimately
    have * : "domA as \<inter> S = {}" using `S \<subseteq> domA \<Gamma> \<union> set L` by auto
    hence [simp]: "rdcH S as = map_ran (\<lambda>_. remove_dead_code) as"
      unfolding rdcH_def by (induction as) auto

    have "(as @ \<Gamma>, body) \<triangleright>\<^bsub>L\<^esub> (rdcH S (as @ \<Gamma>), remove_dead_code body)"
    proof
      show "S \<subseteq> domA (as @ \<Gamma>) \<union> set L" using * `S \<subseteq> _` by auto
      show "S \<inter> fv (rdcH S (as @ \<Gamma>), remove_dead_code body, L) = {}" using `S \<inter> _ = _` *
        apply (simp add: if_not_P[OF let_not_removed])
        apply (auto simp add: disjoint_iff_not_equal)
        done
    qed
    thus "(as @ \<Gamma>, body) \<triangleright>\<^bsub>L\<^esub> (as' @ \<Gamma>', body')" unfolding `as' = _` `\<Gamma>' = _` `body' = _` by simp
qed

end

theorem DeadCodeRemovalCorrect:
  assumes "\<Gamma> : e \<Down>\<^bsub>L\<^esub> \<Delta> : z"
  assumes "(\<Gamma>, e) \<triangleright>\<^bsub>L\<^esub> (\<Gamma>', e')"
   shows  "\<exists> \<Delta>' z'. (\<Delta>, z) \<triangleright>\<^bsub>L\<^esub> (\<Delta>', z') \<and> \<Gamma>' : e' \<Down>\<^bsub>L\<^esub> \<Delta>' : z'"
  using assms
proof(nominal_induct arbitrary: \<Gamma>' e' rule:reds.strong_induct)
case (Lambda \<Gamma> x e L) thus ?case by (rule lambda_case)
next
case (Application y \<Gamma> e x L \<Delta> \<Theta> z body) thus ?case by (rule app_case)
next
case (Variable \<Gamma> x e L \<Delta> z \<Gamma>' var) thus ?case by (rule var_case)
next
case (Let as \<Gamma> L body \<Delta> z \<Gamma>' let')
  show ?case
  proof (cases "domA as \<inter> fv body = {}")
  case True
    with `(\<Gamma>, Let as body) \<triangleright>\<^bsub>L\<^esub> (\<Gamma>', let')`
    obtain S where "\<Gamma>' = rdcH S \<Gamma>" and "let' = remove_dead_code body"
    and "S \<subseteq> domA \<Gamma> \<union> set L" and "S \<inter> fv (rdcH S \<Gamma>, remove_dead_code body, L) = {}"   by (auto elim!: dc_rel.cases)

    have [simp]: "(rdcH (domA as \<union> S) as) = []" by (rule rdcH_is_nil) auto

    have [simp]: "(rdcH (domA as \<union> S) \<Gamma>) = (rdcH S \<Gamma>)"
      using fresh_distinct[OF Let(1)]
      by (auto intro: rdcH_cong_set simp add: fresh_star_at_base)

    have "(as @ \<Gamma>, body) \<triangleright>\<^bsub>L\<^esub> (rdcH (domA as \<union> S) (as @ \<Gamma>), remove_dead_code body)"
    proof (rule dc_rel.intros)
      show "(domA as \<union> S) \<subseteq> domA (as @ \<Gamma>) \<union> set L" using `S \<subseteq> domA \<Gamma> \<union> set L` by auto

      from True
      have "atom ` domA as \<sharp>* body" by (auto simp add: fresh_star_def fv_def fresh_def)
      from Let(1,2) True this
      have "atom ` domA as \<sharp>* (rdcH S \<Gamma>, remove_dead_code body, L)"
        by (auto simp add: fresh_star_def fresh_Pair  intro!: eqvt_fresh_cong1[OF remove_dead_code.eqvt])
      hence "domA as \<inter> fv (rdcH S \<Gamma>, remove_dead_code body, L) = {}"
        by (auto simp add: fresh_star_def fv_def fresh_def)
      moreover
      have "S \<inter> fv (rdcH S \<Gamma>, remove_dead_code body, L) = {}" using `S \<inter> _ = {}` by auto
      ultimately
      show "(domA as \<union> S) \<inter> fv (rdcH (domA as \<union> S) (as @ \<Gamma>), remove_dead_code body, L) = {}" by auto
    qed
    hence "(as @ \<Gamma>, body) \<triangleright>\<^bsub>L\<^esub> (\<Gamma>', remove_dead_code body)" unfolding `\<Gamma>'=_` by simp
    from Let(4)[OF this]
    show ?thesis unfolding `let' = _`.
  next
  case False
    interpret let_not_removed as body apply default using False.
    show ?thesis using Let by (rule let_case)
  qed
qed

corollary
  assumes "[] : e \<Down>\<^bsub>L\<^esub> \<Delta> : z"
   shows  "\<exists> \<Delta>' z'. [] : remove_dead_code e \<Down>\<^bsub>L\<^esub> \<Delta>' : z'"
proof-
  have "([], e) \<triangleright>\<^bsub>L\<^esub> (rdcH {} [], remove_dead_code e)" by (rule dc_rel.intros) auto
  hence "([], e) \<triangleright>\<^bsub>L\<^esub> ([], remove_dead_code e)" by simp
  from DeadCodeRemovalCorrect[OF assms this]
  show ?thesis by auto
qed

end


theory sas_df
imports "sas_analysis"
        "CSP_F.CSP_F_law_step_aux"
        "DFP_DFfive"
begin

overloading Set_FPmode ==
  "CSP_syntax.FPmode :: fpmode"
begin
  definition "CSP_syntax.FPmode == CMSmode"
end
declare Set_FPmode_def [simp add]

declare inj_def [simp add]
declare Let_def [simp add]

declare Rec_prefix_def [simp add]
declare Send_prefix_def [simp add]

fun DFfive_to_ACE_PCUadj :: "ActuatorId \<Rightarrow> DFfivePN \<Rightarrow> (PN, Events) proc"
where
    "DFfive_to_ACE_PCUadj i (DFfive) =
           (!<adjust i> adj .. !<rawPosition i> p0 ..
             $ACE i
             |[ {| servoCmd i, feedbackPos i |}\<^sub>c ]|
             PCUadj i p0 adj)"

lemma Lemma_DFfive_to_ACE_PCUadj :
    "(DFfivefun p) << (DFfive_to_ACE_PCUadj i) <=F DFfive_to_ACE_PCUadj i p"
  apply (induct_tac p)
  apply (auto)

  (* Expand RIGHT *)
  apply (rule cspF_rw_right, rule unwind_ACE_PCUadj)
  apply (rule cspF_rw_right, rule cspF_Parallel_step_choice)
    apply (rule cspF_reflex, rule cspF_reflex, simp)
    apply (cspF_simp_right)

  (* STEP - controlCmd OR adjust is the 1\<ordmasculine> event *)
  apply (rule cspF_Ext_choice_right)

    (* REFINED - controlCmd is the 1\<ordmasculine> event *)
    apply (cspF_step_left)
    apply (rule cspF_decompo_ref, simp, simp)
    apply (erule rangeE, simp)

      (* Expand RIGHT *)
      apply (rule cspF_rw_right, rule cspF_Parallel_step_choice)
        apply (rule cspF_reflex, rule cspF_reflex, simp)
        apply (cspF_simp_right)
        apply (cspF_simp_right)

      (* REFINED - adjust is the 2\<ordmasculine> event *)
      apply (cspF_step_left)
      apply (rule cspF_decompo_ref, simp, simp)
      apply (simp)

      (* Expand RIGHT *)
      apply (rule cspF_rw_right, rule cspF_Parallel_step_choice)
        apply (rule cspF_reflex)
        apply (rule cspF_rw_left, rule cspF_Parallel_step_choice)
          apply (rule cspF_rw_left, rule cspF_Parallel_step_choice)
            apply (rule unwind_EHSV)
            apply (rule cspF_rw_left, rule unwind_Raw)
            apply (rule cspF_Ext_choice_step_Ext_pre_choice_disjnt, simp add: disjnt_def)
            apply (simp)
            apply (cspF_simp_left)
            apply (cspF_simp_left)
          apply (rule unwind_LVDT)
          apply (simp)
          apply (cspF_simp_left)
          apply (cspF_simp_left)
        apply (cspF_simp_right)
        apply (cspF_simp_right)

      (* REFINED - rawPosition is the 3\<ordmasculine> event *)
      apply (cspF_step_left)
      apply (rule cspF_decompo_ref, simp, simp)
      apply (simp)

      (* Expand RIGHT *)
      apply (rule cspF_rw_right, rule cspF_Parallel_step_choice)
        apply (rule cspF_reflex, simp)
        apply (rule cspF_rw_left, rule cspF_Parallel_step_choice)
          apply (rule cspF_rw_left, rule cspF_Parallel_step_choice)
          apply (rule cspF_reflex, cspF_simp_left)
          apply (rule cspF_Ext_choice_step_Ext_pre_choice_disjnt, simp add: disjnt_def)
          apply (simp)
          apply (cspF_simp_left)
          apply (cspF_simp_left)
        apply (rule cspF_Ext_choice_step_Ext_pre_choice_disjnt, simp add: disjnt_def)
        apply (simp)
        apply (cspF_simp_right)
        apply (cspF_simp_right)

      (* REFINED - feedbackPos is the 5\<ordmasculine> event *)
      apply (cspF_step_left)
      apply (rule cspF_decompo_ref, simp, simp)
      apply (simp)

      (* Expand RIGHT *)
      apply (rule cspF_rw_right, rule cspF_Parallel_step_choice)
        apply (rule cspF_reflex)
        apply (cspF_simp_left)
        apply (rule cspF_rw_left, rule cspF_Parallel_step_choice)
          apply (rule cspF_reflex, rule unwind_LVDT, simp)
          apply (cspF_simp_left)
          apply (cspF_simp_left)
        apply (cspF_simp_right)
        apply (cspF_simp_right)

      (* REFINED - servoCmd is the 6\<ordmasculine> event *)
      apply (cspF_step_left)
      apply (rule cspF_decompo_ref, simp, simp)
      apply (simp)

      apply (rule cspF_Rep_int_choice_left, simp)
      apply (rule_tac x="(saturate (aa + a) - disp (dOmega (saturate (x - saturate (aa + a)))))" in exI, simp)
      apply (rule cspF_Rep_int_choice_left, simp)
      apply (rule_tac x="(saturate (aa + a))" in exI, simp)

      apply (rule cspF_decompo, simp, simp)

      (* Expand RIGHT *)
      apply (rule cspF_rw_right, rule cspF_Parallel_step_choice)
        apply (rule cspF_rw_left, rule cspF_Parallel_step_choice)
          apply (rule cspF_reflex, rule cspF_reflex, simp)
          apply (cspF_simp_left)
          apply (cspF_simp_left)
        apply (cspF_simp_right)
        apply (cspF_simp_right)

      apply (simp add: PCUadj_def)
      apply (rule cspF_decompo, simp, simp)
      apply (rule cspF_decompo, simp)
      apply (rule cspF_decompo, simp, simp)
      apply (rule cspF_rw_right, rule cspF_IF, simp)
      apply (rule cspF_eq_ref, rule unwind_LVDT)

    (* REFINED - adjust is the 1\<ordmasculine> event *)
    apply (cspF_step_left)
    apply (rule cspF_decompo_ref, simp, simp)
    apply (simp)

      (* Expand RIGHT *)
      apply (rule cspF_rw_right, rule cspF_Parallel_step_choice)
        apply (rule cspF_reflex)
        apply (rule cspF_rw_left, rule cspF_Parallel_step_choice)
          apply (rule cspF_rw_left, rule cspF_Parallel_step_choice)
          apply (rule unwind_EHSV)
          apply (rule cspF_rw_left, rule unwind_Raw)
          apply (rule cspF_Ext_choice_step_Ext_pre_choice_disjnt, simp add: disjnt_def)
          apply (simp)
          apply (cspF_simp_left)
          apply (cspF_simp_left)
        apply (rule unwind_LVDT)
        apply (simp)
        apply (cspF_simp_left)
        apply (cspF_simp_left)
      apply (cspF_simp_right)

      (* STEP - controlCmd OR rawPosition is the 2\<ordmasculine> event *)
      apply (rule cspF_Ext_choice_right)

      (* REFINED - controlCmd is the 2\<ordmasculine> event *)
      apply (cspF_step_left)
      apply (rule cspF_decompo_ref, simp, simp)
      apply (erule rangeE, simp)

        (* Expand RIGHT *)
        apply (rule cspF_rw_right, rule cspF_Parallel_step_choice)
          apply (rule cspF_reflex, rule cspF_reflex, simp)
        apply (cspF_simp_right)
        apply (cspF_simp_right)

        (* REFINED - rawPosition is the 3\<ordmasculine> event *)
        apply (cspF_step_left)
        apply (rule cspF_decompo_ref, simp, simp)
        apply (simp)

        (* Expand RIGHT *)
        apply (rule cspF_rw_right, rule cspF_Parallel_step_choice)
          apply (rule cspF_reflex)
          apply (rule cspF_rw_left, rule cspF_Parallel_step_choice)
            apply (rule cspF_rw_left, rule cspF_Parallel_step_choice)
            apply (rule cspF_reflex, cspF_simp_left)
            apply (rule cspF_Ext_choice_step_Ext_pre_choice_disjnt, simp add: disjnt_def)
            apply (simp)
              apply (cspF_simp_left)
              apply (cspF_simp_left)
          apply (rule cspF_Ext_choice_step_Ext_pre_choice_disjnt, simp add: disjnt_def)
          apply (simp)
        apply (cspF_simp_right)
        apply (cspF_simp_right)

        (* REFINED - feedbackPos is the 4\<ordmasculine> event *)
        apply (cspF_step_left)
        apply (rule cspF_decompo_ref, simp, simp)
        apply (simp)

        (* Expand RIGHT *)
        apply (rule cspF_rw_right, rule cspF_Parallel_step_choice)
          apply (rule cspF_reflex, cspF_simp_left)
          apply (rule cspF_rw_left, rule cspF_Parallel_step_choice)
          apply (rule cspF_reflex, rule unwind_LVDT, simp)
          apply (cspF_simp_left)
          apply (cspF_simp_left)
        apply (cspF_simp_right)
        apply (cspF_simp_right)

        (* REFINED - servoCmd is the 5\<ordmasculine> event *)
        apply (cspF_step_left)
        apply (rule cspF_decompo_ref, simp, simp)
        apply (simp)

        apply (rule cspF_Rep_int_choice_left, simp)
        apply (rule_tac x="saturate (aa + a) - disp (dOmega (saturate (x - saturate (aa + a))))" in exI, simp)
        apply (rule cspF_Rep_int_choice_left, simp)
        apply (rule_tac x="(saturate (aa + a))" in exI, simp)

        apply (rule cspF_decompo, simp, simp)

        (* Expand RIGHT *)
        apply (rule cspF_rw_right, rule cspF_Parallel_step_choice)
          apply (rule cspF_rw_left, rule cspF_Parallel_step_choice)
            apply (rule cspF_reflex, rule cspF_reflex, simp)
            apply (cspF_simp_left)
            apply (cspF_simp_left)
          apply (cspF_simp_right)
          apply (cspF_simp_right)

        (* REFINED *)
        apply (simp add: PCUadj_def)
        apply (rule cspF_decompo, simp, simp)
        apply (rule cspF_decompo, simp)
        apply (rule cspF_decompo, simp, simp)
        apply (rule cspF_rw_right, rule cspF_IF, simp)
        apply (rule cspF_eq_ref, rule unwind_LVDT)

      (* REFINED - rawPosition is the 2\<ordmasculine> event *)
      apply (cspF_step_left)
      apply (rule cspF_decompo_ref, simp, simp)
      apply (simp)

        (* Expand RIGHT *)
        apply (rule cspF_rw_right, rule cspF_Parallel_step_choice)
          apply (rule cspF_reflex)
          apply (rule cspF_rw_left, rule cspF_Parallel_step_choice)
            apply (rule cspF_rw_left, rule cspF_Parallel_step_choice)
            apply (rule cspF_reflex)
            apply (cspF_simp_left)
            apply (rule cspF_Ext_choice_step_Ext_pre_choice_disjnt, simp add: disjnt_def)
            apply (simp)
            apply (cspF_simp_left)
            apply (cspF_simp_left)
          apply (rule cspF_Ext_choice_step_Ext_pre_choice_disjnt, simp add: disjnt_def)
          apply (simp)
        apply (cspF_simp_right)
        apply (cspF_simp_right)

        (* REFINED - controlCmd is the 3\<ordmasculine> event *)
        apply (cspF_step_left)
        apply (rule cspF_decompo_ref, simp, simp)
        apply (erule rangeE, simp)

        (* Expand RIGHT *)
        apply (rule cspF_rw_right, rule cspF_Parallel_step_choice)
          apply (rule cspF_reflex, rule cspF_reflex, simp)
        apply (cspF_simp_right)
        apply (cspF_simp_right)

        (* REFINED - feedbackPos is the 4\<ordmasculine> event *)
        apply (cspF_step_left)
        apply (rule cspF_decompo_ref, simp, simp)
        apply (simp)

        (* Expand RIGHT *)
        apply (rule cspF_rw_right, rule cspF_Parallel_step_choice)
        apply (rule cspF_reflex)
        apply (rule cspF_rw_left, rule cspF_IF)
        apply (rule cspF_rw_left, rule cspF_Parallel_step_choice)
        apply (rule cspF_reflex)
        apply (rule unwind_LVDT)
        apply (simp)
        apply (cspF_simp_left)
        apply (cspF_simp_left)
        apply (cspF_simp_right)
        apply (cspF_simp_right)

        (* REFINED - servoCmd is the 5\<ordmasculine> event *)
        apply (cspF_step_left)
        apply (rule cspF_decompo_ref, simp, simp)
        apply (simp)

        apply (rule cspF_Rep_int_choice_left, simp)
        apply (rule_tac x="(saturate (aa + a) - disp (dOmega (saturate (x - saturate (aa + a)))))" in exI, simp)
        apply (rule cspF_Rep_int_choice_left, simp)
        apply (rule_tac x="(saturate (aa + a))" in exI, simp)

        apply (rule cspF_decompo, simp, simp)

        (* Expand RIGHT *)
        apply (rule cspF_rw_right, rule cspF_Parallel_step_choice)
        apply (rule cspF_rw_left, rule cspF_Parallel_step_choice)
        apply (rule cspF_reflex)
        apply (rule cspF_reflex)
        apply (simp)
        apply (rule cspF_rw_left, rule cspF_Ext_choice_unit_r_hsf)
        apply (rule cspF_rw_left, rule cspF_Ext_choice_unit_r_hsf)
        apply (rule cspF_reflex)
        apply (rule cspF_reflex)
        apply (simp)
        apply (cspF_simp_right)
        apply (cspF_simp_right)

        (* REFINED *)
        apply (simp add: PCUadj_def)
        apply (rule cspF_decompo, simp, simp)
        apply (rule cspF_decompo, simp)
        apply (rule cspF_decompo, simp, simp)
        apply (rule cspF_rw_right, rule cspF_IF, simp)
        apply (rule cspF_eq_ref, rule unwind_LVDT)
done

lemma DFtick_ACE_PCUadj : "$DFtick <=F ((ACE_PCUadj i p adj)::(PN,Events) proc)"
  apply (rule cspF_trans, rule DFtick_DFfive)
  apply (rule_tac Pf="DFfivefun" and f="DFfive_to_ACE_PCUadj i" in cspF_fp_induct_ref_left)
  apply (simp, simp, simp, simp)
  apply (rule cspF_Rep_int_choice_left, simp)
    apply (rule_tac  x="adj" in exI, simp)
  apply (rule cspF_Rep_int_choice_left, simp)
    apply (rule_tac  x="p" in exI, simp)
  apply (simp add: ACE_PCUadj_def)
  by (rule Lemma_DFfive_to_ACE_PCUadj)

lemma DF_ACE_PCU : "$DFtick <=F ((ACE_PCU i p)::(PN,Events) proc)"
  (* Expand RIGHT *)
  apply (rule cspF_rw_right, rule unwind_ACE_PCU)
    apply (rule cspF_rw_right, rule cspF_Parallel_step_choice)
      apply (rule cspF_reflex)
      (* PCU = ( EHSV |[ ... ]| Raw ) |[ ... ]| LVDT *)
      apply (rule cspF_rw_left, rule cspF_Parallel_step_choice)
       apply (rule cspF_rw_left, rule cspF_Parallel_step_choice)
        apply (rule cspF_reflex)
        apply (rule cspF_Ext_choice_step_Ext_pre_choice_disjnt, simp add: disjnt_def)
        apply (simp)
       apply (cspF_simp_left)
        apply (cspF_simp_left)
        apply (cspF_simp_left)
        apply (cspF_simp_right)
    apply (rule cspF_rw_right, rule cspF_Ext_choice_step_Ext_pre_choice_disjnt, simp add: disjnt_def)

    (* 1\<ordmasculine> STEP IS REFINED - rawPosition OR controlCmd is the first event*)
    apply (cspF_unwind_left, cspF_step_left, rule cspF_Int_choice_left1)
    apply (rule cspF_decompo_ref, simp, simp)
    apply (clarsimp, erule disjE)

    (* rawPosition is the first event *)
    apply (simp)
    apply (cspF_simp_right)
    apply (cspF_simp_right)

      (* Expand RIGHT *)
      apply (rule cspF_rw_right, rule cspF_Parallel_step_choice)
        apply (rule cspF_reflex)
        apply (rule cspF_rw_left, rule cspF_Parallel_step_choice)
        apply (rule cspF_rw_left, rule cspF_Parallel_step_choice)
          apply (rule cspF_reflex)
          apply (rule cspF_Ext_choice_step_Ext_pre_choice_disjnt, simp add: disjnt_def)
          apply (simp)
        apply (cspF_simp_left)
        apply (cspF_simp_left)
      apply (rule cspF_Ext_choice_step_Ext_pre_choice_disjnt, simp add: disjnt_def)
      apply (simp)
      apply (cspF_simp_right)
      apply (cspF_simp_right)

      (* 2\<ordmasculine> STEP IS REFINED - controlCmd is the second event *)
      apply (cspF_unwind_left, cspF_step_left, rule cspF_Int_choice_left1)
      apply (rule cspF_decompo_ref, simp, simp)
      apply (erule rangeE, simp)

      (* Expand RIGHT *)
      apply (rule cspF_rw_right, rule cspF_Parallel_step_choice)
        apply (rule cspF_reflex, rule cspF_reflex, simp)
      apply (cspF_simp_right)
      apply (cspF_simp_right)

      (* 3\<ordmasculine> STEP IS REFINED - feedbackPos is the third event *)
      apply (cspF_unwind_left, cspF_step_left, rule cspF_Int_choice_left1)
      apply (rule cspF_decompo_ref, simp, simp)
      apply (simp)

      (* Expand RIGHT *)
      apply (rule cspF_rw_right, rule cspF_Parallel_step_choice)
        apply (rule cspF_reflex, cspF_simp_left)
        apply (rule cspF_rw_left, rule cspF_Parallel_step_choice)
        apply (rule cspF_reflex, rule unwind_LVDT, simp)
        apply (cspF_simp_left)
        apply (cspF_simp_left)
      apply (cspF_simp_right)
      apply (cspF_simp_right)

      (* 4\<ordmasculine> STEP IS REFINED - servoCmd is the fourth event *)
      apply (cspF_unwind_left, cspF_step_left, rule cspF_Int_choice_left1)
      apply (rule cspF_decompo_ref, simp, simp)
      apply (simp)

      (* REFINED BY TRANS DFtick_ACE_PCUadj *)
      apply (rule cspF_trans)
      apply (rule_tac i="i" and p="p" and adj="(p - disp (dOmega (saturate (x - p))))" in DFtick_ACE_PCUadj)
      apply (simp add: ACE_PCUadj_def)
      apply (rule cspF_decompo, simp, simp)
      apply (simp add: PCUadj_def)

      (* Expand RIGHT *)
      apply (rule cspF_rw_right, rule cspF_Parallel_step_choice)
      apply (rule cspF_rw_left, rule cspF_Parallel_step_choice)
       apply (rule cspF_reflex, rule cspF_reflex, simp)
        apply (cspF_simp_left)
        apply (cspF_simp_left)
      apply (cspF_simp_right)
      apply (cspF_simp_right)

      (* REFINED BY DECOMPO *)
      apply (rule cspF_decompo, simp, simp)
      apply (rule cspF_decompo, simp)
      apply (rule cspF_decompo, simp, simp)
      apply (cspF_simp_right)
      apply (rule cspF_eq_ref, rule unwind_LVDT)

    (* controlCmd is the first event *)
    apply (cspF_simp_right)
    apply (erule rangeE, simp)

      (* Expand RIGHT *)
      apply (rule cspF_rw_right, rule cspF_Parallel_step_choice)
      apply (rule cspF_reflex, rule cspF_reflex, simp)
      apply (cspF_simp_right)
      apply (cspF_simp_right)

      (* 2\<ordmasculine> STEP IS REFINED - rawPosition is the second event *)
      apply (cspF_unwind_left, cspF_step_left, rule cspF_Int_choice_left1)
      apply (rule cspF_decompo_ref, simp, simp)
      apply (simp)

      (* Expand RIGHT *)
      apply (rule cspF_rw_right, rule cspF_Parallel_step_choice)
        apply (rule cspF_reflex)
        apply (rule cspF_rw_left, rule cspF_Parallel_step_choice)
        apply (rule cspF_rw_left, rule cspF_Parallel_step_choice)
          apply (rule cspF_reflex)
          apply (rule cspF_rw_left, rule cspF_IF)
            apply (rule cspF_Ext_choice_step_Ext_pre_choice_disjnt, simp add: disjnt_def)
          apply (simp)
        apply (cspF_simp_left)
        apply (cspF_simp_left)
        apply (rule cspF_Ext_choice_step_Ext_pre_choice_disjnt, simp add: disjnt_def)
        apply (simp)
      apply (cspF_simp_right)
      apply (cspF_simp_right)

      (* 3\<ordmasculine> STEP IS REFINED - feedbackPos is the third event *)
      apply (cspF_unwind_left, cspF_step_left, rule cspF_Int_choice_left1)
      apply (rule cspF_decompo_ref, simp, simp)
      apply (simp)

      (* Expand RIGHT *)
      apply (rule cspF_rw_right, rule cspF_Parallel_step_choice)
        apply (rule cspF_reflex, cspF_simp_left)
      apply (rule cspF_rw_left, rule cspF_Parallel_step_choice)
        apply (rule cspF_reflex, rule unwind_LVDT, simp)
      apply (cspF_simp_left)
      apply (cspF_simp_left)
      apply (cspF_simp_right)
      apply (cspF_simp_right)

      (* 4\<ordmasculine> STEP IS REFINED - servoCmd is the fourth event *)
      apply (cspF_unwind_left, cspF_step_left, rule cspF_Int_choice_left1)
      apply (rule cspF_decompo_ref, simp, simp)
      apply (simp)

      (* REFINED BY TRANS DFtick_ACE_PCUadj *)
      apply (rule cspF_trans)
      apply (rule_tac i="i" and p="p" and adj="(p - disp (dOmega (saturate (x - p))))" in DFtick_ACE_PCUadj)
      apply (simp add: ACE_PCUadj_def)
      apply (rule cspF_decompo, simp, simp)
      apply (simp add: PCUadj_def)

      (* Expand RIGHT *)
      apply (rule cspF_rw_right, rule cspF_Parallel_step_choice)
        apply (rule cspF_rw_left, rule cspF_Parallel_step_choice)
         apply (rule cspF_reflex, rule cspF_reflex, simp)
        apply (cspF_simp_left)
        apply (cspF_simp_left)
      apply (cspF_simp_right)
      apply (cspF_simp_right)

      (* REFINED BY DECOMPO *)
      apply (rule cspF_decompo, simp, simp)
      apply (rule cspF_decompo, simp)
      apply (rule cspF_decompo, simp, simp)
      apply (cspF_simp_right)
      apply (rule cspF_eq_ref, rule unwind_LVDT)
  done

lemma DF_ACE_PCU_isDeadlockFree : "((ACE_PCU i p)::(PN,Events) proc) isDeadlockFree"
  apply (simp only: DeadlockFree_DFtick_ref)
  by (rule DF_ACE_PCU)

theorem SimpleActuator_isDeadlockFree : "((SimpleActuator i)::(PN,Events) proc) isDeadlockFree"
  apply (simp only: SimpleActuator_def)
  by (rule DF_ACE_PCU_isDeadlockFree)

declare inj_def [simp del]
declare Let_def [simp del]

declare Rec_prefix_def [simp del]
declare Send_prefix_def [simp del]

end


section \<open>Correctness Theorem of Partial Order Reduction\<close>

theory Ample_Correctness
imports
  Ample_Abstract
  Formula
begin

  locale ample_correctness =
    S: transition_system_complete ex en init int +
    R: transition_system_complete ex ren init int +
    F: formula_next_free \<phi> +
    ample_abstract ex en init int ind src ren
    for ex :: "'action \<Rightarrow> 'state \<Rightarrow> 'state"
    and en :: "'action \<Rightarrow> 'state \<Rightarrow> bool"
    and init :: "'state \<Rightarrow> bool"
    and int :: "'state \<Rightarrow> 'interpretation"
    and ind :: "'action \<Rightarrow> 'action \<Rightarrow> bool"
    and src :: "'state \<Rightarrow> 'state \<Rightarrow> bool"
    and ren :: "'action \<Rightarrow> 'state \<Rightarrow> bool"
    and \<phi> :: "'interpretation pltl"
  begin

    lemma reduction_language_indistinguishable:
      assumes "R.language \<subseteq> F.language"
      shows "S.language \<subseteq> F.language"
    proof
      fix u
      assume 1: "u \<in> S.language"
      obtain v where 2: "v \<in> R.language" "snth u \<approx> snth v" using reduction_language_stuttering 1 by this
      have 3: "v \<in> F.language" using assms 2(1) by rule
      show "u \<in> F.language" using 2(2) 3 by auto
    qed

    theorem reduction_correct: "S.language \<subseteq> F.language \<longleftrightarrow> R.language \<subseteq> F.language"
      using reduction_language_subset reduction_language_indistinguishable by blast

  end

end


(*  Title:      HOL/Auth/n_germanSimp_lemma_on_inv__12.thy
    Author:     Yongjian Li and Kaiqiang Duan, State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
    Copyright    2016 State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
*)

header{*The n_germanSimp Protocol Case Study*}

theory n_germanSimp_lemma_on_inv__12 imports n_germanSimp_base
begin
section{*All lemmas on causal relation between inv__12 and some rule r*}
lemma n_SendInv__part__0Vsinv__12:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendInv__part__0  i)" and
a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__12  p__Inv3 p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_SendInv__part__0  i" apply fastforce done
from a2 obtain p__Inv3 p__Inv4 where a2:"p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__12  p__Inv3 p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i=p__Inv3)\<or>(i~=p__Inv3\<and>i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i=p__Inv3)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv3\<and>i~=p__Inv4)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_SendInv__part__1Vsinv__12:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendInv__part__1  i)" and
a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__12  p__Inv3 p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_SendInv__part__1  i" apply fastforce done
from a2 obtain p__Inv3 p__Inv4 where a2:"p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__12  p__Inv3 p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i=p__Inv3)\<or>(i~=p__Inv3\<and>i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i=p__Inv3)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv3\<and>i~=p__Inv4)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_SendInvAckVsinv__12:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendInvAck  i)" and
a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__12  p__Inv3 p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_SendInvAck  i" apply fastforce done
from a2 obtain p__Inv3 p__Inv4 where a2:"p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__12  p__Inv3 p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i=p__Inv3)\<or>(i~=p__Inv3\<and>i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i=p__Inv3)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv3\<and>i~=p__Inv4)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_SendGntSVsinv__12:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendGntS  i)" and
a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__12  p__Inv3 p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_SendGntS  i" apply fastforce done
from a2 obtain p__Inv3 p__Inv4 where a2:"p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__12  p__Inv3 p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i=p__Inv3)\<or>(i~=p__Inv3\<and>i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i=p__Inv3)"
  have "?P3 s"
  apply (cut_tac a1 a2 b1, simp, rule_tac x="(neg (andForm (eqn (IVar (Ident ''ExGntd'')) (Const false)) (eqn (IVar (Field (Para (Ident ''Chan2'') p__Inv4) ''Cmd'')) (Const GntE))))" in exI, auto) done
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv3\<and>i~=p__Inv4)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_SendGntEVsinv__12:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendGntE N i)" and
a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__12  p__Inv3 p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_SendGntE N i" apply fastforce done
from a2 obtain p__Inv3 p__Inv4 where a2:"p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__12  p__Inv3 p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i=p__Inv3)\<or>(i~=p__Inv3\<and>i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P3 s"
  apply (cut_tac a1 a2 b1, simp, rule_tac x="(neg (andForm (eqn (IVar (Field (Para (Ident ''Chan2'') p__Inv3) ''Cmd'')) (Const GntS)) (eqn (IVar (Para (Ident ''ShrSet'') p__Inv3)) (Const false))))" in exI, auto) done
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i=p__Inv3)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv3\<and>i~=p__Inv4)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_RecvGntSVsinv__12:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntS  i)" and
a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__12  p__Inv3 p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_RecvGntS  i" apply fastforce done
from a2 obtain p__Inv3 p__Inv4 where a2:"p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__12  p__Inv3 p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i=p__Inv3)\<or>(i~=p__Inv3\<and>i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i=p__Inv3)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv3\<and>i~=p__Inv4)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_RecvGntEVsinv__12:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntE  i)" and
a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__12  p__Inv3 p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_RecvGntE  i" apply fastforce done
from a2 obtain p__Inv3 p__Inv4 where a2:"p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__12  p__Inv3 p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i=p__Inv3)\<or>(i~=p__Inv3\<and>i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i=p__Inv3)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv3\<and>i~=p__Inv4)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_StoreVsinv__12:
  assumes a1: "\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d" and
  a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__12  p__Inv3 p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_RecvInvAckVsinv__12:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i" and
  a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__12  p__Inv3 p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_RecvReqE__part__0Vsinv__12:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_RecvReqE__part__0 N i" and
  a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__12  p__Inv3 p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_RecvReqE__part__1Vsinv__12:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_RecvReqE__part__1 N i" and
  a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__12  p__Inv3 p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_RecvReqSVsinv__12:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_RecvReqS N i" and
  a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__12  p__Inv3 p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

end


theory ReborrowInd
  imports BorrowStack
begin

inductive reborrow'
  :: "ref_kind \<Rightarrow> tag \<Rightarrow> tag \<Rightarrow> (ref_kind * tag set) stack \<Rightarrow> (ref_kind * tag set) stack \<Rightarrow> bool"
where
  DerivUniqueUnique:
    "reborrow' Unique deriv orig
      ((Unique, {orig}) # tail)
      ((Unique, {deriv}) # (Unique, {orig}) # tail)" |
  DerivUniqueSRW:
    "reborrow' SharedReadWrite deriv orig
      ((Unique, {orig}) # tail)
      ((SharedReadWrite, {deriv}) # (Unique, {orig}) # tail)" |
  DerivUniqueSRO:
    "reborrow' SharedReadOnly deriv orig
      ((Unique, {orig}) # tail)
      ((SharedReadOnly, {deriv}) # (Unique, {orig}) # tail)" |
  DerivSRWUnique:
    "orig \<in> ts
     \<Longrightarrow> reborrow' Unique deriv orig
      ((SharedReadWrite, ts) # tail)
      ((Unique, {deriv}) # (SharedReadWrite, ts) # tail)" |
  DerivSRWSRW:
    "orig \<in> ts
     \<Longrightarrow> reborrow' SharedReadWrite deriv orig
      ((SharedReadWrite, ts) # tail)
      ((SharedReadWrite, insert deriv ts) # tail)" |
  DerivSRWSRO:
    "orig \<in> ts
     \<Longrightarrow> reborrow' SharedReadOnly deriv orig
      ((SharedReadWrite, ts) # tail)
      ((SharedReadOnly, {deriv}) # (SharedReadWrite, ts) # tail)" |
  DerivSROSRO:
    "orig \<in> ts
     \<Longrightarrow> reborrow' SharedReadOnly deriv orig
      ((SharedReadOnly, ts) # tail)
      ((SharedReadOnly, insert deriv ts) # tail)" |
  DerivPop:
    "\<lbrakk>reborrow' k deriv orig tail stack; orig \<notin> snd entry\<rbrakk>
    \<Longrightarrow> reborrow' k deriv orig (entry # tail) stack"

lemma reborrow'_nonempty_src:
  "reborrow' k deriv orig stack stack' \<Longrightarrow> stack \<noteq> []"
  using reborrow'.simps by blast

lemma ex_reborrow'_writable:
  assumes
    "wf_reborrow stack"
    "writable orig stack"
  shows "\<exists>stack'. reborrow' k deriv orig stack stack'"
using assms proof (induction rule: wf_reborrow_induct')
  case (Root t)
  then show ?case
    by (metis (full_types) DerivUniqueSRO DerivUniqueSRW DerivUniqueUnique empty_iff insert_iff
        ref_kind.exhaust writable.simps(1) writable.simps(2))
next
  case (UniqueUnique t t' tail)
  then show ?case
    by (metis (full_types) DerivPop DerivUniqueSRO DerivUniqueSRW DerivUniqueUnique
        ref_kind.exhaust singletonD snd_conv writable.simps(2))
next
  case (UniqueSRW t ts' tail)
  then show ?case
    by (metis (full_types) DerivPop DerivSRWSRO DerivSRWSRW DerivSRWUnique
        ref_kind.exhaust snd_eqD writable.simps(2))
next
  case (UniqueSRO t ts' tail)
  then show ?case
    by (metis DerivPop ref_kind.distinct(3) ref_kind.distinct(5) snd_conv writable.simps(2))
next
  case (SRWUnique ts t' tail)
  then show ?case
    by (metis (full_types) DerivPop DerivUniqueSRO DerivUniqueSRW DerivUniqueUnique
        ref_kind.exhaust singletonD snd_eqD writable.simps(2))
next
  case (SRWSRO ts ts' tail)
  then show ?case
    by (metis DerivPop ref_kind.distinct(3) ref_kind.distinct(5) sndI writable.simps(2))
qed

lemma ex_reborrow'_readable:
  assumes
    "wf_reborrow stack"
    "readable orig stack"
    "k = SharedReadOnly"
  shows "\<exists>stack'. reborrow' k deriv orig stack stack'"
using assms proof (induction rule: wf_reborrow_induct')
  case (Root t)
  then show ?case using DerivUniqueSRO by auto
next
  case (UniqueUnique t t' tail)
  then show ?case
  proof (cases "t' = orig")
    case True
    then show ?thesis using UniqueUnique DerivUniqueSRO by auto
  next
    case False
    then show ?thesis
    proof -
      obtain stack' where
        "reborrow' k deriv orig ((Unique, {t}) # tail) stack'"
        using UniqueUnique False by auto
      then show ?thesis using False DerivPop by force
    qed
  qed
next
  case (UniqueSRW t ts' tail)
  then show ?case
  proof (cases "orig \<in> ts'")
    case True
    then show ?thesis using UniqueSRW DerivSRWSRO by blast
  next
    case False
    then show ?thesis
    proof -
      obtain stack' where
        "reborrow' k deriv orig ((Unique, {t}) # tail) stack'"
        using UniqueSRW False by auto
      then show ?thesis using False DerivPop by force
    qed
  qed
next
  case (UniqueSRO t ts' tail)
  then show ?case
  proof (cases "orig \<in> ts'")
    case True
    then show ?thesis using UniqueSRO DerivSROSRO by blast
  next
    case False
    then show ?thesis
    proof -
      obtain stack' where
        "reborrow' k deriv orig ((Unique, {t}) # tail) stack'"
        using UniqueSRO False by auto
      then show ?thesis using False DerivPop by force
    qed
  qed
next
  case (SRWUnique ts t' tail)
  then show ?case
  proof (cases "t' = orig")
    case True
    then show ?thesis using SRWUnique DerivUniqueSRO by auto
  next
    case False
    then show ?thesis
    proof -
      obtain stack' where
        "reborrow' k deriv orig ((SharedReadWrite, ts) # tail) stack'"
        using SRWUnique False by auto
      then show ?thesis using False DerivPop by force
    qed
  qed
next
  case (SRWSRO ts ts' tail)
  then show ?case
  proof (cases "orig \<in> ts'")
    case True
    then show ?thesis using SRWSRO DerivSROSRO by blast
  next
    case False
    then show ?thesis
    proof -
      obtain stack' where
        "reborrow' k deriv orig ((SharedReadWrite, ts) # tail) stack'"
        using SRWSRO False by auto
      then show ?thesis using False DerivPop by force
    qed
  qed
qed

fun reborrow_ind
  :: "ref_kind \<Rightarrow> tag \<Rightarrow> tag \<Rightarrow> (ref_kind * tag set) stack \<Rightarrow> (ref_kind * tag set) stack" where
  "reborrow_ind k deriv orig stack = (THE stack'. reborrow' k deriv orig stack stack')"

lemma reborrow_by_comp[simp, intro]:
  assumes "reborrow' k deriv orig stack stack'"
  shows "reborrow_comp k deriv orig stack = stack'"
using assms proof (induction rule: reborrow'.induct)
qed auto

lemma the_reborrow_by_comp[simp, intro]:
  assumes "reborrow' k deriv orig stack (reborrow_comp k deriv orig stack)"
  shows "(THE stack'. reborrow' k deriv orig stack stack') = reborrow_comp k deriv orig stack"
  using assms reborrow_by_comp by blast

lemma the_reborrow_by_comp'[simp, intro]:
  assumes "reborrow' k deriv orig stack (reborrow_comp k deriv orig stack)"
  shows "The (reborrow' k deriv orig stack) = reborrow_comp k deriv orig stack"
  using assms the_reborrow_by_comp by simp

lemma reborrow_unique:
  assumes
    "reborrow' k deriv orig stack stack'"
    "reborrow' k deriv orig stack stack''"
  shows "stack' = stack''"
  using assms(1) assms(2) reborrow_by_comp by blast

lemma ex1_reborrow'_writable:
  assumes
    "wf_reborrow stack"
    "writable orig stack"
  shows "\<exists>!stack'. reborrow' k deriv orig stack stack'"
proof -
  obtain stack' where
    *: "reborrow' k deriv orig stack stack'"
    using assms ex_reborrow'_writable by blast
  moreover have "\<forall>stack''. reborrow' k deriv orig stack stack'' \<longrightarrow> stack'' = stack'"
    using reborrow_unique * by auto
  ultimately show ?thesis by blast
qed

lemma ex1_reborrow'_readable:
  assumes
    "wf_reborrow stack"
    "readable orig stack"
    "k = SharedReadOnly"
  shows "\<exists>!stack'. reborrow' k deriv orig stack stack'"
proof -
  obtain stack' where
    *: "reborrow' k deriv orig stack stack'"
    using assms ex_reborrow'_readable by blast
  moreover have "\<forall>stack''. reborrow' k deriv orig stack stack'' \<longrightarrow> stack'' = stack'"
    using reborrow_unique * by auto
  ultimately show ?thesis by blast
qed

lemma the_reborrow'_writable:
  assumes
    "wf_reborrow stack"
    "writable orig stack"
  shows "\<exists>!stack'. reborrow' k deriv orig stack stack'"
  using assms ex_reborrow'_writable reborrow_unique by auto

lemma the_reborrow'_readable:
  assumes
    "wf_reborrow stack"
    "readable orig stack"
    "k = SharedReadOnly"
  shows "\<exists>!stack'. reborrow' k deriv orig stack stack'"
  using assms ex_reborrow'_readable reborrow_unique by fastforce

lemma reborrow'_hd:
  assumes "reborrow' k deriv orig stack stack'"
  shows "k = fst (hd stack') \<and> deriv \<in> snd (hd stack')"
using assms proof (induction rule: reborrow'.induct, auto)
qed

lemma wf_reborrow_reborrow':
  assumes
    "reborrow' k deriv orig stack stack'"
    "wf_reborrow stack"
    "deriv \<notin> collect_tags stack"
  shows "wf_reborrow stack'"
using assms proof (induction)
  case (DerivPop k deriv orig tail stack entry)
  then show ?case using reborrow'_nonempty_src wf_reborrow_pop' by auto
qed (auto simp add: ReborrowSRWSRW ReborrowSROSRO)

lemma wf_reborrow_reborrow'_the:
  assumes
    "writable orig stack"
    "wf_reborrow stack"
    "deriv \<notin> collect_tags stack"
  shows "wf_reborrow (THE stack'. reborrow' k deriv orig stack stack')"
  using assms wf_reborrow_reborrow'
  by (metis reborrow_by_comp the_reborrow'_writable the_reborrow_by_comp the_reborrow_by_comp')

lemma stack_finite_reborrow':
  assumes
    "reborrow' k deriv orig stack stack'"
    "stack_finite stack"
  shows "stack_finite stack'"
using assms proof (induction, auto)
qed

lemma reborrow'_subset:
  assumes "reborrow' k deriv orig stack stack'"
  shows "collect_tags stack' \<subseteq> {deriv} \<union> collect_tags stack"
using assms proof (induction, auto)
qed

lemma writable_reborrow:
  assumes
    "reborrow' k deriv orig stack stack'"
    "wf_reborrow stack"
    "writable orig stack"
    "deriv \<notin> collect_tags stack"
  shows "writable orig stack'"
using assms proof (induction)
  case (DerivPop k deriv orig tail stack entry)
  show ?case
  proof (rule DerivPop.IH)
    show "wf_reborrow tail" using DerivPop wf_reborrow_pop' reborrow'_nonempty_src by simp
  next
    show "writable orig tail" using DerivPop writable_tl by fastforce
  next
    show "deriv \<notin> collect_tags tail" using DerivPop.prems by simp
  qed
qed auto

lemma writable_reborrow_the:
  assumes
    "wf_reborrow stack"
    "writable orig stack"
    "deriv \<notin> collect_tags stack"
  shows "writable orig (THE stack'. reborrow' k deriv orig stack stack')"
  using writable_reborrow
  by (metis assms ex_reborrow'_writable reborrow_by_comp the_reborrow_by_comp')

lemma writable_reborrow_derived:
  assumes
    "reborrow' k deriv orig stack stack'"
    "writable orig stack"
    "wf_reborrow stack"
    "k = Unique \<or> k = SharedReadWrite"
  shows "writable deriv stack'"
using assms proof (induction)
  case (DerivPop k deriv orig tail stack entry)
  show ?case
  proof (rule DerivPop.IH)
    show "wf_reborrow tail" using DerivPop wf_reborrow_pop' reborrow'_nonempty_src by simp
  next
    show "writable orig tail" using DerivPop writable_tl by fastforce
  next
    show "k = Unique \<or> k = SharedReadWrite" using DerivPop.prems by simp
  qed
qed auto

lemma writable_reborrow_derived_the:
  assumes
    "writable orig stack"
    "wf_reborrow stack"
    "k = Unique \<or> k = SharedReadWrite"
  shows "writable deriv (THE stack'. reborrow' k deriv orig stack stack')"
  using writable_reborrow_derived
  by (metis assms ex_reborrow'_writable reborrow_by_comp the_reborrow_by_comp')

lemma reborrow_comp_by_ind:
  assumes
    "wf_reborrow stack"
    "reborrow_comp k deriv orig stack = stack'"
    "stack' \<noteq> []"
  shows
    "reborrow' k deriv orig stack stack'"
using assms proof (induction rule: wf_reborrow_induct')
  case (Root t)
  consider "orig \<noteq> t" | "orig = t" by auto
  then show ?case
  proof (cases)
    case 1
    then show ?thesis using Root by simp
  next
    case 2
    then show ?thesis using Root reborrow_by_comp the_reborrow'_writable by fastforce
  qed
next
  case (UniqueUnique t t' tail)
  consider "t' \<noteq> orig" | "t' = orig" by auto
  then show ?case
  proof (cases)
    case 1
    then have "reborrow_comp k deriv orig ((Unique, {t}) # tail) = stack'"
      using UniqueUnique.prems(1) by auto
    then show ?thesis using UniqueUnique \<open>t' \<noteq> orig\<close> reborrow'.intros(8) by auto
  next
    case 2
    then show ?thesis
    proof (cases k)
      case Unique
      then show ?thesis using 2 UniqueUnique DerivUniqueUnique by auto
    next
      case SharedReadWrite
      then show ?thesis using 2 UniqueUnique DerivUniqueSRW by auto
    next
      case SharedReadOnly
      then show ?thesis using 2 UniqueUnique DerivUniqueSRO by auto
    qed
  qed
next
  case (UniqueSRW t ts' tail)
  consider "orig \<notin> ts'" | "orig \<in> ts'" by auto
  then show ?case
  proof (cases)
    case 1
    then have "reborrow_comp k deriv orig ((Unique, {t}) # tail) = stack'"
      using UniqueSRW.prems(1) by auto
    then show ?thesis using UniqueSRW \<open>orig \<notin> ts'\<close> reborrow'.intros(8) by auto
  next
    case 2
    then show ?thesis
    proof (cases k)
      case Unique
      then show ?thesis using 2 UniqueSRW DerivSRWUnique by auto
    next
      case SharedReadWrite
      then show ?thesis using 2 UniqueSRW DerivSRWSRW by auto
    next
      case SharedReadOnly
      then show ?thesis using 2 UniqueSRW DerivSRWSRO by auto
    qed
  qed
next
  case (UniqueSRO t ts' tail)
  consider "orig \<notin> ts'" | "orig \<in> ts'" by auto
  then show ?case
  proof (cases)
    case 1
    then have "reborrow_comp k deriv orig ((Unique, {t}) # tail) = stack'"
      using UniqueSRO.prems(1) by auto
    then show ?thesis using UniqueSRO \<open>orig \<notin> ts'\<close> reborrow'.intros(8) by auto
  next
    case 2
    then show ?thesis
    proof (cases k)
      case Unique
      then show ?thesis using 2 UniqueSRO by auto
    next
      case SharedReadWrite
      then show ?thesis using 2 UniqueSRO by auto
    next
      case SharedReadOnly
      then show ?thesis using 2 UniqueSRO DerivSROSRO by auto
    qed
  qed
next
  case (SRWUnique ts t' tail)
  consider "t' \<noteq> orig" | "t' = orig" by auto
  then show ?case
  proof (cases)
    case 1
    then have "reborrow_comp k deriv orig ((SharedReadWrite, ts) # tail) = stack'"
      using SRWUnique.prems(1) by auto
    then show ?thesis using SRWUnique \<open>t' \<noteq> orig\<close> reborrow'.intros(8) by auto
  next
    case 2
    then show ?thesis
    proof (cases k)
      case Unique
      then show ?thesis using 2 SRWUnique DerivUniqueUnique by auto
    next
      case SharedReadWrite
      then show ?thesis using 2 SRWUnique DerivUniqueSRW by auto
    next
      case SharedReadOnly
      then show ?thesis using 2 SRWUnique DerivUniqueSRO by auto
    qed
  qed
next
  case (SRWSRO ts ts' tail)
  consider "orig \<notin> ts'" | "orig \<in> ts'" by auto
  then show ?case
  proof (cases)
    case 1
    then have "reborrow_comp k deriv orig ((SharedReadWrite, ts) # tail) = stack'"
      using SRWSRO.prems(1) by auto
    then show ?thesis using SRWSRO \<open>orig \<notin> ts'\<close> reborrow'.intros(8) by auto
  next
    case 2
    then show ?thesis
    proof (cases k)
      case Unique
      then show ?thesis using 2 SRWSRO by auto
    next
      case SharedReadWrite
      then show ?thesis using 2 SRWSRO by auto
    next
      case SharedReadOnly
      then show ?thesis using 2 SRWSRO DerivSROSRO by auto
    qed
  qed
qed

lemma reborrow_equivalence:
  assumes
    "wf_reborrow stack"
    "writable orig stack \<or> (readable orig stack \<and> k = SharedReadOnly)"
  shows "reborrow_comp k deriv orig stack = stack' \<longleftrightarrow> reborrow' k deriv orig stack stack'"
  using assms reborrow_by_comp reborrow_comp_by_ind nonempty_reborrow_comp_if_valid_reborrow
  by fast

lemma wf_reborrow_pop''[
  consumes 1,
  case_names Root Reborrow
]:
  assumes
    "wf_reborrow stack"
  obtains
    t where
    "stack = [(Unique, {t})]"
  | entry and tail where
    "stack = entry # tail" and
    "wf_reborrow tail"
  by (metis assms last.simps neq_Nil_conv wf_reborrow_pop'
      wf_reborrow_root wf_reborrow_structure_elims(1))

lemma writable_reborrow_comp_derived':
  assumes
    "writable t stack"
    "reborrow_comp k t' t stack = stack'"
    "wf_reborrow stack"
    "k = Unique \<or> k = SharedReadWrite"
  shows "writable t' stack'"
proof -
  have "reborrow' k t' t stack stack'"
    using assms reborrow_equivalence by simp
  then show ?thesis
  using assms proof (induction)
    case (DerivPop k deriv orig tail stack entry)
    moreover have "writable orig tail"
      using writable_tl DerivPop by fastforce
    moreover have "wf_reborrow tail"
      using reborrow'_nonempty_src wf_reborrow_pop' calculation by blast
    moreover have "reborrow_comp k deriv orig tail = stack"
      using reborrow_equivalence calculation by simp
    ultimately show ?case by simp
  qed auto
qed

end


theory flash81Rev imports flashPub
begin
section{*Main defintions*}
lemma NI_FAckVsInv81:
    (*Rule0VsPInv0*)

  shows  "invHoldForRule' s (inv81 ) (NI_FAck ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

      by( auto)

  lemma NI_InvVsInv81:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (NI_Inv  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_InvAck_1VsInv81:
    (*Rule2VsPInv0*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iRule2 \<le> N" and  a3:"iRule1~=iRule2  "

  shows  "invHoldForRule' s (inv81 ) (NI_InvAck_1  iRule1  iRule2 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1 a2 a3,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_InvAck_1_HomeVsInv81:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (NI_InvAck_1_Home  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_InvAck_2VsInv81:
  (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (NI_InvAck_2 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have allCases:"formEval   (neg ( andForm ( eqn ( IVar ( Global ''Dir_local'') )  ( Const true ))    ( eqn ( IVar ( Global ''Dir_Dirty'') )  ( Const false ))  ) )  s  \<or>formEval  ( andForm ( eqn ( IVar ( Global ''Dir_local'') )  ( Const true ))    ( eqn ( IVar ( Global ''Dir_Dirty'') )  ( Const false ))  )  s  "
	                      by auto

    moreover
                       {assume b1:"formEval  (neg ( andForm ( eqn ( IVar ( Global ''Dir_local'') )  ( Const true ))    ( eqn ( IVar ( Global ''Dir_Dirty'') )  ( Const false ))  ) )  s"
have "?P2 s"

  apply(cut_tac  a1  b1 , auto intro!:forallVars1 simp  add :invHoldForRule2'_def varsOfVar_def)

  done

  then  have "?P1 s\<or> ?P2 s \<or> ?P3 s"

        by blast
    }

    moreover
                       {assume b1:"formEval ( andForm ( eqn ( IVar ( Global ''Dir_local'') )  ( Const true ))    ( eqn ( IVar ( Global ''Dir_Dirty'') )  ( Const false ))  )  s"

      have "?P1 s"

        apply(cut_tac  a1  b1 , auto)

        done

        then  have "?P1 s\<or> ?P2 s \<or> ?P3 s"

       by blast
    }
   ultimately show "?P1 s\<or> ?P2 s\<or> ?P3 s"

	                         by metis

 qed
lemma NI_Local_GetX_GetXVsInv81:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (NI_Local_GetX_GetX  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_GetX_Nak1VsInv81:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (NI_Local_GetX_Nak1  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_GetX_Nak2VsInv81:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (NI_Local_GetX_Nak2  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_GetX_Nak3VsInv81:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (NI_Local_GetX_Nak3  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_GetX_PutX1VsInv81:
  (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (NI_Local_GetX_PutX1 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply(cut_tac  a1 , auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma NI_Local_GetX_PutX2VsInv81:
  (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (NI_Local_GetX_PutX2 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply(cut_tac  a1 , auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma NI_Local_GetX_PutX3VsInv81:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (NI_Local_GetX_PutX3 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_GetX_PutX4VsInv81:
  (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (NI_Local_GetX_PutX4 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply(cut_tac  a1 , auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma NI_Local_GetX_PutX5VsInv81:
  (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (NI_Local_GetX_PutX5 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply(cut_tac  a1 , auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma NI_Local_GetX_PutX6VsInv81:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (NI_Local_GetX_PutX6 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_GetX_PutX7VsInv81:
  (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (NI_Local_GetX_PutX7 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply(cut_tac  a1 , auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma NI_Local_GetX_PutX8VsInv81:
  (*Rule2VsPInv0*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iRule2 \<le> N" and  a3:"iRule1~=iRule2  "

  shows  "invHoldForRule' s (inv81 ) (NI_Local_GetX_PutX8 N  iRule1  iRule2 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply(cut_tac  a1  a2  a3 , auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma NI_Local_GetX_PutX8_homeVsInv81:
  (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (NI_Local_GetX_PutX8_home N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply(cut_tac  a1 , auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma NI_Local_GetX_PutX9VsInv81:
  (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (NI_Local_GetX_PutX9 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply(cut_tac  a1 , auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma NI_Local_GetX_PutX10VsInv81:
  (*Rule2VsPInv0*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iRule2 \<le> N" and  a3:"iRule1~=iRule2  "

  shows  "invHoldForRule' s (inv81 ) (NI_Local_GetX_PutX10 N  iRule1  iRule2 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply(cut_tac  a1  a2  a3 , auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma NI_Local_GetX_PutX10_homeVsInv81:
  (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (NI_Local_GetX_PutX10_home N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply(cut_tac  a1 , auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma NI_Local_GetX_PutX11VsInv81:
  (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (NI_Local_GetX_PutX11 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply(cut_tac  a1 , auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma NI_Local_Get_GetVsInv81:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (NI_Local_Get_Get  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_Get_Nak1VsInv81:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (NI_Local_Get_Nak1  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_Get_Nak2VsInv81:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (NI_Local_Get_Nak2  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_Get_Nak3VsInv81:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (NI_Local_Get_Nak3  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_Get_Put1VsInv81:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (NI_Local_Get_Put1 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_Get_Put2VsInv81:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (NI_Local_Get_Put2  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_Get_Put3VsInv81:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (NI_Local_Get_Put3  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_PutVsInv81:
  (*Rule0VsPInv0*)
  shows  "invHoldForRule' s (inv81 ) (NI_Local_Put ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P3 s"

        apply(    simp)

        apply(rule_tac x=" (neg ( andForm ( eqn ( IVar ( Global ''WbMsg_Cmd'') )  ( Const WB_Wb ))    ( eqn ( IVar ( Para ''UniMsg_Cmd'' Home) )  ( Const UNI_Put ))  ) ) " in exI,auto)

        done

       then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

        by blast

 qed
lemma NI_Local_PutXAcksDoneVsInv81:
  (*Rule0VsPInv0*)
  shows  "invHoldForRule' s (inv81 ) (NI_Local_PutXAcksDone ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P3 s"

        apply(    simp)

        apply(rule_tac x=" (neg ( andForm ( eqn ( IVar ( Global ''WbMsg_Cmd'') )  ( Const WB_Wb ))    ( eqn ( IVar ( Para ''UniMsg_Cmd'' Home) )  ( Const UNI_PutX ))  ) ) " in exI,auto)

        done

       then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

        by blast

 qed
lemma NI_NakVsInv81:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (NI_Nak  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Nak_ClearVsInv81:
    (*Rule0VsPInv0*)

  shows  "invHoldForRule' s (inv81 ) (NI_Nak_Clear ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

      by( auto)

  lemma NI_Nak_HomeVsInv81:
    (*Rule0VsPInv0*)

  shows  "invHoldForRule' s (inv81 ) (NI_Nak_Home ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

      by( auto)

  lemma NI_Remote_GetX_NakVsInv81:
    (*Rule2VsPInv0*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iRule2 \<le> N" and  a3:"iRule1~=iRule2  "

  shows  "invHoldForRule' s (inv81 ) (NI_Remote_GetX_Nak  iRule1  iRule2 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1 a2 a3,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Remote_GetX_Nak_HomeVsInv81:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (NI_Remote_GetX_Nak_Home  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Remote_GetX_PutXVsInv81:
    (*Rule2VsPInv0*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iRule2 \<le> N" and  a3:"iRule1~=iRule2  "

  shows  "invHoldForRule' s (inv81 ) (NI_Remote_GetX_PutX  iRule1  iRule2 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1 a2 a3,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Remote_GetX_PutX_HomeVsInv81:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (NI_Remote_GetX_PutX_Home  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Remote_Get_Nak1VsInv81:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (NI_Remote_Get_Nak1  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Remote_Get_Nak2VsInv81:
    (*Rule2VsPInv0*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iRule2 \<le> N" and  a3:"iRule1~=iRule2  "

  shows  "invHoldForRule' s (inv81 ) (NI_Remote_Get_Nak2  iRule1  iRule2 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1 a2 a3,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Remote_Get_Put1VsInv81:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (NI_Remote_Get_Put1  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Remote_Get_Put2VsInv81:
    (*Rule2VsPInv0*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iRule2 \<le> N" and  a3:"iRule1~=iRule2  "

  shows  "invHoldForRule' s (inv81 ) (NI_Remote_Get_Put2  iRule1  iRule2 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1 a2 a3,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Remote_PutVsInv81:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (NI_Remote_Put  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Remote_PutXVsInv81:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (NI_Remote_PutX  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_ReplaceVsInv81:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (NI_Replace  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_ReplaceHomeVsInv81:
    (*Rule0VsPInv0*)

  shows  "invHoldForRule' s (inv81 ) (NI_ReplaceHome ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

      by( auto)

  lemma NI_ReplaceHomeShrVldVsInv81:
    (*Rule0VsPInv0*)

  shows  "invHoldForRule' s (inv81 ) (NI_ReplaceHomeShrVld ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

      by( auto)

  lemma NI_ReplaceShrVldVsInv81:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (NI_ReplaceShrVld  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_ShWbVsInv81:
    (*Rule0VsPInv0*)

  shows  "invHoldForRule' s (inv81 ) (NI_ShWb N ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

      by( auto)

  lemma NI_WbVsInv81:
  (*Rule0VsPInv0*)
  shows  "invHoldForRule' s (inv81 ) (NI_Wb ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply( auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma PI_Local_GetX_GetX1VsInv81:
    (*Rule0VsPInv0*)

  shows  "invHoldForRule' s (inv81 ) (PI_Local_GetX_GetX1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

      by( auto)

  lemma PI_Local_GetX_GetX2VsInv81:
    (*Rule0VsPInv0*)

  shows  "invHoldForRule' s (inv81 ) (PI_Local_GetX_GetX2 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

      by( auto)

  lemma PI_Local_GetX_PutX1VsInv81:
  (*Rule0VsPInv0*)
  shows  "invHoldForRule' s (inv81 ) (PI_Local_GetX_PutX1 N ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P3 s"

        apply(    simp)

        apply(rule_tac x=" (neg ( andForm ( eqn ( IVar ( Global ''WbMsg_Cmd'') )  ( Const WB_Wb ))    ( eqn ( IVar ( Global ''Dir_Dirty'') )  ( Const false ))  ) ) " in exI,auto)

        done

       then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

        by blast

 qed
lemma PI_Local_GetX_PutX2VsInv81:
  (*Rule0VsPInv0*)
  shows  "invHoldForRule' s (inv81 ) (PI_Local_GetX_PutX2 N ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P3 s"

        apply(    simp)

        apply(rule_tac x=" (neg ( andForm ( eqn ( IVar ( Global ''WbMsg_Cmd'') )  ( Const WB_Wb ))    ( eqn ( IVar ( Para ''CacheState'' Home) )  ( Const CACHE_S ))  ) ) " in exI,auto)

        done

       then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

        by blast

 qed
lemma PI_Local_GetX_PutX3VsInv81:
  (*Rule0VsPInv0*)
  shows  "invHoldForRule' s (inv81 ) (PI_Local_GetX_PutX3 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P3 s"

        apply(    simp)

        apply(rule_tac x=" (neg ( andForm ( eqn ( IVar ( Global ''WbMsg_Cmd'') )  ( Const WB_Wb ))    ( eqn ( IVar ( Global ''Dir_Dirty'') )  ( Const false ))  ) ) " in exI,auto)

        done

       then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

        by blast

 qed
lemma PI_Local_GetX_PutX4VsInv81:
  (*Rule0VsPInv0*)
  shows  "invHoldForRule' s (inv81 ) (PI_Local_GetX_PutX4 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P3 s"

        apply(    simp)

        apply(rule_tac x=" (neg ( andForm ( eqn ( IVar ( Global ''WbMsg_Cmd'') )  ( Const WB_Wb ))    ( eqn ( IVar ( Para ''CacheState'' Home) )  ( Const CACHE_S ))  ) ) " in exI,auto)

        done

       then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

        by blast

 qed
lemma PI_Local_Get_GetVsInv81:
    (*Rule0VsPInv0*)

  shows  "invHoldForRule' s (inv81 ) (PI_Local_Get_Get ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

      by( auto)

  lemma PI_Local_Get_PutVsInv81:
  (*Rule0VsPInv0*)
  shows  "invHoldForRule' s (inv81 ) (PI_Local_Get_Put ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P3 s"

        apply(    simp)

        apply(rule_tac x=" (neg ( andForm ( eqn ( IVar ( Global ''WbMsg_Cmd'') )  ( Const WB_Wb ))    ( eqn ( IVar ( Global ''Dir_Dirty'') )  ( Const false ))  ) ) " in exI,auto)

        done

       then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

        by blast

 qed
lemma PI_Local_PutXVsInv81:
  (*Rule0VsPInv0*)
  shows  "invHoldForRule' s (inv81 ) (PI_Local_PutX ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have allCases:"formEval  ( eqn ( IVar ( Global ''Dir_Pending'') )  ( Const true ))  s  \<or>formEval   (neg ( eqn ( IVar ( Global ''Dir_Pending'') )  ( Const true )) )  s  "
	                      by auto

    moreover
                       {assume b1:"formEval ( eqn ( IVar ( Global ''Dir_Pending'') )  ( Const true ))  s"
have "?P2 s"

  apply(cut_tac  b1 , auto intro!:forallVars1 simp  add :invHoldForRule2'_def varsOfVar_def)

  done

  then  have "?P1 s\<or> ?P2 s \<or> ?P3 s"

        by blast
    }

    moreover
                       {assume b1:"formEval  (neg ( eqn ( IVar ( Global ''Dir_Pending'') )  ( Const true )) )  s"

      have "?P1 s"

        apply(cut_tac  b1 , auto)

        done

        then  have "?P1 s\<or> ?P2 s \<or> ?P3 s"

       by blast
    }
   ultimately show "?P1 s\<or> ?P2 s\<or> ?P3 s"

	                         by metis

 qed
lemma PI_Local_ReplaceVsInv81:
  (*Rule0VsPInv0*)
  shows  "invHoldForRule' s (inv81 ) (PI_Local_Replace ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply( auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma PI_Remote_GetVsInv81:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (PI_Remote_Get  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma PI_Remote_GetXVsInv81:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (PI_Remote_GetX  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma PI_Remote_PutXVsInv81:
  (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (PI_Remote_PutX  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P3 s"

        apply(   cut_tac  a1 , simp)

        apply(rule_tac x=" (neg ( andForm ( eqn ( IVar ( Para ''CacheState'' iRule1) )  ( Const CACHE_E ))    ( eqn ( IVar ( Global ''Dir_local'') )  ( Const true ))  ) ) " in exI,auto)

        done

       then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

        by blast

 qed
lemma PI_Remote_ReplaceVsInv81:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (PI_Remote_Replace  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma StoreVsInv81:
    (*Rule1VsPInv0*)
  assumes   a1:"iRule1 \<le> N"

  shows  "invHoldForRule' s (inv81 ) (Store  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by (cut_tac a1,auto  )
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma StoreHomeVsInv81:
    (*Rule0VsPInv0*)

  shows  "invHoldForRule' s (inv81 ) (StoreHome ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

      by( auto)

  end