\<^marker>\<open>creator Florian Keßler\<close>

section \<open>IMP-- Subprograms\<close>

theory IMP_Minus_Minus_Subprograms imports "../IMP_Minus_Minus_Small_StepT"
begin

text \<open>We give functions that enumerate all subprograms of an IMP-- program, that is, all
  computations that could be reached during the execution of an IMP-- program. Note that this is
  a purely syntactical definition, i.e. we also take into account executions that are actually
  impossible to reach due to the semantics of IMP--. We show completeness of this definition,
  i.e. if a IMP-- program can reach a certain computation, than that computation is contained in
  our definition. \<close>

fun all_subprograms :: "com \<Rightarrow> com list" where
"all_subprograms (SKIP) = [SKIP]" |
"all_subprograms (Assign v b) = [(Assign v b), SKIP]" |
"all_subprograms (c1 ;; c2) = (map (\<lambda> c. c ;; c2) (all_subprograms c1)) @ all_subprograms c1
  @ all_subprograms c2" |
"all_subprograms (If v c1 c2) = [(If v c1 c2)] @ all_subprograms c1 @ all_subprograms c2" |
"all_subprograms (While v c) = [(While v c), SKIP] @ all_subprograms c @
  (map (\<lambda> x. x ;; (While v c)) (all_subprograms c))"

definition enumerate_subprograms :: "com \<Rightarrow> com list" where
"enumerate_subprograms c = remdups (all_subprograms c)"

fun all_variables :: "com \<Rightarrow> vname list" where
"all_variables (SKIP) = []" |
"all_variables (Assign v _) = [ v ]" |
"all_variables (c1 ;; c2) = []" |
"all_variables (If vs c1 c2) = vs" |
"all_variables (While vs c) = vs"

definition enumerate_variables :: "com \<Rightarrow> vname list" where
"enumerate_variables c = remdups (concat (map all_variables (enumerate_subprograms c)))"

lemma enumerate_variables_distinct: "distinct (enumerate_variables c)"
  by (auto simp: enumerate_variables_def)

lemma set_enumerate_variables_seq: "set (enumerate_variables (c1 ;; c2)) =
  set (enumerate_variables c1) \<union> set (enumerate_variables c2)"
  by(auto simp: enumerate_variables_def enumerate_subprograms_def)

lemma set_enumerate_variables_if: "set (enumerate_variables (IF vs\<noteq>0 THEN c1 ELSE c2))
  = set vs \<union> set (enumerate_variables c1) \<union> set (enumerate_variables c2)"
  by(auto simp: enumerate_variables_def enumerate_subprograms_def)

lemma set_enumerate_variables_while: "set (enumerate_variables (WHILE vs\<noteq>0 DO c))
  = set vs \<union> set (enumerate_variables c)"
  by(auto simp: enumerate_variables_def enumerate_subprograms_def)

lemma enumerate_variables_assign[simp]: "enumerate_variables (x1 ::= x2) = [x1]"
  by(auto simp: enumerate_variables_def enumerate_subprograms_def)

lemma enumerate_variables_SKIP[simp]: "enumerate_variables SKIP = []"
  by(auto simp: enumerate_variables_def enumerate_subprograms_def)

declare enumerate_subprograms_def[simp]

lemma c_in_all_subprograms_c[simp]: "c \<in> set (enumerate_subprograms c)"
  by (induction c) auto

lemma enumerate_variables_all_variables[simp]: "x \<in> set (all_variables c) \<Longrightarrow> x \<in> set (enumerate_variables c)"
  using c_in_all_subprograms_c by (auto simp: enumerate_variables_def)

lemma enumerate_subprograms_complete_step: "(c1, s1) \<rightarrow> (c2, s2)
  \<Longrightarrow> c2 \<in> set (enumerate_subprograms c1)"
apply (induction c1 s1 c2 s2 rule: small_step_induct)
  using c_in_all_subprograms_c apply(auto)
done

lemma enumerate_subprograms_transitive: "c2 \<in> set (enumerate_subprograms c1) \<Longrightarrow>
  c3 \<in> set (enumerate_subprograms c2) \<Longrightarrow> c3 \<in> set (enumerate_subprograms c1)"
proof (induction c1 arbitrary: c2 c3 rule: all_subprograms.induct)
  case (4 v c4 c5)
  then have "(c2 = (If v c4 c5)) \<or> (c2 \<in> set (all_subprograms c4))
              \<or> (c2 \<in> set (all_subprograms c5))"
      by (metis Un_iff all_subprograms.simps append.simps append.simps enumerate_subprograms_def set_ConsD set_append set_remdups)
  then show ?case
  proof (elim disjE)
    assume "c2 \<in> set (all_subprograms c5)"
    then show ?thesis using 4 by auto
  next
    assume "c2 \<in> set (all_subprograms c4)"
    then show ?thesis using 4 by auto
  next
    assume "c2 = (If v c4 c5)"
    then show ?thesis using 4 by auto
  qed
