(*  Title:       Mutually recursive procedures
    Author:      Tobias Nipkow, 2001/2006
    Maintainer:  Tobias Nipkow
*)

section "Hoare Logics for Mutually Recursive Procedure"

theory PsLang imports Main begin

subsection\<open>The language\<close>

typedecl state
typedecl pname

type_synonym bexp = "state \<Rightarrow> bool"

datatype
  com = Do "state \<Rightarrow> state set"
      | Semi  com com          ("_; _"  [60, 60] 10)
      | Cond  bexp com com     ("IF _ THEN _ ELSE _"  60)
      | While bexp com         ("WHILE _ DO _"  60)
      | CALL pname
      | Local "(state \<Rightarrow> state)" com "(state \<Rightarrow> state \<Rightarrow> state)"
               ("LOCAL _; _; _" [0,0,60] 60)

consts body :: "pname \<Rightarrow> com"

text\<open>We generalize from a single procedure to a whole set of
procedures following the ideas of von Oheimb~\cite{Oheimb-FSTTCS99}.
The basic setup is modified only in a few places:
\begin{itemize}
\item We introduce a new basic type @{typ pname} of procedure names.
\item Constant @{term body} is now of type @{typ"pname \<Rightarrow> com"}.
\item The @{term CALL} command now has an argument of type @{typ pname},
the name of the procedure that is to be called.
\end{itemize}
\<close>

inductive
  exec :: "state \<Rightarrow> com \<Rightarrow> state \<Rightarrow> bool"   ("_/ -_\<rightarrow>/ _" [50,0,50] 50)
where
    Do:     "t \<in> f s \<Longrightarrow> s -Do f\<rightarrow> t"

  | Semi:   "\<lbrakk> s0 -c1\<rightarrow> s1; s1 -c2\<rightarrow> s2 \<rbrakk> \<Longrightarrow> s0 -c1;c2\<rightarrow> s2"

  | IfTrue:  "\<lbrakk> b s;  s -c1\<rightarrow> t \<rbrakk> \<Longrightarrow> s -IF b THEN c1 ELSE c2\<rightarrow> t"
  | IfFalse: "\<lbrakk> \<not>b s; s -c2\<rightarrow> t \<rbrakk> \<Longrightarrow> s -IF b THEN c1 ELSE c2\<rightarrow> t"

  | WhileFalse: "\<not>b s \<Longrightarrow> s -WHILE b DO c\<rightarrow> s"
  | WhileTrue:  "\<lbrakk> b s; s -c\<rightarrow> t; t -WHILE b DO c\<rightarrow> u \<rbrakk>
                \<Longrightarrow> s -WHILE b DO c\<rightarrow> u"

  | Call: "s -body p\<rightarrow> t \<Longrightarrow> s -CALL p\<rightarrow> t"

  | Local: "f s -c\<rightarrow> t \<Longrightarrow> s -LOCAL f; c; g\<rightarrow> g s t"

lemma [iff]: "(s -c;d\<rightarrow> u) = (\<exists>t. s -c\<rightarrow> t \<and> t -d\<rightarrow> u)"
by(auto elim: exec.cases intro:exec.intros)

lemma [iff]: "(s -IF b THEN c ELSE d\<rightarrow> t) =
              (s -if b s then c else d\<rightarrow> t)"
apply(rule iffI)
 apply(auto elim: exec.cases intro:exec.intros)
apply(auto intro:exec.intros split:if_split_asm)
done

lemma [iff]: "(s -CALL p\<rightarrow> t) = (s -body p\<rightarrow> t)"
by(blast elim: exec.cases intro:exec.intros)

lemma [iff]: "(s -LOCAL f; c; g\<rightarrow> u) = (\<exists>t. f s -c\<rightarrow> t \<and> u = g s t)"
by(fastforce elim: exec.cases intro:exec.intros)

inductive
  execn :: "state \<Rightarrow> com \<Rightarrow> nat \<Rightarrow> state \<Rightarrow> bool"   ("_/ -_-_\<rightarrow>/ _" [50,0,0,50] 50)
where
    Do:     "t \<in> f s \<Longrightarrow> s -Do f-n\<rightarrow> t"

  | Semi:   "\<lbrakk> s0 -c0-n\<rightarrow> s1; s1 -c1-n\<rightarrow> s2 \<rbrakk> \<Longrightarrow> s0 -c0;c1-n\<rightarrow> s2"

  | IfTrue: "\<lbrakk> b s; s -c0-n\<rightarrow> t \<rbrakk> \<Longrightarrow> s -IF b THEN c0 ELSE c1-n\<rightarrow> t"

  | IfFalse: "\<lbrakk> \<not>b s; s -c1-n\<rightarrow> t \<rbrakk> \<Longrightarrow> s -IF b THEN c0 ELSE c1-n\<rightarrow> t"

  | WhileFalse: "\<not>b s \<Longrightarrow> s -WHILE b DO c-n\<rightarrow> s"

  | WhileTrue:  "\<lbrakk> b s; s -c-n\<rightarrow> t; t -WHILE b DO c-n\<rightarrow> u \<rbrakk>
                \<Longrightarrow> s -WHILE b DO c-n\<rightarrow> u"

  | Call:  "s -body p-n\<rightarrow> t \<Longrightarrow> s -CALL p-Suc n\<rightarrow> t"

  | Local: "f s -c-n\<rightarrow> t \<Longrightarrow> s -LOCAL f; c; g-n\<rightarrow> g s t"

lemma [iff]: "(s -Do f-n\<rightarrow> t) = (t \<in> f s)"
by(auto elim: execn.cases intro:execn.intros)

lemma [iff]: "(s -c1;c2-n\<rightarrow> u) = (\<exists>t. s -c1-n\<rightarrow> t \<and> t -c2-n\<rightarrow> u)"
by(best elim: execn.cases intro:execn.intros)

lemma [iff]: "(s -IF b THEN c ELSE d-n\<rightarrow> t) =
              (s -if b s then c else d-n\<rightarrow> t)"
apply auto
apply(blast elim: execn.cases intro:execn.intros)+
done

lemma [iff]: "(s -CALL p- 0\<rightarrow> t) = False"
by(blast elim: execn.cases intro:execn.intros)

lemma [iff]: "(s -CALL p-Suc n\<rightarrow> t) = (s -body p-n\<rightarrow> t)"
by(blast elim: execn.cases intro:execn.intros)

lemma [iff]: "(s -LOCAL f; c; g-n\<rightarrow> u) = (\<exists>t. f s -c-n\<rightarrow> t \<and> u = g s t)"
by(auto elim: execn.cases intro:execn.intros)

lemma exec_mono[rule_format]: "s -c-m\<rightarrow> t \<Longrightarrow> \<forall>n. m \<le> n \<longrightarrow> s -c-n\<rightarrow> t"
apply(erule execn.induct)
       apply(blast)
      apply(blast)
     apply(simp)
    apply(simp)
   apply(simp add:execn.intros)
  apply(blast intro:execn.intros)
 apply(clarify)
 apply(rename_tac m)
 apply(case_tac m)
  apply simp
 apply simp
apply blast
done

lemma exec_iff_execn: "(s -c\<rightarrow> t) = (\<exists>n. s -c-n\<rightarrow> t)"
apply(rule iffI)
 apply(erule exec.induct)
        apply blast
       apply clarify
       apply(rename_tac m n)
       apply(rule_tac x = "max m n" in exI)
       apply(fastforce intro:exec.intros exec_mono simp add:max_def)
      apply fastforce
     apply fastforce
    apply(blast intro:execn.intros)
   apply clarify
   apply(rename_tac m n)
   apply(rule_tac x = "max m n" in exI)
   apply(fastforce elim:execn.WhileTrue exec_mono simp add:max_def)
  apply blast
 apply blast
apply(erule exE, erule execn.induct)
       apply blast
      apply blast
     apply fastforce
    apply fastforce
   apply(erule exec.WhileFalse)
  apply(blast intro: exec.intros)
 apply blast
apply blast
done

