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

section "Predicates and functions used in the AODV model"

theory Aodv_Data
imports Aodv_Basic
begin

subsection "Sequence Numbers"

text \<open>Sequence numbers approximate the relative freshness of routing information.\<close>

definition inc :: "sqn \<Rightarrow> sqn"
  where "inc sn \<equiv> if sn = 0 then sn else sn + 1"

lemma less_than_inc [simp]: "x \<le> inc x"
  unfolding inc_def by simp

lemma inc_minus_suc_0 [simp]:
  "inc x - Suc 0 = x"
  unfolding inc_def by simp

lemma inc_never_one' [simp, intro]: "inc x \<noteq> Suc 0"
  unfolding inc_def by simp

lemma inc_never_one [simp, intro]: "inc x \<noteq> 1"
  by simp

subsection "Modelling Routes"

text \<open>
  A route is a 6-tuple, @{term "(dsn, dsk, flag, hops, nhip, pre)"} where
  @{term dsn} is the `destination sequence number', @{term dsk} is the
  `destination-sequence-number status', @{term flag} is the route status,
  @{term hops} is the number of hops to the destination, @{term nhip} is the
  next hop toward the destination, and @{term pre} is the set of `precursor nodes'--those
  interested in hearing about changes to the route.
\<close>

type_synonym r = "sqn \<times> k \<times> f \<times> nat \<times> ip \<times> ip set"

definition proj2 :: "r \<Rightarrow> sqn" ("\<pi>\<^sub>2")
  where "\<pi>\<^sub>2 \<equiv> \<lambda>(dsn, _, _, _, _, _). dsn"

definition proj3 :: "r \<Rightarrow> k" ("\<pi>\<^sub>3")
  where "\<pi>\<^sub>3 \<equiv> \<lambda>(_, dsk, _, _, _, _). dsk"

definition proj4 :: "r \<Rightarrow> f" ("\<pi>\<^sub>4")
  where "\<pi>\<^sub>4 \<equiv> \<lambda>(_, _, flag, _, _, _). flag"

definition proj5 :: "r \<Rightarrow> nat" ("\<pi>\<^sub>5")
  where "\<pi>\<^sub>5 \<equiv> \<lambda>(_, _, _, hops, _, _). hops"

definition proj6 :: "r \<Rightarrow> ip" ("\<pi>\<^sub>6")
  where "\<pi>\<^sub>6 \<equiv> \<lambda>(_, _, _, _, nhip, _). nhip"

definition proj7 :: "r \<Rightarrow> ip set" ("\<pi>\<^sub>7")
  where "\<pi>\<^sub>7 \<equiv> \<lambda>(_, _, _, _, _, pre). pre"

lemma projs [simp]:
  "\<pi>\<^sub>2(dsn, dsk, flag, hops, nhip, pre) = dsn"
  "\<pi>\<^sub>3(dsn, dsk, flag, hops, nhip, pre) = dsk"
  "\<pi>\<^sub>4(dsn, dsk, flag, hops, nhip, pre) = flag"
  "\<pi>\<^sub>5(dsn, dsk, flag, hops, nhip, pre) = hops"
  "\<pi>\<^sub>6(dsn, dsk, flag, hops, nhip, pre) = nhip"
  "\<pi>\<^sub>7(dsn, dsk, flag, hops, nhip, pre) = pre"
  by (clarsimp simp: proj2_def proj3_def proj4_def
                     proj5_def proj6_def proj7_def)+

lemma proj3_pred [intro]: "\<lbrakk> P kno; P unk \<rbrakk> \<Longrightarrow> P (\<pi>\<^sub>3 x)"
  by (rule k.induct)

lemma proj4_pred [intro]: "\<lbrakk> P val; P inv \<rbrakk> \<Longrightarrow> P (\<pi>\<^sub>4 x)"
  by (rule f.induct)

subsection "Routing Tables"

text \<open>Routing tables map ip addresses to route entries.\<close>

type_synonym rt = "ip \<rightharpoonup> r"

syntax
  "_Sigma_route" :: "rt \<Rightarrow> ip \<rightharpoonup> r"  ("\<sigma>\<^bsub>route\<^esub>'(_, _')")

translations
 "\<sigma>\<^bsub>route\<^esub>(rt, dip)" => "rt dip"

definition sqn :: "rt \<Rightarrow> ip \<Rightarrow> sqn"
  where "sqn rt dip \<equiv> case \<sigma>\<^bsub>route\<^esub>(rt, dip) of Some r \<Rightarrow> \<pi>\<^sub>2(r) | None \<Rightarrow> 0"

definition sqnf :: "rt \<Rightarrow> ip \<Rightarrow> k"
  where "sqnf rt dip \<equiv> case \<sigma>\<^bsub>route\<^esub>(rt, dip) of Some r \<Rightarrow> \<pi>\<^sub>3(r) | None \<Rightarrow> unk"

abbreviation flag :: "rt \<Rightarrow> ip \<rightharpoonup> f"
  where "flag rt dip \<equiv> map_option \<pi>\<^sub>4 (\<sigma>\<^bsub>route\<^esub>(rt, dip))"

abbreviation dhops :: "rt \<Rightarrow> ip \<rightharpoonup> nat"
   where "dhops rt dip \<equiv> map_option \<pi>\<^sub>5 (\<sigma>\<^bsub>route\<^esub>(rt, dip))"

abbreviation nhop :: "rt \<Rightarrow> ip \<rightharpoonup> ip"
   where "nhop rt dip \<equiv> map_option \<pi>\<^sub>6 (\<sigma>\<^bsub>route\<^esub>(rt, dip))"

abbreviation precs :: "rt \<Rightarrow> ip \<rightharpoonup> ip set"
   where "precs rt dip \<equiv> map_option \<pi>\<^sub>7 (\<sigma>\<^bsub>route\<^esub>(rt, dip))"

definition vD :: "rt \<Rightarrow> ip set"
  where "vD rt \<equiv> {dip. flag rt dip = Some val}"

definition iD :: "rt \<Rightarrow> ip set"
  where "iD rt \<equiv> {dip. flag rt dip = Some inv}"

definition kD :: "rt \<Rightarrow> ip set"
  where "kD rt \<equiv> {dip. rt dip \<noteq> None}"

lemma kD_is_vD_and_iD: "kD rt = vD rt \<union> iD rt"
  unfolding kD_def vD_def iD_def by auto

lemma vD_iD_gives_kD [simp]:
   "\<And>ip rt. ip \<in> vD rt \<Longrightarrow> ip \<in> kD rt"
   "\<And>ip rt. ip \<in> iD rt \<Longrightarrow> ip \<in> kD rt"
  unfolding kD_is_vD_and_iD by simp_all

lemma kD_Some [dest]:
    fixes dip rt
  assumes "dip \<in> kD rt"
    shows "\<exists>dsn dsk flag hops nhip pre.
           \<sigma>\<^bsub>route\<^esub>(rt, dip) = Some (dsn, dsk, flag, hops, nhip, pre)"
  using assms unfolding kD_def by simp

lemma kD_None [dest]:
    fixes dip rt
  assumes "dip \<notin> kD rt"
    shows "\<sigma>\<^bsub>route\<^esub>(rt, dip) = None"
  using assms unfolding kD_def
  by (metis (mono_tags) mem_Collect_eq)

lemma vD_Some [dest]:
    fixes dip rt
  assumes "dip \<in> vD rt"
    shows "\<exists>dsn dsk hops nhip pre.
           \<sigma>\<^bsub>route\<^esub>(rt, dip) = Some (dsn, dsk, val, hops, nhip, pre)"
  using assms unfolding vD_def by simp

lemma vD_empty [simp]: "vD Map.empty = {}"
  unfolding vD_def by simp

lemma iD_Some [dest]:
    fixes dip rt
  assumes "dip \<in> iD rt"
    shows "\<exists>dsn dsk hops nhip pre.
           \<sigma>\<^bsub>route\<^esub>(rt, dip) = Some (dsn, dsk, inv, hops, nhip, pre)"
  using assms unfolding iD_def by simp

lemma val_is_vD [elim]:
    fixes ip rt
  assumes "ip\<in>kD(rt)"
      and "the (flag rt ip) = val"
    shows "ip\<in>vD(rt)"
  using assms unfolding vD_def by auto

lemma inv_is_iD [elim]:
    fixes ip rt
  assumes "ip\<in>kD(rt)"
      and "the (flag rt ip) = inv"
    shows "ip\<in>iD(rt)"
  using assms unfolding iD_def by auto

lemma iD_flag_is_inv [elim, simp]:
    fixes ip rt
  assumes "ip\<in>iD(rt)"
    shows "the (flag rt ip) = inv"
  proof -
    from \<open>ip\<in>iD(rt)\<close> have "ip\<in>kD(rt)" by auto
    with assms show ?thesis unfolding iD_def by auto
  qed

lemma kD_but_not_vD_is_iD [elim]:
    fixes ip rt
  assumes "ip\<in>kD(rt)"
      and "ip\<notin>vD(rt)"
    shows "ip\<in>iD(rt)"
  proof -
    from \<open>ip\<in>kD(rt)\<close> obtain dsn dsk f hops nhop pre
      where rtip: "rt ip = Some (dsn, dsk, f, hops, nhop, pre)"
       by (metis kD_Some)
    from \<open>ip\<notin>vD(rt)\<close> have "f \<noteq> val"
    proof (rule contrapos_nn)
      assume "f = val"
      with rtip have "the (flag rt ip) = val" by simp
      with \<open>ip\<in>kD(rt)\<close> show "ip\<in>vD(rt)" ..
    qed
    with rtip have "the (flag rt ip)= inv" by simp
    with \<open>ip\<in>kD(rt)\<close> show "ip\<in>iD(rt)" ..
  qed

lemma vD_or_iD [elim]:
    fixes ip rt
  assumes "ip\<in>kD(rt)"
      and "ip\<in>vD(rt) \<Longrightarrow> P rt ip"
      and "ip\<in>iD(rt) \<Longrightarrow> P rt ip"
    shows "P rt ip"
  proof -
    from \<open>ip\<in>kD(rt)\<close> have "ip\<in>vD(rt) \<union> iD(rt)"
      by (simp add: kD_is_vD_and_iD)
    thus ?thesis by (auto elim: assms(2-3))
  qed

lemma proj5_eq_dhops: "\<And>dip rt. dip\<in>kD(rt) \<Longrightarrow> \<pi>\<^sub>5(the (rt dip)) = the (dhops rt dip)"
  unfolding sqn_def by (drule kD_Some) clarsimp

lemma proj4_eq_flag: "\<And>dip rt. dip\<in>kD(rt) \<Longrightarrow> \<pi>\<^sub>4(the (rt dip)) = the (flag rt dip)"
  unfolding sqn_def by (drule kD_Some) clarsimp

lemma proj2_eq_sqn: "\<And>dip rt. dip\<in>kD(rt) \<Longrightarrow> \<pi>\<^sub>2(the (rt dip)) = sqn rt dip"
  unfolding sqn_def by (drule kD_Some) clarsimp

lemma kD_sqnf_is_proj3 [simp]:
  "\<And>ip rt. ip\<in>kD(rt) \<Longrightarrow> sqnf rt ip = \<pi>\<^sub>3(the (rt ip))"
  unfolding sqnf_def by auto

lemma vD_flag_val [simp]:
  "\<And>dip rt. dip \<in> vD (rt) \<Longrightarrow> the (flag rt dip) = val"
  unfolding vD_def by clarsimp

lemma kD_update [simp]:
  "\<And>rt nip v. kD (rt(nip \<mapsto> v)) = insert nip (kD rt)"
  unfolding kD_def by auto

lemma kD_empty [simp]: "kD Map.empty = {}"
  unfolding kD_def by simp

lemma ip_equal_or_known [elim]:
  fixes rt ip ip'
  assumes "ip = ip' \<or> ip\<in>kD(rt)"
      and "ip = ip' \<Longrightarrow> P rt ip ip'"
      and "\<lbrakk> ip \<noteq> ip'; ip\<in>kD(rt)\<rbrakk> \<Longrightarrow> P rt ip ip'"
    shows "P rt ip ip'"
  using assms by auto

subsection "Updating Routing Tables"

text \<open>Routing table entries are modified through explicit functions.
      The properties of these functions are important in invariant proofs.\<close>

subsubsection "Updating Precursor Lists"

definition addpre :: "r \<Rightarrow> ip set \<Rightarrow> r"
  where "addpre r npre \<equiv> let (dsn, dsk, flag, hops, nhip, pre) = r in
                          (dsn, dsk, flag, hops, nhip, pre \<union> npre)"

lemma proj2_addpre:
  fixes v pre
  shows "\<pi>\<^sub>2(addpre v pre) = \<pi>\<^sub>2(v)"
  unfolding addpre_def by (cases v) simp

lemma proj3_addpre:
  fixes v pre
  shows "\<pi>\<^sub>3(addpre v pre) = \<pi>\<^sub>3(v)"
  unfolding addpre_def by (cases v) simp

lemma proj4_addpre:
  fixes v pre
  shows "\<pi>\<^sub>4(addpre v pre) = \<pi>\<^sub>4(v)"
  unfolding addpre_def by (cases v) simp

lemma proj5_addpre:
  fixes v pre
  shows "\<pi>\<^sub>5(addpre v pre) = \<pi>\<^sub>5(v)"
  unfolding addpre_def by (cases v) simp

lemma proj6_addpre:
  fixes dsn dsk flag hops nhip pre npre
  shows "\<pi>\<^sub>6(addpre v npre) = \<pi>\<^sub>6(v)"
  unfolding addpre_def by (cases v) simp

lemma proj7_addpre:
  fixes dsn dsk flag hops nhip pre npre
  shows "\<pi>\<^sub>7(addpre v npre) = \<pi>\<^sub>7(v) \<union> npre"
  unfolding addpre_def by (cases v) simp

lemma addpre_empty: "addpre r {} = r"
  unfolding addpre_def by simp

lemma addpre_r:
  "addpre (dsn, dsk, fl, hops, nhip, pre) npre = (dsn, dsk, fl, hops, nhip, pre \<union> npre)"
  unfolding addpre_def by simp

lemmas addpre_simps [simp] = proj2_addpre proj3_addpre proj4_addpre proj5_addpre
                             proj6_addpre proj7_addpre addpre_empty addpre_r

definition addpreRT :: "rt \<Rightarrow> ip \<Rightarrow> ip set \<rightharpoonup> rt"
  where "addpreRT rt dip npre \<equiv>
           map_option (\<lambda>s. rt (dip \<mapsto> addpre s npre)) (\<sigma>\<^bsub>route\<^esub>(rt, dip))"

lemma snd_addpre [simp]:
  "\<And>dsn dsn' v pre. (dsn, snd(addpre (dsn', v) pre)) = addpre (dsn, v) pre"
  unfolding addpre_def by clarsimp

lemma proj2_addpreRT [simp]:
    fixes ip rt ip' npre
  assumes "ip\<in>kD rt"
      and "ip'\<in>kD rt"
    shows "\<pi>\<^sub>2(the (the (addpreRT rt ip' npre) ip)) = \<pi>\<^sub>2(the (rt ip))"
  using assms [THEN kD_Some] unfolding addpreRT_def by clarsimp

lemma proj3_addpreRT [simp]:
    fixes ip rt ip' npre
  assumes "ip\<in>kD rt"
      and "ip'\<in>kD rt"
    shows "\<pi>\<^sub>3(the (the (addpreRT rt ip' npre) ip)) = \<pi>\<^sub>3(the (rt ip))"
  using assms [THEN kD_Some] unfolding addpreRT_def by clarsimp

lemma proj5_addpreRT [simp]:
  "\<And>rt dip ip npre. dip\<in>kD(rt) \<Longrightarrow> \<pi>\<^sub>5(the (the (addpreRT rt dip npre) ip)) = \<pi>\<^sub>5(the (rt ip))"
  unfolding addpreRT_def by auto

lemma flag_addpreRT [simp]:
    fixes rt pre ip dip
  assumes "dip \<in> kD rt"
    shows "flag (the (addpreRT rt dip pre)) ip = flag rt ip"
  unfolding addpreRT_def
  using assms [THEN kD_Some] by (clarsimp)

  lemma kD_addpreRT [simp]:
  fixes rt dip npre
  assumes "dip \<in> kD rt"
  shows "kD (the (addpreRT rt dip npre)) = kD rt"
  unfolding kD_def addpreRT_def
  using assms [THEN kD_Some]
  by clarsimp blast

lemma vD_addpreRT [simp]:
  fixes rt dip npre
  assumes "dip \<in> kD rt"
  shows "vD (the (addpreRT rt dip npre)) = vD rt"
  unfolding vD_def addpreRT_def
  using assms [THEN kD_Some] by clarsimp auto

lemma iD_addpreRT [simp]:
  fixes rt dip npre
  assumes "dip \<in> kD rt"
  shows "iD (the (addpreRT rt dip npre)) = iD rt"
  unfolding iD_def addpreRT_def
  using assms [THEN kD_Some] by clarsimp auto

lemma nhop_addpreRT [simp]:
    fixes rt pre ip dip
  assumes "dip \<in> kD rt"
    shows "nhop (the (addpreRT rt dip pre)) ip = nhop rt ip"
  unfolding sqn_def addpreRT_def
  using assms [THEN kD_Some] by (clarsimp)

lemma sqn_addpreRT [simp]:
    fixes rt pre ip dip
  assumes "dip \<in> kD rt"
    shows "sqn (the (addpreRT rt dip pre)) ip = sqn rt ip"
  unfolding sqn_def addpreRT_def
  using assms [THEN kD_Some] by (clarsimp)

lemma dhops_addpreRT [simp]:
    fixes rt pre ip dip
  assumes "dip \<in> kD rt"
    shows "dhops (the (addpreRT rt dip pre)) ip = dhops rt ip"
  unfolding addpreRT_def
  using assms [THEN kD_Some] by (clarsimp)

lemma sqnf_addpreRT [simp]:
  "\<And>ip dip. ip\<in>kD(rt \<xi>) \<Longrightarrow> sqnf (the (addpreRT (rt \<xi>) ip npre)) dip = sqnf (rt \<xi>) dip"
  unfolding sqnf_def addpreRT_def by auto

subsubsection "Updating route entries"

lemma not_in_kD_case [simp]:
    fixes dip rt
  assumes "dip \<notin> kD(rt)"
    shows "(case rt dip of None \<Rightarrow> en | Some r \<Rightarrow> es r) = en"
  using assms [THEN kD_None] by auto

lemma rt_Some_sqn [dest]:
    fixes rt and ip dsn dsk flag hops nhip pre
  assumes "rt ip = Some (dsn, dsk, flag, hops, nhip, pre)"
    shows "sqn rt ip = dsn"
  unfolding sqn_def using assms by simp

lemma not_kD_sqn [simp]:
    fixes dip rt
  assumes "dip \<notin> kD(rt)"
    shows "sqn rt dip = 0"
  using assms unfolding sqn_def
  by simp

definition update_arg_wf :: "r \<Rightarrow> bool"
where "update_arg_wf r \<equiv> \<pi>\<^sub>4(r) = val \<and>
                         (\<pi>\<^sub>2(r) = 0) = (\<pi>\<^sub>3(r) = unk) \<and>
                         (\<pi>\<^sub>3(r) = unk \<longrightarrow> \<pi>\<^sub>5(r) = 1)"

lemma update_arg_wf_gives_cases:
  "\<And>r. update_arg_wf r \<Longrightarrow> (\<pi>\<^sub>2(r) = 0) = (\<pi>\<^sub>3(r) = unk)"
  unfolding update_arg_wf_def by simp

lemma update_arg_wf_tuples [simp]:
  "\<And>nhip pre. update_arg_wf (0, unk, val, Suc 0, nhip, pre)"
  "\<And>n hops nhip pre. update_arg_wf (Suc n, kno, val, hops,  nhip, pre)"
  unfolding update_arg_wf_def by auto

lemma update_arg_wf_tuples' [elim]:
  "\<And>n hops nhip pre. Suc 0 \<le> n \<Longrightarrow> update_arg_wf (n, kno, val, hops,  nhip, pre)"
  unfolding update_arg_wf_def by auto

lemma wf_r_cases [intro]:
    fixes P r
  assumes "update_arg_wf r"
      and c1: "\<And>nhip pre. P (0, unk, val, Suc 0, nhip, pre)"
      and c2: "\<And>dsn hops nhip pre. dsn > 0 \<Longrightarrow> P (dsn, kno, val, hops, nhip, pre)"
    shows "P r"
  proof -
    obtain dsn dsk flag hops nhip pre
    where *: "r = (dsn, dsk, flag, hops, nhip, pre)" by (cases r)
    with \<open>update_arg_wf r\<close> have wf1: "flag = val"
                            and wf2: "(dsn = 0) = (dsk = unk)"
                            and wf3: "dsk = unk \<longrightarrow> (hops = 1)"
      unfolding update_arg_wf_def by auto
    have "P (dsn, dsk, flag, hops, nhip, pre)"
    proof (cases dsk)
      assume "dsk = unk"
      moreover with wf2 wf3 have "dsn = 0" and "hops = Suc 0" by auto
      ultimately show ?thesis using \<open>flag = val\<close> by simp (rule c1)
    next
      assume "dsk = kno"
      moreover with wf2 have "dsn > 0" by simp
      ultimately show ?thesis using \<open>flag = val\<close> by simp (rule c2)
    qed
    with * show "P r" by simp
  qed

definition update :: "rt \<Rightarrow> ip \<Rightarrow> r \<Rightarrow> rt"
  where
  "update rt ip r \<equiv>
     case \<sigma>\<^bsub>route\<^esub>(rt, ip) of
       None \<Rightarrow> rt (ip \<mapsto> r)
     | Some s \<Rightarrow>
          if \<pi>\<^sub>2(s) < \<pi>\<^sub>2(r) then rt (ip \<mapsto> addpre r (\<pi>\<^sub>7(s)))
          else if \<pi>\<^sub>2(s) = \<pi>\<^sub>2(r) \<and> (\<pi>\<^sub>5(s) > \<pi>\<^sub>5(r) \<or> \<pi>\<^sub>4(s) = inv)
               then rt (ip \<mapsto> addpre r (\<pi>\<^sub>7(s)))
               else if \<pi>\<^sub>3(r) = unk
                    then rt (ip \<mapsto> (\<pi>\<^sub>2(s), snd (addpre r (\<pi>\<^sub>7(s)))))
                    else rt (ip \<mapsto> addpre s (\<pi>\<^sub>7(r)))"

lemma update_simps [simp]:
  fixes r s nrt nr nr' ns rt ip
  defines "s \<equiv> the \<sigma>\<^bsub>route\<^esub>(rt, ip)"
      and "nr \<equiv> addpre r (\<pi>\<^sub>7(s))"
      and "nr' \<equiv> (\<pi>\<^sub>2(s), \<pi>\<^sub>3(nr), \<pi>\<^sub>4(nr), \<pi>\<^sub>5(nr), \<pi>\<^sub>6(nr), \<pi>\<^sub>7(nr))"
      and "ns \<equiv> addpre s (\<pi>\<^sub>7(r))"
  shows
  "\<lbrakk>ip \<notin> kD(rt)\<rbrakk>                            \<Longrightarrow> update rt ip r = rt (ip \<mapsto> r)"
  "\<lbrakk>ip \<in> kD(rt); sqn rt ip < \<pi>\<^sub>2(r)\<rbrakk>         \<Longrightarrow> update rt ip r = rt (ip \<mapsto> nr)"
  "\<lbrakk>ip \<in> kD(rt); sqn rt ip = \<pi>\<^sub>2(r);
                 the (dhops rt ip) > \<pi>\<^sub>5(r)\<rbrakk> \<Longrightarrow> update rt ip r = rt (ip \<mapsto> nr)"
  "\<lbrakk>ip \<in> kD(rt); sqn rt ip = \<pi>\<^sub>2(r);
                 flag rt ip = Some inv\<rbrakk>     \<Longrightarrow> update rt ip r = rt (ip \<mapsto> nr)"
  "\<lbrakk>ip \<in> kD(rt); \<pi>\<^sub>3(r) = unk; (\<pi>\<^sub>2(r) = 0) = (\<pi>\<^sub>3(r) = unk)\<rbrakk>  \<Longrightarrow> update rt ip r = rt (ip \<mapsto> nr')"
  "\<lbrakk>ip \<in> kD(rt); sqn rt ip \<ge> \<pi>\<^sub>2(r); \<pi>\<^sub>3(r) = kno;
    sqn rt ip = \<pi>\<^sub>2(r) \<Longrightarrow> the (dhops rt ip) \<le> \<pi>\<^sub>5(r) \<and> the (flag rt ip) = val \<rbrakk>
                                            \<Longrightarrow> update rt ip r = rt (ip \<mapsto> ns)"
  proof -
    assume "ip\<notin>kD(rt)"
    hence "\<sigma>\<^bsub>route\<^esub>(rt, ip) = None" ..
    thus "update rt ip r = rt (ip \<mapsto> r)"
      unfolding update_def by simp
  next
    assume "ip \<in> kD(rt)"
       and "sqn rt ip < \<pi>\<^sub>2(r)"
    from this(1) obtain dsn dsk fl hops nhip pre
      where "rt ip = Some (dsn, dsk, fl, hops, nhip, pre)"
        by (metis kD_Some)
    with \<open>sqn rt ip < \<pi>\<^sub>2(r)\<close> show "update rt ip r = rt (ip \<mapsto> nr)"
      unfolding update_def nr_def s_def by auto
  next
    assume "ip \<in> kD(rt)"
       and "sqn rt ip = \<pi>\<^sub>2(r)"
       and "the (dhops rt ip) > \<pi>\<^sub>5(r)"
    from this(1) obtain dsn dsk fl hops nhip pre
      where "rt ip = Some (dsn, dsk, fl, hops, nhip, pre)"
        by (metis kD_Some)
    with \<open>sqn rt ip = \<pi>\<^sub>2(r)\<close> and \<open>the (dhops rt ip) > \<pi>\<^sub>5(r)\<close>
      show "update rt ip r = rt (ip \<mapsto> nr)"
        unfolding update_def nr_def s_def by auto
   next
     assume "ip \<in> kD(rt)"
        and "sqn rt ip = \<pi>\<^sub>2(r)"
        and "flag rt ip = Some inv"
    from this(1) obtain dsn dsk fl hops nhip pre
      where "rt ip = Some (dsn, dsk, fl, hops, nhip, pre)"
        by (metis kD_Some)
     with \<open>sqn rt ip = \<pi>\<^sub>2(r)\<close> and \<open>flag rt ip = Some inv\<close>
      show "update rt ip r = rt (ip \<mapsto> nr)"
        unfolding update_def nr_def s_def by auto
   next
    assume "ip \<in> kD(rt)"
       and "\<pi>\<^sub>3(r) = unk"
       and "(\<pi>\<^sub>2(r) = 0) = (\<pi>\<^sub>3(r) = unk)"
    from this(1) obtain dsn dsk fl hops nhip pre
      where "rt ip = Some (dsn, dsk, fl, hops, nhip, pre)"
        by (metis kD_Some)
    with \<open>(\<pi>\<^sub>2(r) = 0) = (\<pi>\<^sub>3(r) = unk)\<close> and \<open>\<pi>\<^sub>3(r) = unk\<close>
      show "update rt ip r = rt (ip \<mapsto> nr')"
        unfolding update_def nr'_def nr_def s_def
      by (cases r) simp
   next
    assume "ip \<in> kD(rt)"
       and otherassms: "sqn rt ip \<ge> \<pi>\<^sub>2(r)"
           "\<pi>\<^sub>3(r) = kno"
           "sqn rt ip = \<pi>\<^sub>2(r) \<Longrightarrow> the (dhops rt ip) \<le> \<pi>\<^sub>5(r) \<and> the (flag rt ip) = val"
    from this(1) obtain dsn dsk fl hops nhip pre
      where "rt ip = Some (dsn, dsk, fl, hops, nhip, pre)"
        by (metis kD_Some)
     with otherassms show "update rt ip r = rt (ip \<mapsto> ns)"
      unfolding update_def ns_def s_def by auto
  qed

lemma update_cases [elim]:
  assumes "(\<pi>\<^sub>2(r) = 0) = (\<pi>\<^sub>3(r) = unk)"
      and c1: "\<lbrakk>ip \<notin> kD(rt)\<rbrakk> \<Longrightarrow> P (rt (ip \<mapsto> r))"

      and c2: "\<lbrakk>ip \<in> kD(rt); sqn rt ip < \<pi>\<^sub>2(r)\<rbrakk>
                \<Longrightarrow> P (rt (ip \<mapsto> addpre r (\<pi>\<^sub>7(the \<sigma>\<^bsub>route\<^esub>(rt, ip)))))"
      and c3: "\<lbrakk>ip \<in> kD(rt); sqn rt ip = \<pi>\<^sub>2(r); the (dhops rt ip) > \<pi>\<^sub>5(r)\<rbrakk>
                \<Longrightarrow> P (rt (ip \<mapsto> addpre r (\<pi>\<^sub>7(the \<sigma>\<^bsub>route\<^esub>(rt, ip)))))"
      and c4: "\<lbrakk>ip \<in> kD(rt); sqn rt ip = \<pi>\<^sub>2(r); the (flag rt ip) = inv\<rbrakk>
                \<Longrightarrow> P (rt (ip \<mapsto> addpre r (\<pi>\<^sub>7(the \<sigma>\<^bsub>route\<^esub>(rt, ip)))))"
      and c5: "\<lbrakk>ip \<in> kD(rt); \<pi>\<^sub>3(r) = unk\<rbrakk>
                \<Longrightarrow> P (rt (ip \<mapsto> (\<pi>\<^sub>2(the \<sigma>\<^bsub>route\<^esub>(rt, ip)), \<pi>\<^sub>3(r),
                                  \<pi>\<^sub>4(r), \<pi>\<^sub>5(r), \<pi>\<^sub>6(r), \<pi>\<^sub>7(addpre r (\<pi>\<^sub>7(the \<sigma>\<^bsub>route\<^esub>(rt, ip)))))))"
      and c6: "\<lbrakk>ip \<in> kD(rt); sqn rt ip \<ge> \<pi>\<^sub>2(r); \<pi>\<^sub>3(r) = kno;
                sqn rt ip = \<pi>\<^sub>2(r) \<Longrightarrow> the (dhops rt ip) \<le> \<pi>\<^sub>5(r) \<and> the (flag rt ip) = val\<rbrakk>
                \<Longrightarrow> P (rt (ip \<mapsto> addpre (the \<sigma>\<^bsub>route\<^esub>(rt, ip)) (\<pi>\<^sub>7(r))))"
  shows "(P (update rt ip r))"
  proof (cases "ip \<in> kD(rt)")
    assume "ip \<notin> kD(rt)"
    with c1 show ?thesis
      by simp
  next
    assume "ip \<in> kD(rt)"
    moreover then obtain dsn dsk fl hops nhip pre
      where rteq: "rt ip = Some (dsn, dsk, fl, hops, nhip, pre)"
        by (metis kD_Some)
    moreover obtain dsn' dsk' fl' hops' nhip' pre'
      where req: "r = (dsn', dsk', fl', hops', nhip', pre')"
        by (cases r) metis
    ultimately show ?thesis
      using \<open>(\<pi>\<^sub>2(r) = 0) = (\<pi>\<^sub>3(r) = unk)\<close>
            c2 [OF \<open>ip\<in>kD(rt)\<close>]
            c3 [OF \<open>ip\<in>kD(rt)\<close>]
            c4 [OF \<open>ip\<in>kD(rt)\<close>]
            c5 [OF \<open>ip\<in>kD(rt)\<close>]
            c6 [OF \<open>ip\<in>kD(rt)\<close>]
    unfolding update_def sqn_def by auto
  qed

lemma update_cases_kD:
  assumes "(\<pi>\<^sub>2(r) = 0) = (\<pi>\<^sub>3(r) = unk)"
      and "ip \<in> kD(rt)"
      and c2: "sqn rt ip < \<pi>\<^sub>2(r) \<Longrightarrow> P (rt (ip \<mapsto> addpre r (\<pi>\<^sub>7(the \<sigma>\<^bsub>route\<^esub>(rt, ip)))))"
      and c3: "\<lbrakk>sqn rt ip = \<pi>\<^sub>2(r); the (dhops rt ip) > \<pi>\<^sub>5(r)\<rbrakk>
                \<Longrightarrow> P (rt (ip \<mapsto> addpre r (\<pi>\<^sub>7(the \<sigma>\<^bsub>route\<^esub>(rt, ip)))))"
      and c4: "\<lbrakk>sqn rt ip = \<pi>\<^sub>2(r); the (flag rt ip) = inv\<rbrakk>
                \<Longrightarrow> P (rt (ip \<mapsto> addpre r (\<pi>\<^sub>7(the \<sigma>\<^bsub>route\<^esub>(rt, ip)))))"
      and c5: "\<pi>\<^sub>3(r) = unk \<Longrightarrow> P (rt (ip \<mapsto> (\<pi>\<^sub>2(the \<sigma>\<^bsub>route\<^esub>(rt, ip)), \<pi>\<^sub>3(r),
                                            \<pi>\<^sub>4(r), \<pi>\<^sub>5(r), \<pi>\<^sub>6(r),
                                            \<pi>\<^sub>7(addpre r (\<pi>\<^sub>7(the \<sigma>\<^bsub>route\<^esub>(rt, ip)))))))"
      and c6: "\<lbrakk>sqn rt ip \<ge> \<pi>\<^sub>2(r); \<pi>\<^sub>3(r) = kno;
                sqn rt ip = \<pi>\<^sub>2(r) \<Longrightarrow> the (dhops rt ip) \<le> \<pi>\<^sub>5(r) \<and> the (flag rt ip) = val\<rbrakk>
                \<Longrightarrow> P (rt (ip \<mapsto> addpre (the \<sigma>\<^bsub>route\<^esub>(rt, ip)) (\<pi>\<^sub>7(r))))"
  shows "(P (update rt ip r))"
  using assms(1) proof (rule update_cases)
    assume "sqn rt ip < \<pi>\<^sub>2(r)"
    thus "P (rt(ip \<mapsto> addpre r (\<pi>\<^sub>7(the (rt ip)))))" by (rule c2)
  next
    assume "sqn rt ip = \<pi>\<^sub>2(r)"
       and "the (dhops rt ip) > \<pi>\<^sub>5(r)"
    thus "P (rt(ip \<mapsto> addpre r (\<pi>\<^sub>7 (the (rt ip)))))"
      by (rule c3)
  next
    assume "sqn rt ip = \<pi>\<^sub>2(r)"
       and "the (flag rt ip) = inv"
    thus "P (rt(ip \<mapsto> addpre r (\<pi>\<^sub>7 (the (rt ip)))))"
      by (rule c4)
  next
    assume "\<pi>\<^sub>3(r) = unk"
    thus "P (rt (ip \<mapsto> (\<pi>\<^sub>2(the \<sigma>\<^bsub>route\<^esub>(rt, ip)), \<pi>\<^sub>3(r), \<pi>\<^sub>4(r), \<pi>\<^sub>5(r), \<pi>\<^sub>6(r),
                        \<pi>\<^sub>7(addpre r (\<pi>\<^sub>7(the (rt ip)))))))"
      by (rule c5)
  next
    assume "sqn rt ip \<ge> \<pi>\<^sub>2(r)"
       and "\<pi>\<^sub>3(r) = kno"
       and "sqn rt ip = \<pi>\<^sub>2(r) \<Longrightarrow> the (dhops rt ip) \<le> \<pi>\<^sub>5(r) \<and> the (flag rt ip) = val"
    thus "P (rt (ip \<mapsto> addpre (the (rt ip)) (\<pi>\<^sub>7(r))))"
      by (rule c6)
  qed (simp add: \<open>ip \<in> kD(rt)\<close>)

lemma in_kD_after_update [simp]:
  fixes rt nip dsn dsk flag hops nhip pre
  shows "kD (update rt nip (dsn, dsk, flag, hops, nhip, pre)) = insert nip (kD rt)"
  unfolding update_def
  by (cases "rt nip") auto

lemma nhop_of_update [simp]:
  fixes rt dip dsn dsk flag hops nhip
  assumes "rt \<noteq> update rt dip (dsn, dsk, flag, hops, nhip, {})"
  shows "the (nhop (update rt dip (dsn, dsk, flag, hops, nhip, {})) dip) = nhip"
  proof -
  from assms
  have update_neq: "\<And>v. rt dip = Some v \<Longrightarrow>
          update rt dip (dsn, dsk, flag, hops, nhip, {})
             \<noteq> rt(dip \<mapsto> addpre (the (rt dip)) (\<pi>\<^sub>7 (dsn, dsk, flag, hops, nhip, {})))"
    by auto
  show ?thesis
    proof (cases "rt dip = None")
      assume "rt dip = None"
      thus "?thesis" unfolding update_def by clarsimp
    next
      assume "rt dip \<noteq> None"
      then obtain v where "rt dip = Some v" by (metis not_None_eq)
      with update_neq [OF this] show ?thesis
        unfolding update_def by auto
    qed
  qed

lemma sqn_if_updated:
  fixes rip v rt ip
  shows "sqn (\<lambda>x. if x = rip then Some v else rt x) ip
         = (if ip = rip then \<pi>\<^sub>2(v) else sqn rt ip)"
  unfolding sqn_def by simp

lemma update_sqn [simp]:
  fixes rt dip rip dsn dsk hops nhip pre
  assumes "(dsn = 0) = (dsk = unk)"
  shows "sqn rt dip \<le> sqn (update rt rip (dsn, dsk, val, hops, nhip, pre)) dip"
  proof (rule update_cases)
    show "(\<pi>\<^sub>2 (dsn, dsk, val, hops, nhip, pre) = 0) = (\<pi>\<^sub>3 (dsn, dsk, val, hops, nhip, pre) = unk)"
      by simp (rule assms)
  qed (clarsimp simp: sqn_if_updated sqn_def)+

lemma sqn_update_bigger [simp]:
    fixes rt ip ip' dsn dsk flag hops nhip pre
  assumes "1 \<le> hops"
    shows "sqn rt ip \<le> sqn (update rt ip' (dsn, dsk, flag, hops, nhip, pre)) ip"
  using assms unfolding update_def sqn_def
  by (clarsimp split: option.split) auto

lemma dhops_update [intro]:
    fixes rt dsn dsk flag hops ip rip nhip pre
  assumes ex: "\<forall>ip\<in>kD rt. the (dhops rt ip) \<ge> 1"
      and ip: "(ip = rip \<and> Suc 0 \<le> hops) \<or> (ip \<noteq> rip \<and> ip\<in>kD rt)"
    shows "Suc 0 \<le> the (dhops (update rt rip (dsn, dsk, flag, hops, nhip, pre)) ip)"
  using ip proof
    assume "ip = rip \<and> Suc 0 \<le> hops" thus ?thesis
      unfolding update_def using ex
      by (cases "rip \<in> kD rt") (drule(1) bspec, auto)
  next
    assume "ip \<noteq> rip \<and> ip\<in>kD rt" thus ?thesis
      using ex unfolding update_def
      by (cases "rip\<in>kD rt") auto
  qed

lemma update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip pre
  assumes "ip \<noteq> dip"
    shows "(update rt dip (dsn, dsk, flag, hops, nhip, pre)) ip = rt ip"
  using assms unfolding update_def
  by (clarsimp split: option.split)

lemma nhop_update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip pre
  assumes "ip \<noteq> dip"
    shows "nhop (update rt dip (dsn, dsk, flag, hops, nhip, pre)) ip = nhop rt ip"
  using assms unfolding update_def
  by (clarsimp split: option.split)

lemma dhops_update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip pre
  assumes "ip \<noteq> dip"
    shows "dhops (update rt dip (dsn, dsk, flag, hops, nhip, pre)) ip = dhops rt ip"
  using assms unfolding update_def
  by (clarsimp split: option.split)

lemma sqn_update_same [simp]:
  "\<And>rt ip dsn dsk flag hops nhip pre. sqn (rt(ip \<mapsto> v)) ip = \<pi>\<^sub>2(v)"
  unfolding sqn_def by simp

lemma dhops_update_changed [simp]:
    fixes rt dip osn hops nhip
  assumes "rt \<noteq> update rt dip (osn, kno, val, hops, nhip, {})"
    shows "the (dhops (update rt dip (osn, kno, val, hops, nhip, {})) dip) = hops"
  using assms unfolding update_def
  by (clarsimp split: option.split_asm option.split if_split_asm) auto

lemma nhop_update_changed [simp]:
    fixes rt dip dsn dsk flg hops sip
  assumes "update rt dip (dsn, dsk, flg, hops, sip, {}) \<noteq> rt"
    shows "the (nhop (update rt dip (dsn, dsk, flg, hops, sip, {})) dip) = sip"
  using assms unfolding update_def
  by (clarsimp split: option.splits if_split_asm) auto

lemma update_rt_split_asm:
  "\<And>rt ip dsn dsk flag hops sip.
   P (update rt ip (dsn, dsk, flag, hops, sip, {}))
   =
   (\<not>(rt = update rt ip (dsn, dsk, flag, hops, sip, {}) \<and> \<not>P rt
      \<or> rt \<noteq> update rt ip (dsn, dsk, flag, hops, sip, {})
         \<and> \<not>P (update rt ip (dsn, dsk, flag, hops, sip, {}))))"
  by auto

lemma sqn_update [simp]: "\<And>rt dip dsn flg hops sip.
  rt \<noteq> update rt dip (dsn, kno, flg, hops, sip, {})
  \<Longrightarrow> sqn (update rt dip (dsn, kno, flg, hops, sip, {})) dip = dsn"
  unfolding update_def by (clarsimp split: option.split if_split_asm) auto

lemma sqnf_update [simp]: "\<And>rt dip dsn dsk flg hops sip.
  rt \<noteq> update rt dip (dsn, dsk, flg, hops, sip, {})
  \<Longrightarrow> sqnf (update rt dip (dsn, dsk, flg, hops, sip, {})) dip = dsk"
  unfolding update_def sqnf_def
  by (clarsimp split: option.splits if_split_asm) auto

lemma update_kno_dsn_greater_zero:
  "\<And>rt dip ip dsn hops npre. 1 \<le> dsn \<Longrightarrow> 1 \<le> (sqn (update rt dip (dsn, kno, val, hops, ip, npre)) dip)"
   unfolding update_def
  by (clarsimp split: option.splits)

lemma proj3_update [simp]: "\<And>rt dip dsn dsk flg hops sip.
  rt \<noteq> update rt dip (dsn, dsk, flg, hops, sip, {})
  \<Longrightarrow> \<pi>\<^sub>3(the (update rt dip (dsn, dsk, flg, hops, sip, {}) dip)) = dsk"
  unfolding update_def sqnf_def
  by (clarsimp split: option.splits if_split_asm) auto

lemma nhop_update_changed_kno_val [simp]: "\<And>rt ip dsn dsk hops nhip.
  rt \<noteq> update rt ip (dsn, kno, val, hops, nhip, {})
   \<Longrightarrow> the (nhop (update rt ip (dsn, kno, val, hops, nhip, {})) ip) = nhip"
  unfolding update_def
  by (clarsimp split: option.split_asm option.split if_split_asm) auto

lemma flag_update [simp]: "\<And>rt dip dsn flg hops sip.
  rt \<noteq> update rt dip (dsn, kno, flg, hops, sip, {})
  \<Longrightarrow> the (flag (update rt dip (dsn, kno, flg, hops, sip, {})) dip) = flg"
  unfolding update_def
  by (clarsimp split: option.split if_split_asm) auto

lemma the_flag_Some [dest!]:
    fixes ip rt
  assumes "the (flag rt ip) = x"
      and "ip \<in> kD rt"
    shows "flag rt ip = Some x"
  using assms by auto

lemma kD_update_unchanged [dest]:
    fixes rt dip dsn dsk flag hops nhip pre
  assumes "rt = update rt dip (dsn, dsk, flag, hops, nhip, pre)"
    shows "dip\<in>kD(rt)"
  proof -
    have "dip\<in>kD(update rt dip (dsn, dsk, flag, hops, nhip, pre))" by simp
    with assms show ?thesis by simp
  qed

lemma nhop_update [simp]: "\<And>rt dip dsn dsk flg hops sip.
  rt \<noteq> update rt dip (dsn, dsk, flg, hops, sip, {})
  \<Longrightarrow> the (nhop (update rt dip (dsn, dsk, flg, hops, sip, {})) dip) = sip"
  unfolding update_def sqnf_def
  by (clarsimp split: option.splits if_split_asm) auto

lemma sqn_update_another [simp]:
    fixes dip ip rt dsn dsk flag hops nhip pre
  assumes "ip \<noteq> dip"
    shows "sqn (update rt dip (dsn, dsk, flag, hops, nhip, pre)) ip = sqn rt ip"
  using assms unfolding update_def sqn_def
  by (clarsimp split: option.splits) auto

lemma vD_update_val [dest]:
  "\<And>dip rt dip' dsn dsk hops nhip pre.
   dip \<in> vD(update rt dip' (dsn, dsk, val, hops, nhip, pre)) \<Longrightarrow> (dip\<in>vD(rt) \<or> dip=dip')"
   unfolding update_def vD_def by (clarsimp split: option.split_asm if_split_asm)

subsubsection "Invalidating route entries"

definition invalidate :: "rt \<Rightarrow> (ip \<rightharpoonup> sqn) \<Rightarrow> rt"
where "invalidate rt dests \<equiv>
  \<lambda>ip. case (rt ip, dests ip) of
    (None, _) \<Rightarrow> None
  | (Some s, None) \<Rightarrow> Some s
  | (Some (_, dsk, _, hops, nhip, pre), Some rsn) \<Rightarrow>
                      Some (rsn, dsk, inv, hops, nhip, pre)"

lemma proj3_invalidate [simp]:
  "\<And>dip. \<pi>\<^sub>3(the ((invalidate rt dests) dip)) = \<pi>\<^sub>3(the (rt dip))"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma proj5_invalidate [simp]:
  "\<And>dip. \<pi>\<^sub>5(the ((invalidate rt dests) dip)) = \<pi>\<^sub>5(the (rt dip))"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma proj6_invalidate [simp]:
  "\<And>dip. \<pi>\<^sub>6(the ((invalidate rt dests) dip)) = \<pi>\<^sub>6(the (rt dip))"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma proj7_invalidate [simp]:
  "\<And>dip. \<pi>\<^sub>7(the ((invalidate rt dests) dip)) = \<pi>\<^sub>7(the (rt dip))"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma invalidate_kD_inv [simp]:
  "\<And>rt dests. kD (invalidate rt dests) = kD rt"
  unfolding invalidate_def kD_def
  by (simp split: option.split)

lemma invalidate_sqn:
  fixes rt dip dests
  assumes "\<forall>rsn. dests dip = Some rsn \<longrightarrow> sqn rt dip \<le> rsn"
  shows "sqn rt dip \<le> sqn (invalidate rt dests) dip"
  proof (cases "dip \<notin> kD(rt)")
    assume "\<not> dip \<notin> kD(rt)"
    hence "dip\<in>kD(rt)" by simp
    then obtain dsn dsk flag hops nhip pre where "rt dip = Some (dsn, dsk, flag, hops, nhip, pre)"
      by (metis kD_Some)
    with assms show "sqn rt dip \<le> sqn (invalidate rt dests) dip"
      by (cases "dests dip") (auto simp add: invalidate_def sqn_def)
  qed simp

lemma sqn_invalidate_in_dests [simp]:
    fixes dests ipa rsn rt
  assumes "dests ipa = Some rsn"
      and "ipa\<in>kD(rt)"
    shows "sqn (invalidate rt dests) ipa = rsn"
  unfolding invalidate_def sqn_def
  using assms(1) assms(2) [THEN kD_Some]
  by clarsimp

lemma dhops_invalidate [simp]:
  "\<And>dip. the (dhops (invalidate rt dests) dip) = the (dhops rt dip)"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma sqnf_invalidate [simp]:
  "\<And>dip. sqnf (invalidate (rt \<xi>) (dests \<xi>)) dip = sqnf (rt \<xi>) dip"
  unfolding sqnf_def invalidate_def by (clarsimp split: option.split)

lemma nhop_invalidate [simp]:
  "\<And>dip. the (nhop (invalidate (rt \<xi>) (dests \<xi>)) dip) = the (nhop (rt \<xi>) dip)"
  unfolding invalidate_def by (clarsimp split: option.split)

lemma invalidate_other [simp]:
    fixes rt dests dip
  assumes "dip\<notin>dom(dests)"
    shows "invalidate rt dests dip = rt dip"
  using assms unfolding invalidate_def
  by (clarsimp split: option.split_asm)

lemma invalidate_none [simp]:
    fixes rt dests dip
  assumes "dip\<notin>kD(rt)"
    shows "invalidate rt dests dip = None"
  using assms unfolding invalidate_def by clarsimp

lemma vD_invalidate_vD_not_dests:
  "\<And>dip rt dests. dip\<in>vD(invalidate rt dests) \<Longrightarrow> dip\<in>vD(rt) \<and> dests dip = None"
  unfolding invalidate_def vD_def
  by (clarsimp split: option.split_asm)

lemma sqn_invalidate_not_in_dests [simp]:
  fixes dests dip rt
  assumes "dip\<notin>dom(dests)"
  shows "sqn (invalidate rt dests) dip = sqn rt dip"
  using assms unfolding sqn_def by simp

lemma invalidate_changes:
    fixes rt dests dip dsn dsk flag hops nhip pre
  assumes "invalidate rt dests dip = Some (dsn, dsk, flag, hops, nhip, pre)"
    shows "  dsn = (case dests dip of None \<Rightarrow> \<pi>\<^sub>2(the (rt dip)) | Some rsn \<Rightarrow> rsn)
           \<and> dsk = \<pi>\<^sub>3(the (rt dip))
           \<and> flag = (if dests dip = None then \<pi>\<^sub>4(the (rt dip)) else inv)
           \<and> hops = \<pi>\<^sub>5(the (rt dip))
           \<and> nhip = \<pi>\<^sub>6(the (rt dip))
           \<and> pre = \<pi>\<^sub>7(the (rt dip))"
  using assms unfolding invalidate_def
  by (cases "rt dip", clarsimp, cases "dests dip") auto

lemma proj3_inv: "\<And>dip rt dests. dip\<in>kD (rt)
                      \<Longrightarrow> \<pi>\<^sub>3(the (invalidate rt dests dip)) = \<pi>\<^sub>3(the (rt dip))"
  by (clarsimp simp: invalidate_def kD_def split: option.split)

lemma dests_iD_invalidate [simp]:
  assumes "dests ip = Some rsn"
      and "ip\<in>kD(rt)"
    shows "ip\<in>iD(invalidate rt dests)"
  using assms(1) assms(2) [THEN kD_Some] unfolding invalidate_def iD_def
  by (clarsimp split: option.split)

subsection "Route Requests"

text \<open>Generate a fresh route request identifier.\<close>

definition nrreqid :: "(ip \<times> rreqid) set \<Rightarrow> ip \<Rightarrow> rreqid"
  where "nrreqid rreqs ip \<equiv> Max ({n. (ip, n) \<in> rreqs} \<union> {0}) + 1"

subsection "Queued Packets"

text \<open>Functions for sending data packets.\<close>

type_synonym store = "ip \<rightharpoonup> (p \<times> data list)"

definition sigma_queue :: "store \<Rightarrow> ip \<Rightarrow> data list"    ("\<sigma>\<^bsub>queue\<^esub>'(_, _')")
  where "\<sigma>\<^bsub>queue\<^esub>(store, dip) \<equiv> case store dip of None \<Rightarrow> [] | Some (p, q) \<Rightarrow> q"

definition qD :: "store \<Rightarrow> ip set"
  where "qD \<equiv> dom"

definition add :: "data \<Rightarrow> ip \<Rightarrow> store \<Rightarrow> store"
  where "add d dip store \<equiv> case store dip of
                              None \<Rightarrow> store (dip \<mapsto> (req, [d]))
                            | Some (p, q) \<Rightarrow> store (dip \<mapsto> (p, q @ [d]))"

lemma qD_add [simp]:
  fixes d dip store
  shows "qD(add d dip store) = insert dip (qD store)"
  unfolding add_def Let_def qD_def
  by (clarsimp split: option.split)

definition drop :: "ip \<Rightarrow> store \<rightharpoonup> store"
  where "drop dip store \<equiv>
    map_option (\<lambda>(p, q). if tl q = [] then store (dip := None)
                                      else store (dip \<mapsto> (p, tl q))) (store dip)"

definition sigma_p_flag :: "store \<Rightarrow> ip \<rightharpoonup> p" ("\<sigma>\<^bsub>p-flag\<^esub>'(_, _')")
  where "\<sigma>\<^bsub>p-flag\<^esub>(store, dip) \<equiv> map_option fst (store dip)"

definition unsetRRF :: "store \<Rightarrow> ip \<Rightarrow> store"
  where "unsetRRF store dip \<equiv> case store dip of
                                None \<Rightarrow> store
                              | Some (p, q) \<Rightarrow> store (dip \<mapsto> (noreq, q))"

definition setRRF :: "store \<Rightarrow> (ip \<rightharpoonup> sqn) \<Rightarrow> store"
  where "setRRF store dests \<equiv> \<lambda>dip. if dests dip = None then store dip
                                    else map_option (\<lambda>(_, q). (req, q)) (store dip)"

subsection "Comparison with the original technical report"

text \<open>
  The major differences with the AODV technical report of Fehnker et al are:
  \begin{enumerate}
  \item @{term nhop} is partial, thus a `@{term the}' is needed, similarly for @{term dhops}
        and @{term addpreRT}.
  \item @{term precs} is partial.
  \item @{term "\<sigma>\<^bsub>p-flag\<^esub>(store, dip)"} is partial.
  \item The routing table (@{typ rt}) is modelled as a map (@{typ "ip \<Rightarrow> r option"})
        rather than a set of 7-tuples, likewise, the @{typ r} is a 6-tuple rather than
        a 7-tuple, i.e., the destination ip-address (@{term "dip"}) is taken from the
        argument to the function, rather than a part of the result. Well-definedness then
        follows from the structure of the type and more related facts are available
        automatically, rather than having to be acquired through tedious proofs.
  \item Similar remarks hold for the dests mapping passed to @{term "invalidate"},
        and @{term "store"}.
  \end{enumerate}
