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

section "Predicates and functions used in the AODV model"

theory B_Aodv_Data
imports B_Fwdrreps
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 newparaGsteSimp imports Main
begin

section{*Variables and values*}

text{*
According to the aforementioned discussion in section ?, firstly we define the variables used in the protocols.
There are two kinds of variables, global and parameterized (local)
variables. In hardware implemetations of the protocols,
the variables are implenteed as registers in global or local modules. *}

datatype scalrValueType= index nat   | topVal | bottomVal

section{*Expressions and Formulas*}

datatype arrVarType=arrDef string nat "nat list" |
            update arrVarType "expType list" expType
(*arr "a" 2 [4,4] means an array with two dimensions*)

and  designator=arr arrVarType "expType list"
(*varType=Ident  string | Para varType  expType |
  Field  varType   string | Update varType expType expType*)

(*and arrVar=update varType expType *)
and

 expType= IVar designator |
         Const scalrValueType |
         iteForm formula  expType  expType |
         uif string "expType list" |
         top |unKnown

and
 formula = eqn expType expType|
           uip string "expType list" |
           andForm  formula formula |
           neg formula|
           orForm formula formula |
           implyForm formula formula |
           chaos

datatype scavarType=scaArr arrVarType "nat list"

primrec down ::"nat \<Rightarrow>nat list" where
down0:"down 0=[0]" |
downSuc:"down (Suc n)=Suc n #(down n)"

text{*Similarly, a parameterized formula is a function from a parameter to a formula. We also define
 the $\mathsf{forall}$ and $mathsf{exists}$ formulas$.*}
type_synonym paraFormula="nat \<Rightarrow> formula"

fun forallForm::"nat list \<Rightarrow>paraFormula \<Rightarrow> formula" where
oneAllForm: "forallForm [i] forms = forms i"|
moreAllForm: "forallForm (i#j#xs)  forms = andForm (forms i) (forallForm (j#xs)  forms)"

fun existsForm::"nat list \<Rightarrow>paraFormula \<Rightarrow> formula" where
oneExForm: " existsForm [i] forms = forms i"|
moreExForm: " existsForm (i#j#xs)  forms = orForm (forms i) (forallForm (j#xs)  forms)"

type_synonym formulaExpPair="formula \<times>  expType"

section{*assignment, statement, general statement*}

type_synonym assignType=   "designator \<times>  expType"
(*don't use a\<times>bound \<times>index \<times>content a[ie] = c where ie \<le> bound
only use a \<times>index \<times>content a[ie] := c *)

(*primrec paraNameOfAssign:: "assignType \<Rightarrow> varType" where
"paraNameOfAssign (simpAssign des) = fst des"|
"paraNameOfAssign (compAssign des) = fst des"

primrec leftIndexOfAssign:: "assignType \<Rightarrow> expType" where
"leftIndexOfAssign (compAssign des) = fst (snd des)" |
"leftIndexOfAssign (simpAssign des) = Const (index 0)"

(*definition leftIndexOfAssign:: "assignType \<Rightarrow> expType" where
"leftIndexOfAssign des \<equiv> fst (snd (snd des))"*)

primrec rightOfAssign:: "assignType \<Rightarrow> expType" where
"rightOfAssign (compAssign des) =  (snd (snd des))" |
"rightOfAssign (simpAssign des) =  ( (snd des))"

primrec isSimpAssign:: "assignType \<Rightarrow> bool" where
"isSimpAssign (compAssign des) = False" |
"isSimpAssign (simpAssign des) = True"*)

text{*A statement is is just a lists of assignments, but these assignments
 are extecuted in parallel,  in a sequential order*}

(*datatype statement=  assign assignType    *)

datatype statement=  parallel "assignType  list"

type_synonym paraStatement= "nat \<Rightarrow> statement"

datatype rule =  guard formula  statement
text{*With the formalizatiion of formula and statement,
it is natural to define a rule. A guard and
 statement of a rule are also defined for convenience. *}

primrec pre::"rule \<Rightarrow> formula" where
"pre (guard f a)=f"

primrec act::"rule \<Rightarrow>statement" where
"act  (guard f a)=a"

type_synonym paraRule=" nat \<Rightarrow> rule"
text{*A parameterized rule is just from a natural number to a rule.*}

text{*Variables of a variable, an expression, a formula, and a statement is defined by
varsOfVar, varOfExp, varOfForm and varOfSent respectively*}

(*primrec varOfExp::"expType \<Rightarrow> varType list"  and
  varOfForm::"formula \<Rightarrow> varType list"  where

"varOfExp  (IVar v) = [ v]" |
"varOfExp   (Const j) =  []" |

"varOfExp   (iteForm f e1 e2) =(varOfForm f) @  (varOfExp   e1 )  @   (varOfExp  e2)" |
"varOfExp   (uif f es) = (concat (map varOfExp es))"|
"varOfExp   (top) =  []" |
"varOfExp   (unKnown) =  []" |
"varOfExp   (readE   a e) =  map (\<lambda> i. Para a i) (upt 0 bound)" |

"varOfForm   (eqn e1 e2) = ( (varOfExp   e1 )  @   (varOfExp  e2))" |
"varOfForm   ( andForm f1 f2) =(  (varOfForm  f1 ) @  (varOfForm  f2 ))"|
"varOfForm   (neg f1 ) = (  (varOfForm   f1 ))"|
"varOfForm   (orForm f1 f2) =(  (varOfForm   f1 )   @   (varOfForm  f2 ))"|
"varOfForm   (implyForm f1 f2) = (  (varOfForm  f1 ) @ (varOfForm f2 ))"|
"varOfForm   (uip p es) = (concat (map varOfExp es))"|
"varOfForm   (chaos) =[]"*)

(*primrec  varOfSent::"statement \<Rightarrow> varType list" where
" varOfSent  (assign a)=[  (fst a)] " *)

section{*semantics of a protocol*}
text{*A  state of a protocol  is an instantaneous snapshot of its  behaviour given by an assignment of  values to variables of
the circuit. Therefore, we define:*}
type_synonym natList="nat list"

type_synonym arrFun="natList\<Rightarrow> scalrValueType"

type_synonym state= "string \<Rightarrow> arrFun "

(*definition varsOfVar::" varType \<Rightarrow> varType set"  where  [simp]:
" varsOfVar x  = {x}" *)

type_synonym scalrValueTypeListFun="scalrValueType list \<Rightarrow> scalrValueType"

type_synonym interpretFunType="string \<Rightarrow> scalrValueTypeListFun"

type_synonym scalrValueTypeListPred="scalrValueType list \<Rightarrow> bool"

type_synonym interpretPredType="string \<Rightarrow> scalrValueTypeListPred"

primrec scalar2Bool::"scalrValueType\<Rightarrow>bool" where
" scalar2Bool (index b) =( \<not>(b=0))"

primrec getVal::"scalrValueType\<Rightarrow>nat" where
"getVal (index n) = n"

text{*A state transition from a state to another sate, which is caused by an execution of
a statement, is  defined as follows:*}

primrec statement2Assigns::"statement \<Rightarrow> assignType list" where
"statement2Assigns (parallel  S)=S"

primrec getParams::"designator \<Rightarrow> expType list" where
"getParams (arr a es) =es"

primrec nameOf::"arrVarType \<Rightarrow> string" where
"nameOf (arrDef str n ns) = str"|
"nameOf (update a es e) = nameOf a"

primrec nameOfDesn::"designator \<Rightarrow> string" where
" nameOfDesn (arr a es) =nameOf a"

