(*
  Title: Dynamic Authorization Protocol - Message Transaction
  Author: Felipe Rodopoulos de Oliveira
*)

theory DAP_Transaction imports "./Smartphone"

begin

abbreviation
  Confirmation :: msg where "Confirmation \<equiv> (Number 1)"
abbreviation
  Success :: msg where "Success \<equiv> (Number 2)"

axiomatization where
  daptrans_assume_insecure_devices [iff]: "evs \<in> daptrans \<Longrightarrow> insecureP"

inductive_set daptrans :: "event list set" where
  Nil: "[] \<in> daptrans"

  (* Rule modeling the illegal behavior of the Spy *)
  | Fake: "\<lbrakk> evsF \<in> daptrans; X \<in> synth(analz(knows Spy evsF));
             illegalUse(Smartphone A); C \<noteq> Server; C \<noteq> Spy \<rbrakk>
    \<Longrightarrow> Says Spy B X #
        Scans Spy (Smartphone A) X #
        Shows (Smartphone Spy) C X # evsF \<in> daptrans"

  (* Reception invariant rules *)
  | Rcpt: "\<lbrakk> evsR \<in> daptrans; Says A B X \<in> set evsR \<rbrakk>
    \<Longrightarrow> Gets B X # evsR \<in> daptrans"

  | RcptS: "\<lbrakk> evsRs \<in> daptrans; Scans A (Smartphone B) X \<in> set evsRs \<rbrakk>
    \<Longrightarrow> SGets (Smartphone B) X # evsRs \<in> daptrans"

  | RcptA: "\<lbrakk> evsRa \<in> daptrans; Shows (Smartphone A) B X \<in> set evsRa \<rbrakk>
    \<Longrightarrow> AGets B X # evsRa \<in> daptrans"

  | RcptI: "\<lbrakk> evsRi \<in> daptrans; Inputs A (Smartphone B) X \<in> set evsRi \<rbrakk>
    \<Longrightarrow> SGets (Smartphone B) X # evsRi \<in> daptrans"

  (* Protocol rules *)
  | DT1: "\<lbrakk> evs1 \<in> daptrans; A \<noteq> Server \<rbrakk>
    \<Longrightarrow> Says A Server \<lbrace> Agent A, Number T \<rbrace> # evs1 \<in> daptrans"

  | DT2: "\<lbrakk> evs2 \<in> daptrans; Nonce r \<notin> used evs2;
            Gets Server \<lbrace> Agent A, Number T \<rbrace> \<in> set evs2 \<rbrakk>
    \<Longrightarrow> Says Server A \<lbrace>
          \<lbrace> Agent A, Number T \<rbrace>,
          Crypt (shrK A) (Nonce r),
          Crypt (shrK A) \<lbrace> \<lbrace>Agent A, Number T\<rbrace>, Crypt (shrK A) (Nonce r) \<rbrace>
        \<rbrace> # evs2 \<in> daptrans"

  | DT3: "\<lbrakk> evs3 \<in> daptrans; legalUse (Smartphone A); A \<noteq> Server;
            Says A Server \<lbrace> Agent A, Number T \<rbrace> \<in> set evs3;
            Gets A \<lbrace> \<lbrace> Agent A, Number T \<rbrace>, r', h\<^sub>s \<rbrace> \<in> set evs3 \<rbrakk>
    \<Longrightarrow> Scans A (Smartphone A) \<lbrace> \<lbrace>Agent A, Number T\<rbrace>, r', h\<^sub>s \<rbrace> # evs3 \<in> daptrans"

  | DT4: "\<lbrakk> evs4 \<in> daptrans; legalUse(Smartphone A); A \<noteq> Server;
            SGets (Smartphone A) \<lbrace>
              \<lbrace>Agent A, Number T\<rbrace>,
              Crypt (shrK A) (Nonce r),
              Crypt (shrK A) \<lbrace> \<lbrace>Agent A, Number T\<rbrace>, Crypt (shrK A) (Nonce r) \<rbrace>
            \<rbrace> \<in> set evs4 \<rbrakk>
    \<Longrightarrow> Shows (Smartphone A) A \<lbrace>Agent A, Number T\<rbrace> # evs4 \<in> daptrans"

  | DT5: "\<lbrakk> evs5 \<in> daptrans; legalUse(Smartphone A);
            Says A Server \<lbrace> Agent A, Number T \<rbrace> \<in> set evs5;
            Gets A \<lbrace> \<lbrace> Agent A, Number T \<rbrace>, r', h\<^sub>s \<rbrace> \<in> set evs5;
            Scans A (Smartphone A) \<lbrace> \<lbrace>Agent A, Number T\<rbrace>, r', h\<^sub>s \<rbrace> \<in> set evs5;
            Shows (Smartphone A) A \<lbrace>Agent A, Number T\<rbrace> \<in> set evs5 \<rbrakk>
    \<Longrightarrow> Inputs A (Smartphone A) \<lbrace>Agent A, Number T, Confirmation\<rbrace> # evs5 \<in> daptrans"

  | DT6: "\<lbrakk> evs6 \<in> daptrans; legalUse(Smartphone A); A \<noteq> Server;
            SGets (Smartphone A) \<lbrace>
              \<lbrace>Agent A, Number T\<rbrace>,
              Crypt (shrK A) (Nonce r),
              Crypt (shrK A) \<lbrace> \<lbrace>Agent A, Number T\<rbrace>, Crypt (shrK A) (Nonce r) \<rbrace>
            \<rbrace> \<in> set evs6;
            Shows (Smartphone A) A \<lbrace>Agent A, Number T\<rbrace> \<in> set evs6;
            SGets (Smartphone A) \<lbrace>Agent A, Number T, Confirmation\<rbrace> \<in> set evs6 \<rbrakk>
   \<Longrightarrow> Shows (Smartphone A) A (Nonce r) # evs6 \<in> daptrans"

  | DT7: "\<lbrakk> evs7 \<in> daptrans; A \<noteq> Server;
            Says A Server \<lbrace>Agent A, Number T\<rbrace> \<in> set evs7;
            Gets A \<lbrace> \<lbrace>Agent A, Number T\<rbrace>, r', h\<^sub>s \<rbrace> \<in> set evs7;
            Scans A (Smartphone A) \<lbrace> \<lbrace>Agent A, Number T\<rbrace>, r', h\<^sub>s \<rbrace> \<in> set evs7;
            Shows (Smartphone A) A \<lbrace>Agent A, Number T\<rbrace> \<in> set evs7;
            Inputs A (Smartphone A) \<lbrace>Agent A, Number T, Confirmation\<rbrace> \<in> set evs7;
            AGets A (Nonce r) \<in> set evs7 \<rbrakk>
    \<Longrightarrow> Says A Server (Nonce r) # evs7 \<in> daptrans"

  | DT8: "\<lbrakk> evs8 \<in> daptrans;
            Gets Server \<lbrace>Agent A, Number T\<rbrace> \<in> set evs8;
            Says Server A \<lbrace> \<lbrace>Agent A, Number T\<rbrace>, Crypt (shrK A) (Nonce r),
              Crypt (shrK A) \<lbrace> \<lbrace>Agent A, Number T\<rbrace>, Crypt (shrK A) (Nonce r) \<rbrace>
            \<rbrace> \<in> set evs8;
            Gets Server (Nonce r) \<in> set evs8 \<rbrakk>
    \<Longrightarrow> Says Server A Success # evs8 \<in> daptrans"

declare Fake_parts_insert_in_Un [dest]
declare analz_into_parts [dest]

(* GENERAL LEMMAS ON MESSAGE RECEPTION *)

lemma Gets_imp_Says :
  "\<lbrakk> Gets B X \<in> set evs; evs \<in> daptrans \<rbrakk> \<Longrightarrow> \<exists> A. Says A B X \<in> set evs"

  apply (erule rev_mp, erule daptrans.induct)
  apply (auto)
done

lemma Gets_imp_knows_Spy :
  "\<lbrakk> Gets B X \<in> set evs; evs \<in> daptrans \<rbrakk> \<Longrightarrow> X \<in> knows Spy evs"
by (blast dest!: Gets_imp_Says Says_imp_knows_Spy)

lemma Gets_imp_knows_Spy_analz :
  "\<lbrakk> Gets B X \<in> set evs; evs \<in> daptrans \<rbrakk> \<Longrightarrow> X \<in> analz (knows Spy evs)"
by (blast dest!: Gets_imp_Says Says_imp_knows_Spy)

lemma Gets_imp_knows_Spy_analz_Snd :
 "\<lbrakk> Gets B \<lbrace>X, Y\<rbrace> \<in> set evs; evs \<in> daptrans \<rbrakk> \<Longrightarrow> Y \<in> analz (knows Spy evs)"

  apply (blast dest!: Gets_imp_Says Says_imp_knows_Spy analz.Inj analz.Snd)
done

lemmas Gets_imp_knows_Spy_parts = Gets_imp_knows_Spy_analz [THEN analz_into_parts]
lemmas Gets_imp_knows_Spy_parts_Snd = Gets_imp_knows_Spy_analz_Snd [THEN analz_into_parts]

lemma SGets_imp_Scans_or_Inputs :
  "\<lbrakk> SGets P X \<in> set evs; evs \<in> daptrans \<rbrakk>
    \<Longrightarrow> \<exists> A. (Scans A P X \<in> set evs) \<or> (Inputs A P X \<in> set evs)"

  apply (erule rev_mp, erule daptrans.induct)
  apply (auto)
done

lemma SGets_imp_knows_Spy :
  "\<lbrakk> SGets (Smartphone B) X \<in> set evs; (Smartphone B) \<in> badP; evs \<in> daptrans \<rbrakk>
    \<Longrightarrow> X \<in> knows Spy evs"

  apply (erule rev_mp, erule rev_mp)
  apply (erule daptrans.induct)
  apply (auto)
done

lemma SGets_imp_knows_Spy_analz :
  "\<lbrakk> SGets (Smartphone B) X \<in> set evs; (Smartphone B) \<in> badP; evs \<in> daptrans \<rbrakk>
    \<Longrightarrow> X \<in> analz (knows Spy evs)"
by (blast dest!: SGets_imp_knows_Spy)

lemmas SGets_imp_knows_Spy_parts = SGets_imp_knows_Spy_analz [THEN analz_into_parts]

lemma AGets_imp_Shows :
  "\<lbrakk> AGets A X \<in> set evs; evs \<in> daptrans \<rbrakk> \<Longrightarrow> \<exists> P. Shows P A X \<in> set evs"

  apply (erule rev_mp, erule daptrans.induct)
  apply (auto)
done

(* - Lemmas on insecure devices, from the EventSP.thy, now proved for DAP_Transaction *)

lemma Scans_imp_knows_Spy_insecureP_daptrans :
  "\<lbrakk> Scans Spy P X \<in> set evs; evs \<in> daptrans \<rbrakk> \<Longrightarrow> X \<in> knows Spy evs"

  apply (simp (no_asm_simp) add: Scans_imp_knows_Spy)
done

lemma knows_Spy_Scans_insecureP_daptrans_Spy :
  "evs \<in> daptrans \<Longrightarrow> knows Spy (Scans Spy P X # evs) = insert X (knows Spy evs)"
by simp

