theory flash33Rev imports flashPub
begin
section{*Main defintions*}
lemma NI_FAckVsInv33:
    (*Rule0VsPInv1*)
  assumes   a1:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_FAck ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by (cut_tac  a1 , auto)
 lemma NI_InvVsInv33:
  (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Inv  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have allCases:"(iRule1=iInv1)   \<or>((iRule1~=iInv1 ))   "
	                      by( cut_tac  a1  a2  , auto)
moreover
                {assume b1:"(iRule1=iInv1)"

      have "?P1 s"

        apply(cut_tac  a1  a2  b1 , auto)

        done

        then  have "?P1 s\<or> ?P2 s \<or> ?P3 s"

       by blast

	                }
moreover
                {assume b1:"((iRule1~=iInv1 ))"

                  have "?P2 s"

  apply(cut_tac  a1  a2  b1 , auto intro!:forallVars1 simp  add :invHoldForRule2'_def varsOfVar_def)

  done

  then  have "?P1 s\<or> ?P2 s \<or> ?P3 s"

        by blast

	                }
   ultimately show "?P1 s\<or> ?P2 s\<or> ?P3 s"

	                         by metis

 qed
lemma NI_InvAck_1VsInv33:
    (*Rule2VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iRule2 \<le> N" and  a3:"iInv1 \<le> N" and  a4:"iRule1~=iRule2  "

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_InvAck_1  iRule1  iRule2 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by(cut_tac a1 a2 a3 a4, auto)
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_InvAck_1_HomeVsInv33:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_InvAck_1_Home  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by  (cut_tac  a1  a2 , auto)
 lemma NI_InvAck_2VsInv33:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_InvAck_2 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by  (cut_tac  a1  a2 , auto)
 lemma NI_Local_GetX_GetXVsInv33:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Local_GetX_GetX  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by  (cut_tac  a1  a2 , auto)
 lemma NI_Local_GetX_Nak1VsInv33:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Local_GetX_Nak1  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by  (cut_tac  a1  a2 , auto)
 lemma NI_Local_GetX_Nak2VsInv33:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Local_GetX_Nak2  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by  (cut_tac  a1  a2 , auto)
 lemma NI_Local_GetX_Nak3VsInv33:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Local_GetX_Nak3  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by  (cut_tac  a1  a2 , auto)
 lemma NI_Local_GetX_PutX1VsInv33:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Local_GetX_PutX1 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by  (cut_tac  a1  a2 , auto)
 lemma NI_Local_GetX_PutX2VsInv33:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Local_GetX_PutX2 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by  (cut_tac  a1  a2 , auto)
 lemma NI_Local_GetX_PutX3VsInv33:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Local_GetX_PutX3 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by  (cut_tac  a1  a2 , auto)
 lemma NI_Local_GetX_PutX4VsInv33:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Local_GetX_PutX4 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by  (cut_tac  a1  a2 , auto)
 lemma NI_Local_GetX_PutX5VsInv33:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Local_GetX_PutX5 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by  (cut_tac  a1  a2 , auto)
 lemma NI_Local_GetX_PutX6VsInv33:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Local_GetX_PutX6 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by  (cut_tac  a1  a2 , auto)
 lemma NI_Local_GetX_PutX7VsInv33:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Local_GetX_PutX7 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by  (cut_tac  a1  a2 , auto)
 lemma NI_Local_GetX_PutX8VsInv33:
    (*Rule2VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iRule2 \<le> N" and  a3:"iInv1 \<le> N" and  a4:"iRule1~=iRule2  "

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Local_GetX_PutX8 N  iRule1  iRule2 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by(cut_tac a1 a2 a3 a4, auto)
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_GetX_PutX8_homeVsInv33:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Local_GetX_PutX8_home N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by  (cut_tac  a1  a2 , auto)
 lemma NI_Local_GetX_PutX9VsInv33:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Local_GetX_PutX9 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by  (cut_tac  a1  a2 , auto)
 lemma NI_Local_GetX_PutX10VsInv33:
    (*Rule2VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iRule2 \<le> N" and  a3:"iInv1 \<le> N" and  a4:"iRule1~=iRule2  "

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Local_GetX_PutX10 N  iRule1  iRule2 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by(cut_tac a1 a2 a3 a4, auto)
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Local_GetX_PutX10_homeVsInv33:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Local_GetX_PutX10_home N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by  (cut_tac  a1  a2 , auto)
 lemma NI_Local_GetX_PutX11VsInv33:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Local_GetX_PutX11 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by  (cut_tac  a1  a2 , auto)
 lemma NI_Local_Get_GetVsInv33:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Local_Get_Get  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by  (cut_tac  a1  a2 , auto)
 lemma NI_Local_Get_Nak1VsInv33:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Local_Get_Nak1  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by  (cut_tac  a1  a2 , auto)
 lemma NI_Local_Get_Nak2VsInv33:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Local_Get_Nak2  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by  (cut_tac  a1  a2 , auto)
 lemma NI_Local_Get_Nak3VsInv33:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Local_Get_Nak3  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by  (cut_tac  a1  a2 , auto)
 lemma NI_Local_Get_Put1VsInv33:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Local_Get_Put1 N  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by  (cut_tac  a1  a2 , auto)
 lemma NI_Local_Get_Put2VsInv33:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Local_Get_Put2  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by  (cut_tac  a1  a2 , auto)
 lemma NI_Local_Get_Put3VsInv33:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Local_Get_Put3  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by  (cut_tac  a1  a2 , auto)
 lemma NI_Local_PutVsInv33:
  (*Rule0VsPInv1*)
  assumes   a1:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Local_Put ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply(cut_tac  a1 , auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma NI_Local_PutXAcksDoneVsInv33:
  (*Rule0VsPInv1*)
  assumes   a1:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Local_PutXAcksDone ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply(cut_tac  a1 , auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma NI_NakVsInv33:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Nak  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by  (cut_tac  a1  a2 , auto)
 lemma NI_Nak_ClearVsInv33:
    (*Rule0VsPInv1*)
  assumes   a1:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Nak_Clear ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by (cut_tac  a1 , auto)
 lemma NI_Nak_HomeVsInv33:
  (*Rule0VsPInv1*)
  assumes   a1:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Nak_Home ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply(cut_tac  a1 , auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma NI_Remote_GetX_NakVsInv33:
    (*Rule2VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iRule2 \<le> N" and  a3:"iInv1 \<le> N" and  a4:"iRule1~=iRule2  "

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Remote_GetX_Nak  iRule1  iRule2 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by(cut_tac a1 a2 a3 a4, auto)
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Remote_GetX_Nak_HomeVsInv33:
  (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Remote_GetX_Nak_Home  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have allCases:"(iRule1=iInv1)   \<or>((iRule1~=iInv1 ))   "
	                      by( cut_tac  a1  a2  , auto)
moreover
                {assume b1:"(iRule1=iInv1)"

      have "?P1 s"

        apply(cut_tac  a1  a2  b1 , auto)

        done

        then  have "?P1 s\<or> ?P2 s \<or> ?P3 s"

       by blast

	                }
moreover
                {assume b1:"((iRule1~=iInv1 ))"

      have "?P1 s"

        apply(cut_tac  a1  a2  b1 , auto)

        done

        then  have "?P1 s\<or> ?P2 s \<or> ?P3 s"

       by blast

	                }
   ultimately show "?P1 s\<or> ?P2 s\<or> ?P3 s"

	                         by metis

 qed
lemma NI_Remote_GetX_PutXVsInv33:
    (*Rule2VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iRule2 \<le> N" and  a3:"iInv1 \<le> N" and  a4:"iRule1~=iRule2  "

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Remote_GetX_PutX  iRule1  iRule2 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have allCases:"(iRule1=iInv1\<and>(iRule2~=iInv1 ))   \<or>((iRule1~=iInv1 )\<and>iRule2=iInv1)   \<or>((iRule1~=iInv1 )\<and>(iRule2~=iInv1 ))   "
	                      by( cut_tac  a1  a2  a3  a4  , auto)
moreover
                {assume b1:"(iRule1=iInv1\<and>(iRule2~=iInv1 ))"

                  have "?P2 s"

  apply(cut_tac  a1  a2  a3  a4  b1 , auto intro!:forallVars1 simp  add :invHoldForRule2'_def varsOfVar_def)

  done

  then  have "?P1 s\<or> ?P2 s \<or> ?P3 s"

        by blast

	                }
moreover
                {assume b1:"((iRule1~=iInv1 )\<and>iRule2=iInv1)"

      have "?P1 s"

        apply(cut_tac  a1  a2  a3  a4  b1 , auto)

        done

        then  have "?P1 s\<or> ?P2 s \<or> ?P3 s"

       by blast

	                }
moreover
                {assume b1:"((iRule1~=iInv1 )\<and>(iRule2~=iInv1 ))"

                  have "?P2 s"

  apply(cut_tac  a1  a2  a3  a4  b1 , auto intro!:forallVars1 simp  add :invHoldForRule2'_def varsOfVar_def)

  done

  then  have "?P1 s\<or> ?P2 s \<or> ?P3 s"

        by blast

	                }
   ultimately show "?P1 s\<or> ?P2 s\<or> ?P3 s"

	                         by metis

 qed
lemma NI_Remote_GetX_PutX_HomeVsInv33:
  (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Remote_GetX_PutX_Home  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have allCases:"(iRule1=iInv1)   \<or>((iRule1~=iInv1 ))   "
	                      by( cut_tac  a1  a2  , auto)
moreover
                {assume b1:"(iRule1=iInv1)"

      have "?P1 s"

        apply(cut_tac  a1  a2  b1 , auto)

        done

        then  have "?P1 s\<or> ?P2 s \<or> ?P3 s"

       by blast

	                }
moreover
                {assume b1:"((iRule1~=iInv1 ))"

      have "?P3 s"

        apply(   cut_tac  a1  a2  b1 , simp)

        apply(rule_tac x=" (neg ( andForm ( eqn ( IVar ( Para ''CacheState'' iRule1) )  ( Const CACHE_E ))    ( eqn ( IVar ( Para ''CacheState'' iInv1) )  ( Const CACHE_E ))  ) ) " in exI,auto)

        done

       then  have "?P1 s\<or> ?P2 s \<or> ?P3 s"

        by blast

	                }
   ultimately show "?P1 s\<or> ?P2 s\<or> ?P3 s"

	                         by metis

 qed
lemma NI_Remote_Get_Nak1VsInv33:
  (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Remote_Get_Nak1  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have allCases:"(iRule1=iInv1)   \<or>((iRule1~=iInv1 ))   "
	                      by( cut_tac  a1  a2  , auto)
moreover
                {assume b1:"(iRule1=iInv1)"

      have "?P1 s"

        apply(cut_tac  a1  a2  b1 , auto)

        done

        then  have "?P1 s\<or> ?P2 s \<or> ?P3 s"

       by blast

	                }
moreover
                {assume b1:"((iRule1~=iInv1 ))"

      have "?P1 s"

        apply(cut_tac  a1  a2  b1 , auto)

        done

        then  have "?P1 s\<or> ?P2 s \<or> ?P3 s"

       by blast

	                }
   ultimately show "?P1 s\<or> ?P2 s\<or> ?P3 s"

	                         by metis

 qed
lemma NI_Remote_Get_Nak2VsInv33:
    (*Rule2VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iRule2 \<le> N" and  a3:"iInv1 \<le> N" and  a4:"iRule1~=iRule2  "

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Remote_Get_Nak2  iRule1  iRule2 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have "?P2 s"

     by(cut_tac a1 a2 a3 a4, auto)
   then show "?P1 s\<or>?P2 s\<or>?P3 s"
      by auto
 qed
  lemma NI_Remote_Get_Put1VsInv33:
  (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Remote_Get_Put1  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have allCases:"(iRule1=iInv1)   \<or>((iRule1~=iInv1 ))   "
	                      by( cut_tac  a1  a2  , auto)
moreover
                {assume b1:"(iRule1=iInv1)"

      have "?P1 s"

        apply(cut_tac  a1  a2  b1 , auto)

        done

        then  have "?P1 s\<or> ?P2 s \<or> ?P3 s"

       by blast

	                }
moreover
                {assume b1:"((iRule1~=iInv1 ))"

      have "?P1 s"

        apply(cut_tac  a1  a2  b1 , auto)

        done

        then  have "?P1 s\<or> ?P2 s \<or> ?P3 s"

       by blast

	                }
   ultimately show "?P1 s\<or> ?P2 s\<or> ?P3 s"

	                         by metis

 qed
lemma NI_Remote_Get_Put2VsInv33:
    (*Rule2VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iRule2 \<le> N" and  a3:"iInv1 \<le> N" and  a4:"iRule1~=iRule2  "

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Remote_Get_Put2  iRule1  iRule2 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have allCases:"(iRule1=iInv1\<and>(iRule2~=iInv1 ))   \<or>((iRule1~=iInv1 )\<and>iRule2=iInv1)   \<or>((iRule1~=iInv1 )\<and>(iRule2~=iInv1 ))   "
	                      by( cut_tac  a1  a2  a3  a4  , auto)
moreover
                {assume b1:"(iRule1=iInv1\<and>(iRule2~=iInv1 ))"

                  have "?P2 s"

  apply(cut_tac  a1  a2  a3  a4  b1 , auto intro!:forallVars1 simp  add :invHoldForRule2'_def varsOfVar_def)

  done

  then  have "?P1 s\<or> ?P2 s \<or> ?P3 s"

        by blast

	                }
moreover
                {assume b1:"((iRule1~=iInv1 )\<and>iRule2=iInv1)"

      have "?P1 s"

        apply(cut_tac  a1  a2  a3  a4  b1 , auto)

        done

        then  have "?P1 s\<or> ?P2 s \<or> ?P3 s"

       by blast

	                }
moreover
                {assume b1:"((iRule1~=iInv1 )\<and>(iRule2~=iInv1 ))"

                  have "?P2 s"

  apply(cut_tac  a1  a2  a3  a4  b1 , auto intro!:forallVars1 simp  add :invHoldForRule2'_def varsOfVar_def)

  done

  then  have "?P1 s\<or> ?P2 s \<or> ?P3 s"

        by blast

	                }
   ultimately show "?P1 s\<or> ?P2 s\<or> ?P3 s"

	                         by metis

 qed
lemma NI_Remote_PutVsInv33:
  (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Remote_Put  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have allCases:"(iRule1=iInv1)   \<or>((iRule1~=iInv1 ))   "
	                      by( cut_tac  a1  a2  , auto)
moreover
                {assume b1:"(iRule1=iInv1)"

                     have allCases:"formEval  ( eqn ( IVar ( Para ''InvMarked'' iInv1) )  ( Const true ))  s  \<or>formEval   (neg ( eqn ( IVar ( Para ''InvMarked'' iInv1) )  ( Const true )) )  s  "
	                      by auto

    moreover
                       {assume c1:"formEval ( eqn ( IVar ( Para ''InvMarked'' iInv1) )  ( Const true ))  s"

      have "?P1 s"

        apply(cut_tac  a1  a2  b1  c1 , auto)

        done

        then  have "?P1 s\<or> ?P2 s \<or> ?P3 s"

       by blast
    }

    moreover
                       {assume c1:"formEval  (neg ( eqn ( IVar ( Para ''InvMarked'' iInv1) )  ( Const true )) )  s"

      have "?P1 s"

        apply(cut_tac  a1  a2  b1  c1 , auto)

        done

        then  have "?P1 s\<or> ?P2 s \<or> ?P3 s"

       by blast
    }
   ultimately have "?P1 s\<or> ?P2 s\<or> ?P3 s"

	                         by metis

	                }
moreover
                {assume b1:"((iRule1~=iInv1 ))"

                  have "?P2 s"

  apply(cut_tac  a1  a2  b1 , auto intro!:forallVars1 simp  add :invHoldForRule2'_def varsOfVar_def)

  done

  then  have "?P1 s\<or> ?P2 s \<or> ?P3 s"

        by blast

	                }
   ultimately show "?P1 s\<or> ?P2 s\<or> ?P3 s"

	                         by metis

 qed
lemma NI_Remote_PutXVsInv33:
  (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Remote_PutX  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have allCases:"(iRule1=iInv1)   \<or>((iRule1~=iInv1 ))   "
	                      by( cut_tac  a1  a2  , auto)
moreover
                {assume b1:"(iRule1=iInv1)"

      have "?P3 s"

        apply(   cut_tac  a1  a2  b1 , simp)

        apply(rule_tac x=" (neg ( andForm ( eqn ( IVar ( Para ''UniMsg_Cmd'' Home) )  ( Const UNI_PutX ))    ( eqn ( IVar ( Para ''UniMsg_Cmd'' iInv1) )  ( Const UNI_PutX ))  ) ) " in exI,auto)

        done

       then  have "?P1 s\<or> ?P2 s \<or> ?P3 s"

        by blast

	                }
moreover
                {assume b1:"((iRule1~=iInv1 ))"

                  have "?P2 s"

  apply(cut_tac  a1  a2  b1 , auto intro!:forallVars1 simp  add :invHoldForRule2'_def varsOfVar_def)

  done

  then  have "?P1 s\<or> ?P2 s \<or> ?P3 s"

        by blast

	                }
   ultimately show "?P1 s\<or> ?P2 s\<or> ?P3 s"

	                         by metis

 qed
lemma NI_ReplaceVsInv33:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Replace  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by  (cut_tac  a1  a2 , auto)
 lemma NI_ReplaceHomeVsInv33:
    (*Rule0VsPInv1*)
  assumes   a1:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_ReplaceHome ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by (cut_tac  a1 , auto)
 lemma NI_ReplaceHomeShrVldVsInv33:
    (*Rule0VsPInv1*)
  assumes   a1:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_ReplaceHomeShrVld ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by (cut_tac  a1 , auto)
 lemma NI_ReplaceShrVldVsInv33:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_ReplaceShrVld  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by  (cut_tac  a1  a2 , auto)
 lemma NI_ShWbVsInv33:
    (*Rule0VsPInv1*)
  assumes   a1:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_ShWb N ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by (cut_tac  a1 , auto)
 lemma NI_WbVsInv33:
    (*Rule0VsPInv1*)
  assumes   a1:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (NI_Wb ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by (cut_tac  a1 , auto)
 lemma PI_Local_GetX_GetX1VsInv33:
  (*Rule0VsPInv1*)
  assumes   a1:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (PI_Local_GetX_GetX1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply(cut_tac  a1 , auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma PI_Local_GetX_GetX2VsInv33:
  (*Rule0VsPInv1*)
  assumes   a1:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (PI_Local_GetX_GetX2 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply(cut_tac  a1 , auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma PI_Local_GetX_PutX1VsInv33:
    (*Rule0VsPInv1*)
  assumes   a1:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (PI_Local_GetX_PutX1 N ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by (cut_tac  a1 , auto)
 lemma PI_Local_GetX_PutX2VsInv33:
    (*Rule0VsPInv1*)
  assumes   a1:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (PI_Local_GetX_PutX2 N ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by (cut_tac  a1 , auto)
 lemma PI_Local_GetX_PutX3VsInv33:
    (*Rule0VsPInv1*)
  assumes   a1:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (PI_Local_GetX_PutX3 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by (cut_tac  a1 , auto)
 lemma PI_Local_GetX_PutX4VsInv33:
    (*Rule0VsPInv1*)
  assumes   a1:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (PI_Local_GetX_PutX4 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by (cut_tac  a1 , auto)
 lemma PI_Local_Get_GetVsInv33:
  (*Rule0VsPInv1*)
  assumes   a1:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (PI_Local_Get_Get ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

      have "?P1 s"

        apply(cut_tac  a1 , auto)

        done

        then  show "?P1 s\<or> ?P2 s\<or> ?P3 s"

       by blast

 qed
lemma PI_Local_Get_PutVsInv33:
    (*Rule0VsPInv1*)
  assumes   a1:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (PI_Local_Get_Put ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by (cut_tac  a1 , auto)
 lemma PI_Local_PutXVsInv33:
    (*Rule0VsPInv1*)
  assumes   a1:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (PI_Local_PutX ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by (cut_tac  a1 , auto)
 lemma PI_Local_ReplaceVsInv33:
    (*Rule0VsPInv1*)
  assumes   a1:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (PI_Local_Replace ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by (cut_tac  a1 , auto)
 lemma PI_Remote_GetVsInv33:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (PI_Remote_Get  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by  (cut_tac  a1  a2 , auto)
 lemma PI_Remote_GetXVsInv33:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (PI_Remote_GetX  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by  (cut_tac  a1  a2 , auto)
 lemma PI_Remote_PutXVsInv33:
  (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (PI_Remote_PutX  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

  proof -

     have allCases:"(iRule1=iInv1)   \<or>((iRule1~=iInv1 ))   "
	                      by( cut_tac  a1  a2  , auto)
moreover
                {assume b1:"(iRule1=iInv1)"

      have "?P1 s"

        apply(cut_tac  a1  a2  b1 , auto)

        done

        then  have "?P1 s\<or> ?P2 s \<or> ?P3 s"

       by blast

	                }
moreover
                {assume b1:"((iRule1~=iInv1 ))"

                  have "?P2 s"

  apply(cut_tac  a1  a2  b1 , auto intro!:forallVars1 simp  add :invHoldForRule2'_def varsOfVar_def)

  done

  then  have "?P1 s\<or> ?P2 s \<or> ?P3 s"

        by blast

	                }
   ultimately show "?P1 s\<or> ?P2 s\<or> ?P3 s"

	                         by metis

 qed
lemma PI_Remote_ReplaceVsInv33:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (PI_Remote_Replace  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by  (cut_tac  a1  a2 , auto)
 lemma StoreVsInv33:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (Store  iRule1 ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by  (cut_tac  a1  a2 , auto)
 lemma StoreHomeVsInv33:
    (*Rule0VsPInv1*)
  assumes   a1:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv33  iInv1 ) (StoreHome ) (invariants   N)" (is " ?P1 s\<or>?P2 s\<or>?P3 s")

    by (cut_tac  a1 , auto)
 end


theory RCCVerification_RCC_FO_in_MetricSpace__T
imports "$HETS_ISABELLE_LIB/MainHC"
begin

ML_file "$HETS_ISABELLE_LIB/prelude.ML"

setup "Header.initialize
       [\"Ax1\", \"C_def\", \"EMSCB_center\", \"EMSCB_closed\",
        \"EMSCB_rep_pos\", \"EMSCB_rep_0\", \"EMSCB_rep_inj\", \"Ax4\",
        \"MS_pos\", \"MS_zero\", \"MS_pos_definite\", \"MS_symm\",
        \"MS_triangle\", \"one_greater_zero\", \"zero_leq_one\",
        \"half_gt_zero\", \"half_plus_minus\", \"add_monotone\",
        \"sub_leq\", \"half_leq\", \"half_leq_zero\", \"comm_add\",
        \"Real_half_plus\", \"Real_half_minus\", \"Real_minus_half\",
        \"Real_half_monot\", \"Real_abs_def\", \"Real_sqr_def\",
        \"Real_sqrt_dom\", \"Real_sqrt_idef\", \"Real_2_def\",
        \"Real_minus_def\", \"Real_divide_dom\", \"Real_divide_idef\",
        \"Real_half_idef\", \"Real_ub_def\", \"Real_lb_def\",
        \"Real_inf_def\", \"Real_sup_def\", \"Real_isBounded_def\",
        \"completeness\", \"Real_inj_0\", \"Real_inj_suc\",
        \"Real_archimedian\", \"FWO_plus_right\", \"FWO_times_right\",
        \"FWO_plus\", \"FWO_plus_left\", \"FWO_times_left\",
        \"Field_unary_minus_idef\", \"dichotomy_TotalOrder\", \"antisym\",
        \"trans\", \"refl\", \"min_inf_relation\", \"max_sup_relation\",
        \"ga_comm_min\", \"ga_comm_max\", \"ga_assoc_min\",
        \"ga_assoc_max\", \"ga_left_comm_min\", \"ga_left_comm_max\",
        \"min_def_ExtTotalOrder\", \"max_def_ExtTotalOrder\",
        \"ga_comm_inf\", \"ga_comm_sup\", \"inf_def_ExtPartialOrder\",
        \"sup_def_ExtPartialOrder\", \"geq_def_ExtPartialOrder\",
        \"less_def_ExtPartialOrder\", \"greater_def_ExtPartialOrder\",
        \"C_non_null\", \"C_sym\", \"C_id\", \"C_non_triv\"]"

typedecl ClosedBall
typedecl Real
typedecl S

datatype X_Nat = X0X1 ("0''") | X_suc "X_Nat" ("suc/'(_')" [3] 999)

consts
X0X2 :: "Real" ("0''''")
X1 :: "Real" ("1''")
X2 :: "Real" ("2''")
XMinus__X :: "Real => Real" ("(-''/ _)" [56] 56)
XVBar__XVBar :: "Real => Real" ("(|/ _/ |)" [10] 999)
X__C__X :: "ClosedBall => ClosedBall => bool" ("(_/ C/ _)" [44,44] 42)
X__XGtXEq__X :: "Real => Real => bool" ("(_/ >=''/ _)" [44,44] 42)
X__XGt__X :: "Real => Real => bool" ("(_/ >''/ _)" [44,44] 42)
X__XLtXEq__XX1 :: "Real => Real => bool" ("(_/ <=''/ _)" [44,44] 42)
X__XLtXEq__XX2 :: "Real => (Real => bool) => bool" ("(_/ <=''''/ _)" [44,44] 42)
X__XLtXEq__XX3 :: "(Real => bool) => Real => bool" ("(_/ <='_3/ _)" [44,44] 42)
X__XLt__X :: "Real => Real => bool" ("(_/ <''/ _)" [44,44] 42)
X__XMinus__X :: "Real => Real => Real" ("(_/ -''/ _)" [54,54] 52)
X__XPlus__X :: "Real => Real => Real" ("(_/ +''/ _)" [54,54] 52)
X__XSlash__X :: "Real => Real => Real partial" ("(_/ '/''/ _)" [54,54] 52)
X__Xx__X :: "Real => Real => Real" ("(_/ *''/ _)" [54,54] 52)
X_closedBall :: "S => Real => ClosedBall" ("closedBall/'(_,/ _')" [3,3] 999)
X_d :: "S => S => Real" ("d/'(_,/ _')" [3,3] 999)
X_half :: "Real => Real" ("half/'(_')" [3] 999)
X_inj :: "X_Nat => Real" ("inj''/'(_')" [3] 999)
X_isBounded :: "(Real => bool) => bool" ("isBounded/'(_')" [3] 999)
X_max :: "Real => Real => Real" ("max''/'(_,/ _')" [3,3] 999)
X_min :: "Real => Real => Real" ("min''/'(_,/ _')" [3,3] 999)
X_nonempty :: "ClosedBall => bool" ("nonempty/'(_')" [3] 999)
infX1 :: "Real => Real => Real partial" ("inf''/'(_,/ _')" [3,3] 999)
infX2 :: "(Real => bool) => Real partial" ("inf''''/'(_')" [3] 999)
rep :: "ClosedBall => S => bool"
sqr__X :: "Real => Real" ("(sqr/ _)" [56] 56)
sqrt__X :: "Real => Real partial" ("(sqrt/ _)" [56] 56)
supX1 :: "Real => Real => Real partial" ("sup''/'(_,/ _')" [3,3] 999)
supX2 :: "(Real => bool) => Real partial" ("sup''''/'(_')" [3] 999)

axiomatization
where
Ax1 [rule_format] : "ALL (x :: ClosedBall). nonempty(x) = (x C x)"
and
C_def [rule_format] :
"ALL (x :: ClosedBall).
 ALL (y :: ClosedBall). (x C y) = (EX (s :: S). rep x s & rep y s)"
and
EMSCB_center [rule_format] :
"ALL (r :: Real).
 ALL (x :: S). r >' 0'' --> rep (closedBall(x, r)) x"
and
EMSCB_closed [rule_format] :
"ALL (a :: ClosedBall).
 ALL (x :: S).
 ~ rep a x -->
 (EX (r :: Real).
  ALL (y :: S). ~ (rep (closedBall(x, r)) y & ~ rep a y))"
and
EMSCB_rep_pos [rule_format] :
"ALL (r :: Real).
 ALL (x :: S).
 ALL (y :: S).
 r >' 0'' --> rep (closedBall(x, r)) y = (d(x, y) <=' r)"
and
EMSCB_rep_0 [rule_format] :
"ALL (r :: Real).
 ALL (x :: S).
 ALL (y :: S). ~ r >' 0'' --> ~ rep (closedBall(x, r)) y"
and
EMSCB_rep_inj [rule_format] :
"ALL (a :: ClosedBall).
 ALL (b :: ClosedBall). rep a = rep b --> a = b"
and
Ax4 [rule_format] :
"ALL (a :: ClosedBall).
 EX (z :: S). EX (t :: Real). a = closedBall(z, t)"
and
MS_pos [rule_format] :
"ALL (x :: S). ALL (y :: S). 0'' <=' d(x, y)"
and
MS_zero [rule_format] : "ALL (x :: S). d(x, x) = 0''"
and
MS_pos_definite [rule_format] :
"ALL (x :: S). ALL (y :: S). d(x, y) = 0'' = (x = y)"
and
MS_symm [rule_format] :
"ALL (x :: S). ALL (y :: S). d(x, y) = d(y, x)"
and
MS_triangle [rule_format] :
"ALL (x :: S).
 ALL (y :: S). ALL (z :: S). d(x, z) <=' d(x, y) +' d(y, z)"
and
one_greater_zero [rule_format] : "1' >' 0''"
and
zero_leq_one [rule_format] : "0'' <=' 1'"
and
half_gt_zero [rule_format] :
"ALL (r :: Real). r >' 0'' --> half(r) >' 0''"
and
half_plus_minus [rule_format] :
"ALL (r :: Real).
 ALL (s :: Real). r <=' s --> s +' half(r -' s) <=' s"
and
add_monotone [rule_format] :
"ALL (a :: Real).
 ALL (b :: Real).
 ALL (c :: Real).
 ALL (e :: Real). a <=' b & c <=' e --> a +' c <=' b +' e"
and
sub_leq [rule_format] :
"ALL (a :: Real). ALL (b :: Real). ~ a <=' b --> a -' b >' 0''"
and
half_leq [rule_format] :
"ALL (a :: Real).
 ALL (b :: Real). a <=' half(a -' b) +' b --> a <=' b"
and
half_leq_zero [rule_format] :
"ALL (r :: Real). 0'' <=' r --> 0'' <=' half(r)"
and
comm_add [rule_format] :
"ALL (a :: Real). ALL (b :: Real). a +' b = b +' a"
and
Real_half_plus [rule_format] :
"ALL (r :: Real).
 ALL (s :: Real). half(r +' s) = half(r) +' half(s)"
and
Real_half_minus [rule_format] :
"ALL (r :: Real).
 ALL (s :: Real). half(r -' s) = half(r) -' half(s)"
and
Real_minus_half [rule_format] :
"ALL (r :: Real). r -' half(r) = half(r)"
and
Real_half_monot [rule_format] :
"ALL (r :: Real).
 ALL (s :: Real). (half(r) <=' half(s)) = (r <=' s)"
and
Real_abs_def [rule_format] :
"ALL (r :: Real). | r | = max'(r, -' r)"
and
Real_sqr_def [rule_format] : "ALL (r :: Real). sqr r = r *' r"
and
Real_sqrt_dom [rule_format] :
"ALL (r :: Real). defOp (sqrt r) = (r >=' 0'')"
and
Real_sqrt_idef [rule_format] :
"ALL (r :: Real). sqrt sqr r = makePartial ( | r | )"
and
Real_2_def [rule_format] : "2' = 1' +' 1'"
and
Real_minus_def [rule_format] :
"ALL (r :: Real). ALL (r' :: Real). r -' r' = r +' -' r'"
and
Real_divide_dom [rule_format] :
"ALL (r :: Real). ~ defOp (r /' 0'')"
and
Real_divide_idef [rule_format] :
"ALL (r :: Real).
 ALL (r' :: Real).
 ALL (r'' :: Real).
 (~ r' = 0'' --> r /' r' = makePartial r'') = (r'' *' r' = r)"
and
Real_half_idef [rule_format] : "ALL (r :: Real). 2' *' half(r) = r"
and
Real_ub_def [rule_format] :
"ALL (M :: Real => bool).
 ALL (r :: Real). (M <=_3 r) = (ALL (s :: Real). M s --> s <=' r)"
and
Real_lb_def [rule_format] :
"ALL (M :: Real => bool).
 ALL (r :: Real). (r <='' M) = (ALL (s :: Real). M s --> r <=' s)"
and
Real_inf_def [rule_format] :
"ALL (M :: Real => bool).
 ALL (r :: Real).
 inf''(M) = makePartial r =
 (r <='' M & (ALL (s :: Real). s <='' M --> s <=' r))"
and
Real_sup_def [rule_format] :
"ALL (M :: Real => bool).
 ALL (r :: Real).
 sup''(M) = makePartial r =
 (M <=_3 r & (ALL (s :: Real). M <=_3 s --> r <=' s))"
and
Real_isBounded_def [rule_format] :
"ALL (M :: Real => bool).
 isBounded(M) =
 (EX (ub :: Real). EX (lb :: Real). lb <='' M & M <=_3 ub)"
and
completeness [rule_format] :
"ALL (M :: Real => bool).
 isBounded(M) --> defOp (inf''(M)) & defOp (sup''(M))"
and
Real_inj_0 [rule_format] : "inj'(0') = 0''"
and
Real_inj_suc [rule_format] :
"ALL (X_n :: X_Nat). inj'(suc(X_n)) = 1' +' inj'(X_n)"
and
Real_archimedian [rule_format] :
"ALL (r :: Real). EX (X_n :: X_Nat). r <=' inj'(X_n)"
and
FWO_plus_right [rule_format] :
"ALL (a :: Real).
 ALL (b :: Real). ALL (c :: Real). b <=' c --> a +' b <=' a +' c"
and
FWO_times_right [rule_format] :
"ALL (a :: Real).
 ALL (b :: Real).
 ALL (c :: Real). b <=' c & 0'' <=' a --> a *' b <=' a *' c"
and
FWO_plus [rule_format] :
"ALL (a :: Real).
 ALL (b :: Real).
 ALL (c :: Real).
 ALL (X_d :: Real). a <=' c & b <=' X_d --> a +' b <=' c +' X_d"
and
FWO_plus_left [rule_format] :
"ALL (a :: Real).
 ALL (b :: Real). ALL (c :: Real). a <=' b --> a +' c <=' b +' c"
and
FWO_times_left [rule_format] :
"ALL (a :: Real).
 ALL (b :: Real).
 ALL (c :: Real). a <=' b & 0'' <=' c --> a *' c <=' b *' c"
and
Field_unary_minus_idef [rule_format] :
"ALL (x :: Real). -' x +' x = 0''"
and
dichotomy_TotalOrder [rule_format] :
"ALL (x :: Real). ALL (y :: Real). x <=' y | y <=' x"
and
antisym [rule_format] :
"ALL (x :: Real). ALL (y :: Real). x <=' y & y <=' x --> x = y"
and
trans [rule_format] :
"ALL (x :: Real).
 ALL (y :: Real). ALL (z :: Real). x <=' y & y <=' z --> x <=' z"
and
refl [rule_format] : "ALL (x :: Real). x <=' x"
and
min_inf_relation [rule_format] :
"ALL (x :: Real).
 ALL (y :: Real). makePartial (min'(x, y)) = inf'(x, y)"
and
max_sup_relation [rule_format] :
"ALL (x :: Real).
 ALL (y :: Real). makePartial (max'(x, y)) = sup'(x, y)"
and
ga_comm_min [rule_format] :
"ALL (x :: Real). ALL (y :: Real). min'(x, y) = min'(y, x)"
and
ga_comm_max [rule_format] :
"ALL (x :: Real). ALL (y :: Real). max'(x, y) = max'(y, x)"
and
ga_assoc_min [rule_format] :
"ALL (x :: Real).
 ALL (y :: Real).
 ALL (z :: Real). min'(min'(x, y), z) = min'(x, min'(y, z))"
and
ga_assoc_max [rule_format] :
"ALL (x :: Real).
 ALL (y :: Real).
 ALL (z :: Real). max'(max'(x, y), z) = max'(x, max'(y, z))"
and
ga_left_comm_min [rule_format] :
"ALL (x :: Real).
 ALL (y :: Real).
 ALL (z :: Real). min'(x, min'(y, z)) = min'(y, min'(x, z))"
and
ga_left_comm_max [rule_format] :
"ALL (x :: Real).
 ALL (y :: Real).
 ALL (z :: Real). max'(x, max'(y, z)) = max'(y, max'(x, z))"
and
min_def_ExtTotalOrder [rule_format] :
"ALL (x :: Real).
 ALL (y :: Real). min'(x, y) = (if x <=' y then x else y)"
and
max_def_ExtTotalOrder [rule_format] :
"ALL (x :: Real).
 ALL (y :: Real). max'(x, y) = (if x <=' y then y else x)"
and
ga_comm_inf [rule_format] :
"ALL (x :: Real). ALL (y :: Real). inf'(x, y) = inf'(y, x)"
and
ga_comm_sup [rule_format] :
"ALL (x :: Real). ALL (y :: Real). sup'(x, y) = sup'(y, x)"
and
inf_def_ExtPartialOrder [rule_format] :
"ALL (x :: Real).
 ALL (y :: Real).
 ALL (z :: Real).
 inf'(x, y) = makePartial z =
 (z <=' x &
  z <=' y & (ALL (t :: Real). t <=' x & t <=' y --> t <=' z))"
and
sup_def_ExtPartialOrder [rule_format] :
"ALL (x :: Real).
 ALL (y :: Real).
 ALL (z :: Real).
 sup'(x, y) = makePartial z =
 (x <=' z &
  y <=' z & (ALL (t :: Real). x <=' t & y <=' t --> z <=' t))"
and
geq_def_ExtPartialOrder [rule_format] :
"ALL (x :: Real). ALL (y :: Real). (x >=' y) = (y <=' x)"
and
less_def_ExtPartialOrder [rule_format] :
"ALL (x :: Real). ALL (y :: Real). (x <' y) = (x <=' y & ~ x = y)"
and
greater_def_ExtPartialOrder [rule_format] :
"ALL (x :: Real). ALL (y :: Real). (x >' y) = (y <' x)"

declare EMSCB_rep_pos [simp]
declare EMSCB_center [simp]
declare EMSCB_rep_0 [simp]
declare MS_pos [simp]
declare MS_zero [simp]
declare MS_pos_definite [simp]
declare MS_triangle [simp]
declare one_greater_zero [simp]
declare zero_leq_one [simp]
declare half_plus_minus [simp]
declare sub_leq [simp]
declare half_leq_zero [simp]
declare Real_minus_half [simp]
declare Real_half_monot [simp]
declare Real_divide_dom [simp]
declare Real_half_idef [simp]
declare completeness [simp]
declare Real_inj_0 [simp]
declare FWO_plus_right [simp]
declare FWO_plus_left [simp]
declare Field_unary_minus_idef [simp]
declare refl [simp]
declare min_inf_relation [simp]
declare max_sup_relation [simp]
declare ga_comm_min [simp]
declare ga_comm_max [simp]
declare ga_assoc_min [simp]
declare ga_assoc_max [simp]
declare ga_left_comm_min [simp]
declare ga_left_comm_max [simp]
declare ga_comm_inf [simp]
declare ga_comm_sup [simp]

theorem C_non_null :
"ALL (x :: ClosedBall). ALL (y :: ClosedBall). x C y --> x C x"
using Ax1 C_def Real_abs_def Real_sqr_def Real_sqrt_idef Real_2_def
      Real_minus_def Real_divide_idef Real_half_idef Real_ub_def
      Real_lb_def Real_inf_def Real_sup_def Real_isBounded_def
      Field_unary_minus_idef
by (auto)

setup "Header.record \"C_non_null\""

theorem C_sym :
"ALL (x :: ClosedBall). ALL (y :: ClosedBall). x C y --> y C x"
using Ax1 C_def Real_abs_def Real_sqr_def Real_sqrt_idef Real_2_def
      Real_minus_def Real_divide_idef Real_half_idef Real_ub_def
      Real_lb_def Real_inf_def Real_sup_def Real_isBounded_def
      Field_unary_minus_idef
by (auto)

setup "Header.record \"C_sym\""

lemma impLemma : "[| A; A==>B; B-->D|] ==> D"
by auto

lemma reflLemma : "x=y ==> x <=' y"
using refl by auto

lemma MS_triangle_rev :
"d(x, z) <=' (d(x, y) +' d(z, y))"
by (simp add: MS_symm)

lemma EMSCB_rep_pos1 : "rep (closedBall(x, r)) y \<Longrightarrow> r >' 0'' \<longrightarrow> d(x, y) <=' r"
by auto

lemma C_id_lemma : "!!x y xa.
       ALL z. (EX s. rep z s & rep x s) = (EX s. rep z s & rep y s)
       ==> rep x xa ==> rep y xa"
apply (erule contrapos_pp)
apply (subst not_all)
apply (insert Ax4 [THEN allI, of "%x. x"])
apply (frule_tac x="x" in spec)
apply (drule_tac x="y" in spec)
apply (erule exE)+
apply (subst not_iff)
apply (case_tac "ta >' 0''")
apply (rule_tac x="closedBall(xa, half (d(za, xa) -' ta))" in exI)
apply(auto)
apply(drule EMSCB_rep_pos1)+
apply(rule_tac P="d(za, xa) <=' ta" in notE)
apply(assumption)
apply(rule half_leq)
apply(rule trans)
apply(rule conjI)
defer
apply(rule add_monotone)
apply(rule conjI)
apply(erule mp)
back
apply(insert sub_leq)
apply(rule half_gt_zero)
apply(rule sub_leq)
apply(assumption+)

apply(rule_tac x="xa" in exI)
apply simp
apply(rule EMSCB_rep_pos [THEN iffD2])
apply(rule half_gt_zero)
apply(rule sub_leq)
apply(assumption)
apply simp
apply(rule half_leq_zero)
apply(drule sub_leq)
apply(simp add: greater_def_ExtPartialOrder
                less_def_ExtPartialOrder)
apply(rule trans)
apply(rule conjI)
defer
apply(rule MS_triangle_rev)
apply(rule reflLemma)
apply(rule MS_symm)
done

theorem C_id :
"ALL (x :: ClosedBall).
 ALL (y :: ClosedBall).
 (ALL (z :: ClosedBall). (z C x) = (z C y)) --> x = y"
apply (auto simp add: C_def)
apply (rule EMSCB_rep_inj)
apply (rule ext)
apply (auto)
apply (rule_tac x="x" in C_id_lemma)
apply(auto)
apply (rule_tac x="y" in C_id_lemma)
apply(auto)
done

setup "Header.record \"C_id\""

theorem C_non_triv : "EX (x :: ClosedBall). x C x"
apply (simp add: C_def)
apply (rule exI)+
apply (rule EMSCB_rep_pos [THEN iffD2])
apply(rule one_greater_zero)
apply(rule iffD2)
apply(rule arg_cong)
back
back
defer
apply(rule zero_leq_one)
apply auto
done

setup "Header.record \"C_non_triv\""

end


(*  Title:      HOL/Auth/NS_Shared.thy
    Author:     Lawrence C Paulson and Giampaolo Bella
    Copyright   1996  University of Cambridge
*)

section\<open>Needham-Schroeder Shared-Key Protocol\<close>

theory NS_Shared imports Public begin

text\<open>
From page 247 of
  Burrows, Abadi and Needham (1989).  A Logic of Authentication.
  Proc. Royal Soc. 426
\<close>

definition
 (* A is the true creator of X if she has sent X and X never appeared on
    the trace before this event. Recall that traces grow from head. *)
  Issues :: "[agent, agent, msg, event list] \<Rightarrow> bool"
             ("_ Issues _ with _ on _") where
   "A Issues B with X on evs =
      (\<exists>Y. Says A B Y \<in> set evs \<and> X \<in> parts {Y} \<and>
        X \<notin> parts (spies (takeWhile (\<lambda>z. z  \<noteq> Says A B Y) (rev evs))))"

inductive_set ns_shared :: "event list set"
 where
        (*Initial trace is empty*)
  Nil:  "[] \<in> ns_shared"
        (*The spy MAY say anything he CAN say.  We do not expect him to
          invent new nonces here, but he can also use NS1.  Common to
          all similar protocols.*)
| Fake: "\<lbrakk>evsf \<in> ns_shared;  X \<in> synth (analz (spies evsf))\<rbrakk>
         \<Longrightarrow> Says Spy B X # evsf \<in> ns_shared"

        (*Alice initiates a protocol run, requesting to talk to any B*)
| NS1:  "\<lbrakk>evs1 \<in> ns_shared;  Nonce NA \<notin> used evs1\<rbrakk>
         \<Longrightarrow> Says A Server \<lbrace>Agent A, Agent B, Nonce NA\<rbrace> # evs1  \<in>  ns_shared"

        (*Server's response to Alice's message.
          !! It may respond more than once to A's request !!
          Server doesn't know who the true sender is, hence the A' in
              the sender field.*)
| NS2:  "\<lbrakk>evs2 \<in> ns_shared;  Key KAB \<notin> used evs2;  KAB \<in> symKeys;
          Says A' Server \<lbrace>Agent A, Agent B, Nonce NA\<rbrace> \<in> set evs2\<rbrakk>
         \<Longrightarrow> Says Server A
               (Crypt (shrK A)
                  \<lbrace>Nonce NA, Agent B, Key KAB,
                    (Crypt (shrK B) \<lbrace>Key KAB, Agent A\<rbrace>)\<rbrace>)
               # evs2 \<in> ns_shared"

         (*We can't assume S=Server.  Agent A "remembers" her nonce.
           Need A \<noteq> Server because we allow messages to self.*)
| NS3:  "\<lbrakk>evs3 \<in> ns_shared;  A \<noteq> Server;
          Says S A (Crypt (shrK A) \<lbrace>Nonce NA, Agent B, Key K, X\<rbrace>) \<in> set evs3;
          Says A Server \<lbrace>Agent A, Agent B, Nonce NA\<rbrace> \<in> set evs3\<rbrakk>
         \<Longrightarrow> Says A B X # evs3 \<in> ns_shared"

        (*Bob's nonce exchange.  He does not know who the message came
          from, but responds to A because she is mentioned inside.*)
| NS4:  "\<lbrakk>evs4 \<in> ns_shared;  Nonce NB \<notin> used evs4;  K \<in> symKeys;
          Says A' B (Crypt (shrK B) \<lbrace>Key K, Agent A\<rbrace>) \<in> set evs4\<rbrakk>
         \<Longrightarrow> Says B A (Crypt K (Nonce NB)) # evs4 \<in> ns_shared"

        (*Alice responds with Nonce NB if she has seen the key before.
          Maybe should somehow check Nonce NA again.
          We do NOT send NB-1 or similar as the Spy cannot spoof such things.
          Letting the Spy add or subtract 1 lets him send all nonces.
          Instead we distinguish the messages by sending the nonce twice.*)
| NS5:  "\<lbrakk>evs5 \<in> ns_shared;  K \<in> symKeys;
          Says B' A (Crypt K (Nonce NB)) \<in> set evs5;
          Says S  A (Crypt (shrK A) \<lbrace>Nonce NA, Agent B, Key K, X\<rbrace>)
            \<in> set evs5\<rbrakk>
         \<Longrightarrow> Says A B (Crypt K \<lbrace>Nonce NB, Nonce NB\<rbrace>) # evs5 \<in> ns_shared"

        (*This message models possible leaks of session keys.
          The two Nonces identify the protocol run: the rule insists upon
          the true senders in order to make them accurate.*)
| Oops: "\<lbrakk>evso \<in> ns_shared;  Says B A (Crypt K (Nonce NB)) \<in> set evso;
          Says Server A (Crypt (shrK A) \<lbrace>Nonce NA, Agent B, Key K, X\<rbrace>)
              \<in> set evso\<rbrakk>
         \<Longrightarrow> Notes Spy \<lbrace>Nonce NA, Nonce NB, Key K\<rbrace> # evso \<in> ns_shared"

declare Says_imp_knows_Spy [THEN parts.Inj, dest]
declare parts.Body  [dest]
declare Fake_parts_insert_in_Un  [dest]
declare analz_into_parts [dest]

text\<open>A "possibility property": there are traces that reach the end\<close>
lemma "\<lbrakk>A \<noteq> Server; Key K \<notin> used []; K \<in> symKeys\<rbrakk>
       \<Longrightarrow> \<exists>N. \<exists>evs \<in> ns_shared.
                    Says A B (Crypt K \<lbrace>Nonce N, Nonce N\<rbrace>) \<in> set evs"
apply (intro exI bexI)
apply (rule_tac [2] ns_shared.Nil
       [THEN ns_shared.NS1, THEN ns_shared.NS2, THEN ns_shared.NS3,
        THEN ns_shared.NS4, THEN ns_shared.NS5])
apply (possibility, simp add: used_Cons)
done

(*This version is similar, while instantiating ?K and ?N to epsilon-terms
lemma "A \<noteq> Server \<Longrightarrow> \<exists>evs \<in> ns_shared.
                Says A B (Crypt ?K \<lbrace>Nonce ?N, Nonce ?N\<rbrace>) \<in> set evs"
*)

subsection\<open>Inductive proofs about \<^term>\<open>ns_shared\<close>\<close>

subsubsection\<open>Forwarding lemmas, to aid simplification\<close>

text\<open>For reasoning about the encrypted portion of message NS3\<close>
lemma NS3_msg_in_parts_spies:
     "Says S A (Crypt KA \<lbrace>N, B, K, X\<rbrace>) \<in> set evs \<Longrightarrow> X \<in> parts (spies evs)"
by blast

text\<open>For reasoning about the Oops message\<close>
lemma Oops_parts_spies:
     "Says Server A (Crypt (shrK A) \<lbrace>NA, B, K, X\<rbrace>) \<in> set evs
            \<Longrightarrow> K \<in> parts (spies evs)"
by blast

text\<open>Theorems of the form \<^term>\<open>X \<notin> parts (spies evs)\<close> imply that NOBODY
    sends messages containing \<^term>\<open>X\<close>\<close>

text\<open>Spy never sees another agent's shared key! (unless it's bad at start)\<close>
lemma Spy_see_shrK [simp]:
     "evs \<in> ns_shared \<Longrightarrow> (Key (shrK A) \<in> parts (spies evs)) = (A \<in> bad)"
apply (erule ns_shared.induct, force, drule_tac [4] NS3_msg_in_parts_spies, simp_all, blast+)
done

lemma Spy_analz_shrK [simp]:
     "evs \<in> ns_shared \<Longrightarrow> (Key (shrK A) \<in> analz (spies evs)) = (A \<in> bad)"
by auto

text\<open>Nobody can have used non-existent keys!\<close>
lemma new_keys_not_used [simp]:
    "\<lbrakk>Key K \<notin> used evs; K \<in> symKeys; evs \<in> ns_shared\<rbrakk>
     \<Longrightarrow> K \<notin> keysFor (parts (spies evs))"
apply (erule rev_mp)
apply (erule ns_shared.induct, force, drule_tac [4] NS3_msg_in_parts_spies, simp_all)
txt\<open>Fake, NS2, NS4, NS5\<close>
apply (force dest!: keysFor_parts_insert, blast+)
done

subsubsection\<open>Lemmas concerning the form of items passed in messages\<close>

text\<open>Describes the form of K, X and K' when the Server sends this message.\<close>
lemma Says_Server_message_form:
     "\<lbrakk>Says Server A (Crypt K' \<lbrace>N, Agent B, Key K, X\<rbrace>) \<in> set evs;
       evs \<in> ns_shared\<rbrakk>
      \<Longrightarrow> K \<notin> range shrK \<and>
          X = (Crypt (shrK B) \<lbrace>Key K, Agent A\<rbrace>) \<and>
          K' = shrK A"
by (erule rev_mp, erule ns_shared.induct, auto)

text\<open>If the encrypted message appears then it originated with the Server\<close>
lemma A_trusts_NS2:
     "\<lbrakk>Crypt (shrK A) \<lbrace>NA, Agent B, Key K, X\<rbrace> \<in> parts (spies evs);
       A \<notin> bad;  evs \<in> ns_shared\<rbrakk>
      \<Longrightarrow> Says Server A (Crypt (shrK A) \<lbrace>NA, Agent B, Key K, X\<rbrace>) \<in> set evs"
apply (erule rev_mp)
apply (erule ns_shared.induct, force, drule_tac [4] NS3_msg_in_parts_spies, auto)
done

lemma cert_A_form:
     "\<lbrakk>Crypt (shrK A) \<lbrace>NA, Agent B, Key K, X\<rbrace> \<in> parts (spies evs);
       A \<notin> bad;  evs \<in> ns_shared\<rbrakk>
      \<Longrightarrow> K \<notin> range shrK \<and>  X = (Crypt (shrK B) \<lbrace>Key K, Agent A\<rbrace>)"
by (blast dest!: A_trusts_NS2 Says_Server_message_form)

text\<open>EITHER describes the form of X when the following message is sent,
  OR     reduces it to the Fake case.
  Use \<open>Says_Server_message_form\<close> if applicable.\<close>
lemma Says_S_message_form:
     "\<lbrakk>Says S A (Crypt (shrK A) \<lbrace>Nonce NA, Agent B, Key K, X\<rbrace>) \<in> set evs;
       evs \<in> ns_shared\<rbrakk>
      \<Longrightarrow> (K \<notin> range shrK \<and> X = (Crypt (shrK B) \<lbrace>Key K, Agent A\<rbrace>))
          \<or> X \<in> analz (spies evs)"
by (blast dest: Says_imp_knows_Spy analz_shrK_Decrypt cert_A_form analz.Inj)

(*Alternative version also provable
lemma Says_S_message_form2:
  "\<lbrakk>Says S A (Crypt (shrK A) \<lbrace>Nonce NA, Agent B, Key K, X\<rbrace>) \<in> set evs;
    evs \<in> ns_shared\<rbrakk>
   \<Longrightarrow> Says Server A (Crypt (shrK A) \<lbrace>Nonce NA, Agent B, Key K, X\<rbrace>) \<in> set evs
       \<or> X \<in> analz (spies evs)"
apply (case_tac "A \<in> bad")
apply (force dest!: Says_imp_knows_Spy [THEN analz.Inj])
by (blast dest!: A_trusts_NS2 Says_Server_message_form)
*)

(****
 SESSION KEY COMPROMISE THEOREM.  To prove theorems of the form

  Key K \<in> analz (insert (Key KAB) (spies evs)) \<Longrightarrow>
  Key K \<in> analz (spies evs)

 A more general formula must be proved inductively.
****)

text\<open>NOT useful in this form, but it says that session keys are not used
  to encrypt messages containing other keys, in the actual protocol.
  We require that agents should behave like this subsequently also.\<close>
lemma  "\<lbrakk>evs \<in> ns_shared;  Kab \<notin> range shrK\<rbrakk> \<Longrightarrow>
         (Crypt KAB X) \<in> parts (spies evs) \<and>
         Key K \<in> parts {X} \<longrightarrow> Key K \<in> parts (spies evs)"
apply (erule ns_shared.induct, force, drule_tac [4] NS3_msg_in_parts_spies, simp_all)
txt\<open>Fake\<close>
apply (blast dest: parts_insert_subset_Un)
txt\<open>Base, NS4 and NS5\<close>
apply auto
done

subsubsection\<open>Session keys are not used to encrypt other session keys\<close>

text\<open>The equality makes the induction hypothesis easier to apply\<close>

lemma analz_image_freshK [rule_format]:
 "evs \<in> ns_shared \<Longrightarrow>
   \<forall>K KK. KK \<subseteq> - (range shrK) \<longrightarrow>
             (Key K \<in> analz (Key`KK \<union> (spies evs))) =
             (K \<in> KK \<or> Key K \<in> analz (spies evs))"
apply (erule ns_shared.induct)
apply (drule_tac [8] Says_Server_message_form)
apply (erule_tac [5] Says_S_message_form [THEN disjE], analz_freshK, spy_analz)
txt\<open>NS2, NS3\<close>
apply blast+
done

lemma analz_insert_freshK:
     "\<lbrakk>evs \<in> ns_shared;  KAB \<notin> range shrK\<rbrakk> \<Longrightarrow>
       (Key K \<in> analz (insert (Key KAB) (spies evs))) =
       (K = KAB \<or> Key K \<in> analz (spies evs))"
by (simp only: analz_image_freshK analz_image_freshK_simps)

subsubsection\<open>The session key K uniquely identifies the message\<close>

text\<open>In messages of this form, the session key uniquely identifies the rest\<close>
lemma unique_session_keys:
     "\<lbrakk>Says Server A (Crypt (shrK A) \<lbrace>NA, Agent B, Key K, X\<rbrace>) \<in> set evs;
       Says Server A' (Crypt (shrK A') \<lbrace>NA', Agent B', Key K, X'\<rbrace>) \<in> set evs;
       evs \<in> ns_shared\<rbrakk> \<Longrightarrow> A=A' \<and> NA=NA' \<and> B=B' \<and> X = X'"
by (erule rev_mp, erule rev_mp, erule ns_shared.induct, simp_all, blast+)

subsubsection\<open>Crucial secrecy property: Spy doesn't see the keys sent in NS2\<close>

text\<open>Beware of \<open>[rule_format]\<close> and the universal quantifier!\<close>
lemma secrecy_lemma:
     "\<lbrakk>Says Server A (Crypt (shrK A) \<lbrace>NA, Agent B, Key K,
                                      Crypt (shrK B) \<lbrace>Key K, Agent A\<rbrace>\<rbrace>)
              \<in> set evs;
         A \<notin> bad;  B \<notin> bad;  evs \<in> ns_shared\<rbrakk>
      \<Longrightarrow> (\<forall>NB. Notes Spy \<lbrace>NA, NB, Key K\<rbrace> \<notin> set evs) \<longrightarrow>
         Key K \<notin> analz (spies evs)"
apply (erule rev_mp)
apply (erule ns_shared.induct, force)
apply (frule_tac [7] Says_Server_message_form)
apply (frule_tac [4] Says_S_message_form)
apply (erule_tac [5] disjE)
apply (simp_all add: analz_insert_eq analz_insert_freshK pushes split_ifs, spy_analz)
txt\<open>NS2\<close>
apply blast
txt\<open>NS3\<close>
apply (blast dest!: Crypt_Spy_analz_bad A_trusts_NS2
             dest:  Says_imp_knows_Spy analz.Inj unique_session_keys)
txt\<open>Oops\<close>
apply (blast dest: unique_session_keys)
done

text\<open>Final version: Server's message in the most abstract form\<close>
lemma Spy_not_see_encrypted_key:
     "\<lbrakk>Says Server A (Crypt K' \<lbrace>NA, Agent B, Key K, X\<rbrace>) \<in> set evs;
       \<forall>NB. Notes Spy \<lbrace>NA, NB, Key K\<rbrace> \<notin> set evs;
       A \<notin> bad;  B \<notin> bad;  evs \<in> ns_shared\<rbrakk>
      \<Longrightarrow> Key K \<notin> analz (spies evs)"
by (blast dest: Says_Server_message_form secrecy_lemma)

subsection\<open>Guarantees available at various stages of protocol\<close>

text\<open>If the encrypted message appears then it originated with the Server\<close>
lemma B_trusts_NS3:
     "\<lbrakk>Crypt (shrK B) \<lbrace>Key K, Agent A\<rbrace> \<in> parts (spies evs);
       B \<notin> bad;  evs \<in> ns_shared\<rbrakk>
      \<Longrightarrow> \<exists>NA. Says Server A
               (Crypt (shrK A) \<lbrace>NA, Agent B, Key K,
                                 Crypt (shrK B) \<lbrace>Key K, Agent A\<rbrace>\<rbrace>)
              \<in> set evs"
apply (erule rev_mp)
apply (erule ns_shared.induct, force, drule_tac [4] NS3_msg_in_parts_spies, auto)
done

lemma A_trusts_NS4_lemma [rule_format]:
   "evs \<in> ns_shared \<Longrightarrow>
      Key K \<notin> analz (spies evs) \<longrightarrow>
      Says Server A (Crypt (shrK A) \<lbrace>NA, Agent B, Key K, X\<rbrace>) \<in> set evs \<longrightarrow>
      Crypt K (Nonce NB) \<in> parts (spies evs) \<longrightarrow>
      Says B A (Crypt K (Nonce NB)) \<in> set evs"
apply (erule ns_shared.induct, force, drule_tac [4] NS3_msg_in_parts_spies)
apply (analz_mono_contra, simp_all, blast)
txt\<open>NS2: contradiction from the assumptions \<^term>\<open>Key K \<notin> used evs2\<close> and
    \<^term>\<open>Crypt K (Nonce NB) \<in> parts (spies evs2)\<close>\<close>
apply (force dest!: Crypt_imp_keysFor)
txt\<open>NS4\<close>
apply (metis B_trusts_NS3 Crypt_Spy_analz_bad Says_imp_analz_Spy Says_imp_parts_knows_Spy analz.Fst unique_session_keys)
done

text\<open>This version no longer assumes that K is secure\<close>
lemma A_trusts_NS4:
     "\<lbrakk>Crypt K (Nonce NB) \<in> parts (spies evs);
       Crypt (shrK A) \<lbrace>NA, Agent B, Key K, X\<rbrace> \<in> parts (spies evs);
       \<forall>NB. Notes Spy \<lbrace>NA, NB, Key K\<rbrace> \<notin> set evs;
       A \<notin> bad;  B \<notin> bad;  evs \<in> ns_shared\<rbrakk>
      \<Longrightarrow> Says B A (Crypt K (Nonce NB)) \<in> set evs"
by (blast intro: A_trusts_NS4_lemma
          dest: A_trusts_NS2 Spy_not_see_encrypted_key)

text\<open>If the session key has been used in NS4 then somebody has forwarded
  component X in some instance of NS4.  Perhaps an interesting property,
  but not needed (after all) for the proofs below.\<close>
theorem NS4_implies_NS3 [rule_format]:
  "evs \<in> ns_shared \<Longrightarrow>
     Key K \<notin> analz (spies evs) \<longrightarrow>
     Says Server A (Crypt (shrK A) \<lbrace>NA, Agent B, Key K, X\<rbrace>) \<in> set evs \<longrightarrow>
     Crypt K (Nonce NB) \<in> parts (spies evs) \<longrightarrow>
     (\<exists>A'. Says A' B X \<in> set evs)"
apply (erule ns_shared.induct, force)
apply (drule_tac [4] NS3_msg_in_parts_spies)
apply analz_mono_contra
apply (simp_all add: ex_disj_distrib, blast)
txt\<open>NS2\<close>
apply (blast dest!: new_keys_not_used Crypt_imp_keysFor)
txt\<open>NS4\<close>
apply (metis B_trusts_NS3 Crypt_Spy_analz_bad Says_imp_analz_Spy Says_imp_parts_knows_Spy analz.Fst unique_session_keys)
done

lemma B_trusts_NS5_lemma [rule_format]:
  "\<lbrakk>B \<notin> bad;  evs \<in> ns_shared\<rbrakk> \<Longrightarrow>
     Key K \<notin> analz (spies evs) \<longrightarrow>
     Says Server A
          (Crypt (shrK A) \<lbrace>NA, Agent B, Key K,
                            Crypt (shrK B) \<lbrace>Key K, Agent A\<rbrace>\<rbrace>) \<in> set evs \<longrightarrow>
     Crypt K \<lbrace>Nonce NB, Nonce NB\<rbrace> \<in> parts (spies evs) \<longrightarrow>
     Says A B (Crypt K \<lbrace>Nonce NB, Nonce NB\<rbrace>) \<in> set evs"
apply (erule ns_shared.induct, force)
apply (drule_tac [4] NS3_msg_in_parts_spies)
apply (analz_mono_contra, simp_all, blast)
txt\<open>NS2\<close>
apply (blast dest!: new_keys_not_used Crypt_imp_keysFor)
txt\<open>NS5\<close>
apply (blast dest!: A_trusts_NS2
             dest: Says_imp_knows_Spy [THEN analz.Inj]
                   unique_session_keys Crypt_Spy_analz_bad)
done

text\<open>Very strong Oops condition reveals protocol's weakness\<close>
lemma B_trusts_NS5:
     "\<lbrakk>Crypt K \<lbrace>Nonce NB, Nonce NB\<rbrace> \<in> parts (spies evs);
       Crypt (shrK B) \<lbrace>Key K, Agent A\<rbrace> \<in> parts (spies evs);
       \<forall>NA NB. Notes Spy \<lbrace>NA, NB, Key K\<rbrace> \<notin> set evs;
       A \<notin> bad;  B \<notin> bad;  evs \<in> ns_shared\<rbrakk>
      \<Longrightarrow> Says A B (Crypt K \<lbrace>Nonce NB, Nonce NB\<rbrace>) \<in> set evs"
by (blast intro: B_trusts_NS5_lemma
          dest: B_trusts_NS3 Spy_not_see_encrypted_key)

text\<open>Unaltered so far wrt original version\<close>

subsection\<open>Lemmas for reasoning about predicate "Issues"\<close>

lemma spies_Says_rev: "spies (evs @ [Says A B X]) = insert X (spies evs)"
apply (induct_tac "evs")
apply (rename_tac [2] a b)
apply (induct_tac [2] "a", auto)
done

lemma spies_Gets_rev: "spies (evs @ [Gets A X]) = spies evs"
apply (induct_tac "evs")
apply (rename_tac [2] a b)
apply (induct_tac [2] "a", auto)
done

lemma spies_Notes_rev: "spies (evs @ [Notes A X]) =
          (if A\<in>bad then insert X (spies evs) else spies evs)"
apply (induct_tac "evs")
apply (rename_tac [2] a b)
apply (induct_tac [2] "a", auto)
done

lemma spies_evs_rev: "spies evs = spies (rev evs)"
apply (induct_tac "evs")
apply (rename_tac [2] a b)
apply (induct_tac [2] "a")
apply (simp_all (no_asm_simp) add: spies_Says_rev spies_Gets_rev spies_Notes_rev)
done

lemmas parts_spies_evs_revD2 = spies_evs_rev [THEN equalityD2, THEN parts_mono]

lemma spies_takeWhile: "spies (takeWhile P evs) \<subseteq> spies evs"
apply (induct_tac "evs")
apply (rename_tac [2] a b)
apply (induct_tac [2] "a", auto)
txt\<open>Resembles \<open>used_subset_append\<close> in theory Event.\<close>
done

lemmas parts_spies_takeWhile_mono = spies_takeWhile [THEN parts_mono]

subsection\<open>Guarantees of non-injective agreement on the session key, and
of key distribution. They also express forms of freshness of certain messages,
namely that agents were alive after something happened.\<close>

lemma B_Issues_A:
     "\<lbrakk> Says B A (Crypt K (Nonce Nb)) \<in> set evs;
         Key K \<notin> analz (spies evs);
         A \<notin> bad;  B \<notin> bad; evs \<in> ns_shared \<rbrakk>
      \<Longrightarrow> B Issues A with (Crypt K (Nonce Nb)) on evs"
unfolding Issues_def
apply (rule exI)
apply (rule conjI, assumption)
apply (simp (no_asm))
apply (erule rev_mp)
apply (erule rev_mp)
apply (erule ns_shared.induct, analz_mono_contra)
apply (simp_all)
txt\<open>fake\<close>
apply blast
apply (simp_all add: takeWhile_tail)
txt\<open>NS3 remains by pure coincidence!\<close>
apply (force dest!: A_trusts_NS2 Says_Server_message_form)
txt\<open>NS4 would be the non-trivial case can be solved by Nb being used\<close>
apply (blast dest: parts_spies_takeWhile_mono [THEN subsetD]
                   parts_spies_evs_revD2 [THEN subsetD])
done

text\<open>Tells A that B was alive after she sent him the session key.  The
session key must be assumed confidential for this deduction to be meaningful,
but that assumption can be relaxed by the appropriate argument.

Precisely, the theorem guarantees (to A) key distribution of the session key
to B. It also guarantees (to A) non-injective agreement of B with A on the
session key. Both goals are available to A in the sense of Goal Availability.
\<close>
lemma A_authenticates_and_keydist_to_B:
     "\<lbrakk>Crypt K (Nonce NB) \<in> parts (spies evs);
       Crypt (shrK A) \<lbrace>NA, Agent B, Key K, X\<rbrace> \<in> parts (spies evs);
       Key K \<notin> analz(knows Spy evs);
       A \<notin> bad;  B \<notin> bad;  evs \<in> ns_shared\<rbrakk>
      \<Longrightarrow> B Issues A with (Crypt K (Nonce NB)) on evs"
by (blast intro: A_trusts_NS4_lemma B_Issues_A dest: A_trusts_NS2)

lemma A_trusts_NS5:
  "\<lbrakk> Crypt K \<lbrace>Nonce NB, Nonce NB\<rbrace> \<in> parts(spies evs);
     Crypt (shrK A) \<lbrace>Nonce NA, Agent B, Key K, X\<rbrace> \<in> parts(spies evs);
     Key K \<notin> analz (spies evs);
     A \<notin> bad; B \<notin> bad; evs \<in> ns_shared \<rbrakk>
 \<Longrightarrow> Says A B (Crypt K \<lbrace>Nonce NB, Nonce NB\<rbrace>) \<in> set evs"
apply (erule rev_mp)
apply (erule rev_mp)
apply (erule rev_mp)
apply (erule ns_shared.induct, analz_mono_contra)
apply (simp_all)
txt\<open>Fake\<close>
apply blast
txt\<open>NS2\<close>
apply (force dest!: Crypt_imp_keysFor)
txt\<open>NS3\<close>
apply (metis NS3_msg_in_parts_spies parts_cut_eq)
txt\<open>NS5, the most important case, can be solved by unicity\<close>
apply (metis A_trusts_NS2 Crypt_Spy_analz_bad Says_imp_analz_Spy Says_imp_parts_knows_Spy analz.Fst analz.Snd unique_session_keys)
done

lemma A_Issues_B:
     "\<lbrakk> Says A B (Crypt K \<lbrace>Nonce NB, Nonce NB\<rbrace>) \<in> set evs;
        Key K \<notin> analz (spies evs);
        A \<notin> bad;  B \<notin> bad; evs \<in> ns_shared \<rbrakk>
    \<Longrightarrow> A Issues B with (Crypt K \<lbrace>Nonce NB, Nonce NB\<rbrace>) on evs"
unfolding Issues_def
apply (rule exI)
apply (rule conjI, assumption)
apply (simp (no_asm))
apply (erule rev_mp)
apply (erule rev_mp)
apply (erule ns_shared.induct, analz_mono_contra)
apply (simp_all)
txt\<open>fake\<close>
apply blast
apply (simp_all add: takeWhile_tail)
txt\<open>NS3 remains by pure coincidence!\<close>
apply (force dest!: A_trusts_NS2 Says_Server_message_form)
txt\<open>NS5 is the non-trivial case and cannot be solved as in \<^term>\<open>B_Issues_A\<close>! because NB is not fresh. We need \<^term>\<open>A_trusts_NS5\<close>, proved for this very purpose\<close>
apply (blast dest: A_trusts_NS5 parts_spies_takeWhile_mono [THEN subsetD]
        parts_spies_evs_revD2 [THEN subsetD])
done

text\<open>Tells B that A was alive after B issued NB.

Precisely, the theorem guarantees (to B) key distribution of the session key to A. It also guarantees (to B) non-injective agreement of A with B on the session key. Both goals are available to B in the sense of Goal Availability.
\<close>
lemma B_authenticates_and_keydist_to_A:
     "\<lbrakk>Crypt K \<lbrace>Nonce NB, Nonce NB\<rbrace> \<in> parts (spies evs);
       Crypt (shrK B) \<lbrace>Key K, Agent A\<rbrace> \<in> parts (spies evs);
       Key K \<notin> analz (spies evs);
       A \<notin> bad;  B \<notin> bad;  evs \<in> ns_shared\<rbrakk>
   \<Longrightarrow> A Issues B with (Crypt K \<lbrace>Nonce NB, Nonce NB\<rbrace>) on evs"
by (blast intro: A_Issues_B B_trusts_NS5_lemma dest: B_trusts_NS3)

end