(*
 * Copyright (C) 2014 NICTA
 * All rights reserved.
 *)

(* Author: David Cock - David.Cock@nicta.com.au *)

header {* The Loop Rules *}

theory Loops imports WellDefined begin

text_raw {* \label{s:loop_rules} *}

text {* Given a well-defined body, we can annotate a loop using an invariant, just as in the
classical setting. *}

subsection {* Liberal and Strict Invariants. *}

text {* A probabilistic invariant generalises a boolean one: it \emph{entails} itself, given
the loop guard. *}

definition
  wp_inv :: "('s \<Rightarrow> bool) \<Rightarrow> 's prog \<Rightarrow> ('s \<Rightarrow> real) \<Rightarrow> bool"
where
  "wp_inv G body I \<longleftrightarrow> (\<forall>s. \<guillemotleft>G\<guillemotright> s * I s \<le> wp body I s)"

lemma wp_invI:
  "\<And>I. (\<And>s. \<guillemotleft>G\<guillemotright> s * I s \<le> wp body I s) \<Longrightarrow> wp_inv G body I"
  by(simp add:wp_inv_def)

definition
  wlp_inv :: "('s \<Rightarrow> bool) \<Rightarrow> 's prog \<Rightarrow> ('s \<Rightarrow> real) \<Rightarrow> bool"
where
  "wlp_inv G body I \<longleftrightarrow> (\<forall>s. \<guillemotleft>G\<guillemotright> s * I s \<le> wlp body I s)"

lemma wlp_invI:
  "\<And>I. (\<And>s. \<guillemotleft>G\<guillemotright> s * I s \<le> wlp body I s) \<Longrightarrow> wlp_inv G body I"
  by(simp add:wlp_inv_def)

lemma wlp_invD:
  "wlp_inv G body I \<Longrightarrow> \<guillemotleft>G\<guillemotright> s * I s \<le> wlp body I s"
  by(simp add:wlp_inv_def)

text {* For standard invariants, the multiplication reduces to conjunction. *}
lemma wp_inv_stdD:
  assumes inv: "wp_inv G body \<guillemotleft>I\<guillemotright>"
  and     hb:  "healthy (wp body)"
  shows "\<guillemotleft>G\<guillemotright> && \<guillemotleft>I\<guillemotright> \<tturnstile> wp body \<guillemotleft>I\<guillemotright>"
proof(rule le_funI)
  fix s
  show "(\<guillemotleft>G\<guillemotright> && \<guillemotleft>I\<guillemotright>) s \<le> wp body \<guillemotleft>I\<guillemotright> s"
  proof(cases "G s")
    case False
    with hb show ?thesis
      by(auto simp:exp_conj_def)
  next
    case True
    hence "(\<guillemotleft>G\<guillemotright> && \<guillemotleft>I\<guillemotright>) s = \<guillemotleft>G\<guillemotright> s * \<guillemotleft>I\<guillemotright> s"
      by(simp add:exp_conj_def)
    also from inv have "\<guillemotleft>G\<guillemotright> s * \<guillemotleft>I\<guillemotright> s \<le> wp body \<guillemotleft>I\<guillemotright> s"
      by(simp add:wp_inv_def)
    finally show ?thesis .
  qed
qed

subsection {* Partial Correctness *}

text {* Partial correctness for loops\citep[Lemma 7.2.2, \S7, p.~185]{McIver_M_04}. *}
lemma wlp_Loop:
  assumes wd: "well_def body"
      and uI: "unitary I"
      and inv: "wlp_inv G body I"
  shows "I \<le> wlp do G \<longrightarrow> body od (\<lambda>s. \<guillemotleft>\<N> G\<guillemotright> s * I s)"
  (is "I \<le> wlp do G \<longrightarrow> body od ?P")
proof -
  let "?f Q s" = "\<guillemotleft>G\<guillemotright> s * wlp body Q s + \<guillemotleft>\<N> G\<guillemotright> s * ?P s"
  have "I \<tturnstile> gfp_exp ?f"
  proof(rule gfp_exp_upperbound[OF _ uI])
    have "I = (\<lambda>s. (\<guillemotleft>G\<guillemotright> s + \<guillemotleft>\<N> G\<guillemotright> s) * I s)" by(simp add:negate_embed)
    also have "... = (\<lambda>s. \<guillemotleft>G\<guillemotright> s * I s + \<guillemotleft>\<N> G\<guillemotright> s * I s)"
      by(simp add:algebra_simps)
    also have "... = (\<lambda>s. \<guillemotleft>G\<guillemotright> s * (\<guillemotleft>G\<guillemotright> s * I s) + \<guillemotleft>\<N> G\<guillemotright> s * (\<guillemotleft>\<N> G\<guillemotright> s * I s))"
      by(simp add:embed_bool_idem algebra_simps)
    also have "... \<tturnstile> (\<lambda>s. \<guillemotleft>G\<guillemotright> s * wlp body I s + \<guillemotleft>\<N> G\<guillemotright> s * (\<guillemotleft>\<N> G\<guillemotright> s * I s))"
      using inv by(auto dest:wlp_invD intro:add_mono mult_left_mono)
    finally show "I \<tturnstile> (\<lambda>s. \<guillemotleft>G\<guillemotright> s * wlp body I s + \<guillemotleft>\<N> G\<guillemotright> s * (\<guillemotleft>\<N> G\<guillemotright> s * I s))" .
  qed
  also from uI well_def_wlp_nearly_healthy[OF wd] have "... = wlp do G \<longrightarrow> body od ?P"
    by(auto intro!:wlp_Loop1[symmetric] unitary_intros)
  finally show ?thesis .
qed

subsection {* Total Correctness *}
text_raw {* \label{s:loop_total} *}

text {* The first total correctness lemma for loops which terminate with probability 1\citep[Lemma
7.3.1, \S7, p.~186]{McIver_M_04}. *}

lemma wp_Loop:
  assumes wd:   "well_def body"
      and inv:  "wlp_inv G body I"
      and unit: "unitary I"
  shows "I && wp (do G \<longrightarrow> body od) (\<lambda>s. 1) \<tturnstile> wp (do G \<longrightarrow> body od) (\<lambda>s. \<guillemotleft>\<N> G\<guillemotright> s * I s)"
    (is "I && ?T \<tturnstile> wp ?loop ?X")
proof -
  txt {* We first appeal to the \emph{liberal} loop rule: *}
  from assms have "I && ?T \<tturnstile> wlp ?loop ?X && ?T"
    by(blast intro:exp_conj_mono_left wlp_Loop)

  txt {* Next, by sub-conjunctivity: *}
  also {
    from wd have sdp_loop: "sub_distrib_pconj (do G \<longrightarrow> body od)"
      by(blast intro:sdp_intros)

    from wd unit have "wlp ?loop ?X && ?T \<tturnstile> wp ?loop (?X && (\<lambda>s. 1))"
      by(blast intro:sub_distrib_pconjD sdp_intros unitary_intros)
  }

  txt {* Finally, the conjunction collapses: *}
  finally show ?thesis
    by(simp add:exp_conj_1_right sound_intros sound_nneg unit unitary_sound)
qed

subsection {* Unfolding *}

lemma wp_loop_unfold:
  fixes body :: "'s prog"
  assumes sP: "sound P"
      and h: "healthy (wp body)"
  shows "wp (do G \<longrightarrow> body od) P =
   (\<lambda>s. \<guillemotleft>\<N> G\<guillemotright> s * P s + \<guillemotleft>G\<guillemotright> s * wp body (wp (do G \<longrightarrow> body od) P) s)"
  unfolding wp_eval
proof -
  let "?X t" = "wp (body ;; Embed t \<^bsub>\<guillemotleft> G \<guillemotright>\<^esub>\<oplus> Skip)"
  have "equiv_trans (lfp_trans ?X)
    (wp (body ;; Embed (lfp_trans ?X) \<^bsub>\<guillemotleft> G \<guillemotright>\<^esub>\<oplus> Skip))"
  proof(intro lfp_trans_unfold)
    fix t::"'s trans" and P::"'s expect"
    assume st: "\<And>Q. sound Q \<Longrightarrow> sound (t Q)"
       and sP: "sound P"
    with h show "sound (?X t P)"
      by(rule wp_loop_step_sound)
  next
    fix t u::"'s trans"
    assume "le_trans t u" "(\<And>P. sound P \<Longrightarrow> sound (t P))"
           "(\<And>P. sound P \<Longrightarrow> sound (u P))"
    with h show "le_trans (wp (body ;; Embed t \<^bsub>\<guillemotleft> G \<guillemotright>\<^esub>\<oplus> Skip))
                          (wp (body ;; Embed u \<^bsub>\<guillemotleft> G \<guillemotright>\<^esub>\<oplus> Skip))"
      by(iprover intro:wp_loop_step_mono)
  next
    let ?v = "\<lambda>P s. bound_of P"
    from h show "le_trans (wp (body ;; Embed ?v \<^bsub>\<guillemotleft> G \<guillemotright>\<^esub>\<oplus> Skip)) ?v"
      by(intro le_transI, simp add:wp_eval lfp_loop_fp[unfolded negate_embed])
    fix P::"'s expect"
    assume "sound P" thus "sound (?v P)" by(auto)
  qed
  also have "equiv_trans ...
    (\<lambda>P s. \<guillemotleft>\<N> G\<guillemotright> s * P s + \<guillemotleft>G\<guillemotright> s * wp body (wp (Embed (lfp_trans ?X)) P) s)"
    by(rule equiv_transI, simp add:wp_eval algebra_simps negate_embed)
  finally show "lfp_trans ?X P =
    (\<lambda>s. \<guillemotleft>\<N> G\<guillemotright> s * P s + \<guillemotleft>G\<guillemotright> s * wp body (lfp_trans ?X P) s)"
    using sP unfolding wp_eval by(blast)
qed

lemma wp_loop_nguard:
  "\<lbrakk> healthy (wp body); sound P; \<not> G s \<rbrakk> \<Longrightarrow> wp do G \<longrightarrow> body od P s = P s"
  by(subst wp_loop_unfold, simp_all)