\<close>

end


theory Higher_Proj_Space_Rank_Axioms_To_Higher_Proj_Space_Axioms
  imports Main Higher_Projective_Space_Rank_Axioms Matroid_Rank_Properties
begin

(*
Contents:
- One proves that if the rank-based axioms are satisfied then the higher projective space axioms
are satisfied
*)

(* Assume that we have a model of our rank-based axioms and prove that it is also a model of
our higher projective space axioms *)

(* First, one has a type of points *)

type_synonym points = "Points"

(* Second, one has a type of lines *)

datatype Lines = line "Points" "Points"

fun fst_pt :: "Lines \<Rightarrow> points" where
"fst_pt (line A B) = A"

fun snd_pt :: "Lines \<Rightarrow> points" where
"snd_pt (line A B) = B"

(* possible alternative typedef lines = "{(a::Points,b::Points). a \<noteq> b}" then use a quotient *)

typedef lines = "{l:: Lines. fst_pt l \<noteq> snd_pt l}"
proof-
  obtain A B where "rk {A,B} = 2"
    using rk_ax_3_pts by blast
  then have "A \<noteq> B"
    by (metis One_nat_def card.empty card_Suc_eq insert_absorb insert_absorb2 insert_not_empty matroid_ax_1b numeral_le_one_iff semiring_norm(69))
  thus "?thesis"
    by (metis (mono_tags) fst_pt.simps mem_Collect_eq snd_pt.simps)
