(*  Title:      HOL/Auth/n_mutualExSimp_lemma_on_inv__2.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_mutualExSimp Protocol Case Study*}

theory n_mutualExSimp_lemma_on_inv__2 imports n_mutualExSimp_base
begin
section{*All lemmas on causal relation between inv__2 and some rule r*}
lemma n_CritVsinv__2:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_Crit  i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__2  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_Crit  i" apply fastforce done
from a2 obtain p__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__2  p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(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__Inv4)"
  have "?P1 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_ExitVsinv__2:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_Exit  i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__2  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_Exit  i" apply fastforce done
from a2 obtain p__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__2  p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(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__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_IdleVsinv__2:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_Idle  i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__2  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_Idle  i" apply fastforce done
from a2 obtain p__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__2  p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(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__Inv4)"
  have "?P3 s"
  apply (cut_tac a1 a2 b1, simp, rule_tac x="(neg (andForm (eqn (IVar (Para (Ident ''n'') p__Inv4)) (Const C)) (eqn (IVar (Para (Ident ''n'') i)) (Const E))))" in exI, auto) done
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed
end


theory Unreachability_Certification
  imports
    Simulation_Graphs_Certification
    Worklist_Algorithms.Leadsto_Impl
    TA_Library.Printing
    TA_Library.Imperative_Loops
    TA_Library.Trace_Timing
    Unreachability_Misc
begin

lemma monadic_list_all_nofailI:
  assumes "\<And> x. x \<in> set xs \<Longrightarrow> nofail (f x)"
  shows "nofail (monadic_list_all f xs)"
  sorry

lemma monadic_list_ex_nofailI:
  assumes "\<And> x. x \<in> set xs \<Longrightarrow> nofail (f x)"
  shows "nofail (monadic_list_ex f xs)"
  sorry

lemma no_fail_RES_bindI:
  assumes "\<And>x. x \<in> S \<Longrightarrow> nofail (f x)" "S \<noteq> {}"
  shows "nofail (RES S \<bind> f)"
  sorry

context
  fixes K :: "'k \<Rightarrow> ('ki :: {heap}) \<Rightarrow> assn"
  assumes pure_K: "is_pure K"
  assumes left_unique_K: "IS_LEFT_UNIQUE (the_pure K)"
  assumes right_unique_K: "IS_RIGHT_UNIQUE (the_pure K)"
begin

lemma pure_equality_impl:
  "(uncurry (return oo (=)), uncurry (RETURN oo (=))) \<in> (K\<^sup>k *\<^sub>a K\<^sup>k) \<rightarrow>\<^sub>a bool_assn"
proof -
  have 1: "K = pure (the_pure K)"
    using pure_K by auto
  have [dest]: "a = b" if "(bi, b) \<in> the_pure K" "(bi, a) \<in> the_pure K" for bi a b
    using that right_unique_K by (elim single_valuedD) auto
  have [dest]: "a = b" if "(a, bi) \<in> the_pure K" "(b, bi) \<in> the_pure K" for bi a b
    using that left_unique_K unfolding IS_LEFT_UNIQUE_def by (elim single_valuedD) auto
  show ?thesis
    by (subst 1, subst (2) 1, sepref_to_hoare, sep_auto)
qed

definition
  "is_member x L \<equiv> do {
    xs \<leftarrow> SPEC (\<lambda>xs. set xs = L);
    monadic_list_ex (\<lambda>y. RETURN (y = x)) xs
  }"

lemma is_member_refine:
  "is_member x L \<le> mop_set_member x L"
  unfolding mop_set_member_alt is_member_def
  by (refine_vcg monadic_list_ex_rule) (auto simp: list_ex_iff)

lemma is_member_correct:
  "(uncurry is_member, uncurry (RETURN \<circ>\<circ> op_set_member)) \<in> Id \<times>\<^sub>r Id \<rightarrow> \<langle>bool_rel\<rangle>nres_rel"
  using is_member_refine by (force simp: pw_le_iff pw_nres_rel_iff)

lemmas [sepref_fr_rules] = lso_id_hnr

sepref_definition is_member_impl is
  "uncurry is_member" :: "K\<^sup>k *\<^sub>a (lso_assn K)\<^sup>k \<rightarrow>\<^sub>a bool_assn"
  supply [sepref_fr_rules] = pure_equality_impl
  supply [safe_constraint_rules] = pure_K left_unique_K right_unique_K
  unfolding is_member_def monadic_list_ex_def list_of_set_def[symmetric] by sepref

lemmas op_set_member_lso_hnr = is_member_impl.refine[FCOMP is_member_correct]

end

paragraph \<open>Concrete Implementations\<close>

context Reachability_Impl
begin

definition
  "check_invariant' L' M' \<equiv> do {
  monadic_list_all (\<lambda>l.
  do {
    case op_map_lookup l M' of None \<Rightarrow> RETURN True  | Some xs \<Rightarrow> do {
      let succs = PR_CONST succs l xs;
      monadic_list_all (\<lambda>(l', xs). do {
        xs \<leftarrow> SPEC (\<lambda>xs'. set xs' = xs);
        if xs = [] then RETURN True
        else do {
          case op_map_lookup l' M' of None \<Rightarrow> RETURN False | Some ys \<Rightarrow> do {
            ys \<leftarrow> SPEC (\<lambda>xs.  set xs  = ys);
            monadic_list_all (\<lambda>x'.
              monadic_list_ex (\<lambda>y. RETURN (PR_CONST less_eq x' y)) ys
            ) xs
          }
        }
      }) succs
    }
  }) L'
}"

lemma succs_listD:
  assumes "(l', S') \<in> set (succs l S)" "finite S"
  shows "\<exists> xs. set xs = S'"
  using assms succs_finite by (force intro!: finite_list)

lemma check_invariant'_refine:
  "check_invariant' L_part M \<le> check_invariant L_part" if "L = dom M" "set L_part \<subseteq> L"
  unfolding check_invariant_def check_invariant'_def
  unfolding PR_CONST_def
  apply refine_mono
  apply (clarsimp split: option.splits simp: succs_empty)
  apply refine_mono
  apply (clarsimp split: option.splits)
  apply safe
  subgoal
    by refine_mono (auto simp: bind_RES monadic_list_all_False dest: M_listD)
  subgoal
    apply refine_mono
    apply clarsimp
    apply refine_mono
    apply clarsimp
    subgoal for xs1 xs2
      using monadic_list_all_list_ex_is_RETURN[of "\<lambda> x y. less_eq x y" xs2 xs1]
      by (auto simp: bind_RES \<open>L = dom M\<close>)
    done
  done

lemmas [safe_constraint_rules] = pure_K left_unique_K right_unique_K

lemmas [sepref_fr_rules] = lso_id_hnr

sepref_register
  "PR_CONST L" "list_of_set" "PR_CONST P'" "PR_CONST F" "PR_CONST succs" "PR_CONST less_eq"
  "PR_CONST M" :: "('k, 'b set) i_map"

lemma [sepref_import_param]: "(id, id) \<in> (Id :: (bool \<times> bool) set) \<rightarrow> Id"
  by simp

(*
lemmas [sepref_fr_rules] = M_impl
*)

sepref_definition check_prop_impl_wrong is
  "uncurry check_prop'" :: "(lso_assn K)\<^sup>k *\<^sub>a (hm.hms_assn' K (lso_assn A))\<^sup>k \<rightarrow>\<^sub>a id_assn"
  unfolding check_prop'_alt_def list_of_set_def[symmetric]
  unfolding monadic_list_all_def
  apply sepref_dbg_keep
  oops

sepref_decl_impl "map_lookup":
  copy_list_lso_assn_refine[OF copyi, THEN hms_hm.hms_lookup_hnr]
  uses op_map_lookup.fref[where V = Id] .

abbreviation "table_assn \<equiv> hm.hms_assn' K (lso_assn A)"

sepref_thm check_prop_impl is
  "uncurry (PR_CONST check_prop')" :: "(lso_assn K)\<^sup>k *\<^sub>a table_assn\<^sup>k \<rightarrow>\<^sub>a id_assn"
  unfolding PR_CONST_def
  unfolding check_prop'_def list_of_set_def[symmetric]
  unfolding monadic_list_all_def
  by sepref

concrete_definition (in -) check_prop_impl
  uses Reachability_Impl.check_prop_impl.refine_raw is "(uncurry ?f,_)\<in>_"

sepref_thm check_final_impl is
  "uncurry (PR_CONST check_final')" :: "(lso_assn K)\<^sup>k *\<^sub>a table_assn\<^sup>k \<rightarrow>\<^sub>a id_assn"
  unfolding PR_CONST_def
  unfolding check_final'_def list_of_set_def[symmetric]
  unfolding monadic_list_all_def
  by sepref

concrete_definition (in -) check_final_impl
  uses Reachability_Impl.check_final_impl.refine_raw is "(uncurry ?f,_)\<in>_"

lemma K_equality[sepref_fr_rules]:
  "(uncurry (return oo (=)), uncurry (RETURN oo (=))) \<in> (K\<^sup>k *\<^sub>a K\<^sup>k) \<rightarrow>\<^sub>a bool_assn"
proof -
  have 1: "K = pure (the_pure K)"
    using pure_K by auto
  have [dest]: "a = b" if "(bi, b) \<in> the_pure K" "(bi, a) \<in> the_pure K" for bi a b
    using that right_unique_K by (elim single_valuedD) auto
  have [dest]: "a = b" if "(a, bi) \<in> the_pure K" "(b, bi) \<in> the_pure K" for bi a b
    using that left_unique_K unfolding IS_LEFT_UNIQUE_def by (elim single_valuedD) auto
  show ?thesis
    by (subst 1, subst (2) 1, sepref_to_hoare, sep_auto)
qed

sepref_definition is_K_eq_impl is
  "uncurry (RETURN oo (=))" :: "(K\<^sup>k *\<^sub>a K\<^sup>k) \<rightarrow>\<^sub>a bool_assn"
  unfolding is_member_def monadic_list_ex_def list_of_set_def[symmetric] by sepref

lemmas [sepref_fr_rules] = op_set_member_lso_hnr[OF pure_K left_unique_K right_unique_K]

sepref_definition check_invariant_impl is
  "uncurry (PR_CONST check_invariant')" :: "(list_assn K)\<^sup>k *\<^sub>a table_assn\<^sup>k \<rightarrow>\<^sub>a id_assn"
  unfolding PR_CONST_def
  unfolding check_invariant'_def list_of_set_def[symmetric]
  unfolding monadic_list_all_def monadic_list_ex_def
  by sepref