next
  case (5 v c)
  then have "c2 \<in> set (all_subprograms (While v c))" by (metis enumerate_subprograms_def set_remdups)
  then have "c2 \<in> set ([While v c, SKIP] @ all_subprograms c @ map (\<lambda> x. x ;; (While v c)) (all_subprograms c))"
    by (metis all_subprograms.simps enumerate_subprograms_def map_eq_conv set_append set_remdups)
  then have "(c2 = (While v c)) \<or> c2 = SKIP \<or> (c2 \<in> set (all_subprograms c))
              \<or> (c2 \<in> set (map (\<lambda> x. x ;; (While v c)) (all_subprograms c)))" by simp
  then show ?case
  proof (elim disjE)
    assume "c2 = (While v c)"
    then show ?thesis using 5 by auto
  next
    assume "c2 = SKIP"
    then show ?thesis using 5 by auto
  next
    assume "c2 \<in> set (all_subprograms c)"
    then show ?thesis using 5
      by (metis Un_iff all_subprograms.simps enumerate_subprograms_def set_append set_remdups)
  next
    assume "c2 \<in> set (map (\<lambda> x. x ;; (While v c)) (all_subprograms c))"
    then obtain c' where *: "c2 = c' ;; (While v c) \<and> c' \<in> set (all_subprograms c)" by auto
    then have "c3 \<in> set (map (\<lambda> x. x ;; (While v c)) (all_subprograms c')) \<or> c3 \<in> set (all_subprograms c')
      \<or> c3 \<in> set (all_subprograms (While v c))" using 5 by auto
    then show ?thesis
    proof (elim disjE)
      assume "c3 \<in> set (map (\<lambda> x. x ;; (While v c)) (all_subprograms c'))"
      then have "c3 \<in> set (map (\<lambda> x. x ;; (While v c)) (all_subprograms c))" using * 5 by auto
      then show ?thesis by auto
    next
      assume "c3 \<in> set (all_subprograms c')"
      then have "c3 \<in> set (all_subprograms c)" using * 5 by auto
      then show ?thesis by auto
    next
      assume "c3 \<in> set (all_subprograms (While v c))"
      then show ?thesis using 5 by (metis enumerate_subprograms_def set_remdups)
    qed
  qed
qed auto

lemma enumerate_subprograms_complete: "(c1, s1)\<rightarrow>\<^bsup>t\<^esup> (c2, s2)
  \<Longrightarrow>  c2 \<in> set (enumerate_subprograms c1)"
proof(induction t arbitrary: c1 s1 c2 s2)
  case 0
  then show ?case using c_in_all_subprograms_c by auto
next
  case (Suc t)
  then obtain c1' s1' where "((c1, s1) \<rightarrow> (c1', s1')) \<and> ((c1', s1')\<rightarrow>\<^bsup>t\<^esup> (c2, s2))" by auto
  then show ?case using enumerate_subprograms_transitive Suc enumerate_subprograms_complete_step
    by blast
qed

lemma SKIP_in_enumerate_subprograms[simp]: "SKIP \<in> set (enumerate_subprograms c)"
  by (induction c rule: all_subprograms.induct) auto

