theory Bisimulation
  imports Simulation
begin

context env begin

lemma mono_coinduct: "\<And>x y xa xb xc P Q \<Psi>.
                      x \<le> y \<Longrightarrow>
                      (\<Psi> \<rhd> Q \<leadsto>[{(xc, xb, xa). x xc xb xa}] P) \<longrightarrow>
                     (\<Psi> \<rhd> Q \<leadsto>[{(xb, xa, xc). y xb xa xc}] P)"
apply auto
apply(rule monotonic)
by(auto dest: le_funE)

coinductive_set bisim :: "('b \<times> ('a, 'b, 'c) psi \<times> ('a, 'b, 'c) psi) set"
where
  step: "\<lbrakk>(insert_assertion (extract_frame P)) \<Psi> \<simeq>\<^sub>F (insert_assertion (extract_frame Q) \<Psi>);
          \<Psi> \<rhd> P \<leadsto>[bisim] Q;
          \<forall>\<Psi>'. (\<Psi> \<otimes> \<Psi>',  P, Q) \<in> bisim; (\<Psi>, Q, P) \<in> bisim\<rbrakk> \<Longrightarrow> (\<Psi>, P, Q) \<in> bisim"
monos mono_coinduct

abbreviation
  bisim_judge ("_ \<rhd> _ \<sim> _" [70, 70, 70] 65) where "\<Psi> \<rhd> P \<sim> Q \<equiv> (\<Psi>, P, Q) \<in> bisim"
abbreviation
  bisim_nil_judge ("_ \<sim> _" [70, 70] 65) where "P \<sim> Q \<equiv> S_bottom' \<rhd> P \<sim> Q"

lemma bisim_coinduct_aux[consumes 1]:
  fixes F :: 'b
  and   P :: "('a, 'b, 'c) psi"
  and   Q :: "('a, 'b, 'c) psi"
  and   X :: "('b \<times> ('a, 'b, 'c) psi \<times> ('a, 'b, 'c) psi) set"

  assumes "(\<Psi>, P, Q) \<in> X"
  and     "\<And>\<Psi> P Q. (\<Psi>, P, Q) \<in> X \<Longrightarrow> insert_assertion (extract_frame P) \<Psi> \<simeq>\<^sub>F insert_assertion (extract_frame Q) \<Psi> \<and>
                                    (\<Psi> \<rhd> P \<leadsto>[(X \<union> bisim)] Q) \<and>
                                    (\<forall>\<Psi>'. (\<Psi> \<otimes> \<Psi>', P, Q) \<in> X \<or> (\<Psi> \<otimes> \<Psi>', P, Q) \<in> bisim) \<and>
                                    ((\<Psi>, Q, P) \<in> X \<or> (\<Psi>, Q, P) \<in> bisim)"

  shows "(\<Psi>, P, Q) \<in> bisim"
proof -
  have "X \<union> bisim = {(\<Psi>, P, Q). (\<Psi>, P, Q) \<in> X \<or> (\<Psi>, P, Q) \<in> bisim}" by auto
  with assms show ?thesis
    by coinduct simp
qed

lemma bisim_coinduct[consumes 1, case_names c_stat_eq c_sim c_ext c_sym]:
  fixes F :: 'b
  and   P :: "('a, 'b, 'c) psi"
  and   Q :: "('a, 'b, 'c) psi"

  and   X :: "('b \<times> ('a, 'b, 'c) psi \<times> ('a, 'b, 'c) psi) set"

  assumes "(\<Psi>, P, Q) \<in> X"
  and     "\<And>\<Psi>' R S. (\<Psi>', R, S) \<in> X \<Longrightarrow> insert_assertion (extract_frame R) \<Psi>' \<simeq>\<^sub>F insert_assertion (extract_frame S) \<Psi>'"
  and     "\<And>\<Psi>' R S. (\<Psi>', R, S) \<in> X \<Longrightarrow> \<Psi>' \<rhd> R \<leadsto>[(X \<union> bisim)] S"
  and     "\<And>\<Psi>' R S \<Psi>''. (\<Psi>', R, S) \<in> X \<Longrightarrow> (\<Psi>' \<otimes> \<Psi>'', R, S) \<in> X \<or> (\<Psi>' \<otimes> \<Psi>'', R, S) \<in> bisim"
  and     "\<And>\<Psi>' R S. (\<Psi>', R, S) \<in> X \<Longrightarrow> (\<Psi>', S, R) \<in> X \<or> (\<Psi>', S, R) \<in> bisim"

  shows "(\<Psi>, P, Q) \<in> bisim"
proof -
  have "X \<union> bisim = {(\<Psi>, P, Q). (\<Psi>, P, Q) \<in> X \<or> (\<Psi>, P, Q) \<in> bisim}" by auto
  with assms show ?thesis
    by coinduct simp
qed

lemma bisim_weak_coinduct_aux[consumes 1]:
  fixes \<Psi> :: 'b
  and   P :: "('a, 'b, 'c) psi"
  and   Q :: "('a, 'b, 'c) psi"
  and   X :: "('b \<times> ('a, 'b, 'c) psi \<times> ('a, 'b, 'c) psi) set"

  assumes "(\<Psi>, P, Q) \<in> X"
  and     "\<And>\<Psi> P Q. (\<Psi>, P, Q) \<in> X \<Longrightarrow> insert_assertion (extract_frame P) \<Psi> \<simeq>\<^sub>F insert_assertion (extract_frame Q) \<Psi> \<and>
                                     \<Psi> \<rhd> P \<leadsto>[X] Q \<and>
                                    (\<forall>\<Psi>'. (\<Psi> \<otimes> \<Psi>', P, Q) \<in> X) \<and> (\<Psi>, Q, P) \<in> X"

  shows "(\<Psi>, P, Q) \<in> bisim"
using assms
by(coinduct rule: bisim_coinduct_aux) (blast intro: monotonic)

lemma bisim_weak_coinduct[consumes 1, case_names c_stat_eq c_sim c_ext c_sym]:
  fixes F :: 'b
  and   P :: "('a, 'b, 'c) psi"
  and   Q :: "('a, 'b, 'c) psi"
  and   X :: "('b \<times> ('a, 'b, 'c) psi \<times> ('a, 'b, 'c) psi) set"

  assumes "(\<Psi>, P, Q) \<in> X"
  and     "\<And>\<Psi> P Q. (\<Psi>, P, Q) \<in> X \<Longrightarrow> insert_assertion (extract_frame P) \<Psi> \<simeq>\<^sub>F insert_assertion (extract_frame Q) \<Psi>"
  and     "\<And>\<Psi> P Q. (\<Psi>, P, Q) \<in> X \<Longrightarrow> \<Psi> \<rhd> P \<leadsto>[X] Q"
  and     "\<And>\<Psi> P Q \<Psi>'. (\<Psi>, P, Q) \<in> X \<Longrightarrow> (\<Psi> \<otimes> \<Psi>', P, Q) \<in> X"
  and     "\<And>\<Psi> P Q. (\<Psi>, P, Q) \<in> X \<Longrightarrow> (\<Psi>, Q, P) \<in> X"

  shows "(\<Psi>, P, Q) \<in> bisim"
proof -
  have "X \<union> bisim = {(\<Psi>, P, Q). (\<Psi>, P, Q) \<in> X \<or> (\<Psi>, P, Q) \<in> bisim}" by auto
  with assms show ?thesis
  by(coinduct rule: bisim_coinduct) (blast intro: monotonic)+
qed

(*lemma bisim_weak_coinduct[consumes 1, case_names c_stat_eq c_sim c_ext c_sym]:
  fixes F :: 'b
  and   P :: "('a, 'b, 'c) psi"
  and   Q :: "('a, 'b, 'c) psi"
  and   X :: "('b \<times> ('a, 'b, 'c) psi \<times> ('a, 'b, 'c) psi) set"

  assumes "(\<Psi>, P, Q) \<in> X"
  and     "\<And>\<Psi> P Q. (\<Psi>, P, Q) \<in> X \<Longrightarrow> insert_assertion (extract_frame P) \<Psi> \<simeq>\<^sub>F insert_assertion (extract_frame Q) \<Psi>"
  and     "\<And>\<Psi> P Q. (\<Psi>, P, Q) \<in> X \<Longrightarrow> \<Psi> \<rhd> P \<leadsto>[X] Q"
  and     "\<And>\<Psi> P Q \<Psi>'. (\<Psi>, P, Q) \<in> X \<Longrightarrow> (\<Psi> \<otimes> \<Psi>', P, Q) \<in> X"
  and     "\<And>\<Psi> P Q. (\<Psi>, P, Q) \<in> X \<Longrightarrow> (\<Psi>, Q, P) \<in> X"

  shows "(\<Psi>, P, Q) \<in> bisim"
proof -
  have "X \<union> bisim = {(\<Psi>, P, Q). (\<Psi>, P, Q) \<in> X \<or> (\<Psi>, P, Q) \<in> bisim}" by auto
  with assms show ?thesis
  by(coinduct rule: bisim_coinduct) (blast intro: monotonic)+
qed*)

lemma bisimE:
  fixes P  :: "('a, 'b, 'c) psi"
  and   Q  :: "('a, 'b, 'c) psi"
  and   \<Psi>  :: 'b
  and   \<Psi>' :: 'b

  assumes "(\<Psi>, P, Q) \<in> bisim"

  shows "insert_assertion (extract_frame P) \<Psi> \<simeq>\<^sub>F insert_assertion (extract_frame Q) \<Psi>"
  and   "\<Psi> \<rhd> P \<leadsto>[bisim] Q"
  and   "(\<Psi> \<otimes> \<Psi>', P, Q) \<in> bisim"
  and   "(\<Psi>, Q, P) \<in> bisim"
using assms
by(auto simp add: intro: bisim.cases)

lemma bisimI:
  fixes P :: "('a, 'b, 'c) psi"
  and   Q :: "('a, 'b, 'c) psi"
  and   \<Psi> :: 'b

  assumes "insert_assertion (extract_frame P) \<Psi> \<simeq>\<^sub>F insert_assertion (extract_frame Q) \<Psi>"
  and     "\<Psi> \<rhd> P \<leadsto>[bisim] Q"
  and     "\<forall>\<Psi>'. (\<Psi> \<otimes> \<Psi>', P, Q) \<in> bisim"
  and     "(\<Psi>, Q, P) \<in> bisim"

  shows "(\<Psi>, P, Q) \<in> bisim"
using assms
by(auto intro: bisim.step)

lemma bisim_reflexive:
  fixes \<Psi> :: 'b
  and   P :: "('a, 'b, 'c) psi"

  shows "\<Psi> \<rhd> P \<sim> P"
