(*
   Title: The pi-calculus
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Weak_Early_Bisim_Subst_SC
  imports Weak_Early_Cong_Subst Strong_Early_Bisim_Subst_SC
begin

(******** Structural Congruence **********)

(******** The \<nu>-operator *****************)

lemma resComm:
  fixes P :: pi

  shows "<\<nu>a><\<nu>b>P \<simeq>\<^sup>s <\<nu>b><\<nu>a>P"
proof -
  have "<\<nu>a><\<nu>b>P \<sim>\<^sup>s\<^sub>e <\<nu>b><\<nu>a>P"
    by(rule Strong_Early_Bisim_Subst_SC.resComm)
  thus ?thesis by(rule strongEqWeakCong)
qed

(******** Match *********)

lemma matchId:
  fixes a :: name
  and   P :: pi

  shows "[a\<frown>a]P \<simeq>\<^sup>s P"
proof -
  have "[a\<frown>a]P \<sim>\<^sup>s\<^sub>e P" by(rule Strong_Early_Bisim_Subst_SC.matchId)
  thus ?thesis by(rule strongEqWeakCong)
qed

(******** Mismatch *********)

  shows "[a\<noteq>a]P \<simeq>\<^sup>s \<zero>"
proof -
  have "[a\<noteq>a]P \<sim>\<^sup>s\<^sub>e \<zero>" by(rule Strong_Early_Bisim_Subst_SC.mismatchNil)
  thus ?thesis by(rule strongEqWeakCong)
qed

(******** The +-operator *********)

lemma sumSym:
  fixes P :: pi
  and   Q :: pi

  shows "P \<oplus> Q \<simeq>\<^sup>s Q \<oplus> P"
proof -
  have "P \<oplus> Q \<sim>\<^sup>s\<^sub>e Q \<oplus> P" by(rule Strong_Early_Bisim_Subst_SC.sumSym)
  thus ?thesis by(rule strongEqWeakCong)
qed

(******** The |-operator *********)

lemma parZero:
  fixes P :: pi

  shows "P \<parallel> \<zero> \<simeq>\<^sup>s P"
proof -
  have "P \<parallel> \<zero> \<sim>\<^sup>s\<^sub>e P" by(rule Strong_Early_Bisim_Subst_SC.parZero)
  thus ?thesis by(rule strongEqWeakCong)
qed

lemma parSym:
  fixes P :: pi
  and   Q :: pi

  shows "P \<parallel> Q \<simeq>\<^sup>s Q \<parallel> P"
proof -
  have "P \<parallel> Q \<sim>\<^sup>s\<^sub>e Q \<parallel> P" by(rule Strong_Early_Bisim_Subst_SC.parSym)
  thus ?thesis by(rule strongEqWeakCong)
qed

  assumes "x \<sharp> P"

  shows "<\<nu>x>(P \<parallel> Q) \<simeq>\<^sup>s P \<parallel> <\<nu>x>Q"
proof -
  from \<open>x \<sharp> P\<close> have "<\<nu>x>(P \<parallel> Q) \<sim>\<^sup>s\<^sub>e P \<parallel> <\<nu>x>Q" by(rule Strong_Early_Bisim_Subst_SC.scopeExtPar)
  thus ?thesis by(rule strongEqWeakCong)
qed

lemma scopeExtPar':
  fixes P :: pi
  and   Q :: pi
  and   x :: name

  assumes "x \<sharp> Q"

  shows "<\<nu>x>(P \<parallel> Q) \<simeq>\<^sup>s (<\<nu>x>P) \<parallel> Q"
proof -
  from \<open>x \<sharp> Q\<close> have "<\<nu>x>(P \<parallel> Q) \<sim>\<^sup>s\<^sub>e (<\<nu>x>P) \<parallel> Q" by(rule Strong_Early_Bisim_Subst_SC.scopeExtPar')
  thus ?thesis by(rule strongEqWeakCong)
qed

  shows "(P \<parallel> Q) \<parallel> R \<simeq>\<^sup>s P \<parallel> (Q \<parallel> R)"
proof -
  have "(P \<parallel> Q) \<parallel> R \<sim>\<^sup>s\<^sub>e P \<parallel> (Q \<parallel> R)" by(rule Strong_Early_Bisim_Subst_SC.parAssoc)
  thus ?thesis by(rule strongEqWeakCong)
qed

lemma freshRes:
  fixes P :: pi
  and   a :: name

  assumes "a \<sharp> P"

  shows "<\<nu>a>P \<simeq>\<^sup>s P"
proof -
  from \<open>a \<sharp> P\<close> have "<\<nu>a>P \<sim>\<^sup>s\<^sub>e P" by(rule Strong_Early_Bisim_Subst_SC.freshRes)
  thus ?thesis by(rule strongEqWeakCong)
qed

lemma scopeExtSum:
  fixes P :: pi
  and   Q :: pi
  and   x :: name

  assumes "x \<sharp> P"

  shows "<\<nu>x>(P \<oplus> Q) \<simeq>\<^sup>s P \<oplus> <\<nu>x>Q"
proof -
  from \<open>x \<sharp> P\<close> have "<\<nu>x>(P \<oplus> Q) \<sim>\<^sup>s\<^sub>e P \<oplus> <\<nu>x>Q" by(rule Strong_Early_Bisim_Subst_SC.scopeExtSum)
  thus ?thesis by(rule strongEqWeakCong)
qed

lemma bangSC:
  fixes P

  shows "!P \<simeq>\<^sup>s P \<parallel> !P"
proof -
  have "!P \<sim>\<^sup>s\<^sub>e P \<parallel> !P" by(rule Strong_Early_Bisim_Subst_SC.bangSC)
  thus ?thesis by(rule strongEqWeakCong)
qed

end


(*
 * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
 *
 * SPDX-License-Identifier: BSD-2-Clause
 *)

theory XPres
imports SIMPL_Lemmas
begin

(* FIXME: move *)
lemmas trivial = TrueE[OF TrueI]

(* Intended to be used to calculate `z` from `b`, `x` and `y`. *)
definition xpres_eq_If :: "bool \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool" where
  "xpres_eq_If b x y z \<equiv> z = (if b then x else y)"

lemma xpres_eq_If_False:
  "xpres_eq_If False x y y"
  by (simp add: xpres_eq_If_def)

lemma xpres_eq_If_True:
  "xpres_eq_If True x y x"
  by (simp add: xpres_eq_If_def)

lemmas xpres_eq_If_rules = xpres_eq_If_False xpres_eq_If_True

(* Intended to be used to calculate `abnormal` by syntactic analysis of `c`.
   `abnormal` should be true if syntactic analysis of `c` shows that `c`
   never terminates normally. Note that this does not imply that `c` necessarily
   terminates abruptly. *)
definition xpres_abnormal where
  "xpres_abnormal \<Gamma> c abnormal \<equiv> \<forall>s t. abnormal \<longrightarrow> \<not> \<Gamma> \<turnstile> \<langle>c, Normal s\<rangle> \<Rightarrow> Normal t"

lemma xpres_abnormalD:
  assumes "xpres_abnormal \<Gamma> c abnormal"
  assumes "abnormal"
  assumes "\<Gamma> \<turnstile> \<langle>c, Normal s\<rangle> \<Rightarrow> Normal t"
  shows False
  using assms by (auto simp: xpres_abnormal_def)

lemma xpres_abnormalI:
  assumes "\<And>s t. \<lbrakk>abnormal; \<Gamma> \<turnstile> \<langle>c, Normal s\<rangle> \<Rightarrow> Normal t\<rbrakk> \<Longrightarrow> False"
  shows "xpres_abnormal \<Gamma> c abnormal"
  using assms by (auto simp: xpres_abnormal_def)

lemma xpres_abnormal_trivial:
  "xpres_abnormal \<Gamma> c False"
  by (auto simp: xpres_abnormal_def)

lemma xpres_abnormal_throw:
  "xpres_abnormal \<Gamma> Throw True"
  by (auto simp: xpres_abnormal_def elim!: exec_elim_cases)

lemma xpres_abnormal_creturn:
  "xpres_abnormal \<Gamma> (creturn rtu xfu v) True"
  by (auto simp: xpres_abnormal_def creturn_def elim!: exec_elim_cases)

lemma xpres_abnormal_creturn_void:
  "xpres_abnormal \<Gamma> (creturn_void rtu) True"
  by (auto simp: xpres_abnormal_def creturn_void_def elim!: exec_elim_cases)

lemma xpres_abnormal_cbreak:
  "xpres_abnormal \<Gamma> (cbreak rtu) True"
  by (auto simp: xpres_abnormal_def cbreak_def elim!: exec_elim_cases)

lemma xpres_abnormal_guard:
  assumes "xpres_abnormal \<Gamma> c abnormal"
  shows "xpres_abnormal \<Gamma> (Guard f g c) abnormal"
  apply (rule xpres_abnormalI)
  apply (erule exec_elim_cases; clarsimp; erule (1) assms[THEN xpres_abnormalD])
  done

lemma xpres_abnormal_seq:
  assumes C: "xpres_abnormal \<Gamma> c C"
             "xpres_abnormal \<Gamma> d D"
  assumes S: "xpres_eq_If C True D S"
  shows "xpres_abnormal \<Gamma> (Seq c d) S"
  apply (rule xpres_abnormalI)
  apply (erule exec_elim_cases; clarsimp)
  apply (frule Normal_result, clarsimp, rename_tac s s')
  apply (clarsimp simp: S[unfolded xpres_eq_If_def] if_bool_simps)
  apply (erule disjE; erule (1) C[THEN xpres_abnormalD])
  done

lemma xpres_abnormal_cond:
  assumes C: "xpres_abnormal \<Gamma> c C"
             "xpres_abnormal \<Gamma> d D"
  assumes S: "xpres_eq_If C D False S" (* S = (C \<and> D) *)
  shows "xpres_abnormal \<Gamma> (Cond b c d) S"
  apply (rule xpres_abnormalI)
  apply (clarsimp simp: S[unfolded xpres_eq_If_def] if_bool_simps)
  apply (erule exec_elim_cases; clarsimp; erule (1) C[THEN xpres_abnormalD])
  done

lemma xpres_abnormal_call:
  assumes "\<And>s t. xpres_abnormal \<Gamma> (ret s t) abnormal"
  shows "xpres_abnormal \<Gamma> (call i f reset ret) abnormal"
  using assms by (auto simp: xpres_abnormal_def elim: exec_call_Normal_elim)

lemmas xpres_abnormal_rules
  = xpres_abnormal_creturn xpres_abnormal_creturn_void xpres_abnormal_cbreak xpres_abnormal_guard
    xpres_abnormal_seq xpres_abnormal_cond xpres_abnormal_call

(* Intended to be used to calculate `pres_norm`, `pres_abr` and `abnormal`
   by syntactic analysis of `c`.

   Input parameters:
   - c: the program under consideration.
   - xf: a function that extracts the value of a particular variable from the state.
   - v: the presumed value of the variable prior to executing `c`.

   Ouptut parameters:
   - pres_norm: true if syntactic analysis of `c` shows that the variable
     still has the value `v` whenever `c` terminates normally.
   - pres_abr: true if syntactic analysis of `c` shows that the variable
     still has the value `v` whenever `c` terminates abruptly.
   - abormal: true if syntactic analysis shows that `c` never terminates normally. *)
definition xpres_strong ::
  "('s,'p,'f) body \<Rightarrow> ('s \<Rightarrow> 'v) \<Rightarrow> 'v \<Rightarrow> ('s,'p,'f) com \<Rightarrow> bool \<Rightarrow> bool \<Rightarrow> bool \<Rightarrow> bool"
  where
  "xpres_strong \<Gamma> xf v c pres_norm pres_abr abnormal
   \<equiv> (\<forall>s t. (\<Gamma> \<turnstile> \<langle>c, Normal s\<rangle> \<Rightarrow> Normal t \<longrightarrow> \<not> abnormal \<and> (pres_norm \<longrightarrow> xf s = v \<longrightarrow> xf t = v))
          \<and> (\<Gamma> \<turnstile> \<langle>c, Normal s\<rangle> \<Rightarrow> Abrupt t \<longrightarrow> pres_abr \<longrightarrow> xf s = v \<longrightarrow> xf t = v))
      \<and> (abnormal \<longrightarrow> pres_norm)"

(* For compatibility with older proofs. *)
abbreviation "xpres \<Gamma> xf v c \<equiv> xpres_strong \<Gamma> xf v c True True False"

lemma xpres_def:
  "xpres \<Gamma> xf v c \<equiv> \<forall>s t. \<Gamma> \<turnstile> \<langle>c, Normal s\<rangle> \<Rightarrow> t
                          \<longrightarrow> xf s = v \<longrightarrow> (\<forall>t'. t = Normal t' \<or> t = Abrupt t' \<longrightarrow> xf t' = v)"
  by (auto simp: xpres_strong_def atomize_eq)

lemma xpres_strongI:
  assumes "\<And>s t. \<lbrakk>pres_norm; \<Gamma> \<turnstile> \<langle>c, Normal s\<rangle> \<Rightarrow> Normal t; xf s = v\<rbrakk> \<Longrightarrow> xf t = v"
  assumes "\<And>s t. \<lbrakk>pres_abr; \<Gamma> \<turnstile> \<langle>c, Normal s\<rangle> \<Rightarrow> Abrupt t; xf s = v\<rbrakk> \<Longrightarrow> xf t = v"
  assumes "\<And>s t. \<lbrakk>abnormal; \<Gamma> \<turnstile> \<langle>c, Normal s\<rangle> \<Rightarrow> Normal t\<rbrakk> \<Longrightarrow> False"
  assumes "abnormal \<Longrightarrow> pres_norm"
  shows "xpres_strong \<Gamma> xf v c pres_norm pres_abr abnormal"
  unfolding xpres_strong_def
  by (intro allI impI conjI notI; erule assms)

lemma xpres_strong_abnormalD:
  "xpres_strong \<Gamma> xf v c pres_norm pres_abr abnormal \<Longrightarrow> abnormal \<Longrightarrow> pres_norm"
  by (simp add: xpres_strong_def)

lemma xpresI:
  "\<lbrakk>\<And>s t t'. \<lbrakk>\<Gamma> \<turnstile> \<langle>c, Normal s\<rangle> \<Rightarrow> t; xf s = v; t = Normal t' \<or> t = Abrupt t' \<rbrakk> \<Longrightarrow> xf t' = v\<rbrakk> \<Longrightarrow>
  xpres \<Gamma> xf v c"
  unfolding xpres_def by auto

lemma xpres_strong_abnormal_iff:
  "xpres_strong \<Gamma> xf v c abnormal False abnormal \<longleftrightarrow> xpres_abnormal \<Gamma> c abnormal"
  by (auto simp: xpres_strong_def xpres_abnormal_def)

lemma xpres_skip:
  "xpres \<Gamma> xf v Skip"
  by (rule xpresI; erule exec_Normal_elim_cases; simp)

lemma xpres_strong_basic':
  assumes rl: "\<And>s. pres_norm \<Longrightarrow> xf s = v \<Longrightarrow> xf (f s) = v"
  shows "xpres_strong \<Gamma> xf v (Basic f) pres_norm pres_abr False"
  by (rule xpres_strongI; simp?; erule exec_Normal_elim_cases; clarsimp simp: rl)

lemmas xpres_strong_basic = xpres_strong_basic'[where pres_abr=True]
lemmas xpres_basic = xpres_strong_basic[where pres_norm=True, simplified]

lemma xpres_basic_False:
  "xpres_strong \<Gamma> xf v (Basic f) False True False"
  by (rule xpres_strong_basic, simp)

lemma xpres_exec_Normal:
  assumes "xpres_strong \<Gamma> xf v c pres_norm pres_abr abnormal"
  assumes pres_norm
  assumes "\<Gamma> \<turnstile> \<langle>c, Normal s\<rangle> \<Rightarrow> Normal t"
  assumes "xf s = v"
  shows "xf t = v"
  using assms unfolding xpres_strong_def
  apply -
  by (drule (1) mp | erule allE conjE trivial)+

lemma xpres_exec_Abrupt:
  assumes xp: "xpres_strong \<Gamma> xf v c pres_norm pres_abr abnormal"
  assumes pa: pres_abr
  assumes ex: "\<Gamma> \<turnstile> \<langle>c, Normal s\<rangle> \<Rightarrow> Abrupt t"
  assumes xf: "xf s = v"
  shows   "xf t = v"
  using assms unfolding xpres_strong_def
  apply -
  by (drule (1) mp | erule allE conjE trivial)+

lemma xpres_exec_abnormal:
  assumes "xpres_strong \<Gamma> xf v c pres_norm pres_abr abnormal"
  assumes abnormal
  assumes "\<Gamma> \<turnstile> \<langle>c, Normal s\<rangle> \<Rightarrow> Normal t"
  shows "False"
  using assms unfolding xpres_strong_def
  apply -
  by (drule (1) mp | erule allE conjE notE)+

lemmas xpres_execs = xpres_exec_Normal xpres_exec_Abrupt

(* If `b` never produces a `Normal` result, then we vacuously have that whenever
   the sequence results in a `Normal` state, then `xf` is preserved. Together with
   the rule for `Cond`, this is useful in situations like this:
     IF condition THEN
       \<acute>xf := modified_value ;;
       return
     FI ;;
     // here, `xf` is still preserved.  *)
lemma xpres_strong_seq:
  assumes xpa: "xpres_strong \<Gamma> xf v c c_pres_norm c_pres_abr c_abnormal"
  assumes xpb: "xpres_strong \<Gamma> xf v d d_pres_norm d_pres_abr d_abnormal"
  notes xps = xpa xpb
  \<comment> \<open>abnormal \<longleftrightarrow> c_abnormal \<or> d_abnormal\<close>
  \<comment> \<open>pres_norm \<longleftrightarrow> c_pres_norm \<and> d_pres_norm \<or> abnormal\<close>
  \<comment> \<open>pres_abr \<longleftrightarrow> c_pres_abr \<and> c_pres_norm \<and> d_pres_abr \<or> c_abnormal \<and> c_pres_abr\<close>
  assumes ifs: "xpres_eq_If c_abnormal True d_abnormal abnormal"
               "xpres_eq_If c_pres_norm d_pres_norm False cd_pres_norm"
               "xpres_eq_If cd_pres_norm True abnormal pres_norm"
               "xpres_eq_If c_pres_norm d_pres_abr False c_norm_d_pres_abr"
               "xpres_eq_If c_pres_abr c_norm_d_pres_abr False cd_pres_abr"
               "xpres_eq_If c_abnormal c_pres_abr False c_abnormal_pres_abr"
               "xpres_eq_If cd_pres_abr True c_abnormal_pres_abr pres_abr"
  shows "xpres_strong \<Gamma> xf v (c ;; d) pres_norm pres_abr abnormal"
  unfolding ifs[simplified xpres_eq_If_def if_bool_simps]
  apply (rule xpres_strongI
         ; simp?
         ; erule exec_Normal_elim_cases
         ; erule Normal_resultE Abrupt_resultE
         ; simp
         ; elim disjE conjE exec_elim_cases)
          apply (all \<open>(drule (1) xps[THEN xpres_exec_abnormal], simp)?\<close>)
     apply (all \<open>(drule (2) xpres_execs[OF xpa])\<close>, simp_all)
   apply (all \<open>(erule (2) xpres_execs[OF xpb])\<close>)
  done

lemma xpres_seq:
  assumes xpa: "xpres \<Gamma> xf v a"
  assumes xpb: "xpres \<Gamma> xf v b"
  shows "xpres \<Gamma> xf v (a ;; b)"
  by (rule xpres_strong_seq[OF xpa xpb] xpres_eq_If_rules)+

lemma xpres_strong_while0:
  assumes ex: "\<Gamma>\<turnstile> \<langle>d,s\<rangle> \<Rightarrow> t"
  and     xp: "xpres_strong \<Gamma> xf v a pres_norm pres_abr abnormal"
  and      d: "d = While b a"
  and      s: "s \<in> Normal ` {s. xf s = v} \<union> Abrupt ` {s. xf s = v}"
  and      t: "pres_norm \<and> t = Normal t' \<or> pres_norm \<and> pres_abr \<and> t = Abrupt t'"
  shows    "xf t' = v"
  using ex d s t
proof (induct)
  case (WhileTrue s' b' c' t u)
  hence eqs: "b' = b" "c' = a" and xfs: "xf s' = v" by auto
  {
    fix w
    assume tv: "t = Normal w" and "\<Gamma> \<turnstile> \<langle>a, Normal s'\<rangle> \<Rightarrow> Normal w" and pres_norm

    have ?thesis
    proof (rule WhileTrue.hyps(5))
      have "xf w = v" by (rule xpres_exec_Normal) fact+
      thus "t \<in> Normal ` {s. xf s = v} \<union> Abrupt ` {s. xf s = v}" using tv
        by simp
    qed fact+
  } moreover
  {
    fix w
    assume tv: "t = Abrupt w" and "\<Gamma> \<turnstile> \<langle>a, Normal s'\<rangle> \<Rightarrow> Abrupt w" and pres_abr
    have ?thesis
    proof (rule WhileTrue.hyps(5))
      have "xf w = v" by (rule xpres_exec_Abrupt) fact+
      thus "t \<in> Normal ` {s. xf s = v} \<union> Abrupt ` {s. xf s = v}" using tv
        by simp
    qed fact+
  } ultimately
  show ?thesis using WhileTrue.prems(3) WhileTrue.hyps(2) WhileTrue.hyps(4) unfolding eqs
  apply -
  by (elim disjE conjE; simp; erule Normal_resultE Abrupt_resultE; simp)
qed auto

lemma xpres_strong_while:
  assumes xp: "xpres_strong \<Gamma> xf v x pres_norm pres_abr abnormal"
  assumes pa: "xpres_eq_If pres_norm pres_abr False pres_abr'"
  shows   "xpres_strong \<Gamma> xf v (While b x) pres_norm pres_abr' False"
  unfolding pa[simplified xpres_eq_If_def if_bool_simps]
  apply (rule xpres_strongI)
  apply (erule xpres_strong_while0[OF _ xp refl]; simp)+
  by auto

lemmas xpres_while
  = xpres_strong_while[OF _ xpres_eq_If_True, where pres_abr=True and abnormal=False, simplified]

lemma xpres_strong_xpres_abnormalI:
  assumes abn: "xpres_strong \<Gamma> xf v c' pres_norm pres_abr' abnormal"
  assumes "\<And>s t. \<lbrakk>pres_norm; \<Gamma> \<turnstile> \<langle>c, Normal s\<rangle> \<Rightarrow> Normal t; xf s = v\<rbrakk> \<Longrightarrow> xf t = v"
  assumes "\<And>s t. \<lbrakk>pres_abr; \<Gamma> \<turnstile> \<langle>c, Normal s\<rangle> \<Rightarrow> Abrupt t; xf s = v\<rbrakk> \<Longrightarrow> xf t = v"
  assumes "\<And>s t. \<lbrakk>abnormal; \<Gamma> \<turnstile> \<langle>c, Normal s\<rangle> \<Rightarrow> Normal t\<rbrakk> \<Longrightarrow> False"
  shows "xpres_strong \<Gamma> xf v c pres_norm pres_abr abnormal"
  by (rule xpres_strongI[OF _ _ _ xpres_strong_abnormalD[OF abn]]; erule assms trivial; assumption)

lemma xpres_strong_call_hoarep_gen:
  assumes mod: "\<forall>s. \<Gamma>\<turnstile>\<^bsub>/F s\<^esub> (P s) Call f (Q s),(A s)"
  assumes ret: "\<And>s t. xf s = v \<Longrightarrow> i s \<in> P (x s) \<longrightarrow> t \<in> Q (x s) \<or> t \<in> A (x s) \<Longrightarrow> xf (reset s t) = v"
  assumes xpr: "\<And>s t. xpres_strong \<Gamma> xf v (ret s t) pres_norm pres_abr abnormal"
  shows "xpres_strong \<Gamma> xf v (call i f reset ret) pres_norm pres_abr abnormal"
  apply (rule xpres_strong_xpres_abnormalI[OF xpr]; simp?; erule exec_call_Normal_elim; simp?)
     apply (erule (1) xpres_execs[OF xpr])
     apply (erule ret)
     apply (frule (1) hoarep_exec_call_body[OF mod], fastforce)
    apply (erule (1) xpres_execs[OF xpr])
    apply (erule ret)
    apply (frule (1) hoarep_exec_call_body[OF mod], fastforce)
   apply (erule ret)
   apply (frule (1) hoarep_exec_call_body[OF mod], fastforce)
  apply (erule (1) xpres_exec_abnormal[OF xpr])
  done

lemmas xpres_call = xpres_strong_call_hoarep_gen[OF hoarep_false_pre_gen, simplified]
lemmas xpres_call_hoarep = xpres_strong_call_hoarep_gen[where P="\<lambda>s. {s}" and x=i and i=i for i, simplified]

lemma xpres_strong_catch:
  assumes xpc: "xpres_strong \<Gamma> xf v c c_pres_norm c_pres_abr c_abnormal"
  assumes xpd: "xpres_strong \<Gamma> xf v d d_pres_norm d_pres_abr d_abnormal"
  notes xps = xpc xpd
  \<comment> \<open>abnormal \<longleftrightarrow> c_abnormal \<and> d_abnormal\<close>
  \<comment> \<open>pres_norm \<longleftrightarrow> abnormal \<or> c_pres_norm \<and> c_pres_abr \<and> d_pres_norm\<close>
  \<comment> \<open>pres_abr \<longleftrightarrow> c_pres_abr \<and> c_pres_abr\<close>
  assumes rew: "xpres_eq_If c_abnormal d_abnormal False abnormal"
               "xpres_eq_If c_pres_norm c_pres_abr False c_pres_norm_abr"
               "xpres_eq_If c_pres_norm_abr d_pres_norm False cd_pres_norm"
               "xpres_eq_If abnormal True cd_pres_norm pres_norm"
               "xpres_eq_If c_pres_abr d_pres_abr False pres_abr"
  shows "xpres_strong \<Gamma> xf v (Catch c d) pres_norm pres_abr abnormal"
  unfolding rew[simplified xpres_eq_If_def if_bool_simps]
  apply (rule xpres_strongI; simp?; erule exec_Normal_elim_cases; simp?; (elim disjE conjE)?)
          apply (all \<open>(drule (1) xps[THEN xpres_exec_abnormal], simp)?\<close>)
     apply (all \<open>drule (2) xpres_execs[OF xpc], assumption?\<close>)
   apply (all \<open>drule (2) xpres_execs[OF xpd], assumption\<close>)
  done

lemma xpres_catch:
  assumes "xpres \<Gamma> xf v b"
  assumes "xpres \<Gamma> xf v c"
  shows "xpres \<Gamma> xf v (Catch b c)"
  by (rule xpres_strong_catch[OF assms] xpres_eq_If_rules)+

lemma xpres_strong_guard:
  assumes "xpres_strong \<Gamma> xf v c pres_norm pres_abr abnormal"
  shows "xpres_strong \<Gamma> xf v (Guard f g c) pres_norm pres_abr abnormal"
  apply (rule xpres_strong_xpres_abnormalI[OF assms]; erule exec_Normal_elim_cases; simp?)
     apply (all \<open>drule (1) xpres_execs[OF assms] assms[THEN xpres_exec_abnormal]; simp\<close>)
  done

lemmas xpres_guard = xpres_strong_guard[where pres_norm=True and pres_abr=True and abnormal=False]

lemma xpres_strong_cond:
  assumes xpc: "xpres_strong \<Gamma> xf v c c_pres_norm c_pres_abr c_abnormal"
  assumes xpd: "xpres_strong \<Gamma> xf v d d_pres_norm d_pres_abr d_abnormal"
  notes xps = xpc xpd
  \<comment> \<open>pres_norm \<longleftrightarrow> abnormal \<or> c_pres_norm \<and> d_pres_norm \<or> c_abnormal \<and> d_pres_norm \<or> c_pres_norm \<and> d_abnormal\<close>
  \<comment> \<open>pres_abr \<longleftrightarrow> c_pres_abr \<and> d_pres_abr\<close>
  \<comment> \<open>abnormal \<longleftrightarrow> c_abnormal \<and> d_abnormal\<close>
  assumes rew: "xpres_eq_If c_abnormal d_abnormal False abnormal"
               "xpres_eq_If c_pres_norm d_pres_norm False cd_pres_norm"
               "xpres_eq_If c_abnormal d_pres_norm False ca_pres_norm"
               "xpres_eq_If c_pres_norm d_abnormal False da_pres_norm"
               "xpres_eq_If ca_pres_norm True da_pres_norm cda_pres_norm"
               "xpres_eq_If cd_pres_norm True cda_pres_norm pres_norm'"
               "xpres_eq_If abnormal True pres_norm' pres_norm"
               "xpres_eq_If c_pres_abr d_pres_abr False pres_abr"
  shows "xpres_strong \<Gamma> xf v (Cond x c d) pres_norm pres_abr abnormal"
  unfolding rew[simplified xpres_eq_If_def if_bool_simps]
  apply (rule xpres_strongI; simp?; erule exec_Normal_elim_cases; elim disjE conjE)
             apply (all \<open>(drule (1) xps[THEN xpres_exec_abnormal], simp)?\<close>)
       apply (all \<open>(erule (2) xpres_execs[OF xpc] xpres_execs[OF xpd])\<close>)
  done

lemma xpres_cond:
  assumes "xpres \<Gamma> xf v a"
  assumes "xpres \<Gamma> xf v b"
  shows "xpres \<Gamma> xf v (Cond x a b)"
  by (rule xpres_strong_cond[OF assms] xpres_eq_If_rules)+

lemma xpres_strong_throw':
  shows   "xpres_strong \<Gamma> xf v Throw True True abnormal"
  by (rule xpres_strongI; simp?; erule exec_Normal_elim_cases; simp)

lemmas xpres_strong_throw = xpres_strong_throw'[where abnormal=True]
lemmas xpres_throw = xpres_strong_throw'[where abnormal=False]

lemma xpres_strong_creturn':
  assumes xfu: "\<And>s f. pres_abr \<Longrightarrow> xf (xfu f s) = xf s"
  and xfg: "\<And>s f. pres_abr \<Longrightarrow> xf (exnu f s) = xf s"
  shows   "xpres_strong \<Gamma> xf v (creturn exnu xfu v') True pres_abr abnormal"
  unfolding creturn_def
  by (rule xpres_strongI; clarsimp elim!: exec_Normal_elim_cases simp: xfu xfg)

lemmas xpres_strong_creturn = xpres_strong_creturn'[where pres_abr=True and abnormal=True, simplified]
lemmas xpres_strong_creturn_False = xpres_strong_creturn'[where pres_abr=False and abnormal=True, simplified]
lemmas xpres_creturn = xpres_strong_creturn'[where pres_abr=True and abnormal=False, simplified]

lemma xpres_strong_creturn_void':
  assumes xfg: "\<And>s f. pres_abr \<Longrightarrow> xf (exnu f s) = xf s"
  shows   "xpres_strong \<Gamma> xf v (creturn_void exnu) True pres_abr abnormal"
  unfolding creturn_void_def
  by (rule xpres_strongI; clarsimp elim!: exec_Normal_elim_cases simp: xfg)

lemmas xpres_strong_creturn_void = xpres_strong_creturn_void'[where pres_abr=True and abnormal=True, simplified]
lemmas xpres_strong_creturn_void_False = xpres_strong_creturn_void'[where pres_abr=False and abnormal=True, simplified]
lemmas xpres_creturn_void = xpres_strong_creturn_void'[where pres_abr=True and abnormal=False, simplified]

lemma xpres_strong_cbreak':
  assumes xfg: "\<And>s f. pres_abr \<Longrightarrow> xf (exnu f s) = xf s"
  shows   "xpres_strong \<Gamma> xf v (cbreak exnu) True pres_abr abnormal"
  unfolding cbreak_def
  by (rule xpres_strongI; clarsimp elim!: exec_Normal_elim_cases simp add: xfg)

lemmas xpres_strong_cbreak = xpres_strong_cbreak'[where pres_abr=True and abnormal=True, simplified]
lemmas xpres_strong_cbreak_False = xpres_strong_cbreak'[where pres_abr=False and abnormal=True, simplified]
lemmas xpres_cbreak = xpres_strong_cbreak'[where pres_abr=True and abnormal=False, simplified]

lemma xpres_catchbrk_C:
  shows   "xpres \<Gamma> xf v (ccatchbrk exnu)"
  unfolding ccatchbrk_def
  by (rule xpresI; fastforce elim!: exec_Normal_elim_cases)

lemma xpres_strong_lvar_nondet_init:
  assumes xfg: "\<And>s f. pres_norm \<Longrightarrow> xf (st f s) = xf s"
  shows   "xpres_strong \<Gamma> xf v (lvar_nondet_init gt st) pres_norm True False"
  by (auto intro!: xpres_strongI elim!: exec_Normal_elim_cases simp: xfg lvar_nondet_init_def)

lemmas xpres_lvar_nondet_init_False = xpres_strong_lvar_nondet_init[where pres_norm=False, simplified]
lemmas xpres_lvar_nondet_init = xpres_strong_lvar_nondet_init[where pres_norm=True, simplified]

(* We ignore DynCom and Call and (for now) Spec.  The first two are covered by xpres_call *)
lemmas xpres_rules = xpres_skip xpres_basic xpres_seq xpres_while
  xpres_call xpres_catch xpres_skip xpres_guard xpres_cond xpres_throw
  xpres_creturn xpres_creturn_void xpres_cbreak xpres_catchbrk_C
  xpres_lvar_nondet_init

end


theory Foldl3_FoldlImpl_Proofs2
imports "$HETS_LIB/Isabelle/MainHCPlusPreList"
begin

datatype 'a List = nil | cons 'a "'a List"

consts
"foldl" :: "'b => (('b => ('a => 'b option)) => ('a List => 'b option))"   ( "foldl" )
"snoc" :: "'a List => ('a => 'a List)"   ( "snoc" )
lemma case_List_SomeProm [simp]:" (case caseVar of nil => Some (n)
   | cons a list => Some (c a list)
) =
Some (case caseVar of nil => n
   | cons a list => c a list
)"
apply (case_tac caseVar)
apply (auto)
done

axioms
ga_List: "True"
Ax2: "apt (apt (Some snoc) (Some nil)) (Some x) = apt (apt (Some cons) (Some x)) (Some nil)"
Ax3: "apt (apt (Some snoc) (apt (apt (Some cons) (Some y)) (Some l))) (Some x) = apt (apt (Some cons) (Some y)) (apt (apt (Some snoc) (Some l)) (Some x))"
Ax4: "app (apt (apt (Some foldl) (Some z)) (Some f)) (Some nil) = (Some z)"
Ax5: "app (apt (apt (Some foldl) (Some z)) (Some f)) (apt (apt (Some cons) (Some x)) (Some l)) = app (apt (apt (Some foldl) (app (apt (Some f) (Some z)) (Some x))) (Some f)) (Some l)"

(*replaced first apt by app in Ax4, snd app by apt in Ax5*)
lemmas ga_List' = ga_List [simplified]
lemmas Ax2' = Ax2 [simplified]
lemmas Ax3' = Ax3 [simplified]
lemmas Ax4' = Ax4 [simplified]
lemmas Ax5' = Ax5 [simplified]
thm Ax5'

declare ga_List' [simp]
declare ga_List [simp]
declare Ax2' [simp]
declare Ax2 [simp]
declare Ax3' [simp]
declare Ax3 [simp]
declare Ax4' [simp]
declare Ax4 [simp]
declare Ax5' [simp]
declare Ax5 [simp]

theorem ga_List1: "True"
apply (auto)
done

theorem Ax21: "apt (apt (Some snoc) (Some nil)) (Some x) = apt (apt (Some cons) (Some x)) (Some nil)"
apply (auto)
done

theorem Ax31: "apt (apt (Some snoc) (apt (apt (Some cons) (Some y)) (Some l))) (Some x) = apt (apt (Some cons) (Some y)) (apt (apt (Some snoc) (Some l)) (Some x))"
apply (auto)
done

theorem Ax41: "app (apt (apt (Some foldl) (Some z)) (Some f)) (Some nil) = (Some z)"
(* Replaced first apt by app *)
apply (auto)
done

theorem induct_List_pl: "P (Some nil) ==>
  (!!a l1. P (Some l1) ==> P (apt (apt (Some cons) (Some a)) (Some l1)))
   ==> P (Some l)"
apply auto
apply (induct_tac l)
apply (auto)
done

theorem Ax51: "app (apt (apt (Some foldl) (Some z)) (Some f)) (apt (apt (Some snoc) (Some l)) (Some x)) = app (apt (Some f) (app (apt (apt (Some foldl) (Some z)) (Some f)) (Some l))) (Some x)"
(* replaced first apt in apt apt apt by app, 2 times; snd app on rhs by apt *)
apply (rule_tac x=z in spec)
apply (rule induct_List_pl)
apply (rule allI)

apply (rule seqI)
apply (simp del: app.simps apt.simps)
apply (drule stApp2)
apply (drule stApt2)
apply (drule stApt)

apply (drule defArg)
apply (erule exE)
apply (simp del: app.simps apt.simps)

apply (simp del: app.simps apt.simps)
apply (drule defArg)
apply (erule exE)
apply (simp del: app.simps apt.simps)

apply (rule allI)
apply (simp del: app.simps apt.simps)
apply (rule seqI)
apply (frule stApp)
apply (drule stApt)
apply (rotate_tac)
apply (rotate_tac)
apply (drule defArg)
apply (erule exE)
apply (simp del: app.simps apt.simps)
apply (drule stApp2)
apply (drule stApt2)
apply (drule stApt)
apply (drule defArg)
apply (erule exE)
apply (erule allE)
apply (simp del: app.simps apt.simps)
apply (insert TrueThm)
apply (frule_tac x=l1 in var2)
apply (drule_tac x=x  in var2)
apply (drule_tac a=snoc in total)
apply (drule_tac b="Some x" in total2)
apply assumption
apply (rotate_tac)
apply (rotate_tac)
apply (rotate_tac)
apply (drule defArg)
apply (erule exE)
apply (simp del: app.simps apt.simps)
apply (frule stApp2)
apply (drule stApt)
apply (rotate_tac)
apply (rotate_tac)
apply (rotate_tac)
apply (drule stApp2)
apply (drule stApt2)
apply (drule stApt)
apply (rotate_tac)
apply (rotate_tac)
apply (rotate_tac)
apply (drule defArg)
apply (erule exE)
apply (simp del: app.simps apt.simps)

done

end


theory BinariesAreForComputersNotPeople
imports Main
begin
lemma "A ⟶ A"
proof
qed
end


(*  Title:      HOL/Auth/n_german_lemma_inv__10_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_german Protocol Case Study*}

theory n_german_lemma_inv__10_on_rules imports n_german_lemma_on_inv__10
begin
section{*All lemmas on causal relation between inv__10*}
lemma lemma_inv__10_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__10  p__Inv3 p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  proof -
  have c1: "(\<exists> j. j\<le>N\<and>r=n_SendReqS  j)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendReqEI  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendReqES  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvReq N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInvE  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInvS  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)\<or>
    (\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d)"
  apply (cut_tac b1, auto) done
    moreover {
      assume d1: "(\<exists> j. j\<le>N\<and>r=n_SendReqS  j)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendReqSVsinv__10) done
    }

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

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

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

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

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendInvS  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendInvSVsinv__10) 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__10) 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__10) 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__10) 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__10) 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__10) 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__10) 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__10) done
    }

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