lemma wp_loop_guard:
  "\<lbrakk> healthy (wp body); sound P; G s \<rbrakk> \<Longrightarrow>
   wp do G \<longrightarrow> body od P s = wp (body ;; do G \<longrightarrow> body od) P s"
  by(subst wp_loop_unfold, simp_all add:wp_eval)

end


theory flash47Bra  imports flash47Rev

  begin
lemma onInv47:

   assumes

     b1:"r \<in> rules N" and b2:"invf=inv47 "
   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 (inv47 ) (NI_Local_GetX_PutX1 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX1VsInv47 )
          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 (inv47 ) (NI_Local_GetX_GetX  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_GetXVsInv47 )
          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 (inv47 ) (NI_Replace  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_ReplaceVsInv47 )
          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 (inv47 ) (NI_ShWb N ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_ShWbVsInv47 )
          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 (inv47 ) (PI_Local_GetX_GetX2 ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_GetX2VsInv47 )
          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 (inv47 ) (NI_Local_PutXAcksDone ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_Local_PutXAcksDoneVsInv47 )
          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 (inv47 ) (NI_Local_GetX_PutX7 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX7VsInv47 )
          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 (inv47 ) (NI_Local_Get_Nak2  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Nak2VsInv47 )
          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 (inv47 ) (NI_ReplaceHomeShrVld ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_ReplaceHomeShrVldVsInv47 )
          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 (inv47 ) (NI_Remote_Put  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_PutVsInv47 )
          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 (inv47 ) (NI_Local_GetX_PutX5 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX5VsInv47 )
          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 (inv47 ) (NI_Wb ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_WbVsInv47 )
          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 (inv47 ) (NI_Local_Get_Get  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_GetVsInv47 )
          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 (inv47 ) (PI_Local_Replace ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_ReplaceVsInv47 )
          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 (inv47 ) (NI_ReplaceShrVld  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_ReplaceShrVldVsInv47 )
          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 (inv47 ) (NI_Local_GetX_PutX8 N  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX8VsInv47 )
          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 (inv47 ) (NI_InvAck_2 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_InvAck_2VsInv47 )
          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 (inv47 ) (NI_Remote_Get_Nak2  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_Get_Nak2VsInv47 )
          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 (inv47 ) (PI_Remote_Replace  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis PI_Remote_ReplaceVsInv47 )
          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 (inv47 ) (NI_Nak_Home ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_Nak_HomeVsInv47 )
          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 (inv47 ) (NI_Local_Get_Put2  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Put2VsInv47 )
          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 (inv47 ) (NI_InvAck_1  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_InvAck_1VsInv47 )
          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 (inv47 ) (NI_Local_GetX_PutX11 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX11VsInv47 )
          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 (inv47 ) (NI_Local_GetX_PutX6 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX6VsInv47 )
          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 (inv47 ) (NI_Remote_Get_Put2  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_Get_Put2VsInv47 )
          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 (inv47 ) (PI_Local_Get_Put ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_Get_PutVsInv47 )
          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 (inv47 ) (PI_Local_GetX_PutX1 N ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_PutX1VsInv47 )
          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 (inv47 ) (NI_InvAck_1_Home  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_InvAck_1_HomeVsInv47 )
          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 (inv47 ) (NI_Remote_Get_Nak1  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_Get_Nak1VsInv47 )
          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 (inv47 ) (NI_Local_Get_Nak1  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Nak1VsInv47 )
          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 (inv47 ) (NI_Local_GetX_Nak2  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_Nak2VsInv47 )
          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 (inv47 ) (NI_Local_GetX_PutX10_home N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX10_homeVsInv47 )
          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 (inv47 ) (PI_Remote_Get  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis PI_Remote_GetVsInv47 )
          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 (inv47 ) (NI_Local_GetX_Nak3  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_Nak3VsInv47 )
          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 (inv47 ) (NI_Local_GetX_PutX10 N  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX10VsInv47 )
          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 (inv47 ) (NI_Local_GetX_PutX2 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX2VsInv47 )
          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 (inv47 ) (NI_Remote_Get_Put1  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_Get_Put1VsInv47 )
          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 (inv47 ) (NI_Remote_PutX  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_PutXVsInv47 )
          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 (inv47 ) (Store  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis StoreVsInv47 )
          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 (inv47 ) (NI_FAck ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_FAckVsInv47 )
          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 (inv47 ) (NI_Local_GetX_PutX3 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX3VsInv47 )
          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 (inv47 ) (PI_Local_GetX_PutX3 ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_PutX3VsInv47 )
          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 (inv47 ) (NI_Remote_GetX_PutX  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_GetX_PutXVsInv47 )
          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 (inv47 ) (NI_Local_GetX_PutX8_home N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX8_homeVsInv47 )
          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 (inv47 ) (NI_Local_Get_Put1 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Put1VsInv47 )
          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 (inv47 ) (PI_Local_GetX_GetX1 ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_GetX1VsInv47 )
          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 (inv47 ) (StoreHome ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis StoreHomeVsInv47 )
          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 (inv47 ) (NI_Remote_GetX_Nak  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_GetX_NakVsInv47 )
          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 (inv47 ) (NI_Inv  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_InvVsInv47 )
          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 (inv47 ) (PI_Remote_PutX  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis PI_Remote_PutXVsInv47 )
          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 (inv47 ) (PI_Local_GetX_PutX4 ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_PutX4VsInv47 )
          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 (inv47 ) (NI_Local_GetX_PutX4 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX4VsInv47 )
          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 (inv47 ) (NI_Nak  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_NakVsInv47 )
          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 (inv47 ) (PI_Local_GetX_PutX2 N ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_GetX_PutX2VsInv47 )
          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 (inv47 ) (NI_Local_Put ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_Local_PutVsInv47 )
          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 (inv47 ) (NI_Local_GetX_Nak1  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_Nak1VsInv47 )
          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 (inv47 ) (NI_Nak_Clear ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_Nak_ClearVsInv47 )
          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 (inv47 ) (PI_Local_PutX ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_PutXVsInv47 )
          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 (inv47 ) (NI_Local_Get_Nak3  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Nak3VsInv47 )
          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 (inv47 ) (NI_Remote_GetX_Nak_Home  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_GetX_Nak_HomeVsInv47 )
          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 (inv47 ) (PI_Local_Get_Get ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis PI_Local_Get_GetVsInv47 )
          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 (inv47 ) (NI_Local_GetX_PutX9 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_GetX_PutX9VsInv47 )
          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 (inv47 ) (PI_Remote_GetX  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis PI_Remote_GetXVsInv47 )
          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 (inv47 ) (NI_ReplaceHome ) (invariants N) "
            apply(cut_tac    b2 c2 )
            by (metis NI_ReplaceHomeVsInv47 )
          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 (inv47 ) (NI_Remote_GetX_PutX_Home  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Remote_GetX_PutX_HomeVsInv47 )
          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 (inv47 ) (NI_Local_Get_Put3  iRule1 ) (invariants N) "
            apply(cut_tac  c2  )
            by (metis NI_Local_Get_Put3VsInv47 )
          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


(*  Title:      HOL/Auth/CertifiedEmail.thy
    Author:     Giampaolo Bella, Christiano Longo and Lawrence C Paulson
*)

section\<open>The Certified Electronic Mail Protocol by Abadi et al.\<close>

theory CertifiedEmail imports Public begin

abbreviation
  TTP :: agent where
  "TTP == Server"

abbreviation
  RPwd :: "agent \<Rightarrow> key" where
  "RPwd == shrK"

(*FIXME: the four options should be represented by pairs of 0 or 1.
  Right now only BothAuth is modelled.*)
consts
  NoAuth   :: nat
  TTPAuth  :: nat
  SAuth    :: nat
  BothAuth :: nat

text\<open>We formalize a fixed way of computing responses.  Could be better.\<close>
definition "response" :: "agent \<Rightarrow> agent \<Rightarrow> nat \<Rightarrow> msg" where
   "response S R q == Hash \<lbrace>Agent S, Key (shrK R), Nonce q\<rbrace>"

inductive_set certified_mail :: "event list set"
  where

  Nil: \<comment> \<open>The empty trace\<close>
     "[] \<in> certified_mail"

| Fake: \<comment> \<open>The Spy may say anything he can say.  The sender field is correct,
          but agents don't use that information.\<close>
      "[| evsf \<in> certified_mail; X \<in> synth(analz(spies evsf))|]
       ==> Says Spy B X # evsf \<in> certified_mail"

| FakeSSL: \<comment> \<open>The Spy may open SSL sessions with TTP, who is the only agent
    equipped with the necessary credentials to serve as an SSL server.\<close>
         "[| evsfssl \<in> certified_mail; X \<in> synth(analz(spies evsfssl))|]
          ==> Notes TTP \<lbrace>Agent Spy, Agent TTP, X\<rbrace> # evsfssl \<in> certified_mail"

| CM1: \<comment> \<open>The sender approaches the recipient.  The message is a number.\<close>
 "[|evs1 \<in> certified_mail;
    Key K \<notin> used evs1;
    K \<in> symKeys;
    Nonce q \<notin> used evs1;
    hs = Hash\<lbrace>Number cleartext, Nonce q, response S R q, Crypt K (Number m)\<rbrace>;
    S2TTP = Crypt(pubEK TTP) \<lbrace>Agent S, Number BothAuth, Key K, Agent R, hs\<rbrace>|]
  ==> Says S R \<lbrace>Agent S, Agent TTP, Crypt K (Number m), Number BothAuth,
                 Number cleartext, Nonce q, S2TTP\<rbrace> # evs1
        \<in> certified_mail"

| CM2: \<comment> \<open>The recipient records \<^term>\<open>S2TTP\<close> while transmitting it and her
     password to \<^term>\<open>TTP\<close> over an SSL channel.\<close>
 "[|evs2 \<in> certified_mail;
    Gets R \<lbrace>Agent S, Agent TTP, em, Number BothAuth, Number cleartext,
             Nonce q, S2TTP\<rbrace> \<in> set evs2;
    TTP \<noteq> R;
    hr = Hash \<lbrace>Number cleartext, Nonce q, response S R q, em\<rbrace> |]
  ==>
   Notes TTP \<lbrace>Agent R, Agent TTP, S2TTP, Key(RPwd R), hr\<rbrace> # evs2
      \<in> certified_mail"