proof -
  let ?X = "{(\<Psi>, P, P) | \<Psi> P. True}"
  have "(\<Psi>, P, P) \<in> ?X" by simp
  thus ?thesis
    by(coinduct rule: bisim_weak_coinduct, auto intro: reflexive)
qed

lemma bisim_closed:
  fixes \<Psi> :: 'b
  and   P :: "('a, 'b, 'c) psi"
  and   Q :: "('a, 'b, 'c) psi"
  and   p :: "name prm"

  assumes P_bisimQ: "\<Psi> \<rhd> P \<sim> Q"

  shows "(p \<bullet> \<Psi>) \<rhd>  (p \<bullet> P) \<sim> (p \<bullet> Q)"
proof -
  let ?X = "{(p \<bullet> \<Psi>, p \<bullet> P, p \<bullet> Q) | (p::name prm) \<Psi>  P Q. \<Psi> \<rhd> P \<sim> Q}"
  from P_bisimQ have "(p \<bullet> \<Psi>, p \<bullet> P, p \<bullet> Q) \<in> ?X" by blast
  thus ?thesis
  proof(coinduct rule: bisim_weak_coinduct)
    case(c_stat_eq \<Psi> P Q)
    have "\<And>\<Psi> P Q (p::name prm). insert_assertion (extract_frame P) \<Psi> \<simeq>\<^sub>F insert_assertion (extract_frame Q) \<Psi> \<Longrightarrow>
          insert_assertion (extract_frame(p \<bullet> P)) (p \<bullet> \<Psi>) \<simeq>\<^sub>F insert_assertion (extract_frame(p \<bullet> Q))  (p \<bullet> \<Psi>)"
      by(drule_tac p = p in Frame_stat_eq_closed) (simp add: eqvts)

    with `(\<Psi>, P, Q) \<in> ?X` show ?case by(blast dest: bisimE)
  next
    case(c_sim \<Psi> P Q)
    {
      fix p :: "name prm"
      fix \<Psi> P Q
      have "eqvt ?X"
	apply(auto simp add: eqvt_def)
	apply(rule_tac x="pa@p" in exI)
	by(auto simp add: pt2[OF pt_name_inst])
      moreover assume "\<Psi> \<rhd> P \<leadsto>[bisim] Q"
      hence "\<Psi> \<rhd> P \<leadsto>[?X] Q"
	apply(rule_tac A=bisim in monotonic, auto)
	by(rule_tac x="[]::name prm" in exI) auto
      ultimately have "((p::name prm) \<bullet> \<Psi>) \<rhd> (p \<bullet> P) \<leadsto>[?X] (p \<bullet> Q)"
	by(rule_tac sim_closed)
    }
    with `(\<Psi>, P, Q) \<in> ?X` show ?case
      by(blast dest: bisimE)
  next
    case(c_ext \<Psi> P Q \<Psi>')
    {
      fix p :: "name prm"
      fix \<Psi> P Q \<Psi>'
      assume "\<forall>\<Psi>'. (\<Psi> \<otimes> \<Psi>', P, Q) \<in> bisim"
      hence "((p \<bullet> \<Psi>) \<otimes> \<Psi>', p \<bullet> P, p \<bullet> Q) \<in> ?X"
	apply(auto, rule_tac x=p in exI)
	apply(rule_tac x="\<Psi> \<otimes> (rev p \<bullet> \<Psi>')" in exI)
	by(auto simp add: eqvts)
    }
    with `(\<Psi>, P, Q) \<in> ?X` show ?case
      by(blast dest: bisimE)
  next
    case(c_sym \<Psi> P Q)
    thus ?case
      by(blast dest: bisimE)
  qed
qed

lemma bisim_eqvt[simp]:
  shows "eqvt bisim"
by(auto simp add: eqvt_def bisim_closed)

lemma stat_eq_bisim:
  fixes \<Psi>  :: 'b
  and   P  :: "('a, 'b, 'c) psi"
  and   Q  :: "('a, 'b, 'c) psi"
  and   \<Psi>' :: 'b

  assumes "\<Psi> \<rhd> P \<sim> Q"
  and     "\<Psi> \<simeq> \<Psi>'"

  shows "\<Psi>' \<rhd> P \<sim> Q"
proof -
  let ?X = "{(\<Psi>', P, Q) | \<Psi> P Q \<Psi>'. \<Psi> \<rhd> P \<sim> Q \<and> \<Psi> \<simeq> \<Psi>'}"
  from `\<Psi> \<rhd> P \<sim> Q` `\<Psi> \<simeq> \<Psi>'` have "(\<Psi>', P, Q) \<in> ?X" by auto
  thus ?thesis
  proof(coinduct rule: bisim_coinduct)
    case(c_stat_eq \<Psi>' P Q)
    from `(\<Psi>', P, Q) \<in> ?X` obtain \<Psi> where "\<Psi> \<rhd> P \<sim> Q" and "\<Psi> \<simeq> \<Psi>'"
      by auto
    from `\<Psi> \<rhd> P \<sim> Q` have PeqQ: "insert_assertion (extract_frame P) \<Psi> \<simeq>\<^sub>F insert_assertion (extract_frame Q) \<Psi>"
      by(rule bisimE)

    obtain A\<^sub>P \<Psi>\<^sub>P where FrP: "extract_frame P = \<langle>A\<^sub>P, \<Psi>\<^sub>P\<rangle>" and "A\<^sub>P \<sharp>* \<Psi>" and "A\<^sub>P \<sharp>* \<Psi>'"
      by(rule_tac C="(\<Psi>, \<Psi>')" in fresh_frame) auto
    obtain A\<^sub>Q \<Psi>\<^sub>Q where FrQ: "extract_frame Q = \<langle>A\<^sub>Q, \<Psi>\<^sub>Q\<rangle>" and "A\<^sub>Q \<sharp>* \<Psi>" and "A\<^sub>Q \<sharp>* \<Psi>'"
      by(rule_tac C="(\<Psi>, \<Psi>')" in fresh_frame) auto

    from PeqQ FrP FrQ `A\<^sub>P \<sharp>* \<Psi>` `A\<^sub>Q \<sharp>* \<Psi>` `\<Psi> \<simeq> \<Psi>'`
    have "\<langle>A\<^sub>P, \<Psi>' \<otimes> \<Psi>\<^sub>P\<rangle> \<simeq>\<^sub>F \<langle>A\<^sub>Q, \<Psi>' \<otimes> \<Psi>\<^sub>Q\<rangle>"
      by simp (metis frame_int_composition Frame_stat_eq_trans Frame_stat_eq_sym)
    with FrP FrQ `A\<^sub>P \<sharp>* \<Psi>'` `A\<^sub>Q \<sharp>* \<Psi>'` show ?case by simp
  next
    case(c_sim \<Psi>' P Q)
    from `(\<Psi>', P, Q) \<in> ?X` obtain \<Psi> where "\<Psi> \<rhd> P \<sim> Q" and "\<Psi> \<simeq> \<Psi>'"
      by auto
    from `\<Psi> \<rhd> P \<sim> Q` have "\<Psi> \<rhd> P \<leadsto>[bisim] Q" by(blast dest: bisimE)
    moreover have "eqvt ?X"
      by(auto simp add: eqvt_def) (metis bisim_closed Assertion_stat_eq_closed)
    hence "eqvt(?X \<union> bisim)" by auto
    moreover note `\<Psi> \<simeq> \<Psi>'`
    moreover have "\<And>\<Psi> P Q \<Psi>'. \<lbrakk>\<Psi> \<rhd> P \<sim> Q; \<Psi> \<simeq> \<Psi>'\<rbrakk> \<Longrightarrow> (\<Psi>', P, Q) \<in> ?X \<union> bisim"
      by auto
    ultimately show ?case
      by(rule stat_eq_sim)
  next
    case(c_ext \<Psi>' P Q \<Psi>'')
    from `(\<Psi>', P, Q) \<in> ?X` obtain \<Psi> where "\<Psi> \<rhd> P \<sim> Q" and "\<Psi> \<simeq> \<Psi>'"
      by auto
    from `\<Psi> \<rhd> P \<sim> Q` have "\<Psi> \<otimes> \<Psi>'' \<rhd> P \<sim> Q" by(rule bisimE)
    moreover from `\<Psi> \<simeq> \<Psi>'` have "\<Psi> \<otimes> \<Psi>'' \<simeq> \<Psi>' \<otimes> \<Psi>''" by(rule Composition)
    ultimately show ?case by blast
  next
    case(c_sym \<Psi>' P Q)
    from `(\<Psi>', P, Q) \<in> ?X` obtain \<Psi> where "\<Psi> \<rhd> P \<sim> Q" and "\<Psi> \<simeq> \<Psi>'"
      by auto
    from `\<Psi> \<rhd> P \<sim> Q` have "\<Psi> \<rhd> Q \<sim> P" by(rule bisimE)
    thus ?case using `\<Psi> \<simeq> \<Psi>'` by auto
  qed
qed

lemma bisim_transitive:
  fixes \<Psi> :: 'b
  and   P :: "('a, 'b, 'c) psi"
  and   Q :: "('a, 'b, 'c) psi"
  and   R :: "('a, 'b, 'c) psi"

  assumes PQ: "\<Psi> \<rhd> P \<sim> Q"
  and     QR: "\<Psi> \<rhd> Q \<sim> R"

  shows "\<Psi> \<rhd> P \<sim> R"
proof -
  let ?X = "{(\<Psi>, P, R) | \<Psi> P Q R. \<Psi> \<rhd> P \<sim> Q \<and> \<Psi> \<rhd> Q \<sim> R}"
  from PQ QR have "(\<Psi>, P, R) \<in> ?X" by auto
  thus ?thesis
  proof(coinduct rule: bisim_coinduct)
    case(c_stat_eq \<Psi> P R)
    thus ?case by(blast dest: bisimE Frame_stat_eq_trans)
  next
    case(c_sim \<Psi> P R)
    {
      fix \<Psi> P Q R
      assume "\<Psi> \<rhd> P \<leadsto>[bisim] Q" and "\<Psi> \<rhd> Q \<leadsto>[bisim] R"
      moreover have "eqvt ?X"
	by(force simp add: eqvt_def dest: bisim_closed)
      with bisim_eqvt have "eqvt (?X \<union> bisim)" by blast
      moreover have "?X \<subseteq> ?X \<union> bisim" by auto
      ultimately have "\<Psi> \<rhd> P \<leadsto>[(?X \<union> bisim)] R"
	by(force intro: transitive)
    }
    with `(\<Psi>, P, R) \<in> ?X` show ?case
      by(blast dest: bisimE)
  next
    case(c_ext \<Psi> P R \<Psi>')
    thus ?case by(blast dest: bisimE)
  next
    case(c_sym \<Psi> P R)
    thus ?case by(blast dest: bisimE)
  qed
qed

lemma weak_transitive_coinduct[case_names c_stat_eq c_sim c_ext c_sym, case_conclusion bisim step, consumes 2]:
  fixes \<Psi> :: 'b
  and   P :: "('a, 'b, 'c) psi"
  and   Q :: "('a, 'b, 'c) psi"
  and   X :: "('b \<times> ('a, 'b, 'c) psi \<times> ('a, 'b, 'c) psi) set"

  assumes p: "(\<Psi>, P, Q) \<in> X"
  and Eqvt: "eqvt X"
  and r_stat_eq: "\<And>\<Psi> P Q. (\<Psi>, P, Q) \<in> X \<Longrightarrow> insert_assertion (extract_frame P) \<Psi> \<simeq>\<^sub>F insert_assertion (extract_frame Q) \<Psi>"
  and r_sim: "\<And>\<Psi> P Q. (\<Psi>, P, Q) \<in> X \<Longrightarrow> \<Psi> \<rhd> P \<leadsto>[({(\<Psi>, P, Q) | \<Psi> P P' Q' Q. \<Psi> \<rhd> P \<sim> P' \<and>
                                                                        (\<Psi>, P', Q') \<in> X \<and>
                                                                        \<Psi> \<rhd> Q' \<sim> Q})] Q"
  and r_ext: "\<And>\<Psi> P Q \<Psi>'. (\<Psi>, P, Q) \<in> X \<Longrightarrow> (\<Psi> \<otimes> \<Psi>', P, Q) \<in> X"
  and r_sym: "\<And>\<Psi> P Q. (\<Psi>, P, Q) \<in> X \<Longrightarrow> (\<Psi>, Q, P) \<in> X"

  shows "\<Psi> \<rhd> P \<sim> Q"
proof -
  let ?X = "{(\<Psi>, P, Q) | \<Psi> P P' Q' Q. \<Psi> \<rhd> P \<sim> P' \<and> (\<Psi>, P', Q') \<in> X \<and> \<Psi> \<rhd> Q' \<sim> Q}"
  from p have "(\<Psi>, P, Q) \<in> ?X"
    by(blast intro: bisim_reflexive)
  thus ?thesis
  proof(coinduct rule: bisim_weak_coinduct)
    case(c_stat_eq \<Psi> P Q)
    thus ?case
      by(blast dest: r_stat_eq bisimE Frame_stat_eq_trans)
  next
    case(c_sim \<Psi> P Q)
    {
      fix \<Psi> P P' Q' Q
      assume "\<Psi> \<rhd> P \<leadsto>[bisim] P'"
      moreover assume P'_rel_q': "(\<Psi>, P', Q') \<in> X"
      hence "\<Psi> \<rhd> P' \<leadsto>[?X] Q'" by(rule r_sim)
      moreover from `eqvt X` P'_rel_q' have "eqvt ?X"
	apply(auto simp add: eqvt_def)
	apply(drule_tac p=p in bisim_closed)
	apply(drule_tac p=p in bisim_closed)
	apply(rule_tac x="p \<bullet> P'a" in exI, simp)
	by(rule_tac x="p \<bullet> Q'a" in exI, auto)
      ultimately have "\<Psi> \<rhd> P \<leadsto>[?X] Q'"
	by(force intro: transitive dest: bisim_transitive)
      moreover assume "\<Psi> \<rhd> Q' \<leadsto>[bisim] Q"
      ultimately have "\<Psi> \<rhd> P \<leadsto>[?X] Q" using `eqvt ?X`
	by(force intro: transitive dest: bisim_transitive)
    }
    with `(\<Psi>, P, Q) \<in> ?X` show ?case
      by(blast dest: bisimE)
  next
    case(c_ext \<Psi> P Q \<Psi>')
    thus ?case by(blast dest: bisimE intro: r_ext)
  next
    case(c_sym \<Psi> P Q)
    thus ?case by(blast dest: bisimE intro: r_sym)
  qed
qed

lemma weak_transitive_coinduct'[case_names c_stat_eq c_sim c_ext c_sym, case_conclusion bisim step, consumes 2]:
  fixes \<Psi> :: 'b
  and   P :: "('a, 'b, 'c) psi"
  and   Q :: "('a, 'b, 'c) psi"
  and   X :: "('b \<times> ('a, 'b, 'c) psi \<times> ('a, 'b, 'c) psi) set"

  assumes p: "(\<Psi>, P, Q) \<in> X"
  and Eqvt: "eqvt X"
  and r_stat_eq: "\<And>\<Psi> P Q. (\<Psi>, P, Q) \<in> X \<Longrightarrow> insert_assertion (extract_frame P) \<Psi> \<simeq>\<^sub>F insert_assertion (extract_frame Q) \<Psi>"
  and r_sim: "\<And>\<Psi> P Q. (\<Psi>, P, Q) \<in> X \<Longrightarrow> \<Psi> \<rhd> P \<leadsto>[({(\<Psi>, P, Q) | \<Psi> P P' Q' Q. \<Psi> \<rhd> P \<sim> P' \<and>
                                                                        (\<Psi>, P', Q') \<in> X \<and>
                                                                        \<Psi> \<rhd> Q' \<sim> Q})] Q"
  and r_ext: "\<And>\<Psi> P Q \<Psi>'. (\<Psi>, P, Q) \<in> X \<Longrightarrow> (\<Psi> \<otimes> \<Psi>', P, Q) \<in> X"
  and r_sym: "\<And>\<Psi> P Q. (\<Psi>, P, Q) \<in> X \<Longrightarrow>
                      (\<Psi>, Q, P) \<in> {(\<Psi>, P, Q) | \<Psi> P P' Q' Q. \<Psi> \<rhd> P \<sim> P' \<and> (\<Psi>, P', Q') \<in> X \<and> \<Psi> \<rhd> Q' \<sim> Q}"

  shows "\<Psi> \<rhd> P \<sim> Q"
proof -
  let ?X = "{(\<Psi>, P, Q) | \<Psi> P P' Q' Q. \<Psi> \<rhd> P \<sim> P' \<and> (\<Psi>, P', Q') \<in> X \<and> \<Psi> \<rhd> Q' \<sim> Q}"
  from p have "(\<Psi>, P, Q) \<in> ?X"
    by(blast intro: bisim_reflexive)
  thus ?thesis
  proof(coinduct rule: bisim_weak_coinduct)
    case(c_stat_eq \<Psi> P Q)
    thus ?case
      by(blast dest: r_stat_eq bisimE Frame_stat_eq_trans)
  next
    case(c_sim \<Psi> P Q)
    {
      fix \<Psi> P P' Q' Q
      assume "\<Psi> \<rhd> P \<leadsto>[bisim] P'"
      moreover assume P'_rel_q': "(\<Psi>, P', Q') \<in> X"
      hence "\<Psi> \<rhd> P' \<leadsto>[?X] Q'" by(rule r_sim)
      moreover from `eqvt X` P'_rel_q' have "eqvt ?X"
	apply(auto simp add: eqvt_def)
	apply(drule_tac p=p in bisim_closed)
	apply(drule_tac p=p in bisim_closed)
	apply(rule_tac x="p \<bullet> P'a" in exI, simp)
	by(rule_tac x="p \<bullet> Q'a" in exI, auto)
      ultimately have "\<Psi> \<rhd> P \<leadsto>[?X] Q'"
	by(force intro: transitive dest: bisim_transitive)
      moreover assume "\<Psi> \<rhd> Q' \<leadsto>[bisim] Q"
      ultimately have "\<Psi> \<rhd> P \<leadsto>[?X] Q" using `eqvt ?X`
	by(force intro: transitive dest: bisim_transitive)
    }
    with `(\<Psi>, P, Q) \<in> ?X` show ?case
      by(blast dest: bisimE)
  next
    case(c_ext \<Psi> P Q \<Psi>')
    thus ?case by(blast dest: bisimE intro: r_ext)
  next
    case(c_sym \<Psi> P Q)
    thus ?case
      apply auto
      apply(drule r_sym)
      apply auto
      by(metis bisim_transitive bisimE(4))
  qed
qed

lemma weak_transitive_coinduct''[case_names c_stat_eq c_sim c_ext c_sym, case_conclusion bisim step, consumes 2]:
  fixes \<Psi> :: 'b
  and   P :: "('a, 'b, 'c) psi"
  and   Q :: "('a, 'b, 'c) psi"
  and   X :: "('b \<times> ('a, 'b, 'c) psi \<times> ('a, 'b, 'c) psi) set"

  assumes p: "(\<Psi>, P, Q) \<in> X"
  and Eqvt: "eqvt X"
  and r_stat_eq: "\<And>\<Psi> P Q. (\<Psi>, P, Q) \<in> X \<Longrightarrow> insert_assertion (extract_frame P) \<Psi> \<simeq>\<^sub>F insert_assertion (extract_frame Q) \<Psi>"
  and r_sim: "\<And>\<Psi> P Q. (\<Psi>, P, Q) \<in> X \<Longrightarrow> \<Psi> \<rhd> P \<leadsto>[({(\<Psi>, P, Q) | \<Psi> P P' Q' Q. \<Psi> \<rhd> P \<sim> P' \<and>
                                                                        (\<Psi>, P', Q') \<in> X \<and>
                                                                        \<Psi> \<rhd> Q' \<sim> Q})] Q"
  and r_ext: "\<And>\<Psi> P Q \<Psi>'. (\<Psi>, P, Q) \<in> {(\<Psi>, P, Q) | \<Psi> P P' Q' Q. \<Psi> \<rhd> P \<sim> P' \<and> (\<Psi>, P', Q') \<in> X \<and> \<Psi> \<rhd> Q' \<sim> Q} \<Longrightarrow>
                         (\<Psi> \<otimes> \<Psi>', P, Q) \<in> {(\<Psi>, P, Q) | \<Psi> P P' Q' Q. \<Psi> \<rhd> P \<sim> P' \<and> (\<Psi>, P', Q') \<in> X \<and> \<Psi> \<rhd> Q' \<sim> Q}"
  and r_sym: "\<And>\<Psi> P Q. (\<Psi>, P, Q) \<in> {(\<Psi>, P, Q) | \<Psi> P P' Q' Q. \<Psi> \<rhd> P \<sim> P' \<and> (\<Psi>, P', Q') \<in> X \<and> \<Psi> \<rhd> Q' \<sim> Q} \<Longrightarrow>
                      (\<Psi>, Q, P) \<in> {(\<Psi>, P, Q) | \<Psi> P P' Q' Q. \<Psi> \<rhd> P \<sim> P' \<and> (\<Psi>, P', Q') \<in> X \<and> \<Psi> \<rhd> Q' \<sim> Q}"

  shows "\<Psi> \<rhd> P \<sim> Q"
proof -
  let ?X = "{(\<Psi>, P, Q) | \<Psi> P P' Q' Q. \<Psi> \<rhd> P \<sim> P' \<and> (\<Psi>, P', Q') \<in> X \<and> \<Psi> \<rhd> Q' \<sim> Q}"
  from p have "(\<Psi>, P, Q) \<in> ?X"
    by(blast intro: bisim_reflexive)
  thus ?thesis
  proof(coinduct rule: bisim_weak_coinduct)
    case(c_stat_eq \<Psi> P Q)
    thus ?case
      by(blast dest: r_stat_eq bisimE Frame_stat_eq_trans)
  next
    case(c_sim \<Psi> P Q)
    {
      fix \<Psi> P P' Q' Q
      assume "\<Psi> \<rhd> P \<leadsto>[bisim] P'"
      moreover assume P'_rel_q': "(\<Psi>, P', Q') \<in> X"
      hence "\<Psi> \<rhd> P' \<leadsto>[?X] Q'" by(rule r_sim)
      moreover from `eqvt X` P'_rel_q' have "eqvt ?X"
	apply(auto simp add: eqvt_def)
	apply(drule_tac p=p in bisim_closed)
	apply(drule_tac p=p in bisim_closed)
	apply(rule_tac x="p \<bullet> P'a" in exI, simp)
	by(rule_tac x="p \<bullet> Q'a" in exI, auto)
      ultimately have "\<Psi> \<rhd> P \<leadsto>[?X] Q'"
	by(force intro: transitive dest: bisim_transitive)
      moreover assume "\<Psi> \<rhd> Q' \<leadsto>[bisim] Q"
      ultimately have "\<Psi> \<rhd> P \<leadsto>[?X] Q" using `eqvt ?X`
	by(force intro: transitive dest: bisim_transitive)
    }
    with `(\<Psi>, P, Q) \<in> ?X` show ?case
      by(blast dest: bisimE)
  next
    case(c_ext \<Psi> P Q \<Psi>')
    thus ?case by(rule_tac r_ext)
  next
    case(c_sym \<Psi> P Q)
    thus ?case by(rule_tac r_sym)
  qed
qed

lemma transitive_coinduct[case_names c_stat_eq c_sim c_ext c_sym, case_conclusion bisim step, consumes 2]:
  fixes \<Psi> :: 'b
  and   P :: "('a, 'b, 'c) psi"
  and   Q :: "('a, 'b, 'c) psi"
  and   X :: "('b \<times> ('a, 'b, 'c) psi \<times> ('a, 'b, 'c) psi) set"

  assumes p: "(\<Psi>, P, Q) \<in> X"
  and Eqvt: "eqvt X"
  and r_stat_eq: "\<And>\<Psi>' R S. (\<Psi>', R, S) \<in> X \<Longrightarrow> insert_assertion (extract_frame R) \<Psi>' \<simeq>\<^sub>F insert_assertion (extract_frame S) \<Psi>'"
  and r_sim: "\<And>\<Psi>' R S. (\<Psi>', R, S) \<in> X \<Longrightarrow> \<Psi>' \<rhd> R \<leadsto>[({(\<Psi>', R, S) | \<Psi>' R R' S' S. \<Psi>' \<rhd> R \<sim> R' \<and>
                                                                        ((\<Psi>', R', S') \<in> X \<or> \<Psi>' \<rhd> R' \<sim> S') \<and>
                                                                        \<Psi>' \<rhd> S' \<sim> S})] S"
  and r_ext: "\<And>\<Psi>' R S \<Psi>''. (\<Psi>', R, S) \<in> X \<Longrightarrow> (\<Psi>' \<otimes> \<Psi>'', R, S) \<in> X \<or> \<Psi>' \<otimes> \<Psi>'' \<rhd> R \<sim> S"
  and r_sym: "\<And>\<Psi>' R S. (\<Psi>', R, S) \<in> X \<Longrightarrow> (\<Psi>', S, R) \<in> X \<or> \<Psi>' \<rhd> S \<sim> R"

  shows "\<Psi> \<rhd> P \<sim> Q"
proof -
  from p have "(\<Psi>, P, Q) \<in> (X \<union> bisim)"
    by blast
  moreover from `eqvt X` bisim_eqvt have "eqvt (X \<union> bisim)"
    by auto
  ultimately show ?thesis
  proof(coinduct rule: weak_transitive_coinduct')
    case(c_stat_eq \<Psi> P Q)
    thus ?case
      by(blast intro: r_stat_eq dest: bisimE)
  next
    case(c_sim \<Psi> P Q)
    thus ?case
      apply auto
      apply(blast intro: r_sim)
      apply(drule bisimE(2))
      apply(rule_tac A=bisim in monotonic, simp)
      by(force intro: bisim_reflexive)
  next
    case(c_ext \<Psi> P Q \<Psi>')
    thus ?case
      by(blast dest: bisimE r_ext)
  next
    case(c_sym \<Psi> P Q)
    thus ?case by(blast dest: bisimE r_sym intro: bisim_reflexive)
  qed
qed

lemma transitive_coinduct'[case_names c_stat_eq c_sim c_ext c_sym, case_conclusion bisim step, consumes 2]:
  fixes \<Psi> :: 'b
  and   P :: "('a, 'b, 'c) psi"
  and   Q :: "('a, 'b, 'c) psi"
  and   X :: "('b \<times> ('a, 'b, 'c) psi \<times> ('a, 'b, 'c) psi) set"

  assumes p: "(\<Psi>, P, Q) \<in> X"
  and Eqvt: "eqvt X"
  and r_stat_eq: "\<And>\<Psi> P Q. (\<Psi>, P, Q) \<in> X \<Longrightarrow> insert_assertion (extract_frame P) \<Psi> \<simeq>\<^sub>F insert_assertion (extract_frame Q) \<Psi>"
  and r_sim: "\<And>\<Psi> P Q. (\<Psi>, P, Q) \<in> X \<Longrightarrow> \<Psi> \<rhd> P \<leadsto>[({(\<Psi>, P, Q) | \<Psi> P P' Q' Q. \<Psi> \<rhd> P \<sim> P' \<and>
                                                                        (\<Psi>, P', Q') \<in> (X \<union> bisim) \<and>
                                                                        \<Psi> \<rhd> Q' \<sim> Q})] Q"
  and r_ext: "\<And>\<Psi> P Q \<Psi>'. (\<Psi>, P, Q) \<in> X \<Longrightarrow> (\<Psi> \<otimes> \<Psi>', P, Q) \<in> X \<or> \<Psi> \<otimes> \<Psi>' \<rhd> P \<sim> Q"
  and r_sym: "\<And>\<Psi> P Q. (\<Psi>, P, Q) \<in> X \<Longrightarrow>
                      (\<Psi>, Q, P) \<in> {(\<Psi>, P, Q) | \<Psi> P P' Q' Q. \<Psi> \<rhd> P \<sim> P' \<and> ((\<Psi>, P', Q') \<in> (X \<union> bisim)) \<and> \<Psi> \<rhd> Q' \<sim> Q}"

  shows "\<Psi> \<rhd> P \<sim> Q"
proof -
  from p have "(\<Psi>, P, Q) \<in> (X \<union> bisim)"
    by blast
  moreover from `eqvt X` bisim_eqvt have "eqvt (X \<union> bisim)"
    by auto
  ultimately show ?thesis
  proof(coinduct rule: weak_transitive_coinduct')
    case(c_stat_eq \<Psi> P Q)
    thus ?case
      by(blast intro: r_stat_eq dest: bisimE)
  next
    case(c_sim \<Psi> P Q)
    thus ?case
      apply -
      apply(case_tac "(\<Psi>, P, Q) \<in> X")
      apply(rule_tac r_sim)
      apply simp
      apply(clarify)
      apply(drule bisimE(2))
      apply(rule_tac A=bisim in monotonic, simp)
      by(force intro: bisim_reflexive)
  next
    case(c_ext \<Psi> P Q \<Psi>')
    thus ?case
      by(blast dest: bisimE r_ext)
  next
    case(c_sym \<Psi> P Q)
    thus ?case
      apply auto
      apply(drule r_sym)
      apply auto
      apply(rule_tac x=Q in exI)
      apply(auto intro: bisim_reflexive)
      apply(rule_tac x=P in exI)
      by(auto intro: bisim_reflexive dest: bisimE(4))
  qed
qed

lemma bisim_symmetric:
  fixes \<Psi> :: 'b
  and   P :: "('a, 'b, 'c) psi"
  and   Q :: "('a, 'b, 'c) psi"

  assumes "\<Psi> \<rhd> P \<sim> Q"

  shows "\<Psi> \<rhd> Q \<sim> P"
using assms
by(rule bisimE)

lemma eqvt_trans[intro]:
  assumes "eqvt X"

  shows "eqvt {(\<Psi>, P, Q) | \<Psi> P P' Q' Q. \<Psi> \<rhd> P \<sim> P' \<and> ((\<Psi>, P', Q') \<in> X \<or> \<Psi> \<rhd> P' \<sim> Q') \<and> \<Psi> \<rhd> Q' \<sim> Q}"
using assms
apply(auto simp add: eqvt_def eqvts)
apply(erule_tac x="(a, P', Q')" in ballE, auto)
by(blast dest: bisim_closed)+

lemma eqvt_weak_trans[intro]:
  assumes "eqvt X"

  shows "eqvt {(\<Psi>, P, Q) | \<Psi> P P' Q' Q. \<Psi> \<rhd> P \<sim> P' \<and> (\<Psi>, P', Q') \<in> X \<and> \<Psi> \<rhd> Q' \<sim> Q}"
using assms
apply(auto simp add: eqvt_def eqvts)
apply(erule_tac x="(a, P', Q')" in ballE, auto)
by(blast dest: bisim_closed)+

end

end


theory flash93Bra  imports flash93Rev

  begin
lemma onInv93:

   assumes

     b1:"r \<in> rules N" and b2:"invf=inv93 "
   shows  "invHoldForRule' s invf r (invariants   N)"
   proof -
have c1:"ex1P N (% iRule1 .  r=NI_Local_GetX_PutX1 N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_GetX  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Replace  iRule1 )\<or>ex0P N (  r=NI_ShWb N )\<or>ex0P N (  r=PI_Local_GetX_GetX2 )\<or>ex0P N (  r=NI_Local_PutXAcksDone )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX7 N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Nak2  iRule1 )\<or>ex0P N (  r=NI_ReplaceHomeShrVld )\<or>ex1P N (% iRule1 .  r=NI_Remote_Put  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX5 N  iRule1 )\<or>ex0P N (  r=NI_Wb )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Get  iRule1 )\<or>ex0P N (  r=PI_Local_Replace )\<or>ex1P N (% iRule1 .  r=NI_ReplaceShrVld  iRule1 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Local_GetX_PutX8 N  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=NI_InvAck_2 N  iRule1 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Remote_Get_Nak2  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=PI_Remote_Replace  iRule1 )\<or>ex0P N (  r=NI_Nak_Home )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Put2  iRule1 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_InvAck_1  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX11 N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX6 N  iRule1 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Remote_Get_Put2  iRule1  iRule2 )\<or>ex0P N (  r=PI_Local_Get_Put )\<or>ex0P N (  r=PI_Local_GetX_PutX1 N )\<or>ex1P N (% iRule1 .  r=NI_InvAck_1_Home  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Remote_Get_Nak1  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Nak1  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_Nak2  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX10_home N  iRule1 )\<or>ex1P N (% iRule1 .  r=PI_Remote_Get  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_Nak3  iRule1 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Local_GetX_PutX10 N  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX2 N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Remote_Get_Put1  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Remote_PutX  iRule1 )\<or>ex1P N (% iRule1 .  r=Store  iRule1 )\<or>ex0P N (  r=NI_FAck )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX3 N  iRule1 )\<or>ex0P N (  r=PI_Local_GetX_PutX3 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Remote_GetX_PutX  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX8_home N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Put1 N  iRule1 )\<or>ex0P N (  r=PI_Local_GetX_GetX1 )\<or>ex0P N (  r=StoreHome )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Remote_GetX_Nak  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=NI_Inv  iRule1 )\<or>ex1P N (% iRule1 .  r=PI_Remote_PutX  iRule1 )\<or>ex0P N (  r=PI_Local_GetX_PutX4 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX4 N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Nak  iRule1 )\<or>ex0P N (  r=PI_Local_GetX_PutX2 N )\<or>ex0P N (  r=NI_Local_Put )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_Nak1  iRule1 )\<or>ex0P N (  r=NI_Nak_Clear )\<or>ex0P N (  r=PI_Local_PutX )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Nak3  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Remote_GetX_Nak_Home  iRule1 )\<or>ex0P N (  r=PI_Local_Get_Get )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX9 N  iRule1 )\<or>ex1P N (% iRule1 .  r=PI_Remote_GetX  iRule1 )\<or>ex0P N (  r=NI_ReplaceHome )\<or>ex1P N (% iRule1 .  r=NI_Remote_GetX_PutX_Home  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Put3  iRule1 )"

        apply(cut_tac  b1)
        apply auto
        done      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX1 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX1 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (NI_Local_GetX_PutX1 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX1VsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_GetX  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_GetX  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (NI_Local_GetX_GetX  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_GetXVsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Replace  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Replace  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (NI_Replace  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_ReplaceVsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_ShWb N )
"

         from c1 have c2:" r= NI_ShWb N "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv93 ) (NI_ShWb N ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_ShWbVsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_GetX2 )
"

         from c1 have c2:" r= PI_Local_GetX_GetX2 "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv93 ) (PI_Local_GetX_GetX2 ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_GetX2VsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= NI_Local_PutXAcksDone )
"

         from c1 have c2:" r= NI_Local_PutXAcksDone "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv93 ) (NI_Local_PutXAcksDone ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_Local_PutXAcksDoneVsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX7 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX7 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (NI_Local_GetX_PutX7 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX7VsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Nak2  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Nak2  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (NI_Local_Get_Nak2  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Nak2VsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_ReplaceHomeShrVld )
"

         from c1 have c2:" r= NI_ReplaceHomeShrVld "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv93 ) (NI_ReplaceHomeShrVld ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_ReplaceHomeShrVldVsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_Put  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_Put  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (NI_Remote_Put  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_PutVsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX5 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX5 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (NI_Local_GetX_PutX5 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX5VsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_Wb )
"

         from c1 have c2:" r= NI_Wb "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv93 ) (NI_Wb ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_WbVsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Get  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Get  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (NI_Local_Get_Get  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_GetVsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_Replace )
"

         from c1 have c2:" r= PI_Local_Replace "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv93 ) (PI_Local_Replace ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_ReplaceVsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_ReplaceShrVld  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_ReplaceShrVld  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (NI_ReplaceShrVld  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_ReplaceShrVldVsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Local_GetX_PutX8 N  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Local_GetX_PutX8 N  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv93 ) (NI_Local_GetX_PutX8 N  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX8VsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_InvAck_2 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_InvAck_2 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (NI_InvAck_2 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_InvAck_2VsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Remote_Get_Nak2  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Remote_Get_Nak2  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv93 ) (NI_Remote_Get_Nak2  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_Get_Nak2VsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= PI_Remote_Replace  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= PI_Remote_Replace  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (PI_Remote_Replace  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis PI_Remote_ReplaceVsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_Nak_Home )
"

         from c1 have c2:" r= NI_Nak_Home "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv93 ) (NI_Nak_Home ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_Nak_HomeVsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Put2  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Put2  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (NI_Local_Get_Put2  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Put2VsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_InvAck_1  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_InvAck_1  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv93 ) (NI_InvAck_1  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_InvAck_1VsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX11 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX11 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (NI_Local_GetX_PutX11 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX11VsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX6 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX6 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (NI_Local_GetX_PutX6 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX6VsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Remote_Get_Put2  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Remote_Get_Put2  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv93 ) (NI_Remote_Get_Put2  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_Get_Put2VsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_Get_Put )
"

         from c1 have c2:" r= PI_Local_Get_Put "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv93 ) (PI_Local_Get_Put ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_Get_PutVsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_PutX1 N )
"

         from c1 have c2:" r= PI_Local_GetX_PutX1 N "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv93 ) (PI_Local_GetX_PutX1 N ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_PutX1VsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_InvAck_1_Home  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_InvAck_1_Home  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (NI_InvAck_1_Home  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_InvAck_1_HomeVsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_Get_Nak1  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_Get_Nak1  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (NI_Remote_Get_Nak1  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_Get_Nak1VsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Nak1  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Nak1  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (NI_Local_Get_Nak1  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Nak1VsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_Nak2  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_Nak2  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (NI_Local_GetX_Nak2  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_Nak2VsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX10_home N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX10_home N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (NI_Local_GetX_PutX10_home N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX10_homeVsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= PI_Remote_Get  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= PI_Remote_Get  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (PI_Remote_Get  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis PI_Remote_GetVsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_Nak3  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_Nak3  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (NI_Local_GetX_Nak3  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_Nak3VsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Local_GetX_PutX10 N  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Local_GetX_PutX10 N  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv93 ) (NI_Local_GetX_PutX10 N  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX10VsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX2 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX2 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (NI_Local_GetX_PutX2 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX2VsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_Get_Put1  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_Get_Put1  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (NI_Remote_Get_Put1  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_Get_Put1VsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_PutX  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_PutX  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (NI_Remote_PutX  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_PutXVsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= Store  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= Store  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (Store  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis StoreVsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_FAck )
"

         from c1 have c2:" r= NI_FAck "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv93 ) (NI_FAck ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_FAckVsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX3 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX3 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (NI_Local_GetX_PutX3 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX3VsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_PutX3 )
"

         from c1 have c2:" r= PI_Local_GetX_PutX3 "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv93 ) (PI_Local_GetX_PutX3 ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_PutX3VsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Remote_GetX_PutX  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Remote_GetX_PutX  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv93 ) (NI_Remote_GetX_PutX  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_GetX_PutXVsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX8_home N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX8_home N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (NI_Local_GetX_PutX8_home N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX8_homeVsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Put1 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Put1 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (NI_Local_Get_Put1 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Put1VsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_GetX1 )
"

         from c1 have c2:" r= PI_Local_GetX_GetX1 "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv93 ) (PI_Local_GetX_GetX1 ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_GetX1VsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= StoreHome )
"

         from c1 have c2:" r= StoreHome "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv93 ) (StoreHome ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis StoreHomeVsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Remote_GetX_Nak  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Remote_GetX_Nak  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv93 ) (NI_Remote_GetX_Nak  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_GetX_NakVsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Inv  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Inv  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (NI_Inv  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_InvVsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= PI_Remote_PutX  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= PI_Remote_PutX  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (PI_Remote_PutX  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis PI_Remote_PutXVsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_PutX4 )
"

         from c1 have c2:" r= PI_Local_GetX_PutX4 "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv93 ) (PI_Local_GetX_PutX4 ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_PutX4VsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX4 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX4 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (NI_Local_GetX_PutX4 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX4VsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Nak  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Nak  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (NI_Nak  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_NakVsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_PutX2 N )
"

         from c1 have c2:" r= PI_Local_GetX_PutX2 N "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv93 ) (PI_Local_GetX_PutX2 N ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_PutX2VsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= NI_Local_Put )
"

         from c1 have c2:" r= NI_Local_Put "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv93 ) (NI_Local_Put ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_Local_PutVsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_Nak1  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_Nak1  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (NI_Local_GetX_Nak1  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_Nak1VsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_Nak_Clear )
"

         from c1 have c2:" r= NI_Nak_Clear "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv93 ) (NI_Nak_Clear ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_Nak_ClearVsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= PI_Local_PutX )
"

         from c1 have c2:" r= PI_Local_PutX "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv93 ) (PI_Local_PutX ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_PutXVsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Nak3  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Nak3  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (NI_Local_Get_Nak3  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Nak3VsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_GetX_Nak_Home  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_GetX_Nak_Home  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (NI_Remote_GetX_Nak_Home  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_GetX_Nak_HomeVsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_Get_Get )
"

         from c1 have c2:" r= PI_Local_Get_Get "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv93 ) (PI_Local_Get_Get ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_Get_GetVsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX9 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX9 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (NI_Local_GetX_PutX9 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX9VsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= PI_Remote_GetX  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= PI_Remote_GetX  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (PI_Remote_GetX  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis PI_Remote_GetXVsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_ReplaceHome )
"

         from c1 have c2:" r= NI_ReplaceHome "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv93 ) (NI_ReplaceHome ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_ReplaceHomeVsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_GetX_PutX_Home  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_GetX_PutX_Home  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (NI_Remote_GetX_PutX_Home  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_GetX_PutX_HomeVsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Put3  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Put3  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv93 ) (NI_Local_Get_Put3  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Put3VsInv93 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }ultimately show "invHoldForRule' s invf r (invariants N) "
          by blast
     qed
end


theory Ex_Untyped
imports Monad2
begin

  typedecl global_state
  typedecl val

  datatype err = STATIC_ERROR

  datatype label_name = LABEL_NAME string
  datatype proc_name = PROC_NAME string
  datatype lvar_name = LVAR_NAME string

  datatype nt_instr =
    BASIC (resvar: lvar_name) "global_state \<Rightarrow> (val\<times>global_state)"
  | CALL (resvar: lvar_name) proc_name "lvar_name list"
  hide_const (open) resvar

  datatype t_instr =
    RETURN lvar_name
  | BR label_name
  | CBR lvar_name label_name label_name

  datatype basic_block = BBLOCK "nt_instr list" t_instr

  datatype procedure = PROC
    (params: "lvar_name list")
    (prologue: basic_block)
    (blocks: "(label_name\<times>basic_block) list")
  hide_const (open) params prologue blocks

  datatype program = PROG (procedures: "(proc_name \<times> procedure) list")
  hide_const (open) procedures

  locale program_loc =
    fixes \<pi> :: program
  begin
    definition "proc_map \<equiv> map_of (program.procedures \<pi>)"

  end

  locale procedure_loc = program_loc +
    fixes p :: procedure
  begin
    definition "block_map \<equiv> map_of (procedure.blocks p)"
  end

section \<open>Semantics\<close>

axiomatization val_to_bool :: "val \<Rightarrow> bool"

type_synonym local_state = "lvar_name \<rightharpoonup> val"
definition fresh_local_state :: local_state where "fresh_local_state \<equiv> Map.empty"

lemma fresh_local_state_empty[simp]:
  "fresh_local_state x = None"
  "dom fresh_local_state = {}"
  by (auto simp: fresh_local_state_def)

locale sem_program = program_loc +
  fixes execute_proc :: "proc_name \<times> val list \<Rightarrow> (val,unit,global_state,err) M"

locale sem_procedure = sem_program + procedure_loc

(* TODO: If we have lenses, use zoom fst\<^sub>L here! *)
definition define_lvar where
  "define_lvar name val \<equiv> doM {
    (l,g)\<leftarrow>get;
    fcheck STATIC_ERROR (name\<notin>dom l);
    let l = l(name\<mapsto>val);
    set (l,g)
  }"

definition get_lvar where
  "get_lvar name \<equiv> doM {
    (l,g)\<leftarrow>get;
    lookup STATIC_ERROR l name
  }"

definition "zoom_global m \<equiv> doM {
  (l,_)\<leftarrow>get;
  mblock (snd) (Pair l) m
}"

lemma zoom_global_alt: "zoom_global m = zoom (lift_lens STATIC_ERROR snd\<^sub>L) m"
  unfolding zoom_global_def zoom_def
  apply (rule M_eqI)
  by (auto simp: run_simps split: prod.splits mres.splits option.splits simp: mwp_def)

definition "noexcept m \<equiv> handle m (\<lambda>_. fail STATIC_ERROR)"

lemma noexcept_mono[partial_function_mono]: "\<And>x. M_mono (\<lambda>f. noexcept (f x))"
  unfolding noexcept_def by pf_mono_prover

context sem_procedure begin

  definition execute_nt_instr :: "nt_instr \<Rightarrow> (unit,val,local_state\<times>global_state,err) M"
    where "execute_nt_instr \<equiv> \<lambda>
      BASIC rvar f \<Rightarrow> doM {
        (l,g)\<leftarrow>get;
        let (r,g) = f g;
        set (l,g);
        define_lvar rvar r
      }
    | CALL rvar n args \<Rightarrow> doM {
        argvs \<leftarrow> mmap get_lvar args;
        r \<leftarrow> zoom_global (noexcept (execute_proc (n,argvs)));
        define_lvar rvar r
      }
    "

  definition execute_t_instr :: "t_instr \<Rightarrow> (label_name,val,local_state\<times>global_state,err) M"
    where "execute_t_instr \<equiv> \<lambda>
      RETURN v \<Rightarrow> doM { v\<leftarrow>get_lvar v; raise v }
    | BR label \<Rightarrow> doM { return label }
    | CBR cond iftrue iffalse \<Rightarrow> doM { v\<leftarrow>get_lvar cond; if val_to_bool v then return iftrue else return iffalse }
    "

  definition "execute_block \<equiv> \<lambda>BBLOCK ntis ti\<Rightarrow> doM {
    (* Execute nonterminal instructions *)
    mfold' execute_nt_instr ntis;
    (* Execute terminal instruction *)
    execute_t_instr ti
  }"

  definition "execute_block_reset block \<equiv> doM {
    (* Save local definitions *)
    (l,_)\<leftarrow>get;
    (* Execute block and obtain next label *)
    label \<leftarrow> execute_block block;
    (* Restore local definitions after block execution *)
    map_state (apfst (\<lambda>_. l));

    return label
  }"

  definition "execute args \<equiv> doM {
    fcheck STATIC_ERROR (length (procedure.params p) = length args);
    mblock (Pair fresh_local_state) (snd) (doM {
      (* Define Parameters*)
      mfold' (uncurry define_lvar) (zip (procedure.params p) args);

      handle (doM {
        (* Execute Prologue *)
        label \<leftarrow> execute_block (procedure.prologue p);

        (* Execute Blocks *)
        mwhile (\<lambda>_. return True) (\<lambda>label. doM {
          (* Lookup label *)
          block \<leftarrow> lookup STATIC_ERROR block_map label;
          execute_block_reset block
        }) label;

        fail STATIC_ERROR (* Unreachable *)
      }) (\<lambda>r. return r)
    })
  }"

end

context sem_program begin

  term "sem_procedure.execute execute_proc"

  definition execute_proc_body :: "proc_name \<times> val list \<Rightarrow> (val, unit, global_state, err) M"
    where
  "execute_proc_body \<equiv> \<lambda>(name,args). doM {
    proc \<leftarrow> lookup STATIC_ERROR proc_map name;
    sem_procedure.execute execute_proc proc args
  }"

end

context program_loc begin
  term "sem_program.execute_proc_body \<pi>"

  definition "execute_proc \<equiv> REC (sem_program.execute_proc_body \<pi>)"

  lemma proc_execute_mono[partial_function_mono]:
    "M_mono (\<lambda>fa. sem_procedure.execute fa p args)"
  proof -
    interpret sem_procedure \<pi> f p for f .

    show ?thesis
      unfolding execute_def execute_block_def execute_block_reset_def execute_nt_instr_def zoom_global_def
      by pf_mono_prover
  qed

  lemma execute_proc_body_mono[partial_function_mono]:
    "M.mono_body (\<lambda>fa. sem_program.execute_proc_body \<pi> fa x)"
    unfolding sem_program.execute_proc_body_def
    by pf_mono_prover

  lemmas execute_proc_unfold = REC_unfold[OF execute_proc_def, discharge_monos]
     and execute_proc_partial = lrmwpe_REC_partial[OF execute_proc_def, discharge_monos, consumes 1, case_names nterm step]
     and execute_proc_total = lrmwpe_REC_total[OF execute_proc_def, discharge_monos, consumes 1, case_names wf step]

end

term program_loc.execute_proc

lemma sim_zoom_global[sim_rules]: "sim m m' \<Longrightarrow> sim (zoom_global m) (zoom_global m')"
  by (auto simp: zoom_global_def intro!: sim_rules)

lemma sim_noexcept[sim_rules]: "sim m m' \<Longrightarrow> sim (noexcept m) (noexcept m')"
  by (auto intro!: sim_rules simp: noexcept_def)

locale prog_sim = \<pi>: program_loc \<pi> + \<pi>': program_loc \<pi>' for \<pi> \<pi>' +
  assumes proc_map_le: "\<pi>.proc_map \<subseteq>\<^sub>m \<pi>'.proc_map"
begin

  lemmas execute_proc_sim_aux = sim_REC[OF \<pi>.execute_proc_def \<pi>'.execute_proc_def, discharge_monos]

  lemma execute_block_sim[sim_rules]:
    "(\<And>x. sim (f x) (f' x)) \<Longrightarrow> sim (sem_procedure.execute_block f b) (sem_procedure.execute_block f' b)"
    by (auto
      intro!: sim_rules
      simp: sem_procedure.execute_block_def sem_procedure.execute_nt_instr_def
      split: basic_block.splits nt_instr.splits)

  lemma execute_proc_sim[sim_rules]:
    shows "sim (\<pi>.execute_proc (p,args)) (\<pi>'.execute_proc (p,args))"
    by (auto
      intro!: sim_rules execute_proc_sim_aux
      simp: sem_program.execute_proc_body_def sem_procedure.execute_def sem_procedure.execute_block_reset_def
      simp: proc_map_le
    )

end

context procedure_loc begin

  definition "wt_args args \<equiv> fcheck () (length args = length (procedure.params p))"

end

context program_loc begin

  definition wt_execute_proc :: "proc_name \<times> unit list \<Rightarrow> (unit, unit, unit, unit) M"
    where "wt_execute_proc \<equiv> \<lambda>(n,args). doM {
      p\<leftarrow>lookup () proc_map n;
      procedure_loc.wt_args p args
    }"

end

definition "wt_define_lvar name = doM {
  l\<leftarrow>get;
  fcheck () (name\<notin>l);
  let l = insert name l;
  set l
}"

definition wt_get_lvar where
  "wt_get_lvar name \<equiv> doM {
    l\<leftarrow>get;
    fcheck () (name\<in>l)
  }"

lemma lrmwp_define_lvar[THEN mwp_cons, intro!]:
  assumes "run (wt_define_lvar n) (dom l) = (SUCC () L')"
  shows "mwp (run (define_lvar n v) (l, g)) bot bot bot (\<lambda>_ (l',g'). g'=g \<and> l'=l(n\<mapsto>v) \<and> L'=insert n (dom l))"
  using assms
  by (auto
    simp: run_simps define_lvar_def wt_define_lvar_def
    split: if_splits
    )

lemma lrmwp_get_lvar[THEN mwp_cons, intro!]:
  assumes "run (wt_get_lvar n) (dom l) = SUCC () L'"
  shows "mwp (run (get_lvar n) (l, g)) bot bot bot (\<lambda>r lg'. lg'=(l,g) \<and> L'=dom l \<and> l n = Some r)"
  using assms
  by (auto
    simp: get_lvar_def wt_get_lvar_def run_simps
    split: if_splits option.splits
    )

definition "wt_zoom_global m \<equiv> doM {
  L\<leftarrow>get;
  mblock (\<lambda>_. ()) (\<lambda>_. L) m
}"

context procedure_loc begin

  abbreviation "params \<equiv> procedure.params p"
  abbreviation "prologue \<equiv> procedure.prologue p"
  abbreviation "blocks \<equiv> procedure.blocks p"

  fun wt_nt_instr where
    "wt_nt_instr (BASIC rvar f) = doM {
      wt_define_lvar rvar
    }"
  | "wt_nt_instr (CALL rvar n args) = doM {
      argvs \<leftarrow> mmap wt_get_lvar args;
      r \<leftarrow> wt_zoom_global (wt_execute_proc (n,argvs));
      wt_define_lvar rvar
    }"

  fun wt_t_instr where
    "wt_t_instr (RETURN v) = doM { wt_get_lvar v}"
  | "wt_t_instr (BR label) = doM { fcheck () (label\<in>dom block_map) }"
  | "wt_t_instr (CBR cond iftrue iffalse) = doM { wt_get_lvar cond; fcheck () ({iftrue,iffalse}\<subseteq>dom block_map) }"

  fun wt_block where
    "wt_block (BBLOCK ntis ti) = doM {
      mfold' wt_nt_instr ntis;
      wt_t_instr ti
    }"

  definition wt_blocks where
    "wt_blocks \<equiv> doM {
      l\<leftarrow>get;

      mmap (\<lambda>(_,block). doM {
        set l;
        wt_block block
      }) blocks;

      return ()
    }"

  definition wt_proc :: "(unit,unit,unit,unit) M" where "wt_proc \<equiv> doM {
    fcheck () (distinct (map fst blocks));

    mblock (\<lambda>_. {}) (\<lambda>_. ()) (doM {
      mfold' wt_define_lvar params;

      wt_block prologue;

      wt_blocks;

      return ()
    })
  }"

end

lemma mwp_eq_splitE:
  assumes "mwp m N F E S = r"
  obtains "m=NTERM" "N = r"
    | msg where "m = FAIL msg" "F msg = r"
    | e s where "m = EXC e s" "E e s = r"
    | x s where "m = SUCC x s" "S x s = r"
  using assms apply (cases m) by auto

context procedure_loc begin

  lemma lrmwp_wt_define_args[THEN mwp_cons, intro!]:
    fixes args :: "'a list"
    assumes "run (mfold' wt_define_lvar params) (dom l) = (SUCC () L')"
    assumes "length args = length params"
    shows "mwp (run (mfold' (uncurry define_lvar) (zip params args)) (l, g)) bot bot bot (\<lambda>_ (l',g'). L'=dom l' \<and> g'=g)"
  proof -
    {
      fix p and a :: "'a list"
      assume
          "length a = length p"
      and "run (mfold' wt_define_lvar p) (dom l) = (SUCC () L')"
      then have "mwp (run (mfold' (uncurry define_lvar) (zip p a)) (l, g)) bot bot bot (\<lambda>_ (l',g'). L'=dom l' \<and> g'=g)"
        apply (induction a p arbitrary: l g L' rule: list_induct2)
        apply (auto simp: run_simps elim!: mwp_eq_splitE)
        done
    }
    with assms show ?thesis by auto
  qed

end

lemma run_mmap_get_lvar[THEN mwp_cons]:
  assumes "run (mmap wt_get_lvar xs) (dom l) = (SUCC ys L')"
  shows "mwp (run (mmap get_lvar xs) (l, g)) bot bot bot (\<lambda>vs lg'. lg'=(l,g) \<and> L'=dom l \<and> length vs = length xs \<and> length ys = length xs)"
  using assms
proof (induction xs arbitrary: l g ys L')
  case Nil
  then show ?case by (auto simp: run_simps)
next
  case (Cons a xs)
  note IH = Cons.IH[THEN mwp_cons]
  from Cons.prems show ?case
    apply (auto simp: run_simps elim!: mwp_eq_splitE IH)
    done

qed

lemma run_noexcept[run_simps]:
  "run (noexcept m) s = mwp (run m s) NTERM (\<lambda>msg. FAIL msg) (\<lambda>_ _. FAIL STATIC_ERROR) (\<lambda>x s. SUCC x s)"
  by (auto simp: noexcept_def run_simps mwp_def split: mres.split)

lemma run_mmap_length_eq:
  assumes "run (mmap f xs) s = SUCC ys s'"
  shows "length ys = length xs"
  using assms apply (induction xs arbitrary: ys s)
  by (auto simp: run_simps elim!: mwp_eq_splitE)

lemma run_mmap_unit_state_idxD:
  assumes "run (mmap f xs) () = SUCC ys ()"
  assumes "i<length xs"
  shows "run (f (xs!i)) () = SUCC (ys!i) ()"
  using assms apply (induction xs arbitrary: i ys)
  by (auto simp: run_simps nth_Cons split: nat.splits elim!: mwp_eq_splitE)

lemma run_mmap_unit_state_elemD:
  assumes "run (mmap f xs) () = SUCC ys ()"
  assumes "x\<in>List.set xs"
  shows "\<exists>y\<in>List.set ys. run (f x) () = SUCC y ()"
  using assms
  by (auto simp: in_set_conv_nth Bex_def run_mmap_unit_state_idxD run_mmap_length_eq)

lemma run_mmap_idxD:
  assumes "run (mmap f xs) s = SUCC ys s'"
  assumes "i<length xs"
  shows "\<exists>s s'. run (f (xs!i)) s = SUCC (ys!i) s'"
  using assms apply (induction xs arbitrary: i ys s s')
  by (auto 0 5 simp: run_simps nth_Cons split: nat.splits elim!: mwp_eq_splitE)

lemma run_mmap_elemD:
  assumes "run (mmap f xs) s = SUCC ys s'"
  assumes "x\<in>List.set xs"
  shows "\<exists>s s'. \<exists>y\<in>List.set ys. run (f x) s = SUCC y s'"
  using assms
  by (auto simp: in_set_conv_nth Bex_def run_mmap_length_eq dest!: run_mmap_idxD)

(* TODO: Move *)
lemma mwp_map_state[simp]:
  "mwp (map_mres_state f m) N F E S = mwp m N F (\<lambda>e s. E e (f s)) (\<lambda>x s. S x (f s))"
  by (cases m) auto

context program_loc begin

  definition "wt_program \<equiv> doM {
    fcheck () (distinct (map fst (program.procedures \<pi>)));
    mmap (procedure_loc.wt_proc \<pi> o snd) (program.procedures \<pi>);
    return ()
  }"

  lemma
    assumes "(run (execute_proc (n,args)) s) = r"
    assumes "run (wt_execute_proc (n,argTs)) () = (SUCC () ())"
    assumes "length args = length argTs"
    assumes WTP: "run wt_program () = (SUCC () ())"
    shows "mwp r top bot bot top"
    using assms(1,2,3)
  proof (induction "(n,args)" s r arbitrary: n args argTs rule: execute_proc_partial)
    case (nterm x s)
    then show ?case by simp
  next
    case (step execute_proc_rec s r)

    note IH = step.hyps(1)[OF refl,THEN mwp_cons]

    interpret sem_program \<pi> execute_proc_rec .

    obtain p where PMN: "proc_map n = Some p"
      using step.prems unfolding wt_execute_proc_def
      by (auto simp: run_simps split: option.splits)

    interpret procedure_loc \<pi> p .
    interpret sem_procedure \<pi> execute_proc_rec p .

    from WTP PMN have WT_PROC: "run wt_proc () = (SUCC () ())"
      by (auto simp: wt_program_def proc_map_def run_simps
        split: if_splits
        dest!: run_mmap_unit_state_elemD
        elim!: mwp_eq_splitE)

    note PMN[simp]

    from step.prems have [simp]: "length args = length params"
      by (auto simp: wt_execute_proc_def run_simps  wt_args_def split: if_splits)

    have [THEN mwp_cons, elim!]:
      "mwp (run (execute_nt_instr i) (l, g)) top bot top (\<lambda>_ (l',g'). L'=dom l')"
      if "run (wt_nt_instr i) (dom l) = (SUCC () L')"
      for L' i l g
      using that
      by (fastforce
        simp:  run_simps execute_nt_instr_def zoom_global_alt wt_zoom_global_def
        elim!: IH mwp_eq_splitE run_mmap_get_lvar
        split: nt_instr.splits prod.splits option.splits)

    have [THEN mwp_cons, elim!]:
      "mwp (run (mfold' execute_nt_instr ins) (l, g)) top bot top (\<lambda>_ (l',g'). L'=dom l')"
      if "run (mfold' wt_nt_instr ins) (dom l) = (SUCC () L')"
      for L' ins l g
      using that
      apply (induction ins arbitrary: L' l g)
      by (auto simp: run_simps elim!: mwp_eq_splitE)

    have [THEN mwp_cons, elim!]:
      "mwp (run (execute_t_instr block) (l, g)) True bot top (\<lambda>label (l', g'). L' = dom l' \<and> label \<in> dom block_map)"
      if "run (wt_t_instr block) (dom l) = (SUCC () L')"
      for L' block l g
      using that
      by (auto
        simp: execute_t_instr_def run_simps
        elim!: mwp_eq_splitE
        split: t_instr.splits if_splits
      )

    have [THEN mwp_cons, elim!]:
      "mwp (run (execute_block block) (l, g)) top bot top (\<lambda>label (l',g'). L'=dom l' \<and> label\<in>dom block_map)"
      if "run (wt_block block) (dom l) = (SUCC () L')"
      for L' l g block
      using that
      by (auto
        simp: execute_block_def run_simps
        elim!: mwp_eq_splitE
        split: basic_block.splits)

    (*
    note EB_WRULE = lrmwpe_mwhile[where
          I="\<lambda>label (l,g). l=l\<^sub>0 \<and> label \<in> dom block_map"
      and s="(l\<^sub>0,g\<^sub>0)" for l\<^sub>0 g\<^sub>0
    ]*)

    have [THEN mwp_cons, intro!]:
      "mwp (run (execute_block_reset block) (l, g)) top bot top (\<lambda>label (l',g'). l'=l \<and> label\<in>dom block_map)"
      if "run wt_blocks (dom l) = (SUCC () L')"
      and "block_map label = Some block"
      for l block g label L'
    proof -
      from that(2) have "(label,block)\<in>list.set blocks"
        by (auto simp: block_map_def map_of_SomeD)
      with that(1) obtain L'' where "run (wt_block block) (dom l) = (SUCC () L'')"
        by (auto
          simp: wt_blocks_def run_simps
          split!: prod.splits
          elim!: mwp_eq_splitE
          dest!: run_mmap_elemD)
      with that(1) show ?thesis
        unfolding execute_block_reset_def
        by (auto elim!: simp: run_simps map_state_def)

    qed

    note EB_WRULE = mwhile_invar_rule[where
          I="\<lambda>label (l,g). l=l\<^sub>0 \<and> label \<in> dom block_map"
      and s="(l\<^sub>0,g\<^sub>0)" for l\<^sub>0 g\<^sub>0]

    note EB_WRULE = EB_WRULE[OF refl, where P="\<lambda>r. mwp r N F E S"  for N F E S, simplified]

    have "mwp (run (execute args) s) top bot bot top"
      using WT_PROC
      apply (auto
        simp: execute_def wt_proc_def run_simps
        split: if_splits prod.splits
        elim!: mwp_eq_splitE
        intro!: EB_WRULE
        )
      by simp_all

    with step.hyps(2) show ?case
      by (auto simp: execute_proc_body_def run_simps)

  qed

end

end


\<^marker>\<open>creator "Maximilian P. L. Haslbeck"\<close>
chapter \<open>Quantitative Separation Logic for other domains\<close>
theory QSL_For_Experimental_Domains
imports Quantitative_Separation_Connectives "NREST.NREST"
 begin

paragraph \<open>Summary\<close>

text \<open>This experimental theory tries to instantiate the quantitative separation logic
      with (enat option,>=,+,-).

      Apparently the theory still fails, maybe this domain is not really quantale?
    \<close>

 term mm2

fun eo_plus :: "enat option \<Rightarrow> enat option \<Rightarrow> enat option" where
  "eo_plus None _ = None"
| "eo_plus _ None = None"
| "eo_plus (Some a) (Some b) = Some (a+b)"

lemma eo_plus_comm: "eo_plus a b = eo_plus b a"
  apply(cases a; cases b) apply auto done

lemma "mm2 (Some (a+enat b)) (Some (enat b)) = Some a"
  unfolding mm2_def
  apply simp
  by (metis add.commute add_diff_cancel_enat enat.distinct(2))

lemma "(a<\<infinity>\<or>b<\<infinity>) \<Longrightarrow>
  mm2 (Some (a+b)) (Some (b)) = Some a"
  unfolding mm2_def
  apply simp
  oops

lemma GC: "(A \<le> mm2 B C) \<longleftrightarrow> eo_plus C A \<le> B"
  apply(cases C)
  subgoal unfolding mm2_def  by simp
  subgoal for c apply(cases c)
    subgoal unfolding mm2_def apply simp
      apply(cases A; cases B) apply auto
      subgoal
        using le_less_trans by fastforce
      subgoal
        by (simp add: enat_plus_minus_aux2)
      subgoal
        by (simp add: enat_plus_minus_aux1)
      done
    subgoal unfolding mm2_def
      apply(cases A) apply simp apply simp
      apply(cases B) apply simp apply simp done
    done
  done

lemma f_GC_antimono:
  fixes x y :: "(enat option)"
    and f :: "_ \<Rightarrow> _ \<Rightarrow> (enat option)"
  assumes GC: "(\<And>A B C. (A \<le> f B C) = (g C A \<le> B))"
     and *: "x \<le> y"
   shows "f q x \<ge> f q y"
  oops

lemma f_GC_mono:
  fixes x y :: "('b::{order})"
    and f :: "_ \<Rightarrow> _ \<Rightarrow> ('a::{order})"
  assumes GC: "(\<And>A B C. (A \<le> f B C) = (g C A \<le> B))"
     and *: "x \<le> y"
  shows "f x q \<le> f y q"
  apply(subst GC)
  apply(rule order.trans)
   apply(subst GC[symmetric])
   defer apply (rule *)  by simp

lemma mm2_mono: " x \<le> y \<Longrightarrow> mm2 x q \<le> mm2 y q"
  using GC
      by (metis order.trans order_mono_setup.refl)

lemma mm2_mono_miraculous: "x \<le> y \<Longrightarrow> mm2 x q \<le> mm2 y q"
  apply(subst GC)
  apply(rule order.trans)
   apply(subst GC[symmetric])
  defer apply simp by simp

lemma mm2_mono': "x \<le> y \<Longrightarrow> mm2 x q \<le> mm2 y q"
  unfolding mm2_def apply(cases q) apply (auto split: option.splits)
  using le_some_optE apply blast apply(rule helper) by auto

lemma mm_continous: "mm (\<lambda>x. Inf {u. \<exists>y. u = f y x}) m x = Inf {u. \<exists>y. u = mm (f y) m x}"
  apply(rule antisym)
  subgoal apply(rule Inf_greatest) apply clarsimp
  proof (cases "Inf {u. \<exists>y. u = f y x}")
    case None
    have f: "m x \<noteq> None \<Longrightarrow> mm (\<lambda>x. Inf {u. \<exists>y. u = f y x}) m x = None" unfolding mm_def None apply(cases "m x") by (auto )
    then show "\<And>y. mm (\<lambda>x. Inf {u. \<exists>y. u = f y x}) m x \<le> mm (f y) m x"
      apply(cases "m x") apply(auto simp: f) unfolding mm_def by auto
  next
    case (Some l)
    then show "\<And>y. mm (\<lambda>x. Inf {u. \<exists>y. u = f y x}) m x \<le> mm (f y) m x"
      apply(cases "m x") subgoal unfolding mm_def by auto
    proof -
      fix y a assume I: "Inf {u. \<exists>y. u = f y x} = Some l" " m x = Some a"
      from I have i: "\<And>y. f y x \<ge> Some l"
        by (metis (mono_tags, lifting) Inf_lower mem_Collect_eq)
      show "mm (\<lambda>x. Inf {u. \<exists>y. u = f y x}) m x \<le> mm (f y) m x"
        apply(rule mm_mono) unfolding I apply(rule i) .
    qed
  qed
  subgoal   apply(rule Inf_lower) apply clarsimp
  proof -
    have "\<exists>y. Inf {u. \<exists>y. u = f y x} = f y x"
      unfolding Inf_option_def apply auto unfolding Inf_enat_def apply auto
      apply (metis (mono_tags) empty_iff in_these_eq mem_Collect_eq option.exhaust)
      by (smt LeastI in_these_eq mem_Collect_eq)
    then obtain y where z: "Inf {u. \<exists>y. u = f y x} = f y x" by blast
    show "\<exists>y. mm (\<lambda>x. Inf {u. \<exists>y. u = f y x}) m x = mm (f y) m x"
      apply(rule exI[where x=y]) unfolding mm_def z ..
  qed
  done

lemma enat_plus_Sup_distrib:
  "A\<noteq>{} \<Longrightarrow> (a::enat) + Sup A = Sup ((+) a ` A)"
  apply(cases a)
  subgoal
  unfolding Sup_enat_def apply auto
   apply (metis Max.hom_commute empty_iff enat_add_left_cancel_le max_def plus_enat_simps(2))
  apply(subst (asm) finite_image_iff)
  subgoal unfolding inj_on_def by auto
  subgoal apply simp done
  done
  subgoal by simp
  done

lemma eo_plus_Sup_distrib:
  "eo_plus (c::enat option) (Sup A) = Sup (eo_plus c ` A)"
proof (cases c)
  case None
  then show ?thesis apply auto
    by (metis SUP_bot_conv(2) Sup_empty empty_Sup)
next
  case (Some a)
  then show ?thesis
  proof (cases "A = {} \<or> A = {None} ")
    case True
    then show ?thesis
      unfolding Sup_option_def  apply(cases c) by auto
  next
    case False
    then have *: "A\<noteq>{}" "A \<noteq> {None}" by auto
    have 2: "A\<subseteq>UNIV" by auto
    have 3: "\<exists>x. Some x \<in> A"
      using *  2 unfolding UNIV_option_conv by blast
    then have "\<exists>x. Some x \<in> eo_plus c ` A"
      using Some apply auto
      subgoal for x apply(rule exI[where x="a+x"])
        apply(rule image_eqI[where x="Some x"]) by auto
      done
    then have nn: "eo_plus c ` A \<noteq> {None}" by auto
    from * have ne: "eo_plus c ` A \<noteq> {}" by simp
    from 3 have "Option.these A \<noteq>{}"
      unfolding Option.these_def by auto

    have k: "Option.these (eo_plus (Some a) ` A)
            = ((+) a) ` (Option.these A)"
      apply rule
      subgoal apply rule
        subgoal   for x
          unfolding Option.these_def apply clarsimp
          subgoal for xa
            apply(cases xa)
             apply simp
            subgoal for v
              apply(rule image_eqI[where x=v]) apply simp
              apply(rule image_eqI[where x="Some v"]) by auto
            done
          done
        done
      subgoal apply rule
        subgoal   for x
          unfolding Option.these_def
          apply clarsimp
          subgoal for v
            apply(rule image_eqI[where x="eo_plus (Some a) (Some v)"])
             apply simp
            by force
          done
        done
      done

    show ?thesis
      unfolding Sup_option_def
      using * nn ne Some apply simp
      unfolding k
      by (simp add: \<open>Option.these A \<noteq> {}\<close> enat_plus_Sup_distrib)
  qed
qed

lemma mm2_continous: "mm2 (Inf A) m = Inf ((\<lambda>x. mm2 x m) ` A)"
  using eo_plus_Sup_distrib GC
  using dual_order.trans order_mono_setup.refl
  sorry

interpretation ENOPT_PLUS:
 quant_sep_con_one Inf Sup inf "(\<le>)" "(<)" sup top bot "eo_plus" "mm2" "(Some 0)::(enat option)"
  unfolding quant_sep_con_def quant_sep_con_one_def comm_quantale_def apply safe
  subgoal by standard
  subgoal apply standard
    subgoal for a b c by (cases a; cases b; cases c) auto
    subgoal for a b by (cases a; cases b) auto
    subgoal for a apply(cases a) by auto
    done
  subgoal apply standard
    apply(subst eo_plus_Sup_distrib) by simp
  subgoal apply standard
    subgoal by auto
    subgoal  by(simp add: mm2_mono)
    subgoal by (simp add: mm2_antimono)
    subgoal apply(subst GC)  apply(subst eo_plus_comm) ..
    subgoal unfolding bot_option_def by simp
    done
  subgoal apply standard apply (auto simp: bot_option_def top_option_def top_enat_def)
    oops

end