end


(*
 * Copyright 2017, Data61, CSIRO
 *
 * This software may be distributed and modified according to the terms of
 * the BSD 2-Clause license. Note that NO WARRANTY is provided.
 * See "LICENSE_BSD2.txt" for details.
 *
 * @TAG(DATA61_BSD)
 *)

theory ModifiesProofs
imports CLanguage
begin

(* Rules for breaking down modifies goals before feeding them to the VCG.
   Helps avoid some pathological performance issues. *)

definition
  modifies_inv_refl :: "('a \<Rightarrow> 'a set) \<Rightarrow> bool"
where
  "modifies_inv_refl P \<equiv> \<forall>x. x \<in> P x"

definition
  modifies_inv_incl :: "('a \<Rightarrow> 'a set) \<Rightarrow> bool"
where
  "modifies_inv_incl P \<equiv> \<forall>x y. y \<in> P x \<longrightarrow> P y \<subseteq> P x"

definition
  modifies_inv_prop :: "('a \<Rightarrow> 'a set) \<Rightarrow> bool"
where
  "modifies_inv_prop P \<equiv> modifies_inv_refl P \<and> modifies_inv_incl P"

lemma modifies_inv_prop:
  "modifies_inv_refl P \<Longrightarrow> modifies_inv_incl P \<Longrightarrow> modifies_inv_prop P"
  by (simp add: modifies_inv_prop_def)

