(*  Title:       Seq_Invariants.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
*)

section "Invariant proofs on individual processes"

theory Seq_Invariants
imports AWN.Invariants Aodv Aodv_Data Aodv_Predicates Fresher

begin

text \<open>
  The proposition numbers are taken from the December 2013 version of
  the Fehnker et al technical report.
\<close>

text \<open>Proposition 7.2\<close>

lemma sequence_number_increases:
  "paodv i \<TTurnstile>\<^sub>A onll \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>((\<xi>, _), _, (\<xi>', _)). sn \<xi> \<le> sn \<xi>')"
  by inv_cterms

lemma sequence_number_one_or_bigger:
  "paodv i \<TTurnstile> onl \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>(\<xi>, _). 1 \<le> sn \<xi>)"
  by (rule onll_step_to_invariantI [OF sequence_number_increases])
     (auto simp: \<sigma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V_def)

text \<open>We can get rid of the onl/onll if desired...\<close>

lemma sequence_number_increases':
  "paodv i \<TTurnstile>\<^sub>A (\<lambda>((\<xi>, _), _, (\<xi>', _)). sn \<xi> \<le> sn \<xi>')"
  by (rule step_invariant_weakenE [OF sequence_number_increases]) (auto dest!: onllD)

lemma sequence_number_one_or_bigger':
  "paodv i \<TTurnstile> (\<lambda>(\<xi>, _). 1 \<le> sn \<xi>)"
  by (rule invariant_weakenE [OF sequence_number_one_or_bigger]) auto

lemma sip_in_kD:
  "paodv i \<TTurnstile> onl \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>(\<xi>, l). l \<in> ({PAodv-:7} \<union> {PAodv-:5} \<union> {PRrep-:0..PRrep-:1}
                                     \<union> {PRreq-:0..PRreq-:3}) \<longrightarrow> sip \<xi> \<in> kD (rt \<xi>))"
  by inv_cterms

lemma rrep_1_update_changes:
  "paodv i \<TTurnstile> onl \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>(\<xi>, l). (l = PRrep-:1 \<longrightarrow>
                        rt \<xi> \<noteq> update (rt \<xi>) (dip \<xi>) (dsn \<xi>, kno, val, hops \<xi> + 1, sip \<xi>, {})))"
  by inv_cterms

lemma addpreRT_partly_welldefined:
  "paodv i \<TTurnstile>
     onl \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>(\<xi>, l). (l \<in> {PRreq-:16..PRreq-:18} \<union> {PRrep-:2..PRrep-:6} \<longrightarrow> dip \<xi> \<in> kD (rt \<xi>))
                      \<and> (l \<in> {PRreq-:3..PRreq-:17} \<longrightarrow> oip \<xi> \<in> kD (rt \<xi>)))"
  by inv_cterms

text \<open>Proposition 7.38\<close>

lemma includes_nhip:
  "paodv i \<TTurnstile> onl \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>(\<xi>, l). \<forall>dip\<in>kD(rt \<xi>). the (nhop (rt \<xi>) dip)\<in>kD(rt \<xi>))"
  proof -
    { fix ip and \<xi> \<xi>' :: state
      assume "\<forall>dip\<in>kD (rt \<xi>). the (nhop (rt \<xi>) dip) \<in> kD (rt \<xi>)"
         and "\<xi>' = \<xi>\<lparr>rt := update (rt \<xi>) ip (0, unk, val, Suc 0, ip, {})\<rparr>"
      hence "\<forall>dip\<in>kD (rt \<xi>).
               the (nhop (update (rt \<xi>) ip (0, unk, val, Suc 0, ip, {})) dip) = ip
             \<or> the (nhop (update (rt \<xi>) ip (0, unk, val, Suc 0, ip, {})) dip) \<in> kD (rt \<xi>)"
        by clarsimp (metis nhop_update_unk_val update_another)
    } note one_hop = this
    {  fix ip sip sn hops and \<xi> \<xi>' :: state
       assume "\<forall>dip\<in>kD (rt \<xi>). the (nhop (rt \<xi>) dip) \<in> kD (rt \<xi>)"
          and "\<xi>' = \<xi>\<lparr>rt := update (rt \<xi>) ip (sn, kno, val, Suc hops, sip, {})\<rparr>"
          and "sip \<in> kD (rt \<xi>)"
       hence "(the (nhop (update (rt \<xi>) ip (sn, kno, val, Suc hops, sip, {})) ip) = ip
                 \<or> the (nhop (update (rt \<xi>) ip (sn, kno, val, Suc hops, sip, {})) ip) \<in> kD (rt \<xi>))
               \<and> (\<forall>dip\<in>kD (rt \<xi>).
                    the (nhop (update (rt \<xi>) ip (sn, kno, val, Suc hops, sip, {})) dip) = ip
                    \<or> the (nhop (update (rt \<xi>) ip (sn, kno, val, Suc hops, sip, {})) dip) \<in> kD (rt \<xi>))"
         by (metis kD_update_unchanged nhop_update_changed update_another)
    } note nhip_is_sip = this
    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf sip_in_kD]
                              onl_invariant_sterms [OF aodv_wf addpreRT_partly_welldefined]
                       solve: one_hop nhip_is_sip)
  qed

text \<open>Proposition 7.22: needed in Proposition 7.4\<close>

lemma addpreRT_welldefined:
  "paodv i \<TTurnstile> onl \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>(\<xi>, l). (l \<in> {PRreq-:16..PRreq-:18} \<longrightarrow> dip \<xi> \<in> kD (rt \<xi>)) \<and>
                               (l = PRreq-:17 \<longrightarrow> oip \<xi> \<in> kD (rt \<xi>)) \<and>
                               (l = PRrep-:5  \<longrightarrow> dip \<xi> \<in> kD (rt \<xi>)) \<and>
                               (l = PRrep-:6  \<longrightarrow> (the (nhop (rt \<xi>) (dip \<xi>))) \<in> kD (rt \<xi>)))"
  (is "_ \<TTurnstile> onl \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V ?P")
  unfolding invariant_def
  proof
    fix s
    assume "s \<in> reachable (paodv i) TT"
    then obtain \<xi> p where "s = (\<xi>, p)"
                      and "(\<xi>, p) \<in> reachable (paodv i) TT"
      by (metis prod.exhaust)
    have "onl \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V ?P (\<xi>, p)"
    proof (rule onlI)
      fix l
      assume "l \<in> labels \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V p"
      with \<open>(\<xi>, p) \<in> reachable (paodv i) TT\<close>
        have I1: "l \<in> {PRreq-:16..PRreq-:18} \<longrightarrow> dip \<xi> \<in> kD(rt \<xi>)"
         and I2: "l = PRreq-:17 \<longrightarrow> oip \<xi> \<in> kD(rt \<xi>)"
         and I3: "l \<in> {PRrep-:2..PRrep-:6}  \<longrightarrow> dip \<xi> \<in> kD(rt \<xi>)"
         by (auto dest!: invariantD [OF addpreRT_partly_welldefined])
      moreover from \<open>(\<xi>, p) \<in> reachable (paodv i) TT\<close> \<open>l \<in> labels \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V p\<close> and I3
        have "l = PRrep-:6  \<longrightarrow> (the (nhop (rt \<xi>) (dip \<xi>))) \<in> kD(rt \<xi>)"
          by (auto dest!: invariantD [OF includes_nhip])
      ultimately show "?P (\<xi>, l)"
        by simp
    qed
    with \<open>s = (\<xi>, p)\<close> show "onl \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V ?P s"
      by simp
  qed

text \<open>Proposition 7.4\<close>

lemma known_destinations_increase:
  "paodv i \<TTurnstile>\<^sub>A onll \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>((\<xi>, _), _, (\<xi>', _)). kD (rt \<xi>) \<subseteq> kD (rt \<xi>'))"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf addpreRT_welldefined]
                 simp add: subset_insertI)

text \<open>Proposition 7.5\<close>

lemma rreqs_increase:
  "paodv i \<TTurnstile>\<^sub>A onll \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>((\<xi>, _), _, (\<xi>', _)). rreqs \<xi> \<subseteq> rreqs \<xi>')"
  by (inv_cterms simp add: subset_insertI)

lemma dests_bigger_than_sqn:
  "paodv i \<TTurnstile> onl \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>(\<xi>, l). l \<in> {PAodv-:15..PAodv-:19}
                                 \<union> {PPkt-:7..PPkt-:11}
                                 \<union> {PRreq-:9..PRreq-:13}
                                 \<union> {PRreq-:21..PRreq-:25}
                                 \<union> {PRrep-:10..PRrep-:14}
                                 \<union> {PRerr-:1..PRerr-:5}
                         \<longrightarrow> (\<forall>ip\<in>dom(dests \<xi>). ip\<in>kD(rt \<xi>) \<and> sqn (rt \<xi>) ip \<le> the (dests \<xi> ip)))"
  proof -
    have sqninv:
      "\<And>dests rt rsn ip.
       \<lbrakk> \<forall>ip\<in>dom(dests). ip\<in>kD(rt) \<and> sqn rt ip \<le> the (dests ip); dests ip = Some rsn \<rbrakk>
        \<Longrightarrow> sqn (invalidate rt dests) ip \<le> rsn"
        by (rule sqn_invalidate_in_dests [THEN eq_imp_le], assumption) auto
    have indests:
      "\<And>dests rt rsn ip.
       \<lbrakk> \<forall>ip\<in>dom(dests). ip\<in>kD(rt) \<and> sqn rt ip \<le> the (dests ip); dests ip = Some rsn \<rbrakk>
        \<Longrightarrow> ip\<in>kD(rt) \<and> sqn rt ip \<le> rsn"
        by (metis domI option.sel)
    show ?thesis
      by inv_cterms
         (clarsimp split: if_split_asm option.split_asm
                   elim!: sqninv indests)+
  qed

text \<open>Proposition 7.6\<close>

lemma sqns_increase:
   "paodv i \<TTurnstile>\<^sub>A onll \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>((\<xi>, _), _, (\<xi>', _)). \<forall>ip. sqn (rt \<xi>) ip \<le> sqn (rt \<xi>') ip)"
  proof -
    { fix \<xi> :: state
      assume *: "\<forall>ip\<in>dom(dests \<xi>). ip \<in> kD (rt \<xi>) \<and> sqn (rt \<xi>) ip \<le> the (dests \<xi> ip)"
      have "\<forall>ip. sqn (rt \<xi>) ip \<le> sqn (invalidate (rt \<xi>) (dests \<xi>)) ip"
      proof
        fix ip
        from * have "ip\<notin>dom(dests \<xi>) \<or> sqn (rt \<xi>) ip \<le> the (dests \<xi> ip)" by simp
        thus "sqn (rt \<xi>) ip \<le> sqn (invalidate (rt \<xi>) (dests \<xi>)) ip"
          by (metis domI invalidate_sqn option.sel)
      qed
    } note solve_invalidate = this
    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf addpreRT_welldefined]
                              onl_invariant_sterms [OF aodv_wf dests_bigger_than_sqn]
                    simp add: solve_invalidate)
  qed

text \<open>Proposition 7.7\<close>

lemma ip_constant:
  "paodv i \<TTurnstile> onl \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>(\<xi>, _). ip \<xi> = i)"
  by (inv_cterms simp add: \<sigma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V_def)

text \<open>Proposition 7.8\<close>

lemma sender_ip_valid':
  "paodv i \<TTurnstile>\<^sub>A onll \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>((\<xi>, _), a, _). anycast (\<lambda>m. not_Pkt m \<longrightarrow> msg_sender m = ip \<xi>) a)"
  by inv_cterms

lemma sender_ip_valid:
  "paodv i \<TTurnstile>\<^sub>A onll \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>((\<xi>, _), a, _). anycast (\<lambda>m. not_Pkt m \<longrightarrow> msg_sender m = i) a)"
  by (rule step_invariant_weaken_with_invariantE [OF ip_constant sender_ip_valid'])
     (auto dest!: onlD onllD)

lemma received_msg_inv:
  "paodv i \<TTurnstile> (recvmsg P \<rightarrow>) onl \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>(\<xi>, l). l \<in> {PAodv-:1} \<longrightarrow> P (msg \<xi>))"
  by inv_cterms

text \<open>Proposition 7.9\<close>

lemma sip_not_ip':
  "paodv i \<TTurnstile> (recvmsg (\<lambda>m. not_Pkt m \<longrightarrow> msg_sender m \<noteq> i) \<rightarrow>) onl \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>(\<xi>, _). sip \<xi> \<noteq> ip \<xi>)"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]
                          onl_invariant_sterms [OF aodv_wf ip_constant [THEN invariant_restrict_inD]]
                simp add: clear_locals_sip_not_ip') clarsimp+

lemma sip_not_ip:
  "paodv i \<TTurnstile> (recvmsg (\<lambda>m. not_Pkt m \<longrightarrow> msg_sender m \<noteq> i) \<rightarrow>) onl \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>(\<xi>, _). sip \<xi> \<noteq> i)"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]
                          onl_invariant_sterms [OF aodv_wf ip_constant [THEN invariant_restrict_inD]]
                simp add: clear_locals_sip_not_ip') clarsimp+

text \<open>Neither \<open>sip_not_ip'\<close> nor \<open>sip_not_ip\<close> is needed to show loop freedom.\<close>

text \<open>Proposition 7.10\<close>

lemma hop_count_positive:
  "paodv i \<TTurnstile> onl \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>(\<xi>, _). \<forall>ip\<in>kD (rt \<xi>). the (dhops (rt \<xi>) ip) \<ge> 1)"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf addpreRT_welldefined]) auto

lemma rreq_dip_in_vD_dip_eq_ip:
  "paodv i \<TTurnstile> onl \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>(\<xi>, l). (l \<in> {PRreq-:16..PRreq-:18} \<longrightarrow> dip \<xi> \<in> vD(rt \<xi>))
                            \<and> (l \<in> {PRreq-:5, PRreq-:6} \<longrightarrow> dip \<xi> = ip \<xi>)
                            \<and> (l \<in> {PRreq-:15..PRreq-:18} \<longrightarrow> dip \<xi> \<noteq> ip \<xi>))"
  proof (inv_cterms, elim conjE)
    fix l \<xi> pp p'
    assume "(\<xi>, pp) \<in> reachable (paodv i) TT"
       and "{PRreq-:17}\<lbrakk>\<lambda>\<xi>. \<xi>\<lparr>rt := the (addpreRT (rt \<xi>) (oip \<xi>) {the (nhop (rt \<xi>) (dip \<xi>))})\<rparr>\<rbrakk> p'
              \<in> sterms \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V pp"
       and "l = PRreq-:17"
       and "dip \<xi> \<in> vD (rt \<xi>)"
    from this(1-3) have "oip \<xi> \<in> kD (rt \<xi>)"
      by (auto dest: onl_invariant_sterms [OF aodv_wf addpreRT_welldefined, where l="PRreq-:17"])
    with \<open>dip \<xi> \<in> vD (rt \<xi>)\<close>
      show "dip \<xi> \<in> vD (the (addpreRT (rt \<xi>) (oip \<xi>) {the (nhop (rt \<xi>) (dip \<xi>))}))" by simp
  qed