text{*The formal semantics of an expression and a formula is formalized as follows:*}
primrec
arrEval::"interpretFunType \<Rightarrow> arrVarType \<Rightarrow> state \<Rightarrow>arrFun"
(*arrVarType=arrDef string nat "nat list" |
            update arrVarType "expType list" expType *)
(*arr "a" 2 [4,4] means an array with two dimensions
designator=arr arrVarType "expType list"*)

and

desnEval :: "interpretFunType \<Rightarrow>designator  \<Rightarrow> state \<Rightarrow> scalrValueType " and

expEval :: "interpretFunType \<Rightarrow> expType \<Rightarrow> state \<Rightarrow> scalrValueType" and

 formEval :: "interpretFunType \<Rightarrow> formula \<Rightarrow> state \<Rightarrow>bool"  where

"arrEval I (arrDef n d ds) s= s n"|
"arrEval I (update a es e) s=
  (let t= arrEval I a s in
  t((map (\<lambda> e. (getVal (expEval I e s)) ) es):= (expEval I e s))) "|

"desnEval I (arr a es) s= (arrEval I  a s) (map (\<lambda> e. (getVal (expEval I e s)) ) es)" |

"expEval I  (IVar ie) s =   desnEval I ie s" |
"expEval I (Const i) s =  i"  |
"expEval I  (iteForm f e1 e2) s=
   ( if (formEval I f s) then     (expEval I e1 s)
   else (expEval I e2 s))"  |
"expEval I top  s= topVal"|
"expEval I unKnown s=bottomVal" |
"expEval I  (uif f es)  s=   (I f) (map (\<lambda> e. expEval  I e s) es) " |

evalExp: "formEval I (eqn e1 e2) s= ((expEval I e1 s) = (expEval I e2 s))" |
"formEval I  (uip p es)  s=    scalar2Bool ( (I p) (map (\<lambda> e. expEval  I e s) es)) " |
evalAnd: "formEval I ( andForm f1 f2) s=( (formEval I f1 s) \<and> (formEval I f2 s))"|
evalNeg: "formEval I (neg f1 ) s= ( \<not>(formEval I f1 s))"|
evalOr: "formEval I (orForm f1 f2) s=( (formEval I f1 s) \<or>  (formEval I f2 s))"|
evalImp:"formEval I (implyForm f1 f2) s= ( (formEval I f1 s) \<longrightarrow>  (formEval I f2 s))" |
"formEval I chaos s=True"

primrec getIndexOfExp::"expType \<Rightarrow> nat" where
"getIndexOfExp (Const i) =getVal i"