named_theorems modifies_inv_intros

context
  fixes P :: "'a \<Rightarrow> 'a set"
  assumes p: "modifies_inv_prop P"
begin

private lemmas modifies_inv_prop' =
  p[unfolded modifies_inv_prop_def modifies_inv_refl_def modifies_inv_incl_def]

private lemma modifies_inv_prop_lift:
  assumes c: "\<And>\<sigma>. \<Gamma>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} c (P \<sigma>),(P \<sigma>)"
  shows "\<Gamma>\<turnstile>\<^bsub>/F\<^esub> (P \<sigma>) c (P \<sigma>),(P \<sigma>)"
  using modifies_inv_prop' by (fastforce intro: c hoarep.Conseq)

private lemma modifies_inv_prop_lower:
  assumes c: "\<And>\<sigma>. \<Gamma>\<turnstile>\<^bsub>/F\<^esub> (P \<sigma>) c (P \<sigma>),(P \<sigma>)"
  shows "\<Gamma>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} c (P \<sigma>),(P \<sigma>)"
  using modifies_inv_prop' by (fastforce intro: c hoarep.Conseq)

private lemma modifies_inv_Seq [modifies_inv_intros]:
  assumes c: "\<And>\<sigma>. \<Gamma>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} c1 (P \<sigma>),(P \<sigma>)" "\<And>\<sigma>. \<Gamma>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} c2 (P \<sigma>),(P \<sigma>)"
  shows "\<Gamma>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} c1 ;;\<^sub>s c2 (P \<sigma>),(P \<sigma>)"
  by (intro modifies_inv_prop_lower HoarePartial.Seq[OF c[THEN modifies_inv_prop_lift]])