text \<open>Proposition 7.11\<close>

lemma anycast_msg_zhops:
  "\<And>rreqid dip dsn dsk oip osn sip.
      paodv i \<TTurnstile>\<^sub>A onll \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>(_, a, _). anycast msg_zhops a)"
  proof (inv_cterms inv add:
           onl_invariant_sterms [OF aodv_wf rreq_dip_in_vD_dip_eq_ip [THEN invariant_restrict_inD]]
           onl_invariant_sterms [OF aodv_wf hop_count_positive [THEN invariant_restrict_inD]],
         elim conjE)
    fix l \<xi> a pp p' pp'
    assume "(\<xi>, pp) \<in> reachable (paodv i) TT"
       and "{PRreq-:18}unicast(\<lambda>\<xi>. the (nhop (rt \<xi>) (oip \<xi>)),
               \<lambda>\<xi>. Rrep (the (dhops (rt \<xi>) (dip \<xi>))) (dip \<xi>) (sqn (rt \<xi>) (dip \<xi>)) (oip \<xi>) (ip \<xi>)).
                     p' \<triangleright> pp' \<in> sterms \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V pp"
       and "l = PRreq-:18"
       and "a = unicast (the (nhop (rt \<xi>) (oip \<xi>)))
                 (Rrep (the (dhops (rt \<xi>) (dip \<xi>))) (dip \<xi>) (sqn (rt \<xi>) (dip \<xi>)) (oip \<xi>) (ip \<xi>))"
       and *: "\<forall>ip\<in>kD (rt \<xi>). Suc 0 \<le> the (dhops (rt \<xi>) ip)"
       and "dip \<xi> \<in> vD (rt \<xi>)"
    from \<open>dip \<xi> \<in> vD (rt \<xi>)\<close> have "dip \<xi> \<in> kD (rt \<xi>)"
      by (rule vD_iD_gives_kD(1))
    with * have "Suc 0 \<le> the (dhops (rt \<xi>) (dip \<xi>))" ..
    thus "0 < the (dhops (rt \<xi>) (dip \<xi>))" by simp
  qed

lemma hop_count_zero_oip_dip_sip:
  "paodv i \<TTurnstile> (recvmsg msg_zhops \<rightarrow>) onl \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>(\<xi>, l).
                 (l\<in>{PAodv-:4..PAodv-:5} \<union> {PRreq-:n|n. True} \<longrightarrow>
                          (hops \<xi> = 0 \<longrightarrow> oip \<xi> = sip \<xi>))
                 \<and>
                 ((l\<in>{PAodv-:6..PAodv-:7} \<union> {PRrep-:n|n. True} \<longrightarrow>
                          (hops \<xi> = 0 \<longrightarrow> dip \<xi> = sip \<xi>))))"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]) auto

lemma osn_rreq:
  "paodv i \<TTurnstile> (recvmsg rreq_rrep_sn \<rightarrow>) onl \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>(\<xi>, l).
                                    l \<in> {PAodv-:4, PAodv-:5} \<union> {PRreq-:n|n. True} \<longrightarrow> 1 \<le> osn \<xi>)"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]) clarsimp

lemma osn_rreq':
  "paodv i \<TTurnstile> (recvmsg (\<lambda>m. rreq_rrep_sn m \<and> msg_zhops m) \<rightarrow>) onl \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>(\<xi>, l).
                                    l \<in> {PAodv-:4, PAodv-:5} \<union> {PRreq-:n|n. True} \<longrightarrow> 1 \<le> osn \<xi>)"
  proof (rule invariant_weakenE [OF osn_rreq])
    fix a
    assume "recvmsg (\<lambda>m. rreq_rrep_sn m \<and> msg_zhops m) a"
    thus "recvmsg rreq_rrep_sn a"
      by (cases a) simp_all
  qed

lemma dsn_rrep:
  "paodv i \<TTurnstile> (recvmsg rreq_rrep_sn \<rightarrow>) onl \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>(\<xi>, l).
                                    l \<in> {PAodv-:6, PAodv-:7} \<union> {PRrep-:n|n. True} \<longrightarrow> 1 \<le> dsn \<xi>)"
  by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf received_msg_inv]) clarsimp

lemma dsn_rrep':
  "paodv i \<TTurnstile> (recvmsg (\<lambda>m. rreq_rrep_sn m \<and> msg_zhops m) \<rightarrow>)  onl \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>(\<xi>, l).
                                    l \<in> {PAodv-:6, PAodv-:7} \<union> {PRrep-:n|n. True} \<longrightarrow> 1 \<le> dsn \<xi>)"
  proof (rule invariant_weakenE [OF dsn_rrep])
    fix a
    assume "recvmsg (\<lambda>m. rreq_rrep_sn m \<and> msg_zhops m) a"
    thus "recvmsg rreq_rrep_sn a"
      by (cases a) simp_all
  qed

lemma hop_count_zero_oip_dip_sip':
  "paodv i \<TTurnstile> (recvmsg (\<lambda>m. rreq_rrep_sn m \<and> msg_zhops m) \<rightarrow>) onl \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>(\<xi>, l).
                 (l\<in>{PAodv-:4..PAodv-:5} \<union> {PRreq-:n|n. True} \<longrightarrow>
                          (hops \<xi> = 0 \<longrightarrow> oip \<xi> = sip \<xi>))
                 \<and>
                 ((l\<in>{PAodv-:6..PAodv-:7} \<union> {PRrep-:n|n. True} \<longrightarrow>
                          (hops \<xi> = 0 \<longrightarrow> dip \<xi> = sip \<xi>))))"
  proof (rule invariant_weakenE [OF hop_count_zero_oip_dip_sip])
    fix a
    assume "recvmsg (\<lambda>m. rreq_rrep_sn m \<and> msg_zhops m) a"
    thus "recvmsg msg_zhops a"
      by (cases a) simp_all
  qed

text \<open>Proposition 7.12\<close>

lemma zero_seq_unk_hops_one':
  "paodv i \<TTurnstile> (recvmsg (\<lambda>m. rreq_rrep_sn m \<and> msg_zhops m) \<rightarrow>) onl \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>(\<xi>, _).
                 \<forall>dip\<in>kD(rt \<xi>). (sqn (rt \<xi>) dip = 0 \<longrightarrow> sqnf (rt \<xi>) dip = unk)
                              \<and> (sqnf (rt \<xi>) dip = unk \<longrightarrow> the (dhops (rt \<xi>) dip) = 1)
                              \<and> (the (dhops (rt \<xi>) dip) = 1 \<longrightarrow> the (nhop (rt \<xi>) dip) = dip))"
  proof -
  { fix dip and \<xi> :: state and P
    assume "sqn (invalidate (rt \<xi>) (dests \<xi>)) dip = 0"
       and all: "\<forall>ip. sqn (rt \<xi>) ip \<le> sqn (invalidate (rt \<xi>) (dests \<xi>)) ip"
       and *: "sqn (rt \<xi>) dip = 0 \<Longrightarrow> P \<xi> dip"
    have "P \<xi> dip"
    proof -
      from all have "sqn (rt \<xi>) dip \<le> sqn (invalidate (rt \<xi>) (dests \<xi>)) dip" ..
      with \<open>sqn (invalidate (rt \<xi>) (dests \<xi>)) dip = 0\<close> have "sqn (rt \<xi>) dip = 0" by simp
      thus "P \<xi> dip" by (rule *)
    qed
  } note sqn_invalidate_zero [elim!] = this

  { fix dsn hops :: nat and sip oip rt and ip dip :: ip
    assume "\<forall>dip\<in>kD(rt).
                (sqn rt dip = 0 \<longrightarrow> \<pi>\<^sub>3(the (rt dip)) = unk) \<and>
                (\<pi>\<^sub>3(the (rt dip)) = unk \<longrightarrow> the (dhops rt dip) = Suc 0) \<and>
                (the (dhops rt dip) = Suc 0 \<longrightarrow> the (nhop rt dip) = dip)"
       and "hops = 0 \<longrightarrow> sip = dip"
       and "Suc 0 \<le> dsn"
       and "ip \<noteq> dip \<longrightarrow> ip\<in>kD(rt)"
    hence "the (dhops (update rt dip (dsn, kno, val, Suc hops, sip, {})) ip) = Suc 0 \<longrightarrow>
           the (nhop (update rt dip (dsn, kno, val, Suc hops, sip, {})) ip) = ip"
      by - (rule update_cases, auto simp add: sqn_def dest!: bspec)
  } note prreq_ok1 [simp] = this

  { fix ip dsn hops sip oip rt dip
    assume "\<forall>dip\<in>kD(rt).
                (sqn rt dip = 0 \<longrightarrow> \<pi>\<^sub>3(the (rt dip)) = unk) \<and>
                (\<pi>\<^sub>3(the (rt dip)) = unk \<longrightarrow> the (dhops rt dip) = Suc 0) \<and>
                (the (dhops rt dip) = Suc 0 \<longrightarrow> the (nhop rt dip) = dip)"
       and "Suc 0 \<le> dsn"
       and "ip \<noteq> dip \<longrightarrow> ip\<in>kD(rt)"
    hence "\<pi>\<^sub>3(the (update rt dip (dsn, kno, val, Suc hops, sip, {}) ip)) = unk \<longrightarrow>
           the (dhops (update rt dip (dsn, kno, val, Suc hops, sip, {})) ip) = Suc 0"
      by - (rule update_cases, auto simp add: sqn_def sqnf_def dest!: bspec)
  } note prreq_ok2 [simp] = this

  { fix ip dsn hops sip oip rt dip
    assume "\<forall>dip\<in>kD(rt).
                (sqn rt dip = 0 \<longrightarrow> \<pi>\<^sub>3(the (rt dip)) = unk) \<and>
                (\<pi>\<^sub>3(the (rt dip)) = unk \<longrightarrow> the (dhops rt dip) = Suc 0) \<and>
                (the (dhops rt dip) = Suc 0 \<longrightarrow> the (nhop rt dip) = dip)"
       and "Suc 0 \<le> dsn"
       and "ip \<noteq> dip \<longrightarrow> ip\<in>kD(rt)"
    hence "sqn (update rt dip (dsn, kno, val, Suc hops, sip, {})) ip = 0 \<longrightarrow>
           \<pi>\<^sub>3 (the (update rt dip (dsn, kno, val, Suc hops, sip, {}) ip)) = unk"
      by - (rule update_cases, auto simp add: sqn_def dest!: bspec)
  } note prreq_ok3 [simp] = this

  { fix rt sip
    assume "\<forall>dip\<in>kD rt.
              (sqn rt dip = 0 \<longrightarrow> \<pi>\<^sub>3(the (rt dip)) = unk) \<and>
              (\<pi>\<^sub>3(the (rt dip)) = unk \<longrightarrow> the (dhops rt dip) = Suc 0) \<and>
              (the (dhops rt dip) = Suc 0 \<longrightarrow> the (nhop rt dip) = dip)"
    hence "\<forall>dip\<in>kD rt.
          (sqn (update rt sip (0, unk, val, Suc 0, sip, {})) dip = 0 \<longrightarrow>
           \<pi>\<^sub>3(the (update rt sip (0, unk, val, Suc 0, sip, {}) dip)) = unk)
        \<and> (\<pi>\<^sub>3(the (update rt sip (0, unk, val, Suc 0, sip, {}) dip)) = unk \<longrightarrow>
           the (dhops (update rt sip (0, unk, val, Suc 0, sip, {})) dip) = Suc 0)
        \<and> (the (dhops (update rt sip (0, unk, val, Suc 0, sip, {})) dip) = Suc 0 \<longrightarrow>
           the (nhop (update rt sip (0, unk, val, Suc 0, sip, {})) dip) = dip)"
    by - (rule update_cases, simp_all add: sqnf_def sqn_def)
  } note prreq_ok4 [simp] = this

  have prreq_ok5 [simp]: "\<And>sip rt.
    \<pi>\<^sub>3(the (update rt sip (0, unk, val, Suc 0, sip, {}) sip)) = unk \<longrightarrow>
    the (dhops (update rt sip (0, unk, val, Suc 0, sip, {})) sip) = Suc 0"
    by (rule update_cases) simp_all

  have prreq_ok6 [simp]: "\<And>sip rt.
    sqn (update rt sip (0, unk, val, Suc 0, sip, {})) sip = 0 \<longrightarrow>
    \<pi>\<^sub>3 (the (update rt sip (0, unk, val, Suc 0, sip, {}) sip)) = unk"
    by (rule update_cases) simp_all

  show ?thesis
    by (inv_cterms inv add: onl_invariant_sterms_TT [OF aodv_wf addpreRT_welldefined]
                            onl_invariant_sterms [OF aodv_wf hop_count_zero_oip_dip_sip']
                            seq_step_invariant_sterms_TT [OF sqns_increase aodv_wf aodv_trans]
                            onl_invariant_sterms [OF aodv_wf osn_rreq']
                            onl_invariant_sterms [OF aodv_wf dsn_rrep']) clarsimp+
  qed

lemma zero_seq_unk_hops_one:
  "paodv i \<TTurnstile> (recvmsg (\<lambda>m. rreq_rrep_sn m \<and> msg_zhops m) \<rightarrow>) onl \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>(\<xi>, _).
                 \<forall>dip\<in>kD(rt \<xi>). (sqn (rt \<xi>) dip = 0 \<longrightarrow> (sqnf (rt \<xi>) dip = unk
                                                         \<and> the (dhops (rt \<xi>) dip) = 1
                                                         \<and> the (nhop (rt \<xi>) dip) = dip)))"
  by (rule invariant_weakenE [OF zero_seq_unk_hops_one']) auto

lemma kD_unk_or_atleast_one:
  "paodv i \<TTurnstile> (recvmsg rreq_rrep_sn \<rightarrow>) onl \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>(\<xi>, l).
                               \<forall>dip\<in>kD(rt \<xi>). \<pi>\<^sub>3(the (rt \<xi> dip)) = unk \<or> 1 \<le> \<pi>\<^sub>2(the (rt \<xi> dip)))"
  proof -
    { fix sip rt dsn1 dsn2 dsk1 dsk2 flag1 flag2 hops1 hops2 nhip1 nhip2 pre1 pre2
      assume "dsk1 = unk \<or> Suc 0 \<le> dsn2"
      hence "\<pi>\<^sub>3(the (update rt sip (dsn1, dsk1, flag1, hops1, nhip1, pre1) sip)) = unk
            \<or> Suc 0 \<le> sqn (update rt sip (dsn2, dsk2, flag2, hops2, nhip2, pre2)) sip"
        unfolding update_def by (cases "dsk1 =unk") (clarsimp split: option.split)+
    } note fromsip [simp] = this

    { fix dip sip rt dsn1 dsn2 dsk1 dsk2 flag1 flag2 hops1 hops2 nhip1 nhip2 pre1 pre2
      assume allkd: "\<forall>dip\<in>kD(rt). \<pi>\<^sub>3(the (rt dip)) = unk \<or> Suc 0 \<le> sqn rt dip"
         and    **: "dsk1 = unk \<or> Suc 0 \<le> dsn2"
      have "\<forall>dip\<in>kD(rt). \<pi>\<^sub>3(the (update rt sip (dsn1, dsk1, flag1, hops1, nhip1, pre1) dip)) = unk
            \<or> Suc 0 \<le> sqn (update rt sip (dsn2, dsk2, flag2, hops2, nhip2, pre2)) dip"
        (is "\<forall>dip\<in>kD(rt). ?prop dip")
      proof
        fix dip
        assume "dip\<in>kD(rt)"
        thus "?prop dip"
        proof (cases "dip = sip")
          assume "dip = sip"
          with ** show ?thesis
            by simp
        next
          assume "dip \<noteq> sip"
          with \<open>dip\<in>kD(rt)\<close> allkd show ?thesis
            by simp
        qed
      qed
    } note solve_update [simp] = this

    { fix dip rt dests
      assume  *: "\<forall>ip\<in>dom(dests). ip\<in>kD(rt) \<and> sqn rt ip \<le> the (dests ip)"
         and **: "\<forall>ip\<in>kD(rt). \<pi>\<^sub>3(the (rt ip)) = unk \<or> Suc 0 \<le> sqn rt ip"
      have "\<forall>dip\<in>kD(rt). \<pi>\<^sub>3(the (rt dip)) = unk \<or> Suc 0 \<le> sqn (invalidate rt dests) dip"
      proof
        fix dip
        assume "dip\<in>kD(rt)"
        with ** have "\<pi>\<^sub>3(the (rt dip)) = unk \<or> Suc 0 \<le> sqn rt dip" ..
        thus "\<pi>\<^sub>3 (the (rt dip)) = unk \<or> Suc 0 \<le> sqn (invalidate rt dests) dip"
        proof
          assume "\<pi>\<^sub>3(the (rt dip)) = unk" thus ?thesis ..
        next
          assume "Suc 0 \<le> sqn rt dip"
          have "Suc 0 \<le> sqn (invalidate rt dests) dip"
          proof (cases "dip\<in>dom(dests)")
            assume "dip\<in>dom(dests)"
            with * have "sqn rt dip \<le> the (dests dip)" by simp
            with \<open>Suc 0 \<le> sqn rt dip\<close> have "Suc 0 \<le> the (dests dip)" by simp
            with \<open>dip\<in>dom(dests)\<close> \<open>dip\<in>kD(rt)\<close> [THEN kD_Some] show ?thesis
              unfolding invalidate_def sqn_def by auto
          next
            assume "dip\<notin>dom(dests)"
            with \<open>Suc 0 \<le> sqn rt dip\<close> \<open>dip\<in>kD(rt)\<close> [THEN kD_Some] show ?thesis
              unfolding invalidate_def sqn_def by auto
          qed
        thus ?thesis by (rule disjI2)
        qed
      qed
    } note solve_invalidate [simp] = this

    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms_TT [OF aodv_wf addpreRT_welldefined]
                              onl_invariant_sterms [OF aodv_wf dests_bigger_than_sqn
                                                               [THEN invariant_restrict_inD]]
                              onl_invariant_sterms [OF aodv_wf osn_rreq]
                              onl_invariant_sterms [OF aodv_wf dsn_rrep]
                    simp add: proj3_inv proj2_eq_sqn)
  qed

text \<open>Proposition 7.13\<close>

lemma rreq_rrep_sn_any_step_invariant:
  "paodv i \<TTurnstile>\<^sub>A (recvmsg rreq_rrep_sn \<rightarrow>) onll \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>(_, a, _). anycast rreq_rrep_sn a)"
  proof -
    have sqnf_kno: "paodv i \<TTurnstile> onl \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>(\<xi>, l).
                                      (l \<in> {PRreq-:16..PRreq-:18} \<longrightarrow> sqnf (rt \<xi>) (dip \<xi>) = kno))"
      by (inv_cterms inv add: onl_invariant_sterms_TT [OF aodv_wf addpreRT_welldefined])
    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms_TT [OF aodv_wf addpreRT_welldefined]
                              onl_invariant_sterms [OF aodv_wf sequence_number_one_or_bigger
                                                               [THEN invariant_restrict_inD]]
                              onl_invariant_sterms [OF aodv_wf kD_unk_or_atleast_one]
                              onl_invariant_sterms_TT [OF aodv_wf sqnf_kno]
                              onl_invariant_sterms [OF aodv_wf osn_rreq]
                              onl_invariant_sterms [OF aodv_wf dsn_rrep])
         (auto simp: proj2_eq_sqn)
  qed

text \<open>Proposition 7.14\<close>

lemma rreq_rrep_fresh_any_step_invariant:
  "paodv i \<TTurnstile>\<^sub>A onll \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>((\<xi>, _), a, _). anycast (rreq_rrep_fresh (rt \<xi>)) a)"
  proof -
    have rreq_oip: "paodv i \<TTurnstile> onl \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>(\<xi>, l).
                       (l \<in> {PRreq-:3, PRreq-:4, PRreq-:15, PRreq-:27}
                               \<longrightarrow> oip \<xi> \<in> kD(rt \<xi>)
                                 \<and> (sqn (rt \<xi>) (oip \<xi>) > (osn \<xi>)
                                     \<or> (sqn (rt \<xi>) (oip \<xi>) = (osn \<xi>)
                                        \<and> the (dhops (rt \<xi>) (oip \<xi>)) \<le> Suc (hops \<xi>)
                                        \<and> the (flag (rt \<xi>) (oip \<xi>)) = val))))"
      proof inv_cterms
        fix l \<xi> l' pp p'
        assume "(\<xi>, pp) \<in> reachable (paodv i) TT"
           and "{PRreq-:2}\<lbrakk>\<lambda>\<xi>. \<xi>\<lparr>rt :=
                update (rt \<xi>) (oip \<xi>) (osn \<xi>, kno, val, Suc (hops \<xi>), sip \<xi>, {})\<rparr>\<rbrakk> p' \<in> sterms \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V pp"
           and "l' = PRreq-:3"
        show "osn \<xi> < sqn (update (rt \<xi>) (oip \<xi>) (osn \<xi>, kno, val, Suc (hops \<xi>), sip \<xi>, {})) (oip \<xi>)
           \<or> (sqn (update (rt \<xi>) (oip \<xi>) (osn \<xi>, kno, val, Suc (hops \<xi>), sip \<xi>, {})) (oip \<xi>) = osn \<xi>
             \<and> the (dhops (update (rt \<xi>) (oip \<xi>) (osn \<xi>, kno, val, Suc (hops \<xi>), sip \<xi>, {})) (oip \<xi>))
                                                                            \<le> Suc (hops \<xi>)
             \<and> the (flag (update (rt \<xi>) (oip \<xi>) (osn \<xi>, kno, val, Suc (hops \<xi>), sip \<xi>, {})) (oip \<xi>))
                                                                            = val)"
          unfolding update_def by (clarsimp split: option.split)
                                  (metis linorder_neqE_nat not_less)
      qed

    have rrep_prrep: "paodv i \<TTurnstile> onl \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>(\<xi>, l).
          (l \<in> {PRrep-:2..PRrep-:7} \<longrightarrow> (dip \<xi> \<in> kD(rt \<xi>)
                                        \<and> sqn (rt \<xi>) (dip \<xi>) = dsn \<xi>
                                        \<and> the (dhops (rt \<xi>) (dip \<xi>)) = Suc (hops \<xi>)
                                        \<and> the (flag (rt \<xi>) (dip \<xi>)) = val
                                        \<and> the (nhop (rt \<xi>) (dip \<xi>)) \<in> kD (rt \<xi>))))"
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf rrep_1_update_changes]
                              onl_invariant_sterms [OF aodv_wf sip_in_kD])

    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf rreq_oip]
                              onl_invariant_sterms [OF aodv_wf rreq_dip_in_vD_dip_eq_ip]
                              onl_invariant_sterms [OF aodv_wf rrep_prrep])
  qed