qed

(* print_theorems

find_theorems "_::Lines" name:induct
find_theorems "_::lines"

lemma "P (x::lines)"
proof (induction x)
  case (Abs_lines y)
  then show ?case apply (induction y rule:Lines.induct)
qed
*)

definition fst :: "lines \<Rightarrow> points" where
"fst l \<equiv> fst_pt (Rep_lines l)"

definition snd :: "lines \<Rightarrow> points" where
"snd l \<equiv> snd_pt (Rep_lines l)"

(* Next, we define an incidence relation between points and lines *)

definition incid :: "points \<Rightarrow> lines \<Rightarrow> bool" where
"incid P l \<equiv> rk {fst l, snd l, P} \<le> 2"

lemma incid_rk :
  assumes "incid P l"
  shows "rk {fst l, snd l, P} = 2"
proof-
  have "rk {fst l, snd l, P} \<ge> 2"
    by (metis (mono_tags, lifting) Higher_Proj_Space_Rank_Axioms_To_Higher_Proj_Space_Axioms.fst_def Higher_Proj_Space_Rank_Axioms_To_Higher_Proj_Space_Axioms.snd_def Rep_lines Un_insert_left Un_upper1 insert_is_Un matroid_ax_2 mem_Collect_eq rk_couple)
  thus "rk {fst l, snd l, P} = 2"
    using assms incid_def by auto
