(*  Title:      HOL/Auth/OtwayRees_Bad.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Copyright   1996  University of Cambridge
*)

section\<open>The Otway-Rees Protocol: The Faulty BAN Version\<close>

theory OtwayRees_Bad imports Public begin

text\<open>The FAULTY version omitting encryption of Nonce NB, as suggested on
page 247 of
  Burrows, Abadi and Needham (1988).  A Logic of Authentication.
  Proc. Royal Soc. 426

This file illustrates the consequences of such errors.  We can still prove
impressive-looking properties such as \<open>Spy_not_see_encrypted_key\<close>, yet
the protocol is open to a middleperson attack.  Attempting to prove some key
lemmas indicates the possibility of this attack.\<close>

inductive_set otway :: "event list set"
  where
   Nil: \<comment> \<open>The empty trace\<close>
        "[] \<in> otway"

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

 | Reception: \<comment> \<open>A message that has been sent can be received by the
                  intended recipient.\<close>
              "\<lbrakk>evsr \<in> otway;  Says A B X \<in>set evsr\<rbrakk>
               \<Longrightarrow> Gets B X # evsr \<in> otway"

 | OR1:  \<comment> \<open>Alice initiates a protocol run\<close>
         "\<lbrakk>evs1 \<in> otway;  Nonce NA \<notin> used evs1\<rbrakk>
          \<Longrightarrow> Says A B \<lbrace>Nonce NA, Agent A, Agent B,
                         Crypt (shrK A) \<lbrace>Nonce NA, Agent A, Agent B\<rbrace>\<rbrace>
                 # evs1 \<in> otway"

 | OR2:  \<comment> \<open>Bob's response to Alice's message.
             This variant of the protocol does NOT encrypt NB.\<close>
         "\<lbrakk>evs2 \<in> otway;  Nonce NB \<notin> used evs2;
             Gets B \<lbrace>Nonce NA, Agent A, Agent B, X\<rbrace> \<in> set evs2\<rbrakk>
          \<Longrightarrow> Says B Server
                  \<lbrace>Nonce NA, Agent A, Agent B, X, Nonce NB,
                    Crypt (shrK B) \<lbrace>Nonce NA, Agent A, Agent B\<rbrace>\<rbrace>
                 # evs2 \<in> otway"

 | OR3:  \<comment> \<open>The Server receives Bob's message and checks that the three NAs
           match.  Then he sends a new session key to Bob with a packet for
           forwarding to Alice.\<close>
         "\<lbrakk>evs3 \<in> otway;  Key KAB \<notin> used evs3;
             Gets Server
                  \<lbrace>Nonce NA, Agent A, Agent B,
                    Crypt (shrK A) \<lbrace>Nonce NA, Agent A, Agent B\<rbrace>,
                    Nonce NB,
                    Crypt (shrK B) \<lbrace>Nonce NA, Agent A, Agent B\<rbrace>\<rbrace>
               \<in> set evs3\<rbrakk>
          \<Longrightarrow> Says Server B
                  \<lbrace>Nonce NA,
                    Crypt (shrK A) \<lbrace>Nonce NA, Key KAB\<rbrace>,
                    Crypt (shrK B) \<lbrace>Nonce NB, Key KAB\<rbrace>\<rbrace>
                 # evs3 \<in> otway"

 | OR4:  \<comment> \<open>Bob receives the Server's (?) message and compares the Nonces with
             those in the message he previously sent the Server.
             Need \<^term>\<open>B \<noteq> Server\<close> because we allow messages to self.\<close>
         "\<lbrakk>evs4 \<in> otway;  B \<noteq> Server;
             Says B Server \<lbrace>Nonce NA, Agent A, Agent B, X', Nonce NB,
                             Crypt (shrK B) \<lbrace>Nonce NA, Agent A, Agent B\<rbrace>\<rbrace>
               \<in> set evs4;
             Gets B \<lbrace>Nonce NA, X, Crypt (shrK B) \<lbrace>Nonce NB, Key K\<rbrace>\<rbrace>
               \<in> set evs4\<rbrakk>
          \<Longrightarrow> Says B A \<lbrace>Nonce NA, X\<rbrace> # evs4 \<in> otway"

 | Oops: \<comment> \<open>This message models possible leaks of session keys.  The nonces
             identify the protocol run.\<close>
         "\<lbrakk>evso \<in> otway;
             Says Server B \<lbrace>Nonce NA, X, Crypt (shrK B) \<lbrace>Nonce NB, Key K\<rbrace>\<rbrace>
               \<in> set evso\<rbrakk>
          \<Longrightarrow> Notes Spy \<lbrace>Nonce NA, Nonce NB, Key K\<rbrace> # evso \<in> otway"

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

text\<open>A "possibility property": there are traces that reach the end\<close>
lemma "\<lbrakk>B \<noteq> Server; Key K \<notin> used []\<rbrakk>
      \<Longrightarrow> \<exists>NA. \<exists>evs \<in> otway.
            Says B A \<lbrace>Nonce NA, Crypt (shrK A) \<lbrace>Nonce NA, Key K\<rbrace>\<rbrace>
              \<in> set evs"
apply (intro exI bexI)
apply (rule_tac [2] otway.Nil
                    [THEN otway.OR1, THEN otway.Reception,
                     THEN otway.OR2, THEN otway.Reception,
                     THEN otway.OR3, THEN otway.Reception, THEN otway.OR4])
apply (possibility, simp add: used_Cons)
done

lemma Gets_imp_Says [dest!]:
     "\<lbrakk>Gets B X \<in> set evs; evs \<in> otway\<rbrakk> \<Longrightarrow> \<exists>A. Says A B X \<in> set evs"
apply (erule rev_mp)
apply (erule otway.induct, auto)
done

subsection\<open>For reasoning about the encrypted portion of messages\<close>

lemma OR2_analz_knows_Spy:
     "\<lbrakk>Gets B \<lbrace>N, Agent A, Agent B, X\<rbrace> \<in> set evs;  evs \<in> otway\<rbrakk>
      \<Longrightarrow> X \<in> analz (knows Spy evs)"
by blast

lemma OR4_analz_knows_Spy:
     "\<lbrakk>Gets B \<lbrace>N, X, Crypt (shrK B) X'\<rbrace> \<in> set evs;  evs \<in> otway\<rbrakk>
      \<Longrightarrow> X \<in> analz (knows Spy evs)"
by blast

lemma Oops_parts_knows_Spy:
     "Says Server B \<lbrace>NA, X, Crypt K' \<lbrace>NB,K\<rbrace>\<rbrace> \<in> set evs
      \<Longrightarrow> K \<in> parts (knows Spy evs)"
by blast

text\<open>Forwarding lemma: see comments in OtwayRees.thy\<close>
lemmas OR2_parts_knows_Spy =
    OR2_analz_knows_Spy [THEN analz_into_parts]

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

text\<open>Spy never sees a good agent's shared key!\<close>
lemma Spy_see_shrK [simp]:
     "evs \<in> otway \<Longrightarrow> (Key (shrK A) \<in> parts (knows Spy evs)) = (A \<in> bad)"
by (erule otway.induct, force,
    drule_tac [4] OR2_parts_knows_Spy, simp_all, blast+)

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

lemma Spy_see_shrK_D [dest!]:
     "\<lbrakk>Key (shrK A) \<in> parts (knows Spy evs);  evs \<in> otway\<rbrakk> \<Longrightarrow> A \<in> bad"
by (blast dest: Spy_see_shrK)

subsection\<open>Proofs involving analz\<close>

text\<open>Describes the form of K and NA when the Server sends this message.  Also
  for Oops case.\<close>
lemma Says_Server_message_form:
     "\<lbrakk>Says Server B \<lbrace>NA, X, Crypt (shrK B) \<lbrace>NB, Key K\<rbrace>\<rbrace> \<in> set evs;
         evs \<in> otway\<rbrakk>
      \<Longrightarrow> K \<notin> range shrK \<and> (\<exists>i. NA = Nonce i) \<and> (\<exists>j. NB = Nonce j)"
apply (erule rev_mp)
apply (erule otway.induct, simp_all)
done