lemma enumerate_subprograms_enumerate_variables: "c' \<in> set (enumerate_subprograms c)
  \<Longrightarrow> set (enumerate_variables c') \<subseteq> set (enumerate_variables c)"
 by (auto simp: enumerate_variables_def)
     (metis enumerate_subprograms_def enumerate_subprograms_transitive set_remdups)

lemma step_doesnt_add_variables: "(c1, s1) \<rightarrow> (c2, s2) \<Longrightarrow> c1 \<in> set (enumerate_subprograms c)
  \<Longrightarrow> dom s1 = set (enumerate_variables c)
  \<Longrightarrow> dom s2 = set (enumerate_variables c)"
proof (induction c1 s1  c2 s2 rule: small_step_induct)
  case (Assign x a s)
  have "x \<in> set (enumerate_variables (x ::= a))" by simp
  then have "x \<in> set (enumerate_variables c)"
    using Assign enumerate_subprograms_enumerate_variables by fastforce
  thus ?case using Assign by(auto simp: dom_def)
next
  case (Seq2 c\<^sub>1 s c\<^sub>1' s' c\<^sub>2)
  have "c\<^sub>1 \<in> set (enumerate_subprograms (c\<^sub>1 ;; c\<^sub>2))" using c_in_all_subprograms_c by simp
  then have "c\<^sub>1 \<in> set (enumerate_subprograms c)"
    using Assign Seq2 enumerate_subprograms_transitive by blast
  then show ?case using Seq2 by auto
qed auto

lemma small_step_fun_restrict_variables:
  "set (enumerate_variables c1) \<subseteq> S \<Longrightarrow> small_step_fun (c1, s1 |` S)
    = (fst (small_step_fun (c1, s1)), snd (small_step_fun (c1, s1)) |` S)"
  apply(induction c1 arbitrary: S)
  using subsetD by(fastforce simp: set_enumerate_variables_seq
      set_enumerate_variables_if set_enumerate_variables_while)+

lemma small_step_fun_doesnt_add_variables:
  "set (enumerate_variables c1) \<subseteq> S
  \<Longrightarrow> set (enumerate_variables (fst (small_step_fun (c1, s1)))) \<subseteq> S"
  apply(induction c1)
  by(auto simp: set_enumerate_variables_seq
      set_enumerate_variables_if set_enumerate_variables_while)

lemma t_small_step_fun_restrict_variables:
  "set (enumerate_variables c1) \<subseteq> S \<Longrightarrow> t_small_step_fun t (c1, s1 |` S)
    = (fst (t_small_step_fun t (c1, s1)), snd (t_small_step_fun t (c1, s1)) |` S)"
  apply(induction t arbitrary: c1 s1)
  by(auto simp: small_step_fun_restrict_variables small_step_fun_doesnt_add_variables)

end


(*<*)
(*
   Title:  Theory SteamBoiler_proof.thy (Steam Boiler System: Verification)
   Author: Maria Spichkova <maria.spichkova at rmit.edu.au>, 2013
*)
(*>*)
section \<open>Steam Boiler System: Verification\<close>

theory  SteamBoiler_proof
imports SteamBoiler
begin

subsection \<open>Properties of the Boiler Component\<close>

lemma L1_Boiler:
  assumes "SteamBoiler x s y"
         and "ts x"
  shows "ts s"
using assms  by (simp add: SteamBoiler_def)

lemma L2_Boiler:
  assumes "SteamBoiler x s y"
         and "ts x"
  shows "ts y"
using assms  by (simp add: SteamBoiler_def)

lemma L3_Boiler:
  assumes "SteamBoiler x s y"
         and "ts x"
  shows "200 \<le> hd (s 0)"
using assms by (simp add: SteamBoiler_def)

lemma L4_Boiler:
  assumes "SteamBoiler x s y"
         and "ts x"
  shows "hd (s 0) \<le> 800"
using assms by (simp add: SteamBoiler_def)

lemma L5_Boiler:
  assumes h1:"SteamBoiler x s y"
         and h2:"ts x"
         and h3:"hd (x j) = Zero"
  shows "(hd (s j)) \<le> hd (s (Suc j)) + (10::nat)"
proof -
   from h1 and h2 obtain r where
     a1:"r \<le> 10"  and
     a2:"hd (s (Suc j)) = (if hd (x j) = Zero then hd (s j) - r else hd (s j) + r)"
     by (simp add: SteamBoiler_def, auto)
   from a2 and h3 have "hd (s (Suc j)) = hd (s j) - r" by simp
   from this and a1 show ?thesis by auto
qed

lemma L6_Boiler:
  assumes h1:"SteamBoiler x s y"
         and h2:"ts x"
         and h3:"hd (x j) = Zero"
  shows "(hd (s j)) - (10::nat) \<le> hd (s (Suc j))"
proof -
   from h1 and h2 obtain r where
     a1:"r \<le> 10"  and
     a2:"hd (s (Suc j)) = (if hd (x j) = Zero then hd (s j) - r else hd (s j) + r)"
     by (simp add: SteamBoiler_def, auto)
   from a2 and h3 have "hd (s (Suc j)) = hd (s j) - r" by simp
   from this and a1 show ?thesis by auto
qed

lemma L7_Boiler:
  assumes h1:"SteamBoiler x s y"
      and h2:"ts x"
      and h3:"hd (x j) \<noteq> Zero"
  shows "(hd (s j)) \<ge> hd (s (Suc j)) - (10::nat)"
proof -
   from h1 and h2 obtain r where
     a1:"r \<le> 10"  and
     a2:"hd (s (Suc j)) = (if hd (x j) = Zero then hd (s j) - r else hd (s j) + r)"
     by (simp add: SteamBoiler_def, auto)
   from a2 and h3 have "hd (s (Suc j)) = hd (s j) + r" by simp
   from this and a1 show ?thesis by auto
qed

lemma L8_Boiler:
  assumes h1:"SteamBoiler x s y"
         and h2:"ts x"
         and h3:"hd (x j) \<noteq> Zero"
  shows "(hd (s j)) + (10::nat) \<ge> hd (s (Suc j))"
proof -
   from h1 and h2 obtain r where
     a1:"r \<le> 10"  and
     a2:"hd (s (Suc j)) = (if hd (x j) = Zero then hd (s j) - r else hd (s j) + r)"
     by (simp add: SteamBoiler_def, auto)
   from a2 and h3 have "hd (s (Suc j)) = hd (s j) + r" by simp
   from this and a1 show ?thesis by auto
qed

subsection \<open>Properties of the Controller Component\<close>

lemma L1_Controller:
  assumes "Controller_L s (fin_inf_append [Zero] l) l z"
  shows    "fin_make_untimed (inf_truncate z i) \<noteq> []"
using assms
by (metis Controller_L_def fin_make_untimed_inf_truncate_Nonempty_all0a)

lemma L2_Controller_Zero:
  assumes "Controller_L y (fin_inf_append [Zero] l) l z"
         and "l t = Zero"
         and "300 < hd (y (Suc t))"
  shows    "z (Suc t) = []"
using assms
by (metis Controller_L_def correct_fin_inf_append1)

lemma L2_Controller_One:
  assumes "Controller_L y (fin_inf_append [Zero] l) l z"
          and "l t = One"
          and "hd (y (Suc t)) < 700"
  shows "z (Suc t) = []"
using assms
by (metis Controller_L_def bit.distinct(1) correct_fin_inf_append2)

lemma L3_Controller_Zero:
  assumes "Controller_L y (fin_inf_append [Zero] l) l z"
         and "l t = Zero"
         and "\<not> 300 < hd (y (Suc t))"
  shows "z (Suc t) = [One]"
using assms
by (metis Controller_L_def correct_fin_inf_append1)

lemma L3_Controller_One:
  assumes "Controller_L y (fin_inf_append [Zero] l) l z"
      and "l t = One"
      and "\<not> hd (y (Suc t)) < 700"
  shows      "z (Suc t) = [Zero]"
using assms
by (metis Controller_L_def bit.distinct(1) correct_fin_inf_append1)

lemma L4_Controller_Zero:
  assumes h1:"Controller_L y (fin_inf_append [Zero] l) l z"
         and h2:"l (Suc t) = Zero"
  shows      "(z (Suc t) = [] \<and> l t = Zero) \<or> (z (Suc t) = [Zero] \<and> l t = One)"
proof (cases "l t")
  assume a1:"l t = Zero"
  from this and h1 and h2 show ?thesis
  proof -
    from a1 have sg1:"fin_inf_append [Zero] l (Suc t) = Zero"
      by (simp add: correct_fin_inf_append1)
    from h1 and sg1 have sg2:
      "if 300 < hd (y (Suc t))
       then z (Suc t) = [] \<and> l (Suc t) = Zero
       else z (Suc t) = [One] \<and> l (Suc t) = One"
       by (simp add: Controller_L_def)
    show ?thesis
    proof (cases "300 < hd (y (Suc t))")
      assume a11:"300 < hd (y (Suc t))"
      from a11 and sg2 have sg3:"z (Suc t) = [] \<and> l (Suc t) = Zero" by simp
      from this and a1 show ?thesis by simp
    next
      assume a12:"\<not> 300 < hd (y (Suc t))"
      from a12 and sg2 have sg4:"z (Suc t) = [One] \<and> l (Suc t) = One" by simp
      from this and h2 show ?thesis by simp
    qed
  qed
next
  assume a2:"l t = One"
  from this and h1 and h2 show ?thesis
  proof -
    from a2 have sg5:"fin_inf_append [Zero] l (Suc t) \<noteq> Zero"
      by (simp add: correct_fin_inf_append1)
    from h1 and sg5 have sg6:
      "if hd (y (Suc t)) < 700
       then z (Suc t) = [] \<and> l (Suc t) = One
       else z (Suc t) = [Zero] \<and> l (Suc t) = Zero"
       by (simp add: Controller_L_def)
    show ?thesis
    proof (cases "hd (y (Suc t)) < 700")
      assume a21:"hd (y (Suc t)) < 700"
      from a21 and sg6 have sg7:"z (Suc t) = [] \<and> l (Suc t) = One" by simp
      from this and h2 show ?thesis by simp
    next
      assume a22:"\<not> hd (y (Suc t)) < 700"
      from a22 and sg6 have sg8:"z (Suc t) = [Zero] \<and> l (Suc t) = Zero" by simp
      from this and a2 show ?thesis by simp
    qed
  qed
qed

lemma L5_Controller_One:
  assumes h1:"Controller_L y lIn lOut z"
      and h2:"lOut t = One"
      and h3:"z t = []"
  shows "lIn t = One"
proof (cases "lIn t")
  assume a1:"lIn t = Zero"
  from a1 and h1 have sg1:
    "if 300 < hd (y t)
     then z t = [] \<and> lOut t = Zero
     else z t = [One] \<and> lOut t = One"
     by (simp add: Controller_L_def)
  show ?thesis
  proof (cases "300 < hd (y t)")
    assume a3:"300 < hd (y t)"
    from a3 and sg1 have sg2:"z t = [] \<and> lOut t = Zero" by simp
    from this and h2 show ?thesis by simp
  next
    assume a4:"\<not> 300 < hd (y t)"
    from a4 and sg1 have sg3:"z t = [One] \<and> lOut t = One" by simp
    from this and h3 show ?thesis by simp
  qed
next
  assume "lIn t = One"
  then show ?thesis by simp
qed

lemma L5_Controller:
  assumes "Controller_L y lIn lOut z"
         and "lOut t = a"
         and "z t = []"
  shows "lIn t = a"
using assms
by (metis L5_Controller_One L5_Controller_Zero bit.exhaust)

lemma L6_Controller_Zero:
  assumes "Controller_L y (fin_inf_append [Zero] l) l z"
         and "l (Suc t) = Zero"
         and "z (Suc t) = []"
  shows "l t = Zero"
using assms
by (metis L4_Controller_Zero not_Cons_self2)

lemma L6_Controller_One:
  assumes "Controller_L y (fin_inf_append [Zero] l) l z"
         and "l (Suc t) = One"
         and "z (Suc t) = []"
  shows "l t = One"
using assms
by (metis L4_Controller_One list.distinct(1))

lemma L6_Controller:
  assumes "Controller_L y (fin_inf_append [Zero] l) l z"
         and "l (Suc t) = a"
         and "z (Suc t) = []"
  shows "l t = a"
using assms
by (metis L5_Controller correct_fin_inf_append2)

lemma L7_Controller_Zero:
  assumes h1:"Controller_L y (fin_inf_append [Zero] l) l z"
         and h2:"l t = Zero"
  shows      "last (fin_make_untimed (inf_truncate z t)) = Zero"
using assms
proof (induct t)
  case 0
  from h1 have "z 0 = [Zero]" by (simp add: Controller_L_def)
  from this show ?case by (simp add: fin_make_untimed_def)
next
   fix t
   case (Suc t)
   from this show ?case
   proof (cases "l t")
     assume a1:"l t = Zero"
     from Suc have
       "(z (Suc t) = [] \<and> l t = Zero) \<or> (z (Suc t) = [Zero] \<and> l t = One)"
       by (simp add: L4_Controller_Zero)
     from this and a1 have "z (Suc t) = []"
       by simp
     from Suc and this and a1 show ?case
       by (simp add: fin_make_untimed_append_empty)
   next
     assume a1:"l t = One"
     from Suc have
       "(z (Suc t) = [] \<and> l t = Zero) \<or> (z (Suc t) = [Zero] \<and> l t = One)"
       by (simp add: L4_Controller_Zero)
     from this and a1 have "z (Suc t) = [Zero]"
       by simp
     from a1 and Suc and this show ?case
       by (simp add: fin_make_untimed_def)
   qed
qed

lemma L7_Controller_One_l0:
  assumes "Controller_L y (fin_inf_append [Zero] l) l z"
         and "y 0 = [500::nat]"
  shows    "l 0 = Zero"
proof (rule ccontr)
  assume a1:" \<not> l 0 = Zero"
  from assms have sg1:"z 0 = [Zero]" by (simp add: Controller_L_def)
  have sg2:"fin_inf_append [Zero] l (0::nat) = Zero" by  (simp add: fin_inf_append_def)
  from assms and a1 and sg1 and sg2 show "False"
   by (simp add: Controller_L_def)
qed

lemma L7_Controller_One:
  assumes h1:"Controller_L y (fin_inf_append [Zero] l) l z"
      and h2:"l t = One"
      and h3:"y 0 = [500::nat]"
  shows "last (fin_make_untimed (inf_truncate z t)) = One"
using assms
proof (induct t)
  case 0
  from h1 and h3 have "l 0 = Zero"
    by (simp add: L7_Controller_One_l0)
  from this and 0 show ?case by simp
next
   fix t
   case (Suc t)
   from this show ?case
   proof (cases "l t")
     assume a1:"l t = Zero"
     from Suc have
       "(z (Suc t) = [] \<and> l t = One) \<or> (z (Suc t) = [One] \<and> l t = Zero)"
       by (simp add: L4_Controller_One)
     from this and a1 have "z (Suc t) = [One]"
       by simp
     from Suc and this and a1 show ?case
       by (simp add: fin_make_untimed_def)
   next
     assume a1:"l t = One"
     from Suc have
       "(z (Suc t) = [] \<and> l t = One) \<or> (z (Suc t) = [One] \<and> l t = Zero)"
       by (simp add: L4_Controller_One)
     from this and a1 have "z (Suc t) = []"
       by simp
     from a1 and Suc and this show ?case
       by (simp add: fin_make_untimed_def)
   qed
qed

lemma L7_Controller:
  assumes "Controller_L y (fin_inf_append [Zero] l) l z"
         and "y 0 = [500::nat]"
  shows      "last (fin_make_untimed (inf_truncate z t)) =  l t"
using assms
by (metis (full_types) L7_Controller_One L7_Controller_Zero bit.exhaust)

lemma L8_Controller:
  assumes "Controller_L y (fin_inf_append [Zero] l) l z"
  shows    "z t = [] \<or> z t = [Zero] \<or> z t = [One]"
proof (cases "fin_inf_append [Zero] l t = Zero")
  assume a1:"fin_inf_append [Zero] l t = Zero"
  from a1 and assms have sg1:
   "if 300 < hd (y t)
    then z t = [] \<and> l t = Zero
    else z t = [One] \<and> l t = One"
    by (simp add: Controller_L_def)
  show ?thesis
  proof (cases "300 < hd (y t)")
    assume a11:"300 < hd (y t)"
    from a11 and sg1 show ?thesis by simp
  next
    assume a12:"\<not> 300 < hd (y t)"
    from a12 and sg1 show ?thesis by simp
  qed
next
  assume a2:"fin_inf_append [Zero] l t \<noteq> Zero"
  from a2 and assms have sg2:
   "if hd (y t) < 700
    then z t = [] \<and> l t = One
    else z t = [Zero] \<and> l t = Zero"
    by (simp add: Controller_L_def)
  show ?thesis
  proof (cases "hd (y t) < 700")
    assume a21:"hd (y t) < 700"
    from a21 and sg2 show ?thesis by simp
  next
    assume a22:"\<not> hd (y t) < 700"
    from a22 and sg2 show ?thesis by simp
  qed
qed

lemma L9_Controller:
  assumes h1:"Controller_L s (fin_inf_append [Zero] l) l z"
         and h2:"fin_make_untimed (inf_truncate z i) !
              (length (fin_make_untimed (inf_truncate z i)) - Suc 0) =  Zero"
         and h3:"last (fin_make_untimed (inf_truncate z i)) = l i"
         and h5:"hd (s (Suc i)) = hd (s i) - r"
         and h6:"fin_make_untimed (inf_truncate z i) \<noteq> []"
         and h8:"r \<le> 10"
  shows "200 \<le> hd (s (Suc i))"
proof -
  from h6 and h2 and h3 have sg0:"l i = Zero"
    by (simp add: last_nth_length)
  show ?thesis
  proof (cases "fin_inf_append [Zero] l i = Zero")
    assume a1:"fin_inf_append [Zero] l i = Zero"
    from a1 and h1 have sg1:
      "if 300 < hd (s i)
       then z i = [] \<and> l i = Zero
       else z i = [One] \<and> l i = One"
       by (simp add: Controller_L_def)
    show ?thesis
    proof (cases "300 < hd (s i)")
      assume a11:"300 < hd (s i)"
      from a11 and h5 and h8 show ?thesis by simp
    next
      assume a12:"\<not> 300 < hd (s i)"
      from a12 and sg1 and sg0 show ?thesis by simp
    qed
  next
    assume a2:"fin_inf_append [Zero] l i \<noteq> Zero"
    from a2 and h1 have sg2:
      "if hd (s i) < 700
       then z i = [] \<and> l i = One
       else z i = [Zero] \<and> l i = Zero"
       by (simp add: Controller_L_def)
    show ?thesis
    proof (cases "hd (s i) < 700")
      assume a21:"hd (s i) < 700"
      from this and sg2 and sg0 show ?thesis by simp
    next
      assume a22:"\<not> hd (s i) < 700"
      from this and h5 and h8  show ?thesis by simp
    qed
  qed
qed

lemma L10_Controller:
  assumes h1:"Controller_L s (fin_inf_append [Zero] l) l z"
      and h2:"fin_make_untimed (inf_truncate z i) !
              (length (fin_make_untimed (inf_truncate z i)) - Suc 0) \<noteq>  Zero"
      and h3:"last (fin_make_untimed (inf_truncate z i)) = l i"
      and h5:"hd (s (Suc i)) = hd (s i) + r"
      and h6:"fin_make_untimed (inf_truncate z i) \<noteq> []"
      and h8:"r \<le> 10"
  shows "hd (s (Suc i)) \<le> 800"
proof -
  from h6 and h2 and h3 have sg0:"l i \<noteq>  Zero"
    by (simp add: last_nth_length)
  show ?thesis
  proof (cases "fin_inf_append [Zero] l i = Zero")
    assume a1:"fin_inf_append [Zero] l i = Zero"
    from a1 and h1 have sg1:
      "if 300 < hd (s i)
       then z i = [] \<and> l i = Zero
       else z i = [One] \<and> l i = One"
       by (simp add: Controller_L_def)
    show ?thesis
    proof (cases "300 < hd (s i)")
      assume a11:"300 < hd (s i)"
      from a11 and sg1 and sg0 show ?thesis by simp
    next
      assume a12:"\<not> 300 < hd (s i)"
      from h5 and a12 and h8 show ?thesis by simp
    qed
  next
    assume a2:"fin_inf_append [Zero] l i \<noteq> Zero"
    from a2 and h1 have sg2:
      "if hd (s i) < 700
       then z i = [] \<and> l i = One
       else z i = [Zero] \<and> l i = Zero"
       by (simp add: Controller_L_def)
    show ?thesis
    proof (cases "hd (s i) < 700")
      assume a21:"hd (s i) < 700"
      from this and h5 and h8 show ?thesis by simp
    next
      assume a22:"\<not> hd (s i) < 700"
      from this and sg2 and sg0 show ?thesis by simp
    qed
  qed
qed

subsection \<open>Properties of the Converter Component\<close>

lemma L1_Converter:
  assumes "Converter z x"
         and "fin_make_untimed (inf_truncate z t) \<noteq> []"
  shows      "hd (x t) = (fin_make_untimed (inf_truncate z t)) !
                 ((length (fin_make_untimed (inf_truncate z t))) - (1::nat))"
using assms
by (simp add: Converter_def)

lemma L1a_Converter:
  assumes "Converter z x"
         and "fin_make_untimed (inf_truncate z t) \<noteq> []"
         and "hd (x t) = Zero"
  shows      "(fin_make_untimed (inf_truncate z t)) !
                 ((length (fin_make_untimed (inf_truncate z t))) - (1::nat))
              = Zero"
using assms
by (simp add: L1_Converter)

subsection \<open>Properties of the System\<close>

lemma L1_ControlSystem:
  assumes "ControlSystemArch s"
  shows "ts s"
proof -
  from assms obtain x z y
    where a1:"Converter z x" and a2: "SteamBoiler x s y"
    by (simp only: ControlSystemArch_def, auto)
  from this have "ts x"
    by (simp add: Converter_def)
  from a2 and this show ?thesis by (rule L1_Boiler)
qed

lemma L2_ControlSystem:
  assumes "ControlSystemArch s"
  shows "(200::nat) \<le> hd (s i)"
proof -
  from assms obtain x z y
    where a1:"Converter z x" and a2: "SteamBoiler x s y" and a3:"Controller y z"
    by (simp only: ControlSystemArch_def, auto)
  from this have sg1:"ts x"  by (simp add: Converter_def)
  from sg1 and a2 have sg2:"ts y"  by (simp add: L2_Boiler)
  from sg1 and a2 have sg3:"y = s" by (simp add: SteamBoiler_def)
  from a1 and a2 and a3 and sg1 and sg2 and sg3 show "200 \<le> hd (s i)"
  proof (induction i)
    case 0
    from this show ?case  by (simp add: L3_Boiler)
  next
    fix i
    case (Suc i)
    from this obtain l
      where a4: "Controller_L s (fin_inf_append [Zero] l) l z"
      by (simp add: Controller_def, atomize, auto)
    from Suc and a4 have sg4:"fin_make_untimed (inf_truncate z i) \<noteq> []"
      by (simp add:  L1_Controller)
    from a2 and sg1 have y0asm:"y 0 = [500::nat]"  by (simp add: SteamBoiler_def)
    from Suc and a4 and sg4 and y0asm have sg5: "last (fin_make_untimed (inf_truncate z i)) =  l i"
      by (simp add: L7_Controller)
    from a2 and sg1 obtain r where
         aa0:"0 < r" and
         aa1:"r \<le> 10" and
         aa2:"hd (s (Suc i)) = (if hd (x i) = Zero then hd (s i) - r else hd (s i) + r)"
         by (simp add: SteamBoiler_def, auto)
    from Suc and a4 and sg4 and sg5 show ?case
    proof (cases "hd (x i) = Zero")
       assume aaZero:"hd (x i) = Zero"
       from a1 and sg4 and this have
         sg7:"(fin_make_untimed (inf_truncate z i)) !
             ((length (fin_make_untimed (inf_truncate z i))) - Suc 0)  = Zero"
         by (simp add: L1_Converter)
       from aa2 and aaZero have sg8:"hd (s (Suc i)) = hd (s i) - r" by simp
       from a4 and sg7 and sg5  and sg8 and sg4 and aa1 show ?thesis
          by (rule L9_Controller)
     next
       assume aaOne:"hd (x i) \<noteq> Zero"
       from a1 and sg4 and this have
         sg7:"(fin_make_untimed (inf_truncate z i)) !
             ((length (fin_make_untimed (inf_truncate z i))) - Suc 0) \<noteq> Zero"
         by (simp add: L1_Converter)
       from aa2 and aaOne have sg9:"hd (s (Suc i)) = hd (s i) + r" by simp
       from Suc and this show ?thesis by simp
     qed
  qed
qed

lemma L3_ControlSystem:
  assumes "ControlSystemArch s"
  shows "hd (s i) \<le> (800:: nat)"
proof -
  from assms obtain x z y
    where a1:"Converter z x" and a2: "SteamBoiler x s y" and a3:"Controller y z"
    by (simp only: ControlSystemArch_def, auto)
  from this have sg1:"ts x"  by (simp add: Converter_def)
  from sg1 and a2 have sg2:"ts y"  by (simp add: L2_Boiler)
  from sg1 and a2 have sg3:"y = s" by (simp add: SteamBoiler_def)
  from a1 and a2 and a3 and sg1 and sg2 and sg3 show "hd (s i) \<le> (800:: nat)"
  proof (induction i)
    case 0
    from this show ?case  by (simp add: L4_Boiler)
  next
    fix i
    case (Suc i)
    from this obtain l
      where a4: "Controller_L s (fin_inf_append [Zero] l) l z"
      by (simp add: Controller_def, atomize, auto)
    from a4 have sg4:"fin_make_untimed (inf_truncate z i) \<noteq> []"
      by (simp add:  L1_Controller)
    from a2 and sg1 have y0asm:"y 0 = [500::nat]"  by (simp add: SteamBoiler_def)
    from Suc and a4 and sg4 and y0asm have sg5: "last (fin_make_untimed (inf_truncate z i)) =  l i"
      by (simp add: L7_Controller)
    from a2 and sg1 obtain r where
         aa0:"0 < r" and
         aa1:"r \<le> 10" and
         aa2:"hd (s (Suc i)) = (if hd (x i) = Zero then hd (s i) - r else hd (s i) + r)"
         by (simp add: SteamBoiler_def, auto)
    from this and Suc and a4 and sg4 and sg5 show ?case
    proof (cases "hd (x i) = Zero")
       assume aaZero:"hd (x i) = Zero"
       from a1 and sg4 and this have
         sg7:"(fin_make_untimed (inf_truncate z i)) !
             ((length (fin_make_untimed (inf_truncate z i))) - Suc 0)  = Zero"
         by (simp add: L1_Converter)
       from aa2 and aaZero have sg8:"hd (s (Suc i)) = hd (s i) - r" by simp
       from this and Suc show ?thesis by simp
     next
       assume aaOne:"hd (x i) \<noteq> Zero"
       from a1 and sg4 and this have
         sg7:"(fin_make_untimed (inf_truncate z i)) !
             ((length (fin_make_untimed (inf_truncate z i))) - Suc 0) \<noteq> Zero"
         by (simp add: L1_Converter)
       from aa2 and aaOne have sg9:"hd (s (Suc i)) = hd (s i) + r" by simp
       from a4 and sg7 and sg5 and sg9 and sg4  and aa1 show ?thesis
          by (rule L10_Controller)
     qed
  qed
qed

subsection \<open>Proof of the Refinement Relation\<close>

lemma L0_ControlSystem:
  assumes h1:"ControlSystemArch s"
  shows   "ControlSystem s"
using assms
by (metis ControlSystem_def L1_ControlSystem L2_ControlSystem L3_ControlSystem)

end


(*  Title:      Imperative_Loops
    Author:     Christian Sternagel
*)

header \<open>Looping Constructs for Imperative HOL\<close>

theory Imperative_Loops
imports "~~/src/HOL/Imperative_HOL/Imperative_HOL"
begin

subsection \<open>While Loops\<close>

text \<open>
  We would have liked to restrict to read-only loop conditions using a condition of
  type @{typ "heap \<Rightarrow> bool"} together with @{const tap}. However, this does not allow
  for code generation due to breaking the heap-abstraction.
\<close>
partial_function (heap) while :: "bool Heap \<Rightarrow> 'b Heap \<Rightarrow> unit Heap"
where
  [code]: "while p f = do {
    b \<leftarrow> p;
    if b then f \<guillemotright> while p f
    else return ()
  }"

definition "cond p h \<longleftrightarrow> fst (the (execute p h))"

text \<open>A locale that restricts to read-only loop conditions.\<close>
locale ro_cond =
  fixes p :: "bool Heap"
  assumes read_only: "success p h \<Longrightarrow> snd (the (execute p h)) = h"
begin

lemma ro_cond: "ro_cond p"
  using read_only by (simp add: ro_cond_def)

lemma cond_cases [execute_simps]:
  "success p h \<Longrightarrow> cond p h \<Longrightarrow> execute p h = Some (True, h)"
  "success p h \<Longrightarrow> \<not> cond p h \<Longrightarrow> execute p h = Some (False, h)"
  using read_only [of h] by (auto simp: cond_def success_def)

lemma execute_while_unfolds [execute_simps]:
  "success p h \<Longrightarrow> cond p h \<Longrightarrow> execute (while p f) h = execute (f \<guillemotright> while p f) h"
  "success p h \<Longrightarrow> \<not> cond p h \<Longrightarrow> execute (while p f) h = execute (return ()) h"
  by (auto simp: while.simps execute_simps)

lemma
  success_while_cond: "success p h \<Longrightarrow> cond p h \<Longrightarrow> effect f h h' r \<Longrightarrow> success (while p f) h' \<Longrightarrow>
    success (while p f) h" and
  success_while_not_cond: "success p h \<Longrightarrow> \<not> cond p h \<Longrightarrow> success (while p f) h"
  by (auto simp: while.simps effect_def execute_simps intro!: success_intros)

lemma success_cond_effect:
  "success p h \<Longrightarrow> cond p h \<Longrightarrow> effect p h h True"
  using read_only [of h] by (auto simp: effect_def execute_simps)

lemma success_not_cond_effect:
  "success p h \<Longrightarrow> \<not> cond p h \<Longrightarrow> effect p h h False"
  using read_only [of h] by (auto simp: effect_def execute_simps)

end

text \<open>The loop-condition does no longer hold after the loop is finished.\<close>
lemma ro_cond_effect_while_post:
  assumes "ro_cond p"
    and "effect (while p f) h h' r"
  shows "success p h' \<and> \<not> cond p h'"
  using assms(1)
  apply (induct rule: while.raw_induct [OF _ assms(2)])
  apply (auto elim!: effect_elims effect_ifE simp: cond_def)
  apply (metis effectE ro_cond.read_only)+
done

text \<open>A rule for proving partial correctness of while loops.\<close>
lemma ro_cond_effect_while_induct:
  assumes "ro_cond p"
  assumes "effect (while p f) h h' u"
    and "I h"
    and "\<And>h h' u. I h \<Longrightarrow> success p h \<Longrightarrow> cond p h \<Longrightarrow> effect f h h' u \<Longrightarrow> I h'"
  shows "I h'"
using assms(1, 3-)
proof (induction p f h h' u rule: while.raw_induct)
  case (1 w p f h h' u)
  obtain b
    where "effect p h h b"
    and *: "effect (if b then f \<guillemotright> w p f else return ()) h h' u"
    using "1.hyps" and \<open>ro_cond p\<close>
    by (auto elim!: effect_elims intro: effect_intros) (metis effectE ro_cond.read_only)
  then have cond: "success p h" "cond p h = b" by (auto simp: cond_def elim!: effect_elims effectE)
  show ?case
  proof (cases "b")
    assume "\<not> b"
    then show ?thesis using * and \<open>I h\<close> by (auto elim: effect_elims)
  next
    assume "b"
    moreover
    with * obtain h'' and r
      where "effect f h h'' r" and "effect (w p f) h'' h' u" by (auto elim: effect_elims)
    moreover
    ultimately
    show ?thesis using 1 and cond by blast
  qed
qed fact

lemma effect_success_conv:
  "(\<exists>h'. effect c h h' () \<and> I h') \<longleftrightarrow> success c h \<and> I (snd (the (execute c h)))"
  by (auto simp: success_def effect_def)

context ro_cond
begin

lemmas
  effect_while_post = ro_cond_effect_while_post [OF ro_cond] and
  effect_while_induct [consumes 1, case_names base step] = ro_cond_effect_while_induct [OF ro_cond]

text \<open>A rule for proving total correctness of while loops.\<close>
lemma wf_while_induct [consumes 1, case_names success_cond success_body base step]:
  assumes "wf R" -- \<open>a well-founded relation on heaps proving termination of the loop\<close>
    and success_p: "\<And>h. I h \<Longrightarrow> success p h" -- \<open>the loop-condition terminates\<close>
    and success_f: "\<And>h. I h \<Longrightarrow> success p h \<Longrightarrow> cond p h \<Longrightarrow> success f h" -- \<open>the loop-body terminates\<close>
    and "I h" -- \<open>the invariant holds before the loop is entered\<close>
    and step: "\<And>h h' r. I h \<Longrightarrow> success p h \<Longrightarrow> cond p h \<Longrightarrow> effect f h h' r \<Longrightarrow> (h', h) \<in> R \<and> I h'"
       -- \<open>the invariant is preserved by iterating the loop\<close>
  shows "\<exists>h'. effect (while p f) h h' () \<and> I h'"
using \<open>wf R\<close> and \<open>I h\<close>
proof (induction h)
  case (less h)
  show ?case
  proof (cases "cond p h")
    assume "\<not> cond p h" then show ?thesis
      using \<open>I h\<close> and success_p [of h] by (simp add: effect_def execute_simps)
  next
    assume "cond p h"
    with \<open>I h\<close> and success_f [of h] and step [of h] and success_p [of h]
      obtain h' and r where "effect f h h' r" and "(h', h) \<in> R" and "I h'" and "success p h"
      by (auto simp: success_def effect_def)
    with less.IH [of h'] show ?thesis
      using \<open>cond p h\<close> by (auto simp: execute_simps effect_def)
  qed
qed

text \<open>A rule for proving termination of while loops.\<close>
lemmas
  success_while_induct [consumes 1, case_names success_cond success_body base step] =
    wf_while_induct [unfolded effect_success_conv, THEN conjunct1]

end

subsection \<open>For Loops\<close>

fun "for" :: "'a list \<Rightarrow> ('a \<Rightarrow> 'b Heap) \<Rightarrow> unit Heap"
where
  "for [] f = return ()" |
  "for (x # xs) f = f x \<guillemotright> for xs f"

text \<open>A rule for proving partial correctness of for loops.\<close>
lemma effect_for_induct [consumes 2, case_names base step]:
  assumes "i \<le> j"
    and "effect (for [i ..< j] f) h h' u"
    and "I i h"
    and "\<And>k h h' r. i \<le> k \<Longrightarrow> k < j \<Longrightarrow> I k h \<Longrightarrow> effect (f k) h h' r \<Longrightarrow> I (Suc k) h'"
  shows "I j h'"
using assms
proof (induction "j - i" arbitrary: i h)
  case 0
  then show ?case by (auto elim: effect_elims)
next
  case (Suc k)
  show ?case
  proof (cases "j = i")
    case True
    with Suc show ?thesis by auto
  next
    case False
    with \<open>i \<le> j\<close> and \<open>Suc k = j - i\<close>
      have "i < j" and "k = j - Suc i" and "Suc i \<le> j" by auto
    then have "[i ..< j] = i # [Suc i ..< j]" by (metis upt_rec)
    with \<open>effect (for [i ..< j] f) h h' u\<close> obtain h'' r
      where *: "effect (f i) h h'' r" and **: "effect (for [Suc i ..< j] f) h'' h' u"
      by (auto elim: effect_elims)
    from Suc(6) [OF _ _ \<open>I i h\<close> *] and `i < j`
      have "I (Suc i) h''" by auto
    show ?thesis
      by (rule Suc(1) [OF \<open>k = j - Suc i\<close> \<open>Suc i \<le> j\<close> ** \<open>I (Suc i) h''\<close> Suc(6)]) auto
  qed
qed

text \<open>A rule for proving total correctness of for loops.\<close>
lemma for_induct [consumes 1, case_names succeed base step]:
  assumes "i \<le> j"
    and "\<And>k h. I k h \<Longrightarrow> i \<le> k \<Longrightarrow> k < j \<Longrightarrow> success (f k) h"
    and "I i h"
    and "\<And>k h h' r. I k h \<Longrightarrow> i \<le> k \<Longrightarrow> k < j \<Longrightarrow> effect (f k) h h' r \<Longrightarrow> I (Suc k) h'"
  shows "\<exists>h'. effect (for [i ..< j] f) h h' () \<and> I j h'" (is "?P i h")
using assms
proof (induction "j - i" arbitrary: i h)
  case 0
  then show ?case by (auto simp: effect_def execute_simps)
next
  case (Suc k)
  show ?case
  proof (cases "j = i")
    assume "j = i"
    with Suc show ?thesis by auto
  next
    assume "j \<noteq> i"
    with \<open>i \<le> j\<close> and \<open>Suc k = j - i\<close>
      have "i < j" and "k = j - Suc i" and "Suc i \<le> j" by auto
    then have [simp]: "[i ..< j] = i # [Suc i ..< j]" by (metis upt_rec)
    obtain h' r where *: "effect (f i) h h' r"
      using Suc(4) [OF \<open>I i h\<close> le_refl \<open>i < j\<close>] by (auto elim!: success_effectE)
    moreover
    then have "I (Suc i) h'" using Suc by auto
    moreover
    have "?P (Suc i) h'"
      by (rule Suc(1) [OF \<open>k = j - Suc i\<close> \<open>Suc i \<le> j\<close> Suc(4) \<open>I (Suc i) h'\<close> Suc(6)]) auto
    ultimately
    show ?case by (auto simp: effect_def execute_simps)
  qed
qed

text \<open>A rule for proving termination of for loops.\<close>
lemmas
  success_for_induct [consumes 1, case_names succeed base step] =
    for_induct [unfolded effect_success_conv, THEN conjunct1]

end