(*<*)
theory Monitor_Code
  imports Monitor
  "HOL-Library.Code_Target_Nat"
  "HOL.String"
  Containers.Containers
begin
(*>*)

derive ccompare MFOTL.trm
derive (eq) ceq MFOTL.trm
derive (rbt) set_impl MFOTL.trm

lemma image_these: "f ` Option.these X = Option.these (map_option f ` X)"
  by (force simp: in_these_eq Bex_def image_iff map_option_case split: option.splits)

lemma meval_MPred: "meval n t db (MPred e ts) = ([Option.these
  ((map_option (\<lambda>f. tabulate f 0 n) o match ts) ` (\<Union>(e', x)\<in>db. if e = e' then {x} else {}))], MPred e ts)"
  unfolding meval.simps image_these image_image o_def ..

lemma meval_MPred': "meval n t db (MPred e ts) = ([Option.these
  (\<Union>(e', x)\<in>db. if e = e' then {map_option (\<lambda>f. tabulate f 0 n) (match ts x)} else {})], MPred e ts)"
  unfolding meval_MPred image_UN split_beta if_distrib[of "image _"] image_insert image_empty o_apply
  ..

lemma these_UNION: "Option.these (\<Union> (B ` A)) = (\<Union> ((Option.these o B) ` A))"
  by (auto simp: Option.these_def)

lemma meval_MPred'': "meval n t db (MPred e ts) = ([
  (\<Union>(e', x)\<in>db. if e = e' then set_option (map_option (\<lambda>f. tabulate f 0 n) (match ts x)) else {})], MPred e ts)"
  unfolding meval_MPred' these_UNION o_def prod.case_distrib[of Option.these]
  by (auto simp: Option.these_def map_option_case image_iff split: if_splits option.splits)

lemmas meval_code[code] = meval.simps(1) meval_MPred'' meval.simps(3-9)

definition db_code :: "(char list \<times> 'a list) list \<Rightarrow> (char list \<times> 'a list) set" where
  "db_code = set"

definition verdict_code :: "_ \<Rightarrow> (nat \<times> 'a :: ccompare option list) list" where
  "verdict_code = RBT_Set2.keys"

export_code HOL.equal Collection_Eq.ceq Collection_Order.ccompare Eq Lt Gt set_RBT set_impl phantom
  nat_of_integer integer_of_nat enat literal.explode db_code set interval RBT_set verdict_code
  MFOTL.Var MFOTL.Const
  MFOTL.Pred MFOTL.Eq MFOTL.Neg MFOTL.Or MFOTL.Exists
  MFOTL.Prev MFOTL.Next MFOTL.Since MFOTL.Until
  checking OCaml?

export_code HOL.equal Collection_Eq.ceq Collection_Order.ccompare Eq Lt Gt set_RBT set_impl phantom
  nat_of_integer integer_of_nat enat literal.explode db_code set interval RBT_set verdict_code
  MFOTL.Var MFOTL.Const
  MFOTL.Pred MFOTL.Eq MFOTL.Neg MFOTL.Or MFOTL.Exists
  MFOTL.Prev MFOTL.Next MFOTL.Since MFOTL.Until
  minit_safe mstep in OCaml module_name Monitor file_prefix "verified"

(*<*)
end
(*>*)


theory SpinLock
imports "../SpanningTree/Spanning" BruteForceAutomation
begin

definition newlock :: val where "newlock \<equiv>
  V\<lambda> None: Ref FalseE"
definition acquire :: val where "acquire \<equiv>
  rec: (Some ''acquire'') (Some ''l'') :=
    if: CAS (V ''l'') FalseE TrueE then #[()]
    else App (V ''acquire'') (V ''l'') endif"
definition release :: val where "release \<equiv>
  V\<lambda> (Some ''l''): ((V ''l'') \<leftarrow> FalseE)"

declare lockInG.inG_axioms[lock_inG_axiom, inG_axioms]

definition "lock_name :: gname \<equiv> 7"
definition lockN :: namespace where "lockN \<equiv> add_name nroot (string_to_name ''spin_lock'')"

context includes heap_syntax begin
definition lock_inv :: "gname \<Rightarrow> loc \<Rightarrow> iprop \<Rightarrow> iprop" where
  "lock_inv \<gamma> l R \<equiv> \<exists>\<^sub>u b. l\<mapsto>\<^sub>u#[b] \<^emph> (\<upharpoonleft>b \<or>\<^sub>u (\<upharpoonleft>(\<not>b) \<^emph> (own constr_lock \<gamma> (Ex ())) \<^emph> R))"

definition is_lock :: "gname \<Rightarrow> val \<Rightarrow> iprop \<Rightarrow> iprop" where
  "is_lock \<gamma> lk R \<equiv> \<exists>\<^sub>u l. \<upharpoonleft>(lk=#[l]) \<and>\<^sub>u inv constr_inv lockN (lock_inv \<gamma> l R)"

definition "locked \<gamma> \<equiv> own constr_lock \<gamma> (Ex ())"

context
fixes get_lock :: "gname \<Rightarrow> 'a::ucamera \<Rightarrow> lockG option"
  and put_lock
assumes lock_inG: "inG get_lock put_lock"
begin
definition locked' :: "gname \<Rightarrow> 'a upred_f" where
  "locked' \<gamma> = own put_lock \<gamma> (Ex ())"
end

lemma "locked' constr_lock = locked"
unfolding locked_def locked'_def[OF iPropShallow.lockInG.inG_axioms] by simp

lemma is_lock_pers: "persistent (is_lock \<gamma> lk R)"
  unfolding is_lock_def by (log_prog_solver)
declare is_lock_pers[unfolded is_lock_def, pers_rule, log_prog_rule]

lemma locked_timeless: "timeless (locked \<gamma>)"
  by (auto simp: lockInG.own_def constr_lock_def locked_def intro!: own_timeless' log_prog_rule)
declare locked_timeless[unfolded locked_def, timeless_rule, log_prog_rule]

lemma lock_alloc: "\<exists>\<^sub>u \<gamma>.\<Rrightarrow>\<^sub>b (locked \<gamma>)"
  apply iIntro
  apply (iExistsR "0::nat")
  unfolding locked_def
  apply (entails_substR rule:  lockInG.own_alloc)
  by (auto simp: valid_def constr_lock_def prod_n_valid_def \<epsilon>_n_valid valid_raw_ex_def)

lemmas [iris_simp] = lock_inv_def locked_def is_lock_def newlock_def acquire_def release_def

lemma newlock_spec:
  "{{ upred_emp }} App newlock #[()] {{ \<lambda>lk. \<forall>\<^sub>u R. (R ={UNIV}=\<^emph> (\<exists>\<^sub>u \<gamma>. is_lock \<gamma> lk R)) }}"
  \<comment> \<open>Unfold newlock definition\<close>
  apply (auto simp: newlock_def subst'_def intro!: wp_pure[OF wp_inG pure_exec_beta])
  \<comment> \<open>Remove wp based on @{thm wp_alloc}.\<close>
  apply (iApply rule: wp_alloc[OF wp_inG])
  apply (iDestruct rule: wp_mono[OF wp_inG])
  \<comment> \<open>Allocate lock and \<^const>\<open>lock_inv\<close>.\<close>
  apply (rule upred_forallI, rule upred_wandI)
  apply (rule add_holds[OF lock_alloc])
  apply iExistsL subgoal for v l R \<gamma>
  apply (iMod rule: upd_fupd[OF invInG.inG_axioms])
  apply (iApply_step "?P" rule: inv_alloc[OF invInG.inG_axioms, of "lock_inv _ _ R" _ lockN])
  apply (entails_substR rule: upred_laterI)
  apply (iExistsR False)
  apply (iFrame2 "?l\<mapsto>\<^sub>uFalseV\<^emph>R")
  apply (rule upred_entails_refl)
  \<comment> \<open>Cleanup\<close>
  apply (rule fupd_mono[OF invInG.inG_axioms])
  by (iExistsR \<gamma>)
  oops

(* Once again with another wp rule. Is more similar to the Coq version.*)
lemma newlock_spec:
  "{{ upred_emp }} App newlock #[()] {{ \<lambda>lk. \<forall>\<^sub>u R. (R ={UNIV}=\<^emph> (\<exists>\<^sub>u \<gamma>. is_lock \<gamma> lk R)) }}"
  apply (auto simp: newlock_def subst'_def intro!: wp_pure[OF wp_inG pure_exec_beta])
  apply (iWP rule: wp_alloc')
  apply (entails_substR rule: wp_value[OF wp_inG])
  apply iForallR
  apply (rule upred_wandI)
  apply (iDestruct rule: lock_alloc)
  apply (iMod rule: upd_fupd[OF invInG.inG_axioms])
  subgoal for l R \<gamma>
  apply (iMod_step "?P" rule: inv_alloc[OF invInG.inG_axioms, of "lock_inv _ _ R" _ lockN])
  apply (entails_substR rule: upred_laterI)
  apply iExistsR2
  apply (iFrame2 "?l\<mapsto>\<^sub>u?b") by frame_single+
  oops

lemma release_spec:
  "{{ is_lock \<gamma> lk R \<^emph> locked \<gamma> \<^emph> R }} App release lk {{ \<lambda>_. upred_emp }}"
  \<comment> \<open>Unfold release definition\<close>
  apply (simp add: release_def is_lock_def upred_pure_sep_conj' pull_exists_eq pull_exists_eq')
  apply (iDestruct rule: wp_pure[OF wp_inG pure_exec_beta]) subgoal for l
  \<comment> \<open>Open invaraint\<close>
  apply (iMod rule: inv_acc[OF invInG.inG_axioms subset_UNIV])
  \<comment> \<open>Apply @{thm wp_store}\<close>
  apply (move_sepL "\<triangleright> ?P")
  unfolding upred_later_exists
  apply iExistsL
  apply (iApply rule: upred_entail_eqL[OF upred_later_sep])
  apply (move_sepL "\<triangleright>(?l\<mapsto>\<^sub>u?v)")
  apply later_elim
  apply (iWP rule: wp_store')
  \<comment> \<open>Cleanup\<close>
  apply (entails_substR rule: upred_laterI)
  apply (entails_substR rule: wp_value[OF wp_inG])
  apply (iApply_wand_as_rule "\<exists>\<^sub>u (x::bool). ?P x" "(?l\<mapsto>\<^sub>u?v)\<^emph>(lockInG.own ?n ?x)\<^emph>R")
  apply (iExistsR False)
  apply (entails_substR rule: upred_laterI)
  by frame_single+
  oops

context begin

private lemma "lockInG.own \<gamma> (Ex ()) \<^emph> R \<^emph> (l \<mapsto>\<^sub>u FalseV) \<turnstile> l \<mapsto>\<^sub>u FalseV \<^emph> lockInG.own \<gamma> (Ex ()) \<^emph> R"
apply (tactic \<open>resolve0_tac @{thms upred_entails_trans[OF upred_sep_comm2R]} 1\<close>)
apply (tactic \<open>resolve0_tac @{thms upred_frame} 1\<close>)
apply (tactic \<open>EqSubst.eqsubst_tac \<^context> [1] @{thms upred_sep_comm} 1\<close>)
apply (tactic \<open>resolve0_tac @{thms upred_frame} 1\<close>)
apply (tactic \<open>resolve0_tac @{thms upred_entails_refl} 1\<close>)
oops

ML \<open>
  fun t ctxt = resolve_tac ctxt @{thms upred_entails_trans[OF upred_sep_comm2R]}
    THEN' resolve_tac ctxt @{thms upred_frame}
    THEN' EqSubst.eqsubst_tac ctxt [1] @{thms upred_sep_comm}
    THEN' resolve_tac ctxt @{thms upred_frame}
    THEN' resolve_tac ctxt @{thms upred_entails_refl}
  fun m ctxt = SIMPLE_METHOD' (t ctxt)
  val m' = Scan.succeed m
  val _ = Theory.local_setup (Method.local_setup \<^binding>\<open>m\<close> m' "")
\<close>

private lemma "lockInG.own \<gamma> (Ex ()) \<^emph> R \<^emph> (l \<mapsto>\<^sub>u FalseV) \<turnstile> l \<mapsto>\<^sub>u FalseV \<^emph> lockInG.own \<gamma> (Ex ()) \<^emph> R"
apply (tactic \<open>t \<^context> 1\<close>)
oops

private lemma "lockInG.own \<gamma> (Ex ()) \<^emph> R \<^emph> (l \<mapsto>\<^sub>u FalseV) \<turnstile> l \<mapsto>\<^sub>u FalseV \<^emph> lockInG.own \<gamma> (Ex ()) \<^emph> R"
apply m
oops

method m' =
  match conclusion in "_ \<^emph> P \<turnstile> _" for P \<Rightarrow>
    \<open>check_moveR P; rule upred_frame; m'\<close>
  \<bar> _ \<Rightarrow> \<open>rule upred_entails_refl\<close>

private lemma "lockInG.own \<gamma> (Ex ()) \<^emph> R \<^emph> (l \<mapsto>\<^sub>u FalseV) \<turnstile> l \<mapsto>\<^sub>u FalseV \<^emph> lockInG.own \<gamma> (Ex ()) \<^emph> R"
apply m'
oops

private lemma "lockInG.own \<gamma> (Ex ()) \<^emph> R \<^emph> (l \<mapsto>\<^sub>u FalseV) \<turnstile> l \<mapsto>\<^sub>u FalseV \<^emph> lockInG.own \<gamma> (Ex ()) \<^emph> R"
apply (rule framing, frame_solver)+
apply (rule framing_emp, frame_solver)
apply simp
oops

private lemma "lockInG.own \<gamma> (Ex ()) \<^emph> R \<^emph> (l \<mapsto>\<^sub>u FalseV) \<turnstile> l \<mapsto>\<^sub>u FalseV \<^emph> lockInG.own \<gamma> (Ex ()) \<^emph> R"
apply brute_force_solver
oops
end

lemmas spinlock_intros[intro] = wp_store'[OF wp_inG, simplified]
  upred_entails_substE[OF upred_entail_eqL[OF upred_later_sep]]
  wp_pure[OF wp_inG pure_exec_beta] wp_alloc'[OF wp_inG] upred_entails_trans[OF _ wp_value[OF wp_inG]]
  wp_mono[OF wp_inG] upred_forallI upred_wandI upred_existsE'
  upred_entails_substE[OF upd_fupd[OF invInG.inG_axioms, to_entailment]] elim_modal_entails'[OF elim_modal_fupd[OF invInG.inG_axioms]]
  elim_modal_entails[OF elim_modal_timeless'] elim_modal_entails'[OF elim_modal_timeless']
  upred_entails_trans[OF upred_wand_apply'] upred_entails_trans[OF _ upred_laterI] log_prog_rule
  upred_existsI upred_pure_impl upred_pure_impl' upred_pureI upred_pureI' upred_entails_refl
  upred_weakeningR upred_weakeningL fupd_mono upred_entails_conjI
  framing' can_be_split_refl can_be_split_baseR can_be_split_sepL
  elim_modal_entails'[OF elim_modal_fupd_wp_atomic] wp_inG

lemma move_pure: "(\<upharpoonleft>b) \<^emph> P = P \<^emph> \<upharpoonleft>b" "P \<^emph> (\<upharpoonleft>b) \<^emph> Q = P \<^emph> Q \<^emph> (\<upharpoonleft>b)"
    apply (rule upred_sep_comm) by (rule upred_sep_comm2_eq)

lemma move_disj: "P\<^emph>(Q\<or>\<^sub>uR) = (Q\<or>\<^sub>uR) \<^emph> P" by (rule upred_sep_comm)

lemmas new_lock_simps[simp] = iris_simp pull_exists_eq pull_exists_eq' move_pure
  move_disj upred_later_exists

definition diaframe_hint :: "iprop \<Rightarrow> ('b \<Rightarrow> iprop) \<Rightarrow> (iprop \<Rightarrow> iprop) \<Rightarrow> ('a \<Rightarrow> iprop) \<Rightarrow> ('b \<Rightarrow> 'a \<Rightarrow> iprop) \<Rightarrow> bool" where
  "diaframe_hint H L M A U \<equiv> \<forall>y::'b. (H \<^emph> L y \<turnstile> M (\<exists>\<^sub>u x::'a. A x \<^emph> U y x))"

lemma hintE: "diaframe_hint H L M A U \<Longrightarrow> (\<And>y::'b. (H \<^emph> L y \<turnstile> M (\<exists>\<^sub>u x::'a. A x \<^emph> U y x)))"
  unfolding diaframe_hint_def by simp

lemma inv_hint: "diaframe_hint upred_emp (\<lambda>x::'a. \<triangleright>(L x)) (linear_fupd E)
  (\<lambda>x::'a. inv constr_inv N (L x)) (\<lambda>_ x::'a. inv constr_inv N (L x))"
  apply (auto simp: diaframe_hint_def)
  apply (iMod rule: inv_alloc[OF invInG.inG_axioms, to_entailment])
  apply iExistsR2
  apply (rule upred_entails_trans[OF upred_entail_eqR[OF persistent_dupl]])
  by auto

lemma biabd_hint_apply_aux:
  assumes "diaframe_hint H L (fancy_upd E3 E2) A U"
  shows "H \<^emph> \<Turnstile>{E1,E3}=> (\<exists>\<^sub>u y. L y \<^emph> (\<forall>\<^sub>u x. (U y x) -\<^emph> (G x))) \<turnstile> \<Turnstile>{E1,E2}=> (\<exists>\<^sub>u x. G x \<^emph> A x)"
  apply (entails_substR rule: fupd_mask_trans[OF invInG.inG_axioms, of _ E3])
  apply (iMod rule: fupd_frame_r[OF invInG.inG_axioms, where ?R=H])
  apply iExistsL
  apply (iApply rule: hintE[OF assms])
  apply (iMod rule: fupd_frame_r[OF invInG.inG_axioms, where ?R="(\<forall>\<^sub>ux. U _ x -\<^emph> G x)"])
  apply iExistsL subgoal for y x
  apply (iExistsR x)
  apply (rule pull_forall_antecedent')
  apply (rule upred_entails_trans[OF upred_forall_inst[of _ x]])
  by auto
  done

lemma biabd_hint_apply:
assumes "diaframe_hint H L (fancy_upd E3 E2) A U" "\<Delta> \<turnstile> \<Turnstile>{E1,E3}=> (\<exists>\<^sub>u y. L y \<^emph> (\<forall>\<^sub>u x. (U y x) -\<^emph> (G x)))"
shows "\<Delta> \<^emph> H \<turnstile> \<Turnstile>{E1,E2}=> (\<exists>\<^sub>u x. G x \<^emph> A x)"
proof -
  from biabd_hint_apply_aux[OF assms(1)]
  have aux: "(\<Turnstile>{E1,E3}=>(\<exists>\<^sub>u y. L y \<^emph> (\<forall>\<^sub>u x. (U y x) -\<^emph> (G x)))) \<^emph> H \<turnstile> (\<Turnstile>{E1,E2}=>(\<exists>\<^sub>ux. G x \<^emph> A x))"
    apply (subst (2) upred_sep_comm) by simp
  show ?thesis
    apply (rule upred_entails_trans[OF upred_sep_mono[OF assms(2) upred_entails_refl[of H]]])
    by (rule aux)
qed

lemma biabd_hint_apply':
assumes "diaframe_hint H L (fancy_upd E3 E2) (\<lambda>_. A) (\<lambda>y _. U y)" "\<Delta> \<turnstile> \<Turnstile>{E1,E3}=> (\<exists>\<^sub>u y. L y \<^emph> ((U y) -\<^emph> G))"
shows "\<Delta> \<^emph> H \<turnstile> \<Turnstile>{E1,E2}=> (G \<^emph> A)"
proof -
  from assms(2) have "\<Delta> \<turnstile> \<Turnstile>{E1,E3}=> (\<exists>\<^sub>u y. L y \<^emph> (\<forall>\<^sub>u x. ((\<lambda>y _. U y) y x) -\<^emph> G))"
    by (simp add: drop_forall)
  from biabd_hint_apply[OF assms(1) this, unfolded drop_exists] show ?thesis .
qed

lemma wp_store_hint:"diaframe_hint upred_emp (\<lambda>_. \<Turnstile>{UNIV,E}=>(\<exists>\<^sub>u v'. (\<triangleright>(l\<mapsto>\<^sub>uv')) \<^emph> (\<triangleright>(((l\<mapsto>\<^sub>uv) ={E,UNIV}=\<^emph> \<Phi> #[()])))))
  (linear_fupd UNIV) (\<lambda>_. WP (Store #[l] (Val v)) {{ \<Phi> }}) (\<lambda>_ _. upred_emp)"
  unfolding diaframe_hint_def
  apply (simp add: drop_exists)
  apply(entails_substR rule: fupd_intro[OF invInG.inG_axioms])
  apply (rule elim_modal_entails[OF elim_modal_fupd_wp_atomic[OF wp_inG atomic_store]])
  apply iExistsL
  apply (move_sepL "\<triangleright>(?l\<mapsto>\<^sub>u?v)")
  apply later_elim
  apply (rule wp_store'[OF wp_inG, unfolded to_val_simp])
  apply (rule upred_later_mono_extL)
  apply (rule upred_entails_trans[OF _ wp_value[OF wp_inG]])
  by iApply_wand

lemmas inv_alloc' = biabd_hint_apply[OF inv_hint]
lemmas store_hint = biabd_hint_apply'[OF wp_store_hint]

lemma combine_exist:"(\<exists>\<^sub>u x. (\<exists>\<^sub>u y. P x y)) = (\<exists>\<^sub>u xy. P ((\<lambda>(x,y). x) xy) ((\<lambda>(x,y). y) xy))"
  apply transfer' by simp

lemma newlock_spec:
  "{{ upred_emp }} App newlock #[()] {{ \<lambda>lk. \<forall>\<^sub>u R. (R ={UNIV}=\<^emph> (\<exists>\<^sub>u \<gamma>. is_lock \<gamma> lk R)) }}"
  apply (simp | step)+
  apply (rule add_holds[OF lock_alloc])
  apply (simp | step)+
  apply (rule inv_alloc'[where ?G = "\<lambda> _. upred_emp",simplified])
  apply (entails_substR rule: fupd_intro[OF invInG.inG_axioms, to_entailment])
  apply (simp | step)
  apply (simp | step)
  apply (simp | step)
  apply (simp | step)
  apply (simp | step)
  apply (simp | step)
  oops

ML \<open>
  val x = (HOLogic.case_prod_const (dummyT,dummyT,dummyT))$ Abs ("\<gamma>", dummyT, Abs ("y", dummyT, Bound 0))$
    Var (("x",0), HOLogic.mk_prodT (dummyT,dummyT))
  val y = Free ("y", \<^typ>\<open>nat\<close>)
  val init = Envir.empty 0
  val z = Unify.unifiers (Context.Proof \<^context>, init, [(y,x)])
  val a = Seq.pull z
  val b = Unify.matchers (Context.Proof \<^context>) [(y,x)] |> Seq.pull
  val _ = Syntax.pretty_term \<^context> x |> Pretty.writeln
  val e = Thm.beta_conversion true (Thm.cterm_of \<^context> x)
  val f = Term.could_beta_contract x
\<close>

lemma move_invR: "inv constr_inv N Q \<^emph> P = P \<^emph> inv constr_inv N Q"
  "P \<^emph> inv constr_inv N R \<^emph> Q = P \<^emph> Q \<^emph> inv constr_inv N R"
  apply (rule upred_sep_comm) by (rule upred_sep_comm2_eq)

lemma move_invL: "P \<^emph> inv constr_inv N Q = inv constr_inv N Q \<^emph> P" by (rule upred_sep_comm)

lemma move_closerL: "P \<^emph> (Q={UNIV - names N,UNIV}=\<^emph>upred_emp) = (Q={UNIV - names N,UNIV}=\<^emph>upred_emp) \<^emph> P"
  by (rule upred_sep_comm)

lemma move_closerR: "(Q={UNIV - names N,UNIV}=\<^emph>upred_emp) \<^emph> P = P \<^emph> (Q={UNIV - names N,UNIV}=\<^emph>upred_emp)"
  "P \<^emph> (R={UNIV - names N,UNIV}=\<^emph>upred_emp) \<^emph> Q = P \<^emph> Q \<^emph> (R={UNIV - names N,UNIV}=\<^emph>upred_emp)"
  apply (rule upred_sep_comm) by (rule upred_sep_comm2_eq)

method inv_opener =
  ((unfold move_invR upred_pure_sep_conj')+)?,
  (rule upred_entails_substE[OF upred_entail_eqR[OF persistent_dupl]]
  | rule upred_entails_substE'[OF upred_entail_eqR[OF persistent_dupl]]),
  fast, unfold upred_sep_assoc_eq,
  (rule upred_entails_substE[OF inv_acc[OF invInG.inG_axioms, to_entailment,OF subset_UNIV]]
  | rule upred_entails_substE'[OF inv_acc[OF invInG.inG_axioms, to_entailment,OF subset_UNIV]]),
  (unfold move_closerL)?

lemma release_spec:
  "{{ is_lock \<gamma> lk R \<^emph> locked \<gamma> \<^emph> R }} App release lk {{ \<lambda>_. upred_emp }}"
  apply (simp | step)+
  apply inv_opener
  apply (simp | step)+
  unfolding move_closerR
  apply (simp | step)
  apply (simp | step)
  apply (simp | step)
  apply (simp | step)
  apply (simp | step)
  apply (simp | step)
  apply (simp | step)
  apply (simp | step)
  apply (simp | step)
  apply (simp | step)
  subgoal apply (rule split_last_frame) by step+
  apply (simp | step)
  oops

declare spinlock_intros[rule del]
declare new_lock_simps[simp del]

declare frame_rule_apply[OF upred_entails_trans[OF upred_entails_trans[OF lock_alloc[to_entailment] upred_exist_mono[OF upd_fupd[to_entailment]], unfolded locked_def] fupd_exists_lift[OF invInG.inG_axioms]], alloc_rule]
declare upred_later_exists[iris_simp]
declare upred_entails_trans[OF store_hint[where ?G = upred_emp, unfolded emp_rule to_val_simp] fupd_wp, wp_symbolic_execution_steps]
declare frame_baseL[frame_rule]

lemma newlock_spec:
  "{{{ upred_emp }}} App newlock #[()] {{{ \<lambda>lk. \<forall>\<^sub>u R. (R ={UNIV}=\<^emph> (\<exists>\<^sub>u \<gamma>. is_lock \<gamma> lk R)) }}}"
  by brute_force_solver

lemma release_spec:
  "{{{ is_lock \<gamma> lk R \<^emph> locked \<gamma> \<^emph> R }}} App release lk {{{ \<lambda>_. upred_emp }}}"
  by brute_force_solver
end
end


theory Example_Forte14
imports "../TopoS_Impl"
begin

definition policy :: "string list_graph" where
    "policy \<equiv> \<lparr> nodesL = [''CC'', ''C1'', ''C2'', ''IFEsrv'', ''IFE1'', ''IFE2'', ''SAT'', ''Wifi'', ''P1'', ''P2'' ],
                edgesL = [(''CC'', ''C1''), (''CC'', ''C2''), (''CC'', ''IFEsrv''), (''C1'', ''CC''),
                          (''C1'', ''C2''), (''C2'', ''CC''), (''C2'', ''C1''),
                          (''IFEsrv'', ''IFE1''), (''IFEsrv'', ''IFE2''), (''IFEsrv'', ''SAT''), (''IFEsrv'', ''Wifi''),
                          (''IFE1'', ''IFEsrv''), (''IFE2'', ''IFEsrv''),
                          (''Wifi'', ''IFEsrv''), (''Wifi'', ''SAT''), (''Wifi'', ''P1''),
                          (''Wifi'', ''P2''), (''P1'', ''Wifi''), (''P1'', ''P2''), (''P2'', ''Wifi''), (''P2'', ''P1'')
                          ] \<rparr>"

lemma "wf_list_graph policy" by eval

(*21 rules*)
lemma "length (edgesL policy) = 21" by eval

definition DomainHierarchy_m::"(string SecurityInvariant)" where
      "DomainHierarchy_m \<equiv> new_configured_list_SecurityInvariant SINVAR_DomainHierarchyNG_impl.SINVAR_LIB_DomainHierarchyNG \<lparr>
          node_properties = [
            ''CC'' \<mapsto> DN (''aircraft''--''crew''--Leaf, 1),
            ''C1'' \<mapsto> DN (''aircraft''--''crew''--Leaf, 0),
            ''C2'' \<mapsto> DN (''aircraft''--''crew''--Leaf, 0),
            ''IFEsrv'' \<mapsto> DN (''aircraft''--''entertain''--Leaf, 0),
            ''IFE1'' \<mapsto> DN (''aircraft''--''entertain''--Leaf, 0),
            ''IFE2'' \<mapsto> DN (''aircraft''--''entertain''--Leaf, 0),
            ''SAT'' \<mapsto> DN (''aircraft''--''entertain''--''INET''--Leaf, 0),
            ''Wifi'' \<mapsto> DN (''aircraft''--''entertain''--''POD''--Leaf, 1),
            ''P1'' \<mapsto> DN (''aircraft''--''entertain''--''POD''--Leaf, 0),
            ''P2'' \<mapsto> DN (''aircraft''--''entertain''--''POD''--Leaf, 0)
          ]
          \<rparr> ''Device Hierarchy''"
  text{*sanity check that the host attributes correspond to the desired hierarchy*}
  lemma "DomainHierarchyNG_sanity_check_config
    (map snd [
            (''CC'', DN (''aircraft''--''crew''--Leaf, 1)),
            (''C1'', DN (''aircraft''--''crew''--Leaf, 0)),
            (''C2'', DN (''aircraft''--''crew''--Leaf, 0)),
            (''IFEsrv'', DN (''aircraft''--''entertain''--Leaf, 0)),
            (''IFE1'', DN (''aircraft''--''entertain''--Leaf, 0)),
            (''IFE2'', DN (''aircraft''--''entertain''--Leaf, 0)),
            (''SAT'', DN (''aircraft''--''entertain''--''INET''--Leaf, 0)),
            (''Wifi'', DN (''aircraft''--''entertain''--''POD''--Leaf, 1)),
            (''P1'', DN (''aircraft''--''entertain''--''POD''--Leaf, 0)),
            (''P2'', DN (''aircraft''--''entertain''--''POD''--Leaf, 0))
                            ])
            (
            Department ''aircraft'' [
              Department ''entertain'' [
                Department ''POD'' [], Department ''INET'' []
              ],
              Department ''crew'' []
            ])" by eval

definition PolEnforcePoint_m::"(string SecurityInvariant)" where
  "PolEnforcePoint_m \<equiv> new_configured_list_SecurityInvariant SINVAR_LIB_PolEnforcePointExtended \<lparr>
          node_properties = [''IFEsrv'' \<mapsto> SINVAR_SecGwExt.PolEnforcePointIN,
                             ''IFE1'' \<mapsto> SINVAR_SecGwExt.DomainMember,
                             ''IFE2'' \<mapsto> SINVAR_SecGwExt.DomainMember]
          \<rparr> ''IFEsrc mediates access of its thin clients''"

(*
0 - unclassified
1 - confidential
2 - secret
3 - topsecret
*)
definition BLP_m::"(string SecurityInvariant)" where
    "BLP_m \<equiv> new_configured_list_SecurityInvariant SINVAR_LIB_BLPtrusted \<lparr>
          node_properties = [''CC'' \<mapsto> \<lparr> security_level = 2, trusted = False \<rparr>,
                             ''C1'' \<mapsto> \<lparr> security_level = 2, trusted = False \<rparr>,
                             ''C2'' \<mapsto> \<lparr> security_level = 2, trusted = False \<rparr>,
                             ''IFE1'' \<mapsto> \<lparr> security_level = 1, trusted = False \<rparr>,
                             ''IFE2'' \<mapsto> \<lparr> security_level = 1, trusted = False \<rparr>,
                             ''IFEsrv'' \<mapsto> \<lparr> security_level = 0, trusted = True \<rparr>]
          \<rparr> ''Confidential data''"

definition "security_invariants = [ DomainHierarchy_m, PolEnforcePoint_m, BLP_m]"

lemma "all_security_requirements_fulfilled security_invariants policy" by eval

lemma "implc_get_offending_flows security_invariants policy = []" by eval

text{*
Visualization with a violation.
*}
ML{*
visualize_graph @{context} @{term "security_invariants"} @{term "policy\<lparr>edgesL := (''P1'', ''CC'')#edgesL policy\<rparr>"};
*}

definition "max_policy = generate_valid_topology security_invariants \<lparr>nodesL = nodesL policy, edgesL = List.product (nodesL policy) (nodesL policy) \<rparr>"

text{*calculating the maximum policy*}
value "max_policy"

text{*
The diff to the maximum policy. It adds reflexive flows and the IFEsrv may send to the PODs.
*}
ML_val{*
visualize_edges @{context} @{term "edgesL policy"}
    [("edge [dir=\"arrow\", style=dashed, color=\"#FF8822\", constraint=false]", @{term "[e \<leftarrow> edgesL max_policy. e \<notin> set (edgesL policy)]"})] "";
*}

text{*
Visualizing the maximum policy.
*}
ML{*
visualize_graph @{context} @{term "security_invariants"} @{term "max_policy"};
*}

lemma "all_security_requirements_fulfilled security_invariants policy" by eval
lemma "all_security_requirements_fulfilled security_invariants max_policy" by eval

subsection{*A stateful implementation*}
definition "stateful_policy = generate_valid_stateful_policy_IFSACS policy security_invariants"
value "stateful_policy"

ML_val{*
visualize_edges @{context} @{term "flows_fixL stateful_policy"}
    [("edge [dir=\"arrow\", style=dashed, color=\"#FF8822\", constraint=false]", @{term "flows_stateL stateful_policy"})] "";
*}

end


(*  Title:      HOL/Auth/n_germanSimp_lemma_inv__20_on_rules.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_inv__20_on_rules imports n_germanSimp_lemma_on_inv__20
begin
section{*All lemmas on causal relation between inv__20*}
lemma lemma_inv__20_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__20  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  proof -
  have c1: "(\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvReqS N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvReqE__part__0 N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvReqE__part__1 N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInv__part__0  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInv__part__1  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInvAck  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendGntS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendGntE N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvGntS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvGntE  i)"
  apply (cut_tac b1, auto) done
    moreover {
      assume d1: "(\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_StoreVsinv__20) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvReqS N i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvReqSVsinv__20) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvReqE__part__0 N i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvReqE__part__0Vsinv__20) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvReqE__part__1 N i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvReqE__part__1Vsinv__20) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendInv__part__0  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendInv__part__0Vsinv__20) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendInv__part__1  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendInv__part__1Vsinv__20) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendInvAck  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendInvAckVsinv__20) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvInvAckVsinv__20) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendGntS  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendGntSVsinv__20) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendGntE N i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendGntEVsinv__20) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntS  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvGntSVsinv__20) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntE  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvGntEVsinv__20) done
    }

  ultimately show "invHoldForRule s f r (invariants N)"
  by satx
qed

end


(*  Title:      HOL/Auth/n_germanSimp_lemma_on_inv__48.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__48 imports n_germanSimp_base
begin
section{*All lemmas on causal relation between inv__48 and some rule r*}
lemma n_RecvReqSVsinv__48:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_RecvReqS N i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__48  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_RecvReqS N i" apply fastforce done
from a2 obtain p__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__48  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 "?P3 s"
  apply (cut_tac a1 a2 b1, simp, rule_tac x="(neg (andForm (eqn (IVar (Field (Para (Ident ''Chan2'') p__Inv4) ''Cmd'')) (Const Inv)) (eqn (IVar (Field (Para (Ident ''Cache'') p__Inv4) ''State'')) (Const I))))" in exI, auto) done
  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 (Ident ''CurCmd'')) (Const Empty)) (eqn (IVar (Field (Para (Ident ''Chan2'') p__Inv4) ''Cmd'')) (Const Inv))))" 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

lemma n_RecvReqE__part__0Vsinv__48:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_RecvReqE__part__0 N i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__48  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_RecvReqE__part__0 N i" apply fastforce done
from a2 obtain p__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__48  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_RecvReqE__part__1Vsinv__48:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_RecvReqE__part__1 N i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__48  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_RecvReqE__part__1 N i" apply fastforce done
from a2 obtain p__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__48  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_SendInv__part__0Vsinv__48:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendInv__part__0  i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__48  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__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__48  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_SendInv__part__1Vsinv__48:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendInv__part__1  i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__48  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__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__48  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_SendInvAckVsinv__48:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendInvAck  i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__48  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__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__48  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_RecvInvAckVsinv__48:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__48  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_RecvInvAck  i" apply fastforce done
from a2 obtain p__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__48  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 "((formEval (eqn (IVar (Ident ''ExGntd'')) (Const true)) s))\<or>((formEval (neg (eqn (IVar (Ident ''ExGntd'')) (Const true))) s))" by auto
  moreover {
    assume c1: "((formEval (eqn (IVar (Ident ''ExGntd'')) (Const true)) s))"
    have "?P3 s"
    apply (cut_tac a1 a2 b1 c1, simp, rule_tac x="(neg (andForm (eqn (IVar (Field (Para (Ident ''Chan2'') p__Inv4) ''Cmd'')) (Const Inv)) (eqn (IVar (Field (Para (Ident ''Chan3'') p__Inv4) ''Cmd'')) (Const InvAck))))" in exI, auto) done
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (neg (eqn (IVar (Ident ''ExGntd'')) (Const true))) s))"
    have "?P2 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  ultimately have "invHoldForRule s f r (invariants N)" by satx
}
moreover {
  assume b1: "(i~=p__Inv4)"
  have "((formEval (eqn (IVar (Ident ''ExGntd'')) (Const true)) s))\<or>((formEval (neg (eqn (IVar (Ident ''ExGntd'')) (Const true))) s))" by auto
  moreover {
    assume c1: "((formEval (eqn (IVar (Ident ''ExGntd'')) (Const true)) s))"
    have "?P3 s"
    apply (cut_tac a1 a2 b1 c1, simp, rule_tac x="(neg (andForm (andForm (eqn (IVar (Ident ''CurCmd'')) (Const ReqS)) (eqn (IVar (Field (Para (Ident ''Chan2'') p__Inv4) ''Cmd'')) (Const Inv))) (eqn (IVar (Field (Para (Ident ''Chan3'') i) ''Cmd'')) (Const InvAck))))" in exI, auto) done
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (neg (eqn (IVar (Ident ''ExGntd'')) (Const true))) s))"
    have "?P2 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  ultimately have "invHoldForRule s f r (invariants N)" by satx
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_SendGntSVsinv__48:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendGntS  i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__48  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__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__48  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_SendGntEVsinv__48:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendGntE N i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__48  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__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__48  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_RecvGntSVsinv__48:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntS  i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__48  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__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__48  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_RecvGntEVsinv__48:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntE  i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__48  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__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__48  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_StoreVsinv__48:
  assumes a1: "\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d" and
  a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__48  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

end