private lemma modifies_inv_Cond [modifies_inv_intros]:
  assumes c: "\<And>\<sigma>. \<Gamma>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} c1 (P \<sigma>),(P \<sigma>)" "\<And>\<sigma>. \<Gamma>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} c2 (P \<sigma>),(P \<sigma>)"
  shows "\<Gamma>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} Language.Cond b c1 c2 (P \<sigma>),(P \<sigma>)"
  by (auto intro: HoarePartial.Cond c)

private lemma modifies_inv_Guard_strip [modifies_inv_intros]:
  assumes c: "\<And>\<sigma>. \<Gamma>\<turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} c (P \<sigma>),(P \<sigma>)"
  shows "\<Gamma>\<turnstile>\<^bsub>/UNIV\<^esub> {\<sigma>} Language.Guard f b c (P \<sigma>),(P \<sigma>)"
  by (rule HoarePartial.GuardStrip[OF subset_refl c UNIV_I])
private lemma modifies_inv_Skip [modifies_inv_intros]:
  shows "\<Gamma>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} SKIP\<^sub>s (P \<sigma>),(P \<sigma>)"
  using modifies_inv_prop' by (auto intro: modifies_inv_prop_lift HoarePartial.Skip)

private lemma modifies_inv_Skip' [modifies_inv_intros]:
  shows "\<Gamma>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} SKIP\<^sub>s (P \<sigma>)"
  using modifies_inv_prop' by (auto intro: modifies_inv_prop_lift HoarePartial.Skip)