text \<open>Proposition 7.15\<close>

lemma rerr_invalid_any_step_invariant:
  "paodv i \<TTurnstile>\<^sub>A onll \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>((\<xi>, _), a, _). anycast (rerr_invalid (rt \<xi>)) a)"
  proof -
    have dests_inv: "paodv i \<TTurnstile>
                      onl \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>(\<xi>, l). (l \<in> {PAodv-:15, PPkt-:7, PRreq-:9,
                                            PRreq-:21, PRrep-:10, PRerr-:1}
                          \<longrightarrow> (\<forall>ip\<in>dom(dests \<xi>). ip\<in>vD(rt \<xi>)))
                         \<and> (l \<in> {PAodv-:16..PAodv-:19}
                              \<union> {PPkt-:8..PPkt-:11}
                              \<union> {PRreq-:10..PRreq-:13}
                              \<union> {PRreq-:22..PRreq-:25}
                              \<union> {PRrep-:11..PRrep-:14}
                              \<union> {PRerr-:2..PRerr-:5} \<longrightarrow> (\<forall>ip\<in>dom(dests \<xi>). ip\<in>iD(rt \<xi>)
                                                          \<and> the (dests \<xi> ip) = sqn (rt \<xi>) ip))
                         \<and> (l = PPkt-:14 \<longrightarrow> dip \<xi>\<in>iD(rt \<xi>)))"
      by inv_cterms (clarsimp split: if_split_asm option.split_asm simp: domIff)+
    show ?thesis
      by (inv_cterms inv add: onl_invariant_sterms [OF aodv_wf dests_inv])
  qed

text \<open>Proposition 7.16\<close>

text \<open>
  Some well-definedness obligations are irrelevant for the Isabelle development:

  \begin{enumerate}
  \item In each routing table there is at most one entry for each destination: guaranteed by type.

  \item In each store of queued data packets there is at most one data queue for
        each destination: guaranteed by structure.

  \item Whenever a set of pairs @{term "(rip, rsn)"} is assigned to the variable
        @{term "dests"} of type @{typ "ip \<rightharpoonup> sqn"}, or to the first argument of
        the function @{term "rerr"}, this set is a partial function, i.e., there
        is at most one entry @{term "(rip, rsn)"} for each destination
        @{term "rip"}: guaranteed by type.
  \end{enumerate}
\<close>

lemma dests_vD_inc_sqn:
  "paodv i \<TTurnstile>
        onl \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>(\<xi>, l). (l \<in> {PAodv-:15, PPkt-:7, PRreq-:9, PRreq-:21, PRrep-:10}
             \<longrightarrow> (\<forall>ip\<in>dom(dests \<xi>). ip\<in>vD(rt \<xi>) \<and> the (dests \<xi> ip) = inc (sqn (rt \<xi>) ip)))
           \<and> (l = PRerr-:1
             \<longrightarrow> (\<forall>ip\<in>dom(dests \<xi>). ip\<in>vD(rt \<xi>) \<and> the (dests \<xi> ip) > sqn (rt \<xi>) ip)))"
  by inv_cterms (clarsimp split: if_split_asm option.split_asm)+

text \<open>Proposition 7.27\<close>

lemma route_tables_fresher:
  "paodv i \<TTurnstile>\<^sub>A (recvmsg rreq_rrep_sn \<rightarrow>) onll \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V (\<lambda>((\<xi>, _), _, (\<xi>', _)).
                                                                \<forall>dip\<in>kD(rt \<xi>). rt \<xi> \<sqsubseteq>\<^bsub>dip\<^esub> rt \<xi>')"
  proof (inv_cterms inv add:
           onl_invariant_sterms [OF aodv_wf dests_vD_inc_sqn [THEN invariant_restrict_inD]]
           onl_invariant_sterms [OF aodv_wf hop_count_positive [THEN invariant_restrict_inD]]
           onl_invariant_sterms [OF aodv_wf osn_rreq]
           onl_invariant_sterms [OF aodv_wf dsn_rrep]
           onl_invariant_sterms [OF aodv_wf addpreRT_welldefined [THEN invariant_restrict_inD]])
    fix \<xi> pp p'
    assume "(\<xi>, pp) \<in> reachable (paodv i) (recvmsg rreq_rrep_sn)"
       and "{PRreq-:2}\<lbrakk>\<lambda>\<xi>. \<xi>\<lparr>rt := update (rt \<xi>) (oip \<xi>) (osn \<xi>, kno, val, Suc (hops \<xi>), sip \<xi>, {})\<rparr>\<rbrakk>
               p' \<in> sterms \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V pp"
       and "Suc 0 \<le> osn \<xi>"
       and *: "\<forall>ip\<in>kD (rt \<xi>). Suc 0 \<le> the (dhops (rt \<xi>) ip)"
    show "\<forall>ip\<in>kD (rt \<xi>). rt \<xi> \<sqsubseteq>\<^bsub>ip\<^esub> update (rt \<xi>) (oip \<xi>) (osn \<xi>, kno, val, Suc (hops \<xi>), sip \<xi>, {})"
    proof
      fix ip
      assume "ip\<in>kD (rt \<xi>)"
      moreover with * have "1 \<le> the (dhops (rt \<xi>) ip)" by simp
      moreover from \<open>Suc 0 \<le> osn \<xi>\<close>
        have "update_arg_wf (osn \<xi>, kno, val, Suc (hops \<xi>), sip \<xi>, {})" ..
      ultimately show "rt \<xi> \<sqsubseteq>\<^bsub>ip\<^esub> update (rt \<xi>) (oip \<xi>) (osn \<xi>, kno, val, Suc (hops \<xi>), sip \<xi>, {})"
        by (rule rt_fresher_update)
    qed
  next
    fix \<xi> pp p'
    assume "(\<xi>, pp) \<in> reachable (paodv i) (recvmsg rreq_rrep_sn)"
       and "{PRrep-:1}\<lbrakk>\<lambda>\<xi>. \<xi>\<lparr>rt := update (rt \<xi>) (dip \<xi>) (dsn \<xi>, kno, val, Suc (hops \<xi>), sip \<xi>, {})\<rparr>\<rbrakk>
            p' \<in> sterms \<Gamma>\<^sub>A\<^sub>O\<^sub>D\<^sub>V pp"
       and "Suc 0 \<le> dsn \<xi>"
       and *: "\<forall>ip\<in>kD (rt \<xi>). Suc 0 \<le> the (dhops (rt \<xi>) ip)"
    show "\<forall>ip\<in>kD (rt \<xi>). rt \<xi> \<sqsubseteq>\<^bsub>ip\<^esub> update (rt \<xi>) (dip \<xi>) (dsn \<xi>, kno, val, Suc (hops \<xi>), sip \<xi>, {})"
    proof
      fix ip
      assume "ip\<in>kD (rt \<xi>)"
      moreover with * have "1 \<le> the (dhops (rt \<xi>) ip)" by simp
      moreover from \<open>Suc 0 \<le> dsn \<xi>\<close>
        have "update_arg_wf (dsn \<xi>, kno, val, Suc (hops \<xi>), sip \<xi>, {})" ..
      ultimately show "rt \<xi> \<sqsubseteq>\<^bsub>ip\<^esub> update (rt \<xi>) (dip \<xi>) (dsn \<xi>, kno, val, Suc (hops \<xi>), sip \<xi>, {})"
        by (rule rt_fresher_update)
    qed
  qed

end


(*<*)
(* Author : Peter Chapman *)
(* License: LGPL *)
header "Rule Set Transformations"