primrec transAux:: "assignType list \<Rightarrow>interpretFunType \<Rightarrow> state \<Rightarrow>state " where
"transAux [] I s a= s a "
|
"transAux (asgn#asgns) I s a=
  (
  let a'=(nameOfDesn (fst asgn)) in
  if (a=a') then
   ((s a)( (map (\<lambda> e. (getVal (expEval I e s)) ) (getParams (fst asgn))):= (expEval I (snd asgn) s)))
  else ( transAux asgns I s) a)"

(*(let result=( transAux asgns I s) in
  let a=(nameOfDesn (fst asgn)) in
  result( a:= ((s a)( (map (\<lambda> e. (getVal (expEval I e s)) ) (getParams (fst asgn))):= (expEval I (snd asgn) s)))))" *)
  (* result((desnEval I (fst asgn) s) := expEval I (snd asgn) s)) "*)

definition trans:: "statement \<Rightarrow> interpretFunType \<Rightarrow> state \<Rightarrow> state " where [simp]:
"trans S I s \<equiv> transAux ( statement2Assigns S) I s"

text{*The reachable sate set of a protocol,
which is describled by a set of initiate formulas and a set of rules,
 can be formalized inductively as follows:*}

inductive_set reachableSet::" interpretFunType \<Rightarrow> formula set\<Rightarrow> rule set \<Rightarrow>state set"
  for  I::"interpretFunType" and inis::"formula set"  and rules::"rule set"   where

initState:  "\<lbrakk>formEval  I ini s; ini \<in>  inis\<rbrakk>  \<Longrightarrow>(  s \<in>  ( reachableSet I inis rules))" |

oneStep:    " \<lbrakk>s \<in>  reachableSet I inis rules ;
               r \<in>   rules ;formEval I (pre r ) s \<rbrakk> \<Longrightarrow>   (  (trans  (act r ) I s )) \<in>  reachableSet I inis rules"

section{*substitution, weakest precondition*}

primrec updates::" assignType list \<Rightarrow> arrVarType \<Rightarrow> arrVarType"  where
" updates  [] a   = a " |
" updates (x#xs) a  =
  (if ((nameOfDesn  (fst x)) = (nameOf a))
  then  (update a (getParams (fst x)) (snd x))
  else updates xs a)"

primrec
substArrDef::" arrVarType\<Rightarrow>assignType list \<Rightarrow> arrVarType "  where

"substArrDef (arrDef a d ds) asgns=updates  asgns (arrDef a d ds)"|
"substArrDef (update a es e) asgns=updates  asgns (update a es e)"

primrec
substVar ::"designator \<Rightarrow> assignType list \<Rightarrow> designator" and
substExp :: "expType\<Rightarrow> assignType list \<Rightarrow>expType"  and
substForm ::"formula \<Rightarrow> assignType list \<Rightarrow> formula" where

substVar1:" substVar (arr a es) asgns =arr (updates asgns a  ) (map (\<lambda>e. substExp e asgns) es)" |

substExpVar: "substExp  (IVar v') asgns=   IVar (substVar v' asgns)  "|

substExpConst: "substExp  (Const i)  asgns= Const i" |

substTop: "substExp top asgns=top" |

substUnkown: "substExp unKnown asgns=unKnown" |

substExpite: "substExp  (iteForm f e1 e2)  asgns= (iteForm (substForm f asgns) (substExp e1  asgns) (substExp e2  asgns))"|

substUif: "substExp (uif f es) asgns =( uif f (map (\<lambda>e. substExp e asgns) es))"|

"substForm (eqn l r)  asgns=(eqn (substExp l  asgns) (substExp r  asgns))"  |
"substForm ( andForm f1 f2)  asgns =   ( andForm (substForm f1  asgns)  (substForm f2  asgns))"|
"substForm (neg f1 )   asgns= (neg ( substForm f1  asgns ))"|
"substForm (orForm f1 f2)   asgns= ( orForm (substForm f1  asgns )  (substForm f2  asgns))"|
"substForm (implyForm f1 f2)   asgns= (implyForm (substForm f1 asgns)  (substForm f2  asgns))" |
"substForm (uip p es)   asgns= ( uip p (map (\<lambda>e. substExp e asgns) es))" |
"substForm  chaos   asgns=chaos"

lemma lemmaOnPreArrDef:
  shows "arrDef0=(arrDef a d ds) \<longrightarrow> arrEval I (substArrDef arrDef0 S) s = arrEval I  arrDef0 (trans (parallel S) I s)"

proof(induct_tac arrDef0,auto)
  fix x1 x2 x3
  show "arrEval I (updates S (arrDef x1 x2 x3)) s = transAux S I s x1" (is "?LHS3 S =?RHS3 S")
  proof(induct_tac S)
    show "?LHS3 [] =?RHS3 []" by auto
  next
    fix a S

    assume a:"?LHS3 S =?RHS3 S"
    let ?S="a#S"
    show "?LHS3 ?S =?RHS3 ?S"
    proof(case_tac "nameOfDesn (fst a) = x1",cut_tac a,auto,rule ext,cut_tac a,auto) qed

  qed
qed

lemma lemmaOnPreArrDef:
  shows "arrDef0=(arrDef a d ds) \<longrightarrow>arrEval I (substArrDef arrDef0 S) s = arrEval I  arrDef0 (trans (parallel S) I s)"

proof(induct_tac arrDef0,auto)
  fix x1 x2 x3
  show "arrEval I (updates S (arrDef x1 x2 x3)) s = transAux S I s x1" (is "?LHS3 S =?RHS3 S")
  proof(induct_tac S)
    show "?LHS3 [] =?RHS3 []" by auto
  next
    fix a S

    assume a:"?LHS3 S =?RHS3 S"
    let ?S="a#S"
    show "?LHS3 ?S =?RHS3 ?S"
    proof(case_tac "nameOfDesn (fst a) = x1",cut_tac a,auto,rule ext,cut_tac a,auto) qed

  qed
next
  fix x1 x2 x3
  assume a:"arrEval I (substArrDef x1 S) s=arrEval I x1 (transAux S I s)"
  show "arrEval I (updates S (update x1 x2 x3)) s =
      (\<lambda>a. (if a=map (\<lambda>e. getVal (expEval I e (transAux S I s))) x2 then expEval I x3 (transAux S I s) else arrEval I x1 (transAux S I s) a))"
      (is "?LHS = (\<lambda>a. ?RHS a)")
  proof(rule ext)
    fix a
    show "?LHS a =?RHS a"
    proof(cut_tac a,case_tac "a=map (\<lambda>e. getVal (expEval I e (transAux S I s))) x2",simp)

proof(induct_tac S)
  show "?LHS2 arrDef0 []  =?RHS2 arrDef0 []"
    by (case_tac arrDef0, auto)
next
  fix a S
  assume a:"?LHS2 arrDef0 S   =?RHS2 arrDef0 S"
  have "?LHS2 arrDef0 S   =?RHS2 arrDef0 S \<longrightarrow> ?LHS2 arrDef0(a# S)  =?RHS2 arrDef0 (a#S)"
    apply (induct_tac arrDef0,auto)

lemma lemmaOnPres:
  shows "
  arrEval I (substArrDef arrDef0 S) s = arrEval I  arrDef0 (trans (parallel S) I s) \<and>
  desnEval I (substVar desn S) s= desnEval I desn (trans (parallel S) I s)\<and>
(expEval I (substExp e S ) s =   expEval I  e (trans (parallel S) I s)) \<and>
   (formEval I (substForm f S ) s = formEval I f (trans (parallel S) I s))  "
proof(induct_tac  desn and e and f )

primrec  preCond1 ::" formula \<Rightarrow> statement  \<Rightarrow>formula" where
"preCond1 f ( parallel  S)  = substForm f S "

   (is "( ( ?LHS2 arrDef0 =?RHS2 arrDef0)\<and> ( ?LHS3 desn =?RHS3 desn )\<and> ?LHS e =?RHS e )\<and> ( ?LHS1 f =?RHS1 f )
        ")
primrec  preExp1 ::" expType \<Rightarrow>  statement  \<Rightarrow>expType" where [simp]:
"preExp1 e  (parallel  S)  = substExp e S"

lemma lemmaOnValOf:  shows "expEval I (preExp1 (IVar v) nf) s = ( (trans nf I s)) v"
  (is "?LHS1 nf =?RHS1 nf ")
proof(induct_tac nf)
  fix x
  let ?nf="parallel x"
  show "?LHS1 ?nf=?RHS1 ?nf"
  proof(induct_tac x )
      show "?LHS1 (parallel []) =?RHS1 (parallel [])"
        by auto
      next
      fix a list
      assume b1:"?LHS1 (parallel list) =?RHS1 (parallel list) "
      let ?nf="a#list"
      show "?LHS1 (parallel ?nf) =?RHS1 (parallel ?nf)"
      proof(case_tac "(paraNameOfAssign a) =v \<and> (leftIndexOfAssign a) =Const (index 0)")
        assume c1:"paraNameOfAssign a = v \<and> leftIndexOfAssign a = Const (index 0)"
        show "?LHS1 (parallel ?nf) =?RHS1 (parallel ?nf)"
        proof(case_tac a)
          fix x1
          assume d1:"a= simpAssign x1"
          show "?LHS1 (parallel ?nf) =?RHS1 (parallel ?nf)"
            apply(cut_tac c1 d1 b1,auto) done
        next
          fix x1
          assume d1:"a= compAssign x1"
          show "?LHS1 (parallel ?nf) =?RHS1 (parallel ?nf)"
            apply(cut_tac c1 d1 b1,auto) done
      qed
  qed

qed

lemma itePreExp1:
  "formEval I (preCond1 x1 nf) s = formEval I x1 (trans  nf I s)
   \<longrightarrow> expEval I (preExp1 x2 nf) s = expEval I x2 (trans  nf I s)
   \<longrightarrow>  expEval I (preExp1 x3 nf) s = expEval I x3 (trans  nf I s)
   \<longrightarrow>   expEval I (preExp1 (iteForm x1 x2 x3) nf) s = expEval I (iteForm x1 x2 x3) (trans  nf I s)"
   (is "?p1 nf\<longrightarrow>?p2 nf \<longrightarrow>?p3 nf\<longrightarrow>?LHS nf=?RHS nf")
 proof(induct_tac nf)
   fix S
   let ?nf="parallel S"
   show "?p1 ?nf \<longrightarrow>?p2 ?nf \<longrightarrow>?p3 ?nf \<longrightarrow>?LHS ?nf=?RHS ?nf"
   by auto

qed

lemma eqPre:
  "expEval I (preExp1 x1 nf) s = expEval I x1 (trans nf I s)\<longrightarrow>
   expEval I (preExp1 x2 nf) s = expEval I x2 (trans nf I s)\<longrightarrow>
   formEval I (preCond1 (eqn x1 x2) nf) s = formEval I (eqn x1 x2) (trans nf I s)"
   (is "?p1 nf\<longrightarrow>?p2 nf \<longrightarrow>?LHS nf=?RHS nf")
 proof(induct_tac nf)
   fix S
   let ?nf="parallel S"
   show "?p1 ?nf \<longrightarrow>?p2 ?nf  \<longrightarrow>?LHS ?nf=?RHS ?nf"
   by auto

qed

lemma auxOnufiPre: "(\<forall>x2a. x2a \<in> set es \<longrightarrow> expEval I (preExp1 x2a (parallel S)) s = expEval I x2a (trans (parallel S) I s)) \<longrightarrow>
 (map ((\<lambda>e. expEval I e s) \<circ> (\<lambda>e. substExp e S)) es) =
      (map (\<lambda>e. expEval I e (transAux S I s)) es)" (is "?P es")
proof(induct_tac es)
  let ?nf="parallel S"
  show "?P []" by auto
  next
  fix x xs
  assume b1:"?P xs"
  show "?P (x#xs)" (is "?P1 (x#xs) \<longrightarrow> ?P2 (x#xs)")
  proof
  assume c1:"?P1 (x#xs)"
  have b2:"?P1 xs" by (cut_tac c1,auto )
  then have b3:"?P2 xs" by(cut_tac b1,auto)

   have b5:"((\<lambda>e. expEval I e s) \<circ> (\<lambda>e. substExp e S)) x =
  (\<lambda>e. expEval I e (transAux S I s)) x"
    by (cut_tac c1,simp)

  show "?P2 (x#xs)" (is "?LHS (x#xs) = ?RHS (x#xs)")
  by(cut_tac b5 b3, auto)
  qed
qed

lemma uifPre:

" (\<forall>x2a. x2a \<in> set es \<longrightarrow> expEval I (preExp1 x2a nf) s = expEval I x2a (trans nf I s)) \<longrightarrow>
             expEval I (preExp1 (uif f es) nf) s = expEval I (uif f es) (trans nf I s)   "
           (  is "?p1 nf\<longrightarrow>?LHS nf=?RHS nf")
 proof(induct_tac nf)
   fix S
   let ?nf="parallel S"

   show "?p1 ?nf \<longrightarrow>?LHS ?nf=?RHS ?nf"
   proof
   assume a1:"?p1 ?nf"
   have b1:"(map ((\<lambda>e. expEval I e s) \<circ> (\<lambda>e. substExp e S)) es) =
      (map (\<lambda>e. expEval I e (transAux S I s)) es)"
      using a1 by auto

   then show "?LHS ?nf=?RHS ?nf" apply simp
   apply( simp add:b1)
   done
   qed

qed

lemma uipPre:

" (\<forall>x2a. x2a \<in> set es \<longrightarrow> expEval I (preExp1 x2a nf) s = expEval I x2a (trans nf I s)) \<longrightarrow>
             formEval I (preCond1 (uip pn es) nf) s =formEval I (uip pn es) (trans nf I s)   "
           (  is "?p1 nf\<longrightarrow>?LHS nf=?RHS nf")
 proof(induct_tac nf)
   fix S
   let ?nf="parallel S"

   show "?p1 ?nf \<longrightarrow>?LHS ?nf=?RHS ?nf"
   proof
   assume a1:"?p1 ?nf"
   have b1:"(map ((\<lambda>e. expEval I e s) \<circ> (\<lambda>e. substExp e S)) es) =
      (map (\<lambda>e. expEval I e (transAux S I s)) es)"
      using a1 by auto
   then show "?LHS ?nf=?RHS ?nf" apply simp
   apply( simp add:b1)
   done
   qed

qed

lemma andPre:
  "formEval I (preCond1 x1 nf) s = formEval I x1 (trans nf I s) \<longrightarrow>
   formEval I (preCond1 x2 nf) s = formEval I x2 (trans nf I s) \<longrightarrow>
   formEval I (preCond1 (andForm x1 x2) nf) s = formEval I (andForm x1 x2) (trans nf I s)"
    (is "?p1 nf\<longrightarrow>?p2 nf \<longrightarrow>?LHS nf=?RHS nf")
proof(induct_tac nf)
   fix S
   let ?nf="parallel S"
   show "?p1 ?nf \<longrightarrow>?p2 ?nf  \<longrightarrow>?LHS ?nf=?RHS ?nf"
   by auto

qed

lemma orPre:
  "formEval I (preCond1 x1 nf) s = formEval I x1 (trans nf I s) \<longrightarrow>
   formEval I (preCond1 x2 nf) s = formEval I x2 (trans nf I s) \<longrightarrow>
   formEval I (preCond1 (orForm x1 x2) nf) s = formEval I (orForm x1 x2) (trans nf I s)"
    (is "?p1 nf\<longrightarrow>?p2 nf \<longrightarrow>?LHS nf=?RHS nf")
proof(induct_tac nf)
   fix S
   let ?nf="parallel S"
   show "?p1 ?nf \<longrightarrow>?p2 ?nf  \<longrightarrow>?LHS ?nf=?RHS ?nf"
   by auto

qed

lemma implyPre:
  "formEval I (preCond1 x1 nf) s = formEval I x1 (trans nf I s) \<longrightarrow>
   formEval I (preCond1 x2 nf) s = formEval I x2 (trans nf I s) \<longrightarrow>
   formEval I (preCond1 (implyForm x1 x2) nf) s = formEval I (implyForm x1 x2) (trans nf I s)"
    (is "?p1 nf\<longrightarrow>?p2 nf \<longrightarrow>?LHS nf=?RHS nf")
proof(induct_tac nf)
   fix S
   let ?nf="parallel S"
   show "?p1 ?nf \<longrightarrow>?p2 ?nf  \<longrightarrow>?LHS ?nf=?RHS ?nf"
   by auto

qed

lemma notPre:
  "formEval I (preCond1 x1 nf) s = formEval I x1 (trans nf I s) \<longrightarrow>
   formEval I (preCond1 (neg x1 ) nf) s = formEval I (neg x1 ) (trans nf I s)"
    (is "?p1 nf \<longrightarrow>?LHS nf=?RHS nf")
proof(induct_tac nf)
   fix S
   let ?nf="parallel S"
   show "?p1 ?nf \<longrightarrow>?LHS ?nf=?RHS ?nf"
   by auto

qed

lemma lemmaOnPre:
  shows "(expEval I (preExp1 e nf) s =   expEval I  e (trans nf I s)) \<and>
   (formEval I (preCond1 f nf) s = formEval I f (trans nf I s))"
   (is "((  ?LHS e =?RHS e )\<and> ( ?LHS1 f =?RHS1 f ))")
proof(induct_tac e and f)
  fix v
  let ?e="(IVar v)"
  show  "  ?LHS ?e =?RHS ?e "
  proof(simp)
  by (simp add: lemmaOnValOf)

next
  fix n
  let ?e="(Const n)"
  show  "?LHS ?e =?RHS ?e "
  proof(induct_tac nf,auto)qed

next
  fix f e1 e2
  assume b1:"( ?LHS1 f =?RHS1 f )" and
  b2:"?LHS e1 =?RHS e1 " and a3:"?LHS e2 =?RHS e2 "
  let ?e="iteForm f e1 e2"
  show "?LHS ?e =?RHS ?e " (is "?LHS1 nf=?RHS1 nf")
  by (simp add: a3 b1 b2 itePreExp1)

next
  let ?e="top"
  show "?LHS ?e =?RHS ?e "
  proof(induct_tac nf,auto)qed
next
  let ?e="unKnown"
  show "?LHS ?e =?RHS ?e "
  proof(induct_tac nf,auto)qed
next
  fix e1 e2
  assume a1:" ?LHS e1 =?RHS e1 " and a2:" ?LHS e2 =?RHS e2 "
  let ?f="eqn e1 e2"
  show "(?LHS1 ?f =?RHS1 ?f )"
  by (simp add: a1 a2 eqPre)

next
  fix f1 f2
  assume a1:" ( ?LHS1 f1 =?RHS1 f1 )" and  a2:"  ?LHS1 f2 =?RHS1 f2 "
  let ?f="andForm f1 f2"
  show "( ?LHS1 ?f =?RHS1 ?f )"
  by (simp add: a1 a2 andPre)

next
  fix f1
  assume a1:" (?LHS1 f1 =?RHS1 f1 )"
  let ?f="neg f1"
  show "( ?LHS1 ?f =?RHS1 ?f )"
  by (simp add: a1  notPre)
next
  fix f1 f2
  assume a1:" ( ?LHS1 f1 =?RHS1 f1 )" and  a2:" ?LHS1 f2 =?RHS1 f2 "
  let ?f="implyForm f1 f2"

  show "(?LHS1 ?f =?RHS1 ?f )"
  by (simp add: a1 a2 implyPre)
next

  fix f1 f2
  assume a1:" ( ?LHS1 f1 =?RHS1 f1 )" and  a2:" ( ?LHS1 f2 =?RHS1 f2 )"
  let ?f="orForm f1 f2"

  show "(?LHS1 ?f =?RHS1 ?f )"
   by (simp add: a1 a2 orPre)
next
  let ?f="chaos"
  show "( ?LHS1 ?f =?RHS1 ?f )"
  proof(induct_tac nf,auto)qed
next
  fix fn es
  let ?e="uif fn es"
  assume a1:"(\<And>x2a. x2a \<in> set es \<Longrightarrow> expEval I (preExp1 x2a nf) s = expEval I x2a (trans nf I s))"
   show "?LHS ?e =?RHS ?e " (is "?LHS1 nf=?RHS1 nf")
   by (simp add: a1 uifPre)
next
  fix pn es
  let ?f="uip pn es"
  assume a1:"(\<And>x2a. x2a \<in> set es \<Longrightarrow> expEval I (preExp1 x2a nf) s = expEval I x2a (trans nf I s))"
   show "?LHS1 ?f =?RHS1 ?f "
   by (simp add: a1 uipPre)
qed

lemma lemmaOnPreExp:
shows "expEval I (preExp1 e nf) s =   expEval I e (trans nf I s) "
  by (simp add: lemmaOnPre)

lemma lemmaOnPreForm:
shows "formEval I (preCond1 f nf) s = formEval I f (trans nf I s)"
  by (simp add: lemmaOnPre)

section{*main lemma: consistency lemma*}

definition tautlogy::"formula \<Rightarrow>  interpretFunType \<Rightarrow>    bool" where [simp]:
"tautlogy f I \<equiv> \<forall>s. formEval I f s"

primrec andListForm::"formula list \<Rightarrow> formula " where
"andListForm [] = chaos" |
"andListForm  (f#fs) = andForm f (andListForm  fs)"

lemma andList1Aux:
   shows "formEval I ( (andListForm frms)) s  \<longrightarrow> frm \<in>set frms \<longrightarrow> formEval I ( frm) s "
   proof(induct_tac frms,auto)qed

lemma andList1:
   shows "formEval I ( (andListForm frms)) s  \<Longrightarrow>  frm \<in>set frms \<Longrightarrow> formEval I ( frm) s "
    by (metis andList1Aux)

section{*causal relations and consistency lemma*}
text{*A novel feature of our work lies in that three kinds of causal
relations are exploited, which are essentially special cases of the
general induction rule.  Consider a rule $r$, a formula $f$, and a formula set $fs$, three
 kinds of causal relations are defined as follows:*}

definition invHoldForRule1::"interpretFunType\<Rightarrow> state \<Rightarrow> formula \<Rightarrow> rule \<Rightarrow> bool" where [simp]:
"invHoldForRule1 I s f  r \<equiv>
(formEval I (pre r) s \<longrightarrow>  formEval I (preCond1 f  (act r)) s )"
text{* $\mathsf{invHoldRule}_1(s,f, r)$ means that after rule $r$ is executed, $f$ becomes true immediately;*}

 definition invHoldForRule2::"interpretFunType\<Rightarrow> state \<Rightarrow> formula \<Rightarrow> rule \<Rightarrow> bool" where [simp]:
"invHoldForRule2 I s f  r \<equiv>
(formEval I (preCond1 f  (act r)) s  =  formEval I f s)"
text{*$\mathsf{invHoldRule}_2(s,f, r)$ states that $\mathsf{preCond}(S,f)$ is equivalent to $f$,
which intuitively means that none of state variables in $f$ is changed, and the execution of
statement $S$ does not affect the evaluation of $f$;*}

definition  invHoldForRule3::"interpretFunType\<Rightarrow>state \<Rightarrow> formula \<Rightarrow> rule \<Rightarrow>formula set\<Rightarrow> bool"  where [simp]:
"invHoldForRule3 I s f r fs  \<equiv>
(\<exists>f'. f' \<in> fs \<and>  (formEval  I (andForm (pre r)  f') s\<longrightarrow> formEval I (preCond1 f  (act r))  s))"
text{*$\mathsf{invHoldRule}_3(s,f, r,fs)$ states that there exists another invariant $f' \in fs$ such that
  the conjunction of the guard of $r$ and $f'$ implies the precondition  $\mathsf{preCond}(S,f)$.*}

abbreviation invHoldForRule::"interpretFunType\<Rightarrow>state \<Rightarrow>formula \<Rightarrow> rule \<Rightarrow> (formula set) \<Rightarrow> bool" where
  "invHoldForRule I s inv0 r invs \<equiv>
    invHoldForRule1 I s inv0 r \<or>  invHoldForRule2 I s inv0 r \<or>   invHoldForRule3 I s inv0 r invs "

text{*The relation $\mathsf{invHoldRule}(s, f,r,fs)$ defines a causality relation
between $f$, $r$, and $fs$, which guarantees that if each formula in $fs$ holds
before the execution of rule $r$, then $f$ holds after the execution of rule $r$.
We can also view $\mathsf{invHoldRule}(s, f, r, fs)$ as a
special kind of inductive tactics, which can be applied to prove
each formula in $fs$ holds at each inductive protocol rule cases.
Note that the three kinds of inductive tactics can be done by a theorem prover,
which is the cornerstone of our work.

With the $\mathsf{invHoldRule}$ relation, we define a consistency relation
$\mathsf{consistent}( invs,inis, rs)$ between a protocol $(inis,rs)$ and a
 set of invariants $invs=\{inv_1,\ldots, inv_n\}$. *}

definition consistent::"interpretFunType\<Rightarrow>formula set \<Rightarrow> formula set \<Rightarrow> rule set \<Rightarrow>bool"  where [simp]:
"consistent I invs inis rs \<equiv>
(\<forall>inv ini s. (inv \<in> invs \<longrightarrow> ini\<in> inis\<longrightarrow> formEval I ini s \<longrightarrow> formEval I inv s)) \<and>
 (\<forall> inv r s.  (inv \<in>invs  \<longrightarrow> r \<in> rs \<longrightarrow> invHoldForRule I s inv r invs  ))"

definition  invHoldForRule4::"interpretFunType\<Rightarrow>state \<Rightarrow> formula \<Rightarrow> rule \<Rightarrow>formula set\<Rightarrow> bool"  where [simp]:
"invHoldForRule4 I s f r fs  \<equiv>
(\<exists>fs'. fs' \<subseteq> fs \<and>  ((\<forall> f'. f'\<in>(fs' \<union> {pre r}) \<longrightarrow>formEval  I   f' s)\<longrightarrow> formEval I (preCond1 f  (act r))  s))"

abbreviation invHoldForRule'::"interpretFunType\<Rightarrow>state \<Rightarrow>formula \<Rightarrow> rule \<Rightarrow> (formula set) \<Rightarrow> bool" where
  "invHoldForRule' I s inv0 r invs \<equiv>
    invHoldForRule1 I s inv0 r \<or>  invHoldForRule2 I s inv0 r \<or>   invHoldForRule4 I s inv0 r invs "

text{*$\mathsf{invHoldRule}_3(s,f, r,fs)$ states that there exists another invariant $f' \in fs$ such that
  the conjunction of the guard of $r$ and $f'$ implies the precondition  $\mathsf{preCond}(S,f)$.*}

lemma consistentLemma:
  assumes a1:"consistent I invs inis rs" and a2:"s \<in> reachableSet I inis rs"
  shows "\<forall> inv. inv \<in> invs \<longrightarrow>formEval I inv s"  (is "?P s")
  using a2
  proof induct
    case (initState ini s)
    show "?P s"
      apply(cut_tac a1, unfold consistent_def)
      by (metis (lifting) initState(1) initState(2))
  next
    case (oneStep s r)
    show "?P  (trans  (act r) I s)"
    proof (rule allI, rule impI)
      fix inv
      assume b1:"inv \<in> invs"
      have b2:" invHoldForRule3 I s inv r  invs \<or> invHoldForRule2 I s inv r   \<or> invHoldForRule1 I s inv r  "
        apply(cut_tac a1, unfold consistent_def)
        by (metis b1 oneStep(3))

     moreover
      { assume c1:"invHoldForRule3 I s inv r invs"

        let ?pref="preCond1 inv (act r)"
          have b3:"  ( (\<forall> f'.  f' \<in>  invs\<longrightarrow>formEval I f'  s) \<longrightarrow>formEval I (pre r)  s\<longrightarrow> formEval I  ?pref s)  "  (is " ?P fs ")
           apply (cut_tac c1, unfold invHoldForRule3_def,auto)
          done

        then have b3':"?P fs  "
          by blast

        have b4:" (\<forall> f'.  f' \<in>  invs\<longrightarrow>formEval I f'  s)"
          apply(cut_tac b3' )
          by (metis (no_types) oneStep(2))

        have b5:"formEval I (pre r) s"
          by (metis (lifting) oneStep(4))

        have b6:"formEval I ?pref s"
         by(cut_tac b4 b5 b3', auto)

        have "formEval I inv (trans (act r) I s)"
          using b6 lemmaOnPre by blast
      }

     moreover
      {assume b1':"invHoldForRule2 I s inv r "
        have b2:"formEval I inv s"
        by (metis b1 oneStep.hyps(2))

        let ?pref="preCond1 inv (act r)"
        have b3:" (  formEval I ?pref s  =  formEval I inv s)"
        by(cut_tac b1',unfold  invHoldForRule2_def,simp)

        with b2 have b4:"formEval I ?pref s"
          by auto

        have "formEval I inv (trans (act r) I s)"
          using b2 b3 lemmaOnPreForm by auto

      }
      moreover
      {assume b1':"invHoldForRule1 I s inv r "

         have b5:"formEval I (pre r) s"
          by (metis (lifting) oneStep(4))

         have "formEval I inv (trans (act r) I s)"
           apply(subgoal_tac "formEval I (preCond1 inv (act r) ) s")
           apply (simp add: lemmaOnPre)
           apply(cut_tac b1' b5)
           by(unfold invHoldForRule1_def,auto)

       }
       ultimately show "formEval I inv (trans (act r) I s)"
         by blast
     qed
 qed

definition consistent'::"interpretFunType\<Rightarrow>formula set \<Rightarrow> formula set \<Rightarrow> rule set \<Rightarrow>bool"  where [simp]:
"consistent' I invs inis rs \<equiv>
(\<forall>inv ini s. (inv \<in> invs \<longrightarrow> ini\<in> inis\<longrightarrow> formEval I ini s \<longrightarrow> formEval I inv s)) \<and>
 (\<forall> inv r s.  (inv \<in>invs  \<longrightarrow> r \<in> rs \<longrightarrow> invHoldForRule' I s inv r invs  ))"

lemma consistentLemma':
  assumes a1:"consistent' I invs inis rs" and a2:"s \<in> reachableSet I inis rs"
  shows "\<forall> inv. inv \<in> invs \<longrightarrow>formEval I inv s"  (is "?P s")
  using a2
  proof induct
    case (initState ini s)
    show "?P s"
      apply(cut_tac a1, unfold consistent'_def)
      by (metis (lifting) initState(1) initState(2))
  next
    case (oneStep s r)
    show "?P  (trans  (act r) I s)"
    proof (rule allI, rule impI)
      fix inv
      assume b1:"inv \<in> invs"
      have b2:" invHoldForRule4 I s inv r  invs \<or> invHoldForRule2 I s inv r   \<or> invHoldForRule1 I s inv r  "
        apply(cut_tac a1, unfold consistent'_def)
        by (metis b1 oneStep(3))

     moreover
      { assume c1:"invHoldForRule4 I s inv r invs"

        let ?pref="preCond1 inv (act r)"
          have b3:"  ( (\<forall> f'.  f' \<in>  invs\<longrightarrow>formEval I f'  s) \<longrightarrow>formEval I (pre r)  s\<longrightarrow> formEval I  ?pref s)  "  (is " ?P fs ")
           apply (cut_tac c1, unfold invHoldForRule4_def,auto)
          done

        then have b3':"?P fs  "
          by blast

        have b4:" (\<forall> f'.  f' \<in>  invs\<longrightarrow>formEval I f'  s)"
          apply(cut_tac b3' )
          by (metis (no_types) oneStep(2))

        have b5:"formEval I (pre r) s"
          by (metis (lifting) oneStep(4))

        have b6:"formEval I ?pref s"
         by(cut_tac b4 b5 b3', auto)

        have "formEval I inv (trans (act r) I s)"
          using b6 lemmaOnPre by blast
      }

     moreover
      {assume b1':"invHoldForRule2 I s inv r "
        have b2:"formEval I inv s"
        by (metis b1 oneStep.hyps(2))

        let ?pref="preCond1 inv (act r)"
        have b3:" (  formEval I ?pref s  =  formEval I inv s)"
        by(cut_tac b1',unfold  invHoldForRule2_def,simp)

        with b2 have b4:"formEval I ?pref s"
          by auto

        have "formEval I inv (trans (act r) I s)"
          using b2 b3 lemmaOnPreForm by auto

      }
      moreover
      {assume b1':"invHoldForRule1 I s inv r "

         have b5:"formEval I (pre r) s"
          by (metis (lifting) oneStep(4))

         have "formEval I inv (trans (act r) I s)"
           apply(subgoal_tac "formEval I (preCond1 inv (act r) ) s")
           apply (simp add: lemmaOnPre)
           apply(cut_tac b1' b5)
           by(unfold invHoldForRule1_def,auto)

       }
       ultimately show "formEval I inv (trans (act r) I s)"
         by blast
     qed
 qed

subsection{*more lemmas on valOf operator*}

text{*more lemmas on valOf operator*}

lemma valOfLemmaAux[simp]: "i \<le> N \<longrightarrow> (valOf (map (\<lambda>i. (Para v i, e i)) (down N)) (Para v i))=e i"
  apply(induct_tac N)
  apply simp
  apply auto
done

lemma valOfLemma[simp]: "i \<le> N \<Longrightarrow> (valOf (map (\<lambda>i. (Para v i, e i)) (down N)) (Para v i))=e i"
by (metis valOfLemmaAux )

lemma valOfLemma2Aux[simp]: "(var' \<notin> set (map fst xs)) \<longrightarrow> (valOf xs (var'))=IVar var'"
  apply(induct_tac xs)
  apply simp
  apply auto
done

lemma valOfLemma2[simp,intro]: "(var' \<notin> set (map fst xs)) \<Longrightarrow> (valOf xs (var'))=IVar var'"
by (metis (lifting) valOfLemma2Aux)

lemma valOfLemma3 [simp]:"(\<forall> i.  var' \<noteq> Para v i) \<Longrightarrow>
(valOf (map (\<lambda>i. (Para v i, e i)) (down N)) var')=IVar var'"
apply(rule valOfLemma2)
apply(induction N)
by auto

lemma valOfLemma4Aux :"v \<notin> set (map fst   ( statement2Assigns (parallel S))) \<longrightarrow>
( valOf ( statement2Assigns  (parallel ( S@ S'))) v) =    ( valOf ( statement2Assigns (parallel S')) v)"
    proof(induct_tac S,auto)qed

lemma valOfLemma4 [simp,intro]:"v \<notin> set (map fst   ( statement2Assigns (parallel S))) \<Longrightarrow>
( valOf ( statement2Assigns  (parallel ( S@ S'))) v) =    ( valOf ( statement2Assigns (parallel S')) v)"
by (metis valOfLemma4Aux)

lemma valOfLemma5Aux :"v \<notin> set (map fst  As') \<longrightarrow>
( valOf (As'@ As) v) =    ( valOf As) v"
    proof(induct_tac As',auto)qed

lemma valOfLemma5 :"v \<notin> set (map fst  As') \<Longrightarrow>
( valOf (As'@ As) v) =    ( valOf As) v"
   by (metis valOfLemma5Aux)

(*lemma mapFstAssignsAux:"(\<forall> i.  v' \<noteq> Para v i) \<longrightarrow> v' \<notin> set (map fst ( map (statement2Assigns o
                      (\<lambda>i. assign (Para v i,  e i))) L )) "
  apply(induct_tac L,auto) done

lemma mapFstAssigns [simp,intro]:"(\<forall> i.  v' \<noteq> Para v i) \<Longrightarrow> v' \<notin> set (map fst ( map (statement2Assigns o
                      (\<lambda>i. assign (Para v i,  e i))) L )) "
  apply(metis mapFstAssignsAux) done
*)
lemma valOfLemma6Aux :"v \<notin> set (map fst   S) \<longrightarrow>
( valOf  ( S@ S') v) =    ( valOf   S') v"
    proof(induct_tac S,auto)qed

lemma valOfLemma6 [simp,intro!]:"v \<notin> set (map fst   S) \<Longrightarrow>
( valOf  ( S@ S') v) =    ( valOf   S') v"
by (metis valOfLemma6Aux)

(*
lemma valOfLemma7 [simp]:
"map (statement2Assigns \<circ>
                      (\<lambda>i. assign (Para v i, e i)))
                  [0..<depth] = map (\<lambda>i.   (Para v i, e i)) [0..<depth]"
apply(induct_tac depth)
apply auto
done

lemma valOfLemma8 [simp]:
"map (statement2Assigns \<circ>
                      (\<lambda>i. assign (Para v i, e i)))
                  (down Last) = map (\<lambda>i.   (Para v i, e i)) (down Last)"
apply(induct_tac Last)
apply auto
done
*)
lemma valOfLemma9[simp]:
"\<forall>ASL. valOf (map (\<lambda>i.   (Para v i, e i)) [0..<depth]@ASL) (Ident v') =valOf ASL (Ident v')" (is "?P depth")
proof(induct_tac depth)
  show "?P 0"
    by auto
next
  fix n
  assume a1:"?P n"

  show "?P (Suc n)"
  proof
    fix ASL
    have a2:"(map (\<lambda>i. (Para v i, e i)) [0..<Suc n] @ ASL) =
    (map (\<lambda>i. (Para v i, e i)) [0..< n]) @((Para v ( n), e ( n))#ASL)"
    apply auto done
    have a3:" valOf ((map (\<lambda>i. (Para v i, e i)) [0..< n]) @((Para v ( n), e ( n))#ASL)) (Ident v') =
    valOf  ((Para v ( n), e ( n))#ASL) (Ident v')"
    by (simp add: local.a1)

    show "valOf (map (\<lambda>i. (Para v i, e i)) [0..<Suc n] @ ASL) (Ident v') = valOf ASL (Ident v')"
      apply(cut_tac a2 a3,auto)
   done
   qed
 qed

(*lemma valOfLemma10:"
          valOf (map (statement2Assigns \<circ>
                       (\<lambda>i. assign (Para (Ident ''mem'') i,
                                    iteForm (eqn (Const (index i)) (Const (index 0))) dataIn
                                     (caseExp
                                       (map (\<lambda>ia. (eqn (uif ''-'' [Const (index i), Const (index (Suc 0))]) (Const (index ia)), mem ia))
                                         (down depth))))))
                   [0..<depth] @
                  [(Ident ''tail'', iteForm (neg (eqn emptyFifo LOW)) (uif ''+'' [tail, Const (index (Suc 0))]) tail),
                   (Ident ''empty'', LOW)])
            (Ident ''tail'') = iteForm (neg (eqn emptyFifo LOW)) (uif ''+'' [tail, Const (index (Suc 0))]) tail"
     by auto
     *)
lemma valOfLemma11[simp]: "i \<le> N \<longrightarrow> (valOf (map (\<lambda>i. (Para v i, e i)) (down N)) (Para v i))=e i"
  apply(induct_tac N)
  apply simp
  apply auto
done

lemma substMap:

shows "(\<forall> x. x \<in> set xs \<longrightarrow> substExp  x f=x)\<longrightarrow>substExp  (uif fStr xs) f =uif fStr xs"
proof(induct_tac xs,auto) qed

lemma substNIl:
  shows "(substExp e [] = e) \<and> (substForm f [] =f)"
  using substMap by(induct_tac e and f,auto)

lemma substNIlForm[simp]:
  shows " (substForm f [] =f)"
by (simp add: substNIl)

lemma substNIlExp[simp]:
  shows " (substExp e [] =e)"
by (simp add: substNIl)

lemma tautologyImplTrans[intro!]:
  assumes a1:"tautlogy (implyForm P Q) I" and a2:"tautlogy (implyForm  Q R) I"
  shows "tautlogy (implyForm P R) I"
using a2 local.a1 by auto

lemma noEffectSubstAux:

  shows " (  (v \<notin>set (varOfExp e) ) \<longrightarrow>  substExp  e ((v,e')#S)  =substExp  e S) \<and>
          (  (v \<notin>set (varOfForm f)  )\<longrightarrow> substForm f ((v,e')#S)  =  substForm f S )"

    (is "(( ?condOne e S\<longrightarrow> ?LHS e S=?RHS e S)\<and> (?condOnf f S\<longrightarrow> ?LHS1 f S=?RHS1 f S))")
  proof(induct_tac e and f,auto)qed

lemma noEffectSubstExp [simp,intro!]:

  shows " v \<notin>set (varOfExp e)  \<Longrightarrow>  substExp  e ((v,e')#S)  =substExp  e S "
by (metis noEffectSubstAux)

lemma noEffectSubstForm [simp,intro!]:

  shows "    (v \<notin>set (varOfForm f)  \<Longrightarrow>  substForm f ((v,e')#S)  =  substForm f S ) "
 by (metis noEffectSubstAux)

 lemma noEffectSubstAllAux:

  shows " (  (set (varOfExp e) \<inter> set (map fst S) ={} ) \<longrightarrow>  substExp  e S  = e) \<and>
          (  (set (varOfForm f) \<inter> set (map fst S) ={} )\<longrightarrow> substForm f S =  f )"

    (is "?P S")
  proof(induct_tac S,simp)
  fix a S
    assume a1:"?P S"
    show "?P (a#S)" (is "?P1 \<and> ?P2")
    proof(rule conjI)
    show "?P1"
    proof
      assume b1:" set (varOfExp e) \<inter> set (map fst (a # S)) = {}"
      have b2:"set (varOfExp e) \<inter> set (map fst S) ={}" by(cut_tac b1,auto)
      have b3:" substExp  e (a # S) = substExp  e S"
      proof(case_tac a,cut_tac b1,simp) qed
      have b4:"substExp  e S=e" by(cut_tac b2 a1,auto)
      show "substExp  e (a # S) = e"
      by (simp add: b3 b4)
    qed
   next
    show "?P2"
    proof
      assume b1:" set (varOfForm f) \<inter> set (map fst (a # S)) = {}"
      have b2:"set (varOfForm f) \<inter> set (map fst S) ={}" by(cut_tac b1,auto)
      have b3:" substForm  f (a # S) = substForm  f S"
      proof(case_tac a,cut_tac b1,simp) qed
      have b4:"substForm  f S=f"
      by(cut_tac b2 a1,auto)
      show "substForm  f (a # S) = f"
      by (simp add: b3 b4)
    qed
    qed
 qed

lemma noEffectPreExp [simp,intro!]:
  assumes a1:" v \<notin>set (varOfExp e)"
  shows " preExp1  e (parallel ( (v,e')#S))  = preExp1  e (parallel S) "
  by (simp add: local.a1)

lemma noEffectPreExp1 [simp,intro!]:
  assumes a1:" set (varOfExp e) \<inter>  set (map fst (  statement2Assigns (parallel S))) ={}"
  shows " preExp1  e (parallel S)  =e "
  using assms noEffectSubstAllAux by auto

lemma noEffectPreCond [simp,intro!]:
  assumes a1:" v \<notin>set (varOfForm f)"
  shows " preCond1  f (parallel ( (v,e')#S))  = preCond1  f (parallel S) "
  by (simp add: local.a1)

lemma noEffectPreCond1 [simp,intro!]:
assumes a1: "(  (set (varOfForm f) \<inter> set (map fst S) ={} ) )"
shows " substForm f S =  f"
using assms noEffectSubstAllAux by auto

lemma auxOnCaseExpMaps[simp]:
"varOfExp (caseExp (map (\<lambda>i. (f i, e i)) (down LAST)))
=concat (map (\<lambda>i. ( (varOfForm (f i))@varOfExp ( e i)))  (down LAST))"
proof(induct_tac LAST,auto)qed

lemma substByWrite[simp,intro!]:
  assumes a1:"(\<forall>j. Para mem j \<notin>set (varOfExp e'))"
shows "(substExp e'
       (map (\<lambda>i. (Para mem i, iteForm (eqn e (Const (index i))) e'' (IVar (Para mem i)))) (down n))) =e'"
using a1 by(induct_tac n, auto)

lemma SucnIsNotInDownNAux: "\<forall>i. Suc n \<le> i \<longrightarrow> i \<notin> set (down n)"
proof(induct_tac n,auto)qed

lemma SucnIsNotInDownn: "Suc n \<notin> set (down n)"
by (simp add: SucnIsNotInDownNAux)

(*lemma OnIfPos1[simp,intro]:
  assumes a1:"tautlogy  (implyForm pre b) I"
  shows "tautlogy  (implyForm pre (preCond1 f (If b S1 S2))) I = tautlogy  (implyForm pre (preCond1 f  S1 )) I "
    by (cut_tac a1,auto)

lemma OnIfNeg1[simp,intro]:
  assumes a1:"tautlogy  (implyForm pre (neg b)) I"
  shows "tautlogy  (implyForm pre (preCond1 f (If b S1 S2))) I = tautlogy  (implyForm pre (preCond1 f  S2 )) I "
    by (cut_tac a1,auto)

lemma preCondAndList[simp]:
shows "tautlogy (implyForm (preCond1 (andListForm FS) S) ( andListForm (map (\<lambda>f. preCond1 f S) FS))) I"
proof(induct_tac FS,simp,case_tac S,simp ,simp,rule allI)
  fix a list x21 x22 x23 s
  assume b1:" \<forall>s. (formEval I x21 s \<and> formEval I (preCond1 (andListForm list) x22) s \<longrightarrow>
            formEval I (andListForm (map (\<lambda>f. orForm (andForm x21 (preCond1 f x22)) (andForm (neg x21) (preCond1 f x23))) list)) s) \<and>
           (\<not> formEval I x21 s \<and> formEval I (preCond1 (andListForm list) x23) s \<longrightarrow>
            formEval I (andListForm (map (\<lambda>f. orForm (andForm x21 (preCond1 f x22)) (andForm (neg x21) (preCond1 f x23))) list)) s) " and
         b2:"S = generalizeStatement.If x21 x22 x23 "
   show "(formEval I x21 s \<and> formEval I (preCond1 (andForm a (andListForm list)) x22) s \<longrightarrow>
        formEval I (preCond1 a x22) s \<and>
        formEval I (andListForm (map (\<lambda>f. orForm (andForm x21 (preCond1 f x22)) (andForm (neg x21) (preCond1 f x23))) list)) s) \<and>
       (\<not> formEval I x21 s \<and> formEval I (preCond1 (andForm a (andListForm list)) x23) s \<longrightarrow>
        formEval I (preCond1 a x23) s \<and>
        formEval I (andListForm (map (\<lambda>f. orForm (andForm x21 (preCond1 f x22)) (andForm (neg x21) (preCond1 f x23))) list)) s)"(is "?P \<and> ?Q")
    proof(rule conjI)
      show "?P"
      proof
        assume c1:"formEval I x21 s \<and> formEval I (preCond1 (andForm a (andListForm list)) x22) s "
        show "formEval I (preCond1 a x22) s \<and>
        formEval I (andListForm (map (\<lambda>f. orForm (andForm x21 (preCond1 f x22)) (andForm (neg x21) (preCond1 f x23))) list)) s"
        using b1 c1 lemmaOnPreForm by auto
      qed
      next
      show "?Q"
      proof
        assume c1:"\<not> formEval I x21 s \<and> formEval I (preCond1 (andForm a (andListForm list)) x23) s"
        show "formEval I (preCond1 a x23) s \<and> formEval I (andListForm (map (\<lambda>f. orForm (andForm x21 (preCond1 f x22)) (andForm (neg x21) (preCond1 f x23))) list)) s"
        using b1 c1 lemmaOnPreForm by auto
       qed
       qed
qed

lemma preCondAndListConv[simp]:
shows "tautlogy (implyForm  ( andListForm (map (\<lambda>f. preCond1 f S) FS))  (preCond1 (andListForm FS) S)) I"
proof(induct_tac FS,case_tac S,simp,simp,rule allI)
  fix x21 x22 x23 s
  assume a1:"S = generalizeStatement.If x21 x22 x23"
  show "formEval I x21 s \<and> formEval I (preCond1 chaos x22) s \<or> \<not> formEval I x21 s \<and> formEval I (preCond1 chaos x23) s" thm lemmaOnPreForm
  by (simp add: lemmaOnPreForm)
  next
  fix a list
  assume a1:"tautlogy (implyForm (andListForm (map (\<lambda>f. preCond1 f S) list)) (preCond1 (andListForm list) S)) I"
  show "tautlogy (implyForm (andListForm (map (\<lambda>f. preCond1 f S) (a # list))) (preCond1 (andListForm (a # list)) S)) I"
  proof(simp,rule allI,rule impI)
    fix s
    assume b1:"formEval I (preCond1 a S) s \<and> formEval I (andListForm (map (\<lambda>f. preCond1 f S) list)) s "
    show "formEval I (preCond1 (andForm a (andListForm list)) S) s"
    proof(case_tac S)
      fix xs
      assume c1:"S=Parallel xs"
      show "formEval I (preCond1 (andForm a (andListForm list)) S) s"
      apply(cut_tac a1 b1 c1,simp) done
      next
      fix x21 x22 x23
      assume c1:"S=generalizeStatement.If x21 x22 x23"
      show "formEval I (preCond1 (andForm a (andListForm list)) S) s"
      apply(cut_tac a1 b1 c1,simp)
      using lemmaOnPreForm by auto
    qed
    qed
qed
*)
end