(*  Title:      JinjaDCI/Compiler/Correctness1.thy
    Author:     Tobias Nipkow, Susannah Mansky
    Copyright   TUM 2003, UIUC 2019-20

    Based on the Jinja theory Compiler/Correctness1.thy by Tobias Nipkow
*)

section \<open> Correctness of Stage 1 \<close>

theory Correctness1
imports J1WellForm Compiler1
begin

subsection\<open>Correctness of program compilation \<close>

primrec unmod :: "expr\<^sub>1 \<Rightarrow> nat \<Rightarrow> bool"
  and unmods :: "expr\<^sub>1 list \<Rightarrow> nat \<Rightarrow> bool" where
"unmod (new C) i = True" |
"unmod (Cast C e) i = unmod e i" |
"unmod (Val v) i = True" |
"unmod (e\<^sub>1 \<guillemotleft>bop\<guillemotright> e\<^sub>2) i = (unmod e\<^sub>1 i \<and> unmod e\<^sub>2 i)" |
"unmod (Var i) j = True" |
"unmod (i:=e) j = (i \<noteq> j \<and> unmod e j)" |
"unmod (e\<bullet>F{D}) i = unmod e i" |
"unmod (C\<bullet>\<^sub>sF{D}) i = True" |
"unmod (e\<^sub>1\<bullet>F{D}:=e\<^sub>2) i = (unmod e\<^sub>1 i \<and> unmod e\<^sub>2 i)" |
"unmod (C\<bullet>\<^sub>sF{D}:=e\<^sub>2) i = unmod e\<^sub>2 i" |
"unmod (e\<bullet>M(es)) i = (unmod e i \<and> unmods es i)" |
"unmod (C\<bullet>\<^sub>sM(es)) i = unmods es i" |
"unmod {j:T; e} i = unmod e i" |
"unmod (e\<^sub>1;;e\<^sub>2) i = (unmod e\<^sub>1 i \<and>  unmod e\<^sub>2 i)" |
"unmod (if (e) e\<^sub>1 else e\<^sub>2) i = (unmod e i \<and> unmod e\<^sub>1 i \<and> unmod e\<^sub>2 i)" |
"unmod (while (e) c) i = (unmod e i \<and> unmod c i)" |
"unmod (throw e) i = unmod e i" |
"unmod (try e\<^sub>1 catch(C i) e\<^sub>2) j = (unmod e\<^sub>1 j \<and> (if i=j then False else unmod e\<^sub>2 j))" |
"unmod (INIT C (Cs,b) \<leftarrow> e) i = unmod e i" |
"unmod (RI(C,e);Cs \<leftarrow> e') i = (unmod e i \<and> unmod e' i)" |

"unmods ([]) i = True" |
"unmods (e#es) i = (unmod e i \<and> unmods es i)"

lemma hidden_unmod: "\<And>Vs. hidden Vs i \<Longrightarrow> unmod (compE\<^sub>1 Vs e) i" and
 "\<And>Vs. hidden Vs i \<Longrightarrow> unmods (compEs\<^sub>1 Vs es) i"
(*<*)
proof(induct e and es rule: compE\<^sub>1.induct compEs\<^sub>1.induct)
  case TryCatch
  then show ?case by(simp add:hidden_inacc)(auto simp add:hidden_def)
qed (simp_all add:hidden_inacc)
(*>*)

lemma eval\<^sub>1_preserves_unmod:
  "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>e,(h,ls,sh)\<rangle> \<Rightarrow> \<langle>e',(h',ls',sh')\<rangle>; unmod e i; i < size ls \<rbrakk>
  \<Longrightarrow> ls ! i = ls' ! i"
and "\<lbrakk> P \<turnstile>\<^sub>1 \<langle>es,(h,ls,sh)\<rangle> [\<Rightarrow>] \<langle>es',(h',ls',sh')\<rangle>; unmods es i; i < size ls \<rbrakk>
      \<Longrightarrow> ls ! i = ls' ! i"