theory SRCTransforms
imports "~~/src/HOL/Library/Multiset"
begin

datatype 'a form = At "nat"
                 | Compound "'a" "'a form list"
                 | ff

datatype 'a sequent = Sequent "('a form) multiset" "('a form) multiset" (" (_) \<Rightarrow>* (_)" [6,6] 5)

abbreviation multiset_abbrev ("\<LM> _  \<RM>" [75]75) where
   "\<LM> A \<RM> \<equiv> {# A #}"

abbreviation multiset_empty ("\<Empt>" 75) where
  "\<Empt> \<equiv> {#}"

(* We have that any step in a rule, be it a primitive rule or an instance of a rule in a derivation
   can be represented as a list of premisses and a conclusion.  We need a list since a list is finite
   by definition *)
type_synonym 'a rule = "'a sequent list * 'a sequent"

type_synonym 'a deriv = "'a sequent * nat"

abbreviation
multiset_plus (infixl "\<oplus>" 80) where
   "(\<Gamma> :: 'a multiset) \<oplus> (A :: 'a) \<equiv> \<Gamma> + \<LM>A\<RM>"
abbreviation
multiset_minus (infixl "\<ominus>" 80) where
   "(\<Gamma> :: 'a multiset) \<ominus>  (A :: 'a) \<equiv> \<Gamma> - \<LM>A\<RM>"

consts
  (* extend a sequent by adding another one.  A form of weakening.  Is this overkill by adding a sequent? *)
  extend :: "'a sequent \<Rightarrow> 'a sequent \<Rightarrow> 'a sequent"
  extendRule :: "'a sequent \<Rightarrow> 'a rule \<Rightarrow> 'a rule"

  (* Unique conclusion Property *)
  uniqueConclusion :: "'a rule set \<Rightarrow> bool"

  (* Invertible definitions *)
  invertible :: "'a rule \<Rightarrow> 'a rule set \<Rightarrow> bool"
  invertible_set :: "'a rule set \<Rightarrow> bool"

  (* functions to get at components of sequents *)
primrec antec :: "'a sequent \<Rightarrow> 'a form multiset" where "antec (Sequent ant suc) = ant"
primrec succ :: "'a sequent \<Rightarrow> 'a form multiset" where "succ (Sequent ant suc) = suc"
primrec mset :: "'a sequent \<Rightarrow> 'a form multiset" where "mset (Sequent ant suc) = ant + suc"
primrec seq_size :: "'a sequent \<Rightarrow> nat" where "seq_size (Sequent ant suc) = size ant + size suc"

(* Extend a sequent, and then a rule by adding seq to all premisses and the conclusion *)
defs extend_def : "extend forms seq \<equiv> (antec forms + antec seq) \<Rightarrow>* (succ forms + succ seq)"
defs extendRule_def : "extendRule forms R \<equiv> (map (extend forms) (fst R), extend forms (snd R))"

(* The unique conclusion property.  A set of rules has unique conclusion property if for any pair of rules,
   the conclusions being the same means the rules are the same*)
defs uniqueConclusion_def : "uniqueConclusion R \<equiv> \<forall> r1 \<in> R. \<forall> r2 \<in> R. (snd r1 = snd r2) \<longrightarrow> (r1 =r2)"

primrec max_list :: "nat list \<Rightarrow> nat" where
  "max_list [] = 0"
| "max_list (n # ns) = max n (max_list ns)"

(* The depth of a formula.  Will be useful in later files. *)
fun depth :: "'a form \<Rightarrow> nat"
where
   "depth (At i) = 0"
|  "depth (Compound f fs) = (max_list (map depth fs)) + 1"
|  "depth (ff) = 0"

(* The formulation of various rule sets *)

(* Ax is the set containing all identity RULES and LBot *)
inductive_set "Ax" where
   id[intro]: "([], \<LM> At i \<RM> \<Rightarrow>* \<LM> At i \<RM>) \<in> Ax"
|  Lbot[intro]: "([], \<LM> ff \<RM> \<Rightarrow>* \<Empt>) \<in> Ax"

(* upRules is the set of all rules which have a single conclusion.  This is akin to each rule having a
   single principal formula.  We don't want rules to have no premisses, hence the restriction
   that ps \<noteq> [] *)
inductive_set "upRules" where
   I[intro]: "\<lbrakk> mset c \<equiv> \<LM> Compound R Fs \<RM> ; ps \<noteq> [] \<rbrakk> \<Longrightarrow> (ps,c) \<in> upRules"

inductive_set extRules :: "'a rule set \<Rightarrow> 'a rule set"  ("_*")
  for R :: "'a rule set"
  where
   I[intro]: "r \<in> R \<Longrightarrow> extendRule seq r \<in> R*"

(* A formulation of what it means to be a principal formula for a rule.  Note that we have to build up from
   single conclusion rules.   *)

inductive leftPrincipal :: "'a rule \<Rightarrow> 'a form \<Rightarrow> bool"
  where
  up[intro]: "C = (\<LM>Compound F Fs\<RM> \<Rightarrow>* \<Empt>)  \<Longrightarrow>
                   leftPrincipal (Ps,C) (Compound F Fs)"

inductive rightPrincipal :: "'a rule \<Rightarrow> 'a form \<Rightarrow> bool"
  where
  up[intro]: "C = (\<Empt> \<Rightarrow>* \<LM>Compound F Fs\<RM>) \<Longrightarrow> rightPrincipal (Ps,C) (Compound F Fs)"

(* What it means to be a derivable sequent.  Can have this as a predicate or as a set.
   The two formation rules say that the supplied premisses are derivable, and the second says
   that if all the premisses of some rule are derivable, then so is the conclusion.  *)

inductive_set derivable :: "'a rule set \<Rightarrow> 'a deriv set"
  for R :: "'a rule set"
  where
   base[intro]: "\<lbrakk>([],C) \<in> R\<rbrakk> \<Longrightarrow> (C,0) \<in> derivable R"
|  step[intro]: "\<lbrakk> r \<in> R ; (fst r)\<noteq>[] ; \<forall> p \<in> set (fst r). \<exists> n \<le> m. (p,n) \<in> derivable R \<rbrakk>
                       \<Longrightarrow> (snd r,m + 1) \<in> derivable R"

(* When we don't care about height! *)
inductive_set derivable' :: "'a rule set \<Rightarrow> 'a sequent set"
   for R :: "'a rule set"
   where
    base[intro]: "\<lbrakk> ([],C) \<in> R \<rbrakk> \<Longrightarrow> C \<in> derivable' R"
|   step[intro]: "\<lbrakk> r \<in> R ; (fst r) \<noteq> [] ; \<forall> p \<in> set (fst r). p \<in> derivable' R \<rbrakk>
                       \<Longrightarrow> (snd r) \<in> derivable' R"

lemma deriv_to_deriv[simp]:
assumes "(C,n) \<in> derivable R"
shows "C \<in> derivable' R"
using assms by (induct) auto

lemma deriv_to_deriv2:
assumes "C \<in> derivable' R"
shows "\<exists> n. (C,n) \<in> derivable R"
using assms
proof (induct)
  case (base C)
  then have "(C,0) \<in> derivable R" by auto
  then show ?case by blast
next
  case (step r)
  then obtain ps c where "r = (ps,c)" and "ps \<noteq> []" by (cases r) auto
  then have aa: "\<forall> p \<in> set ps. \<exists> n. (p,n) \<in> derivable R" using step(3) by auto
  then have "\<exists> m. \<forall> p \<in> set ps. \<exists> n\<le>m. (p,n) \<in> derivable R"
  proof (induct ps)
    case Nil
    then show ?case  by auto
  next
    case (Cons a as)
    then have "\<exists> m. \<forall> p \<in> set as. \<exists> n\<le>m. (p,n) \<in> derivable R" by auto
    then obtain m where "\<forall> p \<in> set as. \<exists> n\<le>m. (p,n) \<in> derivable R" by auto
    moreover from `\<forall> p \<in> set (a # as). \<exists> n. (p,n) \<in> derivable R` have
      "\<exists> n. (a,n) \<in> derivable R" by auto
    then obtain m' where "(a,m') \<in> derivable R" by blast
    ultimately have "\<forall> p \<in> set (a # as). \<exists> n\<le>(max m m'). (p,n) \<in> derivable R"
      apply (auto simp add:Ball_def)
      apply (rule_tac x=m' in exI) apply simp
      apply (drule_tac x=x in spec) apply auto
      apply (rule_tac x=n in exI) apply auto done
    then show ?case by blast
  qed
  then obtain m where "\<forall> p \<in> set ps. \<exists> n\<le>m. (p,n) \<in> derivable R" by blast
  with `r = (ps,c)` and `r \<in> R` have "(c,m+1) \<in> derivable R" using `ps \<noteq> []` and
    derivable.step[where r="(ps,c)" and R=R and m=m] by auto
  then show ?case using `r = (ps,c)` by auto
qed

(* definition of invertible rule and invertible set of rules.  It's a bit nasty, but all it really says is
   If a rule is in the given set, and if any extension of that rule is derivable at n, then the
   premisses of the extended rule are derivable at height at most n.  *)
defs invertible_def : "invertible r R \<equiv> \<forall> n S. (r \<in> R \<and> (snd (extendRule S r),n) \<in> derivable R*) \<longrightarrow>
                                          (\<forall> p \<in> set (fst (extendRule S r)). \<exists> m \<le> n. (p,m) \<in> derivable R*)"

defs invertible_set_def : "invertible_set R \<equiv> \<forall> (ps,c) \<in> R. invertible (ps,c) R"

(* Characterisation of a sequent *)
lemma characteriseSeq:
shows "\<exists> A B. (C :: 'a sequent) = (A \<Rightarrow>* B)"
apply (rule_tac x="antec C" in exI, rule_tac x="succ C" in exI) by (cases C) (auto)

(* Helper function for later *)
lemma nonEmptySet:
shows "A \<noteq> [] \<longrightarrow> (\<exists> a. a \<in> set A)"
by (auto simp add:neq_Nil_conv)

(* Lemma which comes in helpful ALL THE TIME *)
lemma midMultiset:
  assumes "\<Gamma> \<oplus> A = \<Gamma>' \<oplus> B" and "A \<noteq> B"
  shows "\<exists> \<Gamma>''. \<Gamma> = \<Gamma>'' \<oplus> B \<and> \<Gamma>' = \<Gamma>'' \<oplus> A"
proof-
  from assms have "A :# \<Gamma>'"
      proof-
      from assms have "set_of (\<Gamma> \<oplus> A) = set_of (\<Gamma>' \<oplus> B)" by auto
      then have "set_of \<Gamma> \<union> {A} = set_of \<Gamma>' \<union> {B}" by auto
      then have "set_of \<Gamma> \<union> {A} \<subseteq> set_of \<Gamma>' \<union> {B}" by simp
      then have "A \<in> set_of \<Gamma>'" using assms by auto
      thus "A :# \<Gamma>'" by simp
      qed
  then have "\<Gamma>' \<ominus> A \<oplus> A = \<Gamma>'" by (auto simp add:multiset_eq_iff)
  then have "\<exists> \<Gamma>''. \<Gamma>' = \<Gamma>'' \<oplus> A" apply (rule_tac x="\<Gamma>' \<ominus> A" in exI) by auto
  then obtain \<Gamma>'' where eq1:"\<Gamma>' = \<Gamma>'' \<oplus> A" by blast
  from `\<Gamma> \<oplus> A = \<Gamma>' \<oplus> B` eq1 have "\<Gamma> \<oplus> A = \<Gamma>'' \<oplus> A \<oplus> B" by auto
  then have "\<Gamma> = \<Gamma>'' \<oplus> B" by (auto simp add:multiset_eq_iff)
  thus ?thesis using eq1 by blast
qed

(* Lemma which says that if we have extended an identity rule, then the propositional variable is
   contained in the extended multisets *)
lemma extendID:
assumes "extend S (\<LM> At i \<RM> \<Rightarrow>* \<LM> At i \<RM>) = (\<Gamma> \<Rightarrow>* \<Delta>)"
shows "At i :# \<Gamma> \<and> At i :# \<Delta>"
using assms
proof-
  from assms have "\<exists> \<Gamma>' \<Delta>'. \<Gamma> = \<Gamma>' \<oplus> At i \<and> \<Delta> = \<Delta>' \<oplus> At i"
    using extend_def[where forms=S and seq="\<LM> At i \<RM> \<Rightarrow>* \<LM> At i \<RM>"]
    by (rule_tac x="antec S" in exI,rule_tac x="succ S" in exI) auto
  then show ?thesis by auto
qed

lemma extendFalsum:
assumes "extend S (\<LM> ff \<RM> \<Rightarrow>* \<Empt>) = (\<Gamma> \<Rightarrow>* \<Delta>)"
shows "ff :# \<Gamma>"
proof-
  from assms have "\<exists> \<Gamma>'. \<Gamma> = \<Gamma>' \<oplus> ff"
    using extend_def[where forms=S and seq="\<LM>ff \<RM> \<Rightarrow>* \<Empt>"]
    by (rule_tac x="antec S" in exI) auto
  then show ?thesis by auto
qed

(* Lemma that says if a propositional variable is in both the antecedent and succedent of a sequent,
   then it is derivable from idupRules *)
lemma containID:
assumes a:"At i :# \<Gamma> \<and> At i :# \<Delta>"
    and b:"Ax \<subseteq> R"
shows "(\<Gamma> \<Rightarrow>* \<Delta>,0) \<in> derivable R*"
proof-
  from a have "\<Gamma> = \<Gamma> \<ominus> At i \<oplus> At i \<and> \<Delta> = \<Delta> \<ominus> At i \<oplus> At i" by auto
  then have "extend ((\<Gamma> \<ominus> At i) \<Rightarrow>* (\<Delta> \<ominus> At i)) (\<LM> At i \<RM> \<Rightarrow>* \<LM> At i \<RM>) = (\<Gamma> \<Rightarrow>* \<Delta>)"
    using extend_def[where forms="\<Gamma> \<ominus> At i \<Rightarrow>* \<Delta> \<ominus> At i" and seq="\<LM>At i\<RM> \<Rightarrow>* \<LM>At i\<RM>"]
    by auto
  moreover
  have "([],\<LM> At i \<RM> \<Rightarrow>* \<LM> At i \<RM>) \<in> R" using b by auto
  ultimately
  have "([],\<Gamma> \<Rightarrow>* \<Delta>) \<in> R*"
    using extRules.I[where R=R and r="([],  \<LM>At i\<RM> \<Rightarrow>* \<LM>At i\<RM>)" and seq="\<Gamma> \<ominus> At i \<Rightarrow>* \<Delta> \<ominus> At i"]
      and extendRule_def[where forms="\<Gamma> \<ominus> At i \<Rightarrow>* \<Delta> \<ominus> At i" and R="([],  \<LM>At i\<RM> \<Rightarrow>* \<LM>At i\<RM>)"] by auto
  then show ?thesis using derivable.base[where R="R*" and C="\<Gamma> \<Rightarrow>* \<Delta>"] by auto
qed

lemma containFalsum:
assumes a: "ff :# \<Gamma>"
   and  b: "Ax \<subseteq> R"
shows "(\<Gamma> \<Rightarrow>* \<Delta>,0) \<in> derivable R*"
proof-
  from a have "\<Gamma> = \<Gamma> \<ominus> ff \<oplus> ff" by auto
  then have "extend (\<Gamma> \<ominus> ff \<Rightarrow>* \<Delta>) (\<LM>ff\<RM> \<Rightarrow>* \<Empt>) = (\<Gamma> \<Rightarrow>* \<Delta>)"
    using extend_def[where forms="\<Gamma> \<ominus> ff \<Rightarrow>* \<Delta>" and seq="\<LM>ff\<RM> \<Rightarrow>* \<Empt>"] by auto
  moreover
  have "([],\<LM>ff\<RM> \<Rightarrow>* \<Empt>) \<in> R" using b by auto
  ultimately have "([],\<Gamma> \<Rightarrow>* \<Delta>) \<in> R*"
    using extRules.I[where R=R and r="([],  \<LM>ff\<RM> \<Rightarrow>* \<Empt>)" and seq="\<Gamma> \<ominus> ff \<Rightarrow>* \<Delta>"]
      and extendRule_def[where forms="\<Gamma> \<ominus> ff \<Rightarrow>* \<Delta>" and R="([],  \<LM>ff\<RM> \<Rightarrow>* \<Empt>)"] by auto
  then show ?thesis using derivable.base[where R="R*" and C="\<Gamma> \<Rightarrow>* \<Delta>"] by auto
qed

(* Lemma which says that if r is an identity rule, then r is of the form
   ([], P \<Rightarrow>* P) *)
lemma characteriseAx:
shows "r \<in> Ax \<Longrightarrow> r = ([],\<LM> ff \<RM> \<Rightarrow>* \<Empt>) \<or> (\<exists> i. r = ([], \<LM> At i \<RM> \<Rightarrow>* \<LM> At i \<RM>))"
  apply (cases r) by (rule Ax.cases) auto

(* A lemma about the last rule used in a derivation, i.e. that one exists *)
lemma characteriseLast:
assumes "(C,m+1) \<in> derivable R"
shows "\<exists> Ps. Ps \<noteq> [] \<and>
             (Ps,C) \<in> R \<and>
             (\<forall> p \<in> set Ps. \<exists> n\<le>m. (p,n) \<in> derivable R)"
using assms
by (cases) auto

(* Lemma which says that if rule is an upRule, then the succedent is either empty, or a single formula *)
lemma succ_upRule:
assumes "(Ps,\<Phi> \<Rightarrow>* \<Psi>) \<in> upRules"
shows "\<Psi> = \<Empt> \<or> (\<exists> A. \<Psi> = \<LM>A\<RM>)"
using assms
proof (cases)
    case (I R Rs)
    then show "\<Psi> = \<Empt> \<or> (\<exists> A. \<Psi> = \<LM>A\<RM>)" using mset.simps[where ant=\<Phi> and suc=\<Psi>]
         and union_is_single[where M=\<Phi> and N=\<Psi> and a="Compound R Rs"] by (simp,elim disjE) (auto)
qed

(* Equivalent, but the antecedent *)
lemma antec_upRule:
assumes "(Ps,\<Phi> \<Rightarrow>* \<Psi>) \<in> upRules"
shows "\<Phi> = \<Empt> \<or> (\<exists> A. \<Phi> = \<LM>A\<RM>)"
using assms
proof (cases)
    case (I R Rs)
    then show "\<Phi> = \<Empt> \<or> (\<exists> A. \<Phi> = \<LM>A\<RM>)" using mset.simps[where ant=\<Phi> and suc=\<Psi>]
         and union_is_single[where M=\<Phi> and N=\<Psi> and a="Compound R Rs"] by (simp,elim disjE) (auto)
qed

lemma upRule_Size:
assumes "r \<in> upRules"
shows "seq_size (snd r) = 1"
using assms
proof-
    obtain Ps C where "r = (Ps,C)" by (cases r)
    then have "(Ps,C) \<in> upRules" using assms by simp
    then show ?thesis
       proof (cases)
          case (I R Rs)
          obtain G H where "C = (G \<Rightarrow>* H)" by (cases C) (auto)
          then have "G + H = \<LM>Compound R Rs\<RM>" using mset.simps and `mset C \<equiv> \<LM>Compound R Rs\<RM>` by auto
          then have "size (G+H) = 1" by auto
          then have "size G + size H = 1" by auto
          then have "seq_size C = 1" using seq_size.simps[where ant=G and suc=H] and `C = (G \<Rightarrow>* H)` by auto
          moreover have "snd r = C" using `r = (Ps,C)` by simp
          ultimately show "seq_size (snd r) = 1" by simp
       qed
qed

lemma upRuleCharacterise:
assumes "(Ps,C) \<in> upRules"
shows "\<exists> F Fs. C = (\<Empt> \<Rightarrow>* \<LM>Compound F Fs\<RM>) \<or> C = (\<LM>Compound F Fs\<RM> \<Rightarrow>* \<Empt>)"
using assms
proof (cases)
  case (I F Fs)
  then obtain \<Gamma> \<Delta> where "C = (\<Gamma> \<Rightarrow>* \<Delta>)" using characteriseSeq[where C=C] by auto
  then have "(Ps,\<Gamma> \<Rightarrow>* \<Delta>) \<in> upRules" using assms by simp
  then show "\<exists> F Fs. C = (\<Empt> \<Rightarrow>* \<LM>Compound F Fs\<RM>) \<or> C = (\<LM>Compound F Fs\<RM> \<Rightarrow>* \<Empt>)"
    using `mset C \<equiv> \<LM>Compound F Fs\<RM>` and `C = (\<Gamma> \<Rightarrow>* \<Delta>)`
      and mset.simps[where ant=\<Gamma> and suc=\<Delta>] and union_is_single[where M=\<Gamma> and N=\<Delta> and a="Compound F Fs"]
    by auto
qed

lemma extendEmpty:
shows "extend (\<Empt> \<Rightarrow>* \<Empt>) C = C"
apply (auto simp add:extend_def) by (cases C) auto

lemma extendContain:
assumes "r = (ps,c)"
    and "(Ps,C) = extendRule S r"
    and "p \<in> set ps"
shows "extend S p \<in> set Ps"
proof-
from `p \<in> set ps` have "extend S p \<in> set (map (extend S) ps)" by auto
moreover from `(Ps,C) = extendRule S r` and `r = (ps,c)` have "map (extend S) ps = Ps" by (simp add:extendRule_def)
ultimately show ?thesis by auto
qed

lemma nonPrincipalID:
fixes A :: "'a form"
assumes "r \<in> Ax"
shows "\<not> rightPrincipal r A \<and> \<not> leftPrincipal r A"
proof-
from assms obtain i where r1:"r = ([], \<LM> ff \<RM> \<Rightarrow>* \<Empt>) \<or> r = ([], \<LM> At i \<RM> \<Rightarrow>* \<LM> At i\<RM>)"
     using characteriseAx[where r=r] by auto
{ assume "rightPrincipal r A" then obtain Ps where r2:"r = (Ps, \<Empt> \<Rightarrow>* \<LM> A \<RM>)" by (cases r) auto
  with r1 have "False" by simp
}
then have "\<not> rightPrincipal r A" by auto
moreover
{ assume "leftPrincipal r A" then obtain Ps' F Fs where r3:"r = (Ps', \<LM>Compound F Fs\<RM> \<Rightarrow>* \<Empt>)" by (cases r) auto
  with r1 have "False" by auto
}
then have "\<not> leftPrincipal r A" by auto
ultimately show ?thesis by simp
qed

lemma extendCommute:
shows "(extend S) (extend R c) = (extend R) (extend S c)"
by (auto simp add:extend_def union_ac)

lemma mapCommute:
shows "map (extend S) (map (extend R) c) = map (extend R) (map (extend S) c)"
by (induct_tac c) (auto simp add:extendCommute)

lemma extendAssoc:
shows "(extend S) (extend R c) = extend (extend S R) c"
by (auto simp add:extend_def union_ac)

lemma mapAssoc:
shows "map (extend S) (map (extend R) c) = map (extend (extend S R)) c"
by (induct_tac c) (auto simp add:extendAssoc)

lemma extended_Ax_prems_empty:
assumes "r \<in> Ax"
shows "fst (extendRule S r) = []"
using assms apply (cases r) by (rule Ax.cases) (auto simp add:extendRule_def)

inductive lastRule :: "'a deriv \<Rightarrow> 'a rule \<Rightarrow> 'a rule set \<Rightarrow> bool"
  where
  base[intro]: "\<lbrakk> r \<in> Ax; Ax \<subseteq> R ; snd (extendRule S r) = (\<Gamma> \<Rightarrow>* \<Delta>)\<rbrakk>
                 \<Longrightarrow> lastRule (\<Gamma> \<Rightarrow>* \<Delta>,0) r R"
|    I[intro]:  "\<lbrakk> r\<in>R ; r \<notin> Ax ; snd (extendRule S r) = (\<Gamma> \<Rightarrow>* \<Delta>) ;
                \<forall> p \<in> set (fst (extendRule S r)). \<exists> m\<le>n. (p,m) \<in> derivable R* \<rbrakk>
                 \<Longrightarrow> lastRule (\<Gamma> \<Rightarrow>* \<Delta>,n+1) r R"

lemma obv:
fixes a :: "('a * 'b)"
shows "a = (fst a, snd a)" by auto

lemma getLast:
assumes "lastRule (\<Gamma> \<Rightarrow>* \<Delta>,n+1) r R"
shows "\<exists> S Ps. extendRule S r = (Ps, \<Gamma> \<Rightarrow>* \<Delta>) \<and> (\<forall> p \<in> set Ps. \<exists> m\<le>n. (p,m) \<in> derivable R*) \<and> r \<in> R \<and> r \<notin> Ax"
proof-
  from assms show ?thesis apply (rule lastRule.cases) apply simp apply simp
  apply (rule_tac x=S in exI) apply (rule_tac x="fst (extendRule S r)" in exI) apply simp
  apply auto
  apply (subgoal_tac "extendRule S (a,b) = (fst (extendRule S (a,b)),snd (extendRule S (a,b)))")
  apply simp by (rule obv)
qed

lemma getAx:
assumes "lastRule (\<Gamma> \<Rightarrow>* \<Delta>,0) r R"
shows "r \<in> Ax \<and> (\<exists> S. extendRule S r = ([],\<Gamma> \<Rightarrow>* \<Delta>))"
proof-
  from assms have "r \<in> Ax \<and> (\<exists> S. snd (extendRule S r) = (\<Gamma> \<Rightarrow>* \<Delta>))"
       by (rule lastRule.cases) auto
  then obtain S where "r \<in> Ax" and "snd (extendRule S r) = (\<Gamma> \<Rightarrow>* \<Delta>)" by auto
  from `r \<in> Ax` have "fst r = []" apply (cases r) by (rule Ax.cases) auto
  then have "fst (extendRule S r) = []" by (auto simp add:extendRule_def)
  with `snd (extendRule S r) = (\<Gamma> \<Rightarrow>* \<Delta>)` and `r \<in> Ax` show ?thesis apply auto
       apply (rule_tac x=S in exI)
       apply (subgoal_tac "extendRule S r = (fst (extendRule S r),snd (extendRule S r))") apply simp
       by (rule obv)
qed

(* Has the usual set-up: takes a subset of the upRules, combines with all the axioms, blah blah *)

(* Constructing the rule set we will use.  It contains all axioms, but only a subset
   of the possible logical rules. *)
lemma ruleSet:
assumes "R' \<subseteq> upRules"
    and "R = Ax \<union> R'"
    and "(Ps,C) \<in> R*"
shows "\<exists> S r. extendRule S r = (Ps,C) \<and> (r \<in> R' \<or> r \<in> Ax)"
proof-
from `(Ps,C) \<in> R*` have "\<exists> S r. extendRule S r = (Ps,C) \<and> r \<in> R" by (cases) auto
then obtain S r where "(Ps,C) = extendRule S r" and "r \<in> R" apply auto
                by (drule_tac x=S in meta_spec,drule_tac x=a in meta_spec, drule_tac x=b in meta_spec) auto
moreover from `r \<in> R` and `R = Ax \<union> R'` have "r \<in> Ax \<or> r \<in> R'" by blast
ultimately show ?thesis by (rule_tac x=S in exI,rule_tac x=r in exI) (auto)
qed

lemma dpWeak:
assumes a:"(\<Gamma> \<Rightarrow>* \<Delta>,n) \<in> derivable R*"
   and  b: "R' \<subseteq> upRules"
   and  c: "R = Ax \<union> R'"
shows "(\<Gamma> + \<Gamma>' \<Rightarrow>* \<Delta> + \<Delta>',n) \<in> derivable R*"
using a
proof (induct n arbitrary: \<Gamma> \<Delta> rule:nat_less_induct)
case (1 n \<Gamma> \<Delta>)
then have IH: "\<forall>m<n. \<forall> \<Gamma> \<Delta>. ( \<Gamma> \<Rightarrow>* \<Delta>, m) \<in> derivable R* \<longrightarrow> ( \<Gamma> + \<Gamma>' \<Rightarrow>* \<Delta> + \<Delta>', m) \<in> derivable R*"
      and a': "( \<Gamma> \<Rightarrow>* \<Delta>, n) \<in> derivable R*" by auto
show ?case
proof (cases n)
case 0
 then have "(\<Gamma> \<Rightarrow>* \<Delta>,0) \<in> derivable R*" using a' by simp
 then have "([], \<Gamma> \<Rightarrow>* \<Delta>) \<in> R*" by (cases) auto
 then obtain  r S where "r \<in> R" and split:"extendRule S r = ([],\<Gamma> \<Rightarrow>* \<Delta>)"
      by (rule extRules.cases) auto
 then obtain c where "r = ([],c)" by (cases r) (auto simp add:extendRule_def)
 with `r \<in> R` have "r \<in> Ax \<or> r \<in> upRules" using b c by auto
 with `r = ([],c)` have "r \<in> Ax" by (auto) (rule upRules.cases,auto)
 with `r = ([],c)` obtain i where "c = (\<LM>At i\<RM> \<Rightarrow>* \<LM>At i\<RM>) \<or> c = (\<LM>ff\<RM> \<Rightarrow>* \<Empt>)"
      using characteriseAx[where r=r] by auto
 moreover
    {assume "c = (\<LM>At i\<RM> \<Rightarrow>* \<LM>At i\<RM>)"
     then have "extend S (\<LM>At i\<RM> \<Rightarrow>*\<LM>At i\<RM>) = (\<Gamma> \<Rightarrow>* \<Delta>)" using split and `r = ([],c)`
          by (auto simp add:extendRule_def)
     then have "At i :# \<Gamma> \<and> At i :# \<Delta>" using extendID by auto
     then have "At i :# \<Gamma> + \<Gamma>' \<and> At i :# \<Delta> + \<Delta>'" by auto
     then have "(\<Gamma> + \<Gamma>' \<Rightarrow>* \<Delta> + \<Delta>',0) \<in> derivable R*"
          using c and containID[where \<Gamma>="\<Gamma>+\<Gamma>'" and \<Delta>="\<Delta>+\<Delta>'" and R=R and i=i] by auto
    }
 moreover
    {assume "c = (\<LM>ff\<RM> \<Rightarrow>* \<Empt>)"
     then have "extend S (\<LM>ff\<RM> \<Rightarrow>*\<Empt>) = (\<Gamma> \<Rightarrow>* \<Delta>)" using split and `r = ([],c)`
          by (auto simp add:extendRule_def)
     then have "ff :# \<Gamma>" using extendFalsum by auto
     then have "ff :# \<Gamma> + \<Gamma>'" by auto
     then have "(\<Gamma> + \<Gamma>' \<Rightarrow>* \<Delta> + \<Delta>',0) \<in> derivable R*"
          using c and containFalsum[where \<Gamma>="\<Gamma>+\<Gamma>'" and \<Delta>="\<Delta>+\<Delta>'" and R=R] by auto
    }
 ultimately show "(\<Gamma> + \<Gamma>' \<Rightarrow>* \<Delta> + \<Delta>',n) \<in> derivable R*" using `n=0` by auto
next
case (Suc n')
 then have "(\<Gamma> \<Rightarrow>* \<Delta>, n'+1) \<in> derivable R*" using a' by simp
 then obtain Ps where f:"Ps \<noteq> []"
                  and g:"(Ps, \<Gamma> \<Rightarrow>* \<Delta>) \<in> R*"
                  and h:"\<forall> p \<in> set Ps. \<exists> m\<le>n'. (p,m) \<in> derivable R*"
      using characteriseLast[where C="\<Gamma> \<Rightarrow>* \<Delta>" and m=n' and R="R*"] by auto
 from g c obtain S r where "r \<in> R" and "(r \<in> Ax \<or> r \<in> R') \<and> extendRule S r = (Ps, \<Gamma> \<Rightarrow>* \<Delta>)" by (cases) auto
 with b have as: "(r \<in> Ax \<or> r \<in> upRules) \<and> extendRule S r = (Ps, \<Gamma> \<Rightarrow>* \<Delta>)" by auto
 then have eq:"map (extend (\<Gamma>' \<Rightarrow>* \<Delta>')) Ps = fst (extendRule (extend S (\<Gamma>' \<Rightarrow>* \<Delta>')) r)"
       using mapCommute[where S="\<Gamma>'\<Rightarrow>*\<Delta>'" and R=S and c="fst r"]
       by (auto simp add:extendRule_def extend_def mapAssoc simp del: map_map)
 from as have eq2: "(\<Gamma> + \<Gamma>' \<Rightarrow>* \<Delta> + \<Delta>') = snd (extendRule (extend S (\<Gamma>' \<Rightarrow>* \<Delta>')) r)"
       by (auto simp add:extendRule_def extend_def union_ac)
 from as f have "fst r \<noteq> []" by (auto simp add:extendRule_def map_is_Nil_conv)
 with as have "r \<in> upRules" apply (cases r,auto) by (rule Ax.cases) auto
 have "\<forall> p' \<in> set (map (extend (\<Gamma>' \<Rightarrow>* \<Delta>')) Ps). \<exists> m\<le>n'. (p',m) \<in> derivable R*"
      proof-
      {fix p
       assume "p \<in> set (map (extend (\<Gamma>' \<Rightarrow>* \<Delta>')) Ps)"
       then obtain p' where t:"p' \<in> set Ps \<and> p = extend (\<Gamma>' \<Rightarrow>* \<Delta>') p'" by auto
       with h obtain m where "m\<le>n'" and "(p',m) \<in> derivable R*" by auto
       moreover obtain \<Phi> \<Psi> where eq:"p' = (\<Phi> \<Rightarrow>* \<Psi>)" by (cases p') auto
       then have "p = (\<Phi> + \<Gamma>' \<Rightarrow>* \<Psi> + \<Delta>')" using t by (auto simp add:extend_def union_ac)
       ultimately have "(p,m) \<in> derivable R*" using IH and `n = Suc n'` and eq
            apply- by (drule_tac x=m in spec) simp
       then have "\<exists> m\<le>n'. (p,m) \<in> derivable R*" using `m\<le>n'` by auto
       }
       then show ?thesis by auto
       qed
 then have "\<forall> p' \<in> set (fst (extendRule (extend S (\<Gamma>' \<Rightarrow>* \<Delta>')) r)).
            \<exists> m\<le>n'. (p',m) \<in> derivable R*" using eq by auto
 moreover have "extendRule (extend S (\<Gamma>' \<Rightarrow>* \<Delta>')) r \<in> R*"
          using `r \<in> upRules` and `r \<in> R` by auto
 ultimately have "(\<Gamma> + \<Gamma>' \<Rightarrow>* \<Delta> + \<Delta>',n'+1) \<in> derivable R*"
          using derivable.step[where r="extendRule (extend S (\<Gamma>' \<Rightarrow>* \<Delta>')) r" and R="R*" and m="n'"]
          and `fst r \<noteq> []` and eq2 by (cases r) (auto simp add:map_is_Nil_conv extendRule_def)
 then show "( \<Gamma> + \<Gamma>' \<Rightarrow>* \<Delta> + \<Delta>', n) \<in> derivable R*" using `n = Suc n'` by auto
 qed
qed
(*>*)
text{*
\section{Manipulating Rule Sets \label{isaSRC}}
The removal of superfluous and redundant rules \cite{AL01} will not be harmful to invertibility: removing rules means that the conditions of earlier sections are more likely to be fulfilled.  Here, we formalise the results that the removal of such rules from a calculus $\mathcal{L}$ will create a new calculus $\mathcal{L}'$ which is equivalent.  In other words, if a sequent is derivable in $\mathcal{L}$, then it is derivable in $\mathcal{L}'$.
The results formalised in this section are for \SC multisuccedent calculi.

When dealing with lists of premisses, a rule $R$ with premisses $P$ will be redundant given a rule $R'$ with premisses $P'$ if there exists some $p$ such that $P = p \# P'$.  There are other ways in which a rule could be redundant; say if $P = Q @ P'$, or if $P = P' @ Q$, and so on.  The order of the premisses is not really important, since the formalisation operates on the finite set based upon the list.  The more general ``append'' lemma could be proved from the lemma we give; we prove the inductive step case in the proof of such an append lemma.  This is a height preserving transformation.  Some of the proof is shown:
*}

lemma removeRedundant:
assumes (*<*)a:(*>*) "r1 = (p#ps,c) \<and> r1 \<in> upRules"
and     (*<*)b:(*>*) "r2 = (ps,c) \<and> r2 \<in> upRules"
and     (*<*)c:(*>*) "R1 \<subseteq> upRules \<and> R = Ax \<union> R1"
and     (*<*)d:(*>*) "(T,n) \<in> derivable (R \<union> {r1} \<union> {r2})*"
shows   "\<exists> m\<le>n. (T,m) \<in> derivable (R \<union> {r2})*"
 (*<*)
using assms (*>*)
proof (induct n (*<*)arbitrary: T (*>*)rule:nat_less_induct)
 (*<*)case (1 n T)
    then have IH: " \<forall>m<n. \<forall> x. (r1 = (p # ps, c) \<and> r1 \<in> upRules \<longrightarrow>
                         r2 = (ps, c) \<and> r2 \<in> upRules \<longrightarrow>
                         R1 \<subseteq> upRules \<and> R = Ax \<union> R1 \<longrightarrow>
                         (x, m) \<in> derivable (R \<union> {r1} \<union> {r2})* \<longrightarrow>
                         (\<exists> m'\<le>m. (x, m') \<in> derivable (R \<union> {r2})*))" and
             prm: "(T,n) \<in> derivable (R \<union> {r1} \<union> {r2})*" by auto
    show ?case
 proof (cases n) (*>*)
 case 0
  (*<*) with prm (*>*) have "(T,0) \<in> derivable (R \<union> {r1} \<union> {r2})*" by simp
   then have "([],T) \<in> (R \<union> {r1} \<union> {r2})*" by (cases) auto
   then obtain S r where ext: "extendRule S r = ([],T)" and
        "r \<in> (R \<union> {r1} \<union> {r2})" by (rule extRules.cases) auto
   then have "r \<in> R \<or> r = r1 \<or> r = r2" using c by auto
txt{* \noindent It cannot be the case that $r=r_{1}$ or $r=r_{2}$, since those are \SC rules, whereas anything with an empty set of premisses
must be an axiom.  Since $\mathcal{R}$ contains the set of axioms, so will $\mathcal{R} \cup r_{2}$: *}
 (*<*)   moreover from ext obtain d where "r = ([],d)" by (cases r) (auto simp add:extendRule_def)
   ultimately have "r \<in> R \<or> r = r2" using c a ext by (auto simp add:extendRule_def) (*>*)
   then have "r \<in> (R \<union> {r2})" using c by auto
 (*<*)  then have "([],T) \<in> (R \<union> {r2})*" using `extendRule S r = ([],T)`
          and extRules.I[where r=r and R="R \<union> {r2}" and seq=S] by auto (*>*)
  then have "(T,0) \<in> derivable (R \<union> {r2})*" by auto
  then show "\<exists> m\<le>n. (T,m) \<in> derivable (R \<union> {r2})*" using `n=0` by auto
next
 case (Suc n')
 (*<*) with prm (*>*)have "(T,n'+1) \<in> derivable (R \<union> {r1} \<union> {r2})*" by simp
  then obtain Ps where e: "Ps \<noteq> []"
         and   f: "(Ps,T) \<in> (R \<union> {r1} \<union> {r2})*"
         and   g: "\<forall> P \<in> set Ps. \<exists> m\<le>n'. (P,m) \<in> derivable (R \<union> {r1} \<union> {r2})*"
        (*<*) using characteriseLast[where C=T and m=n' and R="(R \<union> {r1} \<union> {r2})*"](*>*) by auto
  have g': "\<forall> P \<in> set Ps. \<exists> m\<le>n'. (P,m) \<in> derivable (R \<union> {r2})*"
  (*<*)       proof-
              {fix P
               assume "P \<in> set Ps"
               with g obtain m where "(P,m) \<in> derivable (R \<union> {r1} \<union> {r2})*" and "m\<le>n'" by auto
               with IH have "\<exists> m'\<le>m. (P,m') \<in> derivable (R \<union> {r2})*" using a b c and `n = Suc n'`
                    by auto
               then have "\<exists> m\<le>n'. (P,m) \<in> derivable (R \<union> {r2})*" using `m\<le>n'` apply auto
                    by (rule_tac x=m' in exI) auto
              }
              then show ?thesis by auto
         qed  (*>*)
   from f obtain S r where ext: "extendRule S r = (Ps,T)"
        and "r \<in> (R \<union> {r1} \<union> {r2})" by (rule extRules.cases) auto
    then have "r \<in> (R \<union> {r2}) \<or> r = r1" by auto
txt{* \noindent Either $r$ is in the new rule set or $r$ is the redundant rule.  In the former case, there is nothing to do:*}
 (*<*)moreover
    {(*>*) assume "r \<in> (R \<union> {r2})"
     then have "(Ps,T) \<in> (R \<union> {r2})*" (*<*)using ext and extRules.I[where r=r and R="R \<union> {r2}" and seq=S](*>*) by auto
     with g' have "(T,n) \<in> derivable (R \<union> {r2})*" using `n = Suc n'` (*<*)and e and
       derivable.step[where r="(Ps,T)" and R="(R \<union> {r2})*" and m=n'](*>*) by auto
   (*<*) }
 moreover
    { (*>*)
txt{* \noindent In the latter case, the last inference was redundant.  Therefore the premisses, which are derivable at a lower height than the conclusion,
contain the premisses of $r_{2}$ (these premisses are \texttt{extend S ps}).  This completes the proof: *}
     assume "r = r1"
     with ext have "map (extend S) (p # ps) = Ps" using a by (auto(*<*) simp add:extendRule_def(*>*))
     then have "\<forall> P \<in> set (map (extend S) (p#ps)).
                   \<exists> m\<le>n'. (P,m) \<in> derivable (R \<union> {r2})*"
         using g' by simp
     then have h: "\<forall> P \<in> set (map (extend S) ps).
                      \<exists> m\<le>n'. (P,m) \<in> derivable (R \<union> {r2})*" by auto

 (*<*)    have "extendRule S r2 = (map (extend S) ps, T)" using b and a and ext and `r = r1`
           by (auto simp add:extendRule_def)
     then have i: "(map (extend S) ps,T) \<in> (R \<union> {r2})*" using extRules.I(*<*)[where r=r2 and R="(R \<union> {r2})" and seq=S](*>*)
               by auto
    have "ps = [] \<or> ps \<noteq> []" by blast
   moreover
       {assume "ps = []"
         with i have "([],T) \<in> (R \<union> {r2})*" by auto
         then have "(T,0) \<in> derivable (R \<union> {r2})*" by auto
         then have "\<exists> m\<le>n. (T,m) \<in> derivable (R \<union> {r2})*" by auto
       }
       moreover
          {assume "ps \<noteq> []"
           then have "map (extend S) ps \<noteq> []" by auto
            with i and h have "(T,n'+1) \<in> derivable (R \<union> {r2})*"
                  using derivable.step[where r="(map (extend S) ps,T)" and R="(R \<union> {r2})*" and m=n'] by auto
           with `n = Suc n'` have "\<exists> m\<le>n. (T,m) \<in> derivable (R \<union> {r2})*" by auto
           }
       ultimately have "\<exists> m\<le>n. (T,m) \<in> derivable (R \<union> {r2})*" by blast
     }
  ultimately show "\<exists> m\<le>n. (T,m) \<in> derivable (R \<union> {r2})*" by blast
  qed
qed(*>*)
text{*
\noindent Recall that to remove superfluous rules, we must know that Cut is admissible in the original calculus \cite{AL01}.  Again, we add the two distinguished premisses at the head of the premiss list; general results about permutation of lists will achieve a more general result.  Since one uses Cut in the proof, this will in general not be height-preserving:
*}

lemma removeSuperfluous:
assumes (*<*)a:(*>*) "r1 = ((\<Empt> \<Rightarrow>* \<LM>A\<RM>) # ((\<LM>A\<RM> \<Rightarrow>* \<Empt>) # ps),c) \<and> r1 \<in> upRules"
and     (*<*)b:(*>*) "R1 \<subseteq> upRules \<and> R = Ax \<union> R1"
and     "(T,n) \<in> derivable (R \<union> {r1})*"
and     CA: "\<forall> \<Gamma> \<Delta> A. ((\<Gamma> \<Rightarrow>* \<Delta> \<oplus> A) \<in> derivable' R* \<longrightarrow>
             (\<Gamma> \<oplus> A \<Rightarrow>* \<Delta>) \<in> derivable' R*) \<longrightarrow>
             (\<Gamma> \<Rightarrow>* \<Delta>) \<in> derivable' R*"
shows   "T \<in> derivable' R*"
(*<*)
using assms
proof (induct n arbitrary: T rule: nat_less_induct)
  case (1 n T)
  then have IH: "\<forall>m<n. r1 = (( \<Empt> \<Rightarrow>* \<LM>A\<RM>) # ( \<LM>A\<RM> \<Rightarrow>* \<Empt>) # ps, c) \<and> r1 \<in> upRules \<longrightarrow>
    R1 \<subseteq> upRules \<and> R = Ax \<union> R1 \<longrightarrow>
    (\<forall> T. (T, m) \<in> derivable (R \<union> {r1})* \<longrightarrow>
    (\<forall> \<Gamma> \<Delta> B.
    ((\<Gamma> \<Rightarrow>* \<Delta> \<oplus> B) \<in> derivable' R* \<longrightarrow> (\<Gamma> \<oplus> B \<Rightarrow>* \<Delta>) \<in> derivable' R*) \<longrightarrow>
    (\<Gamma> \<Rightarrow>* \<Delta>) \<in> derivable' R*) \<longrightarrow>
    T \<in> derivable' R*)" by blast
  from 1 have prm: "(T,n) \<in> derivable (R \<union> {r1})*" by blast
  show ?case
  proof (cases n)
    case 0
    with prm have "(T,0) \<in> derivable (R \<union> {r1})*" by simp
    then have "([],T) \<in> (R \<union> {r1})*" by (rule derivable.cases) auto
    then obtain S r where ext: "extendRule S r = ([],T)" and "r \<in> (R \<union> {r1})" by (rule extRules.cases) auto
    then have "r \<in> R \<or> r = r1" by auto
    with a have "r \<in> R" using ext by (auto simp add:extendRule_def)
    then have "([],T) \<in> R*" using ext and extRules.I[where r=r and R=R and seq=S] by auto
    then show "T \<in> derivable' R*" by auto
  next
    case (Suc n')
    with prm have prm': "(T,n'+1) \<in> derivable (R \<union> {r1})*" by auto
    then obtain Ps where ne: "Ps \<noteq> []"
      and   ex: "(Ps,T) \<in> (R \<union> {r1})*"
      and   "\<forall> P \<in> set Ps. \<exists> m\<le>n'. (P,m) \<in> derivable (R \<union> {r1})*"
      using characteriseLast[where C=T and m=n' and R="(R \<union> {r1})*"] by auto
    with IH have e: "\<forall> P \<in> set Ps. P \<in> derivable' R*" using a b and prm' and `n = Suc n'`
      apply (auto simp only:Ball_def) apply (drule_tac x=x in spec) apply auto
      apply (drule_tac x=m in spec) apply auto apply (drule_tac x=x in spec) apply simp
      apply (insert CA[simplified]) apply (subgoal_tac "R = Ax \<union> R1") apply blast apply (insert b) by blast
    from ex obtain S r where ext: "extendRule S r = (Ps,T)" and "r \<in> (R \<union> {r1})" by (rule extRules.cases) auto
    then have "r \<in> R \<or> r = r1" by blast
    moreover
    {assume "r \<in> R"
      with ext have "(Ps,T) \<in> R*" using extRules.I[where r=r and R=R and seq=S] by auto
      with e have "T \<in> derivable' R*" using ne and
        derivable'.step[where r="(Ps,T)" and R="R*"] by auto
    }
    moreover
    {assume "r = r1"
      with e and a and ext have "(extend S (\<LM>A\<RM> \<Rightarrow>* \<Empt>)) \<in> derivable' R*"
        and  "(extend S (\<Empt> \<Rightarrow>* \<LM>A\<RM>)) \<in> derivable' R*"
        by (auto simp add:extendRule_def)
      then have "S \<in> derivable' R*" using CA apply-
        apply (drule_tac x="antec S" in spec) apply (drule_tac x="succ S" in spec) apply (drule_tac x=A in spec)
        apply (simp add:extend_def) by (cases S) auto
      then obtain s where "(S,s) \<in> derivable R*" using deriv_to_deriv2 by auto
      then have "(extend S c,s) \<in> derivable R*"
        using dpWeak[where R=R and R'=R1 and \<Gamma>="antec S" and \<Delta>="succ S"
          and \<Gamma>'="antec c" and \<Delta>'="succ c" and n=s] and b
        apply (auto simp add:extend_def union_ac) by (cases S) auto
      with ext have "(T,s) \<in> derivable R*" using `r = r1` and a by (auto simp add:extendRule_def)
      then have "T \<in> derivable' R*" by auto
    }
    ultimately show "T \<in> derivable' R*" by blast
  qed
qed
(*>*)

text{*
\noindent \textit{Combinable rules} can also be removed.  We encapsulate the combinable criterion by saying that if $(p \# P,T)$ and $(q \# P, T)$ are rules in a calculus, then we get an equivalent calculus by replacing these two rules by $((\textrm{extend } p \ q) \# P, T)$.  Since the \texttt{extend} function is commutative, the order of $p$ and $q$ in the new rule is not important.  This transformation is height preserving:
*}

lemma removeCombinable:
assumes a: "r1 = (p # ps,c) \<and> r1 \<in> upRules"
and     b: "r2 = (q # ps,c) \<and> r2 \<in> upRules"
and     c: "r3 = (extend p q # ps, c) \<and> r3 \<in> upRules"
and     d: "R1 \<subseteq> upRules \<and> R = Ax \<union> R1"
and     "(T,n) \<in> derivable (R \<union> {r1} \<union> {r2})*"
shows   "(T,n) \<in> derivable (R \<union> {r3})*"
(*<*)
using assms
proof (induct n arbitrary:T rule:nat_less_induct)
case (1 n T)
    then have IH: "\<forall>m<n. \<forall> T. (r1 = (p # ps, c) \<and> r1 \<in> upRules \<longrightarrow>
                               r2 = (q # ps, c) \<and> r2 \<in> upRules \<longrightarrow>
                               r3 = (extend p q # ps, c) \<and> r3 \<in> upRules \<longrightarrow>
                               R1 \<subseteq> upRules \<and> R = Ax \<union> R1 \<longrightarrow>
                              (T, m) \<in> derivable (R \<union> {r1} \<union> {r2})* \<longrightarrow>
                              (T, m) \<in> derivable (R \<union> {r3})*)" and
             prm: "(T, n) \<in> derivable (R \<union> {r1} \<union> {r2})*" by auto
    show ?case
    proof (cases n)
    case 0
        with prm have "(T,0) \<in> derivable (R \<union> {r1} \<union> {r2})*" by simp
        then have "([],T) \<in> (R \<union> {r1} \<union> {r2})*" by (rule derivable.cases) auto
        then obtain S r where ext: "extendRule S r = ([],T)" and "r \<in> (R \<union> {r1} \<union> {r2})" by (rule extRules.cases) auto
        then have "r \<in> R \<or> r = r1 \<or> r = r2" by blast
        with ext and a and b have "r \<in> R" by (auto simp add:extendRule_def)
        then have "r \<in> (R \<union> {r3})" by simp
        with ext have "([],T) \<in> (R \<union> {r3})*" using extRules.I[where r=r and R="R \<union> {r3}" and seq=S] by auto
        then have "(T,0) \<in> derivable (R \<union> {r3})*" by auto
        then show "(T,n) \<in> derivable (R \<union> {r3})*" using `n=0` by auto
    next
    case (Suc n')
        with prm have prm': "(T,n'+1) \<in> derivable (R \<union> {r1} \<union> {r2})*" by simp
        then obtain Ps where ne: "Ps \<noteq> []"
                       and   ex: "(Ps,T) \<in> (R \<union> {r1} \<union> {r2})*"
                       and   "\<forall> P \<in> set Ps. \<exists> m\<le>n'. (P,m) \<in> derivable (R \<union> {r1} \<union> {r2})*"
             using characteriseLast[where C=T and m=n' and R="(R \<union> {r1} \<union> {r2})*"] by auto
        with IH have e: "\<forall> P \<in> set Ps. \<exists> m\<le>n'. (P,m) \<in> derivable (R \<union> {r3})*" using a b c d and prm' and `n = Suc n'`
             apply (auto simp add:Ball_def) by (drule_tac x=x in spec) auto
        from ex obtain S r where ext: "extendRule S r = (Ps,T)" and "r \<in> (R \<union> {r1} \<union> {r2})" by (rule extRules.cases) auto
        then have "r \<in> R \<or> r = r1 \<or> r = r2" by blast
        moreover
           {assume "r \<in> R"
            then have "r \<in> (R \<union> {r3})" by simp
            with ext have "(Ps,T) \<in> (R \<union> {r3})*" using extRules.I[where r=r and R="R \<union> {r3}" and seq=S] by auto
            with e have "(T,n'+1) \<in> derivable (R \<union> {r3})*" using ne and
                 derivable.step[where r="(Ps,T)" and R="(R \<union> {r3})*" and m=n'] by auto
           }
        moreover
           {assume "r = r1"
            with e and a and ext have "\<exists> m\<le>n'. (extend S p,m) \<in> derivable (R \<union> {r3})*"
                 by (auto simp add:extendRule_def)
            then have "\<exists> m\<le>n'. (extend S (extend q p),m) \<in> derivable (R \<union> {r3})*"
                 using dpWeak[where R="R \<union> {r3}" and R'="R1 \<union> {r3}" and \<Gamma>="antec S + antec p" and \<Delta>="succ S + succ p"
                              and \<Gamma>'="antec q" and \<Delta>'="succ q"] and d c by (auto simp add:extend_def union_ac)
            moreover from e and ext and `r = r1` and a
                 have "\<forall> P \<in> set (map (extend S) ps). \<exists> m\<le>n'. (P,m) \<in> derivable (R \<union> {r3})*"
                 by (auto simp add:extendRule_def)
            ultimately have "\<forall> P \<in> set (map (extend S) (extend q p # ps)). \<exists> m\<le>n'. (P,m) \<in> derivable (R \<union> {r3})*"
                 by auto
            moreover have "extend q p = extend p q" by (auto simp add:extend_def union_ac)
            ultimately have pm: "\<forall> P \<in> set (fst (extendRule S r3)). \<exists> m\<le>n'. (P,m) \<in> derivable (R \<union> {r3})*"
                 using c by (auto simp add:extendRule_def)
            from ext and a and c and `r = r1` have con: "snd (extendRule S r3) = T" by (auto simp add:extendRule_def)
            have "r3 \<in> (R \<union> {r3})" by simp
            then have "extendRule S r3 \<in> (R \<union> {r3})*" by auto
            with pm and con and c have "(T,n'+1) \<in> derivable (R \<union> {r3})*"
                 using derivable.step[where r="extendRule S r3" and R="(R \<union> {r3})*" and m=n']
                 by (auto simp add:extendRule_def)
           }
        moreover
           {assume "r = r2"
            with e and b and ext have "\<exists> m\<le>n'. (extend S q,m) \<in> derivable (R \<union> {r3})*"
                 by (auto simp add:extendRule_def)
            then have "\<exists> m\<le>n'. (extend S (extend p q),m) \<in> derivable (R \<union> {r3})*"
                 using dpWeak[where R="R \<union> {r3}" and R'="R1 \<union> {r3}" and \<Gamma>="antec S + antec q" and \<Delta>="succ S + succ q"
                              and \<Gamma>'="antec p" and \<Delta>'="succ p"] and d c by (auto simp add:extend_def union_ac)
            moreover from e and ext and `r = r2` and b
                 have "\<forall> P \<in> set (map (extend S) ps). \<exists> m\<le>n'. (P,m) \<in> derivable (R \<union> {r3})*"
                 by (auto simp add:extendRule_def)
            ultimately have "\<forall> P \<in> set (map (extend S) (extend p q # ps)). \<exists> m\<le>n'. (P,m) \<in> derivable (R \<union> {r3})*"
                 by auto
            then have pm: "\<forall> P \<in> set (fst (extendRule S r3)). \<exists> m\<le>n'. (P,m) \<in> derivable (R \<union> {r3})*"
                 using c by (auto simp add:extendRule_def)
            from ext and b and c and `r = r2` have con: "snd (extendRule S r3) = T" by (auto simp add:extendRule_def)
            have "r3 \<in> (R \<union> {r3})" by simp
            then have "extendRule S r3 \<in> (R \<union> {r3})*" by auto
            with pm and con and c have "(T,n'+1) \<in> derivable (R \<union> {r3})*"
                 using derivable.step[where r="extendRule S r3" and R="(R \<union> {r3})*" and m=n']
                 by (auto simp add:extendRule_def)
           }
        ultimately show "(T,n) \<in> derivable (R \<union> {r3})*" using `n = Suc n'` by auto
    qed
qed
(*>*)
text{*
\section{Conclusions}

Only a portion of the formalisation was shown; a variety of intermediate lemmata were not made explicit.  This was necessary, for the \textit{Isabelle} theory files run to almost 8000 lines.  However, these files do not have to be replicated for each new calculus.  It takes very little effort to define a new calculus.  Furthermore, proving invertibility is now a quick process; less than 25 lines of proof in most cases.
*}
(*<*)
end(*>*)


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

Theory of Public Keys (common to all public-key protocols)

Private and public keys; initial states of agents
*)

theory Public
imports Event
begin

lemma invKey_K: "K \<in> symKeys ==> invKey K = K"
by (simp add: symKeys_def)

subsection\<open>Asymmetric Keys\<close>

datatype keymode = Signature | Encryption

consts
  publicKey :: "[keymode,agent] \<Rightarrow> key"

abbreviation
  pubEK :: "agent \<Rightarrow> key" where
  "pubEK == publicKey Encryption"

abbreviation
  pubSK :: "agent \<Rightarrow> key" where
  "pubSK == publicKey Signature"

abbreviation
  privateKey :: "[keymode, agent] \<Rightarrow> key" where
  "privateKey b A == invKey (publicKey b A)"

abbreviation
  (*BEWARE!! priEK, priSK DON'T WORK with inj, range, image, etc.*)
  priEK :: "agent \<Rightarrow> key" where
  "priEK A == privateKey Encryption A"

abbreviation
  priSK :: "agent \<Rightarrow> key" where
  "priSK A == privateKey Signature A"

text\<open>These abbreviations give backward compatibility.  They represent the
simple situation where the signature and encryption keys are the same.\<close>

abbreviation
  pubK :: "agent \<Rightarrow> key" where
  "pubK A == pubEK A"

abbreviation
  priK :: "agent \<Rightarrow> key" where
  "priK A == invKey (pubEK A)"

text\<open>By freeness of agents, no two agents have the same key.  Since
  \<^term>\<open>True\<noteq>False\<close>, no agent has identical signing and encryption keys\<close>
specification (publicKey)
  injective_publicKey:
    "publicKey b A = publicKey c A' ==> b=c \<and> A=A'"
   apply (rule exI [of _
       "\<lambda>b A. 2 * case_agent 0 (\<lambda>n. n + 2) 1 A + case_keymode 0 1 b"])
   apply (auto simp add: inj_on_def split: agent.split keymode.split)
   apply presburger
   apply presburger
   done

axiomatization where
  (*No private key equals any public key (essential to ensure that private
    keys are private!) *)
  privateKey_neq_publicKey [iff]: "privateKey b A \<noteq> publicKey c A'"

lemmas publicKey_neq_privateKey = privateKey_neq_publicKey [THEN not_sym]
declare publicKey_neq_privateKey [iff]

subsection\<open>Basic properties of \<^term>\<open>pubK\<close> and \<^term>\<open>priK\<close>\<close>

lemma publicKey_inject [iff]: "(publicKey b A = publicKey c A') = (b=c \<and> A=A')"
by (blast dest!: injective_publicKey)

lemma not_symKeys_pubK [iff]: "publicKey b A \<notin> symKeys"
by (simp add: symKeys_def)

lemma not_symKeys_priK [iff]: "privateKey b A \<notin> symKeys"
by (simp add: symKeys_def)

lemma symKey_neq_priEK: "K \<in> symKeys ==> K \<noteq> priEK A"
by auto

lemma symKeys_neq_imp_neq: "(K \<in> symKeys) \<noteq> (K' \<in> symKeys) ==> K \<noteq> K'"
by blast

lemma symKeys_invKey_iff [iff]: "(invKey K \<in> symKeys) = (K \<in> symKeys)"
by (unfold symKeys_def, auto)

lemma analz_symKeys_Decrypt:
     "[| Crypt K X \<in> analz H;  K \<in> symKeys;  Key K \<in> analz H |]
      ==> X \<in> analz H"
by (auto simp add: symKeys_def)

subsection\<open>"Image" equations that hold for injective functions\<close>

lemma invKey_image_eq [simp]: "(invKey x \<in> invKey`A) = (x \<in> A)"
by auto

(*holds because invKey is injective*)
lemma publicKey_image_eq [simp]:
     "(publicKey b x \<in> publicKey c ` AA) = (b=c \<and> x \<in> AA)"
by auto

lemma privateKey_notin_image_publicKey [simp]: "privateKey b x \<notin> publicKey c ` AA"
by auto

lemma privateKey_image_eq [simp]:
     "(privateKey b A \<in> invKey ` publicKey c ` AS) = (b=c \<and> A\<in>AS)"
by auto

lemma publicKey_notin_image_privateKey [simp]: "publicKey b A \<notin> invKey ` publicKey c ` AS"
by auto

subsection\<open>Symmetric Keys\<close>

text\<open>For some protocols, it is convenient to equip agents with symmetric as
well as asymmetric keys.  The theory \<open>Shared\<close> assumes that all keys
are symmetric.\<close>

consts
  shrK    :: "agent => key"    \<comment> \<open>long-term shared keys\<close>

specification (shrK)
  inj_shrK: "inj shrK"
  \<comment> \<open>No two agents have the same long-term key\<close>
   apply (rule exI [of _ "case_agent 0 (\<lambda>n. n + 2) 1"])
   apply (simp add: inj_on_def split: agent.split)
   done

axiomatization where
  sym_shrK [iff]: "shrK X \<in> symKeys" \<comment> \<open>All shared keys are symmetric\<close>

text\<open>Injectiveness: Agents' long-term keys are distinct.\<close>
lemmas shrK_injective = inj_shrK [THEN inj_eq]
declare shrK_injective [iff]

lemma invKey_shrK [simp]: "invKey (shrK A) = shrK A"
by (simp add: invKey_K)

lemma analz_shrK_Decrypt:
     "[| Crypt (shrK A) X \<in> analz H; Key(shrK A) \<in> analz H |] ==> X \<in> analz H"
by auto

lemma analz_Decrypt':
     "[| Crypt K X \<in> analz H; K \<in> symKeys; Key K \<in> analz H |] ==> X \<in> analz H"
by (auto simp add: invKey_K)

lemma priK_neq_shrK [iff]: "shrK A \<noteq> privateKey b C"
by (simp add: symKeys_neq_imp_neq)

lemmas shrK_neq_priK = priK_neq_shrK [THEN not_sym]
declare shrK_neq_priK [simp]

lemma pubK_neq_shrK [iff]: "shrK A \<noteq> publicKey b C"
by (simp add: symKeys_neq_imp_neq)

lemmas shrK_neq_pubK = pubK_neq_shrK [THEN not_sym]
declare shrK_neq_pubK [simp]

lemma priEK_noteq_shrK [simp]: "priEK A \<noteq> shrK B"
by auto

lemma publicKey_notin_image_shrK [simp]: "publicKey b x \<notin> shrK ` AA"
by auto

lemma privateKey_notin_image_shrK [simp]: "privateKey b x \<notin> shrK ` AA"
by auto

lemma shrK_notin_image_publicKey [simp]: "shrK x \<notin> publicKey b ` AA"
by auto

lemma shrK_notin_image_privateKey [simp]: "shrK x \<notin> invKey ` publicKey b ` AA"
by auto

lemma shrK_image_eq [simp]: "(shrK x \<in> shrK ` AA) = (x \<in> AA)"
by auto

text\<open>For some reason, moving this up can make some proofs loop!\<close>
declare invKey_K [simp]

subsection\<open>Initial States of Agents\<close>

text\<open>Note: for all practical purposes, all that matters is the initial
knowledge of the Spy.  All other agents are automata, merely following the
protocol.\<close>

overloading
  initState \<equiv> initState
begin

primrec initState where
        (*Agents know their private key and all public keys*)
  initState_Server:
    "initState Server     =
       {Key (priEK Server), Key (priSK Server)} \<union>
       (Key ` range pubEK) \<union> (Key ` range pubSK) \<union> (Key ` range shrK)"

| initState_Friend:
    "initState (Friend i) =
       {Key (priEK(Friend i)), Key (priSK(Friend i)), Key (shrK(Friend i))} \<union>
       (Key ` range pubEK) \<union> (Key ` range pubSK)"

| initState_Spy:
    "initState Spy        =
       (Key ` invKey ` pubEK ` bad) \<union> (Key ` invKey ` pubSK ` bad) \<union>
       (Key ` shrK ` bad) \<union>
       (Key ` range pubEK) \<union> (Key ` range pubSK)"

end

text\<open>These lemmas allow reasoning about \<^term>\<open>used evs\<close> rather than
   \<^term>\<open>knows Spy evs\<close>, which is useful when there are private Notes.
   Because they depend upon the definition of \<^term>\<open>initState\<close>, they cannot
   be moved up.\<close>

lemma used_parts_subset_parts [rule_format]:
     "\<forall>X \<in> used evs. parts {X} \<subseteq> used evs"
apply (induct evs)
 prefer 2
 apply (simp add: used_Cons split: event.split)
 apply (metis Un_iff empty_subsetI insert_subset le_supI1 le_supI2 parts_subset_iff)
txt\<open>Base case\<close>
apply (auto dest!: parts_cut simp add: used_Nil)
done

lemma MPair_used_D: "\<lbrace>X,Y\<rbrace> \<in> used H ==> X \<in> used H \<and> Y \<in> used H"
by (drule used_parts_subset_parts, simp, blast)

text\<open>There was a similar theorem in Event.thy, so perhaps this one can
  be moved up if proved directly by induction.\<close>
lemma MPair_used [elim!]:
     "[| \<lbrace>X,Y\<rbrace> \<in> used H;
         [| X \<in> used H; Y \<in> used H |] ==> P |]
      ==> P"
by (blast dest: MPair_used_D)

text\<open>Rewrites should not refer to  \<^term>\<open>initState(Friend i)\<close> because
  that expression is not in normal form.\<close>

lemma keysFor_parts_initState [simp]: "keysFor (parts (initState C)) = {}"
apply (unfold keysFor_def)
apply (induct_tac "C")
apply (auto intro: range_eqI)
done

lemma Crypt_notin_initState: "Crypt K X \<notin> parts (initState B)"
by (induct B, auto)

lemma Crypt_notin_used_empty [simp]: "Crypt K X \<notin> used []"
by (simp add: Crypt_notin_initState used_Nil)

(*** Basic properties of shrK ***)

(*Agents see their own shared keys!*)
lemma shrK_in_initState [iff]: "Key (shrK A) \<in> initState A"
by (induct_tac "A", auto)

lemma shrK_in_knows [iff]: "Key (shrK A) \<in> knows A evs"
by (simp add: initState_subset_knows [THEN subsetD])

lemma shrK_in_used [iff]: "Key (shrK A) \<in> used evs"
by (rule initState_into_used, blast)

(** Fresh keys never clash with long-term shared keys **)

(*Used in parts_induct_tac and analz_Fake_tac to distinguish session keys
  from long-term shared keys*)
lemma Key_not_used [simp]: "Key K \<notin> used evs ==> K \<notin> range shrK"
by blast

lemma shrK_neq: "Key K \<notin> used evs ==> shrK B \<noteq> K"
by blast

lemmas neq_shrK = shrK_neq [THEN not_sym]
declare neq_shrK [simp]

subsection\<open>Function \<^term>\<open>spies\<close>\<close>

lemma not_SignatureE [elim!]: "b \<noteq> Signature \<Longrightarrow> b = Encryption"
  by (cases b, auto)

text\<open>Agents see their own private keys!\<close>
lemma priK_in_initState [iff]: "Key (privateKey b A) \<in> initState A"
  by (cases A, auto)

text\<open>Agents see all public keys!\<close>
lemma publicKey_in_initState [iff]: "Key (publicKey b A) \<in> initState B"
  by (cases B, auto)

text\<open>All public keys are visible\<close>
lemma spies_pubK [iff]: "Key (publicKey b A) \<in> spies evs"
apply (induct_tac "evs")
apply (auto simp add: imageI knows_Cons split: event.split)
done

lemmas analz_spies_pubK = spies_pubK [THEN analz.Inj]
declare analz_spies_pubK [iff]

text\<open>Spy sees private keys of bad agents!\<close>
lemma Spy_spies_bad_privateKey [intro!]:
     "A \<in> bad ==> Key (privateKey b A) \<in> spies evs"
apply (induct_tac "evs")
apply (auto simp add: imageI knows_Cons split: event.split)
done

text\<open>Spy sees long-term shared keys of bad agents!\<close>
lemma Spy_spies_bad_shrK [intro!]:
     "A \<in> bad ==> Key (shrK A) \<in> spies evs"
apply (induct_tac "evs")
apply (simp_all add: imageI knows_Cons split: event.split)
done

lemma publicKey_into_used [iff] :"Key (publicKey b A) \<in> used evs"
apply (rule initState_into_used)
apply (rule publicKey_in_initState [THEN parts.Inj])
done

lemma privateKey_into_used [iff]: "Key (privateKey b A) \<in> used evs"
apply(rule initState_into_used)
apply(rule priK_in_initState [THEN parts.Inj])
done

(*For case analysis on whether or not an agent is compromised*)
lemma Crypt_Spy_analz_bad:
     "[| Crypt (shrK A) X \<in> analz (knows Spy evs);  A \<in> bad |]
      ==> X \<in> analz (knows Spy evs)"
by force

subsection\<open>Fresh Nonces\<close>

lemma Nonce_notin_initState [iff]: "Nonce N \<notin> parts (initState B)"
by (induct_tac "B", auto)

lemma Nonce_notin_used_empty [simp]: "Nonce N \<notin> used []"
by (simp add: used_Nil)

subsection\<open>Supply fresh nonces for possibility theorems\<close>

text\<open>In any trace, there is an upper bound N on the greatest nonce in use\<close>
lemma Nonce_supply_lemma: "\<exists>N. \<forall>n. N\<le>n \<longrightarrow> Nonce n \<notin> used evs"
apply (induct_tac "evs")
apply (rule_tac x = 0 in exI)
apply (simp_all (no_asm_simp) add: used_Cons split: event.split)
apply safe
apply (rule msg_Nonce_supply [THEN exE], blast elim!: add_leE)+
done

lemma Nonce_supply1: "\<exists>N. Nonce N \<notin> used evs"
by (rule Nonce_supply_lemma [THEN exE], blast)

lemma Nonce_supply: "Nonce (SOME N. Nonce N \<notin> used evs) \<notin> used evs"
apply (rule Nonce_supply_lemma [THEN exE])
apply (rule someI, fast)
done

subsection\<open>Specialized Rewriting for Theorems About \<^term>\<open>analz\<close> and Image\<close>

lemma insert_Key_singleton: "insert (Key K) H = Key ` {K} \<union> H"
by blast

lemma insert_Key_image: "insert (Key K) (Key`KK \<union> C) = Key ` (insert K KK) \<union> C"
by blast

lemma Crypt_imp_keysFor :"[|Crypt K X \<in> H; K \<in> symKeys|] ==> K \<in> keysFor H"
by (drule Crypt_imp_invKey_keysFor, simp)

text\<open>Lemma for the trivial direction of the if-and-only-if of the
Session Key Compromise Theorem\<close>
lemma analz_image_freshK_lemma:
     "(Key K \<in> analz (Key`nE \<union> H)) \<longrightarrow> (K \<in> nE | Key K \<in> analz H)  ==>
         (Key K \<in> analz (Key`nE \<union> H)) = (K \<in> nE | Key K \<in> analz H)"
by (blast intro: analz_mono [THEN [2] rev_subsetD])

lemmas analz_image_freshK_simps =
       simp_thms mem_simps \<comment> \<open>these two allow its use with \<open>only:\<close>\<close>
       disj_comms
       image_insert [THEN sym] image_Un [THEN sym] empty_subsetI insert_subset
       analz_insert_eq Un_upper2 [THEN analz_mono, THEN subsetD]
       insert_Key_singleton
       Key_not_used insert_Key_image Un_assoc [THEN sym]

ML \<open>
structure Public =
struct

val analz_image_freshK_ss =
  simpset_of
   (\<^context> delsimps [image_insert, image_Un]
    delsimps [@{thm imp_disjL}]    (*reduces blow-up*)
    addsimps @{thms analz_image_freshK_simps})

(*Tactic for possibility theorems*)
fun possibility_tac ctxt =
    REPEAT (*omit used_Says so that Nonces start from different traces!*)
    (ALLGOALS (simp_tac (ctxt setSolver safe_solver delsimps [@{thm used_Says}]))
     THEN
     REPEAT_FIRST (eq_assume_tac ORELSE'
                   resolve_tac ctxt [refl, conjI, @{thm Nonce_supply}]))

(*For harder protocols (such as Recur) where we have to set up some
  nonces and keys initially*)
fun basic_possibility_tac ctxt =
    REPEAT
    (ALLGOALS (asm_simp_tac (ctxt setSolver safe_solver))
     THEN
     REPEAT_FIRST (resolve_tac ctxt [refl, conjI]))

end
\<close>

method_setup analz_freshK = \<open>
    Scan.succeed (fn ctxt =>
     (SIMPLE_METHOD
      (EVERY [REPEAT_FIRST (resolve_tac ctxt [allI, ballI, impI]),
          REPEAT_FIRST (resolve_tac ctxt @{thms analz_image_freshK_lemma}),
          ALLGOALS (asm_simp_tac (put_simpset Public.analz_image_freshK_ss ctxt))])))\<close>
    "for proving the Session Key Compromise theorem"

subsection\<open>Specialized Methods for Possibility Theorems\<close>

method_setup possibility = \<open>
    Scan.succeed (SIMPLE_METHOD o Public.possibility_tac)\<close>
    "for proving possibility theorems"

method_setup basic_possibility = \<open>
    Scan.succeed (SIMPLE_METHOD o Public.basic_possibility_tac)\<close>
    "for proving possibility theorems"

end