| CM3: \<comment> \<open>\<^term>\<open>TTP\<close> simultaneously reveals the key to the recipient and gives
         a receipt to the sender.  The SSL channel does not authenticate
         the client (\<^term>\<open>R\<close>), but \<^term>\<open>TTP\<close> accepts the message only
         if the given password is that of the claimed sender, \<^term>\<open>R\<close>.
         He replies over the established SSL channel.\<close>
 "[|evs3 \<in> certified_mail;
    Notes TTP \<lbrace>Agent R, Agent TTP, S2TTP, Key(RPwd R), hr\<rbrace> \<in> set evs3;
    S2TTP = Crypt (pubEK TTP)
                     \<lbrace>Agent S, Number BothAuth, Key k, Agent R, hs\<rbrace>;
    TTP \<noteq> R;  hs = hr;  k \<in> symKeys|]
  ==>
   Notes R \<lbrace>Agent TTP, Agent R, Key k, hr\<rbrace> #
   Gets S (Crypt (priSK TTP) S2TTP) #
   Says TTP S (Crypt (priSK TTP) S2TTP) # evs3 \<in> certified_mail"

| Reception:
 "[|evsr \<in> certified_mail; Says A B X \<in> set evsr|]
  ==> Gets B X#evsr \<in> certified_mail"

declare Says_imp_knows_Spy [THEN analz.Inj, dest]
declare analz_into_parts [dest]

(*A "possibility property": there are traces that reach the end*)
lemma "[| Key K \<notin> used []; K \<in> symKeys |] ==>
       \<exists>S2TTP. \<exists>evs \<in> certified_mail.
           Says TTP S (Crypt (priSK TTP) S2TTP) \<in> set evs"
apply (intro exI bexI)
apply (rule_tac [2] certified_mail.Nil
                    [THEN certified_mail.CM1, THEN certified_mail.Reception,
                     THEN certified_mail.CM2,
                     THEN certified_mail.CM3])
apply (possibility, auto)
done

lemma Gets_imp_Says:
 "[| Gets B X \<in> set evs; evs \<in> certified_mail |] ==> \<exists>A. Says A B X \<in> set evs"
apply (erule rev_mp)
apply (erule certified_mail.induct, auto)
done

lemma Gets_imp_parts_knows_Spy:
     "[|Gets A X \<in> set evs; evs \<in> certified_mail|] ==> X \<in> parts(spies evs)"
apply (drule Gets_imp_Says, simp)
apply (blast dest: Says_imp_knows_Spy parts.Inj)
done

lemma CM2_S2TTP_analz_knows_Spy:
 "[|Gets R \<lbrace>Agent A, Agent B, em, Number AO, Number cleartext,
              Nonce q, S2TTP\<rbrace> \<in> set evs;
    evs \<in> certified_mail|]
  ==> S2TTP \<in> analz(spies evs)"
apply (drule Gets_imp_Says, simp)
apply (blast dest: Says_imp_knows_Spy analz.Inj)
done

lemmas CM2_S2TTP_parts_knows_Spy =
    CM2_S2TTP_analz_knows_Spy [THEN analz_subset_parts [THEN subsetD]]

lemma hr_form_lemma [rule_format]:
 "evs \<in> certified_mail
  \<Longrightarrow> hr \<notin> synth (analz (spies evs)) \<longrightarrow>
      (\<forall>S2TTP. Notes TTP \<lbrace>Agent R, Agent TTP, S2TTP, pwd, hr\<rbrace>
          \<in> set evs \<longrightarrow>
      (\<exists>clt q S em. hr = Hash \<lbrace>Number clt, Nonce q, response S R q, em\<rbrace>))"
apply (erule certified_mail.induct)
apply (synth_analz_mono_contra, simp_all, blast+)
done

text\<open>Cannot strengthen the first disjunct to \<^term>\<open>R\<noteq>Spy\<close> because
the fakessl rule allows Spy to spoof the sender's name.  Maybe can
strengthen the second disjunct with \<^term>\<open>R\<noteq>Spy\<close>.\<close>
lemma hr_form:
 "[|Notes TTP \<lbrace>Agent R, Agent TTP, S2TTP, pwd, hr\<rbrace> \<in> set evs;
    evs \<in> certified_mail|]
  ==> hr \<in> synth (analz (spies evs)) |
      (\<exists>clt q S em. hr = Hash \<lbrace>Number clt, Nonce q, response S R q, em\<rbrace>)"
by (blast intro: hr_form_lemma)

lemma Spy_dont_know_private_keys [dest!]:
    "[|Key (privateKey b A) \<in> parts (spies evs); evs \<in> certified_mail|]
     ==> A \<in> bad"
apply (erule rev_mp)
apply (erule certified_mail.induct, simp_all)
txt\<open>Fake\<close>
apply (blast dest: Fake_parts_insert_in_Un)
txt\<open>Message 1\<close>
apply blast
txt\<open>Message 3\<close>
apply (frule_tac hr_form, assumption)
apply (elim disjE exE)
apply (simp_all add: parts_insert2)
 apply (force dest!: parts_insert_subset_Un [THEN [2] rev_subsetD]
                     analz_subset_parts [THEN subsetD], blast)
done

lemma Spy_know_private_keys_iff [simp]:
    "evs \<in> certified_mail
     ==> (Key (privateKey b A) \<in> parts (spies evs)) = (A \<in> bad)"
by blast

lemma Spy_dont_know_TTPKey_parts [simp]:
     "evs \<in> certified_mail ==> Key (privateKey b TTP) \<notin> parts(spies evs)"
by simp

lemma Spy_dont_know_TTPKey_analz [simp]:
     "evs \<in> certified_mail ==> Key (privateKey b TTP) \<notin> analz(spies evs)"
by auto

text\<open>Thus, prove any goal that assumes that \<^term>\<open>Spy\<close> knows a private key
belonging to \<^term>\<open>TTP\<close>\<close>
declare Spy_dont_know_TTPKey_parts [THEN [2] rev_notE, elim!]

lemma CM3_k_parts_knows_Spy:
 "[| evs \<in> certified_mail;
     Notes TTP \<lbrace>Agent A, Agent TTP,
                 Crypt (pubEK TTP) \<lbrace>Agent S, Number AO, Key K,
                 Agent R, hs\<rbrace>, Key (RPwd R), hs\<rbrace> \<in> set evs|]
  ==> Key K \<in> parts(spies evs)"
apply (rotate_tac 1)
apply (erule rev_mp)
apply (erule certified_mail.induct, simp_all)
   apply (blast  intro:parts_insertI)
txt\<open>Fake SSL\<close>
apply (blast dest: parts.Body)
txt\<open>Message 2\<close>
apply (blast dest!: Gets_imp_Says elim!: knows_Spy_partsEs)
txt\<open>Message 3\<close>
apply (metis parts_insertI)
done

lemma Spy_dont_know_RPwd [rule_format]:
    "evs \<in> certified_mail ==> Key (RPwd A) \<in> parts(spies evs) \<longrightarrow> A \<in> bad"
apply (erule certified_mail.induct, simp_all)
txt\<open>Fake\<close>
apply (blast dest: Fake_parts_insert_in_Un)
txt\<open>Message 1\<close>
apply blast
txt\<open>Message 3\<close>
apply (frule CM3_k_parts_knows_Spy, assumption)
apply (frule_tac hr_form, assumption)
apply (elim disjE exE)
apply (simp_all add: parts_insert2)
apply (force dest!: parts_insert_subset_Un [THEN [2] rev_subsetD]
                    analz_subset_parts [THEN subsetD])
done

lemma Spy_know_RPwd_iff [simp]:
    "evs \<in> certified_mail ==> (Key (RPwd A) \<in> parts(spies evs)) = (A\<in>bad)"
by (auto simp add: Spy_dont_know_RPwd)

lemma Spy_analz_RPwd_iff [simp]:
    "evs \<in> certified_mail ==> (Key (RPwd A) \<in> analz(spies evs)) = (A\<in>bad)"
by (metis Spy_know_RPwd_iff Spy_spies_bad_shrK analz.Inj analz_into_parts)

text\<open>Unused, but a guarantee of sorts\<close>
theorem CertAutenticity:
     "[|Crypt (priSK TTP) X \<in> parts (spies evs); evs \<in> certified_mail|]
      ==> \<exists>A. Says TTP A (Crypt (priSK TTP) X) \<in> set evs"
apply (erule rev_mp)
apply (erule certified_mail.induct, simp_all)
txt\<open>Fake\<close>
apply (blast dest: Spy_dont_know_private_keys Fake_parts_insert_in_Un)
txt\<open>Message 1\<close>
apply blast
txt\<open>Message 3\<close>
apply (frule_tac hr_form, assumption)
apply (elim disjE exE)
apply (simp_all add: parts_insert2 parts_insert_knows_A)
 apply (blast dest!: Fake_parts_sing_imp_Un, blast)
done

subsection\<open>Proving Confidentiality Results\<close>