qed

(* Then we prove that the higher projective space axioms are satisfied *)

lemma rk_triple_rep :
  assumes "P \<noteq> Q"
  shows "rk {P, P, Q} = 2"
proof-
  have f1:"rk {P, P, Q} \<ge> 2"
    by (simp add: assms rk_ax_couple)
  have f2:"rk {P, P, Q} \<le> 2"
    by (metis One_nat_def add.right_neutral add_Suc_right assms card.empty card_Suc_eq empty_iff insert_absorb2 insert_iff matroid_ax_1b one_add_one)
  from f1 and f2 show "rk {P, P, Q} = 2"
    using le_antisym by blast
qed

lemma ax1_existence : "\<forall>P Q.\<exists>l. (incid P l) \<and> (incid Q l)"
proof (rule allI)+
  fix P Q
  have f1:"incid P (Abs_lines (line P Q)) \<and> incid Q (Abs_lines (line P Q))" if "P \<noteq> Q"
    by (smt Abs_lines_inverse Higher_Proj_Space_Rank_Axioms_To_Higher_Proj_Space_Axioms.fst_def Higher_Proj_Space_Rank_Axioms_To_Higher_Proj_Space_Axioms.snd_def fst_pt.simps incid_def insert_commute mem_Collect_eq order_refl rk_triple_rep snd_pt.simps that)
  define l where "l = Abs_lines (line P (@ R. R \<noteq> P))"
  have f2:"incid P l \<and> incid Q l" if "P = Q"
    by (smt Abs_lines_induct Abs_lines_inverse Higher_Proj_Space_Rank_Axioms_To_Higher_Proj_Space_Axioms.fst_def fst_pt.simps incid_def insert_absorb2 insert_commute l_def matroid_ax_2 mem_Collect_eq rk_triple_rep snd_pt.simps some_eq_ex subset_insertI that)
  from f1 and f2 show "\<exists>l. incid P l \<and> incid Q l" by blast