(****
 The following is to prove theorems of the form

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

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

text\<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> otway \<Longrightarrow>
   \<forall>K KK. KK \<subseteq> -(range shrK) \<longrightarrow>
          (Key K \<in> analz (Key`KK \<union> (knows Spy evs))) =
          (K \<in> KK | Key K \<in> analz (knows Spy evs))"
apply (erule otway.induct)
apply (frule_tac [8] Says_Server_message_form)
apply (drule_tac [7] OR4_analz_knows_Spy)
apply (drule_tac [5] OR2_analz_knows_Spy, analz_freshK, spy_analz, auto)
done

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

text\<open>The Key K uniquely identifies the Server's  message.\<close>
lemma unique_session_keys:
     "\<lbrakk>Says Server B \<lbrace>NA, X, Crypt (shrK B) \<lbrace>NB, K\<rbrace>\<rbrace>   \<in> set evs;
         Says Server B' \<lbrace>NA',X',Crypt (shrK B') \<lbrace>NB',K\<rbrace>\<rbrace> \<in> set evs;
         evs \<in> otway\<rbrakk> \<Longrightarrow> X=X' \<and> B=B' \<and> NA=NA' \<and> NB=NB'"
apply (erule rev_mp)
apply (erule rev_mp)
apply (erule otway.induct, simp_all)
apply blast+  \<comment> \<open>OR3 and OR4\<close>
done

text\<open>Crucial secrecy property: Spy does not see the keys sent in msg OR3
    Does not in itself guarantee security: an attack could violate
    the premises, e.g. by having \<^term>\<open>A=Spy\<close>\<close>
lemma secrecy_lemma:
 "\<lbrakk>A \<notin> bad;  B \<notin> bad;  evs \<in> otway\<rbrakk>
  \<Longrightarrow> Says Server B
        \<lbrace>NA, Crypt (shrK A) \<lbrace>NA, Key K\<rbrace>,
          Crypt (shrK B) \<lbrace>NB, Key K\<rbrace>\<rbrace> \<in> set evs \<longrightarrow>
      Notes Spy \<lbrace>NA, NB, Key K\<rbrace> \<notin> set evs \<longrightarrow>
      Key K \<notin> analz (knows Spy evs)"
apply (erule otway.induct, force)
apply (frule_tac [7] Says_Server_message_form)
apply (drule_tac [6] OR4_analz_knows_Spy)
apply (drule_tac [4] OR2_analz_knows_Spy)
apply (simp_all add: analz_insert_eq analz_insert_freshK pushes)
apply spy_analz  \<comment> \<open>Fake\<close>
apply (blast dest: unique_session_keys)+  \<comment> \<open>OR3, OR4, Oops\<close>
done

lemma Spy_not_see_encrypted_key:
     "\<lbrakk>Says Server B
          \<lbrace>NA, Crypt (shrK A) \<lbrace>NA, Key K\<rbrace>,
                Crypt (shrK B) \<lbrace>NB, Key K\<rbrace>\<rbrace> \<in> set evs;
         Notes Spy \<lbrace>NA, NB, Key K\<rbrace> \<notin> set evs;
         A \<notin> bad;  B \<notin> bad;  evs \<in> otway\<rbrakk>
      \<Longrightarrow> Key K \<notin> analz (knows Spy evs)"
by (blast dest: Says_Server_message_form secrecy_lemma)

subsection\<open>Attempting to prove stronger properties\<close>

text\<open>Only OR1 can have caused such a part of a message to appear. The premise
  \<^term>\<open>A \<noteq> B\<close> prevents OR2's similar-looking cryptogram from being picked
  up. Original Otway-Rees doesn't need it.\<close>
lemma Crypt_imp_OR1 [rule_format]:
     "\<lbrakk>A \<notin> bad;  A \<noteq> B;  evs \<in> otway\<rbrakk>
      \<Longrightarrow> Crypt (shrK A) \<lbrace>NA, Agent A, Agent B\<rbrace> \<in> parts (knows Spy evs) \<longrightarrow>
          Says A B \<lbrace>NA, Agent A, Agent B,
                     Crypt (shrK A) \<lbrace>NA, Agent A, Agent B\<rbrace>\<rbrace>  \<in> set evs"
by (erule otway.induct, force,
    drule_tac [4] OR2_parts_knows_Spy, simp_all, blast+)

text\<open>Crucial property: If the encrypted message appears, and A has used NA
  to start a run, then it originated with the Server!
  The premise \<^term>\<open>A \<noteq> B\<close> allows use of \<open>Crypt_imp_OR1\<close>\<close>
text\<open>Only it is FALSE.  Somebody could make a fake message to Server
          substituting some other nonce NA' for NB.\<close>
lemma "\<lbrakk>A \<notin> bad;  A \<noteq> B;  evs \<in> otway\<rbrakk>
       \<Longrightarrow> Crypt (shrK A) \<lbrace>NA, Key K\<rbrace> \<in> parts (knows Spy evs) \<longrightarrow>
           Says A B \<lbrace>NA, Agent A, Agent B,
                      Crypt (shrK A) \<lbrace>NA, Agent A, Agent B\<rbrace>\<rbrace>
            \<in> set evs \<longrightarrow>
           (\<exists>B NB. Says Server B
                \<lbrace>NA,
                  Crypt (shrK A) \<lbrace>NA, Key K\<rbrace>,
                  Crypt (shrK B) \<lbrace>NB, Key K\<rbrace>\<rbrace> \<in> set evs)"
apply (erule otway.induct, force,
       drule_tac [4] OR2_parts_knows_Spy, simp_all)
apply blast  \<comment> \<open>Fake\<close>
apply blast  \<comment> \<open>OR1: it cannot be a new Nonce, contradiction.\<close>
txt\<open>OR3 and OR4\<close>
apply (simp_all add: ex_disj_distrib)
 prefer 2 apply (blast intro!: Crypt_imp_OR1)  \<comment> \<open>OR4\<close>
txt\<open>OR3\<close>
apply clarify
(*The hypotheses at this point suggest an attack in which nonce NB is used
  in two different roles:
          Gets Server
           \<lbrace>Nonce NA, Agent Aa, Agent A,
             Crypt (shrK Aa) \<lbrace>Nonce NA, Agent Aa, Agent A\<rbrace>, Nonce NB,
             Crypt (shrK A) \<lbrace>Nonce NA, Agent Aa, Agent A\<rbrace>\<rbrace>
          \<in> set evs3
          Says A B
           \<lbrace>Nonce NB, Agent A, Agent B,
             Crypt (shrK A) \<lbrace>Nonce NB, Agent A, Agent B\<rbrace>\<rbrace>
          \<in> set evs3;
*)

(*Thus the key property A_can_trust probably fails too.*)
oops

end


section \<open>Example\<close>

text \<open>We provide an example in order to prove that our locale is non-vacuous.
This example corresponds to the computation and associated snapshot described
in Section 4 of~\cite{chandy}.\<close>

theory Example
  imports
    Snapshot

begin

datatype PType = P | Q
datatype MType = M | M'
datatype SType = S_Wait | S_Send | T_Wait | T_Send

fun trans :: "PType \<Rightarrow> SType \<Rightarrow> SType \<Rightarrow> bool" where
  "trans p s s' = False"

fun send :: "channel_id \<Rightarrow> PType \<Rightarrow> PType \<Rightarrow> SType
             \<Rightarrow> SType \<Rightarrow> MType \<Rightarrow> bool" where
  "send c p q s s' m = ((c = 0 \<and> p = P \<and> q = Q
                          \<and> s = S_Send \<and> s' = S_Wait \<and> m = M)
                     \<or> (c = 1 \<and> p = Q \<and> q = P
                          \<and> s = T_Send \<and> s' = T_Wait \<and> m = M'))"

fun recv :: "channel_id \<Rightarrow> PType \<Rightarrow> PType \<Rightarrow> SType
             \<Rightarrow> SType \<Rightarrow> MType \<Rightarrow> bool" where
  "recv c p q s s' m = ((c = 1 \<and> p = P \<and> q = Q
                          \<and> s = S_Wait \<and> s' = S_Send \<and> m = M')
                     \<or> (c = 0 \<and> p = Q \<and> q = P
                          \<and> s = T_Wait \<and> s' = T_Send \<and> m = M))"

fun chan :: "nat \<Rightarrow> (PType * PType) option" where
 "chan n = (if n = 0 then Some (P, Q)
            else if n = 1 then Some (Q, P)
            else None)"

abbreviation init :: "(PType, SType, MType) configuration" where
  "init \<equiv> \<lparr>
       states = (%p. if p = P then S_Send else T_Send),
       msgs = (%d. []),
       process_snapshot = (%p. None),
       channel_snapshot = (%d. ([], NotStarted))
    \<rparr>"

abbreviation t0 where "t0 \<equiv> Snapshot P"

abbreviation s1 :: "(PType, SType, MType) configuration" where
  "s1 \<equiv> \<lparr>
       states = (%p. if p = P then S_Send else T_Send),
       msgs = (%d. if d = 0 then [Marker] else []),
       process_snapshot = (%p. if p = P then Some S_Send else None),
       channel_snapshot = (%d. if d = 1 then ([], Recording) else ([], NotStarted))
    \<rparr>"

abbreviation t1 where "t1 \<equiv> Send 0 P Q S_Send S_Wait M"

abbreviation s2 :: "(PType, SType, MType) configuration" where
  "s2 \<equiv> \<lparr>
       states = (%p. if p = P then S_Wait else T_Send),
       msgs = (%d. if d = 0 then [Marker, Msg M] else []),
       process_snapshot = (%p. if p = P then Some S_Send else None),
       channel_snapshot = (%d. if d = 1 then ([], Recording) else ([], NotStarted))
    \<rparr>"

abbreviation t2 where "t2 \<equiv> Send 1 Q P T_Send T_Wait M'"

abbreviation s3 :: "(PType, SType, MType) configuration" where
  "s3 \<equiv> \<lparr>
       states = (%p. if p = P then S_Wait else T_Wait),
       msgs = (%d. if d = 0 then [Marker, Msg M] else if d = 1 then [Msg M'] else []),
       process_snapshot = (%p. if p = P then Some S_Send else None),
       channel_snapshot = (%d. if d = 1 then ([], Recording) else ([], NotStarted))
    \<rparr>"

abbreviation t3 where "t3 \<equiv> Snapshot Q"

abbreviation s4 :: "(PType, SType, MType) configuration" where
  "s4 \<equiv> \<lparr>
       states = (%p. if p = P then S_Wait else T_Wait),
       msgs = (%d. if d = 0 then [Marker, Msg M] else if d = 1 then [Msg M', Marker] else []),
       process_snapshot = (%p. if p = P then Some S_Send else Some T_Wait),
       channel_snapshot = (%d. if d = 1 then ([], Recording) else if d = 0 then ([], Recording) else ([], NotStarted))
    \<rparr>"

abbreviation t4 where "t4 \<equiv> RecvMarker 0 Q P"

abbreviation s5 :: "(PType, SType, MType) configuration" where
  "s5 \<equiv> \<lparr>
       states = (%p. if p = P then S_Wait else T_Wait),
       msgs = (%d. if d = 0 then [Msg M] else if d = 1 then [Msg M', Marker] else []),
       process_snapshot = (%p. if p = P then Some S_Send else Some T_Wait),
       channel_snapshot = (%d. if d = 0 then ([], Done) else if d = 1 then ([], Recording) else ([], NotStarted))
    \<rparr>"

abbreviation t5 where "t5 \<equiv> Recv 1 P Q S_Wait S_Send M'"

abbreviation s6 :: "(PType, SType, MType) configuration" where
  "s6 \<equiv> \<lparr>
       states = (%p. if p = P then S_Send else T_Wait),
       msgs = (%d. if d = 0 then [Msg M] else if d = 1 then [Marker] else []),
       process_snapshot = (%p. if p = P then Some S_Send else Some T_Wait),
       channel_snapshot = (%d. if d = 0 then ([], Done) else if d = 1 then ([M'], Recording) else ([], NotStarted))
    \<rparr>"

abbreviation t6 where "t6 \<equiv> RecvMarker 1 P Q"

abbreviation s7 :: "(PType, SType, MType) configuration" where
  "s7 \<equiv> \<lparr>
       states = (%p. if p = P then S_Send else T_Wait),
       msgs = (%d. if d = 0 then [Msg M] else if d = 1 then [] else []),
       process_snapshot = (%p. if p = P then Some S_Send else Some T_Wait),
       channel_snapshot = (%d. if d = 0 then ([], Done) else if d = 1 then ([M'], Done) else ([], NotStarted))
    \<rparr>"

lemma s7_no_marker:
  shows
    "\<forall>cid. Marker \<notin> set (msgs s7 cid)"
  by simp

interpretation computation chan trans send recv init s7
proof
  have "distributed_system chan"
  proof
    show "\<forall>i. \<nexists>p. chan i = Some (p, p)" by simp
  qed
  show "\<forall>p q. p \<noteq> q \<longrightarrow> (\<lambda>p q. \<exists>i. chan i = Some (p, q))\<^sup>+\<^sup>+ p q"
  proof ((rule allI)+, rule impI)
    fix p q :: PType assume "p \<noteq> q"
    then have "(p = P \<and> q = Q) \<or> (p = Q \<and> q = P)"
      using PType.exhaust by auto
    then have "\<exists>i. chan i = Some (p, q)" by (elim disjE) auto
    then show "(\<lambda>p q. \<exists>i. chan i = Some (p, q))\<^sup>+\<^sup>+ p q" by blast
  qed
  show "finite {i. \<exists>p q. chan i = Some (p, q)}"
  proof -
    have "{i. \<exists>p q. chan i = Some (p, q)} = {0,1}" by auto
    then show ?thesis by simp
  qed
  show "1 < card (UNIV :: PType set)"
  proof -
    have "(UNIV :: PType set) = {P, Q}"
      using PType.exhaust by blast
    then have "card (UNIV :: PType set) = 2"
      by (metis One_nat_def PType.distinct(1) Suc_1 card.insert card_empty finite.emptyI finite.insertI insert_absorb insert_not_empty singletonD)
    then show ?thesis by auto
  qed
  show "finite (UNIV :: PType set)"
  proof -
    have "(UNIV :: PType set) = {P, Q}"
      using PType.exhaust by blast
    then show ?thesis
      by (metis finite.emptyI finite.insertI)
  qed
  show "\<forall>i. \<nexists>p. chan i = Some (p, p)" by simp
  show "\<forall>i. (\<exists>p q. chan i = Some (p, q)) \<longrightarrow> Marker \<notin> set (msgs init i)" by auto
  show "\<forall>i. chan i = None \<longrightarrow> msgs init i = []" by auto
  show "\<forall>p. \<not> ps init p \<noteq> None" by auto
  show "\<forall>i. cs init i = ([], NotStarted)" by auto
  show "\<exists>t. distributed_system.trace chan Example.trans send recv init t s7"
  proof -
    let ?t = "[t0, t1, t2, t3, t4, t5, t6]"
    have "distributed_system.next chan trans send recv init t0 s1"
    proof -
      have "distributed_system.can_occur chan trans send recv t0 init"
        using \<open>distributed_system chan\<close> distributed_system.can_occur_def by fastforce
      then show ?thesis
        by (simp add: \<open>distributed_system chan\<close> distributed_system.next_snapshot)
    qed
    moreover have "distributed_system.next chan trans send recv s1 t1 s2"
    proof -
      have "distributed_system.can_occur chan trans send recv t1 s1"
        using \<open>distributed_system chan\<close> distributed_system.can_occur_def by fastforce
      then show ?thesis
        by (simp add: \<open>distributed_system chan\<close> distributed_system.next_send)
    qed
    moreover have "distributed_system.next chan trans send recv s2 t2 s3"
    proof -
      have "distributed_system.can_occur chan trans send recv t2 s2"
        using \<open>distributed_system chan\<close> distributed_system.can_occur_def by fastforce
      moreover have "\<forall>r. r \<noteq> P \<longrightarrow> r = Q" using PType.exhaust by auto
      ultimately show ?thesis by (simp add: `distributed_system chan` distributed_system.next_send)
    qed
    moreover have "distributed_system.next chan trans send recv s3 t3 s4"
    proof -
      have "distributed_system.can_occur chan trans send recv t3 s3"
        using \<open>distributed_system chan\<close> distributed_system.can_occur_def by fastforce
      moreover have "\<forall>p'. p' \<noteq> P \<longrightarrow> p' = Q" using PType.exhaust by auto
      ultimately show ?thesis by (simp add: `distributed_system chan` distributed_system.next_snapshot)
    qed
    moreover have "distributed_system.next chan trans send recv s4 t4 s5"
    proof -
      have "distributed_system.can_occur chan trans send recv t4 s4"
        using \<open>distributed_system chan\<close> distributed_system.can_occur_def by fastforce
      then show ?thesis
        by (simp add: `distributed_system chan` distributed_system.next_def)
    qed
    moreover have "distributed_system.next chan trans send recv s5 t5 s6"
    proof -
      have "distributed_system.can_occur chan trans send recv t5 s5"
        using \<open>distributed_system chan\<close> distributed_system.can_occur_def by fastforce
      then show ?thesis
        by (simp add: `distributed_system chan` distributed_system.next_def)
    qed
    moreover have "distributed_system.next chan trans send recv s6 t6 s7"
    proof -
      have "distributed_system.can_occur chan trans send recv t6 s6"
        using \<open>distributed_system chan\<close> distributed_system.can_occur_def by fastforce
      then show ?thesis
        by (simp add: `distributed_system chan` distributed_system.next_def)
    qed
    ultimately have "distributed_system.trace chan trans send recv init ?t s7"
      by (meson \<open>distributed_system chan\<close> distributed_system.trace.simps)
    then show ?thesis by blast
  qed
  show "\<forall>t i cid. distributed_system.trace chan Example.trans send recv init t s7 \<and>
       Marker \<in> set (msgs (distributed_system.s chan Example.trans send recv init t i) cid) \<longrightarrow>
       (\<exists>j\<ge>i. Marker \<notin> set (msgs (distributed_system.s chan Example.trans send recv init t j) cid))"
  proof ((rule allI)+, (rule impI)+)
    fix t i cid
    assume asm: "distributed_system.trace chan Example.trans send recv init t s7 \<and>
                 Marker \<in> set (msgs (distributed_system.s chan Example.trans send recv init t i) cid)"
    have tr_exists: "distributed_system.trace chan Example.trans send recv init t s7" using asm by blast
    have marker_in_channel: "Marker \<in> set (msgs (distributed_system.s chan Example.trans send recv init t i) cid)" using asm by simp
    have s7_is_fin: "s7 = (distributed_system.s chan Example.trans send recv init t (length t))"
      by (metis (no_types, lifting) \<open>distributed_system chan\<close> \<open>distributed_system.trace chan Example.trans send recv init t s7\<close> distributed_system.exists_trace_for_any_i distributed_system.trace_and_start_determines_end order_refl take_all)
    have "i < length t"
    proof (rule ccontr)
      assume "~ i < length t"
      then have "distributed_system.trace chan Example.trans send recv
                (distributed_system.s chan Example.trans send recv init t (length t))
                []
                (distributed_system.s chan Example.trans send recv init t i)"
        by (metis (no_types, lifting) \<open>distributed_system chan\<close> distributed_system.exists_trace_for_any_i distributed_system.trace.simps distributed_system.trace_and_start_determines_end not_less s7_is_fin take_all tr_exists)
      then have "Marker \<notin> set (msgs (distributed_system.s chan Example.trans send recv init t i) cid)"
      proof -
        have "distributed_system.s chan Example.trans send recv init t i = s7"
          using \<open>distributed_system chan\<close> \<open>distributed_system.trace chan Example.trans send recv (distributed_system.s chan Example.trans send recv init t (length t)) [] (distributed_system.s chan Example.trans send recv init t i)\<close> distributed_system.trace.simps s7_is_fin by fastforce
        then show ?thesis using s7_no_marker by simp
      qed
      then show False using marker_in_channel by simp
    qed
    then show "(\<exists>j\<ge>i. Marker \<notin> set (msgs (distributed_system.s chan Example.trans send recv init t j) cid))"
    proof -
      have "distributed_system.trace chan Example.trans send recv
            (distributed_system.s chan Example.trans send recv init t i)
            (take ((length t) - i) (drop i t))
            (distributed_system.s chan Example.trans send recv init t (length t))"
        using \<open>distributed_system chan\<close> \<open>i < length t\<close> distributed_system.exists_trace_for_any_i_j less_imp_le_nat tr_exists by blast
      then have "Marker \<notin> set (msgs (distributed_system.s chan Example.trans send recv init t (length t)) cid)"
      proof -
        have "distributed_system.s chan Example.trans send recv init t (length t) = s7"
          by (simp add: s7_is_fin)
        then show ?thesis using s7_no_marker by simp
      qed
      then show ?thesis
        using \<open>i < length t\<close> less_imp_le_nat by blast
    qed
  qed
  show "\<forall>t p. distributed_system.trace chan Example.trans send recv init t s7 \<longrightarrow>
              (\<exists>i. ps (distributed_system.s chan Example.trans send recv init t i) p \<noteq> None \<and> i \<le> length t)"
  proof ((rule allI)+, rule impI)
    fix t p
    assume "distributed_system.trace chan Example.trans send recv init t s7"
    have s7_is_fin: "s7 = (distributed_system.s chan Example.trans send recv init t (length t))"
      by (metis (no_types, lifting) \<open>distributed_system chan\<close> \<open>distributed_system.trace chan Example.trans send recv init t s7\<close> distributed_system.exists_trace_for_any_i distributed_system.trace_and_start_determines_end order_refl take_all)
    moreover have "has_snapshotted s7 p" by simp
    ultimately show "(\<exists>i. ps (distributed_system.s chan Example.trans send recv init t i) p \<noteq> None \<and> i \<le> length t)"
      by auto
  qed
qed

end


(*  Title:      HOL/Auth/n_mutualEx_on_inis.thy
    Author:     Yongjian Li and Kaiqiang Duan, State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
    Copyright    2016 State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
*)

header{*The n_mutualEx Protocol Case Study*}

theory n_mutualEx_on_inis imports n_mutualEx_on_ini
begin
lemma on_inis:
  assumes b1: "f \<in> (invariants N)" and b2: "ini \<in> {andList (allInitSpecs N)}" and b3: "formEval ini s"
  shows "formEval f s"
  proof -
  have c1: "(\<exists> p__Inv0 p__Inv1. p__Inv0\<le>N\<and>p__Inv1\<le>N\<and>p__Inv0~=p__Inv1\<and>f=inv__1  p__Inv0 p__Inv1)\<or>
    (\<exists> p__Inv0. p__Inv0\<le>N\<and>f=inv__2  p__Inv0)\<or>
    (\<exists> p__Inv0 p__Inv1. p__Inv0\<le>N\<and>p__Inv1\<le>N\<and>p__Inv0~=p__Inv1\<and>f=inv__3  p__Inv0 p__Inv1)\<or>
    (\<exists> p__Inv0. p__Inv0\<le>N\<and>f=inv__4  p__Inv0)\<or>
    (\<exists> p__Inv0 p__Inv1. p__Inv0\<le>N\<and>p__Inv1\<le>N\<and>p__Inv0~=p__Inv1\<and>f=inv__5  p__Inv0 p__Inv1)"
  apply (cut_tac b1, simp) done
    moreover {
      assume d1: "(\<exists> p__Inv0 p__Inv1. p__Inv0\<le>N\<and>p__Inv1\<le>N\<and>p__Inv0~=p__Inv1\<and>f=inv__1  p__Inv0 p__Inv1)"
      have "formEval f s"
      apply (rule iniImply_inv__1)
      apply (cut_tac d1, assumption)
      apply (cut_tac b2 b3, blast) done
    }

    moreover {
      assume d1: "(\<exists> p__Inv0. p__Inv0\<le>N\<and>f=inv__2  p__Inv0)"
      have "formEval f s"
      apply (rule iniImply_inv__2)
      apply (cut_tac d1, assumption)
      apply (cut_tac b2 b3, blast) done
    }

    moreover {
      assume d1: "(\<exists> p__Inv0 p__Inv1. p__Inv0\<le>N\<and>p__Inv1\<le>N\<and>p__Inv0~=p__Inv1\<and>f=inv__3  p__Inv0 p__Inv1)"
      have "formEval f s"
      apply (rule iniImply_inv__3)
      apply (cut_tac d1, assumption)
      apply (cut_tac b2 b3, blast) done
    }

    moreover {
      assume d1: "(\<exists> p__Inv0. p__Inv0\<le>N\<and>f=inv__4  p__Inv0)"
      have "formEval f s"
      apply (rule iniImply_inv__4)
      apply (cut_tac d1, assumption)
      apply (cut_tac b2 b3, blast) done
    }

    moreover {
      assume d1: "(\<exists> p__Inv0 p__Inv1. p__Inv0\<le>N\<and>p__Inv1\<le>N\<and>p__Inv0~=p__Inv1\<and>f=inv__5  p__Inv0 p__Inv1)"
      have "formEval f s"
      apply (rule iniImply_inv__5)
      apply (cut_tac d1, assumption)
      apply (cut_tac b2 b3, blast) done
    }

  ultimately show "formEval f s"
  by satx
qed

end


(*  Title:      HOL/MicroJava/J/Decl.thy

    Author:     David von Oheimb
    Copyright   1999 Technische Universitaet Muenchen
*)

header {* \isaheader{Class Declarations and Programs} *}

theory Decl imports Type begin

type_synonym
  fdecl    = "vname \<times> ty"        -- "field declaration"
type_synonym
  'm mdecl = "mname \<times> ty list \<times> ty \<times> 'm"     -- {* method = name, arg.\ types, return type, body *}
type_synonym
  'm "class" = "cname \<times> fdecl list \<times> 'm mdecl list"       -- "class = superclass, fields, methods"
type_synonym
  'm cdecl = "cname \<times> 'm class"  -- "class declaration"
type_synonym
  'm prog  = "'m cdecl list"     -- "program"

(*<*)
translations
  (type) "fdecl"   <= (type) "vname \<times> ty"
  (type) "'c mdecl" <= (type) "mname \<times> ty list \<times> ty \<times> 'c"
  (type) "'c class" <= (type) "cname \<times> fdecl list \<times> ('c mdecl) list"
  (type) "'c cdecl" <= (type) "cname \<times> ('c class)"
  (type) "'c prog" <= (type) "('c cdecl) list"
(*>*)

definition "class" :: "'m prog \<Rightarrow> cname \<rightharpoonup> 'm class"
where
  "class  \<equiv>  map_of"

definition is_class :: "'m prog \<Rightarrow> cname \<Rightarrow> bool"
where
  "is_class P C  \<equiv>  class P C \<noteq> None"

lemma finite_is_class: "finite {C. is_class P C}"

(*<*)
apply (unfold is_class_def class_def)
apply (fold dom_def)
apply (rule finite_dom_map_of)
done
(*>*)

definition is_type :: "'m prog \<Rightarrow> ty \<Rightarrow> bool"
where
  "is_type P T  \<equiv>
  (case T of Void \<Rightarrow> True | Boolean \<Rightarrow> True | Integer \<Rightarrow> True | NT \<Rightarrow> True
   | Class C \<Rightarrow> is_class P C)"

lemma is_type_simps [simp]:
  "is_type P Void \<and> is_type P Boolean \<and> is_type P Integer \<and>
  is_type P NT \<and> is_type P (Class C) = is_class P C"
(*<*)by(simp add:is_type_def)(*>*)

abbreviation
  "types P == Collect (is_type P)"

end


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

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

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

  shows  "invHoldForRule' s (inv9  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_1VsInv9:
    (*Rule2VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iRule2 \<le> N" and  a3:"iInv1 \<le> N" and  a4:"iRule1~=iRule2  "

  shows  "invHoldForRule' s (inv9  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_HomeVsInv9:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv9  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_2VsInv9:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv9  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_GetXVsInv9:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv9  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_Nak1VsInv9:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv9  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_Nak2VsInv9:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv9  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_Nak3VsInv9:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv9  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_PutX1VsInv9:
  (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv9  iInv1 ) (NI_Local_GetX_PutX1 N  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_Local_GetX_PutX2VsInv9:
  (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv9  iInv1 ) (NI_Local_GetX_PutX2 N  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_Local_GetX_PutX3VsInv9:
  (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv9  iInv1 ) (NI_Local_GetX_PutX3 N  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_Local_GetX_PutX4VsInv9:
  (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv9  iInv1 ) (NI_Local_GetX_PutX4 N  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_Local_GetX_PutX5VsInv9:
  (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv9  iInv1 ) (NI_Local_GetX_PutX5 N  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_Local_GetX_PutX6VsInv9:
  (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv9  iInv1 ) (NI_Local_GetX_PutX6 N  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_Local_GetX_PutX7VsInv9:
  (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv9  iInv1 ) (NI_Local_GetX_PutX7 N  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_Local_GetX_PutX8VsInv9:
    (*Rule2VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iRule2 \<le> N" and  a3:"iInv1 \<le> N" and  a4:"iRule1~=iRule2  "

  shows  "invHoldForRule' s (inv9  iInv1 ) (NI_Local_GetX_PutX8 N  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 "?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 "?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 "?P1 s"

        apply(cut_tac  a1  a2  a3  a4  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_Local_GetX_PutX8_homeVsInv9:
  (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv9  iInv1 ) (NI_Local_GetX_PutX8_home N  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_Local_GetX_PutX9VsInv9:
  (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv9  iInv1 ) (NI_Local_GetX_PutX9 N  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_Local_GetX_PutX10VsInv9:
    (*Rule2VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iRule2 \<le> N" and  a3:"iInv1 \<le> N" and  a4:"iRule1~=iRule2  "

  shows  "invHoldForRule' s (inv9  iInv1 ) (NI_Local_GetX_PutX10 N  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 "?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 "?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 "?P1 s"

        apply(cut_tac  a1  a2  a3  a4  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_Local_GetX_PutX10_homeVsInv9:
  (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv9  iInv1 ) (NI_Local_GetX_PutX10_home N  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_Local_GetX_PutX11VsInv9:
  (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv9  iInv1 ) (NI_Local_GetX_PutX11 N  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_Local_Get_GetVsInv9:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv9  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_Nak1VsInv9:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv9  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_Nak2VsInv9:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv9  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_Nak3VsInv9:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv9  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_Put1VsInv9:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv9  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_Put2VsInv9:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv9  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_Put3VsInv9:
  (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv9  iInv1 ) (NI_Local_Get_Put3  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'' iInv1) )  ( Const UNI_Get ))    ( eqn ( IVar ( Para ''CacheState'' iInv1) )  ( Const CACHE_E ))  ) ) " in exI,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'' iInv1) )  ( Const CACHE_E ))    ( eqn ( IVar ( Global ''Dir_local'') )  ( Const true ))  ) ) " 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_Local_PutVsInv9:
  (*Rule0VsPInv1*)
  assumes   a1:"iInv1 \<le> N"

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

  proof -

      have "?P3 s"

        apply(   cut_tac  a1 , simp)

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

        done

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

        by blast

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

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

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

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

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

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

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

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

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

  shows  "invHoldForRule' s (inv9  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_HomeVsInv9:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

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

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

  shows  "invHoldForRule' s (inv9  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_HomeVsInv9:
  (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv9  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 "?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_Get_Nak1VsInv9:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

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

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

  shows  "invHoldForRule' s (inv9  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_Put1VsInv9:
  (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv9  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 "?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_Get_Put2VsInv9:
    (*Rule2VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iRule2 \<le> N" and  a3:"iInv1 \<le> N" and  a4:"iRule1~=iRule2  "

  shows  "invHoldForRule' s (inv9  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_PutVsInv9:
  (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv9  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_PutXVsInv9:
  (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv9  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 ( Global ''Dir_Dirty'') )  ( Const false ))    ( 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_ReplaceVsInv9:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

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

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

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

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

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

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

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

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

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

  proof -

      have "?P3 s"

        apply(   cut_tac  a1 , simp)

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

        done

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

        by blast

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

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

  proof -

      have "?P3 s"

        apply(   cut_tac  a1 , simp)

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

        done

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

        by blast

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

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

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

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

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

  shows  "invHoldForRule' s (inv9  iInv1 ) (PI_Local_GetX_PutX1 N ) (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_PutX2VsInv9:
  (*Rule0VsPInv1*)
  assumes   a1:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv9  iInv1 ) (PI_Local_GetX_PutX2 N ) (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_PutX3VsInv9:
  (*Rule0VsPInv1*)
  assumes   a1:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv9  iInv1 ) (PI_Local_GetX_PutX3 ) (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_PutX4VsInv9:
  (*Rule0VsPInv1*)
  assumes   a1:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv9  iInv1 ) (PI_Local_GetX_PutX4 ) (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_GetVsInv9:
    (*Rule0VsPInv1*)
  assumes   a1:"iInv1 \<le> N"

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

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

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

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

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

  proof -

      have "?P3 s"

        apply(   cut_tac  a1 , simp)

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

        done

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

        by blast

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

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

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

  shows  "invHoldForRule' s (inv9  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_GetXVsInv9:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv9  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_PutXVsInv9:
  (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

  shows  "invHoldForRule' s (inv9  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_ReplaceVsInv9:
    (*Rule1VsPInv1*)
  assumes   a1:"iRule1 \<le> N" and  a2:"iInv1 \<le> N"

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

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

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

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

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

    by (cut_tac  a1 , auto)
 end


theory SATDecision
imports ModelIso "HOL-Library.Finite_Map"
begin

subsection \<open>AMS\<close>

definition equiv_classes :: "('a \<rightharpoonup> 'b) \<Rightarrow> 'a set set" where
  "equiv_classes m = { {x. m x = Some y}  | y. y \<in> ran m}"

lemma classes_distinct: "\<lbrakk>c1 \<in> equiv_classes m; c2 \<in> equiv_classes m\<rbrakk> \<Longrightarrow> c1=c2 \<or> c1\<inter>c2={}"
  by (auto simp: equiv_classes_def)

datatype len = One | AtLeastTwo
type_synonym abst_var = "var fset"

typedef ams = "{(V,E,\<rho>,\<gamma>)::
  (abst_var fset \<times> (abst_var,(abst_var\<times>len)) fmap \<times> abst_var fset fset \<times> nat) | V E \<rho> \<gamma>.
  (\<forall>v\<in>fset V. v\<noteq>{||}) \<and> (\<exists>v\<in>fset V. Nil |\<in>|v) \<and> (\<forall>v1 v2. v1 |\<in>| V \<and> v2 |\<in>| V \<longrightarrow> v1=v2 \<or> v1 |\<inter>| v2 = {||})
  \<and> fmdom E |\<subseteq>| V \<and> fmimage (Abs_fmap (Some\<circ>fst)) (fmran E) |\<subseteq>| V \<and> (\<forall>v\<in> fset (fmdom E). Nil |\<notin>| v)
  \<and> (\<forall>R1 R2. R1 |\<in>| \<rho> \<and> R2 |\<in>| \<rho> \<longrightarrow> R1=R2 \<or> R1 |\<inter>| R2 = {||}) \<and>
    (\<forall>R\<in>fset \<rho>. R |\<subseteq>| V \<and> R |\<inter>| fmdom E = {||} \<and> (\<forall>v\<in>fset R. Nil |\<notin>| v))}"
proof -
  define ams :: "(abst_var fset \<times> (abst_var,(abst_var\<times>len)) fmap \<times> abst_var fset fset \<times> nat)"
    where "ams \<equiv> ({|{|Nil|}|}, fmempty, {||}, 0)"
  then have "ams \<in> {(V, E, \<rho>, \<gamma>) |V E \<rho> \<gamma>. (\<forall>v\<in>fset V. v \<noteq> {||}) \<and>(\<exists>v\<in>fset V. var.Nil |\<in>| v) \<and>
    (\<forall>v1 v2. v1 |\<in>| V \<and> v2 |\<in>| V \<longrightarrow> v1 = v2 \<or> v1 |\<inter>| v2 = {||}) \<and> fmdom E |\<subseteq>| V \<and>
    fmimage (Abs_fmap (Some \<circ> fst)) (fmran E) |\<subseteq>| V \<and> (\<forall>v\<in>fset (fmdom E). var.Nil |\<notin>| v) \<and>
    (\<forall>R1 R2. R1 |\<in>| \<rho> \<and> R2 |\<in>| \<rho> \<longrightarrow> R1 = R2 \<or> R1 |\<inter>| R2 = {||}) \<and>
    (\<forall>R\<in>fset \<rho>. R |\<subseteq>| V \<and> R |\<inter>| fmdom E = {||} \<and> (\<forall>v\<in>fset R. var.Nil |\<notin>| v))}"
    by simp
  then show ?thesis by meson
qed

end


theory Benchmark_Set_LC
imports
  Benchmark_Set
  Containers.Set_Impl
  "HOL-Library.Code_Target_Nat"
begin

lemma [code_unfold del]: "card \<equiv> Cardinality.card'" by(simp)

instantiation word :: (len) ceq begin
definition "CEQ('a word) = Some (=)"
instance by(intro_classes)(simp add: ceq_word_def)
end

instantiation word :: (len) compare begin
definition "compare_word = (comparator_of :: 'a word comparator)"
instance by(intro_classes)(simp add: compare_word_def comparator_of)
end

instantiation word :: (len) ccompare begin
definition "CCOMPARE('a word) = Some compare"
instance by(intro_classes)(simp add: ccompare_word_def comparator_compare)
end

instantiation word :: (len) set_impl begin
definition "SET_IMPL('a word) = Phantom('a word) set_RBT"
instance ..
end

instantiation word :: (len) proper_interval begin

fun proper_interval_word :: "'a word option \<Rightarrow> 'a word option \<Rightarrow> bool"
where
  "proper_interval_word None None = True"
| "proper_interval_word None (Some y) = (y \<noteq> 0)"
| "proper_interval_word (Some x) None = (x \<noteq> - 1)"
| "proper_interval_word (Some x) (Some y) = (x < y \<and> x \<noteq> y - 1)"

instance
proof
  let ?pi = "proper_interval :: 'a word proper_interval"
  show "?pi None None = True" by simp
  fix y
  show "?pi None (Some y) = (\<exists>z. z < y)"
    using word_neq_0_conv [of y] by auto
  fix x
  show "?pi (Some x) None = (\<exists>z. x < z)"
    using word_order.not_eq_extremum [of x] by auto

  have "(x < y \<and> x \<noteq> y - 1) = (\<exists>z>x. z < y)" (is "?lhs \<longleftrightarrow> ?rhs")
  proof
    assume ?lhs
    then obtain "x < y" "x \<noteq> y - 1" ..
    have "0 \<le> uint x" by simp
    also have "\<dots> < uint y" using \<open>x < y\<close> by(simp add: word_less_def)
    finally have "0 < uint y" .
    then have "y - 1 < y" by(simp add: word_less_def uint_sub_if' not_le)
    moreover from \<open>0 < uint y\<close> \<open>x < y\<close> \<open>x \<noteq> y - 1\<close>
    have "x < y - 1" by(simp add: word_less_def uint_sub_if' uint_arith_simps(3))
    ultimately show ?rhs by blast
  next
    assume ?rhs
    then obtain z where z: "x < z" "z < y" by blast
    have "0 \<le> uint z" by simp
    also have "\<dots> < uint y" using \<open>z < y\<close> by(simp add: word_less_def)
    finally show ?lhs using z by(auto simp add: word_less_def uint_sub_if')
  qed
  thus "?pi (Some x) (Some y) = (\<exists>z>x. z < y)" by simp
qed

end

instantiation word :: (len) cproper_interval begin
definition "cproper_interval = (proper_interval :: 'a word proper_interval)"
instance by( intro_classes, simp add: cproper_interval_word_def ccompare_word_def
  compare_word_def le_lt_comparator_of ID_Some proper_interval_class.axioms)
end

instantiation word :: (len) cenum begin
definition "CENUM('a word) = None"
instance by(intro_classes)(simp_all add: cEnum_word_def)
end

notepad begin
  have "Benchmark_Set.complete 30 40 (12345, 67899) = (32, 4294967296)" by eval
end

end


theory Ipassmt
imports Common_Primitive_Syntax
        "../Semantics_Ternary/Primitive_Normalization"
        "../../Simple_Firewall/Primitives/Iface"
        "../../Simple_Firewall/Common/IP_Addr_WordInterval_toString" (*for debug pretty-printing*)
        "../../Automatic_Refinement/Lib/Misc" (*dependnecy!*)
begin

  text\<open>A mapping from an interface to its assigned ip addresses in CIDR notation\<close>
  type_synonym 'i ipassignment="iface \<rightharpoonup> ('i word \<times> nat) list" (*technically, a set*)

subsection\<open>Sanity checking for an @{typ "'i ipassignment"}.\<close>

  text\<open>warning if interface map has wildcards\<close>
  definition ipassmt_sanity_nowildcards :: "'i ipassignment \<Rightarrow> bool" where
    "ipassmt_sanity_nowildcards ipassmt \<equiv> \<forall> iface \<in> dom ipassmt. \<not> iface_is_wildcard iface"

    text\<open>Executable of the @{typ "'i ipassignment"} is given as a list.\<close>

  (* use this in all exported code*)
  (*TODO: generate useful error message in exported code*)
  definition map_of_ipassmt :: "(iface \<times> ('i word \<times> nat) list) list \<Rightarrow> iface \<rightharpoonup> ('i word \<times> nat) list" where
    "map_of_ipassmt ipassmt = (
      if
        distinct (map fst ipassmt) \<and> ipassmt_sanity_nowildcards (map_of ipassmt)
      then
        map_of ipassmt
      else undefined (*undefined_ipassmt_must_be_distinct_and_dont_have_wildcard_interfaces*))"

  text\<open>some additional (optional) sanity checks\<close>

  text\<open>sanity check that there are no zone-spanning interfaces\<close>
  definition ipassmt_sanity_disjoint :: "'i::len ipassignment \<Rightarrow> bool" where
    "ipassmt_sanity_disjoint ipassmt \<equiv> \<forall> i1 \<in> dom ipassmt. \<forall> i2 \<in> dom ipassmt. i1 \<noteq> i2 \<longrightarrow>
          ipcidr_union_set (set (the (ipassmt i1))) \<inter> ipcidr_union_set (set (the (ipassmt i2))) = {}"

  lemma[code_unfold]: "ipassmt_sanity_disjoint (map_of ipassmt) \<longleftrightarrow>
    (let Is = fst` set ipassmt in
      (\<forall> i1 \<in> Is. \<forall> i2 \<in> Is. i1 \<noteq> i2 \<longrightarrow> wordinterval_empty (wordinterval_intersection (l2wi (map ipcidr_to_interval (the ((map_of ipassmt) i1))))  (l2wi (map ipcidr_to_interval (the ((map_of ipassmt) i2)))))))"
    apply(simp add: ipassmt_sanity_disjoint_def Map.dom_map_of_conv_image_fst)
    apply(simp add: ipcidr_union_set_def)
    apply(simp add: l2wi)
    apply(simp add: ipcidr_to_interval_def)
    using ipset_from_cidr_ipcidr_to_interval by blast

  text\<open>Checking that the ipassmt covers the complete ipv4 address space.\<close>
  definition ipassmt_sanity_complete :: "(iface \<times> ('i::len word \<times> nat) list) list \<Rightarrow> bool" where
    "ipassmt_sanity_complete ipassmt \<equiv> distinct (map fst ipassmt) \<and> (\<Union>(ipcidr_union_set ` set ` (ran (map_of ipassmt)))) = UNIV"

    lemma[code_unfold]: "ipassmt_sanity_complete ipassmt \<longleftrightarrow> distinct (map fst ipassmt) \<and> (let range = map snd ipassmt in
        wordinterval_eq (wordinterval_Union (map (l2wi \<circ> (map ipcidr_to_interval)) range)) wordinterval_UNIV
        )"
     apply(cases "distinct (map fst ipassmt)")
      apply(simp add: ipassmt_sanity_complete_def)
      apply(simp add: Map.ran_distinct)
      apply(simp add: wordinterval_eq_set_eq wordinterval_Union)
      apply(simp add: l2wi)
      apply(simp add: ipcidr_to_interval_def)
      apply(simp add: ipcidr_union_set_def ipset_from_cidr_ipcidr_to_interval; fail)
     apply(simp add: ipassmt_sanity_complete_def)
     done

    value[code] "ipassmt_sanity_nowildcards (map_of [(Iface ''eth1.1017'', [(ipv4addr_of_dotdecimal (131,159,14,240), 28)])])"

  fun collect_ifaces' :: "'i::len common_primitive rule list \<Rightarrow> iface list" where
    "collect_ifaces' [] = []" |
    "collect_ifaces' ((Rule m a)#rs) = filter (\<lambda>iface. iface \<noteq> ifaceAny) (
                                      (map (\<lambda>x. case x of Pos i \<Rightarrow> i | Neg i \<Rightarrow> i) (fst (primitive_extractor (is_Iiface, iiface_sel) m))) @
                                      (map (\<lambda>x. case x of Pos i \<Rightarrow> i | Neg i \<Rightarrow> i) (fst (primitive_extractor (is_Oiface, oiface_sel) m))) @ collect_ifaces' rs)"

  definition collect_ifaces :: "'i::len common_primitive rule list \<Rightarrow> iface list" where
    "collect_ifaces rs \<equiv> mergesort_remdups (collect_ifaces' rs)"
  lemma "set (collect_ifaces rs) = set (collect_ifaces' rs)"
    by(simp add: collect_ifaces_def mergesort_remdups_correct)

  text\<open>sanity check that all interfaces mentioned in the ruleset are also listed in the ipassmt. May fail for wildcard interfaces in the ruleset.\<close>

  (*primitive_extractor requires normalized_nnf_primitives*)
  definition ipassmt_sanity_defined :: "'i::len common_primitive rule list \<Rightarrow> 'i ipassignment \<Rightarrow> bool" where
    "ipassmt_sanity_defined rs ipassmt \<equiv> \<forall> iface \<in> set (collect_ifaces rs). iface \<in> dom ipassmt"

    lemma[code]: "ipassmt_sanity_defined rs ipassmt \<longleftrightarrow> (\<forall> iface \<in> set (collect_ifaces rs). ipassmt iface \<noteq> None)"
      by(simp add: ipassmt_sanity_defined_def Map.domIff)

    lemma "ipassmt_sanity_defined [
         Rule (MatchAnd (Match (Src (IpAddrNetmask (ipv4addr_of_dotdecimal (192,168,0,0)) 24))) (Match (IIface (Iface ''eth1.1017'')))) action.Accept,
         Rule (MatchAnd (Match (Src (IpAddrNetmask (ipv4addr_of_dotdecimal (192,168,0,0)) 24))) (Match (IIface (ifaceAny)))) action.Accept,
         Rule MatchAny action.Drop]
             (map_of [(Iface ''eth1.1017'', [(ipv4addr_of_dotdecimal (131,159,14,240), 28)])])" by eval

  (*TODO: use and add code equation*)
  definition ipassmt_ignore_wildcard :: "'i::len ipassignment \<Rightarrow> 'i ipassignment" where
    "ipassmt_ignore_wildcard ipassmt \<equiv> \<lambda>k. case ipassmt k of None \<Rightarrow> None
                                                           | Some ips \<Rightarrow> if ipcidr_union_set (set ips) = UNIV then None else Some ips"

  lemma ipassmt_ignore_wildcard_le: "ipassmt_ignore_wildcard ipassmt \<subseteq>\<^sub>m ipassmt"
    apply(simp add: ipassmt_ignore_wildcard_def map_le_def)
    apply(clarify)
    apply(simp split: option.split_asm if_split_asm)
    done

  definition ipassmt_ignore_wildcard_list:: "(iface \<times> ('i::len word \<times> nat) list) list \<Rightarrow> (iface \<times> ('i word \<times> nat) list) list" where
    "ipassmt_ignore_wildcard_list ipassmt = filter (\<lambda>(_,ips).  \<not> wordinterval_eq (l2wi (map ipcidr_to_interval ips)) wordinterval_UNIV) ipassmt"

  (*distinct fst ipassmt notwendig?*)
  lemma "distinct (map fst ipassmt) \<Longrightarrow>
    map_of (ipassmt_ignore_wildcard_list ipassmt) = ipassmt_ignore_wildcard (map_of ipassmt)"
      apply(simp add: ipassmt_ignore_wildcard_list_def ipassmt_ignore_wildcard_def)
      apply(simp add: wordinterval_eq_set_eq)
      apply(simp add: l2wi)
      apply(simp add: ipcidr_to_interval_def)
      apply(simp add: fun_eq_iff)
      apply(clarify)
      apply(induction ipassmt)
       apply(simp; fail)
      apply(simp)
      apply(simp split:option.split option.split_asm)
      apply(simp add: ipcidr_union_set_def ipset_from_cidr_ipcidr_to_interval)
      apply(simp add: case_prod_unfold)
      by blast
      (*apply(safe)
                       apply(simp_all)
      by (simp add: rev_image_eqI)*)

  text\<open>Debug algorithm with human-readable output\<close>
  definition debug_ipassmt_generic
    :: "('i::len wordinterval \<Rightarrow> string) \<Rightarrow>
          (iface \<times> ('i word \<times> nat) list) list \<Rightarrow> 'i common_primitive rule list \<Rightarrow> string list" where
    "debug_ipassmt_generic toStr ipassmt rs \<equiv> let ifaces = (map fst ipassmt) in [
      ''distinct: '' @ (if distinct ifaces then ''passed'' else ''FAIL!'')
      , ''ipassmt_sanity_nowildcards: '' @
          (if ipassmt_sanity_nowildcards (map_of ipassmt)
           then ''passed'' else ''fail: ''@list_toString iface_sel (filter iface_is_wildcard ifaces))
      , ''ipassmt_sanity_defined (interfaces defined in the ruleset are also in ipassmt): '' @
          (if ipassmt_sanity_defined rs (map_of ipassmt)
           then ''passed'' else ''fail: ''@list_toString iface_sel [i \<leftarrow> (collect_ifaces rs). i \<notin> set ifaces])
      , ''ipassmt_sanity_disjoint (no zone-spanning interfaces): '' @
          (if ipassmt_sanity_disjoint (map_of ipassmt)
           then ''passed'' else ''fail: ''@list_toString (\<lambda>(i1,i2). ''('' @ iface_sel i1 @ '','' @ iface_sel i2 @ '')'')
               [(i1,i2) \<leftarrow> List.product ifaces ifaces. i1 \<noteq> i2 \<and>
                \<not> wordinterval_empty (wordinterval_intersection
                                        (l2wi (map ipcidr_to_interval (the ((map_of ipassmt) i1))))
                                        (l2wi (map ipcidr_to_interval (the ((map_of ipassmt) i2)))))
          ])
      , ''ipassmt_sanity_disjoint excluding UNIV interfaces: '' @
          (let ipassmt = ipassmt_ignore_wildcard_list ipassmt;
               ifaces = (map fst ipassmt)
           in
          (if ipassmt_sanity_disjoint (map_of ipassmt)
           then ''passed'' else ''fail: ''@list_toString (\<lambda>(i1,i2). ''('' @ iface_sel i1 @ '','' @ iface_sel i2 @ '')'')
               [(i1,i2) \<leftarrow> List.product ifaces ifaces. i1 \<noteq> i2 \<and>
                \<not> wordinterval_empty (wordinterval_intersection
                                        (l2wi (map ipcidr_to_interval (the ((map_of ipassmt) i1))))
                                        (l2wi (map ipcidr_to_interval (the ((map_of ipassmt) i2)))))
          ]))
       , ''ipassmt_sanity_complete: '' @
          (if ipassmt_sanity_complete ipassmt
           then ''passed''
           else ''the following is not covered: '' @
            toStr (wordinterval_setminus wordinterval_UNIV (wordinterval_Union (map (l2wi \<circ> (map ipcidr_to_interval)) (map snd ipassmt)))))
      , ''ipassmt_sanity_complete excluding UNIV interfaces: '' @
          (let ipassmt = ipassmt_ignore_wildcard_list ipassmt
           in
          (if ipassmt_sanity_complete ipassmt
           then ''passed''
           else ''the following is not covered: '' @
            toStr (wordinterval_setminus wordinterval_UNIV (wordinterval_Union (map (l2wi \<circ> (map ipcidr_to_interval)) (map snd ipassmt))))))
      ]"

  definition "debug_ipassmt_ipv4 \<equiv> debug_ipassmt_generic ipv4addr_wordinterval_toString"
  definition "debug_ipassmt_ipv6 \<equiv> debug_ipassmt_generic ipv6addr_wordinterval_toString"

  lemma dom_ipassmt_ignore_wildcard:
    "i\<in>dom (ipassmt_ignore_wildcard ipassmt) \<longleftrightarrow> i \<in> dom ipassmt \<and> ipcidr_union_set (set (the (ipassmt i))) \<noteq> UNIV"
    apply(simp add: ipassmt_ignore_wildcard_def)
    apply(rule)
     apply(clarify)
     apply(simp split: option.split_asm if_split_asm)
     apply blast
    apply(clarify)
    apply(simp)
    done

  lemma ipassmt_ignore_wildcard_the:
    "ipassmt i = Some ips \<Longrightarrow> ipcidr_union_set (set ips) \<noteq> UNIV \<Longrightarrow> (the (ipassmt_ignore_wildcard ipassmt i)) = ips"
    "ipassmt_ignore_wildcard ipassmt i = Some ips \<Longrightarrow> the (ipassmt i) = ips"
    "ipassmt_ignore_wildcard ipassmt i = Some ips \<Longrightarrow> ipcidr_union_set (set ips) \<noteq> UNIV"
    by (simp_all add: ipassmt_ignore_wildcard_def split: option.split_asm if_split_asm)

  lemma ipassmt_sanity_disjoint_ignore_wildcards:
        "ipassmt_sanity_disjoint (ipassmt_ignore_wildcard ipassmt) \<longleftrightarrow>
         (\<forall>i1\<in>dom ipassmt.
          \<forall>i2\<in>dom ipassmt.
            ipcidr_union_set (set (the (ipassmt i1))) \<noteq> UNIV \<and>
            ipcidr_union_set (set (the (ipassmt i2))) \<noteq> UNIV \<and>
            i1 \<noteq> i2
            \<longrightarrow> ipcidr_union_set (set (the (ipassmt i1))) \<inter> ipcidr_union_set (set (the (ipassmt i2))) = {})"
    apply(simp add: ipassmt_sanity_disjoint_def)
    apply(rule)
     apply(clarify)
     apply(simp)
     subgoal for i1 i2 ips1 ips2
     apply(erule_tac x=i1 in ballE)
      prefer 2
      using dom_ipassmt_ignore_wildcard  apply (metis domI option.sel)
     apply(erule_tac x=i2 in ballE)
      prefer 2
      using dom_ipassmt_ignore_wildcard apply (metis domI domIff option.sel)
     by(simp add: ipassmt_ignore_wildcard_the; fail)
    apply(clarify)
    apply(simp)
    subgoal for i1 i2 ips1 ips2
    apply(erule_tac x=i1 in ballE)
     prefer 2
     using dom_ipassmt_ignore_wildcard apply auto[1]
    apply(erule_tac x=i2 in ballE)
     prefer 2
     using dom_ipassmt_ignore_wildcard apply auto[1]
    by(simp add: ipassmt_ignore_wildcard_the)
   done

  text\<open>Confusing names: @{const ipassmt_sanity_nowildcards} refers to wildcard interfaces.
       @{const ipassmt_ignore_wildcard} refers to the UNIV ip range.
\<close>
  lemma ipassmt_sanity_nowildcards_ignore_wildcardD:
    "ipassmt_sanity_nowildcards ipassmt \<Longrightarrow> ipassmt_sanity_nowildcards (ipassmt_ignore_wildcard ipassmt)"
    by (simp add: dom_ipassmt_ignore_wildcard ipassmt_sanity_nowildcards_def)

 lemma ipassmt_disjoint_nonempty_inj:
     assumes ipassmt_disjoint: "ipassmt_sanity_disjoint ipassmt"
        and ifce: "ipassmt ifce = Some i_ips"
        and a: "ipcidr_union_set (set i_ips) \<noteq> {}"
        and k: "ipassmt k = Some i_ips"
     shows "k = ifce"
     proof(rule ccontr)
       assume "k \<noteq> ifce"
       with ifce k ipassmt_disjoint have "ipcidr_union_set (set (the (ipassmt k))) \<inter> ipcidr_union_set (set (the (ipassmt ifce))) = {}"
         unfolding ipassmt_sanity_disjoint_def by fastforce
       thus False using a ifce k by auto
     qed

  lemma ipassmt_ignore_wildcard_None_Some:
    "ipassmt_ignore_wildcard ipassmt ifce = None \<Longrightarrow> ipassmt ifce = Some ips \<Longrightarrow> ipcidr_union_set (set ips) = UNIV"
    by (metis domI domIff dom_ipassmt_ignore_wildcard option.sel)

 (*can this lemma be somehow useful?
   maybe when rewriting, we can try to rewrite in the ignore_wildcard space and just constrain the the other area?*)
 lemma ipassmt_disjoint_ignore_wildcard_nonempty_inj:
     assumes ipassmt_disjoint: "ipassmt_sanity_disjoint (ipassmt_ignore_wildcard ipassmt)"
        and ifce: "ipassmt ifce = Some i_ips"
        and a: "ipcidr_union_set (set i_ips) \<noteq> {}"
        and k: "(ipassmt_ignore_wildcard ipassmt) k = Some i_ips"
     shows "k = ifce"
     proof(rule ccontr)
       assume "k \<noteq> ifce"
       show False
       proof(cases "(ipassmt_ignore_wildcard ipassmt) ifce")
       case (Some i_ips') (*proofs mainly by sledgehammer*)
         hence "i_ips' = i_ips" using ifce ipassmt_ignore_wildcard_the(2) by fastforce
         hence "(ipassmt_ignore_wildcard ipassmt) k = Some i_ips" using Some ifce ipassmt_ignore_wildcard_def k by auto
         thus False using Some \<open>i_ips' = i_ips\<close> \<open>k \<noteq> ifce\<close> a ipassmt_disjoint ipassmt_disjoint_nonempty_inj by blast
       next
       case None
         with ipassmt_ignore_wildcard_None_Some have "ipcidr_union_set (set i_ips) = UNIV" using ifce by auto
         thus False using ipassmt_ignore_wildcard_the(3) k by blast
       qed
     qed

 lemma ipassmt_disjoint_inj_k:
     assumes ipassmt_disjoint: "ipassmt_sanity_disjoint ipassmt"
        and ifce: "ipassmt ifce = Some ips"
        and k: "ipassmt k = Some ips'"
        and a: "p \<in> ipcidr_union_set (set ips)"
        and b: "p \<in> ipcidr_union_set (set ips')"
     shows "k = ifce"
     proof(rule ccontr)
       assume "k \<noteq> ifce"
       with ipassmt_disjoint have
          "ipcidr_union_set (set (the (ipassmt k))) \<inter> ipcidr_union_set (set (the (ipassmt ifce))) = {}"
         unfolding ipassmt_sanity_disjoint_def using ifce k by blast
       hence "ipcidr_union_set (set ips') \<inter> ipcidr_union_set (set ips) = {}" by(simp add: k ifce)
       thus False using a b by blast
     qed

 (*might also work when we ignore UNIVs in the ipassmt? (not tested)*)
 lemma ipassmt_disjoint_matcheq_iifce_srcip:
        assumes ipassmt_nowild: "ipassmt_sanity_nowildcards ipassmt"
            and ipassmt_disjoint: "ipassmt_sanity_disjoint ipassmt"
            and ifce: "ipassmt ifce = Some i_ips"
            and p_ifce: "ipassmt (Iface (p_iiface p)) = Some p_ips \<and> p_src p \<in> ipcidr_union_set (set p_ips)"
        shows   "match_iface ifce (p_iiface p) \<longleftrightarrow> p_src p \<in> ipcidr_union_set (set i_ips)"
    proof
     assume "match_iface ifce (p_iiface p)"
     thus "p_src p \<in> ipcidr_union_set (set i_ips)"
       apply(cases "ifce = Iface (p_iiface p)")
        using ifce p_ifce apply force
       by (metis domI iface.sel iface_is_wildcard_def ifce ipassmt_nowild ipassmt_sanity_nowildcards_def match_iface.elims(2) match_iface_case_nowildcard)
   next
     assume a: "p_src p \<in> ipcidr_union_set (set i_ips)"
     --\<open>basically, we need to reverse the map @{term ipassmt}\<close>

     from ipassmt_disjoint_nonempty_inj[OF ipassmt_disjoint ifce] a have ipassmt_inj: "\<forall>k. ipassmt k = Some i_ips \<longrightarrow> k = ifce" by blast

     from ipassmt_disjoint_inj_k[OF ipassmt_disjoint ifce _ a] have ipassmt_inj_k:
      "\<And>k ips'. ipassmt k = Some ips' \<Longrightarrow> p_src p \<in> ipcidr_union_set (set ips') \<Longrightarrow> k = ifce" by simp

     have ipassmt_inj_p: "\<forall>ips'. p_src p \<in> ipcidr_union_set (set ips') \<and> (\<exists>k. ipassmt k = Some ips') \<longrightarrow> ips' = i_ips"
       apply(clarify)
       apply(rename_tac ips' k)
       apply(subgoal_tac "k = ifce")
        using ifce apply simp
       using ipassmt_inj_k by simp

     from p_ifce have "(Iface (p_iiface p)) = ifce" using ipassmt_inj_p ipassmt_inj by blast

     thus "match_iface ifce (p_iiface p)" using match_iface_refl by blast
   qed

  definition ipassmt_generic_ipv4 :: "(iface \<times> (32 word \<times> nat) list) list" where
    "ipassmt_generic_ipv4 = [(Iface ''lo'', [(ipv4addr_of_dotdecimal (127,0,0,0),8)])]"

  definition ipassmt_generic_ipv6 :: "(iface \<times> (128 word \<times> nat) list) list" where
    "ipassmt_generic_ipv6 = [(Iface ''lo'', [(1,128)])]" (*::1/128*)

subsection\<open>IP Assignment difference\<close>
  text\<open>Compare two ipassmts. Returns a list of tuples
    First entry of the tuple: things which are in the left ipassmt but not in the right.
    Second entry of the tupls: things which are in the right ipassmt but not in the left.\<close>
  definition ipassmt_diff
    :: "(iface \<times> ('i::len word \<times> nat) list) list \<Rightarrow> (iface \<times> ('i::len word \<times> nat) list) list
        \<Rightarrow> (iface \<times> ('i word \<times> nat) list \<times> ('i word \<times> nat) list) list"
  where
  "ipassmt_diff a b \<equiv> let
      t = \<lambda>s. (case s of None \<Rightarrow> Empty_WordInterval
                       | Some s \<Rightarrow> wordinterval_Union (map ipcidr_tuple_to_wordinterval s));
      k = \<lambda>x y d. cidr_split (wordinterval_setminus (t (map_of x d)) (t (map_of y d)))
    in
      [(d, (k a b d, k b a d)). d \<leftarrow> remdups (map fst (a @ b))]"

  text\<open>If an interface is defined in both ipassignments and there is no difference
       then the two ipassignements describe the same IP range for this interface.\<close>
  lemma ipassmt_diff_ifce_equal: "(ifce, [], []) \<in> set (ipassmt_diff ipassmt1 ipassmt2)  \<Longrightarrow>
         ifce \<in> dom (map_of ipassmt1) \<Longrightarrow> ifce \<in> dom (map_of ipassmt2) \<Longrightarrow>
           ipcidr_union_set (set (the ((map_of ipassmt1) ifce))) =
           ipcidr_union_set (set (the ((map_of ipassmt2) ifce)))"
    proof -
    have cidr_empty: "[] = cidr_split r \<Longrightarrow> wordinterval_to_set r = {}" for r :: "'a wordinterval"
      apply(subst cidr_split_prefix[symmetric])
      by(simp)
    show "(ifce, [], []) \<in> set (ipassmt_diff ipassmt1 ipassmt2)  \<Longrightarrow>
         ifce \<in> dom (map_of ipassmt1) \<Longrightarrow> ifce \<in> dom (map_of ipassmt2) \<Longrightarrow>
           ipcidr_union_set (set (the ((map_of ipassmt1) ifce))) =
           ipcidr_union_set (set (the ((map_of ipassmt2) ifce)))"
    apply(simp add: ipassmt_diff_def Let_def ipcidr_union_set_uncurry)
    apply(simp add: Set.image_iff)
    apply(elim conjE)
    apply(drule cidr_empty)+
    apply(simp)
    apply(simp add: domIff)
    apply(elim exE)
    apply(simp add: wordinterval_Union wordinterval_to_set_ipcidr_tuple_to_wordinterval_uncurry)
    done
  qed

  lemma ipcidr_union_cidr_split[simp]: "ipcidr_union_set (set (cidr_split a)) = wordinterval_to_set a"
    by(simp add: ipcidr_union_set_uncurry cidr_split_prefix)

  lemma
    defines "assmt as ifce \<equiv> ipcidr_union_set (set (the ((map_of as ifce))))"
    assumes diffs: "(ifce, d1, d2) \<in> set (ipassmt_diff ipassmt1 ipassmt2)"
        and  doms: "ifce \<in> dom (map_of ipassmt1)" "ifce \<in> dom (map_of ipassmt2)"
    shows "ipcidr_union_set (set d1) = assmt ipassmt1 ifce - assmt ipassmt2 ifce"
          "ipcidr_union_set (set d2) = assmt ipassmt2 ifce - assmt ipassmt1 ifce"
    using assms by (clarsimp simp add: ipassmt_diff_def Let_def assmt_def wordinterval_Union; simp add: ipcidr_union_set_uncurry uncurry_def wordinterval_to_set_ipcidr_tuple_to_wordinterval_uncurry)+

  text\<open>Explanation for interface @{term "Iface ''a''"}:
          Left ipassmt: The IP range 4/30 contains the addresses 4,5,6,7
          Diff: right ipassmt contains 6/32, so 4,5,7 is only in the left ipassmt.
          IP addresses 4,5 correspond to subnet 4/30.\<close>
  lemma "ipassmt_diff (ipassmt_generic_ipv4 @ [(Iface ''a'', [(4,30)])])
                       (ipassmt_generic_ipv4 @ [(Iface ''a'', [(6,32), (0,30)]), (Iface ''b'', [(42,32)])]) =
    [(Iface ''lo'', [], []),
     (Iface ''a'', [(4, 31),(7, 32)],
                   [(0, 30)]
     ),
     (Iface ''b'', [], [(42, 32)])]" by eval

end