lemma analz_image_freshK [rule_format]:
 "evs \<in> certified_mail ==>
   \<forall>K KK. invKey (pubEK TTP) \<notin> KK \<longrightarrow>
          (Key K \<in> analz (Key`KK \<union> (spies evs))) =
          (K \<in> KK | Key K \<in> analz (spies evs))"
apply (erule certified_mail.induct)
apply (drule_tac [6] A=TTP in symKey_neq_priEK)
apply (erule_tac [6] disjE [OF hr_form])
apply (drule_tac [5] CM2_S2TTP_analz_knows_Spy)
prefer 9
apply (elim exE)
apply (simp_all add: synth_analz_insert_eq
                     subset_trans [OF _ subset_insertI]
                     subset_trans [OF _ Un_upper2]
                del: image_insert image_Un add: analz_image_freshK_simps)
done

lemma analz_insert_freshK:
  "[| evs \<in> certified_mail;  KAB \<noteq> invKey (pubEK TTP) |] ==>
      (Key K \<in> analz (insert (Key KAB) (spies evs))) =
      (K = KAB | Key K \<in> analz (spies evs))"
by (simp only: analz_image_freshK analz_image_freshK_simps)

text\<open>\<^term>\<open>S2TTP\<close> must have originated from a valid sender
    provided \<^term>\<open>K\<close> is secure.  Proof is surprisingly hard.\<close>

lemma Notes_SSL_imp_used:
     "[|Notes B \<lbrace>Agent A, Agent B, X\<rbrace> \<in> set evs|] ==> X \<in> used evs"
by (blast dest!: Notes_imp_used)

(*The weaker version, replacing "used evs" by "parts (spies evs)",
   isn't inductive: message 3 case can't be proved *)
lemma S2TTP_sender_lemma [rule_format]:
 "evs \<in> certified_mail ==>
    Key K \<notin> analz (spies evs) \<longrightarrow>
    (\<forall>AO. Crypt (pubEK TTP)
           \<lbrace>Agent S, Number AO, Key K, Agent R, hs\<rbrace> \<in> used evs \<longrightarrow>
    (\<exists>m ctxt q.
        hs = Hash\<lbrace>Number ctxt, Nonce q, response S R q, Crypt K (Number m)\<rbrace> \<and>
        Says S R
           \<lbrace>Agent S, Agent TTP, Crypt K (Number m), Number AO,
             Number ctxt, Nonce q,
             Crypt (pubEK TTP)
              \<lbrace>Agent S, Number AO, Key K, Agent R, hs \<rbrace>\<rbrace> \<in> set evs))"
apply (erule certified_mail.induct, analz_mono_contra)
apply (drule_tac [5] CM2_S2TTP_parts_knows_Spy, simp)
apply (simp add: used_Nil Crypt_notin_initState, simp_all)
txt\<open>Fake\<close>
apply (blast dest: Fake_parts_sing [THEN subsetD]
             dest!: analz_subset_parts [THEN subsetD])
txt\<open>Fake SSL\<close>
apply (blast dest: Fake_parts_sing [THEN subsetD]
             dest: analz_subset_parts [THEN subsetD])
txt\<open>Message 1\<close>
apply (clarsimp, blast)
txt\<open>Message 2\<close>
apply (simp add: parts_insert2, clarify)
apply (metis parts_cut Un_empty_left usedI)
txt\<open>Message 3\<close>
apply (blast dest: Notes_SSL_imp_used used_parts_subset_parts)
done

lemma S2TTP_sender:
 "[|Crypt (pubEK TTP) \<lbrace>Agent S, Number AO, Key K, Agent R, hs\<rbrace> \<in> used evs;
    Key K \<notin> analz (spies evs);
    evs \<in> certified_mail|]
  ==> \<exists>m ctxt q.
        hs = Hash\<lbrace>Number ctxt, Nonce q, response S R q, Crypt K (Number m)\<rbrace> \<and>
        Says S R
           \<lbrace>Agent S, Agent TTP, Crypt K (Number m), Number AO,
             Number ctxt, Nonce q,
             Crypt (pubEK TTP)
              \<lbrace>Agent S, Number AO, Key K, Agent R, hs\<rbrace>\<rbrace> \<in> set evs"
by (blast intro: S2TTP_sender_lemma)

text\<open>Nobody can have used non-existent keys!\<close>
lemma new_keys_not_used [simp]:
    "[|Key K \<notin> used evs; K \<in> symKeys; evs \<in> certified_mail|]
     ==> K \<notin> keysFor (parts (spies evs))"
apply (erule rev_mp)
apply (erule certified_mail.induct, simp_all)
txt\<open>Fake\<close>
apply (force dest!: keysFor_parts_insert)
txt\<open>Message 1\<close>
apply blast
txt\<open>Message 3\<close>
apply (frule CM3_k_parts_knows_Spy, assumption)
apply (frule_tac hr_form, assumption)
apply (force dest!: keysFor_parts_insert)
done

text\<open>Less easy to prove \<^term>\<open>m'=m\<close>.  Maybe needs a separate unicity
theorem for ciphertexts of the form \<^term>\<open>Crypt K (Number m)\<close>,
where \<^term>\<open>K\<close> is secure.\<close>
lemma Key_unique_lemma [rule_format]:
     "evs \<in> certified_mail ==>
       Key K \<notin> analz (spies evs) \<longrightarrow>
       (\<forall>m cleartext q hs.
        Says S R
           \<lbrace>Agent S, Agent TTP, Crypt K (Number m), Number AO,
             Number cleartext, Nonce q,
             Crypt (pubEK TTP) \<lbrace>Agent S, Number AO, Key K, Agent R, hs\<rbrace>\<rbrace>
          \<in> set evs \<longrightarrow>
       (\<forall>m' cleartext' q' hs'.
       Says S' R'
           \<lbrace>Agent S', Agent TTP, Crypt K (Number m'), Number AO',
             Number cleartext', Nonce q',
             Crypt (pubEK TTP) \<lbrace>Agent S', Number AO', Key K, Agent R', hs'\<rbrace>\<rbrace>
          \<in> set evs \<longrightarrow> R' = R \<and> S' = S \<and> AO' = AO \<and> hs' = hs))"
apply (erule certified_mail.induct, analz_mono_contra, simp_all)
 prefer 2
 txt\<open>Message 1\<close>
 apply (blast dest!: Says_imp_knows_Spy [THEN parts.Inj] new_keys_not_used Crypt_imp_keysFor)
txt\<open>Fake\<close>
apply (auto dest!: usedI S2TTP_sender analz_subset_parts [THEN subsetD])
done

text\<open>The key determines the sender, recipient and protocol options.\<close>
lemma Key_unique:
      "[|Says S R
           \<lbrace>Agent S, Agent TTP, Crypt K (Number m), Number AO,
             Number cleartext, Nonce q,
             Crypt (pubEK TTP) \<lbrace>Agent S, Number AO, Key K, Agent R, hs\<rbrace>\<rbrace>
          \<in> set evs;
         Says S' R'
           \<lbrace>Agent S', Agent TTP, Crypt K (Number m'), Number AO',
             Number cleartext', Nonce q',
             Crypt (pubEK TTP) \<lbrace>Agent S', Number AO', Key K, Agent R', hs'\<rbrace>\<rbrace>
          \<in> set evs;
         Key K \<notin> analz (spies evs);
         evs \<in> certified_mail|]
       ==> R' = R \<and> S' = S \<and> AO' = AO \<and> hs' = hs"
by (rule Key_unique_lemma, assumption+)

subsection\<open>The Guarantees for Sender and Recipient\<close>

text\<open>A Sender's guarantee:
      If Spy gets the key then \<^term>\<open>R\<close> is bad and \<^term>\<open>S\<close> moreover
      gets his return receipt (and therefore has no grounds for complaint).\<close>
theorem S_fairness_bad_R:
      "[|Says S R \<lbrace>Agent S, Agent TTP, Crypt K (Number m), Number AO,
                     Number cleartext, Nonce q, S2TTP\<rbrace> \<in> set evs;
         S2TTP = Crypt (pubEK TTP) \<lbrace>Agent S, Number AO, Key K, Agent R, hs\<rbrace>;
         Key K \<in> analz (spies evs);
         evs \<in> certified_mail;
         S\<noteq>Spy|]
      ==> R \<in> bad \<and> Gets S (Crypt (priSK TTP) S2TTP) \<in> set evs"
apply (erule rev_mp)
apply (erule ssubst)
apply (erule rev_mp)
apply (erule certified_mail.induct, simp_all)
txt\<open>Fake\<close>
apply spy_analz
txt\<open>Fake SSL\<close>
apply spy_analz
txt\<open>Message 3\<close>
apply (frule_tac hr_form, assumption)
apply (elim disjE exE)
apply (simp_all add: synth_analz_insert_eq
                     subset_trans [OF _ subset_insertI]
                     subset_trans [OF _ Un_upper2]
                del: image_insert image_Un add: analz_image_freshK_simps)
apply (simp_all add: symKey_neq_priEK analz_insert_freshK)
apply (blast dest: Notes_SSL_imp_used S2TTP_sender Key_unique)+
done

text\<open>Confidentially for the symmetric key\<close>
theorem Spy_not_see_encrypted_key:
      "[|Says S R \<lbrace>Agent S, Agent TTP, Crypt K (Number m), Number AO,
                     Number cleartext, Nonce q, S2TTP\<rbrace> \<in> set evs;
         S2TTP = Crypt (pubEK TTP) \<lbrace>Agent S, Number AO, Key K, Agent R, hs\<rbrace>;
         evs \<in> certified_mail;
         S\<noteq>Spy; R \<notin> bad|]
      ==> Key K \<notin> analz(spies evs)"
by (blast dest: S_fairness_bad_R)

text\<open>Agent \<^term>\<open>R\<close>, who may be the Spy, doesn't receive the key
 until \<^term>\<open>S\<close> has access to the return receipt.\<close>
theorem S_guarantee:
     "[|Says S R \<lbrace>Agent S, Agent TTP, Crypt K (Number m), Number AO,
                    Number cleartext, Nonce q, S2TTP\<rbrace> \<in> set evs;
        S2TTP = Crypt (pubEK TTP) \<lbrace>Agent S, Number AO, Key K, Agent R, hs\<rbrace>;
        Notes R \<lbrace>Agent TTP, Agent R, Key K, hs\<rbrace> \<in> set evs;
        S\<noteq>Spy;  evs \<in> certified_mail|]
     ==> Gets S (Crypt (priSK TTP) S2TTP) \<in> set evs"
apply (erule rev_mp)
apply (erule ssubst)
apply (erule rev_mp)
apply (erule certified_mail.induct, simp_all)
txt\<open>Message 1\<close>
apply (blast dest: Notes_imp_used)
txt\<open>Message 3\<close>
apply (blast dest: Notes_SSL_imp_used S2TTP_sender Key_unique S_fairness_bad_R)
done

text\<open>If \<^term>\<open>R\<close> sends message 2, and a delivery certificate exists,
 then \<^term>\<open>R\<close> receives the necessary key.  This result is also important
 to \<^term>\<open>S\<close>, as it confirms the validity of the return receipt.\<close>
theorem RR_validity:
  "[|Crypt (priSK TTP) S2TTP \<in> used evs;
     S2TTP = Crypt (pubEK TTP)
               \<lbrace>Agent S, Number AO, Key K, Agent R,
                 Hash \<lbrace>Number cleartext, Nonce q, r, em\<rbrace>\<rbrace>;
     hr = Hash \<lbrace>Number cleartext, Nonce q, r, em\<rbrace>;
     R\<noteq>Spy;  evs \<in> certified_mail|]
  ==> Notes R \<lbrace>Agent TTP, Agent R, Key K, hr\<rbrace> \<in> set evs"
apply (erule rev_mp)
apply (erule ssubst)
apply (erule ssubst)
apply (erule certified_mail.induct, simp_all)
txt\<open>Fake\<close>
apply (blast dest: Fake_parts_sing [THEN subsetD]
             dest!: analz_subset_parts [THEN subsetD])
txt\<open>Fake SSL\<close>
apply (blast dest: Fake_parts_sing [THEN subsetD]
            dest!: analz_subset_parts [THEN subsetD])
txt\<open>Message 2\<close>
apply (drule CM2_S2TTP_parts_knows_Spy, assumption)
apply (force dest: parts_cut)
txt\<open>Message 3\<close>
apply (frule_tac hr_form, assumption)
apply (elim disjE exE, simp_all)
apply (blast dest: Fake_parts_sing [THEN subsetD]
             dest!: analz_subset_parts [THEN subsetD])
done

end


theory Let
imports "../Nominal2"
begin

atom_decl name

nominal_datatype trm =
  Var "name"
| App "trm" "trm"
| Lam x::"name" t::"trm"  binds  x in t
| Let as::"assn" t::"trm"   binds "bn as" in t
and assn =
  ANil
| ACons "name" "trm" "assn"
binder
  bn
where
  "bn ANil = []"
| "bn (ACons x t as) = (atom x) # (bn as)"

lemma alpha_bn_inducts_raw:
  "\<lbrakk>alpha_bn_raw a b; P3 ANil_raw ANil_raw;
 \<And>trm_raw trm_rawa assn_raw assn_rawa name namea.
    \<lbrakk>alpha_trm_raw trm_raw trm_rawa; alpha_bn_raw assn_raw assn_rawa;
     P3 assn_raw assn_rawa\<rbrakk>
    \<Longrightarrow> P3 (ACons_raw name trm_raw assn_raw)
        (ACons_raw namea trm_rawa assn_rawa)\<rbrakk> \<Longrightarrow> P3 a b"
  by (erule alpha_trm_raw_alpha_assn_raw_alpha_bn_raw.inducts(3)[of _ _ "\<lambda>x y. True" _ "\<lambda>x y. True", simplified]) auto

lemmas alpha_bn_inducts = alpha_bn_inducts_raw[quot_lifted]

lemma alpha_bn_refl: "alpha_bn x x"
  by (induct x rule: trm_assn.inducts(2))
     (rule TrueI, auto simp add: trm_assn.eq_iff)

lemma max_eqvt[eqvt]: "p \<bullet> (max (a :: _ :: pure) b) = max (p \<bullet> a) (p \<bullet> b)"
  by (simp add: permute_pure)

lemma what_we_would_like:
  assumes a: "alpha_bn as asa"
  shows "\<forall>p. set (bn as) \<sharp>* fv_bn as \<and> set (bn asa) \<sharp>* fv_bn asa \<and>
   p \<bullet> bn as = bn asa \<and> supp p \<subseteq> set (bn as) \<union> set (bn asa) \<longrightarrow> p \<bullet> as = asa"
  apply (rule alpha_bn_inducts[OF a])
  apply
 (simp_all add: trm_assn.bn_defs trm_assn.perm_bn_simps trm_assn.supp)
 apply clarify
 apply simp
 apply (simp add: atom_eqvt)
 apply (case_tac "name = namea")
 sorry

lemma Abs_lst_fcb2:
  fixes as bs :: "'a :: fs"
    and x y :: "'b :: fs"
    and c::"'c::fs"
  assumes eq: "[ba as]lst. x = [ba bs]lst. y"
  and fcb1: "set (ba as) \<sharp>* f as x c"
  and fresh1: "set (ba as) \<sharp>* c"
  and fresh2: "set (ba bs) \<sharp>* c"
  and perm1: "\<And>p. supp p \<sharp>* c \<Longrightarrow> p \<bullet> (f as x c) = f (p \<bullet> as) (p \<bullet> x) c"
  and perm2: "\<And>p. supp p \<sharp>* c \<Longrightarrow> p \<bullet> (f bs y c) = f (p \<bullet> bs) (p \<bullet> y) c"
  and ba_inj: "\<And>q r. q \<bullet> ba as = r \<bullet> ba bs \<Longrightarrow> q \<bullet> as = r \<bullet> bs"
  shows "f as x c = f bs y c"
sorry

nominal_function
    height_trm :: "trm \<Rightarrow> nat"
and height_assn :: "assn \<Rightarrow> nat"
where
  "height_trm (Var x) = 1"
| "height_trm (App l r) = max (height_trm l) (height_trm r)"
| "height_trm (Lam v b) = 1 + (height_trm b)"
| "set (bn as) \<sharp>* fv_bn as \<Longrightarrow> height_trm (Let as b) = max (height_assn as) (height_trm b)"
| "height_assn ANil = 0"
| "height_assn (ACons v t as) = max (height_trm t) (height_assn as)"
  apply (simp only: eqvt_def height_trm_height_assn_graph_def)
  apply (rule, perm_simp, rule, rule TrueI)
  apply (case_tac x)
  apply (rule_tac y="a" in trm_assn.strong_exhaust(1))
  apply (auto)[4]
  apply (drule_tac x="assn" in meta_spec)
  apply (drule_tac x="trm" in meta_spec)
  apply (simp add: alpha_bn_refl)
--"HERE"
  defer
  apply (case_tac b rule: trm_assn.exhaust(2))
  apply (auto)[2]
  apply(simp_all)
  apply (erule_tac c="()" in Abs_lst_fcb2)
  apply (simp_all add: pure_fresh fresh_star_def)[3]
  apply (simp add: eqvt_at_def)
  apply (simp add: eqvt_at_def)
  apply assumption
  apply(erule conjE)
  apply (simp add: meta_eq_to_obj_eq[OF height_trm_def, symmetric, unfolded fun_eq_iff])
  apply (simp add: meta_eq_to_obj_eq[OF height_assn_def, symmetric, unfolded fun_eq_iff])
  apply (subgoal_tac "eqvt_at height_assn as")
  apply (subgoal_tac "eqvt_at height_assn asa")
  apply (subgoal_tac "eqvt_at height_trm b")
  apply (subgoal_tac "eqvt_at height_trm ba")
  apply (thin_tac "eqvt_at height_trm_height_assn_sumC (Inr as)")
  apply (thin_tac "eqvt_at height_trm_height_assn_sumC (Inr asa)")
  apply (thin_tac "eqvt_at height_trm_height_assn_sumC (Inl b)")
  apply (thin_tac "eqvt_at height_trm_height_assn_sumC (Inl ba)")
  defer
  apply (simp add: eqvt_at_def height_trm_def)
  apply (simp add: eqvt_at_def height_trm_def)
  apply (simp add: eqvt_at_def height_assn_def)
  apply (simp add: eqvt_at_def height_assn_def)
  defer
  apply (subgoal_tac "height_assn as = height_assn asa")
  apply (subgoal_tac "height_trm b = height_trm ba")
  apply simp
  apply (erule_tac c="()" in Abs_lst_fcb2)
  apply (simp_all add: pure_fresh fresh_star_def)[3]
  apply (simp_all add: eqvt_at_def)[2]
  apply assumption
  apply (erule_tac Abs_lst_fcb)
  apply (simp_all add: pure_fresh fresh_star_def)[2]
  apply (drule what_we_would_like)
  apply (drule_tac x="p" in spec)
  apply simp
  apply (simp add: eqvt_at_def)
  oops

end


section\<open>An Observationally Equivalent Model\<close>
text\<open>This theory defines a second formalisation of the drinks machine example which produces
identical output to the first model. This property is called \emph{observational equivalence} and is
discussed in more detail in \<^cite>\<open>"foster2018"\<close>.\<close>
theory Drinks_Machine_2
  imports Drinks_Machine
begin

(* Only imports Drinks_Machine_LTL so I can easily open all three at once for testing *)

definition vend_nothing :: "transition" where
"vend_nothing \<equiv> \<lparr>
        Label = (STR ''vend''),
        Arity = 0,
        Guards = [],
        Outputs =  [],
        Updates = [(1, V (R 1)), (2, V (R 2))]
      \<rparr>"

lemmas transitions = Drinks_Machine.transitions vend_nothing_def

definition drinks2 :: transition_matrix where
"drinks2 = {|
              ((0,1), select),
              ((1,1), vend_nothing),
              ((1,2), coin),
              ((2,2), coin),
              ((2,2), vend_fail),
              ((2,3), vend)
         |}"

lemma possible_steps_0:
  "length i = 1 \<Longrightarrow>
   possible_steps drinks2 0 r ((STR ''select'')) i = {|(1, select)|}"
  apply (simp add: possible_steps_def drinks2_def transitions)
  by force

lemma possible_steps_1:
  "length i = 1 \<Longrightarrow>
   possible_steps drinks2 1 r ((STR ''coin'')) i = {|(2, coin)|}"
  apply (simp add: possible_steps_def drinks2_def transitions)
  by force

lemma possible_steps_2_coin:
  "length i = 1 \<Longrightarrow>
   possible_steps drinks2 2 r ((STR ''coin'')) i = {|(2, coin)|}"
  apply (simp add: possible_steps_def drinks2_def transitions)
  by force

lemma possible_steps_2_vend:
  "r $ 2 = Some (Num n) \<Longrightarrow>
   n \<ge> 100 \<Longrightarrow>
   possible_steps drinks2 2 r ((STR ''vend'')) [] = {|(3, vend)|}"
  apply (simp add: possible_steps_singleton drinks2_def)
  apply safe
  by (simp_all add: transitions apply_guards_def value_gt_def join_ir_def connectives)

lemma recognises_first_select:
  "recognises_execution drinks 0 r ((aa, b) # as) \<Longrightarrow> aa = STR ''select'' \<and> length b = 1"
  using recognises_must_be_possible_step[of drinks 0 r "(aa, b)" as]
  apply simp
  apply clarify
  by (metis first_step_select recognises_possible_steps_not_empty drinks_0_rejects fst_conv snd_conv)

lemma drinks2_vend_insufficient:
  "possible_steps drinks2 1 r ((STR ''vend'')) [] = {|(1, vend_nothing)|}"
  apply (simp add: possible_steps_def drinks2_def transitions)
  by force

lemma drinks2_vend_insufficient2:
  "r $ 2 = Some (Num x1) \<Longrightarrow>
   x1 < 100 \<Longrightarrow>
   possible_steps drinks2 2 r ((STR ''vend'')) [] = {|(2, vend_fail)|}"
  apply (simp add: possible_steps_singleton drinks2_def)
  apply safe
  by (simp_all add: transitions apply_guards_def value_gt_def join_ir_def connectives)

lemma drinks2_vend_sufficient: "r $ 2 = Some (Num x1) \<Longrightarrow>
                \<not> x1 < 100 \<Longrightarrow>
                possible_steps drinks2 2 r ((STR ''vend'')) [] = {|(3, vend)|}"
  apply (simp add: possible_steps_singleton drinks2_def)
  apply safe
  by (simp_all add: transitions apply_guards_def value_gt_def join_ir_def connectives)

lemma recognises_1_2: "recognises_execution drinks 1 r t \<longrightarrow> recognises_execution drinks2 2 r t"
proof(induct t arbitrary: r)
  case (Cons a as)
  then show ?case
    apply (cases a)
    apply (simp add: recognises_step_equiv)
    apply (case_tac "a=(STR ''vend'', [])")
     apply (case_tac "\<exists>n. r$2 = Some (Num n)")
      apply clarify
      apply (case_tac "n < 100")
       apply (simp add: drinks_vend_insufficient drinks2_vend_insufficient2)
      apply (simp add: drinks_vend_sufficient drinks2_vend_sufficient)
      apply (metis recognises_prim recognises_prim.elims(3) drinks_rejects_future)
    using drinks_vend_invalid apply blast
    apply (case_tac "\<exists>i. a=(STR ''coin'', [i])")
     apply clarify
     apply (simp add: possible_steps_1_coin possible_steps_2_coin)
    by (metis recognises_execution.simps drinks_1_rejects_trace)
qed auto

lemma drinks_reject_0_2:
  "\<nexists>i. a = (STR ''select'', [i]) \<Longrightarrow>
   possible_steps drinks 0 r (fst a) (snd a) = {||}"
  apply (rule drinks_0_rejects)
  by (cases a, case_tac "snd a", auto)

lemma drinks2_0_invalid:
  "\<not> (aa = (STR ''select'') \<and> length (b) = 1) \<Longrightarrow>
    (possible_steps drinks2 0 <> aa b) = {||}"
  apply (simp add: drinks2_def possible_steps_def transitions)
  by force

lemma drinks2_vend_r2_none:
  "r $ 2 = None \<Longrightarrow> possible_steps drinks2 2 r ((STR ''vend'')) [] = {||}"
  apply (simp add: possible_steps_empty drinks2_def can_take_transition_def can_take_def transitions)
  by (simp add: value_gt_def)

lemma drinks2_vend_r2_String: "r $ 2 = Some (value.Str x2) \<Longrightarrow>
                possible_steps drinks2 2 r ((STR ''vend'')) [] = {||}"
  apply (simp add: possible_steps_empty drinks2_def)
  apply safe
  by (simp_all add: transitions can_take_transition_def can_take_def value_gt_def)

lemma drinks2_2_invalid:
  "fst a = (STR ''coin'') \<longrightarrow> length (snd a) \<noteq> 1 \<Longrightarrow>
          a \<noteq> ((STR ''vend''), []) \<Longrightarrow>
          possible_steps drinks2 2 r (fst a) (snd a) = {||}"
  apply (simp add: possible_steps_empty drinks2_def transitions can_take_transition_def can_take_def)
  by (metis prod.collapse)

lemma drinks2_1_invalid:
  "\<not>(a = (STR ''coin'') \<and> length b = 1) \<Longrightarrow>
      \<not>(a = (STR ''vend'') \<and> b = []) \<Longrightarrow>
    possible_steps drinks2 1 r a b = {||}"
  apply (simp add: possible_steps_empty drinks2_def)
  apply safe
  by (simp_all add: transitions can_take_transition_def can_take_def value_gt_def)

lemma drinks2_vend_invalid:
  "\<nexists>n. r $ 2 = Some (Num n) \<Longrightarrow>
   possible_steps drinks2 2 r (STR ''vend'') [] = {||}"
  apply (simp add: possible_steps_empty drinks2_def)
  apply safe
  by (simp_all add: transitions can_take_transition_def can_take_def value_gt_def MaybeBoolInt_not_num_1)

lemma equiv_1_2: "executionally_equivalent drinks 1 r drinks2 2 r x"
proof(induct x arbitrary: r)
  case (Cons a t)
  then show ?case
    apply (cases a, clarsimp)
    apply (simp add: executionally_equivalent_step)
    apply (case_tac "fst a = STR ''coin'' \<and> length (snd a) = 1")
     apply (simp add: Drinks_Machine.possible_steps_1_coin possible_steps_2_coin)
    apply (case_tac "a = (STR ''vend'', [])")
     defer using drinks2_2_invalid drinks_no_possible_steps_1 apply auto[1]
    apply (case_tac "\<exists>n. r $ 2 = Some (Num n)")
     defer using drinks_vend_invalid drinks2_vend_invalid apply simp
    apply clarify
    subgoal for aa b n
      apply (case_tac "n < 100")
       apply (simp add: Drinks_Machine.drinks_vend_insufficient drinks2_vend_insufficient2)
      apply (simp add: Drinks_Machine.drinks_vend_sufficient drinks2_vend_sufficient)
      apply (induct t)
       apply simp
      subgoal for aa t apply (case_tac aa, clarsimp)
        by (simp add: executionally_equivalent_step drinks_end drinks2_end)
      done
    done
qed auto

lemma equiv_1_1: "r$2 = Some (Num 0) \<Longrightarrow> executionally_equivalent drinks 1 r drinks2 1 r x"
proof(induct x)
  case (Cons a t)
  then show ?case
    apply (cases a, clarsimp)
    subgoal for aa b
      apply (simp add: executionally_equivalent_step)
      apply (case_tac "aa = STR ''coin'' \<and> length b = 1")
       apply (simp add: possible_steps_1_coin possible_steps_1 equiv_1_2)
      apply (case_tac "a = (STR ''vend'', [])")
       apply clarsimp
       apply (simp add: drinks_vend_insufficient drinks2_vend_insufficient)
       apply (simp add: vend_fail_def vend_nothing_def apply_updates_def)
       apply (metis finfun_upd_triv)
      by (simp add: drinks2_1_invalid drinks_no_possible_steps_1)
    done
qed auto

(* Corresponds to Example 3 in Foster et. al. *)
lemma executional_equivalence: "executionally_equivalent drinks 0 <> drinks2 0 <> t"
proof(induct t)
  case (Cons a t)
  then show ?case
    apply (cases a, clarify)
    subgoal for aa b
      apply (simp add: executionally_equivalent_step)
      apply (case_tac "aa = STR ''select'' \<and> length b = 1")
       apply (simp add: Drinks_Machine.possible_steps_0 possible_steps_0)
       apply (simp add: apply_updates_def select_def equiv_1_1)
      by (simp add: drinks2_0_invalid possible_steps_0_invalid)
    done
qed auto

lemma observational_equivalence: "trace_equivalent drinks drinks2"
  by (simp add: executional_equivalence executionally_equivalent_trace_equivalent)

end


(*  Title:      ZF/Coind/Values.thy
    Author:     Jacob Frost, Cambridge University Computer Laboratory
    Copyright   1995  University of Cambridge
*)

theory Values imports Language Map begin

(* Values, values environments and associated operators *)

consts
  Val  :: i
  ValEnv  :: i
  Val_ValEnv  :: i

codatatype
    "Val" = v_const ("c \<in> Const")
          | v_clos ("x \<in> ExVar","e \<in> Exp","ve \<in> ValEnv")
  and
    "ValEnv" = ve_mk ("m \<in> PMap(ExVar,Val)")
  monos       PMap_mono
  type_intros  A_into_univ mapQU

consts
  ve_owr :: "[i,i,i] => i"
  ve_dom :: "i=>i"
  ve_app :: "[i,i] => i"

primrec "ve_owr(ve_mk(m), x, v) = ve_mk(map_owr(m,x,v))"

primrec "ve_dom(ve_mk(m)) = domain(m)"

primrec "ve_app(ve_mk(m), a) = map_app(m,a)"

definition
  ve_emp :: i  where
   "ve_emp == ve_mk(map_emp)"

(* Elimination rules *)

lemma ValEnvE:
  "[| ve \<in> ValEnv; !!m.[| ve=ve_mk(m); m \<in> PMap(ExVar,Val) |] ==> Q |] ==> Q"
apply (unfold Part_def Val_def ValEnv_def, clarify)
apply (erule Val_ValEnv.cases)
apply (auto simp add: Val_def Part_def Val_ValEnv.con_defs)
done

lemma ValE:
  "[| v \<in> Val;
      !!c. [| v = v_const(c); c \<in> Const |] ==> Q;
      !!e ve x.
        [| v = v_clos(x,e,ve); x \<in> ExVar; e \<in> Exp; ve \<in> ValEnv |] ==> Q
   |] ==>
   Q"
apply (unfold Part_def Val_def ValEnv_def, clarify)
apply (erule Val_ValEnv.cases)
apply (auto simp add: ValEnv_def Part_def Val_ValEnv.con_defs)
done

(* Nonempty sets *)

lemma v_closNE [simp]: "v_clos(x,e,ve) \<noteq> 0"
by (unfold QPair_def QInl_def QInr_def Val_ValEnv.con_defs, blast)

declare v_closNE [THEN notE, elim!]

lemma v_constNE [simp]: "c \<in> Const ==> v_const(c) \<noteq> 0"
apply (unfold QPair_def QInl_def QInr_def Val_ValEnv.con_defs)
apply (drule constNEE, auto)
done

(* Proving that the empty set is not a value *)

lemma ValNEE: "v \<in> Val ==> v \<noteq> 0"
by (erule ValE, auto)

(* Equalities for value environments *)

lemma ve_dom_owr [simp]:
     "[| ve \<in> ValEnv; v \<noteq>0 |] ==> ve_dom(ve_owr(ve,x,v)) = ve_dom(ve) \<union> {x}"
apply (erule ValEnvE)
apply (auto simp add: map_domain_owr)
done

lemma ve_app_owr [simp]:
     "ve \<in> ValEnv
      ==> ve_app(ve_owr(ve,y,v),x) = (if x=y then v else ve_app(ve,x))"
by (erule ValEnvE, simp add: map_app_owr)

(* Introduction rules for operators on value environments *)

lemma ve_appI: "[| ve \<in> ValEnv; x \<in> ve_dom(ve) |] ==> ve_app(ve,x):Val"
by (erule ValEnvE, simp add: pmap_appI)

lemma ve_domI: "[| ve \<in> ValEnv; x \<in> ve_dom(ve) |] ==> x \<in> ExVar"
apply (erule ValEnvE, simp)
apply (blast dest: pmap_domainD)
done

lemma ve_empI: "ve_emp \<in> ValEnv"
apply (unfold ve_emp_def)
apply (rule Val_ValEnv.intros)
apply (rule pmap_empI)
done

lemma ve_owrI:
     "[|ve \<in> ValEnv; x \<in> ExVar; v \<in> Val |] ==> ve_owr(ve,x,v):ValEnv"
apply (erule ValEnvE, simp)
apply (blast intro: pmap_owrI Val_ValEnv.intros)
done

end


theory DFP_DFfive
imports DFP.DFP_law_DFkev
begin

datatype DFfivePN = DFfive

primrec
  DFfivefun ::  "(DFfivePN, 'event) pnfun"
where
  "DFfivefun (DFfive) = (! x1 ->  ! x2 ->  ! x3 ->  ! x4 ->  ! x5 ->  $(DFfive)) "

overloading Set_DFfivefun ==
  "CSP_syntax.PNfun :: (DFfivePN, 'event) pnfun"
begin
  definition "CSP_syntax.PNfun :: (DFfivePN, 'event) pnfun == DFfivefun"
end

declare Set_DFfivefun_def [simp]

lemma guardedfun_DFfivefun [simp]: "guardedfun DFfivefun"
  apply (simp add: guardedfun_def)
  by (rule allI, induct_tac p, simp)

fun DF_IH :: "DFfivePN \<Rightarrow> (DFnonTickPN, 'e) proc"
where
    "DF_IH (DFfive) = $DFnonTick"

lemma Lemma_isMapping_procfun_DF_IH [simp]:
    "isMapping_procfun DF_IH"
  by (simp add: isMapping_procfun_def, auto, induct_tac x, simp_all)

lemma dfnt_DFfive :
    "$DFnonTick <=F $DFfive"
  apply (rule_tac Pf="DFfivefun" and f="DF_IH" in cspF_fp_induct_ref_right, simp_all)
  apply (induct_tac p, rule Lemma_fp_induct_refF_isMapping_procfun, simp_all, simp_all)
  apply (cspF_step, rule cspF_decompo, simp)+
  apply (cspF_unwind_left, cspF_step, rule cspF_decompo, simp)+
  by (cspF_unwind_left)

lemma DFtick_DFfive :
    "$DFtick <=F $DFfive"
  by (rule cspF_trans, rule dfp_DFnonTick, rule dfnt_DFfive)

lemma DFfive_isDeadlockFree:
    "(($DFfive) :: (DFfivePN, 'e) proc) isDeadlockFree"
  by (simp only: DeadlockFree_DFtick_ref, rule DFtick_DFfive)

fun DFkev_IH :: "DFfivePN \<Rightarrow> (DFkevPN, 'e) proc"
where
    "DFkev_IH (DFfive) = $DFkev 5 5"

lemma Lemma_isMapping_procfun_DFkev_IH [simp]:
    "isMapping_procfun DFkev_IH"
  by (simp add: isMapping_procfun_def, auto, induct_tac x, simp_all)

lemma DFfive_eqF_KEv_5_5 :
    "FPmode = CMSmode \<or> FPmode = MIXmode \<Longrightarrow> $DFkev 5 5 =F $DFfive"
  apply (rule_tac Pf="DFfivefun" and f="DFkev_IH" in cspF_fp_induct_eq_right, simp_all)
  apply (induct_tac p, simp)
  by (rule cspF_rw_left, rule DFkev_5_5_unwind, cspF_simp)

end


(*<*)
(*
 * Knowledge-based programs.
 * (C)opyright 2011, Peter Gammie, peteg42 at gmail.com.
 * License: BSD
 *)

theory Robot
imports
  ClockView
  SPRViewSingle
  "HOL-Library.Saturated"
begin

(*>*)
subsection\<open>The Robot\<close>

text\<open>
\label{sec:kbps-theory-robot}

\begin{figure}[tb]
 \includegraphics[width=\textwidth]{robot_clock}
 \caption{The implementation of the robot using the clock semantics.}
 \label{fig:kbps-theory-robot-clock}
\end{figure}

\begin{figure}[tb]
 \includegraphics[width=\textwidth]{robot_spr}
 \caption{The implementation of the robot using the SPR semantics.}
 \label{fig:kbps-theory-robot-spr}
\end{figure}

Recall the autonomous robot of \S\ref{sec:kbps-robot-intro}: we are
looking for an implementation of the KBP:
\begin{center}
  \begin{tabular}{lll}
    $\mathbf{do}$\\
     & $\gcalt$ $\mathbf{K}_{\mbox{robot}}$ \textsf{goal} & $\rightarrow$ \textsf{Halt}\\
     & $\gcalt$ $\lnot\mathbf{K}_{\mbox{robot}}$ \textsf{goal} & $\rightarrow$ \textsf{Nothing}\\
    $\mathbf{od}$\\
  \end{tabular}
\end{center}
in an environment where positions are identified with the natural
numbers, the robot's sensor is within one of the position, and the
proposition \textsf{goal} is true when the position is in
$\{2,3,4\}$. The robot is initially at position zero, and the effect
of its \textsf{Halt} action is to cause the robot to instantaneously
stop at its current position. A later \textsf{Nothing}
action may allow the environment to move the robot further to the
right.

To obtain a finite environment, we truncate the number line at 5,
which is intuitively sound for determinining the robot's behaviour due
to the synchronous view, and the fact that if it reaches this
rightmost position then it can never satisfy its objective.  Running
the Haskell code generated by Isabelle yields the automata shown in
Figure~\ref{fig:kbps-theory-robot-clock} and
Figure~\ref{fig:kbps-theory-robot-spr} for the clock and synchronous
perfect recall semantics respectively. These have been minimised using
Hopcroft's algorithm \citep{DBLP:journals/acta/Gries73}.

The (inessential) labels on the states are an upper bound on the set
of positions that the robot considers possible when it is in that
state. Transitions are annotated with the observations yielded by the
sensor. Double-circled states are those in which the robot performs
the \textsf{Halt} action, the others \textsf{Nothing}. We observe that
the synchronous perfect-recall view yields a ``ratchet'' protocol,
i.e. if the robot learns that it is in the goal region then it halts
for all time, and that it never overshoots the goal region. Conversely
the clock semantics allows the robot to infinitely alternate its
actions depending on the sensor reading. This is effectively the
behaviour of the intuitive implementation that halts iff the sensor
reads three or more.

We can also see that minimisation does not yield the smallest automata
we could hope for; in particular there are a lot of redundant states
where the prescribed behaviour is the same but the robot's state of
knowledge different. This is because our implementations do not
specify what happens on invalid observations, which we have modelled
as errors instead of don't-cares, and these extraneous distinctions
are preserved by bisimulation reduction. We discuss this further in
\S\ref{sec:kbps-alg-auto-min}.

\<close>(*<*)

(*

The environment protocol does nothing if the robot has signalled halt,
or chooses a new position and sensor reading if it hasn't.

We need a finite type to represent positions and observations. It is
sufficient to go to 5, for by then we are either halted in the goal
region or have gone past it.

*)

type_synonym digit = "5 sat"

datatype Agent = Robot
datatype EnvAct = Stay | MoveRight
datatype ObsError = Left | On | Right
datatype Proposition = Halted | InGoal
datatype RobotAct = NOP | Halt

type_synonym Halted = bool
type_synonym Pos = digit
type_synonym Obs = digit
type_synonym EnvState = "Pos \<times> Obs \<times> Halted"

definition
  envInit :: "EnvState list"
where
  "envInit \<equiv> [(0, 0, False), (0, 1, False)]"

definition
  envAction :: "EnvState \<Rightarrow> (EnvAct \<times> ObsError) list"
where
  "envAction \<equiv> \<lambda>_. [ (x, y) . x \<leftarrow> [Stay, MoveRight], y \<leftarrow> [Left, On, Right] ]"

definition
  newObs :: "digit \<Rightarrow> ObsError \<Rightarrow> digit"
where
  "newObs pos obserr \<equiv>
              case obserr of Left \<Rightarrow> pos - 1 | On \<Rightarrow> pos | Right \<Rightarrow> pos + 1"

definition
  envTrans :: "EnvAct \<times> ObsError \<Rightarrow> (Agent \<Rightarrow> RobotAct) \<Rightarrow> EnvState \<Rightarrow> EnvState"
where
  "envTrans \<equiv> \<lambda>(move, obserr) aact (pos, obs, halted).
    if halted
      then (pos, newObs pos obserr, halted)
      else
        case aact Robot of
           NOP \<Rightarrow> (case move of
                      Stay \<Rightarrow> (pos, newObs pos obserr, False)
                    | MoveRight \<Rightarrow> (pos + 1, newObs (pos + 1) obserr, False))
         | Halt \<Rightarrow> (pos, newObs pos obserr, True)"

definition
  envObs :: "EnvState \<Rightarrow> Obs"
where
  "envObs \<equiv> \<lambda>(pos, obs, halted). obs"

definition
  envVal :: "EnvState \<Rightarrow> Proposition \<Rightarrow> bool"
where
  "envVal \<equiv> \<lambda>(pos, obs, halted) p.
     case p of Halted \<Rightarrow> halted
             | InGoal \<Rightarrow> 2 \<le> pos \<and> pos \<le> (4 :: 5 sat)"

(* The KBP, clearly subjective. *)

definition
  kbp :: "(Agent, Proposition, RobotAct) KBP"
where
  "kbp \<equiv> [ \<lparr> guard = \<^bold>K\<^sub>Robot (Kprop InGoal),        action = Halt \<rparr>,
           \<lparr> guard = Knot (\<^bold>K\<^sub>Robot (Kprop InGoal)), action = NOP \<rparr> ]"

(*<*)

lemma Agent_univ: "(UNIV :: Agent set) = {Robot}"
  unfolding UNIV_def
  apply auto
  apply (case_tac x)
  apply auto
  done

instance Agent :: finite
  apply intro_classes
  apply (auto iff: Agent_univ)
  done

instantiation Agent :: linorder
begin

definition
  less_Agent_def: "(x::Agent) < y \<equiv> False"

definition
  less_eq_Agent_def: "(x::Agent) \<le> y \<equiv> x = y"

instance
  apply intro_classes
  unfolding less_Agent_def less_eq_Agent_def
  apply simp_all
  apply (case_tac x)
  apply (case_tac y)
  apply simp
  done
end

(*>*)

subsubsection\<open>Locale instantiations\<close>

interpretation Robot:
  Environment "\<lambda>_. kbp" envInit envAction envTrans envVal "\<lambda>_. envObs"
  apply unfold_locales
  apply (auto simp: kbp_def)
  apply ((case_tac a, simp)+)
  done

subsubsection\<open>The Clock view implementation\<close>

interpretation Robot_Clock:
  FiniteLinorderEnvironment "\<lambda>_. kbp" envInit envAction envTrans envVal "\<lambda>_. envObs" "fromList [Robot]"
  apply unfold_locales
  apply (simp add: Agent_univ)
  done

abbreviation "Agents \<equiv> ODList.fromList [Robot]"

definition
  robot_ClockDFS :: "((EnvState, RobotAct list) clock_acts_trie, (EnvState, digit) clock_trans_trie) AlgState"
where
  "robot_ClockDFS \<equiv> ClockAutoDFS Agents (\<lambda>_. kbp) envInit envAction envTrans envVal (\<lambda>_. envObs) Robot"

definition
  robot_ClockAlg :: "Agent \<Rightarrow> (digit, RobotAct, EnvState odlist \<times> EnvState odlist) Protocol"
where
  "robot_ClockAlg \<equiv> mkClockAuto Agents (\<lambda>_. kbp) envInit envAction envTrans envVal (\<lambda>_. envObs)"

lemma (in FiniteLinorderEnvironment)
  "Robot.Clock.implements robot_ClockAlg"
  unfolding robot_ClockAlg_def by (rule Robot_Clock.mkClockAuto_implements)

subsubsection\<open>The SPR view implementation\<close>

interpretation Robot_SPR:
  FiniteSingleAgentEnvironment "\<lambda>_. kbp" envInit envAction envTrans envVal "\<lambda>_. envObs" "Robot"
  apply unfold_locales
  apply (case_tac a, simp)
  done

definition
  robot_SPRSingleDFS :: "(RobotAct, digit, EnvState) SPRSingleAutoDFS"
where
  "robot_SPRSingleDFS \<equiv> SPRSingleAutoDFS kbp envInit envAction envTrans envVal (\<lambda>_. envObs) Robot"

definition
  robot_SPRSingleAlg :: "Agent \<Rightarrow> (digit, RobotAct, EnvState odlist) Protocol"
where
  "robot_SPRSingleAlg \<equiv> mkSPRSingleAuto kbp envInit envAction envTrans envVal (\<lambda>_. envObs)"

lemma (in FiniteSingleAgentEnvironment)
  "Robot.Robot.SPR.implements robot_SPRSingleAlg"
  unfolding robot_SPRSingleAlg_def by (rule Robot.Robot_SPR.mkSPRSingleAuto_implements)

end
(*>*)


theory Conti imports GeneralKnowledge       (*** Benzmüller, Fuenmayor & Lomfeld, 2021 ***)
begin (*** Conti v. ASPCA "wild animal" case **)
 (*unimportant*) nitpick_params[user_axioms,expect=genuine,show_all,format=3]
 (*case-specific 'world-vocabulary'*)
consts \<alpha>::"e" (*appropriated animal (parrot in this case) *)
consts Care::"c\<Rightarrow>e\<Rightarrow>\<sigma>" Prop::"c\<Rightarrow>e\<Rightarrow>\<sigma>" Capture::"c\<Rightarrow>e\<Rightarrow>\<sigma>"
(****************** pro-plaintiff (ASPCA) argument ****************)
 (*plaintiff's theory*)
abbreviation "pT1 \<equiv> \<lfloor>(\<^bold>\<exists>c. Capture c \<alpha> \<^bold>\<and> Domestic \<alpha>) \<^bold>\<rightarrow> appDomAnimal\<rfloor>"
abbreviation "pT2 \<equiv> \<lfloor>\<^bold>\<forall>c. Care c \<alpha> \<^bold>\<rightarrow> Mtn c\<rfloor>"
abbreviation "pT3 \<equiv> \<lfloor>\<^bold>\<forall>c. Prop c \<alpha> \<^bold>\<rightarrow> Own c\<rfloor>"
abbreviation "pT4 \<equiv> \<lfloor>\<^bold>\<forall>c. Capture c \<alpha> \<^bold>\<rightarrow> Poss c\<rfloor>" (*'concedes' to defendant*)
abbreviation "p_theory \<equiv> pT1 \<and> pT2 \<and> pT3 \<and> pT4"
 (*plaintiff's facts*)
abbreviation "pF1 w \<equiv> Parrot \<alpha> w"
abbreviation "pF2 w \<equiv> Pet \<alpha> w"
abbreviation "pF3 w \<equiv> Care p \<alpha> w"
abbreviation "pF4 w \<equiv> Prop p \<alpha> w"
abbreviation "pF5 w \<equiv> Capture d \<alpha> w"
abbreviation "p_facts \<equiv> pF1 \<^bold>\<and> pF2 \<^bold>\<and> pF3 \<^bold>\<and> pF4 \<^bold>\<and> pF5"
 (*decision for plaintiff (ASPCA) can be proven automatically*)
theorem ASPCA: "p_theory \<longrightarrow> \<lfloor>p_facts \<^bold>\<rightarrow> \<^bold>\<box>\<^sup>\<prec>For p\<rfloor>"
  by (smt F3 F4 F5 ForAx R3 W6 W8 tBR SBR_def other.simps(1))
 (*we reconstruct the reasoning process leading to the decision for the plaintiff*)
theorem ASPCA': assumes p_theory and "p_facts w" shows "\<^bold>\<box>\<^sup>\<prec>For p w"
proof -
  have 1: "appDomAnimal w" using W6 W8 assms by blast
  have 2: "\<lfloor>[STAB\<^sup>d] \<^bold>\<prec> [RELI\<^sup>p\<^bold>\<oplus>RESP\<^sup>p]\<rfloor>" using 1 R3 by fastforce
  have 3: "\<lfloor>(\<^bold>\<diamond>\<^sup>\<prec>[STAB\<^sup>d]) \<^bold>\<rightarrow> \<^bold>\<diamond>\<^sup>\<prec>([RELI\<^sup>p] \<^bold>\<or> [RESP\<^sup>p])\<rfloor>" using 2 tSBR by smt
  have 4: "\<^bold>\<box>\<^sup>\<prec>(For p \<^bold>\<leftrightarrow> \<^bold>\<diamond>\<^sup>\<prec>[RELI\<^sup>p]) w" using F5 assms by metis
  have 5: "\<^bold>\<box>\<^sup>\<prec>(For p \<^bold>\<leftrightarrow> \<^bold>\<diamond>\<^sup>\<prec>[RESP\<^sup>p]) w" using F4 assms by metis
  have 6: "\<^bold>\<box>\<^sup>\<prec>(For d \<^bold>\<leftrightarrow> \<^bold>\<diamond>\<^sup>\<prec>[STAB\<^sup>d]) w" using F3 assms by meson
  have 7: "\<^bold>\<box>\<^sup>\<prec>((\<^bold>\<diamond>\<^sup>\<prec>[RELI\<^sup>p]) \<^bold>\<or> (\<^bold>\<diamond>\<^sup>\<prec>[RESP\<^sup>p]) \<^bold>\<or> (\<^bold>\<diamond>\<^sup>\<prec>[STAB\<^sup>d])) w"
    using 4 5 6 ForAx by (smt other.simps)
  have 8: "\<^bold>\<box>\<^sup>\<prec>((\<^bold>\<diamond>\<^sup>\<prec>[RELI\<^sup>p]) \<^bold>\<or> (\<^bold>\<diamond>\<^sup>\<prec>[RESP\<^sup>p])) w" using 3 7 by metis
  have 9: "\<^bold>\<box>\<^sup>\<prec>(For p) w" using 4 5 8 by auto
  then show ?thesis by simp
qed
(************** Further checks (using model finder) ****************)
 (*plaintiff's theory and facts are logically consistent*)
lemma "p_theory \<and> \<lfloor>p_facts\<rfloor>" nitpick[satisfy,card \<iota>=3] oops (*(non-trivial) model found*)
 (*decision for plaintiff is compatible with premises and lacks value conflicts*)
lemma "\<lfloor>\<^bold>\<not>Conflict\<^sup>p\<rfloor> \<and> \<lfloor>\<^bold>\<not>Conflict\<^sup>d\<rfloor> \<and> p_theory \<and> \<lfloor>p_facts \<^bold>\<and> For p\<rfloor>"
  nitpick[satisfy,card \<iota>=3] oops (* (non-trivial) model found*)
 (*situations where decision holds for defendant are compatible too*)
lemma "\<lfloor>\<^bold>\<not>Conflict\<^sup>p\<rfloor> \<and> \<lfloor>\<^bold>\<not>Conflict\<^sup>d\<rfloor> \<and> p_theory \<and> \<lfloor>p_facts \<^bold>\<and> For d\<rfloor>"
  nitpick[satisfy,card \<iota>=3] oops (* (non-trivial) model found*)
end