qed

definition line_eq :: "lines \<Rightarrow> lines \<Rightarrow> bool" where
"line_eq k l \<equiv> rk {fst k, snd k, fst l, snd l} \<le> 2"

lemma line_eq_rk :
  assumes "line_eq k l"
  shows "rk {fst k, snd k, fst l, snd l} = 2"
proof-
  have f1:"rk {fst k, snd k, fst l, snd l} \<le> 2"
    using assms line_eq_def by auto
  have "fst k \<noteq> snd k \<and> fst l \<noteq> snd l"
    using Higher_Proj_Space_Rank_Axioms_To_Higher_Proj_Space_Axioms.fst_def Higher_Proj_Space_Rank_Axioms_To_Higher_Proj_Space_Axioms.snd_def Rep_lines by auto
  then have f2:"rk {fst k, snd k, fst l, snd l} \<ge> 2"
    by (meson matroid_ax_2 order.trans rk_ax_couple subset_insertI)
  from f1 and f2 show "rk {fst k, snd k, fst l, snd l} = 2"
    using antisym_conv by auto
qed

lemma line_eq_refl : "line_eq l l"
  by (smt Higher_Proj_Space_Rank_Axioms_To_Higher_Proj_Space_Axioms.fst_def Higher_Proj_Space_Rank_Axioms_To_Higher_Proj_Space_Axioms.snd_def Rep_lines eq_iff insert_absorb2 insert_commute line_eq_def mem_Collect_eq rk_triple_rep)