(*<*)
proof(induct rule:eval\<^sub>1_evals\<^sub>1_inducts)
  case (RInitInitFail\<^sub>1 e h l sh a h' l' sh' C sfs i sh'' D Cs e\<^sub>1 h\<^sub>1 l\<^sub>1 sh\<^sub>1)
  have "final (throw a)" using eval\<^sub>1_final[OF RInitInitFail\<^sub>1.hyps(1)] by simp
  then show ?case using RInitInitFail\<^sub>1 by(auto simp: eval\<^sub>1_preserves_len)
qed(auto dest!:eval\<^sub>1_preserves_len evals\<^sub>1_preserves_len split:if_split_asm)
(*>*)

lemma LAss_lem:
  "\<lbrakk>x \<in> set xs; size xs \<le> size ys \<rbrakk>
  \<Longrightarrow> m\<^sub>1 \<subseteq>\<^sub>m m\<^sub>2(xs[\<mapsto>]ys) \<Longrightarrow> m\<^sub>1(x\<mapsto>y) \<subseteq>\<^sub>m m\<^sub>2(xs[\<mapsto>]ys[last_index xs x := y])"
(*<*)
by(simp add:map_le_def fun_upds_apply eq_sym_conv)
(*>*)
lemma Block_lem:
fixes l :: "'a \<rightharpoonup> 'b"
assumes 0: "l \<subseteq>\<^sub>m [Vs [\<mapsto>] ls]"
    and 1: "l' \<subseteq>\<^sub>m [Vs [\<mapsto>] ls', V\<mapsto>v]"
    and hidden: "V \<in> set Vs \<Longrightarrow> ls ! last_index Vs V = ls' ! last_index Vs V"
    and size: "size ls = size ls'"    "size Vs < size ls'"
shows "l'(V := l V) \<subseteq>\<^sub>m [Vs [\<mapsto>] ls']"
(*<*)
proof -
  have "l'(V := l V) \<subseteq>\<^sub>m [Vs [\<mapsto>] ls', V\<mapsto>v](V := l V)"
    using 1 by(rule map_le_upd)
  also have "\<dots> = [Vs [\<mapsto>] ls'](V := l V)" by simp
  also have "\<dots> \<subseteq>\<^sub>m [Vs [\<mapsto>] ls']"
  proof (cases "l V")
    case None thus ?thesis by simp
  next
    case (Some w)
    hence "[Vs [\<mapsto>] ls] V = Some w"
      using 0 by(force simp add: map_le_def split:if_splits)
    hence VinVs: "V \<in> set Vs" and w: "w = ls ! last_index Vs V"
      using size by(auto simp add:fun_upds_apply split:if_splits)
    hence "w = ls' ! last_index Vs V" using hidden[OF VinVs] by simp
    hence "[Vs [\<mapsto>] ls'](V := l V) = [Vs [\<mapsto>] ls']" using Some size VinVs
      by(simp add: map_upds_upd_conv_last_index)
    thus ?thesis by simp
  qed
  finally show ?thesis .
qed
(*>*)

(*<*)
declare fun_upd_apply[simp del]
(*>*)

text\<open>\noindent The main theorem: \<close>

and evals\<^sub>1_evals: "P \<turnstile> \<langle>es,(h,l,sh)\<rangle> [\<Rightarrow>] \<langle>es',(h',l',sh')\<rangle>
    \<Longrightarrow> (\<And>Vs ls. \<lbrakk> fvs es \<subseteq> set Vs;  l \<subseteq>\<^sub>m [Vs[\<mapsto>]ls]; size Vs + max_varss es \<le> size ls \<rbrakk>
         \<Longrightarrow> \<exists>ls'. compP\<^sub>1 P \<turnstile>\<^sub>1 \<langle>compEs\<^sub>1 Vs es,(h,ls,sh)\<rangle> [\<Rightarrow>] \<langle>compEs\<^sub>1 Vs es',(h',ls',sh')\<rangle> \<and>
                      l' \<subseteq>\<^sub>m [Vs[\<mapsto>]ls'])"
(*<*)
  (is "_ \<Longrightarrow> (\<And>Vs ls. PROP ?Ps es h l sh es' h' l' sh' Vs ls)"
   is "_ \<Longrightarrow> (\<And>Vs ls. \<lbrakk> _; _; _\<rbrakk> \<Longrightarrow> \<exists>ls'. ?Posts es h l sh es' h' l' sh' Vs ls ls')")
proof (induct rule:eval_evals_inducts)
  case Nil thus ?case by(fastforce intro!:Nil\<^sub>1)
next
  case (Cons e h l sh v h' l' sh' es es' h\<^sub>2 l\<^sub>2 sh\<^sub>2)
  have "PROP ?P e h l sh (Val v) h' l' sh' Vs ls" by fact
  with Cons.prems
  obtain ls' where 1: "?Post e h l sh (Val v) h' l' sh' Vs ls ls'"
    "size ls = size ls'" by(auto intro!:eval\<^sub>1_preserves_len)
  have "PROP ?Ps es h' l' sh' es' h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls'" by fact
  with 1 Cons.prems
  obtain ls\<^sub>2 where 2: "?Posts es h' l' sh' es' h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls' ls\<^sub>2" by(auto)
  from 1 2 Cons show ?case by(auto intro!:Cons\<^sub>1)
next
  case ConsThrow thus ?case
    by(fastforce intro!:ConsThrow\<^sub>1 dest: eval_final)
next
  case (Block e h l V sh e' h' l' sh' T)
  let ?Vs = "Vs @ [V]"
  have IH:
  "\<lbrakk>fv e \<subseteq> set ?Vs; l(V := None) \<subseteq>\<^sub>m [?Vs [\<mapsto>] ls];
    size ?Vs + max_vars e \<le> size ls\<rbrakk>
   \<Longrightarrow> \<exists>ls'. compP\<^sub>1 P \<turnstile>\<^sub>1 \<langle>compE\<^sub>1 ?Vs e,(h,ls,sh)\<rangle> \<Rightarrow> \<langle>fin\<^sub>1 e',(h', ls',sh')\<rangle> \<and>
             l' \<subseteq>\<^sub>m [?Vs [\<mapsto>] ls']" and
  fv: "fv {V:T; e} \<subseteq> set Vs" and rel: "l \<subseteq>\<^sub>m [Vs [\<mapsto>] ls]" and
  len: "length Vs + max_vars {V:T; e} \<le> length ls" by fact+
  have len': "length Vs < length ls" using len by auto
  have "fv e \<subseteq> set ?Vs" using fv by auto
  moreover have "l(V := None) \<subseteq>\<^sub>m [?Vs [\<mapsto>] ls]" using rel len' by simp
  moreover have "size ?Vs + max_vars e \<le> size ls" using len by simp
  ultimately obtain ls' where
   1: "compP\<^sub>1 P \<turnstile>\<^sub>1 \<langle>compE\<^sub>1 ?Vs e,(h,ls,sh)\<rangle> \<Rightarrow> \<langle>fin\<^sub>1 e',(h',ls',sh')\<rangle>"
   and rel': "l' \<subseteq>\<^sub>m [?Vs [\<mapsto>] ls']" using IH by blast
  have [simp]: "length ls = length ls'" by(rule eval\<^sub>1_preserves_len[OF 1])
  show "\<exists>ls'. compP\<^sub>1 P \<turnstile>\<^sub>1 \<langle>compE\<^sub>1 Vs {V:T; e},(h,ls,sh)\<rangle> \<Rightarrow> \<langle>fin\<^sub>1 e',(h',ls',sh')\<rangle>
              \<and> l'(V := l V) \<subseteq>\<^sub>m [Vs [\<mapsto>] ls']" (is "\<exists>ls'. ?R ls'")
  proof
    show "?R ls'"
    proof
      show "compP\<^sub>1 P \<turnstile>\<^sub>1 \<langle>compE\<^sub>1 Vs {V:T; e},(h,ls,sh)\<rangle> \<Rightarrow> \<langle>fin\<^sub>1 e',(h',ls',sh')\<rangle>"
        using 1 by(simp add:Block\<^sub>1)
    next
      show "l'(V := l V) \<subseteq>\<^sub>m [Vs [\<mapsto>] ls']"
      proof -
        have "l' \<subseteq>\<^sub>m [Vs [\<mapsto>] ls', V \<mapsto> ls' ! length Vs]"
          using len' rel' by simp
        moreover
        { assume VinVs: "V \<in> set Vs"
          hence "hidden (Vs @ [V]) (last_index Vs V)"
            by(rule hidden_last_index)
          hence "unmod (compE\<^sub>1 (Vs @ [V]) e) (last_index Vs V)"
            by(rule hidden_unmod)
          moreover have "last_index Vs V < length ls"
            using len' VinVs by simp
          ultimately have "ls ! last_index Vs V = ls' ! last_index Vs V"
            by(rule eval\<^sub>1_preserves_unmod[OF 1])
        }
        ultimately show ?thesis using Block_lem[OF rel] len' by auto
      qed
    qed
  qed
next
  case (TryThrow e' h l sh a h' l' sh' D fs C V e\<^sub>2)
  have "PROP ?P e' h l sh (Throw a) h' l' sh' Vs ls" by fact
  with TryThrow.prems
  obtain ls' where 1: "?Post e' h l sh (Throw a) h' l' sh' Vs ls ls'"  by(auto)
  show ?case using 1 TryThrow.hyps by(auto intro!:eval\<^sub>1_evals\<^sub>1.TryThrow\<^sub>1)
next
  case (TryCatch e\<^sub>1 h l sh a h\<^sub>1 l\<^sub>1 sh\<^sub>1 D fs C e\<^sub>2 V e' h\<^sub>2 l\<^sub>2 sh\<^sub>2)
  let ?e = "try e\<^sub>1 catch(C V) e\<^sub>2"
  have IH\<^sub>1: "\<lbrakk>fv e\<^sub>1 \<subseteq> set Vs; l \<subseteq>\<^sub>m [Vs [\<mapsto>] ls];
              size Vs + max_vars e\<^sub>1 \<le> length ls\<rbrakk>
          \<Longrightarrow> \<exists>ls\<^sub>1. compP\<^sub>1 P \<turnstile>\<^sub>1 \<langle>compE\<^sub>1 Vs e\<^sub>1,(h,ls,sh)\<rangle> \<Rightarrow>
                                \<langle>fin\<^sub>1 (Throw a),(h\<^sub>1,ls\<^sub>1,sh\<^sub>1)\<rangle> \<and>
                    l\<^sub>1 \<subseteq>\<^sub>m [Vs [\<mapsto>] ls\<^sub>1]" and
    fv: "fv ?e \<subseteq> set Vs" and
    rel: "l \<subseteq>\<^sub>m [Vs [\<mapsto>] ls]" and
    len: "length Vs + max_vars ?e \<le> length ls" by fact+
  have "fv e\<^sub>1 \<subseteq> set Vs" using fv by auto
  moreover have "length Vs + max_vars e\<^sub>1 \<le> length ls" using len by(auto)
  ultimately obtain ls\<^sub>1 where
    1: "compP\<^sub>1 P \<turnstile>\<^sub>1 \<langle>compE\<^sub>1 Vs e\<^sub>1,(h,ls,sh)\<rangle> \<Rightarrow> \<langle>Throw a,(h\<^sub>1,ls\<^sub>1,sh\<^sub>1)\<rangle>"
    and rel\<^sub>1: "l\<^sub>1 \<subseteq>\<^sub>m [Vs [\<mapsto>] ls\<^sub>1]" using IH\<^sub>1 rel by fastforce
  from 1 have [simp]: "size ls = size ls\<^sub>1" by(rule eval\<^sub>1_preserves_len)
  let ?Vs = "Vs @ [V]" let ?ls = "(ls\<^sub>1[size Vs:=Addr a])"
  have IH\<^sub>2: "\<lbrakk>fv e\<^sub>2 \<subseteq> set ?Vs; l\<^sub>1(V \<mapsto> Addr a) \<subseteq>\<^sub>m [?Vs [\<mapsto>] ?ls];
              length ?Vs + max_vars e\<^sub>2 \<le> length ?ls\<rbrakk> \<Longrightarrow> \<exists>ls\<^sub>2.
       compP\<^sub>1 P \<turnstile>\<^sub>1 \<langle>compE\<^sub>1 ?Vs e\<^sub>2,(h\<^sub>1,?ls,sh\<^sub>1)\<rangle> \<Rightarrow> \<langle>fin\<^sub>1 e',(h\<^sub>2, ls\<^sub>2, sh\<^sub>2)\<rangle> \<and>
       l\<^sub>2 \<subseteq>\<^sub>m [?Vs [\<mapsto>] ls\<^sub>2]" by fact
  have len\<^sub>1: "size Vs < size ls\<^sub>1" using len by(auto)
  have "fv e\<^sub>2 \<subseteq> set ?Vs" using fv by auto
  moreover have "l\<^sub>1(V \<mapsto> Addr a) \<subseteq>\<^sub>m [?Vs [\<mapsto>] ?ls]" using rel\<^sub>1 len\<^sub>1 by simp
  moreover have "length ?Vs + max_vars e\<^sub>2 \<le> length ?ls" using len by(auto)
  ultimately obtain ls\<^sub>2 where
    2: "compP\<^sub>1 P \<turnstile>\<^sub>1 \<langle>compE\<^sub>1 ?Vs e\<^sub>2,(h\<^sub>1,?ls,sh\<^sub>1)\<rangle> \<Rightarrow> \<langle>fin\<^sub>1 e',(h\<^sub>2, ls\<^sub>2, sh\<^sub>2)\<rangle>"
    and rel\<^sub>2: "l\<^sub>2 \<subseteq>\<^sub>m [?Vs [\<mapsto>] ls\<^sub>2]"  using IH\<^sub>2 by blast
  from 2 have [simp]: "size ls\<^sub>1 = size ls\<^sub>2"
    by(fastforce dest: eval\<^sub>1_preserves_len)
  show "\<exists>ls\<^sub>2. compP\<^sub>1 P \<turnstile>\<^sub>1 \<langle>compE\<^sub>1 Vs ?e,(h,ls,sh)\<rangle> \<Rightarrow> \<langle>fin\<^sub>1 e',(h\<^sub>2,ls\<^sub>2,sh\<^sub>2)\<rangle> \<and>
              l\<^sub>2(V := l\<^sub>1 V) \<subseteq>\<^sub>m [Vs [\<mapsto>] ls\<^sub>2]"  (is "\<exists>ls\<^sub>2. ?R ls\<^sub>2")
  proof
    show "?R ls\<^sub>2"
    proof
      have hp: "h\<^sub>1 a = Some (D, fs)" by fact
      have "P \<turnstile> D \<preceq>\<^sup>* C" by fact hence caught: "compP\<^sub>1 P \<turnstile> D \<preceq>\<^sup>* C" by simp
      from TryCatch\<^sub>1[OF 1 _ caught len\<^sub>1 2, OF hp]
      show "compP\<^sub>1 P \<turnstile>\<^sub>1 \<langle>compE\<^sub>1 Vs ?e,(h,ls,sh)\<rangle> \<Rightarrow> \<langle>fin\<^sub>1 e',(h\<^sub>2,ls\<^sub>2,sh\<^sub>2)\<rangle>" by simp
    next
      show "l\<^sub>2(V := l\<^sub>1 V) \<subseteq>\<^sub>m [Vs [\<mapsto>] ls\<^sub>2]"
      proof -
        have "l\<^sub>2 \<subseteq>\<^sub>m [Vs [\<mapsto>] ls\<^sub>2, V \<mapsto> ls\<^sub>2 ! length Vs]"
          using len\<^sub>1 rel\<^sub>2 by simp
        moreover
        { assume VinVs: "V \<in> set Vs"
          hence "hidden (Vs @ [V]) (last_index Vs V)" by(rule hidden_last_index)
          hence "unmod (compE\<^sub>1 (Vs @ [V]) e\<^sub>2) (last_index Vs V)"
            by(rule hidden_unmod)
          moreover have "last_index Vs V < length ?ls"
            using len\<^sub>1 VinVs by simp
          ultimately have "?ls ! last_index Vs V = ls\<^sub>2 ! last_index Vs V"
            by(rule eval\<^sub>1_preserves_unmod[OF 2])
          moreover have "last_index Vs V < size Vs" using VinVs by simp
          ultimately have "ls\<^sub>1 ! last_index Vs V = ls\<^sub>2 ! last_index Vs V"
            using len\<^sub>1 by(simp del:size_last_index_conv)
        }
        ultimately show ?thesis using Block_lem[OF rel\<^sub>1] len\<^sub>1  by simp
      qed
    qed
  qed
next
  case Try thus ?case by(fastforce intro!:Try\<^sub>1)
next
  case Throw thus ?case by(fastforce intro!:Throw\<^sub>1)
next
  case ThrowNull thus ?case by(fastforce intro!:ThrowNull\<^sub>1)
next
  case ThrowThrow thus ?case  by(fastforce intro!:ThrowThrow\<^sub>1)
next
  case (CondT e h l sh h\<^sub>1 l\<^sub>1 sh\<^sub>1 e\<^sub>1 e' h\<^sub>2 l\<^sub>2 sh\<^sub>2 e\<^sub>2)
  have "PROP ?P e h l sh true h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls" by fact
  with CondT.prems
  obtain ls\<^sub>1 where 1: "?Post e h l sh true h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls ls\<^sub>1"
    "size ls = size ls\<^sub>1"  by(auto intro!:eval\<^sub>1_preserves_len)
  have "PROP ?P e\<^sub>1 h\<^sub>1 l\<^sub>1 sh\<^sub>1 e' h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1" by fact
  with 1 CondT.prems
  obtain ls\<^sub>2 where 2: "?Post e\<^sub>1 h\<^sub>1 l\<^sub>1 sh\<^sub>1 e' h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1 ls\<^sub>2"  by(auto)
  from 1 2 show ?case by(auto intro!:CondT\<^sub>1)
next
  case (CondF e h l sh h\<^sub>1 l\<^sub>1 sh\<^sub>1 e\<^sub>2 e' h\<^sub>2 l\<^sub>2 sh\<^sub>2 e\<^sub>1 Vs ls)
  have "PROP ?P e h l sh false h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls" by fact
  with CondF.prems
  obtain ls\<^sub>1 where 1: "?Post e h l sh false h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls ls\<^sub>1"
    "size ls = size ls\<^sub>1"  by(auto intro!:eval\<^sub>1_preserves_len)
  have "PROP ?P e\<^sub>2 h\<^sub>1 l\<^sub>1 sh\<^sub>1 e' h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1" by fact
  with 1 CondF.prems
  obtain ls\<^sub>2 where 2: "?Post e\<^sub>2 h\<^sub>1 l\<^sub>1 sh\<^sub>1 e' h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1 ls\<^sub>2"  by(auto)
  from 1 2 show ?case by(auto intro!:CondF\<^sub>1)
next
  case CondThrow thus ?case by(fastforce intro!:CondThrow\<^sub>1)
next
  case (Seq e h l sh v h\<^sub>1 l\<^sub>1 sh\<^sub>1 e\<^sub>1 e' h\<^sub>2 l\<^sub>2 sh\<^sub>2)
  have "PROP ?P e h l sh (Val v) h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls" by fact
  with Seq.prems
  obtain ls\<^sub>1 where 1: "?Post e h l sh (Val v) h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls ls\<^sub>1"
    "size ls = size ls\<^sub>1"  by(auto intro!:eval\<^sub>1_preserves_len)
  have "PROP ?P e\<^sub>1 h\<^sub>1 l\<^sub>1 sh\<^sub>1 e' h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1" by fact
  with 1 Seq.prems
  obtain ls\<^sub>2 where 2: "?Post e\<^sub>1 h\<^sub>1 l\<^sub>1 sh\<^sub>1 e' h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1 ls\<^sub>2"  by(auto)
  from 1 2 Seq show ?case by(auto intro!:Seq\<^sub>1)
next
  case SeqThrow thus ?case by(fastforce intro!:SeqThrow\<^sub>1)
next
  case WhileF thus ?case by(fastforce intro!:eval\<^sub>1_evals\<^sub>1.intros)
next
  case (WhileT e h l sh h\<^sub>1 l\<^sub>1 sh\<^sub>1 c v h\<^sub>2 l\<^sub>2 sh\<^sub>2 e' h\<^sub>3 l\<^sub>3 sh\<^sub>3)
  have "PROP ?P e h l sh true h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls" by fact
  with WhileT.prems
  obtain ls\<^sub>1 where 1: "?Post e h l sh true h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls ls\<^sub>1"
    "size ls = size ls\<^sub>1"   by(auto intro!:eval\<^sub>1_preserves_len)
  have "PROP ?P c h\<^sub>1 l\<^sub>1 sh\<^sub>1 (Val v) h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1" by fact
  with 1 WhileT.prems
  obtain ls\<^sub>2 where 2: "?Post c h\<^sub>1 l\<^sub>1 sh\<^sub>1 (Val v) h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1 ls\<^sub>2"
    "size ls\<^sub>1 = size ls\<^sub>2"    by(auto intro!:eval\<^sub>1_preserves_len)
  have "PROP ?P (While (e) c) h\<^sub>2 l\<^sub>2 sh\<^sub>2 e' h\<^sub>3 l\<^sub>3 sh\<^sub>3 Vs ls\<^sub>2" by fact
  with 1 2 WhileT.prems
  obtain ls\<^sub>3 where 3: "?Post (While (e) c) h\<^sub>2 l\<^sub>2 sh\<^sub>2 e' h\<^sub>3 l\<^sub>3 sh\<^sub>3 Vs ls\<^sub>2 ls\<^sub>3" by(auto)
  from 1 2 3 show ?case by(auto intro!:WhileT\<^sub>1)
next
  case (WhileBodyThrow e h l sh h\<^sub>1 l\<^sub>1 sh\<^sub>1 c e' h\<^sub>2 l\<^sub>2 sh\<^sub>2)
  have "PROP ?P e h l sh true h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls" by fact
  with WhileBodyThrow.prems
  obtain ls\<^sub>1 where 1: "?Post e h l sh true h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls ls\<^sub>1"
    "size ls = size ls\<^sub>1"    by(auto intro!:eval\<^sub>1_preserves_len)
  have "PROP ?P c h\<^sub>1 l\<^sub>1 sh\<^sub>1 (throw e') h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1" by fact
  with 1 WhileBodyThrow.prems
  obtain ls\<^sub>2 where 2: "?Post c h\<^sub>1 l\<^sub>1 sh\<^sub>1 (throw e') h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1 ls\<^sub>2" by auto
  from 1 2 show ?case by(auto intro!:WhileBodyThrow\<^sub>1)
next
  case WhileCondThrow thus ?case by(fastforce intro!:WhileCondThrow\<^sub>1)
next
  case New thus ?case by(fastforce intro:eval\<^sub>1_evals\<^sub>1.intros)
next
  case NewFail thus ?case by(fastforce intro:eval\<^sub>1_evals\<^sub>1.intros)
next
  case NewInit then show ?case by(fastforce intro:eval\<^sub>1_evals\<^sub>1.intros)
next
  case NewInitOOM then show ?case by(fastforce intro:eval\<^sub>1_evals\<^sub>1.intros)
next
  case NewInitThrow then show ?case by(fastforce intro:eval\<^sub>1_evals\<^sub>1.intros)
next
  case Cast thus ?case by(fastforce intro:eval\<^sub>1_evals\<^sub>1.intros)
next
  case CastNull thus ?case by(fastforce intro:eval\<^sub>1_evals\<^sub>1.intros)
next
  case CastThrow thus ?case by(fastforce intro:eval\<^sub>1_evals\<^sub>1.intros)
next
  case (CastFail e h l sh a h\<^sub>1 l\<^sub>1 sh\<^sub>1 D fs C)
  have "PROP ?P e h l sh (addr a) h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls" by fact
  with CastFail.prems
  obtain ls\<^sub>1 where 1: "?Post e h l sh (addr a) h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls ls\<^sub>1" by auto
  show ?case using 1 CastFail.hyps
    by(auto intro!:CastFail\<^sub>1[where D=D])
next
  case Val thus ?case by(fastforce intro:eval\<^sub>1_evals\<^sub>1.intros)
next
  case (BinOp e h l sh v\<^sub>1 h\<^sub>1 l\<^sub>1 sh\<^sub>1 e\<^sub>1 v\<^sub>2 h\<^sub>2 l\<^sub>2 sh\<^sub>2 bop v)
  have "PROP ?P e h l sh (Val v\<^sub>1) h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls" by fact
  with BinOp.prems
  obtain ls\<^sub>1 where 1: "?Post e h l sh (Val v\<^sub>1) h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls ls\<^sub>1"
    "size ls = size ls\<^sub>1"    by(auto intro!:eval\<^sub>1_preserves_len)
  have "PROP ?P e\<^sub>1 h\<^sub>1 l\<^sub>1 sh\<^sub>1 (Val v\<^sub>2) h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1" by fact
  with 1 BinOp.prems
  obtain ls\<^sub>2 where 2: "?Post e\<^sub>1 h\<^sub>1 l\<^sub>1 sh\<^sub>1 (Val v\<^sub>2) h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1 ls\<^sub>2"  by(auto)
  from 1 2 BinOp show ?case by(auto intro!:BinOp\<^sub>1)
next
  case (BinOpThrow2 e\<^sub>0 h l sh v\<^sub>1 h\<^sub>1 l\<^sub>1 sh\<^sub>1 e\<^sub>1 e h\<^sub>2 l\<^sub>2 sh\<^sub>2 bop)
  have "PROP ?P e\<^sub>0 h l sh (Val v\<^sub>1) h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls" by fact
  with BinOpThrow2.prems
  obtain ls\<^sub>1 where 1: "?Post e\<^sub>0 h l sh (Val v\<^sub>1) h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls ls\<^sub>1"
    "size ls = size ls\<^sub>1"    by(auto intro!:eval\<^sub>1_preserves_len)
  have "PROP ?P e\<^sub>1 h\<^sub>1 l\<^sub>1 sh\<^sub>1 (throw e) h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1" by fact
  with 1 BinOpThrow2.prems
  obtain ls\<^sub>2 where 2: "?Post e\<^sub>1 h\<^sub>1 l\<^sub>1 sh\<^sub>1 (throw e) h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1 ls\<^sub>2"  by(auto)
  from 1 2 BinOpThrow2 show ?case by(auto intro!:BinOpThrow\<^sub>2\<^sub>1)
next
  case BinOpThrow1 thus ?case  by(fastforce intro!:eval\<^sub>1_evals\<^sub>1.intros)
next
  case Var thus ?case
    by(force intro!:Var\<^sub>1 simp add: map_le_def fun_upds_apply)
next
  case LAss thus ?case
    by(fastforce simp add: LAss_lem intro:eval\<^sub>1_evals\<^sub>1.intros
                dest:eval\<^sub>1_preserves_len)
next
  case LAssThrow thus ?case by(fastforce intro:eval\<^sub>1_evals\<^sub>1.intros)
next
  case FAcc thus ?case by(fastforce intro:eval\<^sub>1_evals\<^sub>1.intros)
next
  case FAccNull thus ?case by(fastforce intro:eval\<^sub>1_evals\<^sub>1.intros)
next
  case FAccThrow thus ?case by(fastforce intro:eval\<^sub>1_evals\<^sub>1.intros)
next
  case (FAccNone e h l sh a h' l' sh' C fs F D)
  have "PROP ?P e h l sh (addr a) h' l' sh' Vs ls" by fact
  with FAccNone.prems
  obtain ls\<^sub>2 where 2: "?Post e h l sh (addr a) h' l' sh' Vs ls ls\<^sub>2" by(auto)
  from 2 FAccNone show ?case by(rule_tac x = ls\<^sub>2 in exI, auto elim!: FAccNone\<^sub>1)
next
  case (FAccStatic e h l sh a h' l' sh' C fs F t D)
  have "PROP ?P e h l sh (addr a) h' l' sh' Vs ls" by fact
  with FAccStatic.prems
  obtain ls\<^sub>2 where 2: "?Post e h l sh (addr a) h' l' sh' Vs ls ls\<^sub>2" by(auto)
  from 2 FAccStatic show ?case by(rule_tac x = ls\<^sub>2 in exI, auto elim!: FAccStatic\<^sub>1)
next
  case SFAcc then show ?case by(fastforce intro:eval\<^sub>1_evals\<^sub>1.intros)
next
  case (SFAccInit C F t D sh h l v' h' l' sh' sfs i v)
  have "PROP ?P (INIT D ([D],False) \<leftarrow> unit) h l sh (Val v') h' l' sh' Vs ls" by fact
  with SFAccInit.prems
  obtain ls\<^sub>2 where 1: "?Post (INIT D ([D],False) \<leftarrow> unit) h l sh (Val v') h' l' sh' Vs ls ls\<^sub>2" by(auto)
  from 1 SFAccInit show ?case by(rule_tac x = ls\<^sub>2 in exI, auto intro: SFAccInit\<^sub>1)
next
  case (SFAccInitThrow C F t D sh h l a h' l' sh')
  have "PROP ?P (INIT D ([D],False) \<leftarrow> unit) h l sh (throw a) h' l' sh' Vs ls" by fact
  with SFAccInitThrow.prems
  obtain ls\<^sub>2 where 1: "?Post (INIT D ([D],False) \<leftarrow> unit) h l sh (throw a) h' l' sh' Vs ls ls\<^sub>2" by(auto)
  from 1 SFAccInitThrow show ?case by(rule_tac x = ls\<^sub>2 in exI, auto intro: SFAccInitThrow\<^sub>1)
next
  case SFAccNone then show ?case by(fastforce intro:eval\<^sub>1_evals\<^sub>1.intros)
next
  case SFAccNonStatic then show ?case by(fastforce intro:eval\<^sub>1_evals\<^sub>1.intros)
next
  case (FAss e\<^sub>1 h l sh a h\<^sub>1 l\<^sub>1 sh\<^sub>1 e\<^sub>2 v h\<^sub>2 l\<^sub>2 sh\<^sub>2 C fs fs' F D h\<^sub>2')
  have "PROP ?P e\<^sub>1 h l sh (addr a) h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls" by fact
  with FAss.prems
  obtain ls\<^sub>1 where 1: "?Post e\<^sub>1 h l sh (addr a) h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls ls\<^sub>1"
    "size ls = size ls\<^sub>1"    by(auto intro!:eval\<^sub>1_preserves_len)
  have "PROP ?P e\<^sub>2 h\<^sub>1 l\<^sub>1 sh\<^sub>1 (Val v) h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1" by fact
  with 1 FAss.prems
  obtain ls\<^sub>2 where 2: "?Post e\<^sub>2 h\<^sub>1 l\<^sub>1 sh\<^sub>1 (Val v) h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1 ls\<^sub>2"  by(auto)
  from 1 2 FAss show ?case by(auto intro!:FAss\<^sub>1)
next
  case (FAssNull e\<^sub>1 h l sh h\<^sub>1 l\<^sub>1 sh\<^sub>1 e\<^sub>2 v h\<^sub>2 l\<^sub>2 sh\<^sub>2 F D)
  have "PROP ?P e\<^sub>1 h l sh null h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls" by fact
  with FAssNull.prems
  obtain ls\<^sub>1 where 1: "?Post e\<^sub>1 h l sh null h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls ls\<^sub>1"
    "size ls = size ls\<^sub>1"    by(auto intro!:eval\<^sub>1_preserves_len)
  have "PROP ?P e\<^sub>2 h\<^sub>1 l\<^sub>1 sh\<^sub>1 (Val v) h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1" by fact
  with 1 FAssNull.prems
  obtain ls\<^sub>2 where 2: "?Post e\<^sub>2 h\<^sub>1 l\<^sub>1 sh\<^sub>1 (Val v) h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1 ls\<^sub>2" by(auto)
  from 1 2 FAssNull show ?case by(auto intro!:FAssNull\<^sub>1)
next
  case FAssThrow1 thus ?case by(fastforce intro:eval\<^sub>1_evals\<^sub>1.intros)
next
  case (FAssThrow2 e\<^sub>1 h l sh v h\<^sub>1 l\<^sub>1 sh\<^sub>1 e\<^sub>2 e h\<^sub>2 l\<^sub>2 sh\<^sub>2 F D)
  have "PROP ?P e\<^sub>1 h l sh (Val v) h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls" by fact
  with FAssThrow2.prems
  obtain ls\<^sub>1 where 1: "?Post e\<^sub>1 h l sh (Val v) h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls ls\<^sub>1"
    "size ls = size ls\<^sub>1"   by(auto intro!:eval\<^sub>1_preserves_len)
  have "PROP ?P e\<^sub>2 h\<^sub>1 l\<^sub>1 sh\<^sub>1 (throw e) h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1" by fact
  with 1 FAssThrow2.prems
  obtain ls\<^sub>2 where 2: "?Post e\<^sub>2 h\<^sub>1 l\<^sub>1 sh\<^sub>1 (throw e) h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1 ls\<^sub>2"  by(auto)
  from 1 2 FAssThrow2 show ?case by(auto intro!:FAssThrow\<^sub>2\<^sub>1)
next
  case (FAssNone e\<^sub>1 h l sh a h' l' sh' e\<^sub>2 v h\<^sub>2 l\<^sub>2 sh\<^sub>2 C fs F D)
  have "PROP ?P e\<^sub>1 h l sh (addr a) h' l' sh' Vs ls" by fact
  with FAssNone.prems
  obtain ls\<^sub>1 where 1: "?Post e\<^sub>1 h l sh (addr a) h' l' sh' Vs ls ls\<^sub>1"
    "size ls = size ls\<^sub>1"   by(auto intro!:eval\<^sub>1_preserves_len)
  have "PROP ?P e\<^sub>2 h' l' sh' (Val v) h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1" by fact
  with 1 FAssNone.prems
  obtain ls\<^sub>2 where 2: "?Post e\<^sub>2 h' l' sh' (Val v) h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1 ls\<^sub>2"  by(auto)
  from 1 2 FAssNone show ?case by(auto intro!:FAssNone\<^sub>1)
next
  case (FAssStatic e\<^sub>1 h l sh a h' l' sh' e\<^sub>2 v h\<^sub>2 l\<^sub>2 sh\<^sub>2 C fs F t D)
  have "PROP ?P e\<^sub>1 h l sh (addr a) h' l' sh' Vs ls" by fact
  with FAssStatic.prems
  obtain ls\<^sub>1 where 1: "?Post e\<^sub>1 h l sh (addr a) h' l' sh' Vs ls ls\<^sub>1"
    "size ls = size ls\<^sub>1"   by(auto intro!:eval\<^sub>1_preserves_len)
  have "PROP ?P e\<^sub>2 h' l' sh' (Val v) h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1" by fact
  with 1 FAssStatic.prems
  obtain ls\<^sub>2 where 2: "?Post e\<^sub>2 h' l' sh' (Val v) h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1 ls\<^sub>2"  by(auto)
  from 1 2 FAssStatic show ?case by(auto intro!:FAssStatic\<^sub>1)
next
  case SFAss then show ?case by(fastforce intro:eval\<^sub>1_evals\<^sub>1.intros)
next
  case (SFAssInit e\<^sub>2 h l sh v h\<^sub>1 l\<^sub>1 sh\<^sub>1 C F t D v' h' l' sh' sfs i sfs' sh'')
  have "PROP ?P e\<^sub>2 h l sh (Val v) h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls" by fact
  with SFAssInit.prems
  obtain ls\<^sub>1 where 1: "?Post e\<^sub>2 h l sh (Val v) h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls ls\<^sub>1" "length ls = length ls\<^sub>1"
    by(auto intro!:eval\<^sub>1_preserves_len)
  then have Init_size: "length Vs \<le> length ls\<^sub>1" using SFAssInit.prems(3) by linarith
  have "PROP ?P (INIT D ([D],False) \<leftarrow> unit) h\<^sub>1 l\<^sub>1 sh\<^sub>1 (Val v') h' l' sh' Vs ls\<^sub>1" by fact
  with 1 Init_size SFAssInit.prems
  obtain ls\<^sub>2 where 2: "?Post (INIT D ([D],False) \<leftarrow> unit) h\<^sub>1 l\<^sub>1 sh\<^sub>1 (Val v') h' l' sh' Vs ls\<^sub>1 ls\<^sub>2"
    by auto
  from 1 2 SFAssInit show ?case
    by(auto simp add: comp_def
                intro!: SFAssInit\<^sub>1 dest!:evals_final)
next
  case (SFAssInitThrow e\<^sub>2 h l sh v h\<^sub>1 l\<^sub>1 sh\<^sub>1 C F t D a h\<^sub>2 l\<^sub>2 sh\<^sub>2)
  have "PROP ?P e\<^sub>2 h l sh (Val v) h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls" by fact
  with SFAssInitThrow.prems
  obtain ls\<^sub>1 where 1: "?Post e\<^sub>2 h l sh (Val v) h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls ls\<^sub>1" "length ls = length ls\<^sub>1"
    by(auto intro!:eval\<^sub>1_preserves_len)
  then have Init_size: "length Vs \<le> length ls\<^sub>1" using SFAssInitThrow.prems(3) by linarith
  have "PROP ?P (INIT D ([D],False) \<leftarrow> unit) h\<^sub>1 l\<^sub>1 sh\<^sub>1 (throw a) h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1" by fact
  with 1 Init_size SFAssInitThrow.prems
  obtain ls\<^sub>2 where 2: "?Post (INIT D ([D],False) \<leftarrow> unit) h\<^sub>1 l\<^sub>1 sh\<^sub>1 (throw a) h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1 ls\<^sub>2"
    by auto
  from 1 2 SFAssInitThrow show ?case
    by(auto simp add: comp_def
                intro!: SFAssInitThrow\<^sub>1 dest!:evals_final)
next
  case SFAssThrow then show ?case by(fastforce intro:eval\<^sub>1_evals\<^sub>1.intros)
next
  case (SFAssNone e\<^sub>2 h l sh v h\<^sub>2 l\<^sub>2 sh\<^sub>2 C F D)
  have "PROP ?P e\<^sub>2 h l sh (Val v) h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls" by fact
  with SFAssNone.prems
  obtain ls\<^sub>2 where 2: "?Post e\<^sub>2 h l sh (Val v) h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls ls\<^sub>2" by(auto)
  from 2 SFAssNone show ?case by(rule_tac x = ls\<^sub>2 in exI, auto elim!: SFAssNone\<^sub>1)
next
  case SFAssNonStatic then show ?case by(fastforce intro:eval\<^sub>1_evals\<^sub>1.intros)
next
  case (CallNull e h l sh h\<^sub>1 l\<^sub>1 sh\<^sub>1 es vs h\<^sub>2 l\<^sub>2 sh\<^sub>2 M)
  have "PROP ?P e h l sh null h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls" by fact
  with CallNull.prems
  obtain ls\<^sub>1 where 1: "?Post e h l sh null h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls ls\<^sub>1"
    "size ls = size ls\<^sub>1"    by(auto intro!:eval\<^sub>1_preserves_len)
  have "PROP ?Ps es h\<^sub>1 l\<^sub>1 sh\<^sub>1 (map Val vs) h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1" by fact
  with 1 CallNull.prems
  obtain ls\<^sub>2 where 2: "?Posts es h\<^sub>1 l\<^sub>1 sh\<^sub>1 (map Val vs) h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1 ls\<^sub>2" by(auto)
  from 1 2 CallNull show ?case
    by (auto simp add: comp_def elim!: CallNull\<^sub>1)
next
  case CallObjThrow thus ?case  by(fastforce intro:eval\<^sub>1_evals\<^sub>1.intros)
next
  case (CallParamsThrow e h l sh v h\<^sub>1 l\<^sub>1 sh\<^sub>1 es vs ex es' h\<^sub>2 l\<^sub>2 sh\<^sub>2 M)
  have "PROP ?P e h l sh (Val v) h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls" by fact
  with CallParamsThrow.prems
  obtain ls\<^sub>1 where 1: "?Post e h l sh (Val v) h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls ls\<^sub>1"
    "size ls = size ls\<^sub>1"    by(auto intro!:eval\<^sub>1_preserves_len)
  have "PROP ?Ps es h\<^sub>1 l\<^sub>1 sh\<^sub>1 (map Val vs @ throw ex # es') h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1" by fact
  with 1 CallParamsThrow.prems
  obtain ls\<^sub>2 where 2: "?Posts es h\<^sub>1 l\<^sub>1 sh\<^sub>1 (map Val vs @ throw ex # es') h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1 ls\<^sub>2" by(auto)
  from 1 2 CallParamsThrow show ?case
    by (auto simp add: comp_def
             elim!: CallParamsThrow\<^sub>1 dest!:evals_final)
next
  case (CallNone e h l sh a h\<^sub>1 l\<^sub>1 sh\<^sub>1 ps vs h\<^sub>2 l\<^sub>2 sh\<^sub>2 C fs M)
  have "PROP ?P e h l sh (addr a) h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls" by fact
  with CallNone.prems
  obtain ls\<^sub>1 where 1: "?Post e h l sh (addr a) h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls ls\<^sub>1"
    "size ls = size ls\<^sub>1"    by(auto intro!:eval\<^sub>1_preserves_len)
  have "PROP ?Ps ps h\<^sub>1 l\<^sub>1 sh\<^sub>1 (map Val vs) h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1" by fact
  with 1 CallNone.prems
  obtain ls\<^sub>2 where 2: "?Posts ps h\<^sub>1 l\<^sub>1 sh\<^sub>1 (map Val vs) h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1 ls\<^sub>2" by(auto)
  from 1 2 CallNone show ?case
    by (auto simp add: comp_def
             elim!: CallNone\<^sub>1 dest!:evals_final sees_method_compPD)
next
  case (CallStatic e h l sh a h\<^sub>1 l\<^sub>1 sh\<^sub>1 ps vs h\<^sub>2 l\<^sub>2 sh\<^sub>2 C fs M Ts T pns body D)
  have "PROP ?P e h l sh (addr a) h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls" by fact
  with CallStatic.prems
  obtain ls\<^sub>1 where 1: "?Post e h l sh (addr a) h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls ls\<^sub>1"
    "size ls = size ls\<^sub>1"    by(auto intro!:eval\<^sub>1_preserves_len)
  let ?Vs = pns
  have mdecl: "P \<turnstile> C sees M,Static: Ts\<rightarrow>T = (pns, body) in D" by fact
  have mdecl\<^sub>1: "compP\<^sub>1 P \<turnstile> C sees M,Static: Ts\<rightarrow>T = (compE\<^sub>1 ?Vs body) in D"
    using sees_method_compP[OF mdecl, of "\<lambda>b (pns,e). compE\<^sub>1 (case b of NonStatic \<Rightarrow> this#pns | Static \<Rightarrow> pns) e"]
    by(simp)
  have "PROP ?Ps ps h\<^sub>1 l\<^sub>1 sh\<^sub>1 (map Val vs) h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1" by fact
  with 1 CallStatic.prems
  obtain ls\<^sub>2 where 2: "?Posts ps h\<^sub>1 l\<^sub>1 sh\<^sub>1 (map Val vs) h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1 ls\<^sub>2" by(auto)
  from 1 2 mdecl\<^sub>1 CallStatic show ?case
    by (auto simp add: comp_def
             elim!: CallStatic\<^sub>1 dest!:evals_final)
next
  case (Call e h l sh a h\<^sub>1 l\<^sub>1 sh\<^sub>1 es vs h\<^sub>2 l\<^sub>2 sh\<^sub>2 C fs M Ts T pns body D l\<^sub>2' b' h\<^sub>3 l\<^sub>3 sh\<^sub>3)
  have "PROP ?P e h l sh (addr a) h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls" by fact
  with Call.prems
  obtain ls\<^sub>1 where 1: "?Post e h l sh (addr a) h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls ls\<^sub>1"
    "size ls = size ls\<^sub>1"    by(auto intro!:eval\<^sub>1_preserves_len)
  have "PROP ?Ps es h\<^sub>1 l\<^sub>1 sh\<^sub>1 (map Val vs) h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1" by fact
  with 1 Call.prems
  obtain ls\<^sub>2 where 2: "?Posts es h\<^sub>1 l\<^sub>1 sh\<^sub>1 (map Val vs) h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1 ls\<^sub>2"
    "size ls\<^sub>1 = size ls\<^sub>2"    by(auto intro!:evals\<^sub>1_preserves_len)
  let ?Vs = "this#pns"
  let ?ls = "Addr a # vs @ replicate (max_vars body) undefined"
  have mdecl: "P \<turnstile> C sees M,NonStatic: Ts\<rightarrow>T = (pns, body) in D" by fact
  have fv_body: "fv body \<subseteq> set ?Vs" and wf_size: "size Ts = size pns"
    using wf mdecl by(auto dest!:sees_wf_mdecl simp:wf_mdecl_def)
  have mdecl\<^sub>1: "compP\<^sub>1 P \<turnstile> C sees M,NonStatic: Ts\<rightarrow>T = (compE\<^sub>1 ?Vs body) in D"
    using sees_method_compP[OF mdecl, of "\<lambda>b (pns,e). compE\<^sub>1 (case b of NonStatic \<Rightarrow> this#pns | Static \<Rightarrow> pns) e"]
    by(simp)
  have [simp]: "l\<^sub>2' = [this \<mapsto> Addr a, pns [\<mapsto>] vs]" by fact
  have Call_size: "size vs = size pns" by fact
  have "PROP ?P body h\<^sub>2 l\<^sub>2' sh\<^sub>2 b' h\<^sub>3 l\<^sub>3 sh\<^sub>3 ?Vs ?ls" by fact
  with 1 2 fv_body Call_size Call.prems
  obtain ls\<^sub>3 where 3: "?Post body h\<^sub>2 l\<^sub>2' sh\<^sub>2 b' h\<^sub>3 l\<^sub>3 sh\<^sub>3 ?Vs ?ls ls\<^sub>3"  by(auto)
  have hp: "h\<^sub>2 a = Some (C, fs)" by fact
  from 1 2 3 hp mdecl\<^sub>1 wf_size Call_size show ?case
    by(fastforce simp add: comp_def
                intro!: Call\<^sub>1 dest!:evals_final)
next
  case (SCallParamsThrow es h l sh vs ex es' h\<^sub>2 l\<^sub>2 sh\<^sub>2 C M)
  have "PROP ?Ps es h l sh (map Val vs @ throw ex # es') h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls" by fact
  with SCallParamsThrow.prems
  obtain ls\<^sub>2 where 2: "?Posts es h l sh (map Val vs @ throw ex # es') h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls ls\<^sub>2" by(auto)
  from 2 SCallParamsThrow show ?case
    by (fastforce simp add: comp_def
             elim!: SCallParamsThrow\<^sub>1 dest!:evals_final)
next
  case (SCall ps h l sh vs h\<^sub>2 l\<^sub>2 sh\<^sub>2 C M Ts T pns body D sfs l\<^sub>2' e' h\<^sub>3 l\<^sub>3 sh\<^sub>3)
  have "PROP ?Ps ps h l sh (map Val vs) h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls" by fact
  with SCall.prems
  obtain ls\<^sub>2 where 2: "?Posts ps h l sh (map Val vs) h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls ls\<^sub>2"
    "size ls = size ls\<^sub>2"    by(auto intro!:evals\<^sub>1_preserves_len)
  let ?Vs = "pns"
  let ?ls = "vs @ replicate (max_vars body) undefined"
  have mdecl: "P \<turnstile> C sees M,Static: Ts\<rightarrow>T = (pns, body) in D" by fact
  have fv_body: "fv body \<subseteq> set ?Vs" and wf_size: "size Ts = size pns"
    using wf mdecl by(auto dest!:sees_wf_mdecl simp:wf_mdecl_def)
  have mdecl\<^sub>1: "compP\<^sub>1 P \<turnstile> C sees M,Static: Ts\<rightarrow>T = (compE\<^sub>1 ?Vs body) in D"
    using sees_method_compP[OF mdecl, of "\<lambda>b (pns,e). compE\<^sub>1 (case b of NonStatic \<Rightarrow> this#pns | Static \<Rightarrow> pns) e"]
    by(simp)
  have [simp]: "l\<^sub>2' = [pns [\<mapsto>] vs]" by fact
  have SCall_size: "size vs = size pns" by fact
  have "PROP ?P body h\<^sub>2 l\<^sub>2' sh\<^sub>2 e' h\<^sub>3 l\<^sub>3 sh\<^sub>3 ?Vs ?ls" by fact
  with 2 fv_body SCall_size SCall.prems
  obtain ls\<^sub>3 where 3: "?Post body h\<^sub>2 l\<^sub>2' sh\<^sub>2 e' h\<^sub>3 l\<^sub>3 sh\<^sub>3 ?Vs ?ls ls\<^sub>3"  by(auto)
  have shp: "sh\<^sub>2 D = \<lfloor>(sfs, Done)\<rfloor> \<or> M = clinit \<and> sh\<^sub>2 D = \<lfloor>(sfs, Processing)\<rfloor>" by fact
  from 2 3 shp mdecl\<^sub>1 wf_size SCall_size show ?case
    by(fastforce simp add: comp_def
                intro!: SCall\<^sub>1 dest!:evals_final)
next
  case (SCallNone ps h l sh vs h' l' sh' C M)
  have "PROP ?Ps ps h l sh (map Val vs) h' l' sh' Vs ls" by fact
  with SCallNone.prems
  obtain ls\<^sub>2 where 2: "?Posts ps h l sh (map Val vs) h' l' sh' Vs ls ls\<^sub>2" by(auto)
  from 2 SCallNone show ?case
    by(rule_tac x = ls\<^sub>2 in exI,
       auto simp add: comp_def elim!: SCallNone\<^sub>1 dest!:evals_final sees_method_compPD)
next
  case (SCallNonStatic ps h l sh vs h' l' sh' C M Ts T pns body D)
  let ?Vs = "this#pns"
  have mdecl: "P \<turnstile> C sees M,NonStatic: Ts\<rightarrow>T = (pns, body) in D" by fact
  have mdecl\<^sub>1: "compP\<^sub>1 P \<turnstile> C sees M,NonStatic: Ts\<rightarrow>T = (compE\<^sub>1 ?Vs body) in D"
    using sees_method_compP[OF mdecl, of "\<lambda>b (pns,e). compE\<^sub>1 (case b of NonStatic \<Rightarrow> this#pns | Static \<Rightarrow> pns) e"]
    by(simp)
  have "PROP ?Ps ps h l sh (map Val vs) h' l' sh' Vs ls" by fact
  with SCallNonStatic.prems
  obtain ls\<^sub>2 where 2: "?Posts ps h l sh (map Val vs) h' l' sh' Vs ls ls\<^sub>2" by(auto)
  from 2 mdecl\<^sub>1 SCallNonStatic show ?case
    by (auto simp add: comp_def
             elim!: SCallNonStatic\<^sub>1 dest!:evals_final)
next
  case (SCallInitThrow ps h l sh vs h\<^sub>1 l\<^sub>1 sh\<^sub>1 C M Ts T pns body D a h\<^sub>2 l\<^sub>2 sh\<^sub>2)
  have "PROP ?Ps ps h l sh (map Val vs) h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls" by fact
  with SCallInitThrow.prems
  obtain ls\<^sub>1 where 1: "?Posts ps h l sh (map Val vs) h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls ls\<^sub>1" "length ls = length ls\<^sub>1"
    by(auto intro!:evals\<^sub>1_preserves_len)
  then have Init_size: "length Vs \<le> length ls\<^sub>1" using SCallInitThrow.prems(3) by linarith
  have "PROP ?P (INIT D ([D],False) \<leftarrow> unit) h\<^sub>1 l\<^sub>1 sh\<^sub>1 (throw a) h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1" by fact
  with 1 Init_size SCallInitThrow.prems
  obtain ls\<^sub>2 where 2: "?Post (INIT D ([D],False) \<leftarrow> unit) h\<^sub>1 l\<^sub>1 sh\<^sub>1 (throw a) h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1 ls\<^sub>2"
    by auto
  let ?Vs = "pns"
  have mdecl: "P \<turnstile> C sees M,Static: Ts\<rightarrow>T = (pns, body) in D" by fact
  have mdecl\<^sub>1: "compP\<^sub>1 P \<turnstile> C sees M,Static: Ts\<rightarrow>T = (compE\<^sub>1 ?Vs body) in D"
    using sees_method_compP[OF mdecl, of "\<lambda>b (pns,e). compE\<^sub>1 (case b of NonStatic \<Rightarrow> this#pns | Static \<Rightarrow> pns) e"]
    by(simp)
  from 1 2 mdecl\<^sub>1 SCallInitThrow show ?case
    by(auto simp add: comp_def
                intro!: SCallInitThrow\<^sub>1 dest!:evals_final)
next
  case (SCallInit ps h l sh vs h\<^sub>1 l\<^sub>1 sh\<^sub>1 C M Ts T pns body D v' h\<^sub>2 l\<^sub>2 sh\<^sub>2 l\<^sub>2' e' h\<^sub>3 l\<^sub>3 sh\<^sub>3)
  have "PROP ?Ps ps h l sh (map Val vs) h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls" by fact
  with SCallInit.prems
  obtain ls\<^sub>1 where 1: "?Posts ps h l sh (map Val vs) h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls ls\<^sub>1" "length ls = length ls\<^sub>1"
    by(auto intro!:evals\<^sub>1_preserves_len)
  then have Init_size: "length Vs \<le> length ls\<^sub>1" using SCallInit.prems(3) by linarith
  have "PROP ?P (INIT D ([D],False) \<leftarrow> unit) h\<^sub>1 l\<^sub>1 sh\<^sub>1 (Val v') h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1" by fact
  with 1 Init_size SCallInit.prems
  obtain ls\<^sub>2 where 2: "?Post (INIT D ([D],False) \<leftarrow> unit) h\<^sub>1 l\<^sub>1 sh\<^sub>1 (Val v') h\<^sub>2 l\<^sub>2 sh\<^sub>2 Vs ls\<^sub>1 ls\<^sub>2"
    by auto
  let ?Vs = "pns"
  let ?ls = "vs @ replicate (max_vars body) undefined"
  have mdecl: "P \<turnstile> C sees M,Static: Ts\<rightarrow>T = (pns, body) in D" by fact
  have fv_body: "fv body \<subseteq> set ?Vs" and wf_size: "size Ts = size pns"
    using wf mdecl by(auto dest!:sees_wf_mdecl simp:wf_mdecl_def)
  have mdecl\<^sub>1: "compP\<^sub>1 P \<turnstile> C sees M,Static: Ts\<rightarrow>T = (compE\<^sub>1 ?Vs body) in D"
    using sees_method_compP[OF mdecl, of "\<lambda>b (pns,e). compE\<^sub>1 (case b of NonStatic \<Rightarrow> this#pns | Static \<Rightarrow> pns) e"]
    by(simp)
  have [simp]: "l\<^sub>2' = [pns [\<mapsto>] vs]" by fact
  have SCall_size: "size vs = size pns" by fact
  have nclinit: "M \<noteq> clinit" by fact
  have "PROP ?P body h\<^sub>2 l\<^sub>2' sh\<^sub>2 e' h\<^sub>3 l\<^sub>3 sh\<^sub>3 ?Vs ?ls" by fact
  with 2 fv_body SCall_size SCallInit.prems
  obtain ls\<^sub>3 where 3: "?Post body h\<^sub>2 l\<^sub>2' sh\<^sub>2 e' h\<^sub>3 l\<^sub>3 sh\<^sub>3 ?Vs ?ls ls\<^sub>3"  by(auto)
  have shp: "\<nexists>sfs. sh\<^sub>1 D = \<lfloor>(sfs, Done)\<rfloor>" by fact
  from 1 2 3 shp mdecl\<^sub>1 wf_size SCall_size nclinit show ?case
    by(auto simp add: comp_def
                intro!: SCallInit\<^sub>1 dest!:evals_final)
next
\<comment> \<open> init cases \<close>
  case InitFinal then show ?case by(fastforce intro:eval\<^sub>1_evals\<^sub>1.intros)
next
  case (InitNone sh C C' Cs e h l e' h' l' sh')
  let ?sh1 = "sh(C \<mapsto> (sblank P C, Prepared))"
  have "PROP ?P (INIT C' (C # Cs,False) \<leftarrow> e) h l ?sh1 e' h' l' sh' Vs ls" by fact
  with InitNone.prems
  obtain ls\<^sub>2 where 2: "?Post (INIT C' (C # Cs,False) \<leftarrow> e) h l ?sh1 e' h' l' sh' Vs ls ls\<^sub>2" by(auto)
  from 2 InitNone show ?case by (auto elim!: InitNone\<^sub>1)
next
  case InitDone then show ?case by(fastforce intro:eval\<^sub>1_evals\<^sub>1.intros)
next
  case InitProcessing then show ?case by(fastforce intro:eval\<^sub>1_evals\<^sub>1.intros)
next
  case InitError then show ?case by(fastforce intro:eval\<^sub>1_evals\<^sub>1.intros)
next
  case InitObject then show ?case by(fastforce intro:eval\<^sub>1_evals\<^sub>1.intros)
next
  case (InitNonObject sh C sfs D fs ms sh' C' Cs e h l e' h1 l1 sh1)
  let ?f = "(\<lambda>b (pns,body). compE\<^sub>1 (case b of NonStatic \<Rightarrow> this#pns | Static \<Rightarrow> pns) body)"
  have cls: "class (compP ?f P) C = \<lfloor>(D,fs,map (compM ?f) ms)\<rfloor>"
    by(rule class_compP[OF InitNonObject.hyps(3)])
  have "PROP ?P (INIT C' (D # C # Cs,False) \<leftarrow> e) h l sh' e' h1 l1 sh1 Vs ls" by fact
  with InitNonObject.prems
  obtain ls\<^sub>2 where 2: "?Post (INIT C' (D # C # Cs,False) \<leftarrow> e) h l sh' e' h1 l1 sh1 Vs ls ls\<^sub>2" by(auto)
  from 2 cls InitNonObject show ?case by (auto elim!: InitNonObject\<^sub>1)
next
  case InitRInit then show ?case by(fastforce intro:eval\<^sub>1_evals\<^sub>1.intros)
next
  case (RInit e h l sh v h' l' sh' C sfs i sh'' C' Cs e' e\<^sub>1 h\<^sub>1 l\<^sub>1 sh\<^sub>1)
  have "PROP ?P e h l sh (Val v) h' l' sh' Vs ls" by fact
  with RInit.prems
  obtain ls\<^sub>1 where 1: "?Post e h l sh (Val v) h' l' sh' Vs ls ls\<^sub>1"
    "size ls = size ls\<^sub>1"    by(auto intro!:eval\<^sub>1_preserves_len)
  have "PROP ?P (INIT C' (Cs,True) \<leftarrow> e') h' l' sh'' e\<^sub>1 h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls\<^sub>1" by fact
  with 1 RInit.prems
  obtain ls\<^sub>2 where 2: "?Post (INIT C' (Cs,True) \<leftarrow> e') h' l' sh'' e\<^sub>1 h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls\<^sub>1 ls\<^sub>2" by(auto)
  from 1 2 RInit show ?case by (auto elim!: RInit\<^sub>1)
next
  case (RInitInitFail e h l sh a h' l' sh' C sfs i sh'' D Cs e' e\<^sub>1 h\<^sub>1 l\<^sub>1 sh\<^sub>1)
  have "PROP ?P e h l sh (throw a) h' l' sh' Vs ls" by fact
  with RInitInitFail.prems
  obtain ls\<^sub>1 where 1: "?Post e h l sh (throw a) h' l' sh' Vs ls ls\<^sub>1"
    "size ls = size ls\<^sub>1"    by(auto intro!:eval\<^sub>1_preserves_len)
  have fv: "fv (RI (D,throw a) ; Cs \<leftarrow> e') \<subseteq> set Vs"
    using RInitInitFail.hyps(1) eval_final RInitInitFail.prems(1) subset_eq by fastforce
  have l': "l' \<subseteq>\<^sub>m [Vs [\<mapsto>] ls\<^sub>1]" by (simp add: "1"(1))
  have "PROP ?P (RI (D,throw a) ; Cs \<leftarrow> e') h' l' sh'' e\<^sub>1 h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls\<^sub>1" by fact
  with 1 eval_final[OF RInitInitFail.hyps(1)] RInitInitFail.prems
  obtain ls\<^sub>2 where 2: "?Post (RI (D,throw a) ; Cs \<leftarrow> e') h' l' sh'' e\<^sub>1 h\<^sub>1 l\<^sub>1 sh\<^sub>1 Vs ls\<^sub>1 ls\<^sub>2"
    by fastforce
  from 1 2 RInitInitFail show ?case
    by(fastforce simp add: comp_def
                intro!: RInitInitFail\<^sub>1 dest!:eval_final)
next
  case RInitFailFinal then show ?case by(fastforce intro:eval\<^sub>1_evals\<^sub>1.intros)
qed
(*>*)

subsection\<open>Preservation of well-formedness\<close>

text\<open> The compiler preserves well-formedness. Is less trivial than it
may appear. We start with two simple properties: preservation of
well-typedness \<close>

lemma compE\<^sub>1_pres_wt: "\<And>Vs Ts U.
  \<lbrakk> P,[Vs[\<mapsto>]Ts] \<turnstile> e :: U; size Ts = size Vs \<rbrakk>
  \<Longrightarrow> compP f P,Ts \<turnstile>\<^sub>1 compE\<^sub>1 Vs e :: U"
and  "\<And>Vs Ts Us.
  \<lbrakk> P,[Vs[\<mapsto>]Ts] \<turnstile> es [::] Us; size Ts = size Vs \<rbrakk>
  \<Longrightarrow> compP f P,Ts \<turnstile>\<^sub>1 compEs\<^sub>1 Vs es [::] Us"
(*<*)
proof(induct e and es rule: compE\<^sub>1.induct compEs\<^sub>1.induct)
  case Var then show ?case
    by (fastforce simp:map_upds_apply_eq_Some split:if_split_asm)
next
  case LAss then show ?case
    by (fastforce simp:map_upds_apply_eq_Some split:if_split_asm)
next
  case Call then show ?case
    by (fastforce dest!: sees_method_compP[where f = f])
next
  case SCall then show ?case
    by (fastforce dest!: sees_method_compP[where f = f])
next
  case Block then show ?case by (fastforce simp:nth_append)
next
  case TryCatch then show ?case by (fastforce simp:nth_append)
qed fastforce+
(*>*)

text\<open>\noindent and the correct block numbering: \<close>

lemma \<B>: "\<And>Vs n. size Vs = n \<Longrightarrow> \<B> (compE\<^sub>1 Vs e) n"
and \<B>s: "\<And>Vs n. size Vs = n \<Longrightarrow> \<B>s (compEs\<^sub>1 Vs es) n"
(*<*)by (induct e and es rule: \<B>.induct \<B>s.induct)
        (force | simp,metis length_append_singleton)+(*>*)

text\<open> The main complication is preservation of definite assignment
@{term"\<D>"}. \<close>

lemma image_last_index: "A \<subseteq> set(xs@[x]) \<Longrightarrow> last_index (xs @ [x]) ` A =
  (if x \<in> A then insert (size xs) (last_index xs ` (A-{x})) else last_index xs ` A)"
(*<*)
by(auto simp:image_def)
(*>*)

lemma A_compE\<^sub>1_None[simp]:
      "\<And>Vs. \<A> e = None \<Longrightarrow> \<A> (compE\<^sub>1 Vs e) = None"
and "\<And>Vs. \<A>s es = None \<Longrightarrow> \<A>s (compEs\<^sub>1 Vs es) = None"
(*<*)by(induct e and es rule: compE\<^sub>1.induct compEs\<^sub>1.induct)(auto simp:hyperset_defs)(*>*)

lemma A_compE\<^sub>1:
      "\<And>A Vs. \<lbrakk> \<A> e = \<lfloor>A\<rfloor>; fv e \<subseteq> set Vs \<rbrakk> \<Longrightarrow> \<A> (compE\<^sub>1 Vs e) = \<lfloor>last_index Vs ` A\<rfloor>"
and "\<And>A Vs. \<lbrakk> \<A>s es = \<lfloor>A\<rfloor>; fvs es \<subseteq> set Vs \<rbrakk> \<Longrightarrow> \<A>s (compEs\<^sub>1 Vs es) = \<lfloor>last_index Vs ` A\<rfloor>"
(*<*)
proof(induct e and es rule: fv.induct fvs.induct)
  case (Block V' T e)
  hence "fv e \<subseteq> set (Vs@[V'])" by fastforce
  moreover obtain B where "\<A> e = \<lfloor>B\<rfloor>"
    using Block.prems by(simp add: hyperset_defs)
  moreover from calculation have "B \<subseteq> set (Vs@[V'])" by(auto dest!:A_fv)
  ultimately show ?case using Block
    by(auto simp add: hyperset_defs image_last_index last_index_size_conv)
next
  case (TryCatch e\<^sub>1 C V' e\<^sub>2)
  hence fve\<^sub>2: "fv e\<^sub>2 \<subseteq> set (Vs@[V'])" by auto
  show ?case
  proof (cases "\<A> e\<^sub>1")
    assume A\<^sub>1: "\<A> e\<^sub>1 = None"
    then obtain A\<^sub>2 where A\<^sub>2: "\<A> e\<^sub>2 = \<lfloor>A\<^sub>2\<rfloor>" using TryCatch
      by(simp add:hyperset_defs)
    hence "A\<^sub>2 \<subseteq> set (Vs@[V'])" using TryCatch.prems A_fv[OF A\<^sub>2] by simp blast
    thus ?thesis using TryCatch fve\<^sub>2 A\<^sub>1 A\<^sub>2
      by(auto simp add:hyperset_defs image_last_index last_index_size_conv)
  next
    fix A\<^sub>1 assume A\<^sub>1: "\<A> e\<^sub>1 =  \<lfloor>A\<^sub>1\<rfloor>"
    show ?thesis
    proof (cases  "\<A> e\<^sub>2")
      assume A\<^sub>2: "\<A> e\<^sub>2 = None"
      then show ?case using TryCatch A\<^sub>1 by(simp add:hyperset_defs)
    next
      fix A\<^sub>2 assume A\<^sub>2: "\<A> e\<^sub>2 = \<lfloor>A\<^sub>2\<rfloor>"
      have "A\<^sub>1 \<subseteq> set Vs" using TryCatch.prems A_fv[OF A\<^sub>1] by simp blast
      moreover
      have "A\<^sub>2 \<subseteq> set (Vs@[V'])" using TryCatch.prems A_fv[OF A\<^sub>2] by simp blast
      ultimately show ?thesis using TryCatch A\<^sub>1 A\<^sub>2
        by (auto simp add: Diff_subset_conv last_index_size_conv subsetD hyperset_defs
                 dest!: sym [of _ A])
    qed
  qed
next
  case (Cond e e\<^sub>1 e\<^sub>2)
  { assume "\<A> e = None \<or> \<A> e\<^sub>1 = None \<or> \<A> e\<^sub>2 = None"
    hence ?case using Cond by(auto simp add:hyperset_defs image_Un)
  }
  moreover
  { fix A A\<^sub>1 A\<^sub>2
    assume "\<A> e = \<lfloor>A\<rfloor>" and A\<^sub>1: "\<A> e\<^sub>1 = \<lfloor>A\<^sub>1\<rfloor>" and A\<^sub>2: "\<A> e\<^sub>2 = \<lfloor>A\<^sub>2\<rfloor>"
    moreover
    have "A\<^sub>1 \<subseteq> set Vs" using Cond.prems A_fv[OF A\<^sub>1] by simp blast
    moreover
    have "A\<^sub>2 \<subseteq> set Vs" using Cond.prems A_fv[OF A\<^sub>2] by simp blast
    ultimately have ?case using Cond
      by(auto simp add:hyperset_defs image_Un
          inj_on_image_Int[OF inj_on_last_index])
  }
  ultimately show ?case by fastforce
qed (auto simp add:hyperset_defs)
(*>*)

lemma D_None[iff]: "\<D> (e::'a exp) None" and [iff]: "\<D>s (es::'a exp list) None"
(*<*)by(induct e and es rule: \<D>.induct \<D>s.induct)(simp_all)(*>*)

lemma last_index_image_set: "distinct xs \<Longrightarrow> last_index xs ` set xs = {..<size xs}"
(*<*)by(induct xs rule:rev_induct) (auto simp add: image_last_index)(*>*)

lemma D_compE\<^sub>1:
  "\<lbrakk> \<D> e \<lfloor>set Vs\<rfloor>; fv e \<subseteq> set Vs; distinct Vs \<rbrakk> \<Longrightarrow> \<D> (compE\<^sub>1 Vs e) \<lfloor>{..<length Vs}\<rfloor>"
(*<*)by(fastforce dest!: D_last_index_compE\<^sub>1[OF subset_refl] simp add:last_index_image_set)(*>*)

lemma D_compE\<^sub>1':
assumes "\<D> e \<lfloor>set(V#Vs)\<rfloor>" and "fv e \<subseteq> set(V#Vs)" and "distinct(V#Vs)"
shows "\<D> (compE\<^sub>1 (V#Vs) e) \<lfloor>{..length Vs}\<rfloor>"
(*<*)
proof -
  have "{..size Vs} = {..<size(V#Vs)}" by auto
  thus ?thesis using assms by (simp only:)(rule D_compE\<^sub>1)
qed
(*>*)

lemma compP\<^sub>1_pres_wf: "wf_J_prog P \<Longrightarrow> wf_J\<^sub>1_prog (compP\<^sub>1 P)"
(*<*)
proof -
  assume wf: "wf_J_prog P"
  let ?f = "(\<lambda>b (pns, body).
           compE\<^sub>1 (case b of Static \<Rightarrow> pns | NonStatic \<Rightarrow> this # pns) body)"
  let ?wf\<^sub>2 = "wf_J\<^sub>1_mdecl"

  { fix C M b Ts T m
    assume cM: "P \<turnstile> C sees M, b :  Ts\<rightarrow>T = m in C"
      and wfm: "wf_mdecl wf_J_mdecl P C (M, b, Ts, T, m)"
    obtain pns body where [simp]: "m = (pns, body)" by(cases m) simp
    let ?E = "\<lambda>b. case b of Static \<Rightarrow> [pns [\<mapsto>] Ts] | NonStatic \<Rightarrow> [pns [\<mapsto>] Ts, this \<mapsto> Class C]"
    obtain T' where WT: "P,?E b \<turnstile> body :: T'" and subT: "P \<turnstile> T' \<le> T"
      using wfm by(cases b) (auto simp: wf_mdecl_def)
    have fv: "fv body \<subseteq> dom (?E b)" by(rule WT_fv[OF WT])
    have "wf_mdecl ?wf\<^sub>2 (compP ?f P) C (M, b, Ts, T, ?f b m)"
    proof(cases b)
      case Static then show ?thesis using cM wfm fv
        by(auto simp:wf_mdecl_def wf_J\<^sub>1_mdecl_def
                intro!: compE\<^sub>1_pres_wt D_compE\<^sub>1 \<B>)
    next
      case NonStatic then show ?thesis using cM wfm fv
        by(clarsimp simp add:wf_mdecl_def wf_J\<^sub>1_mdecl_def)
          (fastforce intro!: compE\<^sub>1_pres_wt D_compE\<^sub>1' \<B>)
    qed
  }
  then show ?thesis by simp (rule wf_prog_compPI[OF _ wf])
qed
(*>*)

end


theory Function_Tests
imports
  "Isabelle_Set.TSFunctions"
  "Isabelle_Set.Strings"
begin

lemma beta_should_succeed: "x \<in> A \<Longrightarrow> (\<lambda>x \<in> A. \<langle>x, x\<rangle>)`x = \<langle>x, x\<rangle>" by simp

lemma graph_eval1: "{\<langle>x, y\<rangle>}`x = y" by simp

(*TODO: fix object and function evaluator*)
(* lemma graph_eval2:
  assumes "x1 \<noteq> x2"
  shows "{\<langle>x1, y1\<rangle>, \<langle>x2, y2\<rangle>}`x1 = y1"
  and "{\<langle>x1, y1\<rangle>, \<langle>x2, y2\<rangle>}`x2 = y2"
  using assms by simp_all

lemma graph_eval3:
  assumes "x1 \<noteq> x2" "x2 \<noteq> x3" "x1 \<noteq> x3"
  shows "{\<langle>x1,y1\<rangle>,\<langle>x2,y2\<rangle>,\<langle>x3,y3\<rangle>}`x1 = y1"
  and "{\<langle>x1,y1\<rangle>,\<langle>x2,y2\<rangle>,\<langle>x3,y3\<rangle>}`x2 = y2"
  and "{\<langle>x1,y1\<rangle>,\<langle>x2,y2\<rangle>,\<langle>x3,y3\<rangle>}`x3 = y3"
  using assms by simp_all

lemma graph_eval4:
  assumes "x1 \<noteq> x2" "x2 \<noteq> x3" "x3 \<noteq> x4" "x4 \<noteq> x1" "x2 \<noteq> x4" "x1 \<noteq> x3"
  shows "{\<langle>x1,y1\<rangle>,\<langle>x2,y2\<rangle>,\<langle>x3,y3\<rangle>,\<langle>x4,y4\<rangle>}`x1 = y1"
    and "{\<langle>x1,y1\<rangle>,\<langle>x2,y2\<rangle>,\<langle>x3,y3\<rangle>,\<langle>x4,y4\<rangle>}`x2 = y2"
    and "{\<langle>x1,y1\<rangle>,\<langle>x2,y2\<rangle>,\<langle>x3,y3\<rangle>,\<langle>x4,y4\<rangle>}`x3 = y3"
    and "{\<langle>x1,y1\<rangle>,\<langle>x2,y2\<rangle>,\<langle>x3,y3\<rangle>,\<langle>x4,y4\<rangle>}`x4 = y4"
  using assms by simp_all

lemma labelled_graph_eval4:
  shows "{\<langle>@x1,@y1\<rangle>,\<langle>@x2,@y2\<rangle>,\<langle>@x3,@y3\<rangle>,\<langle>@x4,@y4\<rangle>}`@x1 = @y1"
    and "{\<langle>@x1,@y1\<rangle>,\<langle>@x2,@y2\<rangle>,\<langle>@x3,@y3\<rangle>,\<langle>@x4,@y4\<rangle>}`@x2 = @y2"
    and "{\<langle>@x1,@y1\<rangle>,\<langle>@x2,@y2\<rangle>,\<langle>@x3,@y3\<rangle>,\<langle>@x4,@y4\<rangle>}`@x3 = @y3"
    and "{\<langle>@x1,@y1\<rangle>,\<langle>@x2,@y2\<rangle>,\<langle>@x3,@y3\<rangle>,\<langle>@x4,@y4\<rangle>}`@x4 = @y4"
  by simp_all *)

end


(*  Title:     paraTheory.thy
    Author:    Yongjian Li, State Key Laboratory of Computer Science, Institute of Software,
Chinese Academy of Sciences
    Copyright   2016  State Key Laboratory of Computer Science, Institute of Software,
Chinese Academy of Sciences

A mechanical theory for verification of parameterized protocols like cache coherence protocols
*)

theory paraTheory imports Main Finite_Set
begin

section{*Datatypes to define variables, values, expressions, and formulas*}

datatype varType=Ident  string | Para varType  nat |Field  varType   string
text{*
Three kinds of variables used in the protocols.
1. simple identifiers to define global variables
2. array variables ----arr[i]
3. record variables -----rcd.f*}

datatype scalrValueType=enum string string |index nat | boolV bool
text{*
Three kinds of values used in the protocols.
1. enumerating values
2. natural numbers
3. Boolean values*}

datatype expType= IVar varType   |
         Const scalrValueType |
         iteForm formula  expType  expType

and  formula = eqn expType expType|
               andForm  formula formula |
               neg formula|
               orForm formula formula |
               implyForm formula formula |
               chaos

text{*
$Experssions$ and $formulas$ are defined mutually recursively.
 $Experssions$ can be simple or compound.
A simple expression is either a variable or a constant,
while a compound expression is constructed with the ite(if-then-else) form.
A $formula$ can be an atomic formula or a compound formula.
An atomic formula can be a boolean variable or constant,
or in the equivalence forms. A $formula$ can also be constructed by
using the logic connectives, including negation, conjunction,
disjunction, implication.
*}

section{*Datatypes to define assignments, statements, rules*}

type_synonym assignType=  "varType \<times>   expType"

datatype statement=  assign assignType          |
                  parallel assignType  statement
text{*A statement is is just a lists of assignments,
but these assignments are extecuted in parallel,
\emph{not} in a sequential order*}

type_synonym paraStatement= "nat \<Rightarrow> statement"
text{*A parameterized statement is just a function from a
parameter to a statement. *}

primrec cat::"statement \<Rightarrow> statement \<Rightarrow>statement" where
cat1:"cat (assign a) S=parallel a S" |
cat2:"cat (parallel a S1) S=parallel a (cat S1 S)"
text{*For conveniece, we also define the concatation of statements.*}

fun parallelList::"statement list \<Rightarrow> statement" where
"parallelList [S] = S"|
"parallelList (S1#SL) = cat S1 (parallelList (SL))"

fun  forallSent::"nat list\<Rightarrow>paraStatement \<Rightarrow> statement"  where
oneSent: "forallSent ([i])  paraS = paraS i"|
moreSent:" forallSent  (i#xs ) paraS=cat (paraS i) (forallSent (xs) paraS)  "

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

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)"

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.*}

section{*semantics of a protocol*}

type_synonym state= "varType \<Rightarrow> scalrValueType "
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:*}

text{*The formal semantics of an expression and a formula is
formalized as follows:*}
primrec expEval :: "expType \<Rightarrow> state \<Rightarrow> scalrValueType" and
 formEval :: "formula \<Rightarrow> state \<Rightarrow>bool"  where

"expEval  (IVar ie) s =  ( s ie)" |
"expEval  (Const i) s =  i"  |
"expEval  (iteForm f e1 e2) s=
   ( if (formEval f s) then     (expEval e1 s)
   else (expEval e2 s))"  |

evalExp: "formEval (eqn e1 e2) s= ((expEval e1 s) = (expEval e2 s))" |
evalAnd: "formEval ( andForm f1 f2) s=( (formEval f1 s) \<and> (formEval f2 s))"|
evalNeg: "formEval (neg f1 ) s= ( \<not>(formEval f1 s))"|
evalOr: "formEval (orForm f1 f2) s=( (formEval f1 s) \<or>  (formEval f2 s))"|
evalImp:"formEval (implyForm f1 f2) s= ( (formEval f1 s) \<longrightarrow>  (formEval f2 s))" |
"formEval chaos s=True"

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

primrec statement2Assigns::"statement \<Rightarrow> assignType list" where
"statement2Assigns (assign asgn)=[asgn]" |
"statement2Assigns (parallel a S)=a#statement2Assigns S"

definition wellformedAssgnList::"assignType list => bool" where
" wellformedAssgnList asgns\<equiv>distinct (map fst asgns)"
text{* Condition wellformedAssgnList guranttees that asgns assign different
variables to values*}

primrec transAux:: "assignType list \<Rightarrow> state \<Rightarrow>state " where
"transAux [] s= s " |
"transAux (pair#asgns) s=( transAux asgns s) ((fst pair):= expEval  (snd pair) s) "

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

text{*Here we must point out the fact that the assignments in a
parallel assignment is executed in parallel, and the statement can be
transformed into a wellformedAssgnList,
therefore we always assign an evaluation of an expression in
the state $s$ to the corresponding variable.*}

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::" formula set\<Rightarrow> rule set \<Rightarrow>state set"
  for  inis::"formula set"  and rules::"rule set"   where

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

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

text{*The rule $\mathsf{initState}$ says that a state $s$ is
in $\mathsf{reachableSet}~inis~ rules$ if
 there exists a formula $ini$ that is true in state $s$.
 Next rule $\mathsf{oneStep}$ says that
$$\mathsf{ trans}~  ($\mathsf{act}~ r )~ s $ is also in
 $\mathsf{reachableSet}~inis~ rules$ if $s$ already is in
 $\mathsf{reachableSet}~inis~ rules$ and $r \<in> rules$.*}

section{*substitions and  preconditions *}

primrec valOf::"assignType list \<Rightarrow> varType =>expType"  where
"valOf [] v=IVar v" |
"valOf (x#xs) v= (if ((fst x) =v) then (snd x) else valOf xs v)"
text{*Let $asgn\!=\![(v_1,e_1),\ldots,(v_n,e_n)]$ be an assignment,
 valOf asgn $x_i$ is the expression $e_i$ assigned to $v_i$*}

lemma lemmaOnValOf:
  shows "expEval (valOf (statement2Assigns S) v) s = transAux ( statement2Assigns S) s v"
  (is "?LHS1 S =?RHS1 S")
  proof(induct_tac S)
  fix x
  let ?S="assign x"
  show "?LHS1 ?S=?RHS1 ?S"
    by auto
  next
  fix assign S2
  let ?S="parallel assign S2"
  assume  b1:"?LHS1 S2 =?RHS1 S2"
  show "?LHS1 ?S =?RHS1 ?S"
  proof(case_tac "fst assign =v",force)
  assume c1:"fst assign \<noteq> v"
  show "?LHS1 ?S =?RHS1 ?S"
    apply(cut_tac b1 c1,simp) done
  qed
qed

text{*This lemma says that the value of (statement2Assigns S) assigned to variable v, which is evaluated
at the state s, is the same as that of v at the result  state  after execution of S from state s*}

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

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

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

substExpite: "substExp  (iteForm f e1 e2)  asgns=
  (iteForm (substForm f asgns) (substExp e1  asgns) (substExp e2  asgns))"|
"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  chaos   asgns=chaos"

text{*$\mathsf{substExp}~asgn~e$ ($\mathsf{substForm}~asgn~f$)
 denotes the expression $e$ (formula $f$) in which the occurrence of variable
  $x_i$ is replaced by $e_i$.*}

definition  substExpByStatement ::"expType \<Rightarrow>statement \<Rightarrow>expType"   where [simp]:
"substExpByStatement e S\<equiv>substExp e (statement2Assigns S)"

definition substFormByStatement ::"formula \<Rightarrow>statement \<Rightarrow>formula"   where [simp]:
"substFormByStatement f S\<equiv>substForm f (statement2Assigns S)"
text{*A statement $S$ can be transformed into an assignment to some variables
 $x_i$,  which is formalized by $\mathsf{statement2Assigns}~ S$.
we use substExpByStatement e S and  substFormByStatement f S to denote the
formula transformed from $f$  by substituting each $x_i$ with $e_i$.
Furthermore, substFormByStatement f S  can be regarded as the weakest
precondition of formula $f$ w.r.t. statement $S$. As Hoare logics specifies, *}

lemma  preCondOnExp:

  shows "(expEval (substExpByStatement e S) s =expEval e (trans S s)) \<and>
         (formEval (substFormByStatement f S) s = formEval f (trans S s))"
    (is "((  ?LHS e S=?RHS e S)\<and> ( ?LHS1 f S=?RHS1 f S))")
proof(induct_tac e and f)
      fix v
      let ?e="(IVar v)"
      show  "?LHS ?e S=?RHS ?e S"
      by (simp add: lemmaOnValOf)

next
  fix n
  let ?e="(Const n)"
      show  "?LHS ?e S=?RHS ?e S"
      apply( simp)
      done
next
  fix f e1 e2
  assume a1:" ( ?LHS1 f S=?RHS1 f S)" and
  a2:"?LHS e1 S=?RHS e1 S" and a3:"?LHS e2 S=?RHS e2 S"
  let ?e="iteForm f e1 e2"
  show "?LHS ?e S=?RHS ?e S"
  using a1 a2 a3 by auto
next
  fix e1 e2

  assume a1:"?LHS e1 S=?RHS e1 S" and a2:"?LHS e2 S=?RHS e2 S"
  let ?f="eqn e1 e2"
  show "( ?LHS1 ?f S=?RHS1 ?f S)"
   using a1 a2 by auto
next
  fix f1 f2
  assume a1:" ( ?LHS1 f1 S=?RHS1 f1 S)" and  a2:" ( ?LHS1 f2 S=?RHS1 f2 S)"
  let ?f="andForm f1 f2"

  show "( ?LHS1 ?f S=?RHS1 ?f S)"
   using a1 a2 by auto
next
  fix f1
  assume a1:" ( ?LHS1 f1 S=?RHS1 f1 S)"
  let ?f="neg f1"
  show "( ?LHS1 ?f S=?RHS1 ?f S)"
   using a1 by auto
next
  fix f1 f2
  assume a1:" ( ?LHS1 f1 S=?RHS1 f1 S)" and  a2:" ( ?LHS1 f2 S=?RHS1 f2 S)"
  let ?f="implyForm f1 f2"

  show "( ?LHS1 ?f S=?RHS1 ?f S)"
  using a1 a2 by auto
next
  fix f1 f2
  assume a1:" ( ?LHS1 f1 S=?RHS1 f1 S)" and  a2:" ( ?LHS1 f2 S=?RHS1 f2 S)"
  let ?f="orForm f1 f2"

  show "( ?LHS1 ?f S=?RHS1 ?f S)"
  using a1 a2 by auto
next
  let ?f="chaos"
  show "( ?LHS1 ?f S=?RHS1 ?f S)"
  by auto
qed

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::" state \<Rightarrow> formula \<Rightarrow> rule \<Rightarrow> bool" where [simp]:
"invHoldForRule1 s f  r \<equiv>
(formEval (pre r) s \<longrightarrow>  formEval  (substFormByStatement f  (act r)) s )"
text{* $\mathsf{invHoldRule}_1(s,f, r)$ means that after rule $r$ is executed, $f$ becomes true immediately;*}

 definition invHoldForRule2::" state \<Rightarrow> formula \<Rightarrow> rule \<Rightarrow> bool" where [simp]:
"invHoldForRule2 s f  r \<equiv>
(formEval  (substFormByStatement f  (act r)) s  =  formEval 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::"state \<Rightarrow> formula \<Rightarrow> rule \<Rightarrow>formula set\<Rightarrow> bool"  where [simp]:
"invHoldForRule3 s f r fs  \<equiv>
(let pref=substFormByStatement f (act r) in
(\<exists>f'. f' \<in> fs \<and>  (formEval   (andForm (pre r)  f') s\<longrightarrow> formEval  pref 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::"state \<Rightarrow>formula \<Rightarrow> rule \<Rightarrow> (formula set) \<Rightarrow> bool" where
  "invHoldForRule s inv0 r invs \<equiv>
    invHoldForRule1 s inv0 r \<or>  invHoldForRule2 s inv0 r \<or>   invHoldForRule3 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::"formula set \<Rightarrow> formula set \<Rightarrow> rule set \<Rightarrow>bool"  where
"consistent invs inis rs \<equiv>
(\<forall>inv ini s. (inv \<in> invs \<longrightarrow> ini\<in> inis\<longrightarrow> formEval ini s \<longrightarrow> formEval inv s)) \<and>
 (\<forall> inv r s.  (inv \<in>invs  \<longrightarrow> r \<in> rs \<longrightarrow> invHoldForRule s inv r invs  ))"

text{*For any invariant $inv \in invs$, $inv$ holds at a reachable state $s$  of a protocol $P=(ini,rs)$
  if the consistency relation
$\mathsf{consistent}( invs, inis, rs)$ holds.
The following lemma formalizes the essence of the aforementioned causal relation,
and is called consistency lemma.*}

lemma consistentLemma:
  assumes a1:"consistent invs inis rs" and a2:"s \<in> reachableSet inis rs"
  shows "\<forall> inv. inv \<in> invs \<longrightarrow>formEval 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) s)"
    proof (rule allI, rule impI)
      fix inv
      assume b1:"inv \<in> invs"
      have b2:" invHoldForRule3 s inv r  invs \<or> invHoldForRule2 s inv r   \<or> invHoldForRule1 s inv r  "
        apply(cut_tac a1, unfold consistent_def)
        by (metis b1 oneStep(3))

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

        let ?pref="substFormByStatement inv (act r)"
          have b3:"  ( (\<forall> f'.  f' \<in>  invs\<longrightarrow>formEval f'  s) \<longrightarrow>formEval (pre r)  s\<longrightarrow> formEval  ?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 f'  s)"
          apply(cut_tac b3' )
          by (metis (no_types) oneStep(2))

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

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

        have "formEval inv (trans (act r) s)"
           apply(cut_tac b6,metis preCondOnExp)
            done
      }

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

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

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

        have "formEval inv (trans (act r) s)"
        by (cut_tac b4,  metis preCondOnExp)

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

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

         have "formEval inv (trans (act r) s)"
           apply(subgoal_tac "formEval (substFormByStatement inv (act r)) s")
           apply (metis preCondOnExp)
           apply(cut_tac b1' b5)
           by(unfold invHoldForRule1_def,auto)

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

section{*miscellaneous definitions and lemmas*}

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

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

primrec varOfExp::"expType \<Rightarrow> varType set"  and
  varOfForm::"formula \<Rightarrow> varType set"  where

"varOfExp  (IVar v) =   varsOfVar v" |
"varOfExp   (Const j) =  {}" |

"varOfExp   (iteForm f e1 e2) =(varOfForm f) \<union>  (varOfExp   e1 )  \<union>   (varOfExp  e2)" |

"varOfForm   (eqn e1 e2) = ( (varOfExp   e1 )  \<union>   (varOfExp  e2))" |
"varOfForm   ( andForm f1 f2) =(  (varOfForm  f1 )  \<union>  (varOfForm  f2 ))"|
"varOfForm   (neg f1 ) = (  (varOfForm   f1 ))"|
"varOfForm   (orForm f1 f2) =(  (varOfForm   f1 )   \<union>   (varOfForm  f2 ))"|
"varOfForm   (implyForm f1 f2) = (  (varOfForm  f1 )  \<union>  (varOfForm f2 ))"|
"varOfForm   (chaos) ={}"

primrec  varOfSent::"statement \<Rightarrow> varType set" where
" varOfSent  (assign a)=( varsOfVar  (fst a)) "|
" varOfSent  ( parallel a sent2)= (( varsOfVar  (fst a)) \<union>  (varOfSent  sent2))"

lemma varsOfSent1:
  " (varOfSent S) = set (map fst (statement2Assigns S))"
  proof(induct_tac S,auto) qed

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

lemma simpDown:"down 5=[5,4,3,2,1,0]"
 by (simp add: eval_nat_numeral(2) eval_nat_numeral(3))

lemma downNIsNotEmpty:
  "\<exists> j xs. down N= j#xs" (is "?P N")
  proof(induct_tac N,auto)qed

text{*definitions and lemmas on forallForm formula constructor*}

lemma forall1:
  shows "\<forall> i. i \<le> N \<longrightarrow>formEval (forallForm (down N) pf ) s\<longrightarrow>formEval (pf i) s" (is "?P N")
proof(induct_tac N)
    show "?P  0"
      by simp
  next
    fix N
    assume b1:"?P N"
    show "?P  (Suc N)"
      proof(case_tac "N =0")
        assume c1:"N=0"
        show "?P  (Suc N)"
        proof(cut_tac c1, auto,case_tac "i=0", auto,case_tac "i=1",auto)qed
      next
        assume c1:"N\<noteq>0"
        have "0<N "
          by(cut_tac c1, arith)
       then have c2:"\<exists> N'. down (Suc N)=(Suc N)#N#down N'"
         by (metis down.simps(2) gr0_conv_Suc)
       then obtain N' where c2:"down (Suc N)=(Suc N)#N#down N'"
         by blast
       then have c3:"(N#down N')=down N"
         by simp
       show "?P  (Suc N)"
       proof(rule allI,(rule impI)+,cut_tac c2,simp)
         fix i
         assume d1:"i\<le> Suc N" and d2:" formEval (pf (Suc N)) s \<and> formEval (forallForm (N # down N') pf) s"
         have "i=Suc N \<or> i<Suc N"
           by (cut_tac d1, arith)
         moreover
         {assume e1:"i=Suc N"
           have " formEval (pf i) s"
             by (metis (lifting) d2 e1)
         }
         moreover
         {assume e1:"i<Suc N"
           have " formEval (pf i) s"
             by (metis b1 c3 d1 d2 le_Suc_eq)
         }
         ultimately show "formEval (pf i) s"
           by blast
       qed
     qed
   qed

lemma forallLemma [simp,dest]:
  assumes a1:"i \<le> N" and a2:"formEval (forallForm (down N) pf ) s"
  shows "formEval (pf i) s"
by (metis a1 a2 forall1)

subsection{*lemmas on varsOf*}

lemma varsOnCat[simp]:
  shows "varOfSent (cat S1 S2)=(varOfSent S1 ) \<union> (varOfSent S2 )"
  apply(induct_tac S1)
apply (metis (lifting) cat1 varOfSent.simps(1) varOfSent.simps(2))
by (metis Un_assoc cat2 varOfSent.simps(2))

lemma   forallVars:
  assumes a1:"\<forall> i.( varOfSent (paraForm i))\<inter> varSet ={}"
   shows  "(varOfSent (forallSent (down N) paraForm))\<inter> varSet ={}"
  proof(induct_tac N)
    show " varOfSent (forallSent (down 0) paraForm) \<inter> varSet = {}"
      apply(cut_tac a1,force)
      done
  next
    fix n
    assume b1:"varOfSent (forallSent (down n) paraForm) \<inter> varSet = {}"
    have " (varOfSent (forallSent (down (Suc n)) paraForm) )  =
      (varOfSent ( paraForm (Suc n)) ) \<union>
      (varOfSent (forallSent (down  n ) paraForm) )"
      by (metis (hide_lams, no_types) add_0_right moreSent down.simps(1) down.simps(2) nat.exhaust varsOnCat)
      then show "  varOfSent (forallSent (down (Suc n)) paraForm) \<inter> varSet = {}"
      apply(-,cut_tac a1,simp )
      by (metis (lifting) Int_Un_distrib2 Un_empty_left b1)
  qed

lemma   forallVars1[simp,intro!]:
  assumes a1:"\<forall>i. v \<notin>( varOfSent (paraForm i))"
   shows  "v \<notin>(varOfSent (forallSent (down N) paraForm))" (is "?P N")
  proof(induct_tac N)
    show "?P 0"
      apply(cut_tac a1,force)
      done
  next
    fix n
    assume b1:"?P n"
    have " (varOfSent (forallSent (down (Suc n)) paraForm) )  =
      (varOfSent ( paraForm (Suc n)) ) \<union>
      (varOfSent (forallSent (down  n ) paraForm) )"
      by (metis (hide_lams, no_types) add_0_right moreSent down.simps(1) down.simps(2) nat.exhaust varsOnCat)
      then show "?P (Suc n) "
      apply(-,cut_tac a1,simp )
      by (metis (lifting) b1)
  qed

lemma varsOfForallSentIn[simp]:
  "i \<le>N \<longrightarrow>v \<in> varOfSent (paraForm i) \<longrightarrow> v \<in> varOfSent (forallSent (down N) paraForm)" ( is "?P N")
proof(induct_tac N)
  show "?P 0"
   by auto
   next
    fix N
   assume a1:"?P N"
   show "?P (Suc N)"
   proof(rule impI)+

    assume b0:"i \<le> Suc N" and b1:"  v \<in> varOfSent (paraForm i)"
    have b2:"  varOfSent  (forallSent (down (Suc N)) paraForm) = varOfSent (paraForm (Suc N)) \<union>   varOfSent (forallSent (down N) paraForm)"
     by (metis down.simps(2) downNIsNotEmpty paraTheory.moreSent varsOnCat)
     have "i \<le> N | i=Suc N" by(cut_tac b0,auto)
    moreover
    {assume c1:"i \<le> N"
     have c2:" v \<in>varOfSent (forallSent (down N) paraForm)"
     apply(cut_tac c1 b1 a1,auto) done
     then have "v \<in> varOfSent (forallSent (down (Suc N)) paraForm)" by(cut_tac c1 c2 b2,auto)
     }
     moreover
    {assume c1:"i =Suc N"
     from c1  have "v \<in> varOfSent (forallSent (down (Suc N)) paraForm)" by(cut_tac c1 b1 b2,auto)
     }
    ultimately show "v \<in> varOfSent (forallSent (down (Suc N)) paraForm)" by blast
  qed
 qed

lemma varsOfNot [simp,dest!]:
"v \<notin> set (map fst   (statement2Assigns S)) \<Longrightarrow>
 v \<in>set( map fst (statement2Assigns  (cat S S'))) = (v \<in> set (map fst   (statement2Assigns S'))) "
by (metis Un_iff varsOfSent1 varsOnCat)

lemma ForallSentForm [simp]:
  shows a1:" (statement2Assigns (forallSent (down N)  (\<lambda>i. assign (Para n i, e' i))))=map (\<lambda>i. (Para n i, e' i)) (down N)" (is "?P N")
proof(induct_tac N)
  show "?P 0"
    apply simp
    done
next
  fix N
  assume b1:"?P N"
  show "?P (Suc N )"
  proof(cut_tac b1, simp)
    have b2:"\<exists> j xs. down N= j#xs"
      by (metis downNIsNotEmpty)
  then obtain j xs where b2:"down N=j#xs" by blast
    show"  statement2Assigns (forallSent (Suc N # down N) (\<lambda>i. assign (Para n i, e' i))) =
           (Para n (Suc N), e' (Suc N)) # map (\<lambda>i. (Para n i, e' i)) (down N)"
      apply(cut_tac b1 b2,simp)
      done
  qed
qed

subsection{*more lemmas on valOf operator*}

text{*more lemmas on valOf operator*}

lemma valOfLemma[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 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 S)) \<longrightarrow>( valOf (statement2Assigns  (cat S S')) v) =    ( valOf (statement2Assigns S')) v"
    proof(induct_tac S,auto)qed

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

lemma valOfLemma5Aux :"( valOf (statement2Assigns   S ) v=IVar v) \<and>
  ( valOf (statement2Assigns S') v=IVar v)\<longrightarrow>( valOf (statement2Assigns  (cat S S')) v=IVar v) "
    proof(induct_tac S,auto)qed

lemma valOfLemma5 [simp,intro]:"( valOf (statement2Assigns   S ) v=IVar v) \<and>
  ( valOf (statement2Assigns S') v=IVar v)  \<Longrightarrow> ( valOf (statement2Assigns  (cat S S')) v=IVar v) "
  by(metis  valOfLemma5Aux)

lemma valOfLemma6Aux :"( valOf (statement2Assigns   S ) v=IVar v) \<and>
  ( valOf (statement2Assigns S') v=IVar v)\<longrightarrow>( valOf (statement2Assigns  (cat S S')) v=IVar v) "
    proof(induct_tac S,auto)qed

lemma valOfLemma7Aux:"v \<notin> varOfSent S \<longrightarrow>( valOf (statement2Assigns  (cat S S')) v) =    ( valOf (statement2Assigns S')) v"
proof(induct_tac S,auto)qed

lemma valOfLemma7 [simp,intro]:"v \<notin> varOfSent S \<Longrightarrow>( valOf (statement2Assigns  (cat S S')) v) =    ( valOf (statement2Assigns S')) v"
by(metis valOfLemma7Aux)

lemma valOfLemma8Aux:"v \<in> varOfSent S \<longrightarrow>( valOf (statement2Assigns  (cat S S')) v) =    ( valOf (statement2Assigns S)) v"
proof(induct_tac S,auto)qed

lemma valOfLemma8A[simp,intro]:"v \<in> varOfSent S \<Longrightarrow>( valOf (statement2Assigns  (cat S S')) v) =    ( valOf (statement2Assigns S)) v"
by(metis valOfLemma8Aux)

lemma noEffectValOfStatementAux[intro]:
  shows "( v \<notin>  (varOfSent S) )\<longrightarrow> valOf (statement2Assigns  S)  v=IVar v" (is "?P N")
 proof(induct_tac S,auto)qed

  lemma noEffectValOfStatement[simp,intro]:
  assumes "( v \<notin>  (varOfSent S)) "
  shows   "valOf (statement2Assigns  S)  v=IVar v" (is "?P N")
by (metis assms valOfLemma2Aux varsOfSent1)

 lemma noEffectValOfForallStatementAux[intro]:
  shows "( \<forall>i. (v\<notin>  (varOfSent (ps i)) ))\<longrightarrow> valOf (statement2Assigns  (forallSent (down N) ps)) v=IVar v" (is "?P N")
  proof(induct_tac N)
    show "?P 0"
      apply simp
      done
   next
    fix N
    assume b1:"?P N"
    show "?P (Suc N)"
    proof(rule impI)
      assume c1:" \<forall>i. v \<notin> varOfSent (ps i)"
      show "valOf (statement2Assigns (forallSent (down (Suc N)) ps)) v = IVar v"
      proof(rule noEffectValOfStatement)
        have "   varOfSent (forallSent (down (Suc N)) ps) \<inter>{v} = {}"  thm forallVars
        proof(rule  forallVars,cut_tac c1,auto)qed
        then show   " v \<notin> varOfSent (forallSent (down (Suc N)) ps)"
        by (metis c1 forallVars1)
      qed
  qed
  qed

text{*definitions and lemmas on  andList formula constructor*}

primrec andList::"formula list \<Rightarrow> formula" where
"andList [] = chaos" |
"andList (frm#frms) = andForm frm (andList frms)"

lemma andListFormAux1:

  shows "set fs \<subseteq>  fs' \<longrightarrow>( \<forall> inv. inv \<in> fs' \<longrightarrow>formEval inv s)\<longrightarrow> formEval (andList fs) s"
  proof(induct_tac fs,auto)qed

lemma andListForm1[simp,intro]:

  "\<lbrakk>set fs \<subseteq>  invs ; ( \<forall> inv. inv \<in>invs \<longrightarrow>formEval inv s)\<rbrakk>\<Longrightarrow> formEval (andList fs) s"
 by(metis  andListFormAux1)

lemma andList2Aux:
   shows "formEval (neg frm) s \<longrightarrow> frm \<in>set frms \<longrightarrow> formEval (neg (andList frms)) s"
   proof(induct_tac frms,auto) qed

lemma andList2:
   shows "formEval (neg frm) s \<Longrightarrow> frm \<in>set frms \<Longrightarrow> formEval (neg (andList frms)) s"
   by (metis andList2Aux)

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

lemma andList1:
   shows "formEval ( (andList frms)) s  \<Longrightarrow>  frm \<in>set frms \<Longrightarrow> formEval ( frm) s "
    by (metis andList1Aux)
lemma resAux1:
  assumes   b:"formEval frm s" and c:"formEval (neg (andList (frm#frms))) s"
  shows"formEval (neg (andList frms)) s"
  apply(cut_tac b c)
  apply auto
  done

text{*If $asgns$ does not assign any variable in $E$ to any value, then evaluation of $E$ at the state $s$ is the same as that of $E$
at the state $transAux~ asgns~ s$ *}
lemma noEffectOnExpAux:
  shows "(\<forall> s. (varOfExp E) \<inter>  set (map fst asgns) ={} \<longrightarrow>
  expEval E  s  =  expEval E (transAux asgns s))  \<and>
  (\<forall>   s. (varOfForm f) \<inter>  set (map fst asgns) ={} \<longrightarrow>
  formEval f s  =  formEval f (transAux asgns s))"
  (is "(\<forall>  s. ?P asgns s E) \<and>( \<forall>  s. ?Q asgns s f)")
proof(induct_tac E and f)

  fix varType
  let ?E="IVar varType"
  show "(\<forall>  s. ?P asgns s ?E)" (is "\<forall>s. ?R s asgns")
  proof(rule allI)
  fix s
  show "?R s asgns"
  proof( induct_tac asgns)
    show "?R s []" by simp
    next
    fix a asgns
    assume  a1:"?R s asgns"
    show "?R s (a#asgns)"
    proof

    assume c1:" varOfExp (?E) \<inter> set (map fst (a # asgns)) = {}"

      have d1:"\<exists> v val0. a=(v,val0)"
            by auto
    then obtain var val0 where d2:"a=(var,val0)"
            by blast

     have f1:"expEval ?E s = expEval ?E (transAux ( asgns) s)"
          apply(cut_tac a1  c1 )
          apply auto
          done
      have f2:" expEval ?E (transAux (a # asgns) s)= expEval ?E (transAux ( asgns) s)"
          apply(cut_tac a1 c1,simp)
          apply( auto)
         done
      show " expEval ?E s = expEval ?E (transAux (a # asgns) s)"
         apply(cut_tac f1 f2, simp)
         done
     qed
   qed
  qed
next
  fix n

  let ?E="Const n"
  show "(\<forall>  s. ?P asgns s ?E)" (is "\<forall>s. ?R s asgns")
  by auto
next
  fix frm e1 e2
   let ?E="iteForm frm e1 e2"
  assume a1:"( \<forall>  s. ?Q asgns s frm)" and a2:"(\<forall>  s. ?P asgns s e1)" and a3:"(\<forall>  s. ?P asgns s e2)"

  show "(\<forall>  s. ?P asgns s ?E)" (is "\<forall>s. ?R s asgns")
  proof(rule allI,rule impI)
  fix s
   assume c1:" varOfExp (?E) \<inter> set (map fst ( asgns)) = {}"
   show "expEval (iteForm frm e1 e2) s = expEval (iteForm frm e1 e2) (transAux asgns s)"
   apply(cut_tac a1 a2 a3 c1)
   apply auto
   done
   qed
next
  fix e1 e2
  let ?f="eqn e1 e2"
  assume a1:"(\<forall>  s. ?P asgns s e1)" and a2:"(\<forall>  s. ?P asgns s e2)"

  show "(\<forall>  s. ?Q asgns s ?f)" (is "\<forall>s. ?R s asgns")
  proof(rule allI,rule impI,cut_tac a1 a2,auto)
  qed
next
  fix f1 f2
  let ?f="andForm f1 f2"
  assume a1:"( \<forall>  s. ?Q asgns s f1)" and  a2:"( \<forall>  s. ?Q asgns s f2)"
  show "( \<forall>  s. ?Q asgns s ?f)"

  proof(rule allI,rule impI,cut_tac a1 a2,auto)
  qed
next
  fix f1
  let ?f="neg f1 "
  assume a1:"( \<forall>  s. ?Q asgns s f1)"
  show "( \<forall>  s. ?Q asgns s ?f)"

  proof(rule allI,rule impI,cut_tac a1 ,auto)
  qed
next
  fix f1 f2
  let ?f="orForm f1 f2"
  assume a1:"( \<forall>  s. ?Q asgns s f1)" and  a2:"( \<forall>  s. ?Q asgns s f2)"
  show "( \<forall>  s. ?Q asgns s ?f)"

  proof(rule allI,rule impI,cut_tac a1 a2,auto) qed
next
fix f1 f2
  let ?f="implyForm f1 f2"
  assume a1:"( \<forall>  s. ?Q asgns s f1)" and  a2:"( \<forall>  s. ?Q asgns s f2)"
  show "( \<forall>  s. ?Q asgns s ?f)"

  proof(rule allI,rule impI,cut_tac a1 a2,auto) qed
next
  show "( \<forall>  s. ?Q asgns s chaos)"
  by auto
qed

lemma noEffect:
shows "(\<forall>   s. (varOfExp E) \<inter>  (varOfSent S) ={} \<longrightarrow> expEval E s  =  expEval E (trans S s)) \<and>
(\<forall>s. varOfForm f \<inter>  (varOfSent S) ={}\<longrightarrow>
         formEval f s = formEval f (trans S s))"
apply(cut_tac  f="f" and E="E" and asgns="  ((statement2Assigns S))" in noEffectOnExpAux)
apply(unfold trans_def)
apply(cut_tac S="S" in varsOfSent1)
apply metis
done

lemma noEffectOnExp:
  assumes a1:"(varOfExp E) \<inter>  (varOfSent S) ={} "
    shows " expEval E s  =  expEval E (trans S s)"
by (metis assms noEffect)

lemma noEffectOnFormula:
  assumes a1:"(varOfForm f) \<inter>  (varOfSent S) ={} "
    shows " formEval f s  =  formEval f (trans S s)"
by (metis assms noEffect)

text{*if varianles occurring in an expression e (or a formula f) is disjoint with that in a statement S, then
substExpByStatement e S (or substFormByStatement f S)
is the same as e(or f)*}

lemma noEffectSubstAux:

  shows " (  (varOfExp e \<inter>  (varOfSent S) ={}) \<longrightarrow>(substExpByStatement e S)  =e) \<and>
           (  (varOfForm f \<inter>  (varOfSent S) ={} )\<longrightarrow> (substFormByStatement f S)  =  f )"

    (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)
      fix v
      let ?e="(IVar v)"
      show  "?condOne ?e S\<longrightarrow>?LHS ?e S=?RHS ?e S"
      proof(induct_tac S)
        fix prod
        let ?S="assign prod"
        show "?condOne ?e ?S \<longrightarrow>?LHS ?e ?S=?RHS ?e ?S"

        apply(unfold  substExpByStatement_def trans_def,auto)
        done
    next
       fix prod S
       let ?S="parallel prod S"
       assume b1:"?condOne ?e S \<longrightarrow>?LHS ?e S=?RHS ?e S"

       show "?condOne ?e ?S \<longrightarrow> ?LHS ?e ?S=?RHS ?e ?S"

       proof(unfold  substExpByStatement_def trans_def,
       case_tac "fst prod =v",force)
       assume d1:"fst prod \<noteq> v "
       show "varOfExp (IVar v) \<inter> varOfSent (parallel prod S) = {} \<longrightarrow> (substExp (IVar v) (statement2Assigns (parallel prod S))) =
               (IVar v)"
       proof(cut_tac d1,simp) qed

      qed
    qed
next
  fix n
  let ?e="(Const n)"
      show  "?condOne ?e S \<longrightarrow>?LHS ?e S=?RHS ?e S"
      apply( simp)
      done
next
  fix f e1 e2
  assume a1:" (?condOnf f S \<longrightarrow> ?LHS1 f S=?RHS1 f S)" and
  a2:"?condOne e1 S \<longrightarrow>?LHS e1 S=?RHS e1 S" and a3:"?condOne e2 S \<longrightarrow>?LHS e2 S=?RHS e2 S"
  let ?e="iteForm f e1 e2"
  show "?condOne ?e S \<longrightarrow>?LHS ?e S=?RHS ?e S"
  proof(rule impI)
  assume b1:"?condOne ?e S"
  have c1:"?condOnf f S "
  apply(cut_tac b1,simp)
  by (metis bot_eq_sup_iff inf_sup_distrib2)
  have c2:"?condOne e1 S "
   apply(cut_tac b1,simp)
   by (metis c1 inf_bot_right inf_sup_absorb inf_sup_distrib2 sup_bot.left_neutral)
  have c3:"?condOne e2 S "
   apply(cut_tac b1,simp)
   by (metis c1 inf_bot_right inf_sup_absorb inf_sup_distrib2 sup_bot.left_neutral)
 with c1 c2 c3 a1 a2 a3
 show "?LHS ?e S=?RHS ?e S"
 by (metis substExpByStatement_def substExpite substFormByStatement_def)
 qed

next
  fix e1 e2

  assume a1:"?condOne e1 S \<longrightarrow>?LHS e1 S=?RHS e1 S" and a2:"?condOne e2 S \<longrightarrow>?LHS e2 S=?RHS e2 S"
  let ?f="eqn e1 e2"

  show "(?condOnf ?f S \<longrightarrow> ?LHS1 ?f S=?RHS1 ?f S)"
  proof(rule impI)
  assume b1:"?condOnf ?f S"
  have c1:"?condOne e1 S"
  apply(cut_tac b1,simp)
  by (metis Int_Un_distrib2 sup_eq_bot_iff)
  have c2:"?condOne e2 S"
  apply(cut_tac b1,simp)
   by (metis Int_Un_distrib2 sup_eq_bot_iff)
   with a1 a2 c1 c2
   show "?LHS1 ?f S=?RHS1 ?f S"
    by simp
   qed
next
  fix f1 f2
  assume a1:" (?condOnf f1 S \<longrightarrow> ?LHS1 f1 S=?RHS1 f1 S)" and  a2:" (?condOnf f2 S \<longrightarrow> ?LHS1 f2 S=?RHS1 f2 S)"
  let ?f="andForm f1 f2"

  show "(?condOnf ?f S \<longrightarrow> ?LHS1 ?f S=?RHS1 ?f S)"
  proof(rule impI)
  assume b1:"?condOnf ?f S"
  have c1:"?condOnf f1 S"
  apply(cut_tac b1,simp)
  by (metis Int_assoc inf_bot_right inf_sup_absorb)
   have c2:"?condOnf f2  S"
  apply(cut_tac b1,simp)
  by (metis Int_Un_distrib2 c1 sup_bot_left)
  with a1 a2 c1 c2
   show "?LHS1 ?f S=?RHS1 ?f S"
   by auto
   qed
next
  fix f1
  assume a1:" (?condOnf f1 S \<longrightarrow> ?LHS1 f1 S=?RHS1 f1 S)"
  let ?f="neg f1"
  show "( ?condOnf ?f S \<longrightarrow>?LHS1 ?f S=?RHS1 ?f S)"
  proof(rule impI)
  assume b1:"?condOnf ?f S"
  have c1:"?condOnf f1 S"
  by(cut_tac b1,simp)

   with a1 c1
   show "?LHS1 ?f S=?RHS1 ?f S"
   by auto
   qed

next
  fix f1 f2
  assume a1:" (?condOnf f1 S \<longrightarrow> ?LHS1 f1 S=?RHS1 f1 S)" and  a2:" (?condOnf f2 S \<longrightarrow> ?LHS1 f2 S=?RHS1 f2 S)"
  let ?f="implyForm f1 f2"

  show "(?condOnf ?f S \<longrightarrow> ?LHS1 ?f S=?RHS1 ?f S)"
  proof(rule impI)
  assume b1:"?condOnf ?f S"
  have c1:"?condOnf f1 S"
  apply(cut_tac b1,simp)
  by (metis Int_assoc inf_bot_right inf_sup_absorb)
   have c2:"?condOnf f2  S"
  apply(cut_tac b1,simp)
  by (metis Int_Un_distrib2 c1 sup_bot_left)
  with a1 a2 c1 c2
   show "?LHS1 ?f S=?RHS1 ?f S"
   by auto

  qed

next
  let ?f="chaos"
  show "( ?condOnf ?f S \<longrightarrow> ?LHS1 ?f S=?RHS1 ?f S)"
  by auto
next
  next
  fix f1 f2
  assume a1:" (?condOnf f1 S \<longrightarrow> ?LHS1 f1 S=?RHS1 f1 S)" and  a2:" (?condOnf f2 S \<longrightarrow> ?LHS1 f2 S=?RHS1 f2 S)"
  let ?f="orForm f1 f2"

  show "(?condOnf ?f S \<longrightarrow> ?LHS1 ?f S=?RHS1 ?f S)"
  proof(rule impI)
  assume b1:"?condOnf ?f S"
  have c1:"?condOnf f1 S"
  apply(cut_tac b1,simp)
  by (metis Int_assoc inf_bot_right inf_sup_absorb)
   have c2:"?condOnf f2  S"
  apply(cut_tac b1,simp)
  by (metis Int_Un_distrib2 c1 sup_bot_left)
  with a1 a2 c1 c2
   show "?LHS1 ?f S=?RHS1 ?f S"
   by auto

  qed
qed

lemma noEffectSubstExp [intro!]:

  shows " (  (varOfExp e \<inter>  (varOfSent S) ={}) \<Longrightarrow>(substExpByStatement e S)  =e) "
by (metis noEffectSubstAux)

lemma noEffectSubstForm [intro!]:

  shows "
             (varOfForm f \<inter>  (varOfSent S) ={}) \<Longrightarrow> (substFormByStatement f S)  =  f "
 by (metis noEffectSubstAux)

lemma  noEffectOnRule[simp,intro]:
  assumes a1:"  (varOfForm f \<inter>  (varOfSent (act r)) ={})"
  shows " invHoldForRule s f r R "  (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
  have "?P2 s"
  using assms noEffectSubstForm by auto
  then show "?P1 s \<or> ?P2 s \<or> ?P3 s"
  by auto
qed

lemma noEffectValOfForallStatement[simp,intro]:
  shows "( \<forall>i. (v \<notin>  (varOfSent (ps i))) ) \<Longrightarrow>  valOf (statement2Assigns  (forallSent (down N) ps)) v=IVar v"
  by(metis noEffectValOfForallStatementAux)

 lemma noEffectValOfForallStatement1[simp,intro]:
  shows "( \<forall>i. (v \<notin>  (varOfSent (ps i))) ) \<Longrightarrow>  expEval ( valOf (statement2Assigns  (forallSent (down N) ps)) v) s=s  v"
by auto

end