lemma check_invariant_impl_ht:
  "<table_assn M bi * list_assn K a ai>
    check_invariant_impl ai bi
  <\<lambda>r. table_assn M bi * list_assn K a ai * \<up>(r \<longrightarrow> check_invariant_spec (set a))>\<^sub>t"
  if "nofail (check_invariant' a M)" "L = dom M" "set a \<subseteq> L" "\<forall>l \<in> L. \<forall>s \<in> the (M l). P (l, s)"
  apply (rule cons_post_rule)
   apply (rule check_invariant_impl.refine[
        to_hnr, unfolded hn_refine_def hn_ctxt_def, simplified, rule_format])
  subgoal
    by (rule that)
  using that
  apply sep_auto
   apply (drule order.trans, rule order.trans[OF check_invariant'_refine check_invariant_correct])
  apply (sep_auto simp: pure_def split: option.splits)+
  done

(*
lemma check_invariant'_correct:
  "(uncurry0 check_invariant', uncurry0 (PR_CONST check_invariant)) \<in> Id \<rightarrow> \<langle>bool_rel\<rangle>nres_rel"
  using check_invariant'_refine by (auto simp: pw_le_iff pw_nres_rel_iff)

lemmas check_invariant_impl_refine = check_invariant_impl.refine_raw[FCOMP check_invariant'_correct]

concrete_definition (in -) check_invariant_impl
  uses Reachability_Impl.check_invariant_impl_refine is "(uncurry0 ?f,_)\<in>_"
*)

definition
  "check_all_pre' L' M' \<equiv> do {
  b1 \<leftarrow> RETURN (PR_CONST l\<^sub>0 \<in> L');
  b2 \<leftarrow> RETURN (PR_CONST P' (PR_CONST l\<^sub>0, PR_CONST s\<^sub>0));
  let S = op_map_lookup (PR_CONST l\<^sub>0) M';
  case S of None \<Rightarrow> RETURN False | Some S \<Rightarrow> do {
    xs \<leftarrow> SPEC (\<lambda>xs. set xs = S);
    b3 \<leftarrow> monadic_list_ex (\<lambda>s. RETURN (PR_CONST less_eq (PR_CONST s\<^sub>0) s)) xs;
    b4 \<leftarrow> PR_CONST check_prop' L' M';
    PRINT_CHECK STR ''Start state is in state list'' b1;
    PRINT_CHECK STR ''Start state fulfills property'' b2;
    PRINT_CHECK STR ''Start state is subsumed'' b3;
    PRINT_CHECK STR ''Check property'' b4;
    RETURN (b1 \<and> b2 \<and> b3 \<and> b4)
    }
  }
"

definition
  "check_all' L' M' \<equiv> do {
  b \<leftarrow> check_all_pre' L' M';
  if b
  then do {
    r \<leftarrow> RETURN (check_invariant_spec L');
    PRINT_CHECK STR ''State set invariant check'' r;
    RETURN r
  }
  else RETURN False
  }
"

definition check_init' where
  "check_init' S \<equiv>
  case S of None \<Rightarrow> RETURN False | Some S \<Rightarrow> do {
    xs \<leftarrow> SPEC (\<lambda>xs. set xs = S);
    monadic_list_ex (\<lambda>s. RETURN (PR_CONST less_eq (PR_CONST s\<^sub>0) s)) xs
  }
"

lemma check_all_pre'_refine:
  "check_all_pre' L M \<le> check_all_pre l\<^sub>0 s\<^sub>0"
  unfolding check_all_pre_def check_all_pre'_def PR_CONST_def Let_def
  using check_prop_gt_SUCCEED
  apply (cases "op_map_lookup l\<^sub>0 M"; simp add: bind_RES)
   apply (cases "check_prop P'")
    apply (clarsimp_all intro: less_eq_Sup simp: bind_RES check_prop_alt_def)
  apply (rule less_eq_Sup)
  subgoal for a v
    apply clarsimp
    apply (rule Sup_least)
    apply clarsimp
    supply [refine_mono] = monadic_list_ex_mono monadic_list_ex_RETURN_mono
    apply refine_mono
    apply (simp add: PRINT_CHECK_def)
    done
  subgoal
    by (auto dest: M_listD)
  done

lemma check_all'_refine:
  "check_all' L M \<le> check_all"
  supply [refine_mono] = check_all_pre'_refine
  unfolding check_all_def check_all'_def PRINT_CHECK_def by refine_mono auto

(*
lemma check_all'_correct:
  "(uncurry0 check_all', uncurry0 (PR_CONST check_all)) \<in> Id \<rightarrow> \<langle>bool_rel\<rangle>nres_rel"
  using check_all'_refine by (auto simp: pw_le_iff pw_nres_rel_iff)
*)
term check_invariant'
sepref_register
  "PR_CONST check_invariant'" :: "'k list \<Rightarrow> ('k, 'b set) i_map \<Rightarrow> bool nres"
  "PR_CONST check_all_pre'" :: "'k set \<Rightarrow> ('k, 'b set) i_map \<Rightarrow> bool nres"
  (* check_prop: "PR_CONST (check_prop P')" *)
  "PR_CONST check_prop'" :: "'k set \<Rightarrow> ('k, 'b set) i_map \<Rightarrow> bool nres"
  "PR_CONST check_all'" :: "'k set \<Rightarrow> ('k, 'b set) i_map \<Rightarrow> bool nres"
  "PR_CONST check_final'" :: "'k set \<Rightarrow> ('k, 'b set) i_map \<Rightarrow> bool nres"
  "PR_CONST check_init"
  "PR_CONST l\<^sub>0" "PR_CONST s\<^sub>0"

sepref_definition check_init_impl is
  "check_init'" :: "(option_assn (lso_assn A))\<^sup>d \<rightarrow>\<^sub>a bool_assn"
  unfolding check_init'_def list_of_set_def[symmetric]
  unfolding monadic_list_all_def monadic_list_ex_def
  by sepref

definition
  "L_member L' \<equiv> PR_CONST l\<^sub>0 \<in> L'"

sepref_thm L_member_impl is
  "RETURN o PR_CONST L_member" :: "(lso_assn K)\<^sup>k \<rightarrow>\<^sub>a id_assn"
  unfolding PR_CONST_def unfolding L_member_def by sepref

lemma L_member_fold:
  "PR_CONST l\<^sub>0 \<in> L' \<equiv> PR_CONST L_member L'"
  unfolding L_member_def PR_CONST_def .

(*
lemmas [sepref_fr_rules] =
  check_prop_impl.refine[OF Reachability_Impl_axioms]
  check_invariant_impl.refine[OF Reachability_Impl_axioms]
*)

definition
  "lookup (M' :: 'k \<Rightarrow> 'a set option) = op_map_lookup (PR_CONST l\<^sub>0) M'"

lemma looukp_fold:
  "op_map_lookup (PR_CONST l\<^sub>0) = PR_CONST lookup"
  unfolding lookup_def PR_CONST_def ..

sepref_register L_member lookup :: "('k, 'b set) i_map \<Rightarrow> 'b set option"

definition check2 where
  "check2 b = PR_CONST check_init' (PR_CONST lookup b)"

lemma check2_fold:
  "PR_CONST check_init' (PR_CONST lookup b) = PR_CONST check2 b"
  unfolding check2_def PR_CONST_def ..

sepref_register check2 :: "('k, 'b set) i_map \<Rightarrow> bool nres"

definition check1 where
  "check1 = PR_CONST P' (PR_CONST l\<^sub>0, PR_CONST s\<^sub>0)"

lemma check1_fold:
  "PR_CONST check1 = PR_CONST P' (PR_CONST l\<^sub>0, PR_CONST s\<^sub>0)"
  unfolding check1_def PR_CONST_def ..

sepref_register check1

sepref_thm check1_impl is
  "uncurry0 (RETURN (PR_CONST check1))" :: "id_assn\<^sup>k \<rightarrow>\<^sub>a id_assn"
  unfolding PR_CONST_def unfolding check1_def by sepref

sepref_thm check2_impl is
  "PR_CONST check2" :: "table_assn\<^sup>k \<rightarrow>\<^sub>a id_assn"
  unfolding PR_CONST_def
  unfolding check2_def
  unfolding PR_CONST_def
  unfolding check_init'_def lookup_def
  unfolding list_of_set_def[symmetric]
  unfolding monadic_list_all_def monadic_list_ex_def
  by sepref

lemmas [sepref_fr_rules] =
  L_member_impl.refine_raw
  check1_impl.refine_raw
  check2_impl.refine_raw
  check_prop_impl.refine_raw
  (* check_invariant_impl.refine_raw *)

context
  fixes splitter :: "'k list \<Rightarrow> 'k list list" and splitteri :: "'ki list \<Rightarrow> 'ki list list"
  (* assumes full_split: "set xs = (\<Union>xs \<in> set (splitteri xs). set xs)" *)
  assumes full_split: "set xs = (\<Union>xs \<in> set (splitter xs). set xs)"
(*
      and same_split:
      "(return o splitteri, RETURN o splitter) \<in> (list_assn K)\<^sup>k \<rightarrow>\<^sub>a list_assn (list_assn K)"
*)
  and same_split:
    "\<And>L Li. list_assn (list_assn K) (splitter L) (splitteri Li) = list_assn K L Li"
begin

definition
  "check_invariant_all_impl L' M' \<equiv> do {
    bs \<leftarrow> parallel_fold_map (\<lambda>L. check_invariant_impl L M') (splitteri L');
    return (list_all id bs)
  }"

definition
  "split_spec \<equiv> \<lambda>L M. RETURN (list_all (\<lambda>x. RETURN True \<le> check_invariant' x M) (splitter L))"

lemma check_invariant_all_impl_refine:
  "(uncurry check_invariant_all_impl, uncurry (PR_CONST split_spec))
  \<in> (list_assn K)\<^sup>k *\<^sub>a table_assn\<^sup>k \<rightarrow>\<^sub>a bool_assn"
  unfolding split_spec_def PR_CONST_def
  apply sepref_to_hoare
  apply sep_auto
  subgoal for M Mi L Li
  unfolding check_invariant_all_impl_def parallel_fold_map_def
  apply sep_auto
   apply (rule Hoare_Triple.cons_pre_rule[rotated])
    apply (rule fold_map_ht2[
        where Q = "\<lambda>L r. RETURN r \<le> check_invariant' L M"
          and R = "list_assn K" and A = "table_assn M Mi" and xs = "splitter L"
          ])
    apply (rule Hoare_Triple.cons_post_rule)
(* find_theorems intro does not find it *)
  apply (rule frame_rule)
     apply (rule check_invariant_impl.refine[to_hnr, unfolded hn_refine_def hn_ctxt_def, simplified, rule_format])
  subgoal
    unfolding check_invariant'_def
    apply (intro monadic_list_all_nofailI)
    apply (clarsimp split: option.splits)
    apply (intro monadic_list_all_nofailI)
    apply (clarsimp split: prod.splits)
    apply (rule no_fail_RES_bindI)
     apply (clarsimp split: option.splits)
     apply (rule no_fail_RES_bindI)
apply (intro monadic_list_all_nofailI monadic_list_ex_nofailI)
      apply auto
(* missing finiteness of table *)
    sorry
    apply (sep_auto simp: pure_def; fail)
  subgoal
    unfolding same_split by solve_entails
  apply sep_auto
  subgoal
    unfolding list_all_length list_all2_conv_all_nth by auto
  subgoal for x
    unfolding list_all_length
    unfolding list_all2_conv_all_nth
    apply auto
    apply (elim allE impE)
       apply assumption+
    subgoal for n
      apply (cases "x ! n")
       apply auto
      sorry
    done
  subgoal
    unfolding same_split by solve_entails
  done
  done

sepref_definition check_all_pre_impl is
  "uncurry (PR_CONST check_all_pre')" :: "(lso_assn K)\<^sup>k *\<^sub>a table_assn\<^sup>k \<rightarrow>\<^sub>a id_assn"
  unfolding PR_CONST_def
  unfolding check_all_pre'_def list_of_set_def[symmetric]
  unfolding monadic_list_all_def monadic_list_ex_def
  by sepref

lemma check_all_pre_impl_ht:
  "<table_assn b bi * lso_assn K a ai>
    check_all_pre_impl ai bi
   <\<lambda>r. table_assn b bi * lso_assn K a ai * \<up> (RETURN r \<le> check_all_pre' a b)>\<^sub>t"
  if "nofail (check_all_pre' a b)"
  apply (rule cons_post_rule)
   apply (rule check_all_pre_impl.refine[to_hnr, unfolded hn_refine_def hn_ctxt_def, simplified, rule_format])
  subgoal
    by (rule that)
  apply (sep_auto simp: pure_def)
  done

definition
  "check_all'' L' M' \<equiv> do {
  b \<leftarrow> PR_CONST check_all_pre' L' M';
  if b
  then do {
    xs \<leftarrow> SPEC (\<lambda>xs. set xs = L');
    r \<leftarrow> PR_CONST split_spec xs M';
    PRINT_CHECK STR ''State set invariant check'' r;
    RETURN r
  }
  else RETURN False
  }
"

sepref_register split_spec :: "'k list \<Rightarrow> (('k, 'b set) i_map) \<Rightarrow> bool nres"

lemmas [sepref_fr_rules] =
  check_all_pre_impl.refine_raw
  check_invariant_all_impl_refine

sepref_thm check_all_impl is
  "uncurry (PR_CONST check_all'')" :: "(lso_assn K)\<^sup>k *\<^sub>a table_assn\<^sup>k \<rightarrow>\<^sub>a id_assn"
  unfolding PR_CONST_def
  unfolding check_all''_def list_of_set_def[symmetric]
  by sepref

lemma [refine_mono]:
  "split_spec L' M \<le> RETURN (check_invariant_spec (set L'))" if "dom M = L" "set L' \<subseteq> L"
  sorry

lemma check_all''_refine:
  "check_all'' L' M \<le> check_all' L' M" if "dom M = L" "L' \<subseteq> L"
  using that
  unfolding check_all''_def check_all'_def PR_CONST_def
  apply refine_mono
  sorry

sepref_thm check_all_impl is
  "uncurry (PR_CONST check_all')" :: "(lso_assn K)\<^sup>k *\<^sub>a table_assn\<^sup>k \<rightarrow>\<^sub>a id_assn"
  unfolding PR_CONST_def
  unfolding check_all'_def list_of_set_def[symmetric]
  unfolding monadic_list_all_def monadic_list_ex_def
  oops

sepref_thm check_all_impl is
  "uncurry (PR_CONST check_all')" :: "(lso_assn K)\<^sup>k *\<^sub>a table_assn\<^sup>k \<rightarrow>\<^sub>a id_assn"
  unfolding PR_CONST_def
  unfolding check_all'_def check_all_pre'_def list_of_set_def[symmetric]
  unfolding monadic_list_all_def monadic_list_ex_def
  oops

(*
lemmas check_all_impl_refine = check_all_impl.refine_raw[FCOMP check_all'_correct]
*)

(*
concrete_definition (in -) check_all_impl
  uses Reachability_Impl.check_all_impl_refine is "(uncurry0 ?f,_)\<in>_"
*)

(*
thm check_all_impl.refine

lemmas [sepref_fr_rules] =
  check_final_impl.refine[OF Reachability_Impl_axioms]
  check_all_impl.refine[OF Reachability_Impl_axioms]
*)

lemma certify_unreachable_alt_def:
  "certify_unreachable \<equiv> do {
  b1 \<leftarrow> PR_CONST check_all;
  b2 \<leftarrow> PR_CONST check_final;
  RETURN (b1 \<and> b2)
  }"
  unfolding certify_unreachable_def PR_CONST_def .

definition certify_unreachable' where
  "certify_unreachable' L' M' \<equiv> do {
  START_TIMER ();
  b1 \<leftarrow> PR_CONST check_all'' L' M';
  SAVE_TIME STR ''Time for state space invariant check'';
  START_TIMER ();
  b2 \<leftarrow> PR_CONST check_final' L' M';
  SAVE_TIME STR ''Time to check final state predicate'';
  PRINT_CHECK STR ''All check: '' b1;
  PRINT_CHECK STR ''Target property check: '' b2;
  RETURN (b1 \<and> b2)
  }"

lemma certify_unreachable'_refine:
  "certify_unreachable' L M \<le> certify_unreachable" if "L = dom M"
  supply [refine_mono] =
    order.trans[OF check_all''_refine[OF that[symmetric] subset_refl] check_all'_refine]
  unfolding certify_unreachable'_def certify_unreachable_def PR_CONST_def check_final_alt_def
  unfolding PRINT_CHECK_def START_TIMER_def SAVE_TIME_def
  by simp refine_mono

sepref_register
  "PR_CONST check_all''" :: "'k set \<Rightarrow> (('k, 'b set) i_map) \<Rightarrow> bool nres"
  "PR_CONST check_final"

lemmas [sepref_fr_rules] =
  check_all_impl.refine_raw
  check_final_impl.refine_raw

sepref_thm certify_unreachable_impl' is
  "uncurry (PR_CONST certify_unreachable')" :: "(lso_assn K)\<^sup>k *\<^sub>a table_assn\<^sup>k \<rightarrow>\<^sub>a id_assn"
  unfolding PR_CONST_def unfolding certify_unreachable'_def
  by sepref

lemma certify_unreachable_correct':
  "(uncurry0 (certify_unreachable' L M), uncurry0 (SPEC (\<lambda>r. r \<longrightarrow> (\<nexists>s'. E\<^sup>*\<^sup>* (l\<^sub>0, s\<^sub>0) s' \<and> F s'))))
    \<in> Id \<rightarrow> \<langle>bool_rel\<rangle>nres_rel" if "L = dom M"
  using certify_unreachable_correct' certify_unreachable'_refine[OF that]
  by (clarsimp simp: pw_le_iff pw_nres_rel_iff) fast

lemmas certify_unreachable_impl'_refine =
  certify_unreachable_impl'.refine_raw[
    unfolded is_member_impl_def[OF pure_K left_unique_K right_unique_K]
      check_invariant_all_impl_def check_invariant_impl_def
  ]

definition certify_unreachable_new where
  "certify_unreachable_new L_list M_table \<equiv> let
  _ = start_timer ();
  b1 = run_heap (do {M' \<leftarrow> M_table; check_all_pre_impl L_list M'});
  _ = save_time STR ''Time for checking basic preconditions'';
  _ = start_timer ();
  xs = run_map_heap (\<lambda>Li. do {M' \<leftarrow> M_table; check_invariant_impl Li M'}) (splitteri L_list);
  b2 = list_all id xs;
  _ = save_time STR ''Time for state space invariant check'';
  _ = print_check STR ''State set invariant check'' b2;
  _ = start_timer ();
  b3 = run_heap (do {M' \<leftarrow> M_table; check_final_impl Fi copyi L_list M'});
  _ = save_time STR ''Time to check final state predicate'';
  _ = print_check STR ''All check: '' (b1 \<and> b2);
  _ = print_check STR ''Target property check: '' b3
  in b1 \<and> b2 \<and> b3"

lemmas certify_unreachable_new_alt_def =
  certify_unreachable_new_def[unfolded
    check_invariant_impl_def
    check_all_pre_impl_def
    is_member_impl_def[OF pure_K left_unique_K right_unique_K]
    ]

end (* Splitter *)

concrete_definition (in -) check_all_impl
  uses Reachability_Impl.check_all_impl.refine_raw is "(uncurry ?f,_)\<in>_"

concrete_definition (in -) certify_unreachable_impl_inner
  uses Reachability_Impl.certify_unreachable_impl'_refine is "(uncurry ?f,_)\<in>_"

lemmas certify_unreachable'_impl_hnr =
  certify_unreachable_impl_inner.refine[OF Reachability_Impl_axioms]

(* lemmas certify_unreachable_impl_refine =
  certify_unreachable_impl.refine_raw[
    unfolded PR_CONST_def is_member_impl_def[OF pure_K left_unique_K right_unique_K]
  ]

concrete_definition (in -) certify_unreachable_impl
  uses Reachability_Impl.certify_unreachable_impl_refine is "(uncurry ?f,_)\<in>_"
 *)

concrete_definition (in -) certify_unreachable_impl2
  uses Reachability_Impl.certify_unreachable_new_alt_def

context
  fixes L_list and M_table
  assumes L_impl[sepref_fr_rules]:
    "(uncurry0 (return L_list), uncurry0 (RETURN (PR_CONST L))) \<in> id_assn\<^sup>k \<rightarrow>\<^sub>a lso_assn K"
  assumes M_impl[sepref_fr_rules]:
    "(uncurry0 M_table, uncurry0 (RETURN (PR_CONST M))) \<in> id_assn\<^sup>k \<rightarrow>\<^sub>a hm.hms_assn' K (lso_assn A)"
  fixes splitter :: "'k list \<Rightarrow> 'k list list" and splitteri :: "'ki list \<Rightarrow> 'ki list list"
  assumes full_split: "set xs = (\<Union>xs \<in> set (splitter xs). set xs)"
      and same_split:
    "\<And>L Li. list_assn (list_assn K) (splitter L) (splitteri Li) = list_assn K L Li"
begin

lemmas [sepref_fr_rules] = certify_unreachable'_impl_hnr[OF full_split same_split]

sepref_register
  "certify_unreachable' splitter" :: "'k set \<Rightarrow> ('k, 'b set) i_map \<Rightarrow> bool nres"

sepref_thm certify_unreachable_impl is
  "uncurry0 (PR_CONST (certify_unreachable' splitter) (PR_CONST L) (PR_CONST M))"
  :: "id_assn\<^sup>k \<rightarrow>\<^sub>a id_assn"
  by sepref_dbg_keep

lemmas certify_unreachable_impl_refine =
  certify_unreachable_impl.refine_raw[
    unfolded PR_CONST_def is_member_impl_def[OF pure_K left_unique_K right_unique_K],
    FCOMP certify_unreachable_correct'[OF full_split same_split]
  ]

lemma certify_unreachable_new_correct:
  assumes "dom M = L"
  shows "certify_unreachable_new splitteri L_list M_table \<longrightarrow> (\<nexists>s'. E\<^sup>*\<^sup>* (l\<^sub>0, s\<^sub>0) s' \<and> F s')"
proof -
  have [sep_heap_rules]: "<emp> M_table <\<lambda>r. hm.hms_assn' K (lso_assn A) M r>\<^sub>t"
    by (sep_auto simp: pure_def heap: M_impl[to_hnr, unfolded hn_refine_def, simplified])
  have true_emp: "true = emp * true"
    by simp
  have *: "emp \<Longrightarrow>\<^sub>A lso_assn K L L_list * true"
    using L_impl[to_hnr, unfolded hn_refine_def, simplified]
    apply -
    apply (drule return_htD)
    apply (erule ent_trans)
    apply (sep_auto simp: pure_def)
    done
  then have *: "true \<Longrightarrow>\<^sub>A lso_assn K L L_list * true"
    by (subst true_emp) (erule ent_true_drop)
  have check_all_pre'_refine: "check_all_pre' L M \<le> RETURN (check_all_pre_spec l\<^sub>0 s\<^sub>0)"
    by (blast intro: check_all_pre_correct check_all_pre'_refine order.trans)
  have list_assn_K_eq: "list_assn K = pure (\<langle>the_pure K\<rangle>list_rel)"
    using pure_K by (simp add: list_assn_pure_conv[symmetric])
  have 1: "
    <emp>
      do {M' \<leftarrow> M_table; check_all_pre_impl L_list M'}
    <\<lambda>r. \<up> (r \<longrightarrow> check_all_pre_spec l\<^sub>0 s\<^sub>0)>\<^sub>t"
    apply sep_auto
    subgoal for Mi
      apply (rule cons_rule[rotated 2])
        apply (rule frame_rule[where R = true])
        apply (rule check_all_pre_impl_ht[OF full_split same_split, where a = L and b = M])
      subgoal
        using check_all_pre'_refine unfolding RETURN_def by (rule le_RES_nofailI)
      subgoal
        using * by (elim ent_frame_fwd) solve_entails+
      subgoal
        apply sep_auto
        apply (drule order.trans, rule check_all_pre'_refine)
        apply auto
        done
      done
    done
  have 3: "
    <emp>
      do {M' \<leftarrow> M_table; check_final_impl Fi copyi L_list M'}
    <\<lambda>r. \<up>(r \<longrightarrow> check_final_spec)>\<^sub>t"
    apply (sep_auto)
    subgoal for Mi
      apply (rule cons_rule[rotated 2])
        apply (rule frame_rule[where R = true])
        apply (rule check_final_impl.refine[
            OF Reachability_Impl_axioms, to_hnr, unfolded hn_refine_def hn_ctxt_def, simplified,
            rule_format, where a = L and b = M])
      subgoal
        sorry
      subgoal
        using * by (elim ent_frame_fwd) solve_entails+
      subgoal
        apply sep_auto
        unfolding check_final_alt_def
        apply (drule order.trans, rule check_final_correct)
        apply (sep_auto simp: pure_def)
        done
      done
    done
  have 2: "
    <emp>
      do {M' \<leftarrow> M_table; check_invariant_impl Li M'}
   <\<lambda>r. \<up>(r \<longrightarrow> check_invariant_spec (set L'))>\<^sub>t
  " if
    "\<forall>l\<in>L. \<forall>s\<in>the (M l). P (l, s)"
    "Li \<in> set (splitteri L_list)" "(Li, L') \<in> \<langle>(the_pure K)\<rangle>list_rel" "set L' \<subseteq> L"
  for Li L'
    apply sep_auto
    subgoal for Mi
      apply (rule cons_rule[rotated 2])
        apply (rule frame_rule[where R = true])
        apply (rule check_invariant_impl_ht[where bi = Mi and a = L'])
      subgoal
        sorry
      subgoal
        using \<open>dom M = L\<close> ..
      subgoal
        by (rule that)
      subgoal
        by (rule that(1))
      subgoal
        using that(3) unfolding list_assn_K_eq pure_def by sep_auto
      subgoal
        by sep_auto
      done
    done
  obtain LL where "set LL = L"
    using L_finite L_listD by blast
  have 2:
    "check_invariant_spec L"
    if "check_all_pre_spec l\<^sub>0 s\<^sub>0"
      "list_all id
     (run_map_heap (\<lambda>Li. M_table \<bind> check_invariant_impl Li)
       (splitteri L_list))"
  proof -
    let ?c = "(\<lambda>Li. M_table \<bind> check_invariant_impl Li)"
    have A: "\<forall>l\<in>L. \<forall>s\<in>the (M l). P (l, s)"
      using \<open>check_all_pre_spec l\<^sub>0 s\<^sub>0\<close> \<open>dom M = L\<close>
      unfolding check_all_pre_spec_def by (force intro: P'_P)
    have
      "list_all2 (\<lambda>L' r. r \<longrightarrow> check_invariant_spec (set L'))
        (splitter LL) (run_map_heap ?c (splitteri L_list))"
      apply (rule hoare_triple_run_map_heapD')
      subgoal
        apply (rule list_all2_all_nthI)
        subgoal B
          sorry
        apply (rule 2[OF A])
        using B apply simp
        subgoal for n
          sorry
        subgoal for n
          unfolding \<open>set LL = L\<close>[symmetric] by (subst (2) full_split) force
        done
      done
    then have "list_all (\<lambda>L'. check_invariant_spec (set L')) (splitter LL)"
      sorry
    with full_split[of LL] show ?thesis
      unfolding list_all_iff check_invariant_spec_def \<open>set LL = L\<close> by auto
  qed
  show ?thesis
    apply standard
    apply (rule certify_unreachableI[rule_format])
    using hoare_triple_run_heapD[OF 1] hoare_triple_run_heapD[OF 3]
    unfolding certify_unreachable_new_def[OF full_split same_split] check_all_spec_def
    by (auto intro: 2)
qed

lemmas certify_unreachable_impl2_refine =
  certify_unreachable_new_correct[
    unfolded certify_unreachable_impl2.refine[OF Reachability_Impl_axioms full_split same_split]
    ]

end

concrete_definition (in -) certify_unreachable_impl
  uses Reachability_Impl.certify_unreachable_impl_refine is "(uncurry0 ?f,_)\<in>_"

(*
lemmas certify_unreachable_impl_refine =
  certify_unreachable_impl.refine_raw[FCOMP certify_unreachable_correct']
*)

(*
concrete_definition (in -) certify_unreachable_impl
  uses Reachability_Impl.certify_unreachable_impl is "(uncurry0 ?f,_)\<in>_"
*)

paragraph \<open>Debugging\<close>

definition (in -)
  "mk_st_string s1 s2 \<equiv> STR ''<'' + s1 + STR '', '' + s2 + STR ''>''"

(* XXX Error: 'Tactic failed' inside context *)
lemma [sepref_import_param]: "(mk_st_string, mk_st_string) \<in> Id \<rightarrow> Id \<rightarrow> Id"
  by simp

definition (in -)
  "PRINTLN = RETURN o println"

lemma (in -) [sepref_import_param]:
  "(println, println) \<in> Id \<rightarrow> Id"
  by simp

sepref_definition (in -) print_line_impl is
  "PRINTLN" :: " id_assn\<^sup>k \<rightarrow>\<^sub>a id_assn"
  unfolding PRINTLN_def by sepref

sepref_register (in -) PRINTLN

lemmas [sepref_fr_rules] = print_line_impl.refine

context
  fixes show_loc :: "'k \<Rightarrow> String.literal nres" and show_dbm :: "'a \<Rightarrow> String.literal nres"
    and show_dbm_impl and show_loc_impl
  assumes show_dbm_impl: "(show_dbm_impl, show_dbm) \<in> A\<^sup>d \<rightarrow>\<^sub>a id_assn"
  assumes show_loc_impl: "(show_loc_impl, show_loc) \<in> K\<^sup>d \<rightarrow>\<^sub>a id_assn"
begin

lemma [sepref_fr_rules]: "(show_dbm_impl, PR_CONST show_dbm) \<in> A\<^sup>d \<rightarrow>\<^sub>a id_assn"
  using show_dbm_impl unfolding PR_CONST_def .

lemma [sepref_fr_rules]: "(show_loc_impl, PR_CONST show_loc) \<in> K\<^sup>d \<rightarrow>\<^sub>a id_assn"
  using show_loc_impl unfolding PR_CONST_def .

definition
  "show_st \<equiv> \<lambda> (l, M).  do {
    s1 \<leftarrow> PR_CONST show_loc l;
    s2 \<leftarrow> PR_CONST show_dbm M;
    RETURN (mk_st_string s1 s2)
  }"

sepref_register "PR_CONST show_st" "PR_CONST show_loc" "PR_CONST show_dbm"

sepref_thm show_st_impl is
  "PR_CONST show_st" :: "(K \<times>\<^sub>a A)\<^sup>d \<rightarrow>\<^sub>a id_assn"
  unfolding PR_CONST_def unfolding show_st_def by sepref

lemmas [sepref_fr_rules] = show_st_impl.refine_raw

definition check_prop_fail where
  "check_prop_fail L' M' = do {
  l \<leftarrow> SPEC (\<lambda>xs. set xs = L');
  r \<leftarrow> monadic_list_all_fail' (\<lambda>l. do {
    let S = op_map_lookup l M';
    case S of None \<Rightarrow> RETURN None | Some S \<Rightarrow> do {
      xs \<leftarrow> SPEC (\<lambda>xs. set xs = S);
      r \<leftarrow> monadic_list_all_fail (\<lambda>s.
        RETURN (PR_CONST P' (l, s))
      ) xs;
      RETURN (case r of None \<Rightarrow> None | Some r \<Rightarrow> Some (l, r))

       \<^cancel>\<open>case r of None \<Rightarrow> RETURN None | Some r \<Rightarrow> RETURN (Some (l, r))\<close>
    }
    }
  ) l;
  case r of None \<Rightarrow> RETURN None |
    Some (l, M) \<Rightarrow> do {
    s \<leftarrow> PR_CONST show_st (l, COPY M);
    PRINTLN (STR ''Prop failed for: '');
    PRINTLN s;
    RETURN (Some (l, M))
  }
  }"

sepref_thm check_prop_fail_impl is
  "uncurry check_prop_fail" :: "(lso_assn K)\<^sup>k *\<^sub>a table_assn\<^sup>d \<rightarrow>\<^sub>a option_assn (K \<times>\<^sub>a A)"
  unfolding check_prop_fail_def list_of_set_def[symmetric]
  unfolding monadic_list_all_fail'_alt_def monadic_list_all_fail_alt_def
  by sepref

end (* Anonymous context *)

definition
  "check_invariant_fail L' M' \<equiv> do {
  l \<leftarrow> SPEC (\<lambda>xs. set xs = L');
  monadic_list_all_fail' (\<lambda>l.
  do {
    case op_map_lookup l M' of None \<Rightarrow> RETURN None  | Some as \<Rightarrow> do {
    let succs = PR_CONST succs l as;
    monadic_list_all_fail' (\<lambda>(l', xs). do {
      xs \<leftarrow> SPEC (\<lambda>xs'. set xs' = xs);
      if xs = [] then RETURN None
      else do {
        b1 \<leftarrow> RETURN (l' \<in> L'); \<comment> \<open>XXX Optimize this\<close>
        if b1 then do {
        case op_map_lookup l' M' of None \<Rightarrow> RETURN (Some (Inl (Inr (l, l', xs)))) | Some ys \<Rightarrow> do {
          ys \<leftarrow> SPEC (\<lambda>xs.  set xs  = ys);
          b2 \<leftarrow> monadic_list_all_fail (\<lambda>x'.
            monadic_list_ex (\<lambda>y. RETURN (PR_CONST less_eq x' y)) ys
          ) xs;
          case b2 of None \<Rightarrow> RETURN None | Some M \<Rightarrow> do {
            case op_map_lookup l M' of
              None \<Rightarrow> RETURN (Some (Inl (Inr (l, l', ys)))) \<comment> \<open>never used\<close>
            | Some as \<Rightarrow> do {
                as \<leftarrow> SPEC (\<lambda>xs'. set xs' = as);
                RETURN (Some (Inr (l, as, l', M, ys)))}
              }
          }
      }
      else RETURN (Some (Inl (Inl (l, l', xs))))
    }
    }) succs
  }
  }
  ) l
}"

sepref_thm check_invariant_fail_impl is
  "uncurry check_invariant_fail"
  :: "(lso_assn K)\<^sup>k *\<^sub>a table_assn\<^sup>k \<rightarrow>\<^sub>a
      option_assn ((K \<times>\<^sub>a K \<times>\<^sub>a list_assn A +\<^sub>a K \<times>\<^sub>a K \<times>\<^sub>a list_assn A) +\<^sub>a K \<times>\<^sub>a list_assn A \<times>\<^sub>a K \<times>\<^sub>a A \<times>\<^sub>a list_assn A)"
  unfolding PR_CONST_def
  unfolding check_invariant_fail_def list_of_set_def[symmetric]
  unfolding monadic_list_all_fail'_alt_def monadic_list_all_fail_alt_def
  unfolding monadic_list_all_def monadic_list_ex_def
  by sepref

lemmas check_invariant_fail_impl_refine = check_invariant_fail_impl.refine_raw[
  unfolded is_member_impl_def[OF pure_K left_unique_K right_unique_K]
]

end (* Reachability Impl *)

concrete_definition (in -) check_prop_fail_impl
  uses Reachability_Impl.check_prop_fail_impl.refine_raw is "(uncurry ?f,_)\<in>_"

concrete_definition (in -) check_invariant_fail_impl
  uses Reachability_Impl.check_invariant_fail_impl_refine is "(uncurry ?f,_)\<in>_"

export_code
  certify_unreachable_impl certify_unreachable_impl2 check_prop_fail_impl check_invariant_fail_impl
in SML module_name Test

end (* Theory *)


(*  Title:      HOL/Auth/n_mutualExAbs1_base.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
*)

theory n_mutualExAbs1_base1 imports paraTheory
begin

section{*Main definitions*}

subsection{* Definitions of Constants*}
definition I::"scalrValueType" where [simp]: "I\<equiv> enum ''control'' ''I''"
definition T::"scalrValueType" where [simp]: "T\<equiv> enum ''control'' ''T''"
definition C::"scalrValueType" where [simp]: "C\<equiv> enum ''control'' ''C''"
definition E::"scalrValueType" where [simp]: "E\<equiv> enum ''control'' ''E''"
definition true::"scalrValueType" where [simp]: "true\<equiv> boolV True"
definition false::"scalrValueType" where [simp]: "false\<equiv> boolV False"

subsection{*  Definitions of Parameterized Rules *}

definition n_Try::"nat \<Rightarrow> rule" where [simp]:
"n_Try  i\<equiv>
let g = (eqn (IVar (Field (Para (Ident ''n'') i) ''st'')) (Const I)) in
let s = (parallelList [(assign ((Field (Para (Ident ''n'') i) ''st''), (Const T)))]) in
guard g s"

definition n_Crit::"nat \<Rightarrow> rule" where [simp]:
"n_Crit  i\<equiv>
let g = (andForm (eqn (IVar (Field (Para (Ident ''n'') i) ''st'')) (Const T)) (eqn (IVar (Ident ''x'')) (Const true))) in
let s = (parallelList [(assign ((Field (Para (Ident ''n'') i) ''st''), (Const C))), (assign ((Ident ''x''), (Const false))), (assign ((Field (Para (Ident ''n'') i) ''data''), (IVar (Ident ''memDATA''))))]) in
guard g s"

definition n_Exit::"nat \<Rightarrow> rule" where [simp]:
"n_Exit  i\<equiv>
let g = (eqn (IVar (Field (Para (Ident ''n'') i) ''st'')) (Const C)) in
let s = (parallelList [(assign ((Field (Para (Ident ''n'') i) ''st''), (Const E)))]) in
guard g s"

definition n_Idle::"nat \<Rightarrow> rule" where [simp]:
"n_Idle  i\<equiv>
let g = (eqn (IVar (Field (Para (Ident ''n'') i) ''st'')) (Const E)) in
let s = (parallelList [(assign ((Field (Para (Ident ''n'') i) ''st''), (Const I))), (assign ((Ident ''x''), (Const true))), (assign ((Ident ''memDATA''), (IVar (Field (Para (Ident ''n'') i) ''data''))))]) in
guard g s"

definition n_Store::"nat \<Rightarrow> nat \<Rightarrow> rule" where [simp]:
"n_Store  i data\<equiv>
let g = (eqn (IVar (Field (Para (Ident ''n'') i) ''st'')) (Const C)) in
let s = (parallelList [(assign ((Field (Para (Ident ''n'') i) ''st''), (Const C))), (assign ((Ident ''x''), (Const false))), (assign ((Ident ''auxDATA''), (Const (index data)))), (assign ((Field (Para (Ident ''n'') i) ''data''), (Const (index data))))]) in
guard g s"

definition n_ABS_Store::"nat \<Rightarrow> nat \<Rightarrow> rule" where [simp]:
"n_ABS_Store N data\<equiv>
let g = (forallForm (down N) (\<lambda>j. (andForm (neg (eqn (IVar (Field (Para (Ident ''n'') j) ''st'')) (Const C))) (neg (eqn (IVar (Field (Para (Ident ''n'') j) ''st'')) (Const E)))))) in
let s = (parallelList [(assign ((Ident ''x''), (Const false))), (assign ((Ident ''auxDATA''), (Const (index data))))]) in
guard g s"

definition n_ABS_Crit::"rule" where [simp]:
"n_ABS_Crit  \<equiv>
let g = (eqn (IVar (Ident ''x'')) (Const true)) in
let s = (parallelList [(assign ((Ident ''x''), (Const false)))]) in
guard g s"

definition n_ABS_Idle::"nat \<Rightarrow> rule" where [simp]:
"n_ABS_Idle N \<equiv>
let g = (forallForm (down N) (\<lambda>j. (andForm (neg (eqn (IVar (Field (Para (Ident ''n'') j) ''st'')) (Const C))) (neg (eqn (IVar (Field (Para (Ident ''n'') j) ''st'')) (Const E)))))) in
let s = (parallelList [(assign ((Ident ''x''), (Const true))), (assign ((Ident ''memDATA''), (IVar (Ident ''auxDATA''))))]) in
guard g s"

subsection{*The set of All actual Rules w.r.t. a Protocol Instance with Size $N$*}
definition rules::"nat \<Rightarrow> rule set" where [simp]:
"rules N \<equiv> {r.
(\<exists> i. i\<le>N\<and>r=n_Try  i) \<or>
(\<exists> i. i\<le>N\<and>r=n_Crit  i) \<or>
(\<exists> i. i\<le>N\<and>r=n_Exit  i) \<or>
(\<exists> i. i\<le>N\<and>r=n_Idle  i)
}"

definition  NC::"nat " where [simp]: "NC==1"

definition rulesAbs::"nat \<Rightarrow> rule set" where [simp]:
"rulesAbs  N\<equiv> {r.
(\<exists> i. i\<le>NC\<and>r=n_Crit  i) \<or>
(\<exists> i. i\<le>NC\<and>r=n_Exit  i) \<or>
(\<exists> i. i\<le>NC\<and>r=n_Idle  i) \<or>
(\<exists> i. i\<le>NC\<and>r=n_Try  i) \<or>
(\<exists> i data. i\<le>NC\<and>data\<le>N\<and>r=n_Store  i data) \<or>
(\<exists> data. data\<le>N\<and>r=n_ABS_Store NC data) \<or>
(r=n_ABS_Crit  ) \<or>
(r=n_ABS_Idle NC )
}"

subsection{*Definitions of a Formally Parameterized Invariant Formulas*}

subsection{*Definitions of  the Set of Invariant Formula Instances in a $N$-protocol Instance*}
definition inv__1::"nat \<Rightarrow> nat \<Rightarrow> formula" where [simp]:
"inv__1 p__Inv0 p__Inv1 \<equiv>
(neg (andForm (eqn (IVar (Field (Para (Ident ''n'') p__Inv0) ''st'')) (Const C)) (eqn (IVar (Field (Para (Ident ''n'') p__Inv1) ''st'')) (Const C))))"

definition inv__2::"nat \<Rightarrow> formula" where [simp]:
"inv__2 p__Inv0 \<equiv>
(neg (andForm (eqn (IVar (Field (Para (Ident ''n'') p__Inv0) ''st'')) (Const C)) (neg (eqn (IVar (Field (Para (Ident ''n'') p__Inv0) ''data'')) (IVar (Ident ''auxDATA''))))))"

definition inv__3::"nat \<Rightarrow> formula" where [simp]:
"inv__3 p__Inv0 \<equiv>
(neg (andForm (eqn (IVar (Field (Para (Ident ''n'') p__Inv0) ''st'')) (Const E)) (neg (eqn (IVar (Field (Para (Ident ''n'') p__Inv0) ''data'')) (IVar (Ident ''auxDATA''))))))"

definition inv__4::"nat \<Rightarrow> nat \<Rightarrow> formula" where [simp]:
"inv__4 p__Inv0 p__Inv1 \<equiv>
(neg (andForm (eqn (IVar (Field (Para (Ident ''n'') p__Inv0) ''st'')) (Const C)) (eqn (IVar (Field (Para (Ident ''n'') p__Inv1) ''st'')) (Const E))))"

definition inv__5::"nat \<Rightarrow> nat \<Rightarrow> formula" where [simp]:
"inv__5 p__Inv0 p__Inv1 \<equiv>
(neg (andForm (eqn (IVar (Field (Para (Ident ''n'') p__Inv0) ''st'')) (Const E)) (eqn (IVar (Field (Para (Ident ''n'') p__Inv1) ''st'')) (Const E))))"

definition inv__6::"nat \<Rightarrow> nat \<Rightarrow> formula" where [simp]:
"inv__6 p__Inv0 p__Inv1 \<equiv>
(neg (andForm (eqn (IVar (Field (Para (Ident ''n'') p__Inv0) ''st'')) (Const E)) (eqn (IVar (Field (Para (Ident ''n'') p__Inv1) ''st'')) (Const C))))"

definition inv__7::"formula" where [simp]:
"inv__7  \<equiv>
(neg (andForm (eqn (IVar (Ident ''x'')) (Const true)) (neg (eqn (IVar (Ident ''memDATA'')) (IVar (Ident ''auxDATA''))))))"

definition inv__8::"nat \<Rightarrow> formula" where [simp]:
"inv__8 p__Inv0 \<equiv>
(neg (andForm (eqn (IVar (Field (Para (Ident ''n'') p__Inv0) ''st'')) (Const C)) (eqn (IVar (Ident ''x'')) (Const true))))"

definition inv__9::"nat \<Rightarrow> formula" where [simp]:
"inv__9 p__Inv0 \<equiv>
(neg (andForm (eqn (IVar (Field (Para (Ident ''n'') p__Inv0) ''st'')) (Const E)) (eqn (IVar (Ident ''x'')) (Const true))))"

subsection{*Definitions of  the Set of Invariant Formula Instances in a $N$-protocol Instance*}
definition invariants::"nat \<Rightarrow> formula set" where [simp]:
"invariants N \<equiv> {f.
(\<exists> p__Inv0 p__Inv1. p__Inv0\<le>N\<and>p__Inv1\<le>N\<and>p__Inv0~=p__Inv1\<and>f=inv__1  p__Inv0 p__Inv1) \<or>
(\<exists> p__Inv0. p__Inv0\<le>N\<and>f=inv__2  p__Inv0) \<or>
(\<exists> p__Inv0. p__Inv0\<le>N\<and>f=inv__3  p__Inv0) \<or>
(\<exists> p__Inv0 p__Inv1. p__Inv0\<le>N\<and>p__Inv1\<le>N\<and>p__Inv0~=p__Inv1\<and>f=inv__4  p__Inv0 p__Inv1) \<or>
(\<exists> p__Inv0 p__Inv1. p__Inv0\<le>N\<and>p__Inv1\<le>N\<and>p__Inv0~=p__Inv1\<and>f=inv__5  p__Inv0 p__Inv1) \<or>
(\<exists> p__Inv0 p__Inv1. p__Inv0\<le>N\<and>p__Inv1\<le>N\<and>p__Inv0~=p__Inv1\<and>f=inv__6  p__Inv0 p__Inv1) \<or>
(f=inv__7  ) \<or>
(\<exists> p__Inv0. p__Inv0\<le>N\<and>f=inv__8  p__Inv0) \<or>
(\<exists> p__Inv0. p__Inv0\<le>N\<and>f=inv__9  p__Inv0)
}"

definition invariantsAbs::" formula list" where [simp]:
"invariantsAbs  \<equiv>

[
(inv__1  0 1) ,(inv__1   1 0),
(inv__2  0),(inv__2  1),
(inv__3 0),(inv__3 1),
(inv__4  0 1),(inv__4   1 0),
(inv__5  0 1),(inv__5   1 0),
(inv__6  0 1) ,(inv__6   1 0),
(inv__7  ) ,
(inv__8  0) ,(inv__8  1),
(inv__9  0),(inv__9  1)
]"
(*[
(inv__1  0 1),
(inv__2  0),
(inv__3 0),
(inv__4  0 1),
(inv__5  0 1),
(inv__6  0 1) ,
(inv__7  ) ,
(inv__8  0) ,
(inv__9  0)
]"*)

subsection{*Definitions of initial states*}

definition initSpec0::"nat \<Rightarrow> formula" where [simp]:
"initSpec0 N \<equiv> (forallForm (down N) (% i . (eqn (IVar (Field (Para (Ident ''n'') i) ''st'')) (Const I))))"

definition initSpec1::"nat \<Rightarrow> formula" where [simp]:
"initSpec1 N \<equiv> (forallForm (down N) (% i . (eqn (IVar (Field (Para (Ident ''n'') i) ''data'')) (Const (index 1)))))"

definition initSpec2::"formula" where [simp]:
"initSpec2  \<equiv> (eqn (IVar (Ident ''x'')) (Const true))"

definition initSpec3::"formula" where [simp]:
"initSpec3  \<equiv> (eqn (IVar (Ident ''auxDATA'')) (Const (index 1)))"

definition initSpec4::"formula" where [simp]:
"initSpec4  \<equiv> (eqn (IVar (Ident ''memDATA'')) (Const (index 1)))"

definition allInitSpecs::"nat \<Rightarrow> formula list" where [simp]:
"allInitSpecs N \<equiv> [
(initSpec0 N),
(initSpec1 N),
(initSpec2 ),
(initSpec3 ),
(initSpec4 )
]"

definition allInitSpecsAbs::" formula list" where [simp]:
"allInitSpecsAbs  \<equiv> [
(initSpec0 NC),
(initSpec1 NC),
(initSpec2  ),
(initSpec3 ),
(initSpec4 )
]"

lemma andListMono2Aux:
  assumes a1:"formEval a1 s \<longrightarrow> formEval b1 s" and a2:"formEval (andList A) s \<longrightarrow>formEval (andList B) s"
  shows "formEval (andList (a1#A)) s \<longrightarrow> formEval (andList (b1#B)) s"
  by (simp add: a2 local.a1)

lemma andListMono2[intro]:
  assumes a1:"formEval a1 s \<longrightarrow> formEval b1 s" and a2:"formEval (andList A) s \<longrightarrow>formEval (andList B) s"
  and a3:"formEval (andList (a1#A)) s "
  shows " formEval (andList (b1#B)) s"
  using a2 a3 local.a1 by auto

axiomatization  where axiomOnf2 [simp,intro]:
   "s \<in> reachableSet (set (allInitSpecs N )) (rules N) \<Longrightarrow>  1 < N \<Longrightarrow> 1 < i \<Longrightarrow> j<2 \<Longrightarrow>  formEval (f 0 1) s \<Longrightarrow> formEval (f i j) s"

axiomatization  where axiomOnf1 [simp,intro]:
   "s \<in> reachableSet (set (allInitSpecs N )) (rules N) \<Longrightarrow> 1 < N \<Longrightarrow> 1 < i \<Longrightarrow>formEval (f 0 ) s \<Longrightarrow> formEval (f i) s"

 (* apply(simp)
  apply(erule disjE)
  apply(rule_tac x="inv__1 0 1" in exI,simp)
  apply(erule disjE)
  apply(rule_tac x="inv__1 0 1" in exI,simp)
  apply(rule_tac x="inv__9 0 " in exI,simp)
  done*)

lemma lemmaOnIdleLeNc:
  assumes a1:"i\<le>NC"
  shows "trans_sim_on1 (n_Idle  i) (n_Idle  i) (set invariantsAbs) s" (is "trans_sim_on1 ?r ?r ?F s")
proof(rule ruleSimId)
  show  "\<forall>v. v\<in>varOfForm (pre ?r) \<longrightarrow>  v \<in>(varOfFormList invariantsAbs) "
    by(cut_tac a1, auto)

next
  show  b1: "\<forall>v a. a \<in> set (statement2Assigns (act ?r)) \<longrightarrow> v\<in>varOfExp ( substExpByStatement (IVar (fst a))  (act ?r))\<longrightarrow>v \<in>varOfFormList invariantsAbs "
   proof(cut_tac a1,(rule allI)+,(rule impI)+,auto) qed

 qed

lemma lemmaOnIdleGtNc1:
  assumes a1:"i>NC" and a2:"s \<in> reachableSet (set (allInitSpecs N)) (rules N)" and a3:"NC<N" and
  a4:"\<forall>f.  f \<in>(set invariantsAbs) \<longrightarrow>  formEval f s"
  shows "trans_sim_on1 (n_Idle  i) (n_ABS_Idle  NC) (set invariantsAbs) s" (is "trans_sim_on1 ?r ?r' (set ?F) s")
proof(rule ruleSimCond1)
  show " formEval (pre ?r) s \<longrightarrow>formEval (pre ?r') s" (is "?A \<longrightarrow>?B")
  proof(rule impI)+
    assume b1:"?A"

    from a4  have b4:"formEval (inv__5 0 1 ) s"   by (force simp del:inv__5_def)
    have b5:"formEval (inv__5 i 0 ) s"
    proof(cut_tac a1 a2 a3 b4,rule axiomOnf2,force+)qed
    with b1  have b6:"formEval (neg (eqn (IVar (Field (Para (Ident ''n'') 0) ''st'')) (Const E))) s" by auto
    have b7:"formEval (inv__5 i 1 ) s"
     proof(cut_tac a1 a2 a3 b4,rule axiomOnf2,force+)qed
    with b1 have b7:"formEval (neg (eqn (IVar (Field (Para (Ident ''n'') 1) ''st'')) (Const E))) s" by auto

     from a4 have b8:"formEval (inv__6 0 1 ) s"    by (force simp del:inv__6_def)

     have b9:"formEval (inv__6 i 0 ) s"
    proof(cut_tac a1 a2 a3 b8,rule axiomOnf2,force+)qed
    with b1 have b9:"formEval (neg (eqn (IVar (Field (Para (Ident ''n'') 0) ''st'')) (Const C))) s" by auto
     have b10:"formEval (inv__6 i 1 ) s"
     proof(cut_tac a1 a2 a3 b8,rule axiomOnf2,force+)qed
     with b1 have b11:"formEval (neg (eqn (IVar (Field (Para (Ident ''n'') 1) ''st'')) (Const C))) s" by auto

     from b1 b6 b7 b9 b11 show "formEval (pre ?r') s"
       by auto
   qed
 next
   show "(\<forall>  v. v \<in>  varOfSent (act  ?r') \<longrightarrow>  v \<in> varOfFormList ?F \<longrightarrow> formEval (pre ?r) s \<longrightarrow>
    expEval (substExpByStatement (IVar v)  (act ?r')) s = expEval (substExpByStatement (IVar v)  (act ?r)) s)"
   proof(rule allI,(rule impI)+)
      fix  v
     assume b1:"v\<in> (varOfFormList invariantsAbs)"  and b2:"formEval (pre ?r) s" and b3:"v \<in>varOfSent (act ?r')"

     from a4  have tmp:"formEval (inv__3 0  ) s"   by (force simp del:inv__3_def)
     have b4:"formEval (inv__3 i  ) s"
     proof(cut_tac a1 a2 a3 tmp,rule axiomOnf1,force+)qed

     show "expEval (substExpByStatement (IVar v)  (act ?r')) s = expEval (substExpByStatement (IVar v)  (act ?r)) s"
       apply (cut_tac  a1 b1 b2 b4,auto) done
   qed
 next
   show "\<forall>  v. v \<in>  varOfSent (act ?r) \<longrightarrow>  v \<in> varOfFormList ?F \<longrightarrow> v \<in>  varOfSent (act ?r')" by(cut_tac a1, auto)

 next
   show "\<forall> v va. v \<in> varOfSent (act ?r') \<longrightarrow>va\<in>varOfExp ( substExpByStatement (IVar v)  (act ?r'))\<longrightarrow> va \<in> (varOfFormList ?F)"
      by auto
  qed

lemma lemmaOnn_IdleGt:
  assumes a1:"i>NC" and
  a2:"s \<in> reachableSet (set (allInitSpecs N)) (rules N)"  and a3:"NC<N" and
  a4:"\<forall>f.  f \<in>(set invariantsAbs) \<longrightarrow>  formEval f s"
  shows "trans_sim_on1 (n_Idle i)  (n_ABS_Idle_i  NC) (set invariantsAbs) s" (is "trans_sim_on1 ?r ?r' (set ?F) s")
  proof(rule ruleSimCond1)
    show " formEval (pre ?r) s \<longrightarrow>formEval (pre ?r') s" (is "?A \<longrightarrow>?B")
    proof(rule impI)+
      assume b0:"?A"
  from a4  have tmp:"formEval (inv__5 0 1)  s"
            by (force simp del:inv__5_def)
        have tmp1:"formEval (inv__5  i 0  ) s"
        proof(cut_tac a1 a2 a3 tmp,rule axiomOnf2,force+)qed
        with b0  have c3:"formEval  (conclude (inv__5  i 0)) s" by auto

        from a4  have b4:"formEval (inv__5 0 1 ) s"   by (force simp del:inv__5_def)
    have b5:"formEval (inv__5 i 0 ) s"
    proof(cut_tac a1 a2 a3 b4,rule axiomOnf2,force+)qed
    with b1  have b6:"formEval (neg (eqn (IVar (Field (Para (Ident ''n'') 0) ''st'')) (Const E))) s" by auto
    have b7:"formEval (inv__5 i 1 ) s"
     proof(cut_tac a1 a2 a3 b4,rule axiomOnf2,force+)qed
    with b1 have b7:"formEval (neg (eqn (IVar (Field (Para (Ident ''n'') 1) ''st'')) (Const E))) s" by auto

        from a4  have tmp:"formEval n_rule_6 0 1  s"
            by (force simp del:n_rule_6_def)
        have tmp1:"formEval (n_rule_6 i 0  ) s"
        proof(cut_tac a1 a2 a3 tmp,rule axiomOnf2,force+)qed
        with b1  have c4:"formEval  (conclude (n_rule_6 i 0)) s" by autofrom a4  have tmp:"formEval n_rule_6 0 1  s"
            by (force simp del:n_rule_6_def)
        have tmp1:"formEval (n_rule_6 i 1  ) s"
        proof(cut_tac a1 a2 a3 tmp,rule axiomOnf2,force+)qed
        with b1  have c5:"formEval  (conclude (n_rule_6 i 1)) s" by autofrom a4  have tmp:"formEval n_rule_3 0 1  s"
            by (force simp del:n_rule_3_def)
        have tmp1:"formEval (n_rule_3 i 0  ) s"
        proof(cut_tac a1 a2 a3 tmp,rule axiomOnf2,force+)qed
        with b1  have c6:"formEval  (conclude (n_rule_3 i 0)) s" by autofrom a4  have tmp:"formEval n_rule_3 0 1  s"
            by (force simp del:n_rule_3_def)
        have tmp1:"formEval (n_rule_3 i 1  ) s"
        proof(cut_tac a1 a2 a3 tmp,rule axiomOnf2,force+)qed
        with b1  have c7:"formEval  (conclude (n_rule_3 i 1)) s" by auto
      from b1 c0 c1 c2 c3 c4 c5 c6 c7 show "formEval (pre ?r') s"
       by auto
     qed
   next
    show "\<forall>v. v\<in>varOfForm (pre ?r') \<longrightarrow> v \<in>(varOfFormList invariantsAbs)"
      by auto

  show "expEval (substExpByStatement (IVar v)  (act ?r')) s = expEval (substExpByStatement (IVar v)  (act ?r)) s"
       apply (cut_tac  a1 b1 b2 b4,auto) done
   qed
 next
   show "\<forall>  v. v \<in>  varOfSent (act ?r) \<longrightarrow>  v \<in> varOfFormList ?F \<longrightarrow> v \<in>  varOfSent (act ?r')" by(cut_tac a1, auto)

 next
   show "\<forall> v va. v \<in> varOfSent (act ?r') \<longrightarrow>va\<in>varOfExp ( substExpByStatement (IVar v)  (act ?r'))\<longrightarrow> va \<in> (varOfFormList ?F)"
      by auto
qed

lemma lemmaOnIdleGtNc:
  assumes a1:"i>NC" and a2:"s \<in> reachableSet (set (allInitSpecs N)) (rules N)" and
a3:"NC<N" and
  a4:"\<forall>f.  f \<in>(set invariantsAbs) \<longrightarrow>  formEval f s"
  shows "trans_sim_on1 (n_Idle  i) (n_ABS_Idle  NC) (set invariantsAbs) s" (is "trans_sim_on1 ?r ?r' ?F s")
proof(rule ruleSimCond)
  show " formEval (pre ?r) s \<longrightarrow>formEval (pre ?r') s" (is "?A \<longrightarrow>?B")
  proof(rule impI)+
    assume b1:"?A"
     have "(inv__5 0 1 )\<in>(set invariantsAbs)" by (force simp del:inv__5_def)
     from a4  have b4:"formEval (inv__5 0 1 ) s" apply(force simp del:inv__5_def) done

    have b5:"formEval (inv__5 i 0 ) s"
    proof(cut_tac a1 a2 a3 b4,rule axiomOnf2,force+)qed
    with b1  have b6:"formEval (neg (eqn (IVar (Field (Para (Ident ''n'') 0) ''st'')) (Const E))) s" by auto
     have b7:"formEval (inv__5 i 1 ) s"
     proof(cut_tac a1 a2 a3 b4,rule axiomOnf2,force+)qed
     with b1 have b7:"formEval (neg (eqn (IVar (Field (Para (Ident ''n'') 1) ''st'')) (Const E))) s" by auto

     have "(inv__6 0 1 )\<in>(set invariantsAbs)" by force
     with a4 have b8:"formEval (inv__6 0 1 ) s"  apply(drule_tac x="(inv__6 0 1 )" in spec,blast)done

     have b9:"formEval (inv__6 i 0 ) s"
    proof(cut_tac a1 a2 a3 b8,rule axiomOnf2,force+)qed
    with b1 have b9:"formEval (neg (eqn (IVar (Field (Para (Ident ''n'') 0) ''st'')) (Const C))) s" by auto
     have b10:"formEval (inv__6 i 1 ) s"
     proof(cut_tac a1 a2 a3 b8,rule axiomOnf2,force+)qed
     with b1 have b11:"formEval (neg (eqn (IVar (Field (Para (Ident ''n'') 1) ''st'')) (Const C))) s" by auto

     from b1 b6 b7 b9 b11 show "formEval (pre ?r') s"
       by auto
   qed
 next

   show "\<forall>v. v\<in>varOfForm (pre ?r') \<longrightarrow> v \<in>(varOfFormList invariantsAbs)"
     by auto

 next

   show "
  (\<forall>v.   v \<in> (varOfFormList invariantsAbs) \<longrightarrow>formEval (pre ?r) s\<longrightarrow> expEval (substExpByStatement (IVar v)  (act ?r')) s = expEval (substExpByStatement (IVar v)  (act ?r)) s)"
   proof((rule allI)+,(rule impI)+,auto)
     fix  v
     assume b1:"v\<in> (varOfFormList invariantsAbs)"  and b2:"formEval (pre ?r) s"

     have "(inv__3 0  )\<in>(set invariantsAbs)" by force
     with a4 have b30:"formEval (inv__3 0 ) s"   apply(drule_tac x="(inv__3 0  )" in spec,blast)done

     have b3:"formEval (inv__3 i ) s"  proof(cut_tac a1 a2 a3 b30,rule axiomOnf1,force+)qed

     show "expEval (substExpByStatement (IVar v)  (act ?r')) s = expEval (substExpByStatement (IVar v)  (act ?r)) s"
       apply (cut_tac  a1 b1 b2 b3,auto) done
   qed
  (* have "\<forall>f v va. v \<in> varOfForm f \<longrightarrow> f \<in>?F \<longrightarrow>va\<in>varOfExp ( substExpByStatement (IVar v)  (act ?r'))\<longrightarrow> va \<in>(varOfFormList invariantsAbs)"   by auto*)
     then show "\<forall> v va. v \<in> varOfFormList invariantsAbs \<longrightarrow>va\<in>varOfExp ( substExpByStatement (IVar v)  (act ?r'))\<longrightarrow> va \<in> varOfFormList invariantsAbs"
      by auto
  qed

lemma lemmaOnCritLeNc:
  assumes a1:"i\<le>NC"
  shows "trans_sim_on1 (n_Crit  i) (n_Crit  i) (set invariantsAbs) s" (is "trans_sim_on1 ?r ?r ?F s")
proof(rule ruleSimId)
  show  "\<forall>v. v\<in>varOfForm (pre ?r) \<longrightarrow>  v \<in>(varOfFormList invariantsAbs) "
    by(cut_tac a1, auto)

next
  show  b1: "\<forall>v a. a \<in> set (statement2Assigns (act ?r))
 \<longrightarrow> v\<in>varOfExp ( substExpByStatement (IVar (fst a))  (act ?r))\<longrightarrow>v \<in>varOfFormList invariantsAbs "
   proof((rule allI)+,(rule impI)+,auto) qed

qed

lemma lemmaOnCritGtNc:
  assumes a1:"i>NC" and a2:"s \<in> reachableSet (set (allInitSpecs N)) (rules N)" and a3:"NC<N" and
  a4:"\<forall>f.  f \<in>(set invariantsAbs) \<longrightarrow>  formEval f s"
  shows "trans_sim_on1 (n_Crit  i) (n_ABS_Crit  ) (set invariantsAbs) s" (is "trans_sim_on1 ?r ?r' ?F s")
proof(rule ruleSimCond)
  show " formEval (pre ?r) s \<longrightarrow>formEval (pre ?r') s" (is "?A \<longrightarrow>?B")
  proof(rule impI)+
    assume b1:"?A"

     from b1  show "formEval (pre ?r') s"
       by auto
   qed
 next

   show "\<forall>v. v\<in>varOfForm (pre ?r') \<longrightarrow> v \<in>(varOfFormList invariantsAbs)"
      by auto
 next

   show "
  (\<forall>v.   v \<in> (varOfFormList invariantsAbs) \<longrightarrow>formEval (pre ?r) s\<longrightarrow> expEval (substExpByStatement (IVar v)  (act ?r')) s = expEval (substExpByStatement (IVar v)  (act ?r)) s)"
   proof((rule allI)+,(rule impI)+)
     fix  v
     assume b1:"v\<in> (varOfFormList invariantsAbs)"  and b2:"formEval (pre ?r) s"

     show "expEval (substExpByStatement (IVar v)  (act ?r')) s = expEval (substExpByStatement (IVar v)  (act ?r)) s"
       apply (cut_tac  a1 b1 b2 ,auto) done
   qed
  (* have "\<forall>f v va. v \<in> varOfForm f \<longrightarrow> f \<in>?F \<longrightarrow>va\<in>varOfExp ( substExpByStatement (IVar v)  (act ?r'))\<longrightarrow> va \<in>(varOfFormList invariantsAbs)"   by auto*)
     then show "\<forall> v va. v \<in> varOfFormList invariantsAbs \<longrightarrow>va\<in>varOfExp ( substExpByStatement (IVar v)  (act ?r'))\<longrightarrow> va \<in> varOfFormList invariantsAbs"
      by auto
  qed

lemma lemmaOnStoreLeNc:
  assumes a1:"i\<le>NC"
  shows "trans_sim_on1 (n_Store  i d) (n_Store  i d) (set invariantsAbs) s" (is "trans_sim_on1 ?r ?r ?F s")
proof(rule ruleSimId)
  show  "\<forall>v. v\<in>varOfForm (pre ?r) \<longrightarrow>  v \<in>(varOfFormList invariantsAbs) "
    by(cut_tac a1, auto)

next
  show  b1: "\<forall>v a. a \<in> set (statement2Assigns (act ?r)) \<longrightarrow> v\<in>varOfExp ( substExpByStatement (IVar (fst a))  (act ?r))\<longrightarrow>v \<in>varOfFormList invariantsAbs "
   proof(cut_tac a1,(rule allI)+,(rule impI)+,auto) qed

qed

lemma lemmaOnStoreGtNc:
  assumes a1:"i>NC" and a2:"s \<in> reachableSet (set (allInitSpecs N)) (rules N)" and a3:"1<N" and
  a4:"\<forall>f.  f \<in>(set invariantsAbs) \<longrightarrow>  formEval f s"
  shows "trans_sim_on1 (n_Store  i d) (n_ABS_Store  NC d) (set invariantsAbs) s" (is "trans_sim_on1 ?r ?r' ?F s")
proof(rule ruleSimCond)
  show " formEval (pre ?r) s \<longrightarrow>formEval (pre ?r') s" (is "?A \<longrightarrow>?B")
  proof(rule impI)+
    assume b1:"?A"
     have "(inv__1 0 1 )\<in>(set invariantsAbs)" by force
     with a4  have b4:"formEval (inv__1 0 1 ) s"  apply(drule_tac x="(inv__1 0 1 )" in spec,blast)done

    have b5:"formEval (inv__1 i 0 ) s"
    proof(cut_tac a1 a2 a3 b4,rule axiomOnf2,force+)qed
    with b1  have b6:"formEval (neg (eqn (IVar (Field (Para (Ident ''n'') 0) ''st'')) (Const C))) s" by auto
     have b7:"formEval (inv__1 i 1 ) s"
     proof(cut_tac a1 a2 a3 b4,rule axiomOnf2,force+)qed
     with b1 have b7:"formEval (neg (eqn (IVar (Field (Para (Ident ''n'') 1) ''st'')) (Const C))) s" by auto

     have "(inv__4 0 1 )\<in>(set invariantsAbs)" by force
     with a4 have b8:"formEval (inv__4 0 1 ) s"  apply(drule_tac x="(inv__4 0 1 )" in spec,blast)done

     have b9:"formEval (inv__4 i 0 ) s"
    proof(cut_tac a1 a2 a3 b8,rule axiomOnf2,force+)qed
    with b1 have b9:"formEval (neg (eqn (IVar (Field (Para (Ident ''n'') 0) ''st'')) (Const E))) s" by auto
     have b10:"formEval (inv__4 i 1 ) s"
     proof(cut_tac a1 a2 a3 b8,rule axiomOnf2,force+)qed
     with b1 have b11:"formEval (neg (eqn (IVar (Field (Para (Ident ''n'') 1) ''st'')) (Const E))) s" by auto

     from b1 b6 b7 b9 b11 show "formEval (pre ?r') s"
       by auto
   qed
 next

   show "\<forall>v. v\<in>varOfForm (pre ?r') \<longrightarrow> v \<in>(varOfFormList invariantsAbs)"
      by auto
 next

   show "
  (\<forall>v.   v \<in> (varOfFormList invariantsAbs) \<longrightarrow>formEval (pre ?r) s\<longrightarrow> expEval (substExpByStatement (IVar v)  (act ?r')) s = expEval (substExpByStatement (IVar v)  (act ?r)) s)"
   proof((rule allI)+,(rule impI)+)
     fix  v
     assume b1:"v\<in> (varOfFormList invariantsAbs)"  and b2:"formEval (pre ?r) s"

     have "(inv__3 0  )\<in>(set invariantsAbs)" by force
     with a4 have b30:"formEval (inv__3 0 ) s"
       apply(drule_tac x="(inv__3 0  )" in spec,blast)done

     have b3:"formEval (inv__3 i ) s"  proof(cut_tac a1 a2 a3 b30,rule axiomOnf1,force+)qed

     show "expEval (substExpByStatement (IVar v)  (act ?r')) s = expEval (substExpByStatement (IVar v)  (act ?r)) s"
       apply (cut_tac  a1 b1 b2 b3,auto) done
   qed
   then show "\<forall> v va. v \<in> varOfFormList invariantsAbs \<longrightarrow>va\<in>varOfExp ( substExpByStatement (IVar v)  (act ?r'))\<longrightarrow> va \<in> varOfFormList invariantsAbs"
      by auto
  qed

lemma lemmaOnTryLeNc:
  assumes a1:"i\<le>NC"
  shows (*"\<exists> r'. r' \<in> rulesAbs NC\<and> trans_sim_on1 (n_Try  i) r' (set invariantsAbs) s"*)
 "trans_sim_on1 (n_Try  i) (n_Try  i) (set invariantsAbs) s" (is "trans_sim_on1 ?r ?r ?F s")
proof(rule ruleSimId)
  show  "\<forall>v. v\<in>varOfForm (pre ?r) \<longrightarrow>  v \<in>(varOfFormList invariantsAbs) "
    by(cut_tac a1, auto)

next
  show  b1: "\<forall>v a. a \<in> set (statement2Assigns (act ?r)) \<longrightarrow>
  v\<in>varOfExp ( substExpByStatement (IVar (fst a))  (act ?r))\<longrightarrow>v \<in>varOfFormList invariantsAbs "
   proof(cut_tac a1,(rule allI)+,(rule impI)+,auto) qed

qed

lemma lemmaOnTryGtNc:
  assumes a1:"i>NC" and a2:"s \<in> reachableSet (set (allInitSpecs N)) (rules N)"  and
  a4:"\<forall>f.  f \<in>(set invariantsAbs) \<longrightarrow>  formEval f s"
shows "trans_sim_on1 (n_Try  i) (n_Try  0) (set invariantsAbs) s" (is "trans_sim_on1 ?r ?r' ?F s")
proof(unfold trans_sim_on1_def,(rule allI)+,(rule impI)+,rule disjI2)
  fix s2
  assume b0:"state_sim_on1 s s2 (set invariantsAbs)"
  show "state_sim_on1 (trans (act (n_Try i)) s) s2 (set invariantsAbs)"
  proof(cut_tac a1,unfold state_sim_on1_def,
    (rule allI)+,(rule impI)+)
    fix f v
    assume b1:" f \<in>(set invariantsAbs)" and b2:"v \<in> varOfForm f"

    have b30: "(varOfFormList  invariantsAbs) = {v. \<exists>f. f \<in> set  invariantsAbs\<and> v \<in> varOfForm f}"
      using setOfList by blast

    from b1 and b2 and b30 have b4:"v \<in> (varOfFormList  invariantsAbs)" by blast

    from b4 have b5:"trans (act (n_Try  i)) s v = s v"
      by (cut_tac a1  b4  ,auto)

    from b0   have b6:"s v =s2 v "
      using b1 b2 state_sim_on1_def by blast
    show "trans (act (n_Try i)) s v= s2 v"
      using b5 b6 by auto
  qed
qed

lemma lemmaOnn_TryGtNc:
  assumes a1:"i\<le>N" and a2:"s \<in> reachableSet (set (allInitSpecs N)) (rules N)"  and
  a4:"\<forall>f.  f \<in>(set invariantsAbs) \<longrightarrow>  formEval f s" and a5:"i> NC"
shows "trans_sim_on1 (n_Try i  ) skip (set invariantsAbs) s" (is "trans_sim_on1 ?r ?r' ?F s")
proof(unfold trans_sim_on1_def,(rule allI)+,(rule impI)+,rule disjI2)
  fix s2
  assume b0:"state_sim_on1 s s2 (set invariantsAbs)"
  show "state_sim_on1 (trans (act (n_Try i)) s) s2 (set invariantsAbs)"
  proof(cut_tac a1,unfold state_sim_on1_def,
    (rule allI)+,(rule impI)+)
    fix f v
    assume b1:" f \<in>(set invariantsAbs)" and b2:"v \<in> varOfForm f"

    have b30: "(varOfFormList  invariantsAbs) = {v. \<exists>f. f \<in> set  invariantsAbs\<and> v \<in> varOfForm f}"
      using setOfList by blast

    from b1 and b2 and b30 have b4:"v \<in> (varOfFormList  invariantsAbs)" by blast

    from b4 have b5:"trans (act (n_Try  i)) s v = s v"
      by (cut_tac a5  b4  ,auto)

    from b0   have b6:"s v =s2 v "
      using b1 b2 state_sim_on1_def by blast
    show "trans (act (n_Try i)) s v= s2 v"
      using b5 b6 by auto
  qed
qed

lemma lemmaOnTry:
  assumes   a2:"s \<in> reachableSet (set (allInitSpecs N)) (rules N)"  and
  a4:"\<forall>f.  f \<in>(set invariantsAbs) \<longrightarrow>  formEval f s" and a5:"\<exists>i. i\<le>N \<and> r=(n_Try  i)"
  shows "\<exists> r'. r' \<in> rulesAbs NC\<and> trans_sim_on1 r r' (set invariantsAbs) s" (is "\<exists>r'.?P1 r' \<and> ?P2 r'")
proof -
  from a5 obtain i where d0:"i\<le>N \<and> r=(n_Try  i)"  by blast
  have "i \<le> NC | i> NC" by auto
  moreover{
  assume a1:"i \<le>NC"
  have "\<exists>r'. ?P1 r' \<and> ?P2 r'"
  proof(rule_tac x="(n_Try  i)" in exI,rule conjI)

    show  "?P1 (n_Try  i) "
      by(cut_tac a1, auto)

  next
    show  "?P2 (n_Try  i) "
      using lemmaOnTryLeNc local.a1 d0 by blast
  qed
}
 moreover{
  assume a1:"i >NC"
  have "\<exists>r'. ?P1 r' \<and> ?P2 r'"
  proof(rule_tac x="(n_Try  0)" in exI,rule conjI)

    show  "?P1 (n_Try  0) "
      by(cut_tac a1, auto)

  next
    show  "?P2 (n_Try  0) "

      using lemmaOnTryGtNc local.a1 a2 a4 d0 by blast
  qed
}
  ultimately show "\<exists>r'.?P1 r' \<and> ?P2 r'"
    by satx
qed

lemma lemmaOnExitLeNc:
  assumes a1:"i\<le>NC"
  shows "trans_sim_on1 (n_Exit  i) (n_Exit  i) (set invariantsAbs) s" (is "trans_sim_on1 ?r ?r ?F s")
proof(rule ruleSimId)
  show  "\<forall>v. v\<in>varOfForm (pre ?r) \<longrightarrow>  v \<in>(varOfFormList invariantsAbs) "
    by(cut_tac a1, auto)

next
  show  b1: "\<forall>v a. a \<in> set (statement2Assigns (act ?r)) \<longrightarrow>
  v\<in>varOfExp ( substExpByStatement (IVar (fst a))  (act ?r))\<longrightarrow>v \<in>varOfFormList invariantsAbs "
   proof(cut_tac a1,(rule allI)+,(rule impI)+,auto) qed

qed

lemma lemmaOnExitGtNc:
  assumes a1:"i>NC" and a2:"s \<in> reachableSet (set (allInitSpecs N)) (rules N)" and a3:"NC<N" and
  a4:"\<forall>f.  f \<in>(set invariantsAbs) \<longrightarrow>  formEval f s"
shows "trans_sim_on1 (n_Exit  i) (n_Exit  0) (set invariantsAbs) s" (is "trans_sim_on1 ?r ?r' ?F s")
proof(unfold trans_sim_on1_def,(rule allI)+,(rule impI)+,rule disjI2)
  fix s2
  assume b0:"state_sim_on1 s s2 (set invariantsAbs)"
  show "state_sim_on1 (trans (act (n_Exit i)) s) s2 (set invariantsAbs)"
  proof(cut_tac a1,unfold state_sim_on1_def,
    (rule allI)+,(rule impI)+)
    fix f v
    assume b1:" f \<in>(set invariantsAbs)" and b2:"v \<in> varOfForm f"

    have b30: "(varOfFormList  invariantsAbs) = {v. \<exists>f. f \<in> set  invariantsAbs\<and> v \<in> varOfForm f}"
      using setOfList by blast

    from b1 and b2 and b30 have b4:"v \<in> (varOfFormList  invariantsAbs)" by blast

    from b4 have b5:"trans (act (n_Exit  i)) s v = s v"
      by (cut_tac a1  b4  ,auto)

    from b0   have b6:"s v =s2 v "
      using b1 b2 state_sim_on1_def by blast
    show "trans (act (n_Exit i)) s v= s2 v"
      using b5 b6 by auto
  qed
qed

lemma lemmaOnIdle:
  assumes   a2:"s \<in> reachableSet (set (allInitSpecs N)) (rules N)"  and  a1:"NC<N" and
  a4:"\<forall>f.  f \<in>(set invariantsAbs) \<longrightarrow>  formEval f s" and a5:"\<exists>i. i\<le>N \<and> r=(n_Idle  i)"
  shows "\<exists> r'. r' \<in> rulesAbs NC\<and> trans_sim_on1 r r' (set invariantsAbs) s" (is "\<exists>r'.?P1 r' \<and> ?P2 r'")
proof -
  from a5 obtain i where d0:"i\<le>N \<and> r=(n_Idle  i)"  by blast
  have "i \<le> NC |  NC<i" by auto
  moreover{
  assume b1:"i \<le>NC"
  have "\<exists>r'. ?P1 r' \<and> ?P2 r'"
  proof(rule_tac x="(n_Idle  i)" in exI,rule conjI)

    show  "?P1 (n_Idle  i) "
      by(cut_tac b1, auto)

  next
    show  "?P2 (n_Idle  i) "
      using lemmaOnIdleLeNc b1 d0 by blast
  qed
}
 moreover{
  assume b1:"NC<i"
  have "\<exists>r'. ?P1 r' \<and> ?P2 r'"
  proof(rule_tac x="(n_ABS_Idle  NC)" in exI,rule conjI)

    show  "?P1 (n_ABS_Idle  NC) "
      by(cut_tac a1, auto)

  next
    show  "?P2 (n_ABS_Idle  NC) "  thm lemmaOnIdleGtNc

      using lemmaOnIdleGtNc b1 a1 a2 a4 d0 by blast
  qed
}
  ultimately show "\<exists>r'.?P1 r' \<and> ?P2 r'"
    by satx
qed

lemma lemmaOnCrit:
  assumes   a2:"s \<in> reachableSet (set (allInitSpecs N)) (rules N)"  and  a1:"NC<N" and
  a4:"\<forall>f.  f \<in>(set invariantsAbs) \<longrightarrow>  formEval f s" and a5:"\<exists>i. i\<le>N \<and> r=(n_Crit  i)"
  shows "\<exists> r'. r' \<in> rulesAbs NC\<and> trans_sim_on1 r r' (set invariantsAbs) s" (is "\<exists>r'.?P1 r' \<and> ?P2 r'")
proof -
  from a5 obtain i where d0:"i\<le>N \<and> r=(n_Crit  i)"  by blast
  have "i \<le> NC |  NC<i" by auto
  moreover{
  assume b1:"i \<le>NC"
  have "\<exists>r'. ?P1 r' \<and> ?P2 r'"
  proof(rule_tac x="(n_Crit  i)" in exI,rule conjI)

    show  "?P1 (n_Crit  i) "
      by(cut_tac b1, auto)

  next
    show  "?P2 (n_Crit  i) "
      using lemmaOnCritLeNc b1 d0 by blast
  qed
}
 moreover{
  assume b1:"NC<i"
  have "\<exists>r'. ?P1 r' \<and> ?P2 r'"
  proof(rule_tac x="(n_ABS_Crit )" in exI,rule conjI)

    show  "?P1 (n_ABS_Crit  ) "
      by(cut_tac a1, auto)

  next
    show  "?P2 (n_ABS_Crit ) "  thm lemmaOnIdleGtNc

      using lemmaOnCritGtNc b1 a1 a2 a4 d0 by blast
  qed
}
  ultimately show "\<exists>r'.?P1 r' \<and> ?P2 r'"
    by satx
qed

lemma lemmaOnExit:
  assumes   a2:"s \<in> reachableSet (set (allInitSpecs N)) (rules N)"  and  a1:"NC<N" and
  a4:"\<forall>f.  f \<in>(set invariantsAbs) \<longrightarrow>  formEval f s" and a5:"\<exists>i. i\<le>N \<and> r=(n_Exit  i)"
  shows "\<exists> r'. r' \<in> rulesAbs NC\<and> trans_sim_on1 r r' (set invariantsAbs) s" (is "\<exists>r'.?P1 r' \<and> ?P2 r'")
proof -
  from a5 obtain i where d0:"i\<le>N \<and> r=(n_Exit  i)"  by blast
  have "i \<le> NC |  NC<i" by auto
  moreover{
  assume b1:"i \<le>NC"
  have "\<exists>r'. ?P1 r' \<and> ?P2 r'"
  proof(rule_tac x="(n_Exit  i)" in exI,rule conjI)

    show  "?P1 (n_Exit  i) "
      by(cut_tac b1, auto)

  next
    show  "?P2 (n_Exit  i) "
      using lemmaOnExitLeNc b1 d0 by blast
  qed
}
moreover{
  assume b1:"NC<i"
  have "\<exists>r'. ?P1 r' \<and> ?P2 r'"
  proof(rule_tac x="(n_Exit  0)" in exI,rule conjI)

    show  "?P1 (n_Exit  0) "
      by(cut_tac a1, auto)

  next
    show  "?P2 (n_Exit  0) "  thm lemmaOnExitGtNc

      using lemmaOnExitGtNc b1 a1 a2 a4 d0 by blast
  qed
}
  ultimately show "\<exists>r'.?P1 r' \<and> ?P2 r'"
    by satx
qed

lemma simCond1:
  assumes a1:"s \<in>reachableSet (set (allInitSpecs N)) (rules N)" and
    a2:"(\<forall> f. f \<in>(set invariantsAbs) \<longrightarrow> formEval f s )" and a3:"NC <N"

  shows "prot_sim_on1 {andList (allInitSpecs N)} {andList (allInitSpecs NC)}
    (rules N) (rulesAbs NC) (set invariantsAbs) s" (is "prot_sim_on1 {?I} {?I'} ?rs ?rs' ?F s")
proof(unfold prot_sim_on1_def,rule conjI)
  show "\<forall>f. f \<in> {?I} \<longrightarrow> (\<exists>f'. f' \<in> {?I'} \<and> pred_sim_on1 f f' ?F s)"
  proof(rule allI, rule impI)
    fix i
    assume b1:" i \<in> {?I}"
    show "(\<exists>f'. f' \<in> {?I'} \<and> pred_sim_on1 i f' ?F s)"
    proof(rule_tac x="?I'" in exI,rule conjI)
      show "pred_sim_on1 i ?I' ?F s"
      proof(unfold pred_sim_on1_def,rule impI)
        assume c1:"formEval i s"
        show "(\<exists>s'. formEval ?I' s' \<and>  state_sim_on1 s s' ?F)"
        proof(rule_tac x="s" in exI,cut_tac b1 c1 a3,rule conjI)
          have "formEval (andList (allInitSpecs N)) s"
            using b1 c1 by blast
          then show "formEval (andList (allInitSpecs NC)) s"
          proof(cut_tac a3 ,auto simp del:evalEqn )
          qed

          next
            show " state_sim_on1 s s ?F"
              by auto
          qed
        qed
      next
        show "andList (allInitSpecs NC)  \<in> {andList (allInitSpecs NC)} " by blast
      qed

    qed
  next
    show " (\<forall>r. r \<in> ?rs\<longrightarrow>(\<exists> r'. r' \<in> ?rs' \<and> trans_sim_on1 r r' (set invariantsAbs) s))" (is "?P")
    proof(rule allI, rule impI)
      fix r
      assume b1:"r \<in> (rules N)"
      have c1: "(\<exists> i. i\<le>N\<and>r=n_Try  i)\<or>
      (\<exists> i. i\<le>N\<and>r=n_Crit  i)\<or>
      (\<exists> i. i\<le>N\<and>r=n_Exit  i)\<or>
      (\<exists> i. i\<le>N\<and>r=n_Idle  i)"
          apply (cut_tac b1, auto) done
    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_Try  i)"
          have "(\<exists> r'. r' \<in> ?rs' \<and> trans_sim_on1 r r' (set invariantsAbs) s)"
            using a2 a1 d1 lemmaOnTry by blast
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_Exit  i)"
          have "(\<exists> r'. r' \<in> ?rs' \<and> trans_sim_on1 r r' (set invariantsAbs) s)" thm lemmaOnExit
            using a3 a2 a1 d1 lemmaOnExit by blast
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_Idle  i)"
          have "(\<exists> r'. r' \<in> ?rs' \<and> trans_sim_on1 r r' (set invariantsAbs) s)" thm lemmaOnExit
            using a3 a2 a1 d1 lemmaOnIdle by blast
    }

  moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_Crit  i)"
       have "(\<exists> r'. r' \<in> ?rs' \<and> trans_sim_on1 r r' (set invariantsAbs) s)" thm lemmaOnExit
            using a3 a2 a1 d1 lemmaOnCrit  by blast
    }

  ultimately show "(\<exists> r'. r' \<in> ?rs' \<and> trans_sim_on1 r r' (set invariantsAbs) s)"
    by satx
qed
qed

lemma iniImply_inv__1:
assumes a1: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__1  p__Inv3 p__Inv4)"
and a2: "formEval (andList (allInitSpecs N)) s"
shows "formEval f s"
  using a1 a2 apply( auto  )done

(*lemma iniImply_inv__1:
assumes a1: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>NC\<and>p__Inv4\<le>NC\<and>p__Inv3~=p__Inv4\<and>f=inv__1  p__Inv3 p__Inv4)"
and a2: "formEval (andList (allInitSpecs NC)) s"
shows "formEval f s"
using a1 a2 apply( auto  )done*)

lemma iniImply_inv__2:
assumes a1: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__2  p__Inv4)"
and a2: "formEval (andList (allInitSpecs N)) s"
shows "formEval f s"
using a1 a2 by (auto )

lemma iniImply_inv__3:
assumes a1: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__3  p__Inv3 p__Inv4)"
and a2: "formEval (andList (allInitSpecs N)) s"
shows "formEval f s"
using a1 a2 by auto

lemma iniImply_inv__4:
assumes a1: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__4  p__Inv4)"
and a2: "formEval (andList (allInitSpecs N)) s"
shows "formEval f s"
using a1 a2 by auto

lemma iniImply_inv__5:
assumes a1: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__5  p__Inv3 p__Inv4)"
and a2: "formEval (andList (allInitSpecs N)) s"
shows "formEval f s"
using a1 a2 by auto

end
      show "(\<exists> r'. r' \<in> ?rs' \<and> trans_sim_on1 r r' (set invariantsAbs) s)"

  qed
end
set fs \<subseteq>  invs ; ( \<forall> inv. inv \<in>invs \<longrightarrow>formEval inv s
(\<forall>f. f \<in> I \<longrightarrow> (\<exists>f'. f' \<in> I' \<and> pred_sim_on1 f f' F s)) \<and>
  (\<forall>r. r \<in> rs\<longrightarrow>(\<exists> r'. r' \<in> rs' \<and> trans_sim_on1 r r' F s))
assumes  a1:"\<forall>s. s \<in>reachableSet I rs \<longrightarrow> (\<forall> f. f \<in>F \<longrightarrow> formEval f s )\<longrightarrow>prot_sim_on1 I I' rs rs' F s"
    and a2:"\<forall>s f. s \<in>reachableSet I' rs' \<longrightarrow>f \<in>F \<longrightarrow> formEval f s  "
  (*and a3:"\<forall>s. s \<in>reachableSet I rs' \<longrightarrow>f \<in>F \<longrightarrow> formEval f s  " *)
  and a4:"s \<in>reachableSet I rs " and a5:"\<forall> s f.  f \<in>I \<longrightarrow> formEval f s \<longrightarrow> (\<forall>f'. f' \<in>F \<longrightarrow> formEval  f' s)   "
  and a6:"\<forall> s f.  f \<in>I' \<longrightarrow> formEval f s \<longrightarrow> (\<forall>f'. f' \<in>F \<longrightarrow> formEval  f' s)   "
lemma lemmaOnTryGtNc:
  assumes a1:"i>NC" and a2:"s \<in> reachableSet (set (allInitSpecs N)) (rules N)" and a3:"1<N"
  shows "trans_sim_on1 (n_Idle  i) (n_ABS_Idle  NC) (set invariantsAbs) s" (is "trans_sim_on1 ?r ?r' ?F s")
proof(rule ruleSimCond)
  show " (\<forall> f. f \<in>?F \<longrightarrow> formEval f s ) \<longrightarrow> formEval (pre ?r) s \<longrightarrow>formEval (pre ?r') s" (is "?A \<longrightarrow>?B\<longrightarrow>?C")
  proof(rule impI)+
    assume b1:"?A" and b2:"?B"
    from b1 have b4:"formEval (inv__5 0 1 ) s"  by auto
    have b5:"formEval (inv__5 i 0 ) s"
    proof(cut_tac a1 a2 a3 b4,rule axiomOnf2,force+)qed
    with b2 have b6:"formEval (neg (eqn (IVar (Field (Para (Ident ''n'') 0) ''st'')) (Const E))) s" by auto
     have b7:"formEval (inv__5 i 1 ) s"
     proof(cut_tac a1 a2 a3 b4,rule axiomOnf2,force+)qed
     with b2 have b7:"formEval (neg (eqn (IVar (Field (Para (Ident ''n'') 1) ''st'')) (Const E))) s" by auto

     from b1 have b8:"formEval (inv__6 0 1 ) s"  by auto
     have b9:"formEval (inv__6 i 0 ) s"
    proof(cut_tac a1 a2 a3 b8,rule axiomOnf2,force+)qed
    with b2 have b9:"formEval (neg (eqn (IVar (Field (Para (Ident ''n'') 0) ''st'')) (Const C))) s" by auto
     have b10:"formEval (inv__6 i 1 ) s"
     proof(cut_tac a1 a2 a3 b8,rule axiomOnf2,force+)qed
     with b2 have b11:"formEval (neg (eqn (IVar (Field (Para (Ident ''n'') 1) ''st'')) (Const C))) s" by auto

     from b2 b6 b7 b9 b11 show "formEval (pre ?r') s"
       by auto
   qed
 next
   have "\<forall>v. v\<in>varOfForm (pre ?r') \<longrightarrow> v \<in>(varOfFormList invariantsAbs)"
     by simp
   then show "\<forall>v. v\<in>varOfForm (pre ?r') \<longrightarrow>(\<exists>f. f \<in>?F \<and>v \<in> varOfForm f)"
     using mem_Collect_eq setOfList by auto
 next

   show " (\<forall> f. f \<in>?F \<longrightarrow> formEval f s ) \<longrightarrow>
  (\<forall>f  v. f\<in> ?F \<longrightarrow>  v \<in> varOfForm f \<longrightarrow>formEval (pre ?r) s\<longrightarrow> expEval (substExpByStatement (IVar v)  (act ?r')) s = expEval (substExpByStatement (IVar v)  (act ?r)) s)" (is "?A \<longrightarrow>?B")
   proof(rule impI)+
     assume b1:"?A"

     from b1 have b2:"formEval (inv__3 0 ) s"   by auto

     have b2:"formEval (inv__3 i ) s"  proof(cut_tac a1 a2 a3 b2,rule axiomOnf1,force+)qed
     show "?B"  by (cut_tac a1 b2,auto)
   qed
   have "\<forall>f v va. v \<in> varOfForm f \<longrightarrow> f \<in>?F \<longrightarrow>va\<in>varOfExp ( substExpByStatement (IVar v)  (act ?r'))\<longrightarrow> va \<in>(varOfFormList invariantsAbs)"   by auto
     then show "\<forall>f v va. v \<in> varOfForm f \<longrightarrow> f \<in>?F \<longrightarrow>va\<in>varOfExp ( substExpByStatement (IVar v)  (act ?r'))\<longrightarrow> (\<exists>f. f \<in>?F \<and>va \<in> varOfForm f)"
     using mem_Collect_eq setOfList by auto
 qed

end
and
  a5:"\<forall>f v va. v \<in> varOfForm f \<longrightarrow> f \<in>F \<longrightarrow>va\<in>varOfExp ( substExpByStatement (IVar v)  (act r2))\<longrightarrow> (varOfFormList invariantsAbs)"
*)