lemma line_eq_sym : "line_eq k l = line_eq l k"
  by (simp add: insert_commute line_eq_def)

lemma line_eq_trans : "line_eq k l \<longrightarrow> line_eq l m \<longrightarrow> line_eq k m"
proof(rule impI)+
  assume "line_eq k l" and "line_eq l m"
  have "{fst l, snd l} \<subseteq> {fst k, snd k, fst l, snd l} \<inter> {fst l, snd l, fst m, snd m}" by auto
  then have "rk {fst k, snd k, fst l, snd l, fst m, snd m} + rk {fst l, snd l} \<le>
    rk {fst k, snd k, fst l, snd l} + rk {fst l, snd l, fst m, snd m}" using matroid_ax_3_alt
    by (smt Un_insert_left le_infE sup.absorb_iff2)
  then have "rk {fst k, snd k, fst l, snd l, fst m, snd m} \<le> 2"
    by (metis Nat.le_diff_conv2 \<open>line_eq k l\<close> \<open>line_eq l m\<close> add_diff_cancel_right' add_leD2 insert_absorb2 line_eq_refl line_eq_rk rk_couple)
  then have "rk {fst k, snd k, fst m, snd m} \<le> 2" using matroid_ax_2 by (smt insert_commute order_trans subset_insertI)
  thus "line_eq k m"
    using line_eq_def by auto
qed

lemma ax1_uniqueness : "\<forall>P Q k l.
(incid P k) \<longrightarrow> (incid Q k) \<longrightarrow> (incid P l) \<longrightarrow> (incid Q l) \<longrightarrow> (P = Q) \<or> (line_eq k l)"
proof((rule allI)+, (rule impI)+)
  fix P Q k l
  assume "incid P k" and "incid Q k" and "incid P l" and "incid Q l"
  have f1:"line_eq k l" if "P \<noteq> Q"
  proof-
    have f1:"rk {P, Q} = 2"
      by (simp add: rk_couple that)
    have f2:"rk {fst k, snd k, P, Q} = 2" using matroid_ax_3_alt'
      by (smt Higher_Proj_Space_Rank_Axioms_To_Higher_Proj_Space_Axioms.fst_def Higher_Proj_Space_Rank_Axioms_To_Higher_Proj_Space_Axioms.snd_def Rep_lines Un_insert_left \<open>incid P k\<close> \<open>incid Q k\<close> incid_rk insert_absorb2 insert_is_Un matroid_ax_2 mem_Collect_eq rk_triple_rep subset_insertI)
    have f3:"rk {fst l, snd l, P, Q} = 2" using matroid_ax_3_alt'
      by (smt Un_insert_right \<open>incid P l\<close> \<open>incid Q l\<close> incid_rk insert_absorb2 insert_commute line_eq_refl line_eq_rk sup_bot.right_neutral)
    have f4:"rk {fst k, snd k, fst l, snd l, P, Q} + rk {P, Q} \<le> rk {fst k, snd k, P, Q} + rk {fst l, snd l, P, Q}"
      using matroid_ax_3_alt[of "{P, Q}" "{fst k, snd k, P, Q}" "{fst l, snd l, P, Q}"]
      by (simp add: insert_commute)
    from f1 and f2 and f3 and f4 have "rk {fst k, snd k, fst l, snd l, P, Q} \<le> 2" by auto
    thus "line_eq k l" using matroid_ax_2 by (smt eq_iff f3 insert_mono insert_subset line_eq_def)
  qed
  from f1 show "P = Q \<or> line_eq k l" by auto
qed

definition distinct3 :: "points => points => points => bool" where
"distinct3 A B C \<equiv> (A \<noteq> B) \<and> (A \<noteq> C) \<and> (B \<noteq> C)"

definition distinct4 :: "points \<Rightarrow> points \<Rightarrow> points \<Rightarrow> points \<Rightarrow> bool" where
"distinct4 A B C D \<equiv> distinct3 A B C \<and> (A \<noteq> D) \<and> (B \<noteq> D) \<and> (C \<noteq> D)"

lemma rk_lines_inter :
  assumes "incid P k" and "incid P l"
  shows "rk {fst k, snd k, fst l, snd l} \<le> 3"
proof-
  have f1:"rk {fst k, snd k, P} \<le> 2"
    using assms(1) incid_def by auto
  have f2:"rk {fst l, snd l, P} \<le> 2"
    using assms(2) incid_def by auto
  have f3:"rk {fst k, snd k, fst l, snd l, P} + rk {P} \<le> rk {fst k, snd k, P} + rk {fst l, snd l, P}"
    using matroid_ax_3_alt
    by (smt Un_empty Un_insert_left Un_insert_right all_not_in_conv insert_absorb2 insert_iff insert_inter_insert subsetI)
  then have "rk {fst k, snd k, fst l, snd l, P} \<le> 3"
    using f1 f2 by (simp add: rk_singleton)
  thus "rk {fst k, snd k, fst l, snd l} \<le> 3" using matroid_ax_2
    by (metis insert_commute order_trans subset_insertI)
qed

lemma ax_2 : "\<forall>A B C D lAB lCD lAC lBD. distinct4 A B C D \<longrightarrow> (incid A lAB \<and> incid B lAB)
\<longrightarrow> (incid C lCD \<and> incid D lCD) \<longrightarrow> (incid A lAC \<and> incid C lAC) \<longrightarrow>
(incid B lBD \<and> incid D lBD) \<longrightarrow> (\<exists>I.(incid I lAB \<and> incid I lCD)) \<longrightarrow>
(\<exists>J.(incid J lAC \<and> incid J lBD))" sorry
(* proof((rule allI)+, (rule impI)+)
  fix A B C D lAB lCD lAC lBD
  assume "distinct4 A B C D" and "incid A lAB \<and> incid B lAB" and "incid C lCD \<and> incid D lCD" and
"incid A lAC \<and> incid C lAC" and "incid B lBD \<and> incid D lBD" and "\<exists>I. incid I lAB \<and> incid I lCD"
  show "\<exists>J. incid J lAC \<and> incid J lBD"
  proof
    obtain I where "incid I lAB \<and> incid I lCD"
      using \<open>\<exists>I. incid I lAB \<and> incid I lCD\<close> by auto
    have f1:"rk {fst lAB, snd lAB, A} = 2"
      by (simp add: \<open>incid A lAB \<and> incid B lAB\<close> incid_rk)
    have f2:"rk {fst lAB, snd lAB, B} = 2"
      by (simp add: \<open>incid A lAB \<and> incid B lAB\<close> incid_rk)
    from f1 and f2 have c1:"rk {fst lAB, snd lAB, A, B} = 2" using matroid_ax_3_alt'
      by (metis Un_insert_right insert_absorb2 insert_commute line_eq_refl line_eq_rk sup_bot.right_neutral)
    have f3:"rk {fst lCD, snd lCD, C} = 2"
      by (simp add: \<open>incid C lCD \<and> incid D lCD\<close> incid_rk)
    have f4:"rk {fst lCD, snd lCD, D} = 2"
      by (simp add: \<open>incid C lCD \<and> incid D lCD\<close> incid_rk)
    from f3 and f4 have c2:"rk {fst lCD, snd lCD, C, D} = 2" using matroid_ax_3_alt'
      by (metis (no_types, hide_lams) Un_insert_right insert_absorb2 insert_commute line_eq_refl line_eq_rk sup_bot.right_neutral)
    have f5:"rk {fst lAC, snd lAC, A} = 2"
      by (simp add: \<open>incid A lAC \<and> incid C lAC\<close> incid_rk)
    have f6:"rk {fst lAC, snd lAC, C} = 2"
      by (simp add: \<open>incid A lAC \<and> incid C lAC\<close> incid_rk)
    from f5 and f6 have c3:"rk {fst lAC, snd lAC, A, C} = 2" using matroid_ax_3_alt'
      by (metis Un_insert_right insert_absorb2 insert_commute line_eq_refl line_eq_rk sup_bot.right_neutral)
    have f7:"rk {fst lBD, snd lBD, B} = 2"
      by (simp add: \<open>incid B lBD \<and> incid D lBD\<close> incid_rk)
    have f8:"rk {fst lBD, snd lBD, D} = 2"
      by (simp add: \<open>incid B lBD \<and> incid D lBD\<close> incid_rk)
    from f7 and f8 have c4:"rk {fst lBD, snd lBD, B, D} = 2" using matroid_ax_3_alt'
      by (metis Un_insert_right insert_absorb2 insert_commute line_eq_refl line_eq_rk sup_bot.right_neutral)
    have "rk {fst lAB, snd lAB, fst lAC, snd lAC} \<le> 3"
      using \<open>incid A lAB \<and> incid B lAB\<close> \<open>incid A lAC \<and> incid C lAC\<close> rk_lines_inter by blast
    then have "rk {fst lAB, snd lAB, fst lAC, snd lAC, A} \<le> 3"
*)

lemma ax3 : "\<forall>l.\<exists>A B C. distinct3 A B C \<and> incid A l \<and> incid B l \<and> incid C l"
proof
  fix l
  obtain P where a1:"rk {fst l, snd l, P} = 2" and a2:"rk {snd l, P} = 2" and a3:"rk {fst l, P} = 2"
    using rk_ax_3_pts by auto
  have f1:"distinct3 (fst l) (snd l) P"
    by (metis a2 a3 distinct3_def insert_absorb2 line_eq_refl line_eq_rk numeral_eq_iff numerals(1) rk_singleton_bis semiring_norm(85))
  have f2:"incid (fst l) l"
    by (metis distinct3_def eq_iff f1 incid_def insert_commute rk_triple_rep)
  have f3:"incid (snd l) l"
    using distinct3_def f1 incid_def rk_triple_rep by auto
  have f4:"incid P l"
    by (simp add: a1 incid_def)
  show "\<exists>A B C. distinct3 A B C \<and> incid A l \<and> incid B l \<and> incid C l"
    using f1 f2 f3 f4 by blast
qed

lemma ax4 : "\<exists>l m.\<forall>P. \<not>(incid P l \<and> incid P m)"
proof-
  obtain A B C D where "rk {A, B, C, D} \<ge> 4"
    using rk_ax_dim by auto
  define l m where "l = Abs_lines (line A B)" and "m = Abs_lines (line C D)"
  fix P
  have f1:"rk {A, B, P} \<le> 2" and f2:"rk {C, D, P} \<le> 2" if "incid P l" and "incid P m"
    apply(smt Abs_lines_inverse Higher_Proj_Space_Rank_Axioms_To_Higher_Proj_Space_Axioms.fst_def Higher_Proj_Space_Rank_Axioms_To_Higher_Proj_Space_Axioms.snd_def fst_pt.simps incid_rk insert_absorb2 l_def linear mem_Collect_eq numeral_le_one_iff rk_couple rk_singleton_bis semiring_norm(69) snd_pt.simps that(1))
    by (smt Abs_lines_inverse Higher_Proj_Space_Rank_Axioms_To_Higher_Proj_Space_Axioms.fst_def Higher_Proj_Space_Rank_Axioms_To_Higher_Proj_Space_Axioms.snd_def fst_pt.simps incid_rk insert_absorb2 linear m_def mem_Collect_eq numeral_le_one_iff rk_singleton_bis rk_triple_rep semiring_norm(69) snd_pt.simps that(2))
  have f3:"rk {A, B, C, D, P} + rk {P} \<le> rk {A, B, P} + rk {C, D, P}"
    using matroid_ax_3_alt[of "{P}" "{A, B, P}" "{C, D, P}"]
    by (simp add: insert_commute)
  from f1 and f2 and f3 have "rk {A, B, C, D, P} \<le> 3" if "incid P l" and "incid P m"
    by (simp add: rk_singleton that(1) that(2))
  then have "rk {A, B, C, D} \<le> 3" if "incid P l" and "incid P m"
    using matroid_ax_2
    by (smt Abs_lines_inverse Higher_Proj_Space_Rank_Axioms_To_Higher_Proj_Space_Axioms.fst_def Higher_Proj_Space_Rank_Axioms_To_Higher_Proj_Space_Axioms.snd_def One_nat_def add_Suc_right add_leD1 fst_pt.simps insert_absorb2 insert_is_Un l_def m_def matroid_ax_3 mem_Collect_eq numeral_2_eq_2 numeral_3_eq_3 one_add_one rk_lines_inter rk_singleton_bis rk_triple_rep snd_pt.simps that(1) that(2))
  then have "\<forall>P. \<not>(incid P l \<and> incid P m)"
    using \<open>4 \<le> rk {A, B, C, D}\<close> l_def m_def
    by (smt Abs_lines_inverse Higher_Proj_Space_Rank_Axioms_To_Higher_Proj_Space_Axioms.fst_def Higher_Proj_Space_Rank_Axioms_To_Higher_Proj_Space_Axioms.snd_def One_nat_def Suc_le_eq Suc_numeral add_Suc_right add_leD1 fst_pt.simps insert_absorb2 insert_is_Un matroid_ax_3 mem_Collect_eq not_le numeral_2_eq_2 numeral_3_eq_3 one_add_one rk_lines_inter rk_singleton rk_triple_rep semiring_norm(2) semiring_norm(8) snd_pt.simps)
  thus "\<exists>l m.\<forall>P. \<not>(incid P l \<and> incid P m)" by auto
qed

end


theory ComputeNumeral
imports ComputeHOL ComputeFloat
begin

(* equality for bit strings *)
lemmas biteq = eq_num_simps

(* x < y for bit strings *)
lemmas bitless = less_num_simps

(* x \<le> y for bit strings *)
lemmas bitle = le_num_simps

(* addition for bit strings *)
lemmas bitadd = add_num_simps

(* multiplication for bit strings *)
lemmas bitmul = mult_num_simps

lemmas bitarith = arith_simps

(* Normalization of nat literals *)
lemmas natnorm = one_eq_Numeral1_nat

fun natfac :: "nat \<Rightarrow> nat"
  where "natfac n = (if n = 0 then 1 else n * (natfac (n - 1)))"

lemmas compute_natarith =
  arith_simps rel_simps
  diff_nat_numeral nat_numeral nat_0 nat_neg_numeral
  numeral_One [symmetric]
  numeral_1_eq_Suc_0 [symmetric]
  Suc_numeral natfac.simps

lemmas number_norm = numeral_One[symmetric]

lemmas compute_numberarith =
  arith_simps rel_simps number_norm

lemmas compute_num_conversions =
  of_nat_numeral of_nat_0
  nat_numeral nat_0 nat_neg_numeral
  of_int_numeral of_int_neg_numeral of_int_0

lemmas zpowerarith = power_numeral_even power_numeral_odd zpower_Pls int_pow_1

(* div, mod *)

lemmas compute_div_mod = div_0 mod_0 div_by_0 mod_by_0 div_by_1 mod_by_1
  one_div_numeral one_mod_numeral minus_one_div_numeral minus_one_mod_numeral
  one_div_minus_numeral one_mod_minus_numeral
  numeral_div_numeral numeral_mod_numeral minus_numeral_div_numeral minus_numeral_mod_numeral
  numeral_div_minus_numeral numeral_mod_minus_numeral
  div_minus_minus mod_minus_minus Parity.adjust_div_eq of_bool_eq one_neq_zero
  numeral_neq_zero neg_equal_0_iff_equal arith_simps arith_special divmod_trivial
  divmod_steps divmod_cancel divmod_step_def fst_conv snd_conv numeral_One
  case_prod_beta rel_simps Parity.adjust_mod_def div_minus1_right mod_minus1_right
  minus_minus numeral_times_numeral mult_zero_right mult_1_right

(* collecting all the theorems *)

lemma even_0_int: "even (0::int) = True"
  by simp

lemma even_One_int: "even (numeral Num.One :: int) = False"
  by simp

lemma even_Bit0_int: "even (numeral (Num.Bit0 x) :: int) = True"
  by (simp only: even_numeral)

lemma even_Bit1_int: "even (numeral (Num.Bit1 x) :: int) = False"
  by (simp only: odd_numeral)

lemmas compute_even = even_0_int even_One_int even_Bit0_int even_Bit1_int

lemmas compute_numeral = compute_if compute_let compute_pair compute_bool
                         compute_natarith compute_numberarith max_def min_def compute_num_conversions zpowerarith compute_div_mod compute_even

end


(*  Title:      HOL/Imperative_HOL/ex/Imperative_Reverse.thy
    Author:     Lukas Bulwahn, TU Muenchen
*)

section {* An imperative in-place reversal on arrays *}

theory Imperative_Reverse
imports Subarray "~~/src/HOL/Imperative_HOL/Imperative_HOL"
begin

fun swap :: "'a\<Colon>heap array \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> unit Heap" where
  "swap a i j = do {
     x \<leftarrow> Array.nth a i;
     y \<leftarrow> Array.nth a j;
     Array.upd i y a;
     Array.upd j x a;
     return ()
   }"