lemma knows_Spy_Scans_insecureP_daptrans :
  "\<lbrakk> A \<noteq> Spy; A \<in> bad; evs \<in> daptrans \<rbrakk>
    \<Longrightarrow> knows Spy (Scans A P X # evs) = insert X (knows Spy evs)"
by simp

lemma knows_Spy_Shows_insecureM_daptrans_Spy :
  "\<lbrakk> P \<notin> badP; evs \<in> daptrans \<rbrakk>
    \<Longrightarrow> knows Spy (Shows P Spy X # evs) = knows Spy evs"
by simp

lemma knows_Spy_Shows_insecureM_daptrans :
  "\<lbrakk> P \<in> badP; evs \<in> daptrans \<rbrakk>
    \<Longrightarrow> knows Spy (Shows P A X # evs) = insert X (knows Spy evs)"
by simp

lemma knows_Spy_Inputs_daptrans_Spy :
  "evs \<in> daptrans \<Longrightarrow> knows Spy (Inputs Spy P X # evs) = insert X (knows Spy evs)"
by simp

lemma knows_Spy_Inputs_daptrans :
  "\<lbrakk> A \<noteq> Spy; evs \<in> daptrans \<rbrakk>
    \<Longrightarrow> knows Spy (Inputs A P X # evs) = knows Spy evs"
by simp

(* RELIABILITY LEMMAS *)

(* 1. General Server guarantees *)

(* Server cannot initiate the protocol *)
lemma Says_Server_DT1_not_evs :
  "evs \<in> daptrans \<Longrightarrow> Says Server Server \<lbrace> Agent Server, Number T \<rbrace> \<notin> set evs"

  apply (erule daptrans.induct)
  apply (simp_all)
done

lemma Server_cannot_initiate :
  "\<lbrakk> Says A Server \<lbrace> Agent A, Number T \<rbrace> \<in> set evs; evs \<in> daptrans \<rbrakk> \<Longrightarrow> A \<noteq> Server"

  apply (erule rev_mp, erule daptrans.induct)
  apply (simp_all)
done

(* - The Server smartphone is not usable *)

lemma Scans_Agent_Server_not_evs [rule_format] :
  "evs \<in> daptrans \<Longrightarrow> Scans Server (Smartphone A) X \<notin> set evs"

  apply (erule daptrans.induct)
  apply (auto)
done

lemma Scans_Server_Agent_not_evs [rule_format] :
  "evs \<in> daptrans \<Longrightarrow> Scans A (Smartphone Server) X \<notin> set evs"

  apply (erule daptrans.induct)
  apply (auto)
done

lemma Shows_Agent_Server_not_evs [rule_format] :
  "evs \<in> daptrans \<Longrightarrow> Shows (Smartphone A) Server X \<notin> set evs"

  apply (erule daptrans.induct)
  apply (simp_all)
done

lemma Shows_Server_Agent_not_evs [rule_format]:
  "evs \<in> daptrans \<Longrightarrow> Shows (Smartphone Server) A X \<notin> set evs"

  apply (erule daptrans.induct)
  apply (simp_all)
done

(* - Server expected message form to the sender *)

lemma Says_Server_DT2 :
  "\<lbrakk> Says Server A \<lbrace>
       \<lbrace>Agent A, Number T\<rbrace>,
       Crypt (shrK A) (Nonce r),
       Crypt (shrK A) \<lbrace> \<lbrace>Agent A, Number T\<rbrace>, Crypt (shrK A) (Nonce r) \<rbrace>
     \<rbrace> \<in> set evs; evs \<in> daptrans \<rbrakk>
    \<Longrightarrow> Gets Server \<lbrace>Agent A, Number T\<rbrace> \<in> set evs"

  apply (erule rev_mp, erule daptrans.induct)
  apply (auto)
done

lemma Says_Server_form_DT2 :
  "\<lbrakk> Says Server A \<lbrace> \<lbrace>Agent A, Number T\<rbrace>, r', h\<^sub>s \<rbrace> \<in> set evs; evs \<in> daptrans \<rbrakk>
    \<Longrightarrow> (\<exists> r.
         r' = Crypt (shrK A) (Nonce r) \<and>
         h\<^sub>s = Crypt (shrK A) \<lbrace> \<lbrace>Agent A, Number T\<rbrace>, Crypt (shrK A) (Nonce r) \<rbrace>)"

  apply (erule rev_mp, erule daptrans.induct)
  apply (auto)
done

(* - The Server only authorizes a transaction if
     it received a nonce that matches the produced TAN *)

lemma Says_Server_Success :
  "\<lbrakk> Says Server A Success \<in> set evs; evs \<in> daptrans \<rbrakk>
    \<Longrightarrow> \<exists> T r.
          Gets Server \<lbrace>Agent A, Number T\<rbrace> \<in> set evs \<and>
          Says Server A \<lbrace>
            \<lbrace>Agent A, Number T\<rbrace>,
            Crypt (shrK A) (Nonce r),
            Crypt (shrK A) \<lbrace>\<lbrace>Agent A, Number T\<rbrace>, Crypt (shrK A) (Nonce r)\<rbrace>
          \<rbrace> \<in> set evs \<and>
          Gets Server (Nonce r) \<in> set evs"

  apply (erule rev_mp, erule daptrans.induct)
  apply (auto)
done

(* 2. General guarantees on smartphones usability *)

(* - Defining legalUse conditions *)

lemma Scans_Smartphone_legalUse :
  "\<lbrakk> Scans A (Smartphone A) X \<in> set evs; evs \<in> daptrans \<rbrakk> \<Longrightarrow> legalUse(Smartphone A)"
apply (erule rev_mp, erule daptrans.induct)
apply (auto)
done

lemma Shows_Smartphone_legalUse :
  "\<lbrakk> Shows (Smartphone A) A X \<in> set evs; evs \<in> daptrans \<rbrakk> \<Longrightarrow> legalUse(Smartphone A)"
apply (erule rev_mp, erule daptrans.induct)
apply (auto)
done

(* - Legal agents' smartphones firing Scans/Shows must be their owners
     performing a legal action or the Spy performing an illegal action *)

lemma Scans_Smartphone :
  "\<lbrakk> Scans A P X \<in> set evs; A \<noteq> Spy; evs \<in> daptrans \<rbrakk>
    \<Longrightarrow> (P = (Smartphone A) \<and> legalUse(P)) \<or> (P = (Smartphone Spy) \<and> illegalUse(P))"

  apply (erule rev_mp, erule daptrans.induct)
  apply (auto)
done

lemma Shows_Smartphone :
  "\<lbrakk> Shows P A X \<in> set evs; A \<noteq> Spy; evs \<in> daptrans \<rbrakk>
    \<Longrightarrow> (P = (Smartphone A) \<and> legalUse(P)) \<or> (P = (Smartphone Spy))"

  apply (erule rev_mp, erule daptrans.induct)
  apply (simp_all)
done

lemma Scans_Shows_Smartphone :
  "\<lbrakk> Scans A P X \<in> set evs \<or> Shows P A X \<in> set evs; A \<noteq> Spy; evs \<in> daptrans \<rbrakk>
     \<Longrightarrow> (P = (Smartphone A) \<and> legalUse(Smartphone A)) \<or> (P = (Smartphone Spy))"

  apply (blast dest: Scans_Smartphone Shows_Smartphone)
done

(* - The spy can act both legally (using her smartphone) or illegally (using someone else) *)
lemma Scans_Smartphone_Spy :
  "\<lbrakk> Scans Spy P X \<in> set evs \<or> Shows P Spy X \<in> set evs; evs \<in> daptrans \<rbrakk>
      \<Longrightarrow> (P = (Smartphone Spy)) \<and> (legalUse(Smartphone Spy)) \<or>
          (\<exists> A. P = (Smartphone A) \<and> illegalUse(Smartphone A))"

  apply (erule rev_mp, erule daptrans.induct)
  apply (auto)
done

(* 3. Protocol termination  *)

lemma Protocol_terminates :
  "\<exists> A Success. \<exists> evs \<in> daptrans. A \<noteq> Server \<and> Says Server A Success \<in> set evs"

  apply (intro exI bexI)
  apply (rule_tac [2] daptrans.Nil [THEN daptrans.DT1, THEN daptrans.Rcpt,
        THEN daptrans.DT2, THEN daptrans.Rcpt,
        THEN daptrans.DT3, THEN daptrans.RcptS,
        THEN daptrans.DT4, THEN daptrans.RcptA,
        THEN daptrans.DT5, THEN daptrans.RcptI,
        THEN daptrans.DT6, THEN daptrans.RcptA,
        THEN daptrans.DT7, THEN daptrans.Rcpt,
        THEN daptrans.DT8])
  apply (possibility, auto)
done

(* 4. Scans & Inputs events guarantees *)

lemma Scans_A_Smartphone_3 :
  "\<lbrakk> Scans A P \<lbrace> \<lbrace>Agent A, Number T\<rbrace>, r', h\<^sub>s \<rbrace> \<in> set evs; A \<noteq> Spy; evs \<in> daptrans \<rbrakk>
    \<Longrightarrow> (legalUse(P)) \<and> P = (Smartphone A) \<and>
        Says A Server \<lbrace>Agent A, Number T\<rbrace> \<in> set evs \<and>
        Gets A \<lbrace> \<lbrace> Agent A, Number T \<rbrace>, r', h\<^sub>s \<rbrace> \<in> set evs"

  apply (erule rev_mp, erule daptrans.induct)
  apply (simp_all)
done

(* This is an important guarantee: the protocol legally continues if the agent confirms the
     outputed message, which contains the transaction *)
lemma Inputs_A_Smartphone_5 :
  "\<lbrakk> Inputs A P \<lbrace>Agent A, Number T, Confirmation\<rbrace> \<in> set evs; A \<noteq> Spy; evs \<in> daptrans \<rbrakk>
    \<Longrightarrow> (legalUse(P)) \<and> P = (Smartphone A) \<and>
        (\<exists> r' h\<^sub>s. Says A Server \<lbrace>Agent A, Number T\<rbrace> \<in> set evs \<and>
        Gets A \<lbrace> \<lbrace>Agent A, Number T\<rbrace>, r', h\<^sub>s \<rbrace> \<in> set evs \<and>
        Scans A (Smartphone A) \<lbrace> \<lbrace>Agent A, Number T\<rbrace>, r', h\<^sub>s \<rbrace> \<in> set evs \<and>
        Shows (Smartphone A) A \<lbrace>Agent A, Number T\<rbrace> \<in> set evs)"

  apply (erule rev_mp, erule daptrans.induct)
  apply (auto)
done

(* - Message form guarantees *)

lemma Scans_A_Smartphone_form_3 :
  "\<lbrakk> Scans A (Smartphone A) \<lbrace> Transaction, r', h\<^sub>s \<rbrace> \<in> set evs;
     \<forall> p q. Transaction = \<lbrace>p, q\<rbrace>; evs \<in> daptrans \<rbrakk>
    \<Longrightarrow> (\<exists> T r. Transaction = \<lbrace> Agent A, Number T \<rbrace>)"

  apply (erule rev_mp, erule daptrans.induct)
  apply (auto)
done

lemma Scans_A_Smartphone_form_DT3:
  "\<lbrakk> Scans A (Smartphone A) \<lbrace> \<lbrace>Agent A, Number T\<rbrace>, r', h\<^sub>s \<rbrace> \<in> set evs; evs \<in> daptrans \<rbrakk>
    \<Longrightarrow> \<exists> r. r' = Crypt (shrK A) (Nonce r) \<and>
             h\<^sub>s = Crypt (shrK A) \<lbrace> \<lbrace>Agent A, Number T\<rbrace>, Crypt (shrK A) (Nonce r) \<rbrace>"

  apply (erule rev_mp, erule daptrans.induct)
  apply (simp_all)
  apply (force)
oops

(* 5. Shows events guarantees *)

(* First, we state that Smartphones provide correct Shows when fed with expected Scans.
   Such lemmas guarantee that Smartphones cannot produce unexpected Shows, preventing the
   Spy from having unlimited resources *)
lemma Shows_A_Smartphone_4 :
  "\<lbrakk> Shows P A \<lbrace>Agent A, Number T\<rbrace> \<in> set evs; evs \<in> daptrans \<rbrakk>
    \<Longrightarrow> ((legalUse(P)) \<and> P = (Smartphone A)) \<or> ((illegalUse(P)) \<and> P = (Smartphone Spy)) \<and>
        (\<exists> r. SGets (Smartphone A) \<lbrace>
          \<lbrace>Agent A, Number T\<rbrace>,
          Crypt (shrK A) (Nonce r),
          Crypt (shrK A) \<lbrace> \<lbrace>Agent A, Number T\<rbrace>, Crypt (shrK A) (Nonce r) \<rbrace>
        \<rbrace> \<in> set evs)"

  apply (erule rev_mp, erule daptrans.induct)
  apply (simp_all)
  defer
  apply (blast+)
oops

lemma Shows_honest_A_Smartphone_4 :
  "\<lbrakk> Shows P A \<lbrace>Agent A, Number T\<rbrace> \<in> set evs; evs \<in> daptrans \<rbrakk>
    \<Longrightarrow> (legalUse(P)) \<and> P = (Smartphone A) \<and>
        (\<exists> r. SGets (Smartphone A) \<lbrace>
          \<lbrace>Agent A, Number T\<rbrace>,
          Crypt (shrK A) (Nonce r),
          Crypt (shrK A) \<lbrace> \<lbrace>Agent A, Number T\<rbrace>, Crypt (shrK A) (Nonce r) \<rbrace>
        \<rbrace> \<in> set evs)"

  apply (erule rev_mp, erule daptrans.induct)
  apply (simp_all)
  defer
  apply (blast+)
oops

lemma Shows_which_Smartphone_4 :
  "\<lbrakk> Shows (Smartphone A) A \<lbrace>Agent A, Number T\<rbrace> \<in> set evs; evs \<in> daptrans \<rbrakk>
    \<Longrightarrow> (\<exists> r. SGets (Smartphone A) \<lbrace>
          \<lbrace>Agent A, Number T\<rbrace>,
          Crypt (shrK A) (Nonce r),
          Crypt (shrK A) \<lbrace> \<lbrace>Agent A, Number T\<rbrace>, Crypt (shrK A) (Nonce r) \<rbrace>
        \<rbrace> \<in> set evs)"

  apply (erule rev_mp, erule daptrans.induct)
  apply (simp_all)
  defer
  apply (blast+)
done

lemma Shows_A_Smartphone_6 :
  "\<lbrakk> Shows P A (Nonce r) \<in> set evs; evs \<in> daptrans \<rbrakk>
    \<Longrightarrow> (\<exists> T. SGets (Smartphone A) \<lbrace>Agent A, Number T, Confirmation\<rbrace> \<in> set evs)"

  apply (erule rev_mp, erule daptrans.induct)
  apply (simp_all)
  defer
  apply (blast+)
oops

lemma Shows_honest_A_Smartphone_6 :
  "\<lbrakk> Shows P A (Nonce r) \<in> set evs; A \<noteq> Spy; evs \<in> daptrans \<rbrakk>
    \<Longrightarrow> (legalUse(P)) \<and> P = (Smartphone A) \<and>
        (\<exists> T. SGets (Smartphone A) \<lbrace>Agent A, Number T, Confirmation\<rbrace> \<in> set evs)"

  apply (erule rev_mp, erule daptrans.induct)
  apply (simp_all)
  defer
  apply (blast+)
oops

lemma Shows_which_Smartphone_6 :
  "\<lbrakk> Shows (Smartphone A) A (Nonce r) \<in> set evs; evs \<in> daptrans \<rbrakk>
    \<Longrightarrow> (\<exists> T. SGets (Smartphone A) \<lbrace>Agent A, Number T, Confirmation\<rbrace> \<in> set evs)"

  apply (erule rev_mp, erule daptrans.induct)
  apply (auto)
done

(* - Shows messages form guarantees *)

lemma Shows_A_Smartphone_form_4 :
  "\<lbrakk> Shows (Smartphone A) A Transaction \<in> set evs; \<forall> p q. Transaction = \<lbrace>p, q\<rbrace>;
     evs \<in> daptrans \<rbrakk>
    \<Longrightarrow> \<exists> T. Transaction = \<lbrace>Agent A, Number T\<rbrace>"

  apply (erule rev_mp, erule daptrans.induct)
  apply (simp_all)
done

lemma Shows_A_Smartphone_form_6 :
  "\<lbrakk> Shows (Smartphone A) A TAN \<in> set evs; \<forall> p q. TAN \<noteq> \<lbrace>p, q\<rbrace>; evs \<in> daptrans \<rbrakk>
    \<Longrightarrow> \<exists> r. TAN = (Nonce r)"

  apply (erule rev_mp, erule rev_mp, erule daptrans.induct)
  apply (simp_all, blast)
done

(* 6. Spy guarantees *)

lemma Spy_knows_Transaction :
  "\<lbrakk> Says A Server \<lbrace>Agent A, Number T\<rbrace> \<in> set evs; evs \<in> daptrans \<rbrakk>
     \<Longrightarrow> Number T \<in> analz (knows Spy evs)"
by (blast dest!: Says_imp_knows_Spy [THEN analz.Inj, THEN analz.Snd])

lemma Spy_knows_TAN :
  "\<lbrakk> Says A Server (Nonce r) \<in> set evs; evs \<in> daptrans \<rbrakk>
    \<Longrightarrow> Nonce r \<in> knows Spy evs"
by (blast dest!: Says_imp_knows_Spy)

(* REGULARITY LEMMAS *)

(* For reasoning about encrypted portion of messages *)
lemma DT3_analz_knows_Spy_fst :
 "\<lbrakk> Gets A \<lbrace> \<lbrace>Agent A, Number T\<rbrace>, r', h\<^sub>s \<rbrace> \<in> set evs; evs \<in> daptrans \<rbrakk>
    \<Longrightarrow> r' \<in> analz (knows Spy evs)"
by (blast dest!: Gets_imp_Says Gets_imp_knows_Spy_analz_Snd)

lemma DT3_analz_knows_Spy_snd :
 "\<lbrakk> Gets A \<lbrace> \<lbrace>Agent A, Number T\<rbrace>, r', h\<^sub>s \<rbrace> \<in> set evs; evs \<in> daptrans \<rbrakk>
    \<Longrightarrow> h\<^sub>s \<in> analz (knows Spy evs)"
by (blast dest!: Gets_imp_Says Gets_imp_knows_Spy_analz_Snd)

lemmas DT3_parts_knows_Spy_fst = DT3_analz_knows_Spy_fst [THEN analz_into_parts]
lemmas DT3_parts_knows_Spy_snd = DT3_analz_knows_Spy_snd [THEN analz_into_parts]

lemma shrK_not_in_honest_Scans [dest]:
  "\<lbrakk>Scans A (Smartphone A) X \<in> set evs; A \<notin> bad; Smartphone P \<notin> badP; evs \<in> daptrans\<rbrakk>
    \<Longrightarrow> Key (shrK A) \<notin> analz {X}"

  apply (erule rev_mp, erule rev_mp, erule rev_mp)
  apply (erule daptrans.induct)
  apply (frule_tac [9] DT3_parts_knows_Spy_fst)
  apply (frule_tac [10] DT3_parts_knows_Spy_snd)
  apply (simp_all, blast)
  apply (auto)
sorry

lemma Spy_parts_keys [simp] :
  "evs \<in> daptrans \<Longrightarrow> (Key (shrK A) \<in> parts (knows Spy evs)) = (Smartphone A \<in> badP)"

  apply (erule daptrans.induct)
  apply (frule_tac [9] DT3_parts_knows_Spy_fst)
  apply (frule_tac [10] DT3_parts_knows_Spy_snd)
  apply (simp_all, blast)
  apply (auto)
sorry

lemma Spy_analz_shrK [simp] :
  "evs \<in> daptrans \<Longrightarrow> (Key (shrK A) \<in> analz (knows Spy evs)) = (Smartphone A \<in> badP)"
by (auto dest!: Spy_knows_bad_phones)

(* UNICITY LEMMAS *)

(* The TAN r uniquely identifies a transaction at the Server side *)
lemma Server_transaction_unique :
  "\<lbrakk> Says Server A \<lbrace>
      \<lbrace>Agent A, Number T\<rbrace>,
      Crypt (shrK A) (Nonce r),
      Crypt (shrK A) \<lbrace> \<lbrace>Agent A, Number T\<rbrace>, Crypt (shrK A) (Nonce r) \<rbrace>
    \<rbrace> \<in> set evs ;
    Says Server A' \<lbrace>
      \<lbrace>Agent A', Number T'\<rbrace>,
      Crypt (shrK A') (Nonce r),
      Crypt (shrK A') \<lbrace> \<lbrace>Agent A', Number T'\<rbrace>, Crypt (shrK A') (Nonce r) \<rbrace>
     \<rbrace> \<in> set evs;
    evs \<in> daptrans\<rbrakk>
   \<Longrightarrow> A = A' \<and> T = T'"

  apply (erule rev_mp, erule rev_mp)
  apply (erule daptrans.induct, simp_all)
  apply (fastforce dest: Says_parts_used)
done

(* AUTHENTICITY LEMMAS *)
lemma Checksum_authentic :
  "\<lbrakk> Crypt (shrK A) \<lbrace> \<lbrace>Agent A, Number T\<rbrace>, r', h\<^sub>s \<rbrace> \<in> parts (knows Spy evs);
     (Smartphone A) \<notin> badP; evs \<in> daptrans \<rbrakk>
     \<Longrightarrow> r' = Crypt (shrK A) (Nonce r) \<and>
         h\<^sub>s = Crypt (shrK A) \<lbrace> \<lbrace>Agent A, Number T\<rbrace>, Crypt (shrK A) (Nonce r)\<rbrace> \<and>
         Says Server A \<lbrace>
            \<lbrace>Agent A, Number T\<rbrace>,
            Crypt (shrK A) (Nonce r),
            Crypt (shrK A) \<lbrace> \<lbrace>Agent A, Number T\<rbrace>, Crypt (shrK A) (Nonce r) \<rbrace>
         \<rbrace> \<in> set evs"

  apply (erule rev_mp, erule daptrans.induct)
  apply (simp_all (no_asm_simp))
oops

end


(*
 * Copyright 2014, General Dynamics C4 Systems
 *
 * This software may be distributed and modified according to the terms of
 * the GNU General Public License version 2. Note that NO WARRANTY is provided.
 * See "LICENSE_GPLv2.txt" for details.
 *
 * @TAG(GD_GPL)
 *)

(*
CSpace invariants
*)

theory ArchCSpaceInvPre_AI
imports "../CSpaceInvPre_AI"
begin
context Arch begin global_naming ARM

lemma aobj_ref_acap_rights_update[simp]:
  "aobj_ref (acap_rights_update f x) = aobj_ref x"
  by (cases x; simp add: acap_rights_update_def)

lemma arch_obj_size_acap_rights_update[simp]:
  "arch_obj_size (acap_rights_update f x) = arch_obj_size x"
  by (cases x; simp add: acap_rights_update_def)

lemma valid_arch_cap_acap_rights_update[intro]:
  "valid_arch_cap x s \<Longrightarrow> valid_arch_cap (acap_rights_update f x) s"
  by (cases x; simp add: acap_rights_update_def valid_arch_cap_def)

definition
  cap_master_arch_cap where
  "cap_master_arch_cap acap \<equiv>
     (case acap of
           arch_cap.PageCap dev ref rghts sz mapdata \<Rightarrow>
              arch_cap.PageCap dev ref UNIV sz None
         | arch_cap.ASIDPoolCap pool asid \<Rightarrow>
              arch_cap.ASIDPoolCap pool 0
         | arch_cap.PageTableCap ptr data \<Rightarrow>
              arch_cap.PageTableCap ptr None
         | arch_cap.PageDirectoryCap ptr data \<Rightarrow>
              arch_cap.PageDirectoryCap ptr None
         | _ \<Rightarrow> acap)"

lemma
  cap_master_arch_cap_eqDs1:
  "cap_master_arch_cap cap =  (arch_cap.PageCap dev ref rghts sz mapdata)
     \<Longrightarrow> rghts = UNIV \<and> mapdata = None
          \<and> (\<exists>rghts mapdata. cap =  (arch_cap.PageCap dev ref rghts sz mapdata))"
  "cap_master_arch_cap cap =  arch_cap.ASIDControlCap
     \<Longrightarrow> cap =  arch_cap.ASIDControlCap"
  "cap_master_arch_cap cap =  (arch_cap.ASIDPoolCap pool asid)
     \<Longrightarrow> asid = 0 \<and> (\<exists>asid. cap =  (arch_cap.ASIDPoolCap pool asid))"
  "cap_master_arch_cap cap =  (arch_cap.PageTableCap ptr data)
     \<Longrightarrow> data = None \<and> (\<exists>data. cap =  (arch_cap.PageTableCap ptr data))"
  "cap_master_arch_cap cap =  (arch_cap.PageDirectoryCap ptr data2)
     \<Longrightarrow> data2 = None \<and> (\<exists>data2. cap =  (arch_cap.PageDirectoryCap ptr data2))"
  by (clarsimp simp: cap_master_arch_cap_def
             split: arch_cap.split_asm)+

lemma
  cap_master_arch_inv:
  "cap_master_arch_cap (cap_master_arch_cap ac) = cap_master_arch_cap ac"
  by (cases ac; simp add: cap_master_arch_cap_def)

definition
  "is_ap_cap cap \<equiv> case cap of (ArchObjectCap (arch_cap.ASIDPoolCap ap asid)) \<Rightarrow> True | _ \<Rightarrow> False"

lemmas is_ap_cap_simps [simp] = is_ap_cap_def [split_simps cap.split arch_cap.split]

definition
  "reachable_pg_cap cap \<equiv> \<lambda>s.
   is_pg_cap cap \<and>
   (\<exists>vref. vs_cap_ref cap = Some vref \<and> (vref \<unrhd> obj_ref_of cap) s)"

definition
  replaceable_final_arch_cap :: "'z::state_ext state \<Rightarrow> cslot_ptr \<Rightarrow> cap \<Rightarrow> cap \<Rightarrow> bool"
where
 "replaceable_final_arch_cap s sl newcap \<equiv> \<lambda>cap.
    (\<forall>vref. vs_cap_ref cap = Some vref
            \<longrightarrow> (vs_cap_ref newcap = Some vref
                   \<and> obj_refs newcap = obj_refs cap)
             \<or> (\<forall>oref \<in> obj_refs cap. \<not> (vref \<unrhd> oref) s))
  \<and> no_cap_to_obj_with_diff_ref newcap {sl} s
  \<and> ((is_pt_cap newcap \<or> is_pd_cap newcap) \<longrightarrow> cap_asid newcap = None
      \<longrightarrow> (\<forall> r \<in> obj_refs newcap.
            obj_at (empty_table (set (arm_global_pts (arch_state s)))) r s))
  \<and> ((is_pt_cap newcap \<or> is_pd_cap newcap)
         \<longrightarrow> ((is_pt_cap newcap \<and> is_pt_cap cap \<or> is_pd_cap newcap \<and> is_pd_cap cap)
                  \<longrightarrow> (cap_asid newcap = None \<longrightarrow> cap_asid cap = None)
                  \<longrightarrow> obj_refs cap \<noteq> obj_refs newcap)
         \<longrightarrow> (\<forall>sl'. cte_wp_at (\<lambda>cap'. obj_refs cap' = obj_refs newcap
                     \<and> (is_pd_cap newcap \<and> is_pd_cap cap' \<or> is_pt_cap newcap \<and> is_pt_cap cap')
                     \<and> (cap_asid newcap = None \<or> cap_asid cap' = None)) sl' s \<longrightarrow> sl' = sl))
  \<and> \<not>is_ap_cap newcap"

definition
  replaceable_non_final_arch_cap :: "'z::state_ext state \<Rightarrow> cslot_ptr \<Rightarrow> cap \<Rightarrow> cap \<Rightarrow> bool"
where
 "replaceable_non_final_arch_cap s sl newcap \<equiv> \<lambda>cap. \<not> reachable_pg_cap cap s"

declare
  replaceable_final_arch_cap_def[simp]
  replaceable_non_final_arch_cap_def[simp]

lemma unique_table_refsD:
  "\<lbrakk> unique_table_refs cps; cps p = Some cap; cps p' = Some cap';
     obj_refs cap = obj_refs cap'\<rbrakk>
     \<Longrightarrow> table_cap_ref cap = table_cap_ref cap'"
  unfolding unique_table_refs_def
  by blast

lemma table_cap_ref_vs_cap_ref_Some:
  "table_cap_ref x = Some y \<Longrightarrow> vs_cap_ref x = Some y"
  by (clarsimp simp: table_cap_ref_def vs_cap_ref_def
                 split: cap.splits arch_cap.splits)

lemma set_cap_valid_vs_lookup:
  "\<lbrace>\<lambda>s. valid_vs_lookup s
      \<and> (\<forall>vref cap'. cte_wp_at (op = cap') ptr s
                \<longrightarrow> vs_cap_ref cap' = Some vref
                \<longrightarrow> (vs_cap_ref cap = Some vref \<and> obj_refs cap = obj_refs cap')
                 \<or> (\<not> is_final_cap' cap' s \<and> \<not> reachable_pg_cap cap' s)
                 \<or> (\<forall>oref. oref \<in> obj_refs cap' \<longrightarrow> \<not> (vref \<unrhd> oref) s))
      \<and> unique_table_refs (caps_of_state s)\<rbrace>
     set_cap cap ptr
   \<lbrace>\<lambda>rv. valid_vs_lookup\<rbrace>"
  apply (simp add: valid_vs_lookup_def
              del: split_paired_All split_paired_Ex)
  apply (rule hoare_pre)
   apply (wp hoare_vcg_all_lift hoare_convert_imp[OF set_cap.vs_lookup_pages]
             hoare_vcg_disj_lift)
  apply (elim conjE allEI, rule impI, drule(1) mp)
  apply (simp only: simp_thms)
  apply (elim exE conjE)
  apply (case_tac "p' = ptr")
   apply (clarsimp simp: cte_wp_at_caps_of_state)
   apply (elim disjE impCE)
     apply fastforce
    apply clarsimp
    apply (drule (1) not_final_another_caps)
     apply (erule obj_ref_is_obj_irq_ref)
    apply (simp, elim exEI, clarsimp simp: obj_irq_refs_eq)
    apply (rule conjI, clarsimp)
    apply (drule(3) unique_table_refsD)
    apply (clarsimp simp: reachable_pg_cap_def is_pg_cap_def)
    apply (case_tac cap, simp_all add: vs_cap_ref_simps)[1]
    apply (rename_tac arch_cap)
    apply (case_tac arch_cap,
           simp_all add: vs_cap_ref_simps table_cap_ref_simps)[1]
       apply (clarsimp dest!: table_cap_ref_vs_cap_ref_Some)
      apply fastforce
     apply (clarsimp dest!: table_cap_ref_vs_cap_ref_Some)+
  apply (auto simp: cte_wp_at_caps_of_state)[1]
  done

crunch arch[wp]: set_cap "\<lambda>s. P (arch_state s)" (simp: split_def)

lemma set_cap_valid_table_caps:
  "\<lbrace>\<lambda>s. valid_table_caps s
         \<and> ((is_pt_cap cap \<or> is_pd_cap cap) \<longrightarrow> cap_asid cap = None
            \<longrightarrow> (\<forall>r \<in> obj_refs cap. obj_at (empty_table (set (arm_global_pts (arch_state s)))) r s))\<rbrace>
     set_cap cap ptr
   \<lbrace>\<lambda>rv. valid_table_caps\<rbrace>"
  apply (simp add: valid_table_caps_def)
  apply (wp hoare_vcg_all_lift
            hoare_vcg_disj_lift hoare_convert_imp[OF set_cap_caps_of_state]
            hoare_use_eq[OF set_cap_arch set_cap_obj_at_impossible])
  apply (simp add: empty_table_caps_of)
  done

lemma set_cap_unique_table_caps:
  "\<lbrace>\<lambda>s. unique_table_caps (caps_of_state s)
      \<and> ((is_pt_cap cap \<or> is_pd_cap cap)
             \<longrightarrow> (\<forall>oldcap. caps_of_state s ptr = Some oldcap \<longrightarrow>
                  (is_pt_cap cap \<and> is_pt_cap oldcap \<or> is_pd_cap cap \<and> is_pd_cap oldcap)
                    \<longrightarrow> (cap_asid cap = None \<longrightarrow> cap_asid oldcap = None)
                    \<longrightarrow> obj_refs oldcap \<noteq> obj_refs cap)
             \<longrightarrow> (\<forall>ptr'. cte_wp_at (\<lambda>cap'. obj_refs cap' = obj_refs cap
                                              \<and> (is_pd_cap cap \<and> is_pd_cap cap' \<or> is_pt_cap cap \<and> is_pt_cap cap')
                                              \<and> (cap_asid cap = None \<or> cap_asid cap' = None)) ptr' s \<longrightarrow> ptr' = ptr))\<rbrace>
     set_cap cap ptr
   \<lbrace>\<lambda>rv s. unique_table_caps (caps_of_state s)\<rbrace>"
  apply wp
  apply (simp only: unique_table_caps_def)
  apply (elim conjE)
  apply (erule impCE)
   apply clarsimp
  apply (erule impCE)
   prefer 2
   apply (simp del: imp_disjL)
   apply (thin_tac "\<forall>a b. P a b" for P)
   apply (auto simp: cte_wp_at_caps_of_state)[1]
  apply (clarsimp simp del: imp_disjL del: allI)
  apply (case_tac "cap_asid cap \<noteq> None")
   apply (clarsimp del: allI)
   apply (elim allEI | rule impI)+
   apply (auto simp: is_pt_cap_def is_pd_cap_def)[1]
  apply (elim allEI)
  apply (intro conjI impI)
   apply (elim allEI)
   apply (auto simp: is_pt_cap_def is_pd_cap_def)[1]
  apply (elim allEI)
  apply (auto simp: is_pt_cap_def is_pd_cap_def)[1]
  done

lemma set_cap_unique_table_refs:
  "\<lbrace>\<lambda>s. unique_table_refs (caps_of_state s)
      \<and> no_cap_to_obj_with_diff_ref cap {ptr} s\<rbrace>
     set_cap cap ptr
   \<lbrace>\<lambda>rv s. unique_table_refs (caps_of_state s)\<rbrace>"
  apply wp
  apply clarsimp
  apply (simp add: unique_table_refs_def
              split del: if_split del: split_paired_All)
  apply (erule allEI, erule allEI)
  apply (clarsimp split del: if_split)
  apply (clarsimp simp: no_cap_to_obj_with_diff_ref_def
                        cte_wp_at_caps_of_state
                 split: if_split_asm)
  done

lemma set_cap_valid_arch_caps:
  "\<lbrace>\<lambda>s. valid_arch_caps s
      \<and> (\<forall>vref cap'. cte_wp_at (op = cap') ptr s
                \<longrightarrow> vs_cap_ref cap' = Some vref
                \<longrightarrow> (vs_cap_ref cap = Some vref \<and> obj_refs cap = obj_refs cap')
                 \<or> (\<not> is_final_cap' cap' s \<and> \<not> reachable_pg_cap cap' s)
                 \<or> (\<forall>oref \<in> obj_refs cap'. \<not> (vref \<unrhd> oref) s))
      \<and> no_cap_to_obj_with_diff_ref cap {ptr} s
      \<and> ((is_pt_cap cap \<or> is_pd_cap cap) \<longrightarrow> cap_asid cap = None
            \<longrightarrow> (\<forall>r \<in> obj_refs cap. obj_at (empty_table (set (arm_global_pts (arch_state s)))) r s))
      \<and> ((is_pt_cap cap \<or> is_pd_cap cap)
             \<longrightarrow> (\<forall>oldcap. caps_of_state s ptr = Some oldcap \<longrightarrow>
                  (is_pt_cap cap \<and> is_pt_cap oldcap \<or> is_pd_cap cap \<and> is_pd_cap oldcap)
                    \<longrightarrow> (cap_asid cap = None \<longrightarrow> cap_asid oldcap = None)
                    \<longrightarrow> obj_refs oldcap \<noteq> obj_refs cap)
             \<longrightarrow> (\<forall>ptr'. cte_wp_at (\<lambda>cap'. obj_refs cap' = obj_refs cap
                                              \<and> (is_pd_cap cap \<and> is_pd_cap cap' \<or> is_pt_cap cap \<and> is_pt_cap cap')
                                              \<and> (cap_asid cap = None \<or> cap_asid cap' = None)) ptr' s \<longrightarrow> ptr' = ptr))\<rbrace>
     set_cap cap ptr
   \<lbrace>\<lambda>rv. valid_arch_caps\<rbrace>"
  apply (simp add: valid_arch_caps_def pred_conj_def)
  apply (wp set_cap_valid_vs_lookup set_cap_valid_table_caps
            set_cap_unique_table_caps set_cap_unique_table_refs)
  by simp_all blast+

lemma valid_table_capsD:
  "\<lbrakk> cte_wp_at (op = cap) ptr s; valid_table_caps s;
        is_pt_cap cap | is_pd_cap cap; cap_asid cap = None \<rbrakk>
        \<Longrightarrow> \<forall>r \<in> obj_refs cap. obj_at (empty_table (set (arm_global_pts (arch_state s)))) r s"
  apply (clarsimp simp: cte_wp_at_caps_of_state valid_table_caps_def)
  apply (cases ptr, fastforce)
  done

lemma unique_table_capsD:
  "\<lbrakk> unique_table_caps cps; cps ptr = Some cap; cps ptr' = Some cap';
     obj_refs cap = obj_refs cap'; cap_asid cap = None \<or> cap_asid cap' = None;
     (is_pd_cap cap \<and> is_pd_cap cap') \<or> (is_pt_cap cap \<and> is_pt_cap cap') \<rbrakk>
     \<Longrightarrow> ptr = ptr'"
  unfolding unique_table_caps_def
  by blast

lemma set_cap_cap_refs_in_kernel_window[wp]:
  "\<lbrace>cap_refs_in_kernel_window
         and (\<lambda>s. \<forall>ref \<in> cap_range cap. arm_kernel_vspace (arch_state s) ref
                         = ArmVSpaceKernelWindow)\<rbrace>
     set_cap cap p
   \<lbrace>\<lambda>rv. cap_refs_in_kernel_window\<rbrace>"
  apply (simp add: cap_refs_in_kernel_window_def valid_refs_def2
                   pred_conj_def)
  apply (rule hoare_lift_Pf2[where f=arch_state])
   apply wp
   apply (fastforce elim!: ranE split: if_split_asm)
  apply wp
  done

lemma cap_refs_in_kernel_windowD:
  "\<lbrakk> caps_of_state s ptr = Some cap; cap_refs_in_kernel_window s \<rbrakk>
   \<Longrightarrow> \<forall>ref \<in> cap_range cap.
         arm_kernel_vspace (arch_state s) ref = ArmVSpaceKernelWindow"
  apply (clarsimp simp: cap_refs_in_kernel_window_def valid_refs_def
                        cte_wp_at_caps_of_state)
  apply (cases ptr, fastforce)
  done

lemma valid_cap_imp_valid_vm_rights:
  "valid_cap (cap.ArchObjectCap (PageCap dev mw rs sz m)) s \<Longrightarrow>
   rs \<in> valid_vm_rights"
  by (simp add: valid_cap_def valid_vm_rights_def)

lemma acap_rights_update_idem [simp]:
  "acap_rights_update R (acap_rights_update R' cap) = acap_rights_update R cap"
  by (simp add: acap_rights_update_def split: arch_cap.splits)

lemma cap_master_arch_cap_rights [simp]:
  "cap_master_arch_cap (acap_rights_update R cap) = cap_master_arch_cap cap"
  by (simp add: cap_master_arch_cap_def acap_rights_update_def
           split: arch_cap.splits)

lemma acap_rights_update_id [intro!, simp]:
  "valid_arch_cap ac s \<Longrightarrow> acap_rights_update (acap_rights ac) ac = ac"
  unfolding acap_rights_update_def acap_rights_def valid_arch_cap_def
  by (cases ac; simp)

lemma obj_ref_none_no_asid:
  "{} = obj_refs new_cap \<longrightarrow> None = table_cap_ref new_cap"
  "obj_refs new_cap = {} \<longrightarrow> table_cap_ref new_cap = None"
  by (simp add: table_cap_ref_def split: cap.split arch_cap.split)+
end

end


(*  Title:      HOL/Auth/n_g2kAbsAfter_lemma_on_inv__66.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_g2kAbsAfter Protocol Case Study*}

theory n_g2kAbsAfter_lemma_on_inv__66 imports n_g2kAbsAfter_base
begin
section{*All lemmas on causal relation between inv__66 and some rule r*}
lemma n_n_RecvInvAck_i1Vsinv__66:
assumes a1: "(r=n_n_RecvInvAck_i1  )" and
a2: "(f=inv__66  )"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
have "((formEval (eqn (IVar (Ident ''ExGntd'')) (Const true)) s))\<or>((formEval (neg (eqn (IVar (Ident ''ExGntd'')) (Const true))) s))" by auto
  moreover {
    assume c1: "((formEval (eqn (IVar (Ident ''ExGntd'')) (Const true)) s))"
    have "?P1 s"
    proof(cut_tac a1 a2  c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (neg (eqn (IVar (Ident ''ExGntd'')) (Const true))) s))"
    have "?P2 s"
    proof(cut_tac a1 a2  c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_n_SendGntE_i1Vsinv__66:
assumes a1: "(r=n_n_SendGntE_i1  )" and
a2: "(f=inv__66  )"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
  have "?P3 s"
  apply (cut_tac a1 a2 , simp, rule_tac x="(neg (andForm (eqn (IVar (Ident ''AShrSet_1'')) (Const false)) (eqn (IVar (Field (Ident ''AChan2_1'') ''Cmd'')) (Const GntS))))" in exI, auto) done
  then show "invHoldForRule s f r (invariants N)" by auto
qed

lemma n_n_ASendInvE_i1Vsinv__66:
assumes a1: "(r=n_n_ASendInvE_i1  )" and
a2: "(f=inv__66  )"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
  have "?P1 s"
  proof(cut_tac a1 a2 , auto) qed
  then show "invHoldForRule s f r (invariants N)" by auto
qed

lemma n_n_ASendInvS_i1Vsinv__66:
assumes a1: "(r=n_n_ASendInvS_i1  )" and
a2: "(f=inv__66  )"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
  have "?P1 s"
  proof(cut_tac a1 a2 , auto) qed
  then show "invHoldForRule s f r (invariants N)" by auto
qed

lemma n_n_ASendInvAck_i1Vsinv__66:
assumes a1: "(r=n_n_ASendInvAck_i1  )" and
a2: "(f=inv__66  )"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
  have "?P1 s"
  proof(cut_tac a1 a2 , auto) qed
  then show "invHoldForRule s f r (invariants N)" by auto
qed

lemma n_n_ARecvInvAck_i1Vsinv__66:
assumes a1: "(r=n_n_ARecvInvAck_i1  )" and
a2: "(f=inv__66  )"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
have "((formEval (eqn (IVar (Ident ''ExGntd'')) (Const true)) s))\<or>((formEval (neg (eqn (IVar (Ident ''ExGntd'')) (Const true))) s))" by auto
  moreover {
    assume c1: "((formEval (eqn (IVar (Ident ''ExGntd'')) (Const true)) s))"
    have "?P1 s"
    proof(cut_tac a1 a2  c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (neg (eqn (IVar (Ident ''ExGntd'')) (Const true))) s))"
    have "?P2 s"
    proof(cut_tac a1 a2  c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_n_ASendGntS_i1Vsinv__66:
assumes a1: "(r=n_n_ASendGntS_i1  )" and
a2: "(f=inv__66  )"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
  have "?P1 s"
  proof(cut_tac a1 a2 , auto) qed
  then show "invHoldForRule s f r (invariants N)" by auto
qed

lemma n_n_ASendGntE_i1Vsinv__66:
assumes a1: "(r=n_n_ASendGntE_i1  )" and
a2: "(f=inv__66  )"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
  have "?P1 s"
  proof(cut_tac a1 a2 , auto) qed
  then show "invHoldForRule s f r (invariants N)" by auto
qed

lemma n_n_ARecvGntS_i1Vsinv__66:
assumes a1: "(r=n_n_ARecvGntS_i1  )" and
a2: "(f=inv__66  )"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
  have "?P1 s"
  proof(cut_tac a1 a2 , auto) qed
  then show "invHoldForRule s f r (invariants N)" by auto
qed

lemma n_n_ARecvGntE_i1Vsinv__66:
assumes a1: "(r=n_n_ARecvGntE_i1  )" and
a2: "(f=inv__66  )"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
  have "?P1 s"
  proof(cut_tac a1 a2 , auto) qed
  then show "invHoldForRule s f r (invariants N)" by auto
qed

lemma n_n_RecvReq_i1Vsinv__66:
  assumes a1: "r=n_n_RecvReq_i1  " and
  a2: "(f=inv__66  )"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_n_SendInvS_i1Vsinv__66:
  assumes a1: "r=n_n_SendInvS_i1  " and
  a2: "(f=inv__66  )"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_n_SendReqEI_i1Vsinv__66:
  assumes a1: "r=n_n_SendReqEI_i1  " and
  a2: "(f=inv__66  )"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_n_ASendReqEI_i1Vsinv__66:
  assumes a1: "r=n_n_ASendReqEI_i1  " and
  a2: "(f=inv__66  )"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_n_ASendReqIS_j1Vsinv__66:
  assumes a1: "r=n_n_ASendReqIS_j1  " and
  a2: "(f=inv__66  )"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_n_ASendReqES_i1Vsinv__66:
  assumes a1: "r=n_n_ASendReqES_i1  " and
  a2: "(f=inv__66  )"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_n_SendGntS_i1Vsinv__66:
  assumes a1: "r=n_n_SendGntS_i1  " and
  a2: "(f=inv__66  )"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_n_SendReqES_i1Vsinv__66:
  assumes a1: "r=n_n_SendReqES_i1  " and
  a2: "(f=inv__66  )"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_n_SendInvE_i1Vsinv__66:
  assumes a1: "r=n_n_SendInvE_i1  " and
  a2: "(f=inv__66  )"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_n_ASendReqSE_j1Vsinv__66:
  assumes a1: "r=n_n_ASendReqSE_j1  " and
  a2: "(f=inv__66  )"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_n_RecvGntS_i1Vsinv__66:
  assumes a1: "r=n_n_RecvGntS_i1  " and
  a2: "(f=inv__66  )"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_n_SendReqEE_i1Vsinv__66:
  assumes a1: "r=n_n_SendReqEE_i1  " and
  a2: "(f=inv__66  )"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_n_RecvGntE_i1Vsinv__66:
  assumes a1: "r=n_n_RecvGntE_i1  " and
  a2: "(f=inv__66  )"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_n_ARecvReq_i1Vsinv__66:
  assumes a1: "r=n_n_ARecvReq_i1  " and
  a2: "(f=inv__66  )"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_n_Store_i1Vsinv__66:
  assumes a1: "\<exists> d. d\<le>N\<and>r=n_n_Store_i1  d" and
  a2: "(f=inv__66  )"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_n_AStore_i1Vsinv__66:
  assumes a1: "\<exists> d. d\<le>N\<and>r=n_n_AStore_i1  d" and
  a2: "(f=inv__66  )"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_n_SendReqS_j1Vsinv__66:
  assumes a1: "r=n_n_SendReqS_j1  " and
  a2: "(f=inv__66  )"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_n_SendInvAck_i1Vsinv__66:
  assumes a1: "r=n_n_SendInvAck_i1  " and
  a2: "(f=inv__66  )"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

end


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

header{*The n_g2kAbsAfter Protocol Case Study*}

theory n_g2kAbsAfter_lemma_inv__30_on_rules imports n_g2kAbsAfter_lemma_on_inv__30
begin
section{*All lemmas on causal relation between inv__30*}
lemma lemma_inv__30_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(f=inv__30  )"
  shows "invHoldForRule s f r (invariants N)"
  proof -
  have c1: "(\<exists> d. d\<le>N\<and>r=n_n_Store_i1  d)\<or>
    (\<exists> d. d\<le>N\<and>r=n_n_AStore_i1  d)\<or>
    (r=n_n_SendReqS_j1  )\<or>
    (r=n_n_SendReqEI_i1  )\<or>
    (r=n_n_SendReqES_i1  )\<or>
    (r=n_n_RecvReq_i1  )\<or>
    (r=n_n_SendInvE_i1  )\<or>
    (r=n_n_SendInvS_i1  )\<or>
    (r=n_n_SendInvAck_i1  )\<or>
    (r=n_n_RecvInvAck_i1  )\<or>
    (r=n_n_SendGntS_i1  )\<or>
    (r=n_n_SendGntE_i1  )\<or>
    (r=n_n_RecvGntS_i1  )\<or>
    (r=n_n_RecvGntE_i1  )\<or>
    (r=n_n_ASendReqIS_j1  )\<or>
    (r=n_n_ASendReqSE_j1  )\<or>
    (r=n_n_ASendReqEI_i1  )\<or>
    (r=n_n_ASendReqES_i1  )\<or>
    (r=n_n_SendReqEE_i1  )\<or>
    (r=n_n_ARecvReq_i1  )\<or>
    (r=n_n_ASendInvE_i1  )\<or>
    (r=n_n_ASendInvS_i1  )\<or>
    (r=n_n_ASendInvAck_i1  )\<or>
    (r=n_n_ARecvInvAck_i1  )\<or>
    (r=n_n_ASendGntS_i1  )\<or>
    (r=n_n_ASendGntE_i1  )\<or>
    (r=n_n_ARecvGntS_i1  )\<or>
    (r=n_n_ARecvGntE_i1  )"
  apply (cut_tac b1, auto) done
    moreover {
      assume d1: "(\<exists> d. d\<le>N\<and>r=n_n_Store_i1  d)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_Store_i1Vsinv__30) done
    }

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

    moreover {
      assume d1: "(r=n_n_SendReqS_j1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendReqS_j1Vsinv__30) done
    }

    moreover {
      assume d1: "(r=n_n_SendReqEI_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendReqEI_i1Vsinv__30) done
    }

    moreover {
      assume d1: "(r=n_n_SendReqES_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendReqES_i1Vsinv__30) done
    }

    moreover {
      assume d1: "(r=n_n_RecvReq_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_RecvReq_i1Vsinv__30) done
    }

    moreover {
      assume d1: "(r=n_n_SendInvE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendInvE_i1Vsinv__30) done
    }

    moreover {
      assume d1: "(r=n_n_SendInvS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendInvS_i1Vsinv__30) done
    }

    moreover {
      assume d1: "(r=n_n_SendInvAck_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendInvAck_i1Vsinv__30) done
    }

    moreover {
      assume d1: "(r=n_n_RecvInvAck_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_RecvInvAck_i1Vsinv__30) done
    }

    moreover {
      assume d1: "(r=n_n_SendGntS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendGntS_i1Vsinv__30) done
    }

    moreover {
      assume d1: "(r=n_n_SendGntE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendGntE_i1Vsinv__30) done
    }

    moreover {
      assume d1: "(r=n_n_RecvGntS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_RecvGntS_i1Vsinv__30) done
    }

    moreover {
      assume d1: "(r=n_n_RecvGntE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_RecvGntE_i1Vsinv__30) done
    }

    moreover {
      assume d1: "(r=n_n_ASendReqIS_j1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendReqIS_j1Vsinv__30) done
    }

    moreover {
      assume d1: "(r=n_n_ASendReqSE_j1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendReqSE_j1Vsinv__30) done
    }

    moreover {
      assume d1: "(r=n_n_ASendReqEI_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendReqEI_i1Vsinv__30) done
    }

    moreover {
      assume d1: "(r=n_n_ASendReqES_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendReqES_i1Vsinv__30) done
    }

    moreover {
      assume d1: "(r=n_n_SendReqEE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendReqEE_i1Vsinv__30) done
    }

    moreover {
      assume d1: "(r=n_n_ARecvReq_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ARecvReq_i1Vsinv__30) done
    }

    moreover {
      assume d1: "(r=n_n_ASendInvE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendInvE_i1Vsinv__30) done
    }

    moreover {
      assume d1: "(r=n_n_ASendInvS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendInvS_i1Vsinv__30) done
    }

    moreover {
      assume d1: "(r=n_n_ASendInvAck_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendInvAck_i1Vsinv__30) done
    }

    moreover {
      assume d1: "(r=n_n_ARecvInvAck_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ARecvInvAck_i1Vsinv__30) done
    }

    moreover {
      assume d1: "(r=n_n_ASendGntS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendGntS_i1Vsinv__30) done
    }

    moreover {
      assume d1: "(r=n_n_ASendGntE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendGntE_i1Vsinv__30) done
    }

    moreover {
      assume d1: "(r=n_n_ARecvGntS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ARecvGntS_i1Vsinv__30) done
    }

    moreover {
      assume d1: "(r=n_n_ARecvGntE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ARecvGntE_i1Vsinv__30) done
    }

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

end


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

header{*The n_g2kAbsAfter Protocol Case Study*}

theory n_g2kAbsAfter_lemma_inv__62_on_rules imports n_g2kAbsAfter_lemma_on_inv__62
begin
section{*All lemmas on causal relation between inv__62*}
lemma lemma_inv__62_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(f=inv__62  )"
  shows "invHoldForRule s f r (invariants N)"
  proof -
  have c1: "(\<exists> d. d\<le>N\<and>r=n_n_Store_i1  d)\<or>
    (\<exists> d. d\<le>N\<and>r=n_n_AStore_i1  d)\<or>
    (r=n_n_SendReqS_j1  )\<or>
    (r=n_n_SendReqEI_i1  )\<or>
    (r=n_n_SendReqES_i1  )\<or>
    (r=n_n_RecvReq_i1  )\<or>
    (r=n_n_SendInvE_i1  )\<or>
    (r=n_n_SendInvS_i1  )\<or>
    (r=n_n_SendInvAck_i1  )\<or>
    (r=n_n_RecvInvAck_i1  )\<or>
    (r=n_n_SendGntS_i1  )\<or>
    (r=n_n_SendGntE_i1  )\<or>
    (r=n_n_RecvGntS_i1  )\<or>
    (r=n_n_RecvGntE_i1  )\<or>
    (r=n_n_ASendReqIS_j1  )\<or>
    (r=n_n_ASendReqSE_j1  )\<or>
    (r=n_n_ASendReqEI_i1  )\<or>
    (r=n_n_ASendReqES_i1  )\<or>
    (r=n_n_SendReqEE_i1  )\<or>
    (r=n_n_ARecvReq_i1  )\<or>
    (r=n_n_ASendInvE_i1  )\<or>
    (r=n_n_ASendInvS_i1  )\<or>
    (r=n_n_ASendInvAck_i1  )\<or>
    (r=n_n_ARecvInvAck_i1  )\<or>
    (r=n_n_ASendGntS_i1  )\<or>
    (r=n_n_ASendGntE_i1  )\<or>
    (r=n_n_ARecvGntS_i1  )\<or>
    (r=n_n_ARecvGntE_i1  )"
  apply (cut_tac b1, auto) done
    moreover {
      assume d1: "(\<exists> d. d\<le>N\<and>r=n_n_Store_i1  d)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_Store_i1Vsinv__62) done
    }

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

    moreover {
      assume d1: "(r=n_n_SendReqS_j1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendReqS_j1Vsinv__62) done
    }

    moreover {
      assume d1: "(r=n_n_SendReqEI_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendReqEI_i1Vsinv__62) done
    }

    moreover {
      assume d1: "(r=n_n_SendReqES_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendReqES_i1Vsinv__62) done
    }

    moreover {
      assume d1: "(r=n_n_RecvReq_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_RecvReq_i1Vsinv__62) done
    }

    moreover {
      assume d1: "(r=n_n_SendInvE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendInvE_i1Vsinv__62) done
    }

    moreover {
      assume d1: "(r=n_n_SendInvS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendInvS_i1Vsinv__62) done
    }

    moreover {
      assume d1: "(r=n_n_SendInvAck_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendInvAck_i1Vsinv__62) done
    }

    moreover {
      assume d1: "(r=n_n_RecvInvAck_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_RecvInvAck_i1Vsinv__62) done
    }

    moreover {
      assume d1: "(r=n_n_SendGntS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendGntS_i1Vsinv__62) done
    }

    moreover {
      assume d1: "(r=n_n_SendGntE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendGntE_i1Vsinv__62) done
    }

    moreover {
      assume d1: "(r=n_n_RecvGntS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_RecvGntS_i1Vsinv__62) done
    }

    moreover {
      assume d1: "(r=n_n_RecvGntE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_RecvGntE_i1Vsinv__62) done
    }

    moreover {
      assume d1: "(r=n_n_ASendReqIS_j1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendReqIS_j1Vsinv__62) done
    }

    moreover {
      assume d1: "(r=n_n_ASendReqSE_j1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendReqSE_j1Vsinv__62) done
    }

    moreover {
      assume d1: "(r=n_n_ASendReqEI_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendReqEI_i1Vsinv__62) done
    }

    moreover {
      assume d1: "(r=n_n_ASendReqES_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendReqES_i1Vsinv__62) done
    }

    moreover {
      assume d1: "(r=n_n_SendReqEE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_SendReqEE_i1Vsinv__62) done
    }

    moreover {
      assume d1: "(r=n_n_ARecvReq_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ARecvReq_i1Vsinv__62) done
    }

    moreover {
      assume d1: "(r=n_n_ASendInvE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendInvE_i1Vsinv__62) done
    }

    moreover {
      assume d1: "(r=n_n_ASendInvS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendInvS_i1Vsinv__62) done
    }

    moreover {
      assume d1: "(r=n_n_ASendInvAck_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendInvAck_i1Vsinv__62) done
    }

    moreover {
      assume d1: "(r=n_n_ARecvInvAck_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ARecvInvAck_i1Vsinv__62) done
    }

    moreover {
      assume d1: "(r=n_n_ASendGntS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendGntS_i1Vsinv__62) done
    }

    moreover {
      assume d1: "(r=n_n_ASendGntE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ASendGntE_i1Vsinv__62) done
    }

    moreover {
      assume d1: "(r=n_n_ARecvGntS_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ARecvGntS_i1Vsinv__62) done
    }

    moreover {
      assume d1: "(r=n_n_ARecvGntE_i1  )"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_n_ARecvGntE_i1Vsinv__62) done
    }

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

end


header {* \isaheader{Postdomination} *}

theory Postdomination imports CFGExit begin

text {* For static interprocedural slicing, we only consider standard control
  dependence, hence we only need standard postdomination. *}

locale Postdomination = CFGExit sourcenode targetnode kind valid_edge Entry
    get_proc get_return_edges procs Main Exit
  for sourcenode :: "'edge \<Rightarrow> 'node" and targetnode :: "'edge \<Rightarrow> 'node"
  and kind :: "'edge \<Rightarrow> ('var,'val,'ret,'pname) edge_kind"
  and valid_edge :: "'edge \<Rightarrow> bool"
  and Entry :: "'node" ("'('_Entry'_')")  and get_proc :: "'node \<Rightarrow> 'pname"
  and get_return_edges :: "'edge \<Rightarrow> 'edge set"
  and procs :: "('pname \<times> 'var list \<times> 'var list) list" and Main :: "'pname"
  and Exit::"'node"  ("'('_Exit'_')") +
  assumes Entry_path:"valid_node n \<Longrightarrow> \<exists>as. (_Entry_) -as\<rightarrow>\<^sub>\<surd>* n"
  and Exit_path:"valid_node n \<Longrightarrow> \<exists>as. n -as\<rightarrow>\<^sub>\<surd>* (_Exit_)"
  and method_exit_unique:
    "\<lbrakk>method_exit n; method_exit n'; get_proc n = get_proc n'\<rbrakk> \<Longrightarrow> n = n'"

begin

lemma get_return_edges_unique:
  assumes "valid_edge a" and "a' \<in> get_return_edges a" and "a'' \<in> get_return_edges a"
  shows "a' = a''"
proof -
  from `valid_edge a` `a' \<in> get_return_edges a`
  obtain Q r p fs where "kind a = Q:r\<hookrightarrow>\<^bsub>p\<^esub>fs"
    by(fastforce dest!:only_call_get_return_edges)
  with `valid_edge a` `a' \<in> get_return_edges a` obtain Q' f' where "kind a' = Q'\<hookleftarrow>\<^bsub>p\<^esub>f'"
    by(fastforce dest!:call_return_edges)
  from `valid_edge a` `a' \<in> get_return_edges a` have "valid_edge a'"
    by(rule get_return_edges_valid)
  from this `kind a' = Q'\<hookleftarrow>\<^bsub>p\<^esub>f'` have "get_proc (sourcenode a') = p"
    by(rule get_proc_return)
  from `valid_edge a'` `kind a' = Q'\<hookleftarrow>\<^bsub>p\<^esub>f'` have "method_exit (sourcenode a')"
    by(fastforce simp:method_exit_def)
  from `valid_edge a` `a'' \<in> get_return_edges a` `kind a = Q:r\<hookrightarrow>\<^bsub>p\<^esub>fs`
  obtain Q'' f'' where "kind a'' = Q''\<hookleftarrow>\<^bsub>p\<^esub>f''" by(fastforce dest!:call_return_edges)
  from `valid_edge a` `a'' \<in> get_return_edges a` have "valid_edge a''"
    by(rule get_return_edges_valid)
  from this `kind a'' = Q''\<hookleftarrow>\<^bsub>p\<^esub>f''` have "get_proc (sourcenode a'') = p"
    by(rule get_proc_return)
  from `valid_edge a''` `kind a'' = Q''\<hookleftarrow>\<^bsub>p\<^esub>f''` have "method_exit (sourcenode a'')"
    by(fastforce simp:method_exit_def)
  with `method_exit (sourcenode a')` `get_proc (sourcenode a') = p`
    `get_proc (sourcenode a'') = p` have "sourcenode a' = sourcenode a''"
    by(fastforce elim!:method_exit_unique)
  from `valid_edge a` `a' \<in> get_return_edges a`
  obtain ax' where "valid_edge ax'" and "sourcenode ax' = sourcenode a"
    and "targetnode ax' = targetnode a'" and "intra_kind(kind ax')"
    by -(drule call_return_node_edge,auto simp:intra_kind_def)
  from `valid_edge a` `a'' \<in> get_return_edges a`
  obtain ax'' where "valid_edge ax''" and "sourcenode ax'' = sourcenode a"
    and "targetnode ax'' = targetnode a''" and "intra_kind(kind ax'')"
    by -(drule call_return_node_edge,auto simp:intra_kind_def)
  from `valid_edge a` `kind a = Q:r\<hookrightarrow>\<^bsub>p\<^esub>fs` `valid_edge ax'`
    `sourcenode ax' = sourcenode a` `intra_kind(kind ax')`
    `valid_edge ax''` `sourcenode ax'' = sourcenode a` `intra_kind(kind ax'')`
  have "ax' = ax''" by -(drule call_only_one_intra_edge,auto)
  with `targetnode ax' = targetnode a'` `targetnode ax'' = targetnode a''`
  have "targetnode a' = targetnode a''" by simp
  with `valid_edge a'` `valid_edge a''` `sourcenode a' = sourcenode a''`
  show ?thesis by(rule edge_det)
qed

definition postdominate :: "'node \<Rightarrow> 'node \<Rightarrow> bool" ("_ postdominates _" [51,0])
where postdominate_def:"n' postdominates n \<equiv>
  (valid_node n \<and> valid_node n' \<and>
  (\<forall>as pex. (n -as\<rightarrow>\<^sub>\<iota>* pex \<and> method_exit pex) \<longrightarrow> n' \<in> set (sourcenodes as)))"

lemma postdominate_implies_inner_path:
  assumes "n' postdominates n"
  obtains as where "n -as\<rightarrow>\<^sub>\<iota>* n'" and "n' \<notin> set (sourcenodes as)"
proof(atomize_elim)
  from `n' postdominates n` have "valid_node n"
    and all:"\<forall>as pex. (n -as\<rightarrow>\<^sub>\<iota>* pex \<and> method_exit pex) \<longrightarrow> n' \<in> set (sourcenodes as)"
    by(auto simp:postdominate_def)
  from `valid_node n` obtain asx where "n -asx\<rightarrow>\<^sub>\<surd>* (_Exit_)" by(auto dest:Exit_path)
  then obtain as where "n -as\<rightarrow>\<^sub>\<surd>* (_Exit_)"
    and "\<forall>a \<in> set as. intra_kind(kind a) \<or> (\<exists>Q f p. kind a = Q\<hookleftarrow>\<^bsub>p\<^esub>f)"
    by -(erule valid_Exit_path_descending_path)
  show "\<exists>as. n -as\<rightarrow>\<^sub>\<iota>* n' \<and> n' \<notin> set (sourcenodes as)"
  proof(cases "\<exists>a \<in> set as. \<exists>Q f p. kind a = Q\<hookleftarrow>\<^bsub>p\<^esub>f")
    case True
    then obtain asx ax asx' where [simp]:"as = asx@ax#asx'"
      and "\<exists>Q f p. kind ax = Q\<hookleftarrow>\<^bsub>p\<^esub>f" and "\<forall>a \<in> set asx. \<forall>Q f p. kind a \<noteq> Q\<hookleftarrow>\<^bsub>p\<^esub>f"
      by -(erule split_list_first_propE,simp)
    with `\<forall>a \<in> set as. intra_kind(kind a) \<or> (\<exists>Q f p. kind a = Q\<hookleftarrow>\<^bsub>p\<^esub>f)`
    have "\<forall>a \<in> set asx. intra_kind(kind a)" by auto
    from `n -as\<rightarrow>\<^sub>\<surd>* (_Exit_)` have "n -asx\<rightarrow>\<^sub>\<surd>* sourcenode ax"
      and "valid_edge ax" by(auto dest:vp_split)
    from `n -asx\<rightarrow>\<^sub>\<surd>* sourcenode ax` `\<forall>a \<in> set asx. intra_kind(kind a)`
    have "n -asx\<rightarrow>\<^sub>\<iota>* sourcenode ax" by(simp add:vp_def intra_path_def)
    from `valid_edge ax` `\<exists>Q f p. kind ax = Q\<hookleftarrow>\<^bsub>p\<^esub>f`
    have "method_exit (sourcenode ax)" by(fastforce simp:method_exit_def)
    with `n -asx\<rightarrow>\<^sub>\<iota>* sourcenode ax` all have "n' \<in> set (sourcenodes asx)" by fastforce
    then obtain xs ys where "sourcenodes asx = xs@n'#ys" and "n' \<notin> set xs"
      by(fastforce dest:split_list_first)
    then obtain as' a as'' where "xs = sourcenodes as'"
      and [simp]:"asx = as'@a#as''" and "sourcenode a = n'"
      by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
    from `n -asx\<rightarrow>\<^sub>\<iota>* sourcenode ax` have "n -as'\<rightarrow>\<^sub>\<iota>* sourcenode a"
      by(fastforce dest:path_split simp:intra_path_def)
    with `sourcenode a = n'` `n' \<notin> set xs` `xs = sourcenodes as'`
    show ?thesis by fastforce
  next
    case False
    with `\<forall>a \<in> set as. intra_kind(kind a) \<or> (\<exists>Q f p. kind a = Q\<hookleftarrow>\<^bsub>p\<^esub>f)`
    have "\<forall>a \<in> set as. intra_kind(kind a)" by fastforce
    with `n -as\<rightarrow>\<^sub>\<surd>* (_Exit_)` all have "n' \<in> set (sourcenodes as)"
      by(auto simp:vp_def intra_path_def simp:method_exit_def)
    then obtain xs ys where "sourcenodes as = xs@n'#ys" and "n' \<notin> set xs"
      by(fastforce dest:split_list_first)
    then obtain as' a as'' where "xs = sourcenodes as'"
      and [simp]:"as = as'@a#as''" and "sourcenode a = n'"
      by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
    from `n -as\<rightarrow>\<^sub>\<surd>* (_Exit_)` `\<forall>a \<in> set as. intra_kind(kind a)` `as = as'@a#as''`
    have "n -as'\<rightarrow>\<^sub>\<iota>* sourcenode a"
      by(fastforce dest:path_split simp:vp_def intra_path_def)
    with `sourcenode a = n'` `n' \<notin> set xs` `xs = sourcenodes as'`
    show ?thesis by fastforce
  qed
qed

lemma postdominate_variant:
  assumes "n' postdominates n"
  shows "\<forall>as. n -as\<rightarrow>\<^sub>\<surd>* (_Exit_) \<longrightarrow> n' \<in> set (sourcenodes as)"
proof -
  from `n' postdominates n`
  have all:"\<forall>as pex. (n -as\<rightarrow>\<^sub>\<iota>* pex \<and> method_exit pex) \<longrightarrow> n' \<in> set (sourcenodes as)"
    by(simp add:postdominate_def)
  { fix as assume "n -as\<rightarrow>\<^sub>\<surd>* (_Exit_)"
    then obtain as' pex where "n -as'\<rightarrow>\<^sub>\<iota>* pex" and "method_exit pex"
      and "set(sourcenodes as') \<subseteq> set(sourcenodes as)"
      by(erule valid_Exit_path_intra_path)
    from `n -as'\<rightarrow>\<^sub>\<iota>* pex` `method_exit pex` `n' postdominates n`
    have "n' \<in> set (sourcenodes as')" by(fastforce simp:postdominate_def)
    with `set(sourcenodes as') \<subseteq> set(sourcenodes as)`
    have "n' \<in> set (sourcenodes as)" by fastforce }
  thus ?thesis by simp
qed

lemma postdominate_refl:
  assumes "valid_node n" and "\<not> method_exit n" shows "n postdominates n"
using `valid_node n`
proof(induct rule:valid_node_cases)
  case Entry
  { fix as pex assume "(_Entry_) -as\<rightarrow>\<^sub>\<iota>* pex" and "method_exit pex"
    from `method_exit pex` have "(_Entry_) \<in> set (sourcenodes as)"
    proof(rule method_exit_cases)
      assume "pex = (_Exit_)"
      with `(_Entry_) -as\<rightarrow>\<^sub>\<iota>* pex` have "as \<noteq> []"
        apply(clarsimp simp:intra_path_def) apply(erule path.cases)
        by (drule sym,simp,drule Exit_noteq_Entry,auto)
      with `(_Entry_) -as\<rightarrow>\<^sub>\<iota>* pex` have "hd (sourcenodes as) = (_Entry_)"
        by(fastforce intro:path_sourcenode simp:intra_path_def)
      with `as \<noteq> []`show ?thesis by(fastforce intro:hd_in_set simp:sourcenodes_def)
    next
      fix a Q p f assume "pex = sourcenode a" and "valid_edge a" and "kind a = Q\<hookleftarrow>\<^bsub>p\<^esub>f"
      from `(_Entry_) -as\<rightarrow>\<^sub>\<iota>* pex` have "get_proc (_Entry_) = get_proc pex"
        by(rule intra_path_get_procs)
      hence "get_proc pex = Main" by(simp add:get_proc_Entry)
      from `valid_edge a` `kind a = Q\<hookleftarrow>\<^bsub>p\<^esub>f` have "get_proc (sourcenode a) = p"
        by(rule get_proc_return)
      with `pex = sourcenode a` `get_proc pex = Main` have "p = Main" by simp
      with `valid_edge a` `kind a = Q\<hookleftarrow>\<^bsub>p\<^esub>f` have False
        by simp (rule Main_no_return_source)
      thus ?thesis by simp
    qed }
  with Entry show ?thesis
    by(fastforce intro:empty_path simp:postdominate_def intra_path_def)
next
  case Exit
  with `\<not> method_exit n` have False by(simp add:method_exit_def)
  thus ?thesis by simp
next
  case inner
  show ?thesis
  proof(cases "\<exists>as. n -as\<rightarrow>\<^sub>\<surd>* (_Exit_)")
    case True
    { fix as pex assume "n -as\<rightarrow>\<^sub>\<iota>* pex" and "method_exit pex"
      with `\<not> method_exit n` have "as \<noteq> []"
        by(fastforce elim:path.cases simp:intra_path_def)
      with `n -as\<rightarrow>\<^sub>\<iota>* pex` inner have "hd (sourcenodes as) = n"
        by(fastforce intro:path_sourcenode simp:intra_path_def)
      from `as \<noteq> []` have "sourcenodes as \<noteq> []" by(simp add:sourcenodes_def)
      with `hd (sourcenodes as) = n`[THEN sym]
      have "n \<in> set (sourcenodes as)" by simp }
    hence "\<forall>as pex. (n -as\<rightarrow>\<^sub>\<iota>* pex \<and> method_exit pex) \<longrightarrow> n \<in> set (sourcenodes as)"
      by fastforce
    with True inner show ?thesis
      by(fastforce intro:empty_path
                   simp:postdominate_def inner_is_valid intra_path_def)
  next
    case False
    with inner show ?thesis by(fastforce dest:inner_is_valid Exit_path)
  qed
qed

lemma postdominate_trans:
  assumes "n'' postdominates n" and "n' postdominates n''"
  shows "n' postdominates n"
proof -
  from `n'' postdominates n` `n' postdominates n''`
  have "valid_node n" and "valid_node n'" by(simp_all add:postdominate_def)
  { fix as pex assume "n -as\<rightarrow>\<^sub>\<iota>* pex" and "method_exit pex"
    with `n'' postdominates n` have "n'' \<in> set (sourcenodes as)"
      by(fastforce simp:postdominate_def)
    then obtain ns' ns'' where "sourcenodes as = ns'@n''#ns''"
      by(auto dest:split_list)
    then obtain as' as'' a where "sourcenodes as'' = ns''" and [simp]:"as=as'@a#as''"
      and [simp]:"sourcenode a = n''"
      by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
    from `n -as\<rightarrow>\<^sub>\<iota>* pex` have "n -as'@a#as''\<rightarrow>\<^sub>\<iota>* pex" by simp
    hence "n'' -a#as''\<rightarrow>\<^sub>\<iota>* pex"
      by(fastforce dest:path_split_second simp:intra_path_def)
    with `n' postdominates n''` `method_exit pex`
    have "n' \<in> set(sourcenodes (a#as''))" by(fastforce simp:postdominate_def)
    hence "n' \<in> set (sourcenodes as)" by(fastforce simp:sourcenodes_def) }
  with `valid_node n` `valid_node n'`
  show ?thesis by(fastforce simp:postdominate_def)
qed

lemma postdominate_antisym:
  assumes "n' postdominates n" and "n postdominates n'"
  shows "n = n'"
proof -
  from `n' postdominates n` have "valid_node n" and "valid_node n'"
    by(auto simp:postdominate_def)
  from `valid_node n` obtain asx where "n -asx\<rightarrow>\<^sub>\<surd>* (_Exit_)" by(auto dest:Exit_path)
  then obtain as' pex where "n -as'\<rightarrow>\<^sub>\<iota>* pex" and "method_exit pex"
    by -(erule valid_Exit_path_intra_path)
  with `n' postdominates n` have "\<exists>nx \<in> set(sourcenodes as'). nx = n'"
    by(fastforce simp:postdominate_def)
  then obtain ns ns' where "sourcenodes as' = ns@n'#ns'"
    and "\<forall>nx \<in> set ns'. nx \<noteq> n'"
    by(fastforce elim!:split_list_last_propE)
  from `sourcenodes as' = ns@n'#ns'` obtain asx a asx'
    where [simp]:"ns' = sourcenodes asx'" "as' = asx@a#asx'" "sourcenode a = n'"
    by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
  from `n -as'\<rightarrow>\<^sub>\<iota>* pex` have "n' -a#asx'\<rightarrow>\<^sub>\<iota>* pex"
    by(fastforce dest:path_split_second simp:intra_path_def)
  with `n postdominates n'` `method_exit pex` have "n \<in> set(sourcenodes (a#asx'))"
    by(fastforce simp:postdominate_def)
  hence "n = n' \<or> n \<in> set(sourcenodes asx')" by(simp add:sourcenodes_def)
  thus ?thesis
  proof
    assume "n = n'" thus ?thesis .
  next
    assume "n \<in> set(sourcenodes asx')"
    then obtain nsx' nsx'' where "sourcenodes asx' = nsx'@n#nsx''"
      by(auto dest:split_list)
    then obtain asi asi' a' where [simp]:"asx' = asi@a'#asi'" "sourcenode a' = n"
      by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
    with `n -as'\<rightarrow>\<^sub>\<iota>* pex` have "n -(asx@a#asi)@a'#asi'\<rightarrow>\<^sub>\<iota>* pex" by simp
    hence "n -(asx@a#asi)@a'#asi'\<rightarrow>* pex"
      and "\<forall>a \<in> set ((asx@a#asi)@a'#asi'). intra_kind (kind a)"
      by(simp_all add:intra_path_def)
    from `n -(asx@a#asi)@a'#asi'\<rightarrow>* pex`
    have "n -a'#asi'\<rightarrow>* pex" by(fastforce dest:path_split_second)
    with `\<forall>a \<in> set ((asx@a#asi)@a'#asi'). intra_kind (kind a)`
    have "n -a'#asi'\<rightarrow>\<^sub>\<iota>* pex" by(simp add:intra_path_def)
    with `n' postdominates n` `method_exit pex`
    have "n' \<in> set(sourcenodes (a'#asi'))" by(fastforce simp:postdominate_def)
    hence "n' = n \<or> n' \<in> set(sourcenodes asi')"
      by(simp add:sourcenodes_def)
    thus ?thesis
    proof
      assume "n' = n" thus ?thesis by(rule sym)
    next
      assume "n' \<in> set(sourcenodes asi')"
      with `\<forall>nx \<in> set ns'. nx \<noteq> n'` have False by(fastforce simp:sourcenodes_def)
      thus ?thesis by simp
    qed
  qed
qed

lemma postdominate_path_branch:
  assumes "n -as\<rightarrow>* n''" and "n' postdominates n''" and "\<not> n' postdominates n"
  obtains a as' as'' where "as = as'@a#as''" and "valid_edge a"
  and "\<not> n' postdominates (sourcenode a)" and "n' postdominates (targetnode a)"
proof(atomize_elim)
  from assms
  show "\<exists>as' a as''. as = as'@a#as'' \<and> valid_edge a \<and>
    \<not> n' postdominates (sourcenode a) \<and> n' postdominates (targetnode a)"
  proof(induct rule:path.induct)
    case (Cons_path n'' as nx a n)
    note IH = `\<lbrakk>n' postdominates nx; \<not> n' postdominates n''\<rbrakk>
      \<Longrightarrow> \<exists>as' a as''. as = as'@a#as'' \<and> valid_edge a \<and>
        \<not> n' postdominates sourcenode a \<and> n' postdominates targetnode a`
    show ?case
    proof(cases "n' postdominates n''")
      case True
      with `\<not> n' postdominates n` `sourcenode a = n` `targetnode a = n''`
        `valid_edge a` show ?thesis by blast
    next
      case False
      from IH[OF `n' postdominates nx` this] show ?thesis
        by clarsimp(rule_tac x="a#as'" in exI,clarsimp)
    qed
  qed simp
qed

lemma Exit_no_postdominator:
  assumes "(_Exit_) postdominates n" shows False
proof -
  from `(_Exit_) postdominates n` have "valid_node n" by(simp add:postdominate_def)
  from `valid_node n` obtain asx where "n -asx\<rightarrow>\<^sub>\<surd>* (_Exit_)" by(auto dest:Exit_path)
  then obtain as' pex where "n -as'\<rightarrow>\<^sub>\<iota>* pex" and "method_exit pex"
    by -(erule valid_Exit_path_intra_path)
  with `(_Exit_) postdominates n` have "(_Exit_) \<in> set (sourcenodes as')"
    by(fastforce simp:postdominate_def)
  with `n -as'\<rightarrow>\<^sub>\<iota>* pex` show False by(fastforce simp:intra_path_def)
qed

lemma postdominate_inner_path_targetnode:
  assumes "n' postdominates n" and "n -as\<rightarrow>\<^sub>\<iota>* n''" and "n' \<notin> set(sourcenodes as)"
  shows "n' postdominates n''"
proof -
  from `n' postdominates n` obtain asx
    where "valid_node n" and "valid_node n'"
    and all:"\<forall>as pex. (n -as\<rightarrow>\<^sub>\<iota>* pex \<and> method_exit pex) \<longrightarrow> n' \<in> set (sourcenodes as)"
    by(auto simp:postdominate_def)
  from `n -as\<rightarrow>\<^sub>\<iota>* n''` have "valid_node n''"
    by(fastforce dest:path_valid_node simp:intra_path_def)
  have "\<forall>as' pex'. (n'' -as'\<rightarrow>\<^sub>\<iota>* pex' \<and> method_exit pex') \<longrightarrow>
                   n' \<in> set (sourcenodes as')"
  proof(rule ccontr)
    assume "\<not> (\<forall>as' pex'. (n'' -as'\<rightarrow>\<^sub>\<iota>* pex' \<and> method_exit pex') \<longrightarrow>
                          n' \<in> set (sourcenodes as'))"
    then obtain as' pex' where "n'' -as'\<rightarrow>\<^sub>\<iota>* pex'" and "method_exit pex'"
      and "n' \<notin> set (sourcenodes as')" by blast
    from `n -as\<rightarrow>\<^sub>\<iota>* n''` `n'' -as'\<rightarrow>\<^sub>\<iota>* pex'` have "n -as@as'\<rightarrow>\<^sub>\<iota>* pex'"
      by(fastforce intro:path_Append simp:intra_path_def)
    from `n' \<notin> set(sourcenodes as)` `n' \<notin> set (sourcenodes as')`
    have "n' \<notin> set (sourcenodes (as@as'))"
      by(simp add:sourcenodes_def)
    with `n -as@as'\<rightarrow>\<^sub>\<iota>* pex'` `method_exit pex'` `n' postdominates n`
    show False by(fastforce simp:postdominate_def)
  qed
  with `valid_node n'` `valid_node n''`
  show ?thesis by(auto simp:postdominate_def)
qed

lemma not_postdominate_source_not_postdominate_target:
  assumes "\<not> n postdominates (sourcenode a)"
  and "valid_node n" and "valid_edge a" and "intra_kind (kind a)"
  obtains ax where "sourcenode a = sourcenode ax" and "valid_edge ax"
  and "\<not> n postdominates targetnode ax"
proof(atomize_elim)
  show "\<exists>ax. sourcenode a = sourcenode ax \<and> valid_edge ax \<and>
    \<not> n postdominates targetnode ax"
  proof -
    from assms obtain asx pex
      where "sourcenode a -asx\<rightarrow>\<^sub>\<iota>* pex" and "method_exit pex"
      and "n \<notin> set(sourcenodes asx)" by(fastforce simp:postdominate_def)
    show ?thesis
    proof(cases asx)
      case Nil
      with `sourcenode a -asx\<rightarrow>\<^sub>\<iota>* pex` have "pex = sourcenode a"
        by(fastforce simp:intra_path_def)
      with `method_exit pex` have "method_exit (sourcenode a)" by simp
      thus ?thesis
      proof(rule method_exit_cases)
        assume "sourcenode a = (_Exit_)"
        with `valid_edge a` have False by(rule Exit_source)
        thus ?thesis by simp
      next
        fix a' Q f p assume "sourcenode a = sourcenode a'"
          and "valid_edge a'" and "kind a' = Q\<hookleftarrow>\<^bsub>p\<^esub>f"
        hence False using `intra_kind (kind a)` `valid_edge a`
          by(fastforce dest:return_edges_only simp:intra_kind_def)
        thus ?thesis by simp
      qed
    next
      case (Cons ax asx')
      with `sourcenode a -asx\<rightarrow>\<^sub>\<iota>* pex`
      have "sourcenode a -[]@ax#asx'\<rightarrow>* pex"
        and "\<forall>a \<in> set (ax#asx'). intra_kind (kind a)" by(simp_all add:intra_path_def)
      from `sourcenode a -[]@ax#asx'\<rightarrow>* pex`
      have "sourcenode a = sourcenode ax" and "valid_edge ax"
        and "targetnode ax -asx'\<rightarrow>* pex"  by(fastforce dest:path_split)+
      with `\<forall>a \<in> set (ax#asx'). intra_kind (kind a)`
      have "targetnode ax -asx'\<rightarrow>\<^sub>\<iota>* pex" by(simp add:intra_path_def)
      with `n \<notin> set(sourcenodes asx)` Cons `method_exit pex`
      have "\<not> n postdominates targetnode ax"
        by(fastforce simp:postdominate_def sourcenodes_def)
      with `sourcenode a = sourcenode ax` `valid_edge ax` show ?thesis by blast
    qed
  qed
qed

lemma inner_node_Exit_edge:
  assumes "inner_node n"
  obtains a where "valid_edge a" and "intra_kind (kind a)"
  and "inner_node (sourcenode a)" and "targetnode a = (_Exit_)"
proof(atomize_elim)
  from `inner_node n` have "valid_node n" by(rule inner_is_valid)
  then obtain as where "n -as\<rightarrow>\<^sub>\<surd>* (_Exit_)" by(fastforce dest:Exit_path)
  show "\<exists>a. valid_edge a \<and> intra_kind (kind a) \<and> inner_node (sourcenode a) \<and>
    targetnode a = (_Exit_)"
  proof(cases "as = []")
    case True
    with `inner_node n` `n -as\<rightarrow>\<^sub>\<surd>* (_Exit_)` have False by(fastforce simp:vp_def)
    thus ?thesis by simp
  next
    case False
    with `n -as\<rightarrow>\<^sub>\<surd>* (_Exit_)` obtain a' as' where "as = as'@[a']"
      and "n -as'\<rightarrow>\<^sub>\<surd>* sourcenode a'" and "valid_edge a'"
      and "(_Exit_) = targetnode a'" by -(erule vp_split_snoc)
    from `valid_edge a'` have "valid_node (sourcenode a')" by simp
    thus ?thesis
    proof(cases "sourcenode a'" rule:valid_node_cases)
      case Entry
      with `n -as'\<rightarrow>\<^sub>\<surd>* sourcenode a'` have "n -as'\<rightarrow>* (_Entry_)" by(simp add:vp_def)
      with `inner_node n`
      have False by -(drule path_Entry_target,auto simp:inner_node_def)
      thus ?thesis by simp
    next
      case Exit
      from `valid_edge a'` this have False by(rule Exit_source)
      thus ?thesis by simp
    next
      case inner
      have "intra_kind (kind a')"
      proof(cases "kind a'" rule:edge_kind_cases)
        case Intra thus ?thesis by simp
      next
        case (Call Q r p fs)
        with `valid_edge a'` have "get_proc(targetnode a') = p" by(rule get_proc_call)
        with `(_Exit_) = targetnode a'` get_proc_Exit have "p = Main" by simp
        with `kind a' = Q:r\<hookrightarrow>\<^bsub>p\<^esub>fs` have "kind a' = Q:r\<hookrightarrow>\<^bsub>Main\<^esub>fs" by simp
        with `valid_edge a'` have False by(rule Main_no_call_target)
        thus ?thesis by simp
      next
        case (Return Q p f)
        from `valid_edge a'` `kind a' = Q\<hookleftarrow>\<^bsub>p\<^esub>f` `(_Exit_) = targetnode a'`[THEN sym]
        have False by(rule Exit_no_return_target)
        thus ?thesis by simp
      qed
      with `valid_edge a'` `(_Exit_) = targetnode a'` `inner_node (sourcenode a')`
      show ?thesis by simp blast
    qed
  qed
qed

lemma inner_node_Entry_edge:
  assumes "inner_node n"
  obtains a where "valid_edge a" and "intra_kind (kind a)"
  and "inner_node (targetnode a)" and "sourcenode a = (_Entry_)"
proof(atomize_elim)
  from `inner_node n` have "valid_node n" by(rule inner_is_valid)
  then obtain as where "(_Entry_) -as\<rightarrow>\<^sub>\<surd>* n" by(fastforce dest:Entry_path)
  show "\<exists>a. valid_edge a \<and> intra_kind (kind a) \<and> inner_node (targetnode a) \<and>
    sourcenode a = (_Entry_)"
  proof(cases "as = []")
    case True
    with `inner_node n` `(_Entry_) -as\<rightarrow>\<^sub>\<surd>* n` have False
      by(fastforce simp:inner_node_def vp_def)
    thus ?thesis by simp
  next
    case False
    with `(_Entry_) -as\<rightarrow>\<^sub>\<surd>* n` obtain a' as' where "as = a'#as'"
      and "targetnode a' -as'\<rightarrow>\<^sub>\<surd>* n" and "valid_edge a'"
      and "(_Entry_) = sourcenode a'" by -(erule vp_split_Cons)
    from `valid_edge a'` have "valid_node (targetnode a')" by simp
    thus ?thesis
    proof(cases "targetnode a'" rule:valid_node_cases)
      case Entry
      from `valid_edge a'` this have False by(rule Entry_target)
      thus ?thesis by simp
    next
      case Exit
      with `targetnode a' -as'\<rightarrow>\<^sub>\<surd>* n` have "(_Exit_) -as'\<rightarrow>* n" by(simp add:vp_def)
      with `inner_node n`
      have False by -(drule path_Exit_source,auto simp:inner_node_def)
      thus ?thesis by simp
    next
      case inner
      have "intra_kind (kind a')"
      proof(cases "kind a'" rule:edge_kind_cases)
        case Intra thus ?thesis by simp
      next
        case (Call Q r p fs)
        from `valid_edge a'` `kind a' = Q:r\<hookrightarrow>\<^bsub>p\<^esub>fs`
          `(_Entry_) = sourcenode a'`[THEN sym]
        have False by(rule Entry_no_call_source)
        thus ?thesis by simp
      next
        case (Return Q p f)
        with `valid_edge a'` have "get_proc(sourcenode a') = p"
          by(rule get_proc_return)
        with `(_Entry_) = sourcenode a'` get_proc_Entry have "p = Main" by simp
        with `kind a' = Q\<hookleftarrow>\<^bsub>p\<^esub>f` have "kind a' = Q\<hookleftarrow>\<^bsub>Main\<^esub>f" by simp
        with `valid_edge a'` have False by(rule Main_no_return_source)
        thus ?thesis by simp
      qed
      with `valid_edge a'` `(_Entry_) = sourcenode a'` `inner_node (targetnode a')`
      show ?thesis by simp blast
    qed
  qed
qed

lemma intra_path_to_matching_method_exit:
  assumes "method_exit n'" and "get_proc n = get_proc n'" and "valid_node n"
  obtains as where "n -as\<rightarrow>\<^sub>\<iota>* n'"
proof(atomize_elim)
  from `valid_node n` obtain as' where "n -as'\<rightarrow>\<^sub>\<surd>* (_Exit_)"
    by(fastforce dest:Exit_path)
  then obtain as mex where "n -as\<rightarrow>\<^sub>\<iota>* mex" and "method_exit mex"
    by(fastforce elim:valid_Exit_path_intra_path)
  from `n -as\<rightarrow>\<^sub>\<iota>* mex` have "get_proc n = get_proc mex"
    by(rule intra_path_get_procs)
  with `method_exit n'` `get_proc n = get_proc n'` `method_exit mex`
  have "mex = n'" by(fastforce intro:method_exit_unique)
  with `n -as\<rightarrow>\<^sub>\<iota>* mex` show "\<exists>as. n -as\<rightarrow>\<^sub>\<iota>* n'" by fastforce
qed

end

end