lemma while_lemma[rule_format]:
"s -w-n\<rightarrow> t \<Longrightarrow> \<forall>b c. w = WHILE b DO c \<and> P s \<and>
                    (\<forall>s s'. P s \<and> b s \<and> s -c-n\<rightarrow> s' \<longrightarrow> P s') \<longrightarrow> P t \<and> \<not>b t"
apply(erule execn.induct)
apply clarify+
defer
apply clarify+
apply(subgoal_tac "P t")
apply blast
apply blast
done

lemma while_rule:
 "\<lbrakk>s -WHILE b DO c-n\<rightarrow> t; P s; \<And>s s'. \<lbrakk>P s; b s; s -c-n\<rightarrow> s' \<rbrakk> \<Longrightarrow> P s'\<rbrakk>
  \<Longrightarrow> P t \<and> \<not>b t"
apply(drule while_lemma)
prefer 2 apply assumption
apply blast
done

end


theory Execute
  imports Main Unification Term Deduction
begin

section \<open>Assignment 9\<close>

subsection \<open>(a)\<close>

definition solve_Unif :: "constraint \<Rightarrow> (constraint_system \<times> msg_subst) list" where
  "solve_Unif c = (if \<not>(is_Variable (c_t c)) then
                     (foldr (\<lambda>u acc. let subst = msg_unify [((c_t c), u)] in
                                     if Option.is_none subst then acc
                                     else ([], (Option.the subst)) # acc) ((c_M c) @ (c_A c)) [])
                   else [])"

fun solve_Comp :: "constraint \<Rightarrow> (constraint_system \<times> msg_subst) list" where
  "solve_Comp (M | A \<rhd> (Hash t)) = [([M | A \<rhd> t], Variable)]"
| "solve_Comp (M | A \<rhd> (Pair t1 t2)) = [([M | A \<rhd> t1, M | A \<rhd> t2], Variable)]"
| "solve_Comp (M | A \<rhd> (SymEncrypt k t)) = [([M | A \<rhd> k, M | A \<rhd> t], Variable)]"
| "solve_Comp (M | A \<rhd> (PubKeyEncrypt k t)) = [([M | A \<rhd> k, M | A \<rhd> t], Variable)]"
| "solve_Comp (M | A \<rhd> (Sig \<iota> t)) = [([M | A \<rhd> \<iota>, M | A \<rhd> t], Variable)]"
| "solve_Comp _ = []"

definition solve_Proj :: "constraint \<Rightarrow> (constraint_system \<times> msg_subst) list" where
  "solve_Proj c = concat (map (\<lambda>m. case m of Pair t1 t2 \<Rightarrow> let A = c_A c in
                                                           let M = filter (\<lambda>m'. m \<noteq> m') (c_M c) in
                                                           [([(t1 # t2 # M) | (Pair t1 t2 # A) \<rhd> (c_t c)], Variable)]
                                   | _ \<Rightarrow> []) (c_M c))"

definition solve_Sdec :: "constraint \<Rightarrow> (constraint_system \<times> msg_subst) list" where
  "solve_Sdec c = concat (map (\<lambda>m. case m of SymEncrypt k u \<Rightarrow> let A = c_A c in
                                                               let M = filter (\<lambda>m'. m \<noteq> m') (c_M c) in
                                                               [([(u # M) | (SymEncrypt k u # A) \<rhd> (c_t c), M | (SymEncrypt k u # A) \<rhd> k], Variable)]
                                   | _ \<Rightarrow> []) (c_M c))"

definition solve_Adec :: "constraint \<Rightarrow> (constraint_system \<times> msg_subst) list" where
  "solve_Adec c = concat (map (\<lambda>m. case m of PubKeyEncrypt \<iota> u \<Rightarrow> let A = c_A c in
                                                                  let M = filter (\<lambda>m'. m \<noteq> m') (c_M c) in
                                                                  [([(u # M) | (PubKeyEncrypt \<iota> u # A) \<rhd> (c_t c)], Variable)]
                                   | _ \<Rightarrow> []) (c_M c))"

definition solve_Ksub :: "constraint \<Rightarrow> (constraint_system \<times> msg_subst) list" where
  "solve_Ksub c = concat (map (\<lambda>m. case m of PubKeyEncrypt (Variable x) u \<Rightarrow> let A = c_A c in
                                                                             let M = filter (\<lambda>m'. m \<noteq> m') (c_M c) in
                                                                             [([c_sapply (Variable(x := \<iota>)) ((PubKeyEncrypt (Variable x) u # M) | A \<rhd> (c_t c))], Variable(x := \<iota>))]
                                   | _ \<Rightarrow> []) (c_M c))"

function solve_rer :: "constraint_system \<Rightarrow> (constraint_system \<times> msg_subst) list" where
  "solve_rer [] = []"
| "solve_rer (c # cs') = (let unif = solve_Unif c in
                          let comp = solve_Comp c in
                          let proj = solve_Proj c in
                          let sdec = solve_Sdec c in
                          let adec = solve_Adec c in
                          let ksub = solve_Ksub c in
                          let cs = (unif @ comp @ proj @ sdec @ adec @ ksub) in
                          let \<sigma>s = map (\<lambda>(_, \<sigma>). \<sigma>) cs in
                          let \<sigma>_cs' = concat (map (\<lambda>\<sigma>. cs_sapply \<sigma> cs') \<sigma>s) in
                          cs @ (solve_rer \<sigma>_cs'))"
  by pat_completeness auto
termination
  sorry

subsection \<open>(b)\<close>

primrec map_until :: "((constraint_system \<times> msg_subst) \<Rightarrow> (constraint_system \<times> msg_subst) option) \<Rightarrow>
  (constraint_system \<times> msg_subst) list \<Rightarrow> (constraint_system \<times> msg_subst) option" where
  "map_until f [] = None"
| "map_until f (x # xs) = (let res = f x in
                           if Option.is_none res then (map_until f xs)
                           else res)"

function search :: "constraint_system \<Rightarrow> (constraint_system \<times> msg_subst) option" where
  "search cs = (if is_simple_cs cs then Some(cs, Variable)
                else (let rer_res = solve_rer cs in
                      map_until (\<lambda>(cs', \<sigma>). let res = search cs' in
                                            if Option.is_none res then None
                                            else (let cs'' = fst(the res) in
                                            let \<tau> = snd(the res) in
                                            Some(cs'', \<tau> \<circ>m \<sigma>))) rer_res))"
  by pat_completeness auto
termination
  apply (relation "measures [\<eta>_1, \<eta>_2]")
  subgoal by simp
  subgoal sorry
  done

subsection \<open>(c)\<close>

value "map (\<lambda>(cs, \<sigma>). (cs, map (\<lambda>v. (v, \<sigma> v)) [''A0''])) (solve_Unif ([Variable ''A0''] | [] \<rhd> Constant ''a''))"
value "solve_Proj ([Pair (Variable ''A0'') (Variable ''B0'')] | [] \<rhd> Constant ''t'')"
value "solve_Sdec ([SymEncrypt (Variable ''K'') (Constant ''u'')] | [] \<rhd> Constant ''t'')"
value "solve_Adec ([PubKeyEncrypt \<iota> (Constant ''u'')] | [] \<rhd> Constant ''t'')"
value "map (\<lambda>(cs, \<sigma>). (cs, map (\<lambda>v. (v, \<sigma> v)) [''X''])) (solve_Ksub ([PubKeyEncrypt (Variable ''X'') (Constant ''u'')] | [] \<rhd> Constant ''t''))"

value "map (\<lambda>(cs, \<sigma>). (cs, map (\<lambda>v. (v, \<sigma> v)) [''K1'']))
       (solve_Comp ([SymEncrypt (Variable ''K1'') (Constant ''m1'')] | [] \<rhd> (Pair (Variable ''K1'') (Constant ''m1''))))"
value "map (\<lambda>(cs, \<sigma>). (cs, map (\<lambda>v. (v, \<sigma> v)) [''K1'']))
       (solve_Sdec ([SymEncrypt (Variable ''K1'') (Constant ''m1'')]|[] \<rhd> Variable ''K1''))"
value "map (\<lambda>(cs, \<sigma>). (cs, map (\<lambda>v. (v, \<sigma> v)) [''K1'']))
       (solve_Sdec ([SymEncrypt (Variable ''K1'') (Constant ''m1'')]|[] \<rhd> Constant ''m1''))"
value "map_option (\<lambda>(cs, \<sigma>). (cs, map (\<lambda>v. (v, \<sigma> v)) [''A0'', ''B0'', ''K1'', ''Z0'']))
       (search [[SymEncrypt (Variable ''K1'') (Constant ''m1'')] | [] \<rhd> (Pair (Variable ''K1'') (Constant ''m1''))])"

(* value "map_option (\<lambda>(cs, \<sigma>). (cs, map (\<lambda>v. (v, \<sigma> v)) [''A0'', ''B0'', ''K1'', ''Z0'']))
       (search [ [Constant ''a'', Constant ''b'', \<iota>] | [] \<rhd> (Pair (Variable ''A0'') (Variable ''B0'')),
                 [PubKeyEncrypt (Variable ''B0'') (Pair (Constant ''k0'') (Sig (Variable ''A0'') (Constant ''k0''))), Constant ''a'', Constant ''b'', \<iota>] | [] \<rhd> (PubKeyEncrypt (Constant ''b'') (Pair (Variable ''K1'') (Sig (Constant ''a'') (Variable ''K1'')))),
                 [SymEncrypt (Variable ''K1'') (Constant ''m1''), PubKeyEncrypt (Variable ''B0'') (Pair (Constant ''k0'') (Sig (Variable ''A0'') (Constant ''k0''))), Constant ''a'', Constant ''b'', \<iota>] | [] \<rhd> (SymEncrypt (Constant ''k0'') (Variable ''Z0'')),
                 [SymEncrypt (Variable ''K1'') (Constant ''m1''), PubKeyEncrypt (Variable ''B0'') (Pair (Constant ''k0'') (Sig (Variable ''A0'') (Constant ''k0''))), Constant ''a'', Constant ''b'', \<iota>] | [] \<rhd> (Pair (Variable ''K1'') (Constant ''m1''))])" *)

(* value "map_option (\<lambda>(cs, \<sigma>). (cs, map (\<lambda>v. (v, \<sigma> v)) [''A0'', ''B0'', ''NA1'', ''NB0'']))
       (search [ [Constant ''a'', Constant ''b'', \<iota>] | [] \<rhd> (Pair (Variable ''A0'') (Variable ''B0'')),
                 [PubKeyEncrypt (Variable ''B0'') (Pair (Constant ''na0'') (Variable ''A0'')),  Constant ''a'', Constant ''b'', \<iota>] | [] \<rhd> (PubKeyEncrypt (Constant ''b'') (Pair (Variable ''NA1'') (Constant ''a''))),
                 [PubKeyEncrypt (Constant ''a'') (Pair (Variable ''NA1'') (Constant ''nb1'')), PubKeyEncrypt (Variable ''B0'') (Pair (Constant ''na0'') (Variable ''A0'')),  Constant ''a'', Constant ''b'', \<iota>] | [] \<rhd> (PubKeyEncrypt (Variable ''A0'') (Pair (Constant ''na0'') (Variable ''NB0''))),
                 [PubKeyEncrypt (Variable ''B0'') (Variable ''NB0''), PubKeyEncrypt (Constant ''a'') (Pair (Variable ''NA1'') (Constant ''nb1'')), PubKeyEncrypt (Variable ''B0'') (Pair (Constant ''na0'') (Variable ''A0'')),  Constant ''a'', Constant ''b'', \<iota>] | [] \<rhd> (PubKeyEncrypt (Constant ''b'') (Constant ''nb1'')),
                 [PubKeyEncrypt (Variable ''B0'') (Variable ''NB0''), PubKeyEncrypt (Constant ''a'') (Pair (Variable ''NA1'') (Constant ''nb1'')), PubKeyEncrypt (Variable ''B0'') (Pair (Constant ''na0'') (Variable ''A0'')),  Constant ''a'', Constant ''b'', \<iota>] | [] \<rhd> (Pair (Variable ''NA1'') (Constant ''nb1''))])" *)

section \<open>Assignment 9\<close>

subsection \<open>(a)\<close>

lemma inv_Unif:
  assumes "c = (M | A \<rhd> t)"
    and "c \<leadsto>\<^sub>1[\<sigma>] []"
  shows "\<exists>u. \<not>(is_Variable t) \<and> u \<in> (set M) \<union> (set A) \<and> Some(\<sigma>) = msg_unify [(t, u)]"
  using assms(2,1)
proof(cases rule: rer1.cases)
  case (Unif t u M A)
  then show ?thesis
    using assms by auto
qed

lemma solve_Unif_sound:
  assumes "c = (M | A \<rhd> t)"
    and "solve_Unif (c) = [([], \<sigma>)]"
  shows "c \<leadsto>\<^sub>1[\<sigma>] []"
  sorry

lemma solve_Comp_Hash_sound:
  assumes "c = (M | A \<rhd> (Hash t))"
    and "\<sigma> = Variable"
    and "cs = [(M | A \<rhd> t)]"
    and "solve_Comp (c) = [(cs, \<sigma>)]"
  shows "c \<leadsto>\<^sub>1[\<sigma>] cs"
  using assms rer1.CompHash by simp

lemma solve_Comp_Pair_sound:
  assumes "c = (M | A \<rhd> (Pair t1 t2))"
    and "\<sigma> = Variable"
    and "cs = [M | A \<rhd> t1, M | A \<rhd> t2]"
    and "solve_Comp (c) = [(cs, \<sigma>)]"
  shows "c \<leadsto>\<^sub>1[\<sigma>] cs"
  using assms rer1.CompPair by simp

lemma solve_Comp_SymEncrypt_sound:
  assumes "c = (M | A \<rhd> (SymEncrypt k t))"
    and "\<sigma> = Variable"
    and "cs = [M | A \<rhd> k, M | A \<rhd> t]"
    and "solve_Comp (c) = [(cs, \<sigma>)]"
  shows "c \<leadsto>\<^sub>1[\<sigma>] cs"
  using assms rer1.CompSymEncrypt by simp

lemma solve_Comp_PubKeyEncrypt_sound:
  assumes "c = (M | A \<rhd> (PubKeyEncrypt k t))"
    and "\<sigma> = Variable"
    and "cs = [M | A \<rhd> k, M | A \<rhd> t]"
    and "solve_Comp (c) = [(cs, \<sigma>)]"
  shows "c \<leadsto>\<^sub>1[\<sigma>] cs"
  using assms rer1.CompPubKeyEncrypt by simp

lemma solve_Comp_Sig_sound:
  assumes "c = (M | A \<rhd> (Sig \<iota> t))"
    and "\<sigma> = Variable"
    and "cs = [M | A \<rhd> \<iota>, M | A \<rhd> t]"
    and "solve_Comp (c) = [(cs, \<sigma>)]"
  shows "c \<leadsto>\<^sub>1[\<sigma>] cs"
  using assms rer1.CompSig by simp

subsection \<open>(b)\<close>

lemma solve_Unif_comp:
  assumes "c = (M | A \<rhd> t)"
    and "c \<leadsto>\<^sub>1[\<sigma>] []"
  shows "solve_Unif (c) = [([], \<sigma>)]"
  using inv_Unif[of c M A t \<sigma>]
  unfolding solve_Unif_def
  apply (simp only: Let_def)
  sorry

lemma solve_Comp_Hash_comp:
  assumes "c = (M | A \<rhd> (Hash t))"
    and "\<sigma> = Variable"
    and "cs = [(M | A \<rhd> t)]"
    and "c \<leadsto>\<^sub>1[\<sigma>] cs"
  shows "solve_Comp (c) = [(cs, \<sigma>)]"
  using assms by simp

lemma solve_Comp_Pair_comp:
  assumes "c = (M | A \<rhd> (Pair t1 t2))"
    and "\<sigma> = Variable"
    and "cs = [M | A \<rhd> t1, M | A \<rhd> t2]"
    and "c \<leadsto>\<^sub>1[\<sigma>] cs"
  shows "solve_Comp (c) = [(cs, \<sigma>)]"
  using assms by simp

lemma solve_Comp_SymEncrypt_comp:
  assumes "c = (M | A \<rhd> (SymEncrypt k t))"
    and "\<sigma> = Variable"
    and "cs = [M | A \<rhd> k, M | A \<rhd> t]"
    and "c \<leadsto>\<^sub>1[\<sigma>] cs"
  shows "solve_Comp (c) = [(cs, \<sigma>)]"
  using assms by simp

lemma solve_Comp_PubKeyEncrypt_comp:
  assumes "c = (M | A \<rhd> (PubKeyEncrypt k t))"
    and "\<sigma> = Variable"
    and "cs = [M | A \<rhd> k, M | A \<rhd> t]"
    and "c \<leadsto>\<^sub>1[\<sigma>] cs"
  shows "solve_Comp (c) = [(cs, \<sigma>)]"
  using assms by simp

lemma solve_Comp_Sig_comp:
  assumes "c = (M | A \<rhd> (Sig \<iota> t))"
    and "\<sigma> = Variable"
    and "cs = [M | A \<rhd> \<iota>, M | A \<rhd> t]"
    and "c \<leadsto>\<^sub>1[\<sigma>] cs"
  shows "solve_Comp (c) = [(cs, \<sigma>)]"
  using assms by simp

lemma solve_Proj_comp:
  assumes "c = ((M1 @ (Pair t1 t2) # M2) | A \<rhd> t)"
    and "\<sigma> = Variable"
    and "cs = [(M1 @ (t1 # t2 # M2)) | ((Pair t1 t2) # A) \<rhd> t]"
    and "c \<leadsto>\<^sub>1[\<sigma>] cs"
  shows "solve_Proj (c) = [(cs, \<sigma>)]"
  using assms
  unfolding solve_Proj_def
  apply (simp add: Let_def concat_def)
  sorry

lemma solve_Sdec_comp:
  assumes "c = (M1 @ (SymEncrypt k t) # M2) | A \<rhd> t"
    and "\<sigma> = Variable"
    and "cs = [(M1 @ (u # M2)) | ((SymEncrypt k t) # A) \<rhd> t, (M1 @ M2) | ((SymEncrypt k t) # A) \<rhd> k]"
    and "c \<leadsto>\<^sub>1[\<sigma>] cs"
  shows "solve_Sdec (c) = [(cs, \<sigma>)]"
  using assms
  unfolding solve_Sdec_def
  apply (simp add: Let_def concat_def)
  sorry

lemma solve_Adec_comp:
  assumes "c = (M1 @ (PubKeyEncrypt \<iota> u) # M2) | A \<rhd> t"
    and "\<sigma> = Variable"
    and "cs = [(M1 @ (u # M2)) | ((PubKeyEncrypt \<iota> u) # A) \<rhd> t]"
    and "c \<leadsto>\<^sub>1[\<sigma>] cs"
  shows "solve_Adec (c) = [(cs, \<sigma>)]"
  using assms
  unfolding solve_Adec_def
  apply (simp add: Let_def concat_def)
  sorry

lemma solve_Ksub_comp:
  assumes "c = (M1 @ (PubKeyEncrypt (Variable x) u) # M2) | A \<rhd> t"
    and "\<sigma> = Variable(x := \<iota>)"
    and "cs = [c_sapply (Variable(x := \<iota>)) ((M1 @ (PubKeyEncrypt (Variable x) u) # M2) | A \<rhd> t)]"
    and "c \<leadsto>\<^sub>1[\<sigma>] cs"
  shows "solve_Ksub (c) = [(cs, \<sigma>)]"
  using assms
  unfolding solve_Ksub_def
  apply (simp add: Let_def concat_def)
  sorry

end


(*
    Authors:      Jose Divasón
                  Sebastiaan Joosten
                  René Thiemann
                  Akihisa Yamada
*)
theory Code_Abort_Gcd
imports
  "HOL-Computational_Algebra.Polynomial_Factorial"
begin

text \<open>Dummy code-setup for @{const Gcd} and @{const Lcm} in the presence of
  Container.\<close>

definition dummy_Gcd where "dummy_Gcd x = Gcd x"
definition dummy_Lcm where "dummy_Lcm x = Lcm x"
declare  [[code abort: dummy_Gcd]]

lemma dummy_Gcd_Lcm: "Gcd x = dummy_Gcd x" "Lcm x = dummy_Lcm x"
  unfolding dummy_Gcd_def dummy_Lcm_def by auto

lemmas dummy_Gcd_Lcm_poly [code] = dummy_Gcd_Lcm
  [where ?'a = "'a :: {factorial_ring_gcd,semiring_gcd_mult_normalize} poly"]
lemmas dummy_Gcd_Lcm_int [code] = dummy_Gcd_Lcm [where ?'a = int]
lemmas dummy_Gcd_Lcm_nat [code] = dummy_Gcd_Lcm [where ?'a = nat]

declare [[code abort: Euclidean_Algorithm.Gcd Euclidean_Algorithm.Lcm]]

end


section \<open>Derived facts about classical registers\<close>

theory Classical_Extra
  imports Laws_Classical Misc
begin

lemma register_from_getter_setter_of_getter_setter[simp]: \<open>register_from_getter_setter (getter F) (setter F) = F\<close> if \<open>register F\<close>
  by (metis getter_of_register_from_getter_setter register_def setter_of_register_from_getter_setter that)

lemma valid_getter_setter_getter_setter[simp]: \<open>valid_getter_setter (getter F) (setter F)\<close> if \<open>register F\<close>
  by (metis getter_of_register_from_getter_setter register_def setter_of_register_from_getter_setter that)

lemma register_register_from_getter_setter[simp]: \<open>register (register_from_getter_setter g s)\<close> if \<open>valid_getter_setter g s\<close>
  using register_def that by blast

definition \<open>total_fun f = (\<forall>x. f x \<noteq> None)\<close>

lemma register_total:
  assumes \<open>register F\<close>
  assumes \<open>total_fun a\<close>
  shows \<open>total_fun (F a)\<close>
  using assms
  by (auto simp: register_def total_fun_def register_from_getter_setter_def option.case_eq_if)

lemma register_apply:
  assumes \<open>register F\<close>
  shows \<open>Some o register_apply F a = F (Some o a)\<close>
proof -
  have \<open>total_fun (F (Some o a))\<close>
    using assms apply (rule register_total)
    by (auto simp: total_fun_def)
  then show ?thesis
    by (auto simp: register_apply_def dom_def total_fun_def)
qed

lemma register_empty:
  assumes \<open>preregister F\<close>
  shows \<open>F Map.empty = Map.empty\<close>
  using assms unfolding preregister_def by auto

lemma compatible_setter:
  fixes F :: \<open>('a,'c) preregister\<close> and G :: \<open>('b,'c) preregister\<close>
  assumes [simp]: \<open>register F\<close> \<open>register G\<close>
  shows \<open>compatible F G \<longleftrightarrow> (\<forall>a b. setter F a o setter G b = setter G b o setter F a)\<close>
proof (intro allI iffI)
  fix a b
  assume \<open>compatible F G\<close>
  then show \<open>setter F a o setter G b = setter G b o setter F a\<close>
    apply (rule_tac compatible_setter)
    unfolding compatible_def by auto
next
  assume commute[rule_format, THEN fun_cong, unfolded o_def]: \<open>\<forall>a b. setter F a \<circ> setter G b = setter G b \<circ> setter F a\<close>
  have \<open>valid_getter_setter (getter F) (setter F)\<close>
    by auto
  then have \<open>F a \<circ>\<^sub>m G b = G b \<circ>\<^sub>m F a\<close> for a b
    apply (subst (2) register_from_getter_setter_of_getter_setter[symmetric, of F], simp)
    apply (subst (1) register_from_getter_setter_of_getter_setter[symmetric, of F], simp)
    apply (subst (2) register_from_getter_setter_of_getter_setter[symmetric, of G], simp)
    apply (subst (1) register_from_getter_setter_of_getter_setter[symmetric, of G], simp)
    unfolding register_from_getter_setter_def valid_getter_setter_def
    apply (auto intro!: ext simp: option.case_eq_if map_comp_def) (* Sledgehammer: *)
          apply ((metis commute option.distinct option.simps)+)[4]
      apply (smt (verit, ccfv_threshold) assms(2) commute valid_getter_setter_def valid_getter_setter_getter_setter)
     apply (smt (verit, ccfv_threshold) assms(2) commute valid_getter_setter_def valid_getter_setter_getter_setter)
    by (smt (verit, del_insts) assms(2) commute option.inject valid_getter_setter_def valid_getter_setter_getter_setter)
  then show \<open>compatible F G\<close>
    unfolding compatible_def by auto
qed

lemma register_from_getter_setter_compatibleI[intro]:
  assumes [simp]: \<open>valid_getter_setter g s\<close> \<open>valid_getter_setter g' s'\<close>
  assumes \<open>\<And>x y m. s x (s' y m) = s' y (s x m)\<close>
  shows \<open>compatible (register_from_getter_setter g s) (register_from_getter_setter g' s')\<close>
  apply (subst compatible_setter)
  using assms by auto

lemma separating_update1:
  \<open>separating TYPE(_) {update1 x y | x y. True}\<close>
  by (smt (verit) mem_Collect_eq separating_def update1_extensionality)

definition "permutation_register (p::'b\<Rightarrow>'a) = register_from_getter_setter p (\<lambda>a _. inv p a)"

lemma permutation_register_register[simp]:
  fixes p :: "'b \<Rightarrow> 'a"
  assumes [simp]: "bij p"
  shows "register (permutation_register p)"
  apply (auto intro!: register_register_from_getter_setter simp: permutation_register_def valid_getter_setter_def bij_inv_eq_iff)
  by (meson assms bij_inv_eq_iff)

lemma getter_permutation_register: \<open>bij p \<Longrightarrow> getter (permutation_register p) = p\<close>
  by (smt (verit, ccfv_threshold) bij_inv_eq_iff getter_of_register_from_getter_setter permutation_register_def valid_getter_setter_def)

lemma setter_permutation_register: \<open>bij p \<Longrightarrow> setter (permutation_register p) a m = inv p a\<close>
  by (metis bij_inv_eq_iff getter_permutation_register permutation_register_register valid_getter_setter_def valid_getter_setter_getter_setter)

definition empty_var :: \<open>'a::{CARD_1} update \<Rightarrow> 'b update\<close> where
  "empty_var = register_from_getter_setter (\<lambda>_. undefined) (\<lambda>_ m. m)"

lemma valid_empty_var[simp]: \<open>valid_getter_setter (\<lambda>_. (undefined::_::CARD_1)) (\<lambda>_ m. m)\<close>
  by (simp add: valid_getter_setter_def)

lemma register_empty_var[simp]: \<open>register empty_var\<close>
  using empty_var_def register_def valid_empty_var by blast

lemma getter_empty_var[simp]: \<open>getter empty_var m = undefined\<close>
  by (rule everything_the_same)

lemma setter_empty_var[simp]: \<open>setter empty_var a m = m\<close>
  by (simp add: empty_var_def setter_of_register_from_getter_setter)

lemma empty_var_compatible[simp]: \<open>compatible empty_var X\<close> if [simp]: \<open>register X\<close>
  apply (subst compatible_setter) by auto

lemma empty_var_compatible'[simp]: \<open>register X \<Longrightarrow> compatible X empty_var\<close>
  using compatible_sym empty_var_compatible by blast

paragraph \<open>Example\<close>

record memory =
  x :: "int*int"
  y :: nat

definition "X = register_from_getter_setter x (\<lambda>a b. b\<lparr>x:=a\<rparr>)"
definition "Y = register_from_getter_setter y (\<lambda>a b. b\<lparr>y:=a\<rparr>)"

lemma validX[simp]: \<open>valid_getter_setter x (\<lambda>a b. b\<lparr>x:=a\<rparr>)\<close>
  unfolding valid_getter_setter_def by auto

lemma registerX[simp]: \<open>register X\<close>
  using X_def register_def validX by blast

lemma validY[simp]: \<open>valid_getter_setter y (\<lambda>a b. b\<lparr>y:=a\<rparr>)\<close>
  unfolding valid_getter_setter_def by auto

lemma registerY[simp]: \<open>register Y\<close>
  using Y_def register_def validY by blast

lemma compatibleXY[simp]: \<open>compatible X Y\<close>
  unfolding X_def Y_def by auto

(* Avoiding namespace pollution *)
hide_const (open) x y x_update y_update X Y

end


(*  Title:      HOL/MicroJava/BV/LBVComplete.thy
    Author:     Gerwin Klein
    Copyright   2000 Technische Universitaet Muenchen
*)

section \<open>Completeness of the LBV\<close>

theory LBVComplete
imports LBVSpec Typing_Framework_1
begin

definition is_target :: "'s step_type \<Rightarrow> 's list \<Rightarrow> nat \<Rightarrow> bool" where
  "is_target step \<tau>s pc' \<longleftrightarrow> (\<exists>pc s'. pc' \<noteq> pc+1 \<and> pc < size \<tau>s \<and> (pc',s') \<in> set (step pc (\<tau>s!pc)))"

definition make_cert :: "'s step_type \<Rightarrow> 's list \<Rightarrow> 's \<Rightarrow> 's certificate" where
  "make_cert step \<tau>s B = map (\<lambda>pc. if is_target step \<tau>s pc then \<tau>s!pc else B) [0..<size \<tau>s] @ [B]"

locale lbvc = lbv +
  fixes \<tau>s :: "'a list"
  fixes c :: "'a list"
  defines cert_def: "c \<equiv> make_cert step \<tau>s \<bottom>"

  assumes mono: "mono r step (size \<tau>s) A"
  assumes pres: "pres_type step (size \<tau>s) A"
  assumes \<tau>s:  "\<forall>pc < size \<tau>s. \<tau>s!pc \<in> A \<and> \<tau>s!pc \<noteq> \<top>"
  assumes bounded: "bounded step (size \<tau>s)"

  assumes B_neq_T: "\<bottom> \<noteq> \<top>"

lemma (in lbvc) cert: "cert_ok c (size \<tau>s) \<top> \<bottom> A"
(*<*)
proof (unfold cert_ok_def, intro strip conjI)
  note [simp] = make_cert_def cert_def nth_append

  show "c!size \<tau>s = \<bottom>" by simp

  fix pc assume pc: "pc < size \<tau>s"
  from pc \<tau>s B_A show "c!pc \<in> A" by simp
  from pc \<tau>s B_neq_T show "c!pc \<noteq> \<top>" by simp
qed
(*>*)

lemmas [simp del] = split_paired_Ex

lemma (in lbvc) cert_target [intro?]:
  "\<lbrakk> (pc',s') \<in> set (step pc (\<tau>s!pc));
      pc' \<noteq> pc+1; pc < size \<tau>s; pc' < size \<tau>s \<rbrakk>
  \<Longrightarrow> c!pc' = \<tau>s!pc'"
(*<*) by (auto simp add: cert_def make_cert_def nth_append is_target_def) (*>*)

lemma (in lbvc) cert_approx [intro?]:
  "\<lbrakk> pc < size \<tau>s; c!pc \<noteq> \<bottom> \<rbrakk> \<Longrightarrow> c!pc = \<tau>s!pc"
(*<*) by (auto simp add: cert_def make_cert_def nth_append) (*>*)

lemma (in lbv) le_top [simp, intro]: "x <=_r \<top>"
(*<*) by (insert top) simp (*>*)

lemma (in lbv) merge_mono:
  assumes less:  "set ss\<^sub>2 {\<sqsubseteq>\<^bsub>r\<^esub>} set ss\<^sub>1"
  assumes x:     "x \<in> A"
  assumes ss\<^sub>1:   "snd`set ss\<^sub>1 \<subseteq> A"
  assumes ss\<^sub>2:   "snd`set ss\<^sub>2 \<subseteq> A"
  assumes boun:  "\<forall>x\<in>(fst`set ss\<^sub>1). x < size \<tau>s"
  assumes cert:  "cert_ok c (size \<tau>s) T B A"
  shows "merge c pc ss\<^sub>2 x \<sqsubseteq>\<^sub>r merge c pc ss\<^sub>1 x" (is "?s\<^sub>2 \<sqsubseteq>\<^sub>r ?s\<^sub>1")
(*<*)
proof-
  have "?s\<^sub>1 = \<top> \<Longrightarrow> ?thesis" by simp
  moreover {
    assume merge: "?s\<^sub>1 \<noteq> T"
    from x ss\<^sub>1 have "?s\<^sub>1 =
      (if \<forall>(pc',s')\<in>set ss\<^sub>1. pc' \<noteq> pc + 1 \<longrightarrow> s' \<sqsubseteq>\<^sub>r c!pc'
      then (map snd [(p', t') \<leftarrow> ss\<^sub>1 . p'=pc+1]) \<Squnion>\<^bsub>f\<^esub> x
      else \<top>)" by (rule merge_def)
    with merge obtain
      app: "\<forall>(pc',s')\<in>set ss\<^sub>1. pc' \<noteq> pc+1 \<longrightarrow> s' \<sqsubseteq>\<^sub>r c!pc'"
           (is "?app ss\<^sub>1") and
      sum: "(map snd [(p',t') \<leftarrow> ss\<^sub>1 . p' = pc+1] \<Squnion>\<^bsub>f\<^esub> x) = ?s\<^sub>1"
           (is "?map ss\<^sub>1 \<Squnion>\<^bsub>f\<^esub> x = _" is "?sum ss\<^sub>1 = _")
      by (simp split: if_split_asm)

    have "?app ss\<^sub>2"
    proof(intro strip, clarsimp )
      fix a b
      assume a_b: "(a, b) \<in> set ss\<^sub>2" and neq: "a \<noteq> Suc pc"
      from less a_b obtain y where y: "(a, y) \<in> set ss\<^sub>1 " and b_lt_y: "b \<sqsubseteq>\<^sub>r y" by (blast dest:lesub_step_typeD)
      with app have "a \<noteq> pc + 1 \<longrightarrow> y \<sqsubseteq>\<^bsub>r\<^esub> c!a" by auto
      with neq have "y \<sqsubseteq>\<^bsub>r\<^esub> c!a" by auto
      moreover from y ss\<^sub>1 have "y \<in> A" by auto
      moreover from a_b ss\<^sub>2 have "b \<in> A" by auto
      moreover from y boun cert have "c!a \<in> A" by (auto dest:cert_okD1)
      ultimately show "b \<sqsubseteq>\<^bsub>r\<^esub> c!a" using b_lt_y by (auto intro:trans_r)
    qed

    moreover {
      from ss\<^sub>1 have map1: "set (?map ss\<^sub>1) \<subseteq> A" by auto
      with x and semilat Semilat_axioms have "?sum ss\<^sub>1 \<in> A" by (auto intro!: plusplus_closed)
      with sum have "?s\<^sub>1 \<in> A" by simp
      moreover
      have mapD: "\<And>x ss. x \<in> set (?map ss) \<Longrightarrow> \<exists>p. (p,x) \<in> set ss \<and> p=pc+1" by auto
      from x map1 have "\<forall>x \<in> set (?map ss\<^sub>1). x \<sqsubseteq>\<^sub>r ?sum ss\<^sub>1" by clarify (rule pp_ub1)
      with sum have "\<forall>x \<in> set (?map ss\<^sub>1). x \<sqsubseteq>\<^sub>r ?s\<^sub>1" by simp
      then have "\<forall>x \<in> set (?map ss\<^sub>2). x \<sqsubseteq>\<^sub>r ?s\<^sub>1"
      proof(intro strip, clarsimp)
        fix b
        assume xa: "\<forall>xa. (Suc pc, xa) \<in>set ss\<^sub>1 \<longrightarrow> xa \<sqsubseteq>\<^bsub>r\<^esub> merge c pc ss\<^sub>1 x"
           and b: "(Suc pc, b) \<in> set ss\<^sub>2"
        from less b obtain y where y: "(Suc pc, y) \<in> set ss\<^sub>1 " and b_lt_y: "b \<sqsubseteq>\<^sub>r y" by (blast dest:lesub_step_typeD)
        from y xa have "y \<sqsubseteq>\<^bsub>r\<^esub> merge c pc ss\<^sub>1 x" by auto
        moreover from y ss\<^sub>1 have "y \<in> A" by auto
        moreover from b ss\<^sub>2 have "b \<in> A" by auto
        moreover from ss\<^sub>1 x have "merge c pc ss\<^sub>1 x \<in> A" by (auto intro:merge_pres)
        ultimately show "b \<sqsubseteq>\<^bsub>r\<^esub> merge c pc ss\<^sub>1 x" using b_lt_y by (auto intro:trans_r)
      qed
      moreover from map1 x have "x \<sqsubseteq>\<^sub>r (?sum ss\<^sub>1)" by (rule pp_ub2)
      with sum have "x \<sqsubseteq>\<^sub>r ?s\<^sub>1" by simp
      moreover from ss\<^sub>2 have "set (?map ss\<^sub>2) \<subseteq> A" by auto
      ultimately  have "?sum ss\<^sub>2 \<sqsubseteq>\<^sub>r ?s\<^sub>1" using x by - (rule pp_lub)
    }
    moreover from x ss\<^sub>2 have "?s\<^sub>2 =
      (if \<forall>(pc', s')\<in>set ss\<^sub>2. pc' \<noteq> pc + 1 \<longrightarrow> s' \<sqsubseteq>\<^sub>r c!pc'
      then map snd [(p', t') \<leftarrow> ss\<^sub>2 . p' = pc + 1] \<Squnion>\<^bsub>f\<^esub> x
      else \<top>)" by (rule merge_def)
    ultimately have ?thesis by simp
  }
  ultimately show ?thesis by (cases "?s\<^sub>1 = \<top>") auto
qed
(*>*)

lemma (in lbvc) wti_mono:
  assumes less: "s\<^sub>2 \<sqsubseteq>\<^sub>r s\<^sub>1"
  assumes pc: "pc < size \<tau>s" and s\<^sub>1: "s\<^sub>1 \<in> A" and s\<^sub>2: "s\<^sub>2 \<in> A"
  shows "wti c pc s\<^sub>2 \<sqsubseteq>\<^sub>r wti c pc s\<^sub>1" (is "?s\<^sub>2' \<sqsubseteq>\<^sub>r ?s\<^sub>1'")
(*<*)
proof -
  from bounded pc have "\<forall>(q,\<tau>) \<in> set(step pc s\<^sub>1). q < size \<tau>s" by (simp add:bounded_def)
  then have u: "\<forall>q \<in> fst ` set (step pc s\<^sub>1). q < size \<tau>s" by auto
  from mono pc s\<^sub>2 less have "set (step pc s\<^sub>2) {\<sqsubseteq>\<^bsub>r\<^esub>} set (step pc s\<^sub>1)" by (rule monoD)
  moreover from cert B_A pc have "c!Suc pc \<in> A" by (rule cert_okD3)
  moreover from pres s\<^sub>1 pc have "snd`set (step pc s\<^sub>1) \<subseteq> A" by (rule pres_typeD2)
  moreover from pres s\<^sub>2 pc have "snd`set (step pc s\<^sub>2) \<subseteq> A" by (rule pres_typeD2)
  ultimately show ?thesis using cert u by (simp add: wti merge_mono)
qed
(*>*)

lemma (in lbvc) wtc_mono:
  assumes less: "s\<^sub>2 \<sqsubseteq>\<^sub>r s\<^sub>1"
  assumes pc: "pc < size \<tau>s" and s\<^sub>1: "s\<^sub>1 \<in> A" and s\<^sub>2: "s\<^sub>2 \<in> A"
  shows "wtc c pc s\<^sub>2 \<sqsubseteq>\<^sub>r wtc c pc s\<^sub>1" (is "?s\<^sub>2' \<sqsubseteq>\<^sub>r ?s\<^sub>1'")
(*<*)
proof (cases "c!pc = \<bottom>")
  case True
  moreover from less pc s\<^sub>1 s\<^sub>2 have "wti c pc s\<^sub>2 \<sqsubseteq>\<^sub>r wti c pc s\<^sub>1" by (rule wti_mono)
  ultimately show ?thesis by (simp add: wtc)
next
  case False
  with pc have "c!pc = \<tau>s!pc" using cert_approx by auto
  with \<tau>s pc have c_pc_inA: "c!pc \<in> A"  by auto
  moreover from cert B_A pc have "c ! (pc + 1) \<in> A" by (auto dest: cert_okD3)
  ultimately  have inA: "wtc c pc s\<^sub>2 \<in> A"  using pres wtc_pres pc s\<^sub>2 by auto
  have "?s\<^sub>1' = \<top> \<Longrightarrow> ?thesis" by simp
  moreover {
    assume "?s\<^sub>1' \<noteq> \<top>"
    with False have c: "s\<^sub>1 \<sqsubseteq>\<^sub>r c!pc" by (simp add: wtc split: if_split_asm)
    from semilat have "order r A" by auto
    from this less c s\<^sub>2 s\<^sub>1 c_pc_inA have "s\<^sub>2 \<sqsubseteq>\<^sub>r c!pc" by (rule order_trans)
    with False c have ?thesis using inA by (simp add: wtc)
  }
  ultimately show ?thesis by (cases "?s\<^sub>1' = \<top>") auto
qed
(*>*)

lemma (in lbv) top_le_conv [simp]: "x \<in> A \<Longrightarrow> \<top> \<sqsubseteq>\<^sub>r x = (x = \<top>)"
(*<*)
  apply(subgoal_tac "order r A")
   apply (insert semilat T_A top)
   apply (rule top_le_conv)
      apply assumption+
  apply (simp add:semilat_def)
  done
  (*>*)

lemma (in lbv) neq_top [simp, elim]: "\<lbrakk> x \<sqsubseteq>\<^sub>r y; y \<noteq> \<top>; y \<in> A \<rbrakk> \<Longrightarrow> x \<noteq> \<top>"
(*<*) by (cases "x = T") auto (*>*)

lemma (in lbvc) stable_wti:
  assumes stable:  "stable r step \<tau>s pc" and pc: "pc < size \<tau>s"
  shows "wti c pc (\<tau>s!pc) \<noteq> \<top>"
(*<*)
proof -
  let ?step = "step pc (\<tau>s!pc)"
  from stable
  have less: "\<forall>(q,s')\<in>set ?step. s' \<sqsubseteq>\<^sub>r \<tau>s!q" by (simp add: stable_def)

  from cert B_A pc have cert_suc: "c!Suc pc \<in> A" by (rule cert_okD3)
  moreover from \<tau>s pc have "\<tau>s!pc \<in> A" by simp
  with pres pc have stepA: "snd`set ?step \<subseteq> A" by - (rule pres_typeD2)
  ultimately
  have "merge c pc ?step (c!Suc pc) =
    (if \<forall>(pc',s')\<in>set ?step. pc'\<noteq>pc+1 \<longrightarrow> s' \<sqsubseteq>\<^sub>r c!pc'
    then map snd [(p',t') \<leftarrow> ?step.p'=pc+1] \<Squnion>\<^bsub>f\<^esub> c!Suc pc
    else \<top>)" unfolding mrg_def by (rule lbv.merge_def [OF lbvc.axioms(1), OF lbvc_axioms])
  moreover {
    fix pc' s' assume s': "(pc',s') \<in> set ?step" and suc_pc: "pc' \<noteq> pc+1"
    with less have "s' \<sqsubseteq>\<^sub>r \<tau>s!pc'" by auto
    also from bounded pc s' have "pc' < size \<tau>s" by (rule boundedD)
    with s' suc_pc pc have "c!pc' = \<tau>s!pc'" ..
    hence "\<tau>s!pc' = c!pc'" ..
    finally have "s' \<sqsubseteq>\<^sub>r c!pc'" .
  } hence "\<forall>(pc',s')\<in>set ?step. pc'\<noteq>pc+1 \<longrightarrow> s' \<sqsubseteq>\<^sub>r c!pc'" by auto
  moreover from pc have "Suc pc = size \<tau>s \<or> Suc pc < size \<tau>s" by auto
  hence "map snd [(p',t') \<leftarrow> ?step.p'=pc+1] \<Squnion>\<^bsub>f\<^esub> c!Suc pc \<noteq> \<top>" (is "?map \<Squnion>\<^bsub>f\<^esub> _ \<noteq> _")
  proof (rule disjE)
    assume pc': "Suc pc = size \<tau>s"
    with cert have "c!Suc pc = \<bottom>" by (simp add: cert_okD2)
    moreover
    from pc' bounded pc
    have "\<forall>(p',t')\<in>set ?step. p'\<noteq>pc+1" by clarify (drule boundedD, auto)
    hence "[(p',t') \<leftarrow> ?step. p'=pc+1] = []" by (blast intro: filter_False)
    hence "?map = []" by simp
    ultimately show ?thesis by (simp add: B_neq_T)
  next
    assume pc': "Suc pc < size \<tau>s"
    from pc' \<tau>s have \<tau>s_inA: "\<tau>s!Suc pc \<in> A" by simp
    moreover note cert_suc
    moreover from stepA have "set ?map \<subseteq> A" by auto
    moreover have "\<And>s. s \<in> set ?map \<Longrightarrow> \<exists>t. (Suc pc, t) \<in> set ?step" by auto
    with less have "\<forall>s' \<in> set ?map. s' \<sqsubseteq>\<^sub>r \<tau>s!Suc pc" by auto
    moreover from pc' \<tau>s_inA have "c!Suc pc \<sqsubseteq>\<^sub>r \<tau>s!Suc pc"
      by (cases "c!Suc pc = \<bottom>") (auto dest: cert_approx)
    ultimately have "?map \<Squnion>\<^bsub>f\<^esub> c!Suc pc \<sqsubseteq>\<^sub>r \<tau>s!Suc pc" by (rule pp_lub)
    moreover from pc' \<tau>s have "\<tau>s!Suc pc \<noteq> \<top>" by simp
    ultimately show ?thesis using \<tau>s_inA by auto
  qed
  ultimately have "merge c pc ?step (c!Suc pc) \<noteq> \<top>" by simp
  thus ?thesis by (simp add: wti)
qed
(*>*)

lemma (in lbvc) wti_less:
  assumes stable: "stable r step \<tau>s pc" and suc_pc: "Suc pc < size \<tau>s"
  shows "wti c pc (\<tau>s!pc) \<sqsubseteq>\<^sub>r \<tau>s!Suc pc" (is "?wti \<sqsubseteq>\<^sub>r _")
(*<*)
proof -
  let ?step = "step pc (\<tau>s!pc)"

  from stable
  have less: "\<forall>(q,s')\<in>set ?step. s' \<sqsubseteq>\<^sub>r \<tau>s!q" by (simp add: stable_def)

  from suc_pc have pc: "pc < size \<tau>s" by simp
  with cert B_A have cert_suc: "c!Suc pc \<in> A" by (rule cert_okD3)
  moreover from \<tau>s pc have "\<tau>s!pc \<in> A" by simp
  with pres pc have stepA: "snd`set ?step \<subseteq> A" by - (rule pres_typeD2)
  moreover from stable pc have "?wti \<noteq> \<top>" by (rule stable_wti)
  hence "merge c pc ?step (c!Suc pc) \<noteq> \<top>" by (simp add: wti)
  ultimately
  have "merge c pc ?step (c!Suc pc) =
    map snd [(p',t') \<leftarrow> ?step.p'=pc+1] \<Squnion>\<^bsub>f\<^esub> c!Suc pc" by (rule merge_not_top_s)
  hence "?wti = \<dots>" (is "_ = (?map \<Squnion>\<^bsub>f\<^esub> _)" is "_ = ?sum") by (simp add: wti)
  also {
    from suc_pc \<tau>s have \<tau>s_inA: "\<tau>s!Suc pc \<in> A" by simp
    moreover note cert_suc
    moreover from stepA have "set ?map \<subseteq> A" by auto
    moreover have "\<And>s. s \<in> set ?map \<Longrightarrow> \<exists>t. (Suc pc, t) \<in> set ?step" by auto
    with less have "\<forall>s' \<in> set ?map. s' \<sqsubseteq>\<^sub>r \<tau>s!Suc pc" by auto
    moreover from suc_pc \<tau>s_inA have "c!Suc pc \<sqsubseteq>\<^sub>r \<tau>s!Suc pc"
      by (cases "c!Suc pc = \<bottom>") (auto dest: cert_approx)
    ultimately have "?sum \<sqsubseteq>\<^sub>r \<tau>s!Suc pc" by (rule pp_lub)
  }
  finally show ?thesis .
qed
(*>*)

lemma (in lbvc) stable_wtc:
  assumes stable: "stable r step \<tau>s pc" and pc: "pc < size \<tau>s"
  shows "wtc c pc (\<tau>s!pc) \<noteq> \<top>"
(*<*)
proof -
  from stable pc have wti: "wti c pc (\<tau>s!pc) \<noteq> \<top>" by (rule stable_wti)
  show ?thesis
  proof (cases "c!pc = \<bottom>")
    case True with wti show ?thesis by (simp add: wtc)
  next
    case False
    with pc have "c!pc = \<tau>s!pc" ..
    with False wti \<tau>s pc show ?thesis by (simp add: wtc)
  qed
qed
(*>*)

lemma (in lbvc) wtc_less:
  assumes stable: "stable r step \<tau>s pc" and suc_pc: "Suc pc < size \<tau>s"
  shows "wtc c pc (\<tau>s!pc) \<sqsubseteq>\<^sub>r \<tau>s!Suc pc" (is "?wtc \<sqsubseteq>\<^sub>r _")
(*<*)
proof (cases "c!pc = \<bottom>")
  case True
  moreover from stable suc_pc have "wti c pc (\<tau>s!pc) \<sqsubseteq>\<^sub>r \<tau>s!Suc pc" by (rule wti_less)
  ultimately show ?thesis by (simp add: wtc)
next
  case False
  from suc_pc have pc: "pc < size \<tau>s" by simp
  with stable have "?wtc \<noteq> \<top>" by (rule stable_wtc)
  with False have "?wtc = wti c pc (c!pc)"
    by (unfold wtc) (simp split: if_split_asm)
  also from pc False have "c!pc = \<tau>s!pc" ..
  finally have "?wtc = wti c pc (\<tau>s!pc)" .
  also from stable suc_pc have "wti c pc (\<tau>s!pc) \<sqsubseteq>\<^sub>r \<tau>s!Suc pc" by (rule wti_less)
  finally show ?thesis .
qed
(*>*)

lemma (in lbvc) wt_step_wtl_lemma:
  assumes wt_step: "wt_step r \<top> step \<tau>s"
  shows "\<And>pc s. pc+size ls = size \<tau>s \<Longrightarrow> s \<sqsubseteq>\<^sub>r \<tau>s!pc \<Longrightarrow> s \<in> A \<Longrightarrow> s\<noteq>\<top> \<Longrightarrow>
                wtl ls c pc s \<noteq> \<top>"
  (is "\<And>pc s. _ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> _ \<Longrightarrow> ?wtl ls pc s \<noteq> _")
(*<*)
proof (induct ls)
  fix pc s assume "s\<noteq>\<top>" thus "?wtl [] pc s \<noteq> \<top>" by simp
next
  fix pc s i ls
  assume "\<And>pc s. pc+size ls=size \<tau>s \<Longrightarrow> s \<sqsubseteq>\<^sub>r \<tau>s!pc \<Longrightarrow> s \<in> A \<Longrightarrow> s\<noteq>\<top> \<Longrightarrow>
                  ?wtl ls pc s \<noteq> \<top>"
  moreover
  assume pc_l: "pc + size (i#ls) = size \<tau>s"
  hence suc_pc_l: "Suc pc + size ls = size \<tau>s" by simp
  ultimately
  have IH: "\<And>s. s \<sqsubseteq>\<^sub>r \<tau>s!Suc pc \<Longrightarrow> s \<in> A \<Longrightarrow> s \<noteq> \<top> \<Longrightarrow> ?wtl ls (Suc pc) s \<noteq> \<top>" .

  from pc_l obtain pc: "pc < size \<tau>s" by simp
  with wt_step have stable: "stable r step \<tau>s pc" by (simp add: wt_step_def)
  moreover note pc
  ultimately have wt_\<tau>s: "wtc c pc (\<tau>s!pc) \<noteq> \<top>" by (rule stable_wtc)

  assume s_\<tau>s: "s \<sqsubseteq>\<^sub>r \<tau>s!pc"
  assume sA: "s \<in> A"

  from \<tau>s pc have \<tau>s_pc:"\<tau>s!pc \<in> A" by auto
  moreover from cert pc have c1: "c!pc \<in> A" by (rule cert_okD1)
  moreover from cert B_A pc have c2: "c!Suc pc \<in> A" by (rule cert_okD3)
  ultimately have wtc1: "wtc c pc (\<tau>s!pc) \<in> A"
              and wtc2: "wtc c pc s \<in> A" using pres sA pc by (auto intro:wtc_pres)

  from s_\<tau>s pc \<tau>s_pc sA have wt_s_\<tau>s: "wtc c pc s \<sqsubseteq>\<^sub>r wtc c pc (\<tau>s!pc)" by (rule wtc_mono)
  with wt_\<tau>s have wt_s: "wtc c pc s \<noteq> \<top>"  using wtc1 by simp
  moreover assume s: "s \<noteq> \<top>"
  ultimately have "ls = [] \<Longrightarrow> ?wtl (i#ls) pc s \<noteq> \<top>" by simp
  moreover {
    assume "ls \<noteq> []"
    with pc_l have suc_pc: "Suc pc < size \<tau>s" by (auto simp add: neq_Nil_conv)
    with stable have t: "wtc c pc (\<tau>s!pc) \<sqsubseteq>\<^sub>r \<tau>s!Suc pc" by (rule wtc_less)
    from suc_pc \<tau>s have "\<tau>s!Suc pc \<in> A" by auto
    with t wt_s_\<tau>s wtc1 wtc2 have "wtc c pc s \<sqsubseteq>\<^sub>r \<tau>s!Suc pc" by (auto intro: trans_r)
    moreover from cert suc_pc have "c!pc \<in> A" "c!(pc+1) \<in> A"
      by (auto simp add: cert_ok_def)
    from pres this sA pc have "wtc c pc s \<in> A" by (rule wtc_pres)
    ultimately have "?wtl ls (Suc pc) (wtc c pc s) \<noteq> \<top>" using IH wt_s by blast
    with s wt_s have "?wtl (i#ls) pc s \<noteq> \<top>" by simp
  }
  ultimately show "?wtl (i#ls) pc s \<noteq> \<top>" by (cases ls) blast+
qed
(*>*)

theorem (in lbvc) wtl_complete:
  assumes wt: "wt_step r \<top> step \<tau>s"
  assumes s: "s \<sqsubseteq>\<^sub>r \<tau>s!0" "s \<in> A" "s \<noteq> \<top>" and eq: "size ins = size \<tau>s"
  shows "wtl ins c 0 s \<noteq> \<top>"
(*<*)
proof -
  from eq have "0+size ins = size \<tau>s" by simp
  from wt this s show ?thesis by (rule wt_step_wtl_lemma)
qed
(*>*)

end


theory Dutch_National_Flag_Monad_Definitions_Lemmas
imports
  "Dutch_National_Flag_Monad_Eisbach"
begin

section\<open>Aux. lemmas about values inside the array\<close>

text\<open>These proofs have been made to make Isabelle able to infer the correct value at position @{text i} in the array.
  The proof contains the same information in the assumptions that can be inferred from the conditional-statements and precondition.\<close>
lemma value_must_be_one : "\<lbrakk>xs e ! i e  \<noteq> 0 ; xs e! i e \<noteq> 2 ; i e < length (xs e) ; set(xs e) \<subseteq> {0,1,2}\<rbrakk> \<Longrightarrow> xs e ! i e = 1"
  by (smt insertE insert_subset mk_disjoint_insert nth_mem singletonD)

lemma value_must_be_two_aux : "\<lbrakk>xs e ! i e  \<noteq> 0 ; xs e! i e \<noteq> 1 ; i e < length (xs e) ; set(xs e) \<subseteq> {0,1,2}\<rbrakk> \<Longrightarrow> xs e ! i e = 2"
  by (smt insertE insert_subset mk_disjoint_insert nth_mem singletonD)

lemma value_must_be_two_aux1 : "\<lbrakk>xs e! i e > 1 ; i e < length (xs e) ; set(xs e) \<subseteq> {0,1,2}\<rbrakk> \<Longrightarrow> xs e ! i e = 2"
  using value_must_be_one by force

lemma value_must_be_two : "\<lbrakk>xs e ! i e  > 0 ; xs e! i e > 1 ; i e < length (xs e) ; set(xs e) \<subseteq> {0,1,2}\<rbrakk> \<Longrightarrow> xs e ! i e = 2"
  using nat_neq_iff value_must_be_two_aux by blast

lemma value_must_be_one_aux : "\<lbrakk>\<not>xs e ! i e  > 1 ; \<not>xs e! i e < 1 ; i e < length (xs e) ; set(xs e) \<subseteq> {0,1,2}\<rbrakk> \<Longrightarrow> xs e ! i e = 1"
  by linarith

section\<open>Inc lowbound - proof\<close>
text\<open>Inc lowbound will keep the relationship between variables and both the @{text i} and @{text low} variables will be increased\<close>
lemma inc_lowbound_spec: "spec (inc_lowbound_pre e) inc_lowbound (GG (inc_lowbound_post e))"
  unfolding inc_lowbound_pre_def loop_update_action_pre_def dnfp_variables_invariants_def GG_def inc_lowbound_post_def loop_update_action_post_def dnfp_post_def
  apply(simp_all add: inc_lowbound_def)
  apply(intro get_rule; intro allI; simp)
  apply(intro conj_rule_right)
  apply(intro seq_rule[of _ _ "(\<lambda>_ y. high e = high y)"])
  apply(rewrite_env simps: swap_def xs_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  apply (intro seq_rule[of _ _ "(\<lambda>_ y. high e = high y)"])
  apply(rewrite_env simps: i_Env_def)
  apply(rewrite_env simps: low_Env_def)
  apply (intro seq_rule[of _ _ "(\<lambda>_ y. low e = low y)"])
  apply(rewrite_env simps: xs_Env_def swap_def)
  apply(all_Get_Seq)
  apply(intro seq_rule[of _ _ "(\<lambda>_ y. low e = low y)"])
  apply (simp add: spec_def put_def put_state_def swap_def get_state_def i_Env_def)
  apply(all_Get_Seq)
  apply(simp add: spec_def put_def get_state_def put_state_def low_Env_def)
  apply (intro seq_rule[of _ _ "(\<lambda>_ y. length (xs e) = length (xs y))"])
  apply (simp add: spec_def put_def put_state_def swap_def get_state_def xs_Env_def i_Env_def)
  apply(all_Get_Seq)
  apply (intro seq_rule[of _ _ "(\<lambda>_ y. length (xs e) = length (xs y))"])
  apply (simp add: spec_def put_def put_state_def swap_def get_state_def i_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  apply(simp add: spec_def put_def get_state_def put_state_def low_Env_def)
  apply (intro seq_rule[of _ _ "(\<lambda>_ y. high y = high e)"])
  apply (simp add: spec_def put_def put_state_def swap_def get_state_def xs_Env_def i_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  apply (intro seq_rule[of _ _ "(\<lambda>_ y. high y = high e)"])
  apply (simp add: spec_def put_def put_state_def swap_def get_state_def i_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  apply(simp add: spec_def put_def get_state_def put_state_def low_Env_def)
  apply (intro seq_rule[of _ _ "(\<lambda>_ y. low y = low e)"])
  apply (simp add: spec_def put_def put_state_def swap_def get_state_def xs_Env_def i_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  apply (intro seq_rule[of _ _ "(\<lambda>_ y. low y = low e)"])
  apply (simp add: spec_def put_def put_state_def swap_def get_state_def i_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  apply(simp add: spec_def put_def get_state_def put_state_def low_Env_def)
  apply (intro seq_rule[of _ _ "(\<lambda>_ y. i y = i e)"])
  apply (simp add: spec_def put_def put_state_def swap_def get_state_def xs_Env_def i_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  apply (intro seq_rule[of _ _ "(\<lambda>_ y. i y > i e)"])
  apply (simp add: spec_def put_def put_state_def swap_def get_state_def i_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  apply(simp add: spec_def put_def get_state_def put_state_def low_Env_def)
  apply (intro seq_rule[of _ _ "(\<lambda>_ y. high y - i y \<le> high e - i e)"])
  apply (simp add: spec_def put_def put_state_def swap_def get_state_def xs_Env_def i_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  apply (intro seq_rule[of _ _ "(\<lambda>_ y. high y - i y \<le> high e - i e)"])
  apply (simp add: spec_def put_def put_state_def swap_def get_state_def i_Env_def)
  apply (linarith)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  apply(simp add: spec_def put_def get_state_def put_state_def low_Env_def)
  apply (intro seq_rule[of _ _ "(\<lambda>x y. mset (xs e) = mset (xs y))"])
  apply (simp add: spec_def put_def put_state_def swap_def get_state_def xs_Env_def i_Env_def)
  apply (metis (no_types, hide_lams) Multiset.mset_swap le_less_trans less_le_trans)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  apply (intro seq_rule[of _ _ "(\<lambda>x y. mset (xs e) = mset (xs y))"])
  apply (simp add: spec_def put_def put_state_def swap_def get_state_def i_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  apply(simp add: spec_def put_def get_state_def put_state_def low_Env_def)
  apply (intro seq_rule[of _ _ "(\<lambda>x y. high y - i y = high e - i e \<and> high e > i e)"])
  apply (simp add: spec_def put_def put_state_def swap_def get_state_def xs_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  apply (intro seq_rule[of _ _ "(\<lambda>x y. Suc(high y - i y) = high e - i e)"])
  apply (simp add: spec_def put_def put_state_def get_state_def i_Env_def)
  apply linarith
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  apply(simp add: spec_def put_def get_state_def put_state_def low_Env_def)
  apply (intro seq_rule[of _ _ "(\<lambda>x y. i y \<ge> i e)"])
  apply (simp add: spec_def put_def put_state_def swap_def get_state_def xs_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  apply (intro seq_rule[of _ _ "(\<lambda>x y. i y > i e)"])
  apply (simp add: spec_def put_def put_state_def get_state_def i_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  by(simp add: spec_def put_def get_state_def put_state_def low_Env_def)

subsection\<open>Invariants - inc lowbound\<close>
text\<open>These proofs show that the invariants on the ranges are kept by a @{text inc_lowbound_action}\<close>
lemma inc_lowbound_invariantRed: "spec inc_lowbound_inv1 inc_lowbound (GG dnfp_inv1)"
  unfolding inc_lowbound_inv1_def loop_update_action_pre_def  GG_def loop_update_action_inv1_def dnfp_inv1_def low_invariant_is_0_Env_def dnfp_variables_invariants_def
  apply(simp_all add: inc_lowbound_def)
  apply(intro get_rule; intro allI; simp)
  apply(intro seq_rule[of _ _ "(\<lambda>x s. i s < high s \<and>
                 low s \<le> i s \<and>
                 high s \<le> length (xs s) \<and>
                 set (xs s) \<subseteq> {0, 1, 2} \<and>
                 (\<forall>x \<le> low s. xs s ! x = 0))"])
  apply (simp add: spec_def put_def put_state_def swap_def get_state_def xs_Env_def)
  apply (smt length_list_update less_le_trans nth_list_update order.not_eq_order_implies_strict set_swap)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  apply(intro seq_rule[of _ _ "(\<lambda>x s. i s \<le> high s \<and>
                 low s < i s \<and>
                 high s \<le> length (xs s) \<and>
                 set (xs s) \<subseteq> {0, 1, 2} \<and>
                 (\<forall>x\<le>low s. xs s ! x = 0))"])
  apply (simp add: spec_def put_def put_state_def get_state_def i_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  by (simp add: spec_def put_def put_state_def get_state_def low_Env_def)

lemma inc_lowbound_invariantWhite: "spec inc_lowbound_inv2 inc_lowbound (GG dnfp_inv2)"
  unfolding inc_lowbound_inv2_def loop_update_action_inv2_def  inc_lowbound_inv2_def loop_update_action_pre_def dnfp_inv2_def GG_def invariant_low_to_j_is_1_Env_def dnfp_variables_invariants_def
  apply(simp_all add: inc_lowbound_def)
  apply(intro get_rule; intro allI; simp)
  apply(intro seq_rule[of _ _ "(\<lambda>x s. i s < high s \<and>
                 low s \<le> i s \<and>
                 high s \<le> length (xs s) \<and>
                 set (xs s) \<subseteq> {0, 1, 2} \<and>
                 (\<forall>x. low s < x \<and> x \<le> i s \<longrightarrow> xs s ! x = 1))"])
  apply (simp add: spec_def put_def put_state_def get_state_def xs_Env_def swap_def)
  apply (smt le_less less_le_trans nth_list_update set_swap)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  apply(intro seq_rule[of _ _ "(\<lambda>x s. i s \<le> high s \<and>
                 low s < i s \<and>
                 high s \<le> length (xs s) \<and>
                 set (xs s) \<subseteq> {0, 1, 2} \<and>
                 (\<forall>x. low s < x \<and> x < i s \<longrightarrow> xs s ! x = 1))"])
  apply (simp add: spec_def put_def put_state_def  get_state_def i_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  by (simp add: spec_def put_def put_state_def  get_state_def low_Env_def)

lemma inc_lowbound_invariantBlue: "spec inc_lowbound_inv3  inc_lowbound (GG dnfp_inv3)"
  unfolding  inc_lowbound_inv3_def loop_update_action_inv3_def loop_update_action_pre_def dnfp_inv3_def  GG_def high_invariant_is_2_Env_def dnfp_variables_invariants_def
  apply(simp_all add: inc_lowbound_def)
  apply(intro get_rule; intro allI; simp)
  apply(intro seq_rule[of _ _ "(\<lambda>x s.
                       low s \<le> i s \<and>
                       high s \<le> length (xs s) \<and>
                       set (xs s) \<subseteq> {0, 1, 2} \<and>
                       i s < high s \<and>
                       (\<forall>x. high s \<le> x \<and> x < length (xs s) \<longrightarrow> xs s ! x = 2))"])
  apply (simp add: spec_def put_def put_state_def swap_def get_state_def xs_Env_def)
  apply (smt less_le_trans not_less set_swap)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  apply(intro seq_rule[of _ _ "(\<lambda>x s. i s \<le> high s \<and>
                 low s < i s \<and>
                 high s \<le> length (xs s) \<and>
                 set (xs s) \<subseteq> {0, 1, 2} \<and>
                 (\<forall>x. high s \<le> x \<and> x < length (xs s) \<longrightarrow> xs s ! x = 2))"])
  apply (simp add: spec_def put_def put_state_def get_state_def i_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  by (simp add: spec_def put_def put_state_def get_state_def low_Env_def)

text\<open>All invariants are preserved\<close>
lemma inc_lowbound_invariants: "spec inc_lowbound_inv_pre  inc_lowbound (GG dnfp_inv)"
  unfolding inc_lowbound_inv_pre_def GG_def dnfp_inv_def loop_update_action_inv_def
  by (smt GG_def inc_lowbound_inv1_def inc_lowbound_inv2_def inc_lowbound_inv3_def inc_lowbound_invariantBlue inc_lowbound_invariantRed inc_lowbound_invariantWhite loop_update_action_inv1_def loop_update_action_inv2_def loop_update_action_inv3_def spec_def split_beta')

section\<open>Dec highbound proof\<close>
lemma dec_highbound_spec: "spec (dec_highbound_pre e) dec_highbound (GG (dec_highbound_post e))"
  unfolding dec_highbound_pre_def dnfp_variables_invariants_def dnfp_post_def loop_update_action_pre_def GG_def dec_highbound_post_def loop_update_action_post_def
  apply(simp_all add: dec_highbound_def)
  apply(intro get_rule; intro allI; simp)
  apply(intro conj_rule_right)
  apply(intro seq_rule[of _ _ "(\<lambda>_ y. high y < length (xs y))"])
  apply (simp add: spec_def put_def put_state_def get_state_def high_Env_def)
  apply linarith
  apply(intro allI; simp)
  apply(intro get_rule; intro allI; simp)
  apply (simp add: spec_def put_def put_state_def get_state_def xs_Env_def swap_def)
  apply(intro seq_rule[of _ _ "(\<lambda>_ y. high y < high e)"])
  apply (simp add: spec_def put_def put_state_def get_state_def high_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI; simp)
  apply (simp add: spec_def put_def put_state_def get_state_def xs_Env_def)
  apply(intro seq_rule[of _ _ "(\<lambda>_ y. low e = low y)"])
  apply (simp add: spec_def put_def put_state_def get_state_def high_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI; simp)
  apply (simp add: spec_def put_def put_state_def get_state_def xs_Env_def)
  apply(intro seq_rule[of _ _ "(\<lambda>_ y. i e = i y)"])
  apply (simp add: spec_def put_def put_state_def get_state_def high_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI; simp)
  apply (simp add: spec_def put_def put_state_def get_state_def xs_Env_def)
  apply(intro seq_rule[of _ _ "(\<lambda>_ y. xs y ! i y = 2 \<and> high y < length(xs y) \<and> high y \<ge> i y)"])
  apply (simp add: spec_def put_def put_state_def get_state_def high_Env_def)
  using less_le_trans value_must_be_two_aux1 apply auto[1]
  apply(intro allI; simp)
  apply(intro get_rule; intro allI; simp)
  apply (simp add: spec_def put_def put_state_def get_state_def xs_Env_def swap_def)
  apply(intro seq_rule[of _ _ "(\<lambda>_ y. length (xs e) = length (xs y))"])
  apply (simp add: spec_def put_def put_state_def get_state_def high_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI; simp)
  apply (simp add: spec_def put_def put_state_def get_state_def xs_Env_def swap_def)
  apply(intro seq_rule[of _ _ "(\<lambda>_ y. high y \<le> high e)"])
  apply (simp add: spec_def put_def put_state_def get_state_def high_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI; simp)
  apply (simp add: spec_def put_def put_state_def get_state_def xs_Env_def)
  apply(intro seq_rule[of _ _ "(\<lambda>_ y. low e \<le> low y)"])
  apply (simp add: spec_def put_def put_state_def get_state_def high_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI; simp)
  apply (simp add: spec_def put_def put_state_def get_state_def xs_Env_def)
  apply(intro seq_rule[of _ _ "(\<lambda>_ y. i e \<le> i y)"])
  apply (simp add: spec_def put_def put_state_def get_state_def high_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI; simp)
  apply (simp add: spec_def put_def put_state_def get_state_def xs_Env_def)
  apply(intro seq_rule[of _ _ "(\<lambda>_ y. high y - i y \<le> high e - i e)"])
  apply (simp add: spec_def put_def put_state_def get_state_def high_Env_def)
  apply (simp add: diff_le_mono2)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI; simp)
  apply (simp add: spec_def put_def put_state_def get_state_def xs_Env_def)
  apply(intro seq_rule[of _ _ "(\<lambda>_ y. mset (xs e) = mset (xs y))"])
  apply (simp add: spec_def put_def put_state_def get_state_def high_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI; simp)
  apply (simp add: spec_def put_def put_state_def get_state_def swap_def xs_Env_def)
  apply (simp add: mset_swap)
  apply (intro seq_rule[of _ _ "(\<lambda>x y. Suc(high y - i y) = high e - i e \<and> high e > i e)"])
  apply (simp add: spec_def put_def put_state_def get_state_def high_Env_def)
  apply linarith
  apply(intro allI; simp)
  apply(intro get_rule; intro allI; simp)
  by (simp add: spec_def put_def put_state_def get_state_def xs_Env_def)

subsection\<open>Invariants - dec highbound\<close>
text\<open>These proofs show that the invariants on the ranges are kept by a @{text dec_highbound_action}\<close>
lemma dec_highbound_invariantRed: "spec dec_highbound_inv1 dec_highbound (GG dnfp_inv1)"
    unfolding dec_highbound_inv1_def dec_highbound_inv1_def loop_update_action_inv1_def dnfp_inv1_def dnfp_variables_invariants_def loop_update_action_pre_def GG_def low_invariant_is_0_Env_def
    apply(simp_all add: dec_highbound_def)
    apply(intro get_rule; intro allI; simp)
    apply(intro seq_rule[of _ _ "(\<lambda>x e. i e \<le> high e \<and>
                 low e \<le> i e \<and>
                 high e \<le> length (xs e) \<and>
                 set (xs e) \<subseteq> {0, 1, 2} \<and> Suc 0 < xs e ! i e \<and> (\<forall>x < low e. xs e ! x = 0))"])
    apply (simp add: spec_def put_def put_state_def get_state_def high_Env_def swap_def)
    apply linarith
    apply(intro allI; simp)
    apply(intro get_rule;intro allI; simp)
    by (simp add: spec_def put_def put_state_def get_state_def xs_Env_def swap_def)

lemma dec_highbound_invariantWhite: "spec dec_highbound_inv2 dec_highbound (GG dnfp_inv2)"
    unfolding dec_highbound_inv2_def dec_highbound_inv2_def loop_update_action_inv2_def dnfp_inv2_def  dnfp_variables_invariants_def loop_update_action_pre_def GG_def invariant_low_to_j_is_1_Env_def
    apply(simp_all add: dec_highbound_def)
    apply(intro get_rule; intro allI; simp)
    apply(intro seq_rule[of _ _ "(\<lambda>x e. i e \<le> high e \<and>
                 low e \<le> i e \<and>
                 high e \<le> length (xs e) \<and>
                 set (xs e) \<subseteq> {0, 1, 2} \<and> Suc 0 < xs e ! i e \<and> (\<forall>x. low e \<le> x \<and> x < i e \<longrightarrow> xs e ! x = Suc 0))"])
    apply (simp add: spec_def put_def put_state_def get_state_def high_Env_def swap_def)
    apply linarith
    apply(intro allI; simp)
    apply(intro get_rule;intro allI; simp)
    by (simp add: spec_def put_def put_state_def get_state_def xs_Env_def swap_def)

lemma dec_highbound_invariantBlue: "spec dec_highbound_inv3 dec_highbound (GG dnfp_inv3)"
    unfolding dec_highbound_inv3_def dec_highbound_inv3_def loop_update_action_inv3_def dnfp_inv3_def dnfp_variables_invariants_def loop_update_action_pre_def GG_def high_invariant_is_2_Env_def
    apply(simp_all add: dec_highbound_def)
    apply(intro get_rule; intro allI; simp)
    apply(intro seq_rule[of _ _ "(\<lambda>x e. i e \<le> high e \<and>
                 low e \<le> i e \<and>
                 high e \<le> length (xs e) \<and>
                 set (xs e) \<subseteq> {0, 1, 2} \<and> Suc 0 < xs e ! i e \<and> (\<forall>x. high e < x \<and> x < length (xs e) \<longrightarrow> xs e ! x = 2))"])
    apply (simp add: spec_def put_def put_state_def get_state_def high_Env_def swap_def)
    apply force
    apply(intro allI; simp)
    apply(intro get_rule;intro allI; simp)
    apply (simp add: spec_def put_def put_state_def get_state_def xs_Env_def swap_def)
    by (smt One_nat_def leD le_eq_less_or_eq le_less_trans length_list_update less_numeral_extra(2) nth_list_update value_must_be_two_aux)

lemma dec_highbound_invariants: "spec dec_highbound_inv dec_highbound (GG dnfp_inv)"
  unfolding dec_highbound_inv_def loop_update_action_inv_def GG_def dnfp_inv_def
  by (smt GG_def case_prodD dec_highbound_inv1_def dec_highbound_inv2_def dec_highbound_inv3_def dec_highbound_invariantBlue dec_highbound_invariantRed dec_highbound_invariantWhite loop_update_action_inv1_def loop_update_action_inv2_def loop_update_action_inv3_def spec_def split_cong)

section\<open>Inc index proof\<close>
lemma inc_index_spec: "spec (inc_index_pre e) inc_index (GG (inc_index_post e))"
  unfolding inc_index_pre_def dnfp_variables_invariants_def dnfp_post_def loop_update_action_pre_def GG_def inc_index_post_def loop_update_action_post_def
  apply(simp_all add: inc_index_def)
  apply(intro get_rule; intro allI;simp)
  apply(intro conj_rule_right)
  apply (simp_all add: spec_def put_def put_state_def get_state_def i_Env_def)
  apply linarith
  by linarith

subsection\<open>Invariants - inc index\<close>
text\<open>These proofs show that the invariants on the ranges are kept by an @{text inc_index}-action.
  It can be noted that these proofs are straightforward since the definition only contains one put-statement.
And nothing follows the put-statement. It is therefore not necessary to introduce the seq-rule.)\<close>
lemma inc_index_invariantRed: "spec inc_index_inv1 inc_index (GG dnfp_inv1)"
  unfolding inc_index_inv1_def loop_update_action_inv1_def dnfp_variables_invariants_def dnfp_inv1_def loop_update_action_pre_def  GG_def low_invariant_is_0_Env_def
  apply(simp_all add: inc_index_def)
  apply(intro get_rule; intro allI; simp)
  by (simp add: spec_def i_Env_def put_def get_state_def put_state_def)

lemma inc_index_invariantWhite: "spec inc_index_inv2 inc_index (GG dnfp_inv2)"
  unfolding inc_index_inv2_def loop_update_action_inv2_def dnfp_variables_invariants_def dnfp_inv2_def loop_update_action_pre_def  GG_def invariant_low_to_j_is_1_Env_def
  apply(simp_all add: inc_index_def)
  apply(intro get_rule; intro allI; simp)
  apply (simp add: spec_def i_Env_def put_def get_state_def put_state_def)
  using le_eq_less_or_eq by fastforce

lemma inc_index_invariantBlue: "spec inc_index_inv3 inc_index (GG dnfp_inv3)"
  unfolding inc_index_inv3_def loop_update_action_inv3_def  dnfp_variables_invariants_def dnfp_inv3_def loop_update_action_pre_def  GG_def high_invariant_is_2_Env_def
  apply(simp_all add: inc_index_def)
  apply(intro get_rule; intro allI; simp)
  by (simp add: spec_def i_Env_def put_def get_state_def put_state_def)

lemma inc_index_invariants: "spec inc_index_inv inc_index (GG dnfp_inv)"
  unfolding inc_index_inv_def dnfp_inv_def GG_def loop_update_action_inv_def
  by (smt GG_def inc_index_inv1_def inc_index_inv2_def inc_index_inv3_def inc_index_invariantBlue inc_index_invariantRed inc_index_invariantWhite loop_update_action_inv1_def loop_update_action_inv2_def loop_update_action_inv3_def spec_def split_beta')

section\<open>Loop update action - proofs\<close>
text\<open>This proofs shows that the loop-update-action preserves the relationship on the variables. This proof can be rewritten to make use of the lemmas established in the file above.\<close>
lemma loop_update_action_spec: "spec (loop_update_action_pre_aux e) loop_update_action (GG (loop_update_action_post e))"
  unfolding loop_update_action_pre_aux_def GG_def loop_update_action_post_def loop_update_action_pre_def dnfp_variables_invariants_def dnfp_post_def
  apply(simp add: loop_update_action_def)
  apply (intro get_rule; intro allI; clarify)
  apply (intro cond_rule)
  apply(simp add: inc_lowbound_def)
  apply(intro get_rule; intro allI; simp)
  apply(intro conj_rule_right)
  apply (intro seq_rule[of _ _ "(\<lambda>_ y. length (xs e) = length (xs y))"])
  apply (simp add: spec_def put_def put_state_def swap_def get_state_def xs_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  apply (intro seq_rule[of _ _ "(\<lambda>_ y. length (xs e) = length (xs y))"])
  apply (simp add: spec_def put_def put_state_def swap_def get_state_def i_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  apply (simp add: spec_def put_def put_state_def swap_def get_state_def low_Env_def)
  apply (intro seq_rule[of _ _ "(\<lambda>_ y. high e = high y)"])
  apply (simp add: spec_def put_def put_state_def swap_def get_state_def xs_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  apply (intro seq_rule[of _ _ "(\<lambda>_ y. high e = high y)"])
  apply (simp add: spec_def put_def put_state_def swap_def get_state_def i_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  apply (simp add: spec_def put_def put_state_def swap_def get_state_def low_Env_def)
  apply (intro seq_rule[of _ _ "(\<lambda>_ y. low e = low y)"])
  apply (simp add: spec_def put_def put_state_def swap_def get_state_def xs_Env_def i_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  apply(intro seq_rule[of _ _ "(\<lambda>_ y. low e = low y)"])
  apply (simp add: spec_def put_def put_state_def  get_state_def i_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  apply(simp add: spec_def put_def get_state_def put_state_def low_Env_def)
  apply (intro seq_rule[of _ _ "(\<lambda>_ y. i y = i e)"])
  apply (simp add: spec_def put_def put_state_def swap_def get_state_def xs_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  apply (intro seq_rule[of _ _ "(\<lambda>_ y. i y > i e)"])
  apply (simp add: spec_def put_def put_state_def  get_state_def i_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  apply (simp add: spec_def put_def put_state_def  get_state_def low_Env_def)
  apply (intro seq_rule[of _ _ "(\<lambda>_ y. i y < high y \<and> i y = i e \<and> high y = high e)"])
  apply (simp add: spec_def put_def put_state_def swap_def get_state_def xs_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  apply (intro seq_rule[of _ _ "(\<lambda>_ y. high y - i y < high e - i e)"])
  apply (simp add: spec_def put_def put_state_def  get_state_def i_Env_def)
  apply (linarith)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  apply (simp add: spec_def put_def put_state_def  get_state_def low_Env_def)
  apply (intro seq_rule[of _ _ "(\<lambda>_ y. mset(xs e) = mset(xs y))"])
  apply (simp add: spec_def put_def put_state_def swap_def get_state_def xs_Env_def)
  apply (simp add: Multiset.mset_swap)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  apply (intro seq_rule[of _ _ "(\<lambda>_ y. mset(xs e) = mset(xs y))"])
  apply (simp add: spec_def put_def put_state_def get_state_def i_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  apply (simp add: spec_def put_def put_state_def  get_state_def low_Env_def)
  apply (intro seq_rule[of _ _ "(\<lambda>x y. high y - i y = high e - i e \<and> high e > i e)"])
  apply (simp add: spec_def put_def put_state_def swap_def get_state_def xs_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  apply (intro seq_rule[of _ _ "(\<lambda>x y. Suc(high y - i y) = high e - i e)"])
  apply (simp add: spec_def put_def put_state_def get_state_def i_Env_def)
  apply linarith
  apply(intro allI; simp)
  apply(intro get_rule; intro allI)
  apply (simp add: spec_def put_def put_state_def get_state_def low_Env_def)

  apply(simp add: dec_highbound_def)
  apply(intro conj_rule_right)
  apply (intro get_rule; intro allI; simp)
  apply (intro seq_rule[of _ _ "(\<lambda>_ y. length (xs e) = length (xs y))"])
  apply (simp add: spec_def put_def get_state_def put_state_def high_Env_def swap_def)
  apply (rule allI; simp; intro get_rule; rule allI; simp)
  apply (simp add: spec_def get_def put_def get_state_def put_state_def xs_Env_def swap_def)
  apply (intro get_rule; intro allI; simp)
  apply(intro seq_rule[of _ _ "(\<lambda>x y. high y < high e)"])
  apply (simp add: spec_def get_def put_def get_state_def put_state_def high_Env_def)
  apply (intro allI; simp)
  apply (intro get_rule; intro allI; simp)
  apply (simp add: spec_def get_def put_def get_state_def put_state_def xs_Env_def swap_def)
  apply (intro get_rule; intro allI; simp)
  apply(intro seq_rule[of _ _ "(\<lambda>x y. low e \<le> low y)"])
  apply (simp add: spec_def get_def put_def get_state_def put_state_def high_Env_def)
  apply (intro allI; simp)
  apply (intro get_rule; intro allI; simp)
  apply (simp add: spec_def get_def put_def get_state_def put_state_def xs_Env_def swap_def)
  apply (intro get_rule; intro allI; simp)
  apply(intro seq_rule[of _ _ "(\<lambda>x y. i e \<le> i y)"])
  apply (simp add: spec_def get_def put_def get_state_def put_state_def high_Env_def)
  apply (intro allI; simp)
  apply (intro get_rule; intro allI; simp)
  apply (simp add: spec_def get_def put_def get_state_def put_state_def xs_Env_def swap_def)
  apply (intro get_rule; intro allI; simp)
  apply(intro seq_rule[of _ _ "(\<lambda>x y. high y - i y < high e - i e)"])
  apply (simp add: spec_def get_def put_def get_state_def put_state_def high_Env_def)
  apply(linarith)
  apply(intro allI; simp)
  apply (intro get_rule; intro allI; simp)
  apply (simp add: spec_def get_def put_def get_state_def put_state_def xs_Env_def swap_def)
  apply (intro get_rule; intro allI; simp)
  apply (intro seq_rule[of _ _ "(\<lambda>_ y. mset(xs e) = mset(xs y))"])
  apply (simp add: spec_def put_def put_state_def get_state_def high_Env_def)
  apply(intro allI; simp)
  apply(intro get_rule; intro allI; simp)
  apply (simp add: spec_def get_def put_def get_state_def put_state_def xs_Env_def swap_def)
  apply (simp add: Multiset.mset_swap)
  apply(intro get_rule; intro allI; simp)

  apply (intro seq_rule[of _ _ "(\<lambda>x y. Suc(high y - i y) = high e - i e \<and> high e > i e)"])
  apply (simp add: spec_def put_def put_state_def get_state_def high_Env_def)
  apply linarith
  apply(intro allI; simp)
  apply(intro get_rule; intro allI; simp)
  apply (simp add: spec_def put_def put_state_def get_state_def xs_Env_def)
  apply(simp add: inc_index_def)
  apply (intro get_rule; intro allI; simp)
  apply (simp add: spec_def get_def put_def get_state_def put_state_def i_Env_def)
  apply (simp add: diff_le_mono2)
  by (simp add: Suc_diff_Suc)

subsection\<open>Invariants - Loop update action \<close>
lemma loop_update_action_invariantRed: "spec loop_update_action_inv1 loop_update_action (GG dnfp_inv1)"
   unfolding loop_update_action_inv1_def loop_update_action_inv1_def dnfp_variables_invariants_def dnfp_inv1_def  loop_update_action_pre_def  GG_def low_invariant_is_0_Env_def
   apply(simp add: loop_update_action_def)
   apply (intro get_rule; intro allI; clarify)
   apply (intro cond_rule)
   apply(simp add: inc_lowbound_def)
   apply (intro get_rule; intro allI; simp)
   apply(intro seq_rule[of _ _ "(\<lambda>x e. i e < high e \<and>
                                low e \<le> i e \<and>
                                high e \<le> length (xs e) \<and> set (xs e) \<subseteq> {0, 1, 2} \<and> (\<forall>x\<le>low e. xs e ! x = 0))"])
   apply (simp add: spec_def put_def put_state_def swap_def get_state_def xs_Env_def)
   apply (smt le_antisym le_eq_less_or_eq le_trans length_list_update nth_list_update_eq nth_list_update_neq)
   apply(intro allI; simp)
   apply(intro get_rule; intro allI)
   apply(intro seq_rule[of _ _ "(\<lambda>x e. i e \<le> high e \<and>
               low e < i e \<and>
               high e \<le> length (xs e) \<and> set (xs e) \<subseteq> {0, 1, 2} \<and> (\<forall>x\<le>low e. xs e ! x = 0))"])
   apply (simp add: spec_def put_def put_state_def get_state_def i_Env_def)
   apply(intro allI; simp)
   apply(intro get_rule; intro allI)
   apply (simp add: spec_def put_def put_state_def get_state_def low_Env_def)
   apply(simp add: dec_highbound_def)
   apply (intro get_rule; intro allI; simp)
   apply(intro seq_rule[of _ _ "(\<lambda>_ e. i e \<le> high e \<and>
               low e \<le> i e \<and>
               high e \<le> length (xs e) \<and> set (xs e) \<subseteq> {0, 1, 2} \<and> (\<forall>x<low e. xs e ! x = 0))"])
   apply (simp add: spec_def get_def put_def get_state_def put_state_def high_Env_def)
   apply(linarith)
   apply(intro allI; simp)
   apply (intro get_rule; intro allI; simp)
   apply (simp add: spec_def get_def put_def get_state_def put_state_def xs_Env_def swap_def)
   apply(simp add: inc_index_def)
   apply (intro get_rule; intro allI; simp)
   by (simp add: spec_def get_def put_def get_state_def put_state_def i_Env_def)

text\<open>The following proofs are mostly done using the already established lemmas of the definitions inside loop update action. This can be seen from the lemmas used inside smt-statement\<close>
lemma loop_update_action_invariantWhite: "spec loop_update_action_inv2 loop_update_action (GG dnfp_inv2)"
   unfolding loop_update_action_inv2_def GG_def
   apply(simp add: loop_update_action_def)
   apply (intro get_rule; intro allI; clarify)
   apply (intro cond_rule; simp)
   apply (smt GG_def case_prodD case_prodI2  inc_lowbound_inv2_def inc_lowbound_invariantWhite less_numeral_extra(1) loop_update_action_inv2_def spec_def)
   apply (smt GG_def One_nat_def dec_highbound_inv2_def dec_highbound_invariantWhite loop_update_action_inv2_def spec_def split_beta')
   by (smt GG_def One_nat_def Suc_less_eq inc_index_inv2_def inc_index_invariantWhite less_Suc_eq loop_update_action_inv2_def spec_def split_beta')

lemma loop_update_action_invariantBlue: "spec loop_update_action_inv3 loop_update_action (GG dnfp_inv3)"
   unfolding loop_update_action_inv3_def GG_def
   apply(simp add: loop_update_action_def)
   apply (intro get_rule; intro allI; clarify)
   apply (intro cond_rule;simp)
   apply (smt GG_def case_prodD case_prodI2  inc_lowbound_inv3_def inc_lowbound_invariantBlue less_numeral_extra(1) loop_update_action_inv3_def spec_def)
   apply (smt GG_def One_nat_def  dec_highbound_inv3_def dec_highbound_invariantBlue loop_update_action_inv3_def spec_def split_beta')
   by (smt GG_def One_nat_def Suc_less_eq  inc_index_inv3_def inc_index_invariantBlue less_Suc_eq loop_update_action_inv3_def spec_def split_beta')

lemma loop_update_action_invariants: "spec loop_update_action_inv loop_update_action (GG dnfp_inv)"
  unfolding loop_update_action_inv_def GG_def loop_update_action_inv_def dnfp_inv_def
  by (smt GG_def case_prodD case_prodI2 loop_update_action_inv1_def loop_update_action_inv2_def loop_update_action_inv3_def loop_update_action_invariantBlue loop_update_action_invariantRed loop_update_action_invariantWhite spec_def)
end