fun rev :: "'a\<Colon>heap array \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> unit Heap" where
  "rev a i j = (if (i < j) then do {
     swap a i j;
     rev a (i + 1) (j - 1)
   }
   else return ())"

declare swap.simps [simp del] rev.simps [simp del]

lemma swap_pointwise: assumes "effect (swap a i j) h h' r"
  shows "Array.get h' a ! k = (if k = i then Array.get h a ! j
      else if k = j then Array.get h a ! i
      else Array.get h a ! k)"
using assms unfolding swap.simps
by (elim effect_elims)
 (auto simp: length_def)

lemma rev_pointwise: assumes "effect (rev a i j) h h' r"
  shows "Array.get h' a ! k = (if k < i then Array.get h a ! k
      else if j < k then Array.get h a ! k
      else Array.get h a ! (j - (k - i)))" (is "?P a i j h h'")
using assms proof (induct a i j arbitrary: h h' rule: rev.induct)
  case (1 a i j h h'')
  thus ?case
  proof (cases "i < j")
    case True
    with 1[unfolded rev.simps[of a i j]]
    obtain h' where
      swp: "effect (swap a i j) h h' ()"
      and rev: "effect (rev a (i + 1) (j - 1)) h' h'' ()"
      by (auto elim: effect_elims)
    from rev 1 True
    have eq: "?P a (i + 1) (j - 1) h' h''" by auto

    have "k < i \<or> i = k \<or> (i < k \<and> k < j) \<or> j = k \<or> j < k" by arith
    with True show ?thesis
      by (elim disjE) (auto simp: eq swap_pointwise[OF swp])
  next
    case False
    with 1[unfolded rev.simps[of a i j]]
    show ?thesis
      by (cases "k = j") (auto elim: effect_elims)
  qed
qed

lemma rev_length:
  assumes "effect (rev a i j) h h' r"
  shows "Array.length h a = Array.length h' a"
using assms
proof (induct a i j arbitrary: h h' rule: rev.induct)
  case (1 a i j h h'')
  thus ?case
  proof (cases "i < j")
    case True
    with 1[unfolded rev.simps[of a i j]]
    obtain h' where
      swp: "effect (swap a i j) h h' ()"
      and rev: "effect (rev a (i + 1) (j - 1)) h' h'' ()"
      by (auto elim: effect_elims)
    from swp rev 1 True show ?thesis
      unfolding swap.simps
      by (elim effect_elims) fastforce
  next
    case False
    with 1[unfolded rev.simps[of a i j]]
    show ?thesis
      by (auto elim: effect_elims)
  qed
qed

lemma rev2_rev': assumes "effect (rev a i j) h h' u"
  assumes "j < Array.length h a"
  shows "subarray i (j + 1) a h' = List.rev (subarray i (j + 1) a h)"
proof -
  {
    fix k
    assume "k < Suc j - i"
    with rev_pointwise[OF assms(1)] have "Array.get h' a ! (i + k) = Array.get h a ! (j - k)"
      by auto
  }
  with assms(2) rev_length[OF assms(1)] show ?thesis
  unfolding subarray_def Array.length_def
  by (auto simp add: length_sublist' rev_nth min_def nth_sublist' intro!: nth_equalityI)
qed

lemma rev2_rev:
  assumes "effect (rev a 0 (Array.length h a - 1)) h h' u"
  shows "Array.get h' a = List.rev (Array.get h a)"
  using rev2_rev'[OF assms] rev_length[OF assms] assms
    by (cases "Array.length h a = 0", auto simp add: Array.length_def
      subarray_def rev.simps[where j=0] elim!: effect_elims)
  (drule sym[of "List.length (Array.get h a)"], simp)

definition "example = (Array.make 10 id \<guillemotright>= (\<lambda>a. rev a 0 9))"

export_code example checking SML SML_imp OCaml? OCaml_imp? Haskell? Scala Scala_imp

end


theory Chapter12_4
imports "HOL-IMP.VCG" "HOL-IMP.Hoare_Examples" "Short_Theory"
begin

text\<open>
\exercise
Let @{term "asum i"} be the annotated command \texttt{y := 0; W}
where \texttt{W} is defined in Example~12.7. Prove
\<close>
(* your definition of asum here *)

lemma "\<turnstile> {\<lambda>s. s ''x'' = i} strip(asum i) {\<lambda>s. s ''y'' = sum i}"
(* your definition/proof here *)

text\<open>
with the help of corollary @{thm[source] vc_sound'}.
\endexercise

\exercise
Solve exercises \ref{exe:Hoare:sumeq} to \ref{exe:Hoare:sqrt} using the VCG:
for every Hoare triple @{prop"\<turnstile> {P} c {Q}"} from one of those exercises
define an annotated version @{text C} of @{text c} and prove
@{prop"\<turnstile> {P} strip C {Q}"} with the help of %Corollary~\ref{cor:vc_sound}
corollary @{thm[source] vc_sound'}.
\<close>

text\<open>
\endexercise

\exercise
Having two separate functions @{const pre} and @{const vc} is inefficient.
When computing @{const vc} one often needs to compute @{const pre} too,
leading to multiple traversals of many subcommands. Define an optimised function
\<close>
fun prevc :: "acom \<Rightarrow> assn \<Rightarrow> assn \<times> bool" where
(* your definition/proof here *)

text\<open> that traverses the command only once. Prove \<close>

lemma "prevc C Q = (pre C Q, vc C Q)"
(* your definition/proof here *)

text\<open>
\endexercise

\exercise
Design a VCG that computes post rather than preconditions.
Start by solving Exercise~\ref{exe:fwdassign}. Now modify theory
@{short_theory "VCG"} as follows. Instead of @{const pre} define a function
\<close>

fun post :: "acom \<Rightarrow> assn \<Rightarrow> assn" where
(* your definition/proof here *)

text\<open>
such that (with the execption of loops) @{term "post C P"} is the strongest
postcondition of @{text C} w.r.t.\ the precondition @{text P} (see also
Exercise~\ref{exe:sp}). Now modify @{const vc} such that is uses
@{const post} instead of @{const pre} and prove its soundness
and completeness.
\<close>

fun vc :: "acom \<Rightarrow> assn \<Rightarrow> bool" where
(* your definition/proof here *)

lemma vc_sound: "vc C P \<Longrightarrow> \<turnstile> {P} strip C {post C P}"
(* your definition/proof here *)

lemma vc_complete: "\<turnstile> {P} c {Q}
  \<Longrightarrow> \<exists>C. strip C = c \<and> vc C P \<and> (\<forall>s. post C P s \<longrightarrow> Q s)"
(* your definition/proof here *)

text \<open>
\endexercise
\<close>

end