private lemma modifies_inv_whileAnno [modifies_inv_intros]:
  assumes c: "\<And>\<sigma>. \<Gamma>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} c (P \<sigma>),(P \<sigma>)"
  shows "\<Gamma>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} Language.whileAnno b I V c (P \<sigma>),(P \<sigma>)"
  apply (rule HoarePartial.reannotateWhileNoGuard[where I="P \<sigma>"])
  by (intro HoarePartial.While hoarep.Conseq;
      fastforce simp: modifies_inv_prop' intro: modifies_inv_prop_lift c)

private lemma modifies_inv_While [modifies_inv_intros]:
  assumes c: "\<And>\<sigma>. \<Gamma>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} c (P \<sigma>),(P \<sigma>)"
  shows "\<Gamma>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} Language.While b c (P \<sigma>),(P \<sigma>)"
  by (intro modifies_inv_whileAnno[unfolded Language.whileAnno_def] c)

private lemma modifies_inv_Throw [modifies_inv_intros]:
  shows "\<Gamma>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} THROW\<^sub>s (P \<sigma>),(P \<sigma>)"
  using modifies_inv_prop' by (auto intro: modifies_inv_prop_lift HoarePartial.Throw)

private lemma modifies_inv_Catch [modifies_inv_intros]:
  assumes c: "\<And>\<sigma>. \<Gamma>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} c1 (P \<sigma>),(P \<sigma>)"
             "\<And>\<sigma>. \<Gamma>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} c2 (P \<sigma>),(P \<sigma>)"
  shows "\<Gamma>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} TRY\<^sub>s c1 CATCH c2 END (P \<sigma>),(P \<sigma>)"
  by (intro modifies_inv_prop_lower HoarePartial.Catch[OF c[THEN modifies_inv_prop_lift]])

private lemma modifies_inv_Catch_all [modifies_inv_intros]:
  assumes 1: "\<And>\<sigma>. \<Gamma>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} c1 (P \<sigma>),(P \<sigma>)"
  assumes 2: "\<And>\<sigma>. \<Gamma>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} c2 (P \<sigma>)"
  shows "\<Gamma>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} TRY\<^sub>s c1 CATCH c2 END (P \<sigma>)"
  apply (intro HoarePartial.Catch[OF 1] hoarep.Conseq, clarsimp)
  apply (metis modifies_inv_prop' 2 singletonI)
  done

private lemma modifies_inv_switch_Nil [modifies_inv_intros]:
  shows "\<Gamma>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} Language.switch v [] (P \<sigma>),(P \<sigma>)"
  by (auto intro: modifies_inv_Skip)

private lemma modifies_inv_switch_Cons [modifies_inv_intros]:
  assumes c: "\<And>\<sigma>. \<Gamma>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} c (P \<sigma>),(P \<sigma>)"
             "\<And>\<sigma>. \<Gamma>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} Language.switch p vcs (P \<sigma>),(P \<sigma>)"
  shows "\<Gamma>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} Language.switch p ((v,c) # vcs) (P \<sigma>),(P \<sigma>)"
  by (auto intro: c modifies_inv_Cond)

end

context
  fixes P :: "'c \<times> 'd  \<Rightarrow> ('c \<times> 'd) set"
  assumes p: "modifies_inv_prop P"
begin

private lemma modifies_inv_creturn [modifies_inv_intros]:
  assumes c: "\<And>\<sigma>. \<Gamma>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} Language.Basic (\<lambda>s. xfu (\<lambda>_. v s) s) (P \<sigma>),(P \<sigma>)"
             "\<And>\<sigma>. \<Gamma>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} Language.Basic (rtu (\<lambda>_. Return)) (P \<sigma>),(P \<sigma>)"
  shows "\<Gamma>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} seq_creturn rtu xfu v (P \<sigma>),(P \<sigma>)"
  unfolding seq_creturn_def by (intro p c modifies_inv_intros)

private lemma modifies_inv_creturn_void [modifies_inv_intros]:
  assumes c: "\<And>\<sigma>. \<Gamma>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} Language.Basic (rtu (\<lambda>_. Return)) (P \<sigma>),(P \<sigma>)"
  shows "\<Gamma>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} seq_creturn_void rtu (P \<sigma>),(P \<sigma>)"
  unfolding seq_creturn_void_def by (intro p c modifies_inv_intros)

private lemma modifies_inv_cbreak [modifies_inv_intros]:
  assumes c: "\<And>\<sigma>. \<Gamma>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} Language.Basic (rtu (\<lambda>_. Break)) (P \<sigma>),(P \<sigma>)"
  shows "\<Gamma>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} seq_cbreak rtu (P \<sigma>),(P \<sigma>)"
  unfolding seq_cbreak_def by (intro p c modifies_inv_intros)

private lemma modifies_inv_ccatchbrk [modifies_inv_intros]:
  shows "\<Gamma>\<turnstile>\<^bsub>/F\<^esub> {\<sigma>} seq_ccatchbrk rt (P \<sigma>),(P \<sigma>)"
  unfolding seq_ccatchbrk_def by (intro p modifies_inv_intros)

end

end


(*  Title:      HOL/Auth/n_german_lemma_inv__32_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_german Protocol Case Study*}

theory n_german_lemma_inv__32_on_rules imports n_german_lemma_on_inv__32
begin
section{*All lemmas on causal relation between inv__32*}
lemma lemma_inv__32_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(\<exists> p__Inv2. p__Inv2\<le>N\<and>f=inv__32  p__Inv2)"
  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_SendReqS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendReqE__part__0  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendReqE__part__1  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvReqS N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvReqE 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__32) done
    }

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

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

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendReqE__part__1  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendReqE__part__1Vsinv__32) 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__32) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvReqE N i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvReqEVsinv__32) 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__32) 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__32) 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__32) 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__32) 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__32) 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__32) 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__32) 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__32) done
    }

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

end