(*  Title:      regular/Safety_Regular.thy
    Author:     Sven Linker

Distance and Lane change controller for cars with regular sensors.
Flawed safety theorem and proof of flawedness.
Controller definitions that take knowledge of other cars
into account and correct safety theorem.
*)

section\<open>Safety for Cars with Regular Sensors\<close>
text\<open>
This section contains the definition of requirements for
lane change and distance controllers for cars, with the assumption
of regular sensors. Using these definitions, we show that safety
is an invariant along all possible behaviour of cars.
However, we need to slightly amend our notion of safety, compared
to the safety proof for perfect sensors.
\<close>

theory Safety_Regular
  imports HMLSL_Regular
begin
context hmlsl_regular
begin

interpretation hmlsl : hmlsl "regular :: cars \<Rightarrow> traffic \<Rightarrow> cars \<Rightarrow> real"
proof unfold_locales
  fix e ts c
  show " 0 < regular e ts c"
    by (metis less_add_same_cancel2 less_trans regular_def
        traffic.psGeZero traffic.sdGeZero)
qed
notation hmlsl.space ("space")
notation hmlsl.re ("re'(_')")
notation hmlsl.cl("cl'(_')")
notation hmlsl.len ("len")

text\<open>
First we show that the same "safety" theorem as for perfect senors can be
proven. However, we will subsequently show that this theorem does not
ensure safety from the perspective of each car.

The controller definitions for this "flawed" safety are the same as for perfect sensors.
\<close>

abbreviation safe::"cars\<Rightarrow>\<sigma>"
  where "safe e \<equiv> \<^bold>\<forall> c. \<^bold>\<not>(c \<^bold>= e) \<^bold>\<rightarrow> \<^bold>\<not>\<^bold>\<langle>re(c) \<^bold>\<and> re(e) \<^bold>\<rangle>"

abbreviation DC::"\<sigma>"
  where "DC \<equiv> \<^bold>G(\<^bold>\<forall> c d. \<^bold>\<not>(c \<^bold>= d) \<^bold>\<rightarrow>
                  \<^bold>\<not>\<^bold>\<langle>re(c) \<^bold>\<and> re(d)\<^bold>\<rangle> \<^bold>\<rightarrow> \<^bold>\<box>\<^bold>\<tau> \<^bold>\<not>\<^bold>\<langle>re(c) \<^bold>\<and> re(d)\<^bold>\<rangle>)"

abbreviation pcc::"cars \<Rightarrow> cars \<Rightarrow> \<sigma>"
  where "pcc c d \<equiv> \<^bold>\<not> (c \<^bold>= d) \<^bold>\<and> \<^bold>\<langle> cl(d) \<^bold>\<and> (re(c) \<^bold>\<or> cl(c))\<^bold>\<rangle>"

abbreviation LC::"\<sigma>"
  where "LC \<equiv> \<^bold>G ( \<^bold>\<forall>d.( \<^bold>\<exists> c. pcc c d) \<^bold>\<rightarrow> \<^bold>\<box>r(d) \<^bold>\<bottom>)"

text\<open>
The safety proof is exactly the same as for perfect sensors. Note
in particular, that we fix a single car \(e\) for which we show
safety.
\<close>

theorem safety_flawed:"\<Turnstile>( \<^bold>\<forall>e. safe e ) \<^bold>\<and> DC \<^bold>\<and> LC \<^bold>\<rightarrow> \<^bold>G (\<^bold>\<forall> e. safe e)"
proof (rule allI|rule impI)+
  fix ts v ts'
  fix e c:: cars
  assume assm:"ts,v \<Turnstile> ( \<^bold>\<forall>e. safe e ) \<^bold>\<and> DC \<^bold>\<and> LC"
  assume abs:"(ts \<^bold>\<Rightarrow> ts')"
  assume neg:"ts,v \<Turnstile>\<^bold>\<not>(c \<^bold>= e)"
  from assm have init:"ts,v \<Turnstile> ( \<^bold>\<forall>e. safe e )" by simp
  from assm have DC :"ts,v \<Turnstile> DC" by simp
  from assm have LC: "ts,v \<Turnstile> LC" by simp
  show "ts',move ts ts' v \<Turnstile> \<^bold>\<not> \<^bold>\<langle>re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>" using abs
  proof (induction)
    case (refl )
    have "move ts ts v = v" using move_nothing  by simp
    thus ?case using init move_nothing neg by simp
  next
    case (evolve ts' ts'' )
    have local_DC:
      "ts',move ts ts' v \<Turnstile> \<^bold>\<forall> c d. \<^bold>\<not>(c \<^bold>= d) \<^bold>\<rightarrow>
                            \<^bold>\<not>\<^bold>\<langle>re(c) \<^bold>\<and> re(d)\<^bold>\<rangle> \<^bold>\<rightarrow> \<^bold>\<box>\<^bold>\<tau> \<^bold>\<not>\<^bold>\<langle>re(c) \<^bold>\<and> re(d)\<^bold>\<rangle>"
      using evolve.hyps DC by simp
    show ?case
    proof (rule )
      assume e_def: " (ts'',move ts ts'' v \<Turnstile> \<^bold>\<langle>re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>)"
      from evolve.IH  and e_def and neg have
        ts'_safe:"ts',move ts ts' v \<Turnstile> \<^bold>\<not>(c \<^bold>= e) \<^bold>\<and> \<^bold>\<not>\<^bold>\<langle>re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>" by blast
      hence no_coll_after_evol:"ts',move ts ts' v \<Turnstile> \<^bold>\<box>\<^bold>\<tau> \<^bold>\<not>\<^bold>\<langle>re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>"
        using local_DC by blast
      have move_eq:"move ts' ts'' (move ts ts' v) = move ts ts'' v"
          using "evolve.hyps" abstract.evolve abstract.refl move_trans
        by (meson traffic.abstract.evolve traffic.abstract.refl traffic.move_trans)
      from no_coll_after_evol and evolve.hyps have
        "ts'',move ts' ts'' (move ts ts' v) \<Turnstile>  \<^bold>\<not>\<^bold>\<langle>re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>"
        by blast
      thus False using e_def using  move_eq by fastforce
    qed
  next
    case (cr_res ts' ts'')
    have local_LC: "ts',move ts ts' v \<Turnstile>( \<^bold>\<forall>d.( \<^bold>\<exists> c. pcc c d) \<^bold>\<rightarrow> \<^bold>\<box>r(d) \<^bold>\<bottom>)  "
      using LC cr_res.hyps by blast
    have "move ts ts' v = move ts' ts'' (move ts ts' v)"
      using move_stability_res cr_res.hyps move_trans
      by auto
    hence move_stab: "move ts ts' v = move ts ts'' v"
      using cr_res.hyps local.create_reservation_def local.move_def by auto
    show ?case
    proof (rule)
      assume e_def:" (ts'',move ts ts'' v \<Turnstile> \<^bold>\<langle>re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>)"
      obtain d where d_def: "ts' \<^bold>\<midarrow>r(d) \<^bold>\<rightarrow> ts''" using cr_res.hyps by blast
      have "d = e \<or> d \<noteq> e" by simp
      thus False
      proof
        assume eq:"d = e"
        hence e_trans:"ts' \<^bold>\<midarrow>r(e) \<^bold>\<rightarrow> ts''" using d_def by simp
        from e_def have "ts'',move ts ts'' v \<Turnstile> \<^bold>\<langle> re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>" by auto
        hence "\<exists>v'. (v' \<le> move ts ts'' v) \<and> (ts'',v' \<Turnstile> re(c) \<^bold>\<and> re(e))"
          using somewhere_leq
          by meson
        then obtain v' where v'_def:
          "(v' \<le> move ts ts'' v) \<and> (ts'',v' \<Turnstile> re(c) \<^bold>\<and> re(e))"
          by blast
        with backwards_res_act have "ts',v' \<Turnstile> re(c) \<^bold>\<and> (re(e) \<^bold>\<or> cl(e))"
          using e_def  backwards_res_stab neg
          by (metis (no_types, lifting) d_def eq)
        hence "\<exists>v'. (v' \<le> move ts ts'' v) \<and> (ts',v' \<Turnstile> re(c) \<^bold>\<and> (re(e) \<^bold>\<or> cl(e)))"
          using  v'_def by blast
        hence "ts',move ts ts'' v \<Turnstile>\<^bold>\<langle> re(c) \<^bold>\<and> (re(e) \<^bold>\<or> cl(e)) \<^bold>\<rangle>"
          using somewhere_leq by meson
        hence "ts',move ts ts'' v \<Turnstile>  \<^bold>\<langle> re(c) \<^bold>\<and> re(e)\<^bold>\<rangle> \<^bold>\<or> \<^bold>\<langle> re(c) \<^bold>\<and> cl(e)\<^bold>\<rangle> "
          using hmlsl.somewhere_and_or_distr by blast
        thus False
        proof
          assume assm':"ts',move ts ts'' v \<Turnstile>  \<^bold>\<langle> re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>"
          have "ts',move ts ts' v \<Turnstile> \<^bold>\<not> (c \<^bold>= e)" using neg by blast
          thus False using assm' cr_res.IH e_def move_stab by force
        next
          assume assm':"ts',move ts ts'' v \<Turnstile>  \<^bold>\<langle> re(c) \<^bold>\<and> cl(e)\<^bold>\<rangle>"
          hence "ts',move ts ts'' v \<Turnstile> \<^bold>\<not> (c \<^bold>=e) \<^bold>\<and> \<^bold>\<langle> re(c) \<^bold>\<and> cl(e)\<^bold>\<rangle>"
            using neg by force
          hence "ts',move ts ts'' v \<Turnstile>\<^bold>\<not> (c \<^bold>=e) \<^bold>\<and> \<^bold>\<langle> cl(e) \<^bold>\<and> (re(c) \<^bold>\<or> cl(c)) \<^bold>\<rangle>" by blast
          hence pcc:"ts',move ts ts'' v \<Turnstile> pcc c e" by blast
          have "ts',move ts ts'' v \<Turnstile>( \<^bold>\<exists> c. pcc c e) \<^bold>\<rightarrow> \<^bold>\<box>r(e) \<^bold>\<bottom>  "
            using local_LC move_stab by fastforce
          hence "ts',move ts ts'' v \<Turnstile> \<^bold>\<box>r(e) \<^bold>\<bottom>" using pcc by blast
          thus "ts'',move ts ts'' v \<Turnstile> \<^bold>\<bottom>" using e_trans by blast
        qed
      next
        assume neq:"d \<noteq> e"
        have "c=d \<or> c \<noteq> d" by simp
        thus False
        proof
          assume neq2:"c \<noteq> d"
          from e_def have "ts'',move ts ts'' v \<Turnstile> \<^bold>\<langle> re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>" by auto
          hence "\<exists>v'. (v' \<le> move ts ts'' v) \<and> (ts'',v' \<Turnstile> re(c) \<^bold>\<and> re(e))"
            using somewhere_leq
            by meson
          then obtain v' where v'_def:
            "(v' \<le> move ts ts'' v) \<and> (ts'',v' \<Turnstile> re(c) \<^bold>\<and> re(e))"
            by blast
          with backwards_res_stab have overlap: "ts',v' \<Turnstile> re(c) \<^bold>\<and> (re(e))"
            using e_def  backwards_res_stab neg neq2
            by (metis (no_types, lifting) d_def neq)
          hence unsafe2:"ts',move ts ts'' v \<Turnstile>\<^bold>\<langle>re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>"
            using   somewhere_leq v'_def by blast
          from cr_res.IH have "ts',move ts ts'' v \<Turnstile> \<^bold>\<not>\<^bold>\<langle>re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>"
            using move_stab by force
          thus False using unsafe2 by best
        next
          assume eq2:"c = d"
          hence e_trans:"ts' \<^bold>\<midarrow>r(c) \<^bold>\<rightarrow> ts''" using d_def by simp
          from e_def have "ts'',move ts ts'' v \<Turnstile> \<^bold>\<langle> re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>" by auto
          hence "\<exists>v'. (v' \<le> move ts ts'' v) \<and> (ts'',v' \<Turnstile> re(c) \<^bold>\<and> re(e))"
            using somewhere_leq
            by meson
          then obtain v' where v'_def:
            "(v' \<le> move ts ts'' v) \<and> (ts'',v' \<Turnstile> re(c) \<^bold>\<and> re(e))"
            by blast
          with backwards_res_act have "ts',v' \<Turnstile>   (re(c) \<^bold>\<or> cl(c)) \<^bold>\<and> (re(e) )"
            using e_def  backwards_res_stab neg
            by (metis (no_types, lifting) d_def eq2)
          hence "\<exists>v'. (v' \<le> move ts ts'' v) \<and> (ts',v' \<Turnstile> (re(c) \<^bold>\<or> cl(c)) \<^bold>\<and> (re(e)))"
            using v'_def by blast
          hence "ts',move ts ts'' v \<Turnstile>\<^bold>\<langle> (re(c) \<^bold>\<or> cl(c)) \<^bold>\<and> (re(e) ) \<^bold>\<rangle>"
            using somewhere_leq by meson
          hence "ts',move ts ts'' v \<Turnstile>  \<^bold>\<langle> re(c) \<^bold>\<and> re(e)\<^bold>\<rangle> \<^bold>\<or> \<^bold>\<langle> cl(c) \<^bold>\<and> re(e)\<^bold>\<rangle> "
            using hmlsl.somewhere_and_or_distr  by blast
          thus False
          proof
            assume assm':"ts',move ts ts'' v \<Turnstile>  \<^bold>\<langle> re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>"
            have "ts',move ts ts'' v \<Turnstile> \<^bold>\<not> (c \<^bold>= e)" using neg by blast
            thus False using assm' cr_res.IH e_def move_stab by fastforce
          next
            assume assm':"ts',move ts ts'' v \<Turnstile>  \<^bold>\<langle> cl(c) \<^bold>\<and> re(e)\<^bold>\<rangle>"
            hence "ts',move ts ts'' v \<Turnstile> \<^bold>\<not> (c \<^bold>=e) \<^bold>\<and> \<^bold>\<langle> cl(c) \<^bold>\<and> re(e)\<^bold>\<rangle>"
              using neg by blast
            hence "ts',move ts ts'' v \<Turnstile>\<^bold>\<not> (c \<^bold>=e) \<^bold>\<and> \<^bold>\<langle> cl(c) \<^bold>\<and> (re(e) \<^bold>\<or> cl(e))\<^bold>\<rangle>"
              by blast
            hence pcc:"ts',move ts ts'' v \<Turnstile> pcc e c" by blast
            have "ts',move ts ts'' v \<Turnstile>( \<^bold>\<exists> d. pcc d c) \<^bold>\<rightarrow> \<^bold>\<box>r(c) \<^bold>\<bottom>  "
              using local_LC move_stab by fastforce
            hence "ts',move ts ts'' v \<Turnstile> \<^bold>\<box>r(c) \<^bold>\<bottom>" using pcc by blast
            thus "ts'',move ts ts'' v \<Turnstile> \<^bold>\<bottom>" using e_trans by blast
          qed
        qed
      qed
    qed
  next
    case (cr_clm ts' ts'')
    have "move ts ts' v = move ts' ts'' (move ts ts' v)"
      using move_stability_clm cr_clm.hyps move_trans
      by auto
    hence move_stab: "move ts ts' v = move ts ts'' v"
      by (metis abstract.simps cr_clm.hyps move_trans)
    show ?case
    proof (rule)
      assume e_def: "(ts'',move ts ts'' v \<Turnstile>  \<^bold>\<langle>re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>)"
      obtain d where d_def: "\<exists>n. (ts' \<^bold>\<midarrow>c(d,n) \<^bold>\<rightarrow> ts'')" using cr_clm.hyps by blast
      then obtain n where n_def:" (ts' \<^bold>\<midarrow>c(d,n) \<^bold>\<rightarrow> ts'')"  by blast
      from e_def have "\<exists>v'. (v' \<le> move ts ts'' v) \<and> (ts'',v' \<Turnstile> re(c) \<^bold>\<and> re(e))"
        using somewhere_leq by fastforce
      then obtain v' where v'_def:
        "(v' \<le> move ts ts'' v) \<and> (ts'',v' \<Turnstile> re(c) \<^bold>\<and> re(e))"
        by blast
      then have " (ts',v' \<Turnstile> re(c) \<^bold>\<and> re(e))"
        using n_def backwards_c_res_stab by blast
      hence "ts',move ts ts'' v \<Turnstile> \<^bold>\<langle>re(c) \<^bold>\<and>re(e) \<^bold>\<rangle>"
        using e_def v'_def somewhere_leq by meson
      thus False using cr_clm.IH move_stab by fastforce
    qed
  next
    case (wd_res ts' ts'')
    have "move ts ts' v = move ts' ts'' (move ts ts' v)"
      using move_stability_wdr wd_res.hyps move_trans
      by auto
    hence move_stab: "move ts ts' v = move ts ts'' v"
      by (metis abstract.simps wd_res.hyps move_trans)
    show ?case
    proof (rule)
      assume e_def:" (ts'',move ts ts'' v \<Turnstile> \<^bold>\<langle>re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>)"
      obtain d and n where n_def:" (ts' \<^bold>\<midarrow>wdr(d,n) \<^bold>\<rightarrow> ts'')"
        using wd_res.hyps by auto
      from e_def have "\<exists>v'. (v' \<le> move ts ts'' v) \<and> (ts'',v' \<Turnstile> re(c) \<^bold>\<and> re(e))"
        using somewhere_leq by fastforce
      then obtain v' where v'_def:
        "(v' \<le> move ts ts'' v) \<and> (ts'',v' \<Turnstile> re(c) \<^bold>\<and> re(e))"
        by blast
      then have " (ts',v' \<Turnstile> re(c) \<^bold>\<and> re(e))"
        using n_def backwards_wdr_res_stab by blast
      hence "ts',move ts ts'' v \<Turnstile>\<^bold>\<langle>re(c) \<^bold>\<and>re(e)\<^bold>\<rangle>" using
          v'_def somewhere_leq by meson
      thus False using wd_res.IH move_stab by fastforce
    qed
  next
    case (wd_clm ts' ts'')
    have "move ts ts' v = move ts' ts'' (move ts ts' v)"
      using move_stability_wdc wd_clm.hyps move_trans
      by auto
    hence move_stab: "move ts ts' v = move ts ts'' v"
      by (metis abstract.simps wd_clm.hyps move_trans)
    show ?case
    proof (rule)
      assume e_def: " (ts'',move ts ts'' v \<Turnstile> \<^bold>\<langle>re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>)"
      obtain d where d_def: " (ts' \<^bold>\<midarrow>wdc(d) \<^bold>\<rightarrow> ts'')" using wd_clm.hyps by blast
      from e_def have "\<exists>v'. (v' \<le> move ts ts'' v) \<and> (ts'',v' \<Turnstile> re(c) \<^bold>\<and> re(e))"
        using somewhere_leq by fastforce
      then obtain v' where v'_def:
        "(v' \<le> move ts ts'' v) \<and> (ts'',v' \<Turnstile> re(c) \<^bold>\<and> re(e))"
        by blast
      from this have " (ts',v' \<Turnstile> re(c) \<^bold>\<and> re(e))"
        using d_def backwards_wdc_res_stab by blast
      hence "ts',move ts ts'' v \<Turnstile> \<^bold>\<langle>re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>" using  v'_def somewhere_leq by meson
      thus False using wd_clm.IH move_stab by fastforce
    qed
  qed
qed

text\<open>
As stated above, the flawed safety theorem does not ensure safety for
the perspective of each car.
In particular, we can construct a traffic snapshot and a view, such that
it satisfies our safety predicate for each car, but if we switch the
perspective of the view to another car, the situation is unsafe. A
visualisation of this situation can be found in the publication
of this work at iFM 2017 \cite{Linker2017}.
\<close>

lemma safety_not_invariant_switch:
  "\<exists>ts v. (ts,v \<Turnstile> \<^bold>\<forall>e. safe(e) \<^bold>\<and> ( \<^bold>\<exists> c. \<^bold>@c  \<^bold>\<not>( \<^bold>\<forall>e. safe(e))))"
proof -
  obtain d c ::cars where assumption:"d \<noteq>c"
    using cars.at_least_two_cars_exists by best
  obtain pos' where  pos'_def:"\<forall>(c::cars). (pos' c) = (5::real)" by best
  obtain po where pos_def:"po = (pos'(c:=0))(d:=2)" by best
  obtain re where res_def:"\<forall>(c::cars). re c = Abs_nat_int{0}" by best
  obtain cl where clm_def:"\<forall>(c::cars). cl c= \<emptyset>" by best
  obtain dy where dyn_def:"\<forall>c::cars. \<forall>x::real . (dy c) x  = (0::real)"  by force
  obtain sd where sd_def:"\<forall>(c::cars). sd c = (2::real)" by best
  obtain ps where ps_def:"\<forall>(c::cars). ps c = (1::real)" by best
  obtain ts_rep where ts_rep_def:"ts_rep= (po, re, cl, dy, ps, sd)"  by best

  have disj:"\<forall>c .((re c) \<sqinter> (cl c) = \<emptyset>)" by (simp add: clm_def nat_int.inter_empty1)
  have re_geq_one:"\<forall>c. |re c| \<ge> 1"
    by (simp add: Abs_nat_int_inverse nat_int.card'_def res_def)
  have re_leq_two:"\<forall>c. |re c| \<le> 2"
    using nat_int.card'.rep_eq res_def nat_int.rep_single by auto
  have cl_leq_one:"\<forall>c. |cl c| \<le> 1"
    using nat_int.card_empty_zero clm_def by (simp )
  have add_leq_two:"\<forall>c . |re c| + |cl c| \<le> 2"
    using nat_int.card_empty_zero clm_def re_leq_two by (simp )
  have  clNextRe :
    "\<forall>c. ((cl c) \<noteq> \<emptyset> \<longrightarrow> (\<exists> n. Rep_nat_int (re c) \<union> Rep_nat_int (cl c) = {n, n+1}))"
    by (simp add: clm_def)
  from dyn_def have dyn_geq_zero:"\<forall>c. \<forall>x. (dy c x) \<ge> 0" by auto
  from ps_def have ps_ge_zero :"\<forall>c. ps c> 0" by auto
  from sd_def have sd_ge_zero: "\<forall>c. sd c > 0" by auto
  have ts_in_type: " ts_rep \<in>
  {ts :: (cars\<Rightarrow>real)*(cars\<Rightarrow>lanes)*(cars\<Rightarrow>lanes)*(cars\<Rightarrow>real\<Rightarrow>real)*(cars\<Rightarrow>real)*(cars\<Rightarrow>real).
    (\<forall>c. ((fst (snd ts))) c \<sqinter> ((fst (snd (snd ts)))) c = \<emptyset> )  \<and>
    (\<forall>c. |(fst (snd ts)) c| \<ge> 1) \<and>
    (\<forall>c. |(fst (snd ts)) c| \<le> 2) \<and>
    (\<forall>c. |(fst (snd (snd ts)) c)| \<le> 1) \<and>
    (\<forall>c. |(fst (snd ts)) c| + |(fst (snd (snd ts))) c| \<le> 2) \<and>
    (\<forall>c. (fst(snd(snd (ts)))) c \<noteq> \<emptyset> \<longrightarrow>
      (\<exists> n. Rep_nat_int ((fst (snd ts)) c) \<union> Rep_nat_int ((fst (snd (snd ts))) c)
        = {n, n+1})) \<and>
    (\<forall>c . fst (snd (snd (snd (snd (ts))))) c > 0) \<and>
    (\<forall>c.  snd (snd (snd (snd (snd (ts))))) c > 0)
 } "
    using pos_def res_def clm_def disj re_geq_one re_leq_two cl_leq_one add_leq_two
      ps_ge_zero sd_ge_zero ts_rep_def
    by auto
  obtain v where v_def:
    "v=\<lparr>ext = Abs_real_int (0,3), lan = Abs_nat_int{0}, own = d\<rparr>"
    by best
  obtain ts where ts_def:"ts=Abs_traffic ts_rep"
    by blast
  have size:"\<forall>c. physical_size ts c = 1" using ps_def physical_size_def ts_rep_def
      ts_in_type ts_def ps_ge_zero using Abs_traffic_inverse
    by auto

  have safe:" ts,v \<Turnstile> \<^bold>\<forall>e. safe(e) "
  proof
    have other_len_zero:"\<forall>e. e \<noteq>c \<and> e \<noteq>d \<longrightarrow> \<parallel> len v ts e\<parallel> = 0"
    proof (rule allI|rule impI)+
      fix e
      assume e_def:" e \<noteq>c \<and> e \<noteq>d"
      have position:"pos ts e = 5" using e_def ts_def ts_rep_def ts_in_type ts_def
          Abs_traffic_inverse pos_def fun_upd_apply pos'_def traffic.pos_def
        by auto
      have "regular (own v) ts e = 1"
        using e_def v_def sensors_def ps_def ts_def size regular_def by auto
      then have space:"space ts v e = Abs_real_int (5,6)"
        using e_def pos_def position hmlsl.space_def  by auto
      have "left (space ts v e) > right (ext v)"
        using space v_def Abs_real_int_inverse by auto
      thus "\<parallel> len v ts e\<parallel> = 0"
        using hmlsl.len_def real_int.length_def Abs_real_int_inverse by auto
    qed
    have no_cars:"\<forall>e. e \<noteq>c \<and> e \<noteq>d \<longrightarrow> (ts,v \<Turnstile> \<^bold>\<not> \<^bold>\<langle> re(e) \<^bold>\<or> cl(e) \<^bold>\<rangle>)"
    proof (rule allI|rule impI|rule notI)+
      fix e
      assume neq:"e \<noteq>c \<and> e \<noteq>d"
      assume contra:"ts,v \<Turnstile> \<^bold>\<langle> re(e) \<^bold>\<or> cl(e) \<^bold>\<rangle>"
      from other_len_zero have len_e:"\<parallel>len v ts e\<parallel> = 0" using neq by auto
      from contra obtain v' where v'_def:"v' \<le> v \<and> (ts,v' \<Turnstile>re(e) \<^bold>\<or> cl(e))"
        using somewhere_leq by force
      from v'_def and len_e have len_v':"\<parallel>len v' ts e\<parallel> = 0"
        using hmlsl.len_empty_subview  by blast
      from v'_def have "ts,v' \<Turnstile>re(e) \<^bold>\<or> cl(e)" by blast
      thus False using len_v' by auto
    qed

    have sensors_c:"regular (own v) ts c = 1"
      using v_def regular_def ps_def ts_def size assumption by auto
    have space_c:"space ts v c = Abs_real_int (0,1)"
      using pos_def ts_def ts_rep_def ts_in_type Abs_traffic_inverse
        fun_upd_apply sensors_c  assumption hmlsl.space_def traffic.pos_def
      by auto
    have lc:"left (space ts v c) = 0" using space_c Abs_real_int_inverse by auto
    have rv:"right (ext v) = 3" using v_def Abs_real_int_inverse by auto
    have lv:"left (ext v) = 0" using v_def Abs_real_int_inverse by auto
    have rc:"right (space ts v c) = 1" using space_c Abs_real_int_inverse by auto
    have len_c:"len v ts c = Abs_real_int(0,1)"
      using space_c v_def hmlsl.len_def lc lv rv rc by auto
    have sensors_d:"regular (own v) ts d = 3"
      using v_def regular_def braking_distance_def ts_def size sd_def
        Abs_traffic_inverse ts_in_type ts_rep_def
      by auto
    have space_d:"space ts v d = Abs_real_int(2,5)"
      using pos_def ts_def ts_rep_def ts_in_type Abs_traffic_inverse
        fun_upd_apply sensors_d assumption hmlsl.space_def traffic.pos_def
      by auto
    have ld:"left (space ts v d) = 2" using space_d Abs_real_int_inverse by auto
    have rd: "right (space ts v d) = 5" using space_d Abs_real_int_inverse by auto
    have len_d :"len v ts d = Abs_real_int(2,3)"
      using space_d v_def hmlsl.len_def ld rd lv rv by auto
    have no_overlap_c_d:"ts,v \<Turnstile>\<^bold>\<not> \<^bold>\<langle>re(c) \<^bold>\<and> re(d)\<^bold>\<rangle>"
    proof (rule notI)
      assume contra:"ts,v \<Turnstile>  \<^bold>\<langle>re(c) \<^bold>\<and> re(d)\<^bold>\<rangle>"
      obtain v' where v'_def:"(v' \<le> v) \<and> (ts,v' \<Turnstile>re(c) \<^bold>\<and> re(d))"
        using somewhere_leq contra by force
      hence len_eq:"len v' ts c = len v' ts d" by simp
      from v'_def have v'_c:"\<parallel>len v' ts c\<parallel> > 0"
                   and  v'_d:"\<parallel>len v' ts d\<parallel> > 0" by simp+
      from v'_c have v'_rel_c:
        "left (space ts v' c) < right (ext v') \<and> right (space ts v' c) > left (ext v')"
        using hmlsl.len_non_empty_inside by blast
      from v'_d have v'_rel_d:
        "left (space ts v' d) < right (ext v') \<and> right (space ts v' d) > left (ext v')"
        using hmlsl.len_non_empty_inside by blast
      have less_len:"len v' ts c \<le> len v ts c"
        using hmlsl.view_leq_len_leq v'_c v'_def less_eq_view_ext_def by blast
      have sp_eq_c:"space ts v' c = space ts v c"
        using v'_def less_eq_view_ext_def regular_def hmlsl.space_def by auto
      have sp_eq_d:"space ts v' d = space ts v d"
        using v'_def less_eq_view_ext_def regular_def hmlsl.space_def by auto

      have "right (ext v') > 0 \<and> right (ext v') > 2"
        using ld lc v'_rel_c v'_rel_d sp_eq_c sp_eq_d by auto
      hence r_v':"right (ext v') > 2" by blast
      have "left (ext v') < 1 \<and> left (ext v') < 5"
        using rd rc v'_rel_c v'_rel_d sp_eq_c sp_eq_d by auto
      hence l_v':"left (ext v') < 1" by blast
      have "len v' ts c \<noteq> ext v'  "
      proof
        assume "len v' ts c = ext v'"
        hence eq:"right (len v' ts c) = right (ext v')" by simp
        from less_len have "right (len v' ts c) \<le> right (len v ts c)"
          by (simp add: less_eq_real_int_def)
        with len_c have "right (len v' ts c) \<le> 1 "
          using Abs_real_int_inverse by auto
        thus False using r_v' eq by linarith
      qed
      thus False using v'_def by blast
    qed
    fix x
    show "ts,v \<Turnstile> safe(x)"
    proof (rule allI|rule impI)+
      fix y
      assume x_neg_y: "ts,v \<Turnstile>  \<^bold>\<not>(y \<^bold>= x)"
      show "ts,v \<Turnstile>\<^bold>\<not>\<^bold>\<langle>re(y) \<^bold>\<and> re(x)\<^bold>\<rangle>"
      proof (cases "y \<noteq>c \<and> y \<noteq>d")
        assume "y \<noteq> c \<and> y \<noteq> d"
        hence "(ts,v \<Turnstile> \<^bold>\<not> \<^bold>\<langle> re(y) \<^bold>\<or> cl(y) \<^bold>\<rangle>)" using no_cars by blast
        hence "ts,v \<Turnstile> \<^bold>\<not> \<^bold>\<langle> re(y) \<^bold>\<rangle>" by blast
        then show ?thesis by blast
      next
        assume "\<not>(y \<noteq>c \<and> y \<noteq>d)"
        hence "y = c \<or> y = d" by blast
        thus ?thesis
        proof
          assume y_eq_c:"y=c"
          thus ?thesis
          proof (cases "x=d")
            assume "x=d"
            then show "ts,v \<Turnstile>\<^bold>\<not> \<^bold>\<langle>re(y) \<^bold>\<and> re(x)\<^bold>\<rangle>"
              using no_overlap_c_d y_eq_c by blast
          next
            assume x:"x \<noteq>d"
            have x2:"x \<noteq>c" using y_eq_c x_neg_y by blast
            hence "(ts,v \<Turnstile> \<^bold>\<not> \<^bold>\<langle> re(x) \<^bold>\<or> cl(x) \<^bold>\<rangle>)" using no_cars x by blast
            hence "ts,v \<Turnstile> \<^bold>\<not> \<^bold>\<langle> re(x) \<^bold>\<rangle>" by blast
            thus ?thesis by blast
          qed
        next
          assume y_eq_c:"y=d"
          thus ?thesis
          proof (cases "x=c")
            assume "x=c"
            thus "ts,v \<Turnstile>\<^bold>\<not> \<^bold>\<langle>re(y) \<^bold>\<and> re(x)\<^bold>\<rangle>" using no_overlap_c_d y_eq_c by blast
          next
            assume x:"x \<noteq>c"
            have x2:"x \<noteq>d" using y_eq_c x_neg_y by blast
            hence "(ts,v \<Turnstile> \<^bold>\<not> \<^bold>\<langle> re(x) \<^bold>\<or> cl(x) \<^bold>\<rangle>)" using no_cars x by blast
            hence "ts,v \<Turnstile> \<^bold>\<not> \<^bold>\<langle> re(x) \<^bold>\<rangle>" by blast
            thus ?thesis  by blast
          qed
        qed
      qed
    qed
  qed

  have unsafe:"ts,v \<Turnstile> (\<^bold>\<exists> c. (\<^bold>@c  \<^bold>\<not>( \<^bold>\<forall>e. safe(e))))"
  proof -
    have "ts,v \<Turnstile> (\<^bold>@c  \<^bold>\<not>( \<^bold>\<forall>e. safe(e)))"
    proof (rule allI|rule impI|rule notI)+
      fix vc
      assume sw:"( v=c>vc)"
      have spatial_vc:"ext v = ext vc \<and> lan v = lan vc"
        using switch_def sw by blast
      assume safe: "ts,vc\<Turnstile> ( \<^bold>\<forall>e. safe(e))"
      obtain vc' where vc'_def:
        "vc'=\<lparr>ext = Abs_real_int (2,3), lan = Abs_nat_int {0}, own = c\<rparr>"
        by best
      have own_eq:"own vc' = own vc" using sw switch_def vc'_def by auto
      have ext_vc:"ext vc = Abs_real_int (0,3)" using spatial_vc v_def by force
      have right_ok:"right (ext vc) \<ge> right (ext vc')"
        using vc'_def ext_vc Abs_real_int_inverse by auto
      have left_ok:"left (ext vc') \<ge> left (ext vc)"
        using vc'_def ext_vc Abs_real_int_inverse by auto
      hence ext_leq: "ext vc' \<le> ext vc"
        using right_ok left_ok less_eq_real_int_def by auto
      have "lan vc = Abs_nat_int{0}" using v_def switch_def sw by force
      hence lan_leq:"lan vc' \<sqsubseteq> lan vc" using  vc'_def  order_refl by force
      have leqvc:"vc' \<le> vc"
        using ext_leq lan_leq own_eq less_eq_view_ext_def by force
      have sensors_c:"regular (own vc') ts c = 3"
        using vc'_def regular_def ps_def traffic.braking_distance_def
          ts_def sd_def size assumption Abs_traffic_inverse ts_in_type  ts_rep_def
        by auto
      have space_c:"space ts vc' c = Abs_real_int (0,3)"
        using pos_def ts_def ts_rep_def ts_in_type Abs_traffic_inverse
          fun_upd_apply sensors_c  assumption hmlsl.space_def traffic.pos_def
        by auto
      have lc:"left (space ts vc' c) = 0" using space_c Abs_real_int_inverse by auto
      have rv:"right (ext vc') = 3" using vc'_def Abs_real_int_inverse by auto
      have lv:"left (ext vc') = 2" using vc'_def Abs_real_int_inverse by auto
      have rc:"right (space ts vc' c) = 3" using space_c Abs_real_int_inverse by auto
      have len_c:"len vc' ts c = Abs_real_int(2,3)"
        using space_c v_def hmlsl.len_def lc lv rv rc by auto
      have res_c: "restrict vc' (res ts) c = Abs_nat_int {0}"
        using ts_def ts_rep_def ts_in_type Abs_traffic_inverse res_def traffic.res_def
          inf_idem restrict_def vc'_def
        by force
      have sensors_d:"regular (own vc') ts d = 1"
        using vc'_def regular_def ts_def size sd_def Abs_traffic_inverse ts_in_type
          ts_rep_def assumption
        by auto
      have space_d:"space ts vc' d = Abs_real_int(2,3)"
        using pos_def ts_def ts_rep_def ts_in_type Abs_traffic_inverse
          fun_upd_apply sensors_d assumption hmlsl.space_def traffic.pos_def
        by auto
      have ld:"left (space ts vc' d) = 2" using space_d Abs_real_int_inverse by auto
      have rd: "right (space ts vc' d) = 3" using space_d Abs_real_int_inverse by auto
      have len_d :"len vc' ts d = Abs_real_int(2,3)"
        using space_d v_def hmlsl.len_def ld rd lv rv
        by auto
      have  res_d:"restrict vc' (res ts) d = Abs_nat_int {0}"
        using ts_def ts_rep_def ts_in_type Abs_traffic_inverse res_def traffic.res_def
          inf_idem restrict_def vc'_def by force
      have "ts,vc' \<Turnstile> re(c) \<^bold>\<and> re(d)" using
          len_d len_c vc'_def ts_def ts_rep_def ts_in_type Abs_traffic_inverse
          res_c res_d nat_int.card'_def
          Abs_real_int_inverse real_int.length_def traffic.res_def
          nat_int.singleton2 Abs_nat_int_inverse
        by auto
      with leqvc have "ts,vc \<Turnstile> \<^bold>\<langle>re(c) \<^bold>\<and> re(d)\<^bold>\<rangle>" using somewhere_leq by blast
      with assumption have "ts,vc \<Turnstile> \<^bold>\<not> (c \<^bold>= d) \<^bold>\<and> \<^bold>\<langle> re(c) \<^bold>\<and> re(d) \<^bold>\<rangle>" by blast
      with safe show False by blast
    qed
    thus ?thesis by blast
  qed
  from safe and unsafe have "ts,v  \<Turnstile> \<^bold>\<forall>e. safe(e) \<^bold>\<and>  (\<^bold>\<exists> c. (\<^bold>@c  \<^bold>\<not>( \<^bold>\<forall>e. safe(e))))"
    by blast
  thus ?thesis by blast
qed

text\<open>
Now we show how to amend the controller specifications to gain safety as an invariant
even with regular sensors.

The distance controller can be strengthened, by requiring that we switch
to the perspective of one of the cars involved first, before checking
for the collision. Since all variables are universally quantified,
this ensures that no collision exists for the perspective of any car.
\<close>
abbreviation DC'::"\<sigma>"
  where "DC' \<equiv> \<^bold>G ( \<^bold>\<forall> c d. \<^bold>\<not>(c \<^bold>= d) \<^bold>\<rightarrow>
                  (\<^bold>@d \<^bold>\<not>\<^bold>\<langle>re(c) \<^bold>\<and> re(d)\<^bold>\<rangle>) \<^bold>\<rightarrow> \<^bold>\<box>\<^bold>\<tau> \<^bold>@d \<^bold>\<not>\<^bold>\<langle>re(c) \<^bold>\<and> re(d)\<^bold>\<rangle>)"

text\<open>
The amendment to the lane change controller is slightly different. Instead
of checking the potential collision only from the perspective of the
car \(d\) trying to change lanes, we require that also no other car may
perceive a potential collision. Note that the restriction to \(d\)'s
behaviour can only be enforced within \(d\), if the information from
the other car is somehow passed to \(d\). Hence, we require the
cars to communicate in some way. However, we do not need to specifiy,
\emph{how} this communication is implemented.
\<close>
abbreviation LC'::"\<sigma>"
  where "LC' \<equiv> \<^bold>G ( \<^bold>\<forall>d. (\<^bold>\<exists> c.  (\<^bold>@c (pcc c d)) \<^bold>\<or> (\<^bold>@d (pcc c d))) \<^bold>\<rightarrow> \<^bold>\<box>r(d) \<^bold>\<bottom> ) "

text\<open>
With these new controllers, we can prove a stronger theorem than before. Instead
of proving safety from the perspective of a single car as previously, we now
only consider a traffic situation to be safe, if it satisfies the safety
predicate from the perspective of \emph{all} cars. Note that this immediately
implies the safety invariance theorem proven for perfect sensors.
\<close>
theorem safety:"\<Turnstile> (\<^bold>\<forall>e. \<^bold>@e ( safe e ) ) \<^bold>\<and> DC' \<^bold>\<and> LC' \<^bold>\<rightarrow>  \<^bold>G(\<^bold>\<forall> e.  \<^bold>@ e (safe e))"
proof (rule allI; rule allI;rule impI; rule allI; rule impI; rule allI)
  fix ts v ts' e
  assume assm:"ts,v \<Turnstile> ( \<^bold>\<forall>e. \<^bold>@e (safe e) ) \<^bold>\<and> DC' \<^bold>\<and> LC'"
  assume abs:"(ts \<^bold>\<Rightarrow> ts')"
  from assm have init:"ts,v \<Turnstile> ( \<^bold>\<forall>e. \<^bold>@e (safe e) )" by simp
  from assm have DC :"ts,v \<Turnstile> DC'" by simp
  from assm have LC: "ts,v \<Turnstile> LC'" by simp
  show "ts',move ts ts' v \<Turnstile> ( \<^bold>@e (safe e))" using abs
  proof (induction)
    case (refl )
    have "move ts ts v = v" using move_nothing by blast
    thus ?case using    move_nothing init  by simp
  next
    case (evolve ts' ts'' )
    have local_DC:
      "ts',move ts ts' v \<Turnstile> \<^bold>\<forall> c d. \<^bold>\<not>(c \<^bold>= d) \<^bold>\<rightarrow>
                             (\<^bold>@d \<^bold>\<not>\<^bold>\<langle>re(c) \<^bold>\<and> re(d)\<^bold>\<rangle> ) \<^bold>\<rightarrow> ( \<^bold>\<box>\<^bold>\<tau> \<^bold>@d \<^bold>\<not>\<^bold>\<langle>re(c) \<^bold>\<and> re(d)\<^bold>\<rangle>)"
      using evolve.hyps DC by simp
    show ?case
    proof (rule ccontr)
      assume "\<not> (ts'',move ts ts'' v \<Turnstile> ( \<^bold>@e (safe e)))"
      then have  e_def:"ts'',move ts ts'' v \<Turnstile> \<^bold>\<not>(\<^bold>@e (safe e))" by best
      hence "ts'',move ts ts'' v \<Turnstile> \<^bold>@e (\<^bold>\<not> safe e)"
        using switch_always_exists switch_unique by fastforce
      then obtain ve where ve_def:
        "((move ts ts'' v) =e> ve) \<and> (ts'',ve \<Turnstile> \<^bold>\<not> safe e)"
        using switch_always_exists by fastforce
      hence unsafe:"ts'',ve \<Turnstile> \<^bold>\<exists> c. \<^bold>\<not>(c \<^bold>= e) \<^bold>\<and> \<^bold>\<langle> re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>" by blast
      then obtain c where c_def:"ts'',ve \<Turnstile>  \<^bold>\<not>(c \<^bold>= e) \<^bold>\<and> \<^bold>\<langle> re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>" by blast
      from evolve.IH  and c_def have
        ts'_safe:"ts',move ts ts' v \<Turnstile> \<^bold>@e (\<^bold>\<not>(c \<^bold>= e) \<^bold>\<and> \<^bold>\<not>\<^bold>\<langle>re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>)"
        by blast
      hence not_eq:"ts',move ts ts' v \<Turnstile>\<^bold>@e (\<^bold>\<not>(c \<^bold>= e))"
        and safe':"ts',move ts ts' v \<Turnstile> \<^bold>@e ( \<^bold>\<not>\<^bold>\<langle>re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>)"
        using hmlsl.at_conj_distr by simp+
      from not_eq have not_eq_v:"ts',move ts ts' v \<Turnstile>\<^bold>\<not>(c \<^bold>=e)"
        using hmlsl.at_eq switch_always_exists by auto
      have
        "ts',move ts ts' v \<Turnstile>  \<^bold>\<not>(c \<^bold>= e) \<^bold>\<rightarrow>
                                 (\<^bold>@e \<^bold>\<not>\<^bold>\<langle>re(c) \<^bold>\<and> re(e)\<^bold>\<rangle> ) \<^bold>\<rightarrow> (\<^bold>\<box>\<^bold>\<tau> \<^bold>@e \<^bold>\<not>\<^bold>\<langle>re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>)"
        using local_DC by simp
      hence dc:"ts',move ts ts' v \<Turnstile> (\<^bold>@e \<^bold>\<not>\<^bold>\<langle>re(c) \<^bold>\<and> re(e)\<^bold>\<rangle> ) \<^bold>\<rightarrow>
                                      (\<^bold>\<box>\<^bold>\<tau> \<^bold>@e \<^bold>\<not>\<^bold>\<langle>re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>)"
        using not_eq_v
        by simp
      hence no_coll_after_evol:"ts',move ts ts' v \<Turnstile> ( \<^bold>\<box>\<^bold>\<tau> \<^bold>@e \<^bold>\<not>\<^bold>\<langle>re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>)"
        using safe'
        by simp
      hence 1:"ts'',move ts' ts'' (move ts ts' v) \<Turnstile> \<^bold>@e \<^bold>\<not> \<^bold>\<langle>re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>"
        using evolve.hyps by simp
      have move_eq:"move ts' ts'' (move ts ts' v) = move ts ts'' v"
        using "evolve.hyps" abstract.evolve abstract.refl move_trans
        by blast
      from 1 have "ts'', move ts ts'' v \<Turnstile> \<^bold>@e \<^bold>\<not>\<^bold>\<langle>re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>"
        using move_eq by fastforce
      hence "ts'',ve \<Turnstile>  \<^bold>\<not>\<^bold>\<langle>re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>" using ve_def by blast
      thus False using c_def by blast
    qed
  next
    case (cr_clm ts' ts'')
    have "move ts ts' v = move ts' ts'' (move ts ts' v)"
      using move_stability_clm cr_clm.hyps move_trans
      by auto
    hence move_stab: "move ts ts' v = move ts ts'' v"
      by (metis abstract.simps cr_clm.hyps move_trans)
    show ?case
    proof (rule ccontr)
      assume "\<not> (ts'',move ts ts'' v \<Turnstile> ( \<^bold>@e (safe e)))"
      then have  e_def:"ts'',move ts ts'' v \<Turnstile> \<^bold>\<not>(\<^bold>@e (safe e))" by best
      hence "ts'',move ts ts'' v \<Turnstile> \<^bold>@e (\<^bold>\<not> safe e)"
        using switch_always_exists switch_unique
        by fastforce
      then obtain ve where ve_def:
        "((move ts ts'' v) =e> ve) \<and> (ts'',ve \<Turnstile> \<^bold>\<not> safe e)"
        using switch_always_exists by fastforce
      hence unsafe:"ts'',ve \<Turnstile> \<^bold>\<exists> c. \<^bold>\<not>(c \<^bold>= e) \<^bold>\<and> \<^bold>\<langle> re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>" by blast
      then obtain c where c_def:"ts'',ve \<Turnstile>  \<^bold>\<not>(c \<^bold>= e) \<^bold>\<and> \<^bold>\<langle> re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>"
        by blast
      hence c_neq_e:"ts'',ve \<Turnstile>\<^bold>\<not> (c \<^bold>= e)" by blast
      obtain d n where d_def: " (ts' \<^bold>\<midarrow>c(d,n) \<^bold>\<rightarrow> ts'')" using cr_clm.hyps by blast
      from c_def have "\<exists>v'. (v' \<le> ve) \<and> (ts'',v' \<Turnstile> re(c) \<^bold>\<and> re(e))"
        using somewhere_leq by fastforce
      then obtain v' where v'_def:"(v' \<le> ve) \<and> (ts'',v' \<Turnstile> re(c) \<^bold>\<and> re(e))"
        by blast
      then have " (ts',v' \<Turnstile> re(c) \<^bold>\<and> re(e))"
        using d_def backwards_c_res_stab by blast
      hence "ts',ve \<Turnstile> \<^bold>\<not> safe (e)"
        using c_neq_e c_def v'_def somewhere_leq by meson
      thus False using cr_clm.IH move_stab ve_def by fastforce
    qed
  next
    case (wd_res ts' ts'')
    have "move ts ts' v = move ts' ts'' (move ts ts' v)"
      using move_stability_wdr wd_res.hyps move_trans
      by auto
    hence move_stab: "move ts ts' v = move ts ts'' v"
      by (metis abstract.simps wd_res.hyps move_trans)
    show ?case
    proof (rule ccontr)
      assume "\<not> (ts'',move ts ts'' v \<Turnstile> ( \<^bold>@e (safe e)))"
      then have  e_def:"ts'',move ts ts'' v \<Turnstile> \<^bold>\<not>(\<^bold>@e (safe e))" by best
      hence "ts'',move ts ts'' v \<Turnstile> \<^bold>@e (\<^bold>\<not> safe e)"
        using switch_always_exists switch_unique  by (fastforce)
      then obtain ve where ve_def:
        "((move ts ts'' v) =e> ve) \<and> (ts'',ve \<Turnstile> \<^bold>\<not> safe e)"
        using switch_always_exists by fastforce
      hence unsafe:"ts'',ve \<Turnstile> \<^bold>\<exists> c. \<^bold>\<not>(c \<^bold>= e) \<^bold>\<and> \<^bold>\<langle> re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>" by blast
      then obtain c where c_def:"ts'',ve \<Turnstile>  \<^bold>\<not>(c \<^bold>= e) \<^bold>\<and> \<^bold>\<langle> re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>" by blast
      hence c_neq_e:"ts'',ve \<Turnstile>\<^bold>\<not> (c \<^bold>= e)" by blast
      obtain d n  where n_def:
        "(ts' \<^bold>\<midarrow>wdr(d,n) \<^bold>\<rightarrow> ts'')" using wd_res.hyps  by blast
      from c_def have "\<exists>v'. (v' \<le> ve) \<and> (ts'',v' \<Turnstile> re(c) \<^bold>\<and> re(e))"
        using somewhere_leq by fastforce
      then obtain v' where v'_def:"(v' \<le> ve) \<and> (ts'',v' \<Turnstile> re(c) \<^bold>\<and> re(e))"
        by blast
      then have " (ts',v' \<Turnstile> re(c) \<^bold>\<and> re(e))"
        using n_def backwards_wdr_res_stab by blast
      hence "ts',ve \<Turnstile> \<^bold>\<not> safe (e)"
        using c_neq_e c_def v'_def somewhere_leq by meson
      thus False using wd_res.IH move_stab ve_def by fastforce
    qed
  next
    case (wd_clm ts' ts'')
    have "move ts ts' v = move ts' ts'' (move ts ts' v)"
      using move_stability_wdc wd_clm.hyps move_trans
      by auto
    hence move_stab: "move ts ts' v = move ts ts'' v"
      by (metis abstract.simps wd_clm.hyps move_trans)
    show ?case
    proof (rule ccontr)
      assume "\<not> (ts'',move ts ts'' v \<Turnstile> ( \<^bold>@e (safe e)))"
      then have  e_def:"ts'',move ts ts'' v \<Turnstile> \<^bold>\<not>(\<^bold>@e (safe e))" by best
      then obtain ve where ve_def:
        "((move ts ts'' v) =e> ve) \<and> (ts'',ve \<Turnstile> \<^bold>\<not> safe e)"
        using switch_always_exists by fastforce
      hence unsafe:"ts'',ve \<Turnstile> \<^bold>\<exists> c. \<^bold>\<not>(c \<^bold>= e) \<^bold>\<and> \<^bold>\<langle> re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>" by blast
      then obtain c where c_def:"ts'',ve \<Turnstile>  \<^bold>\<not>(c \<^bold>= e) \<^bold>\<and> \<^bold>\<langle> re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>" by blast
      hence c_neq_e:"ts'',ve \<Turnstile>\<^bold>\<not> (c \<^bold>= e)" by blast
      obtain d where d_def: "(ts' \<^bold>\<midarrow>wdc(d) \<^bold>\<rightarrow> ts'')" using wd_clm.hyps by blast
      from c_def have "\<exists>v'. (v' \<le> ve) \<and> (ts'',v' \<Turnstile> re(c) \<^bold>\<and> re(e))"
        using somewhere_leq by fastforce
      then obtain v' where v'_def:
        "(v' \<le> ve) \<and> (ts'',v' \<Turnstile> re(c) \<^bold>\<and> re(e))" by blast
      then have " (ts',v' \<Turnstile> re(c) \<^bold>\<and> re(e))"
        using d_def backwards_wdc_res_stab by blast
      hence "ts',ve \<Turnstile> \<^bold>\<not> safe (e)"
        using c_neq_e c_def v'_def somewhere_leq by meson
      thus False using wd_clm.IH move_stab ve_def by fastforce
    qed
  next
    case (cr_res ts' ts'')
    have local_LC:
      "ts',move ts ts' v \<Turnstile> \<^bold>\<forall>d.( \<^bold>\<exists> c. (\<^bold>@c (pcc c d)) \<^bold>\<or> (\<^bold>@d (pcc c d))) \<^bold>\<rightarrow> \<^bold>\<box>r(d) \<^bold>\<bottom>"
      using LC cr_res.hyps(1)   by blast
    have "move ts ts' v = move ts' ts'' (move ts ts' v)"
      using move_stability_res cr_res.hyps move_trans
      by auto
    hence move_stab: "move ts ts' v = move ts ts'' v"
      by (metis abstract.simps cr_res.hyps move_trans)
    show ?case
    proof (rule ccontr)
      obtain d where d_def: "(ts' \<^bold>\<midarrow>r(d) \<^bold>\<rightarrow> ts'')"
        using cr_res.hyps by blast
      assume "\<not> (ts'',move ts ts'' v \<Turnstile> ( \<^bold>@e (safe e)))"
      then have  e_def:"ts'',move ts ts'' v \<Turnstile> \<^bold>\<not>(\<^bold>@e (safe e))" by best
      hence "ts'',move ts ts'' v \<Turnstile> \<^bold>@e (\<^bold>\<not> safe e)"
        using switch_always_exists switch_unique by fast
      then obtain ve where ve_def:
        "((move ts ts'' v) =e> ve) \<and> (ts'',ve \<Turnstile> \<^bold>\<not> safe e)"
        using switch_always_exists by fastforce
      hence unsafe:"ts'',ve \<Turnstile> \<^bold>\<exists> c. \<^bold>\<not>(c \<^bold>= e) \<^bold>\<and> \<^bold>\<langle> re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>" by blast
      then obtain c where c_def:"ts'',ve \<Turnstile>  \<^bold>\<not>(c \<^bold>= e) \<^bold>\<and> \<^bold>\<langle> re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>" by blast
      hence c_neq_e:"ts'',ve \<Turnstile>\<^bold>\<not>(c \<^bold>= e)" by blast
      show False
      proof (cases "d=e")
        case True
        hence e_trans:"ts' \<^bold>\<midarrow>r(e) \<^bold>\<rightarrow> ts''" using d_def by simp
        from c_def have "ts'',ve \<Turnstile> \<^bold>\<langle> re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>" by auto
        hence "\<exists>v'. (v' \<le> ve) \<and> (ts'',v' \<Turnstile> re(c) \<^bold>\<and> re(e))"
          using somewhere_leq
          by meson
        then obtain v' where v'_def:
          "(v' \<le> ve) \<and> (ts'',v' \<Turnstile> re(c) \<^bold>\<and> re(e))" by blast
        with backwards_res_act have "ts',v' \<Turnstile>   re(c) \<^bold>\<and> (re(e) \<^bold>\<or> cl(e))"
          using c_def  backwards_res_stab c_neq_e
          by (metis (no_types, lifting) d_def True)
        hence "\<exists>v'. (v' \<le> ve) \<and> (ts',v' \<Turnstile> re(c) \<^bold>\<and> (re(e) \<^bold>\<or> cl(e)))"
          using  v'_def by blast
        hence "ts',ve \<Turnstile>\<^bold>\<langle> re(c) \<^bold>\<and> (re(e) \<^bold>\<or> cl(e)) \<^bold>\<rangle>"
          using somewhere_leq by meson
        hence "ts',ve \<Turnstile>  \<^bold>\<langle> re(c) \<^bold>\<and> re(e)\<^bold>\<rangle> \<^bold>\<or> \<^bold>\<langle> re(c) \<^bold>\<and> cl(e)\<^bold>\<rangle> "
          using hmlsl.somewhere_and_or_distr by metis
        then show False
        proof
          assume assm':"ts',ve \<Turnstile>  \<^bold>\<langle> re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>"
          have "ts',move ts ts' v \<Turnstile> \<^bold>\<not> (c \<^bold>= e)" using c_def by blast
          thus False using assm' cr_res.IH c_def move_stab ve_def by force
        next
          assume assm':"ts',ve \<Turnstile>  \<^bold>\<langle> re(c) \<^bold>\<and> cl(e)\<^bold>\<rangle>"
          hence "ts',ve \<Turnstile> \<^bold>\<not> (c \<^bold>=e) \<^bold>\<and> \<^bold>\<langle> re(c) \<^bold>\<and> cl(e)\<^bold>\<rangle>" using c_def by force
          hence "ts',ve \<Turnstile> pcc c e" by blast
          hence "ts',move ts ts' v \<Turnstile> \<^bold>@e (pcc c e)"
            using ve_def move_stab switch_unique by fastforce
          hence pcc:"ts',move ts ts' v \<Turnstile> (\<^bold>@c (pcc c e)) \<^bold>\<or> (\<^bold>@e (pcc c e))"
            by blast
          have
            "ts',move ts ts' v \<Turnstile>(\<^bold>\<exists> c.(\<^bold>@c (pcc c e)) \<^bold>\<or> (\<^bold>@e (pcc c e))) \<^bold>\<rightarrow> \<^bold>\<box>r(e) \<^bold>\<bottom>"
            using local_LC e_def by blast
          thus "ts'',move ts ts'' v \<Turnstile> \<^bold>\<bottom>" using e_trans pcc by blast
        qed
      next
        case False
        then have neq:"d \<noteq>e" .
        show False
        proof (cases "c=d")
          case False
          from c_def have "ts'',ve \<Turnstile> \<^bold>\<langle> re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>" by auto
          hence "\<exists>v'. (v' \<le> ve) \<and> (ts'',v' \<Turnstile> re(c) \<^bold>\<and> re(e))"
            using somewhere_leq
            by meson
          then obtain v' where v'_def:
            "(v' \<le> ve) \<and> (ts'',v' \<Turnstile> re(c) \<^bold>\<and> re(e))" by blast
          with backwards_res_stab have overlap: "ts',v' \<Turnstile> re(c) \<^bold>\<and> (re(e))"
            using c_def  backwards_res_stab c_neq_e False
            by (metis (no_types, lifting) d_def neq)
          hence unsafe2:"ts',ve \<Turnstile>\<^bold>\<not> safe(e)"
            using  c_neq_e somewhere_leq v'_def by blast
          from cr_res.IH have "ts',move ts ts'' v \<Turnstile> \<^bold>@e (safe(e))"
            using move_stab by force
          thus False using unsafe2 ve_def by best
        next
          case True
          hence e_trans:"ts' \<^bold>\<midarrow>r(c) \<^bold>\<rightarrow> ts''" using d_def by simp
          from c_def have "ts'',ve \<Turnstile> \<^bold>\<langle> re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>" by auto
          hence "\<exists>v'. (v' \<le> ve) \<and> (ts'',v' \<Turnstile> re(c) \<^bold>\<and> re(e))"
            using somewhere_leq
            by meson
          then obtain v' where v'_def:
            "(v' \<le> ve) \<and> (ts'',v' \<Turnstile> re(c) \<^bold>\<and> re(e))" by blast
          with backwards_res_act have "ts',v' \<Turnstile>   (re(c) \<^bold>\<or> cl(c)) \<^bold>\<and> (re(e) )"
            using c_def  backwards_res_stab c_neq_e
            by (metis (no_types, lifting) d_def True)
          hence "\<exists>v'. (v' \<le> ve) \<and> (ts',v' \<Turnstile> (re(c) \<^bold>\<or> cl(c)) \<^bold>\<and> (re(e)))"
            using v'_def by blast
          hence "ts',ve \<Turnstile>\<^bold>\<langle> (re(c) \<^bold>\<or> cl(c)) \<^bold>\<and> (re(e) ) \<^bold>\<rangle>"
            using somewhere_leq move_stab
            by meson
          hence "ts',ve \<Turnstile>  \<^bold>\<langle> re(c) \<^bold>\<and> re(e)\<^bold>\<rangle> \<^bold>\<or> \<^bold>\<langle> cl(c) \<^bold>\<and> re(e)\<^bold>\<rangle> "
            using hmlsl.somewhere_and_or_distr  by blast
          thus False
          proof
            assume assm':"ts',ve \<Turnstile>  \<^bold>\<langle> re(c) \<^bold>\<and> re(e)\<^bold>\<rangle>"
            have "ts',ve \<Turnstile> \<^bold>\<not> (c \<^bold>= e)" using c_def by blast
            thus False using assm' cr_res.IH c_def move_stab ve_def by fastforce
          next
            assume assm':"ts',ve \<Turnstile>  \<^bold>\<langle> cl(c) \<^bold>\<and> re(e)\<^bold>\<rangle>"
            hence "ts',ve \<Turnstile> \<^bold>\<not> (c \<^bold>=e) \<^bold>\<and> \<^bold>\<langle> cl(c) \<^bold>\<and> re(e)\<^bold>\<rangle>" using c_def by blast
            hence "ts',ve \<Turnstile>\<^bold>\<not> (c \<^bold>=e) \<^bold>\<and> \<^bold>\<langle> cl(c) \<^bold>\<and> (re(e) \<^bold>\<or> cl(e)) \<^bold>\<rangle>" by blast
            hence "ts',ve \<Turnstile> pcc e c" by blast
            hence "ts',move ts ts' v \<Turnstile> \<^bold>@e (pcc e c)"
              using ve_def move_stab  switch_unique by fastforce
            hence pcc:"ts', move ts ts' v \<Turnstile> (\<^bold>@e (pcc e c)) \<^bold>\<or> (\<^bold>@c (pcc e c))"
              by blast
            have
              "ts',move ts ts' v \<Turnstile>(\<^bold>\<exists> d.(\<^bold>@d (pcc d c)) \<^bold>\<or> (\<^bold>@c (pcc d c))) \<^bold>\<rightarrow> \<^bold>\<box>r(c) \<^bold>\<bottom>"
              using local_LC move_stab c_def e_def by blast
            hence "ts',move ts ts' v \<Turnstile> \<^bold>\<box>r(c) \<^bold>\<bottom>" using pcc by blast
            thus "ts'',move ts ts'' v \<Turnstile> \<^bold>\<bottom>" using e_trans by blast
          qed
        qed
      qed
    qed
  qed
qed
end
end


theory ExploitLogic
  imports Main "HOL-Word.Word"
begin

(*
  TYPES: Variables, Meta-Variables, Operations, Regions in memory, Expressions, Predicates

  An expression of type E is deterministic. It may contain meta-variables, which should be closed
  by an existential quantifier.

  For example, the predicate:

    Exists ID\<^sub>0 (MetaVar ID\<^sub>0 \<le>\<^sub>s 100) (MetaVar ID\<^sub>0 + MetaVar ID\<^sub>0 ==\<^sub>s Num 0)

  can be read as:

    \<exists> v\<^sub>0 \<le> 100 \<cdot> v\<^sub>0 + v\<^sub>0 == 0

  An expression of type E' can be non-deterministic. For example, the expression:

    NDExpr ID\<^sub>0 (MetaVar ID\<^sub>0 \<le>\<^sub>s 100)

  can be read as:

    { v\<^sub>0 .  v\<^sub>0 \<le> 100 }

*)
type_synonym V  = string
type_synonym \<mu>V = int

datatype Op = Plus | Mult | Eq | Le | And
datatype R =  Region E nat ("\<lbrakk>_,_\<rbrakk>")
     and E =
    Num "64 word"   \<comment> \<open>Immediate number\<close>
  | Var V           \<comment> \<open>Normal variable\<close>
  | MetaVar \<mu>V      \<comment> \<open>Meta variable\<close>
  | Deref R         \<comment> \<open>Read from region\<close>
  | SP_AL R R E E   \<comment> \<open>Case split for separation and aliasing\<close>
  | App E Op E      \<comment> \<open>Application of the pure operator op to LHS and RHS\<close>

datatype E' =
    DExpr E     \<comment> \<open>deterministic\<close>
  | NDExpr \<mu>V E \<comment> \<open>non-deterministic\<close>

datatype P = Exists \<mu>V E P | Expr E

(*
  TYPES: Commands

  See the command semantics (particularly of loop and while) at function "step" below.
*)

datatype C =
    Assign V E' (infixl "::=" 40)
  | Store R V
  | Seq C C     (infixl ";" 30)
  | Loop E C
  | While E C
  | Choice C C  (infixl "\<parallel>" 31)

(*
  Some notation for symbolic operators
*)
abbreviation plus_s (infixl "+\<^sub>s" 65)
  where "e0 +\<^sub>s e1 \<equiv> App e0 Plus e1"
abbreviation mult_s (infixl "*\<^sub>s" 70)
  where "e0 *\<^sub>s e1 \<equiv> App e0 Mult e1"
abbreviation equal_s (infixl "==\<^sub>s" 49)
  where "e0 ==\<^sub>s e1 \<equiv> App e0 Eq e1"
abbreviation less_equal_s (infixl "\<le>\<^sub>s" 49)
  where "e0 \<le>\<^sub>s e1 \<equiv> App e0 Le e1"
abbreviation and_s  (infixr "\<and>\<^sub>s" 35)
  where "e0 \<and>\<^sub>s e1 \<equiv> App e0 And e1"
abbreviation not_s :: "E \<Rightarrow> E"  ("\<not>\<^sub>s _" [40] 40)
  where "\<not>\<^sub>s e \<equiv> e ==\<^sub>s Num 0"

(*
  As state, we simply assign words to variable names.
  Moreover, there is some polymorhpic type 'M representing memory.
*)
record 'M state =
  mem  :: 'M
  vars :: "V \<Rightarrow> 64 word"

locale memory =
  fixes write_region :: "64 word \<times> nat \<Rightarrow> 64 word \<Rightarrow> 'M state \<Rightarrow> 'M state"
    and read_region  :: "64 word \<times> nat \<Rightarrow> 'M state \<Rightarrow> 64 word"
    and separate     :: "64 word \<times> nat \<Rightarrow> 64 word \<times> nat \<Rightarrow> bool" (infixl "\<bowtie>" 55)
    and aliasing     :: "64 word \<times> nat \<Rightarrow> 64 word \<times> nat \<Rightarrow> bool" (infixl "\<simeq>" 55)
  assumes read_write_SP:                 "r' \<bowtie> r \<Longrightarrow> read_region r (write_region r' v \<sigma>) = read_region r \<sigma>"
      and read_write_AL:                 "read_region r (write_region r v \<sigma>) = v"
      and regs_after_write_region[simp]: "vars (write_region r v \<sigma>) = vars \<sigma>"
      and read_region_reg_update[simp]:  "read_region r (\<sigma>\<lparr>vars := x\<rparr>) = read_region r \<sigma>"
      and separate_irreflexive[simp]:    "\<not> separate r r"
      and separate_symmetric[symmetric]: "r \<bowtie> r' = r' \<bowtie> r"
      and separate_or_aliasing:          "r \<bowtie> r' \<or> r \<simeq> r'"
      and aliasing_def:                  "r \<simeq> r' \<equiv> r = r'"
begin

(* Evaluation *)
abbreviation "bool2expr f e0 e1 \<equiv> if f e0 e1 then 1 else 0"

primrec eval_Op
  where
    "eval_Op Plus = (+)"
  | "eval_Op Mult = (*)"
  | "eval_Op Eq   = bool2expr (=)"
  | "eval_Op Le   = bool2expr (\<le>)"
  | "eval_Op And  = bool2expr (\<lambda> e0 e1 . e0 \<noteq> 0 \<and> e1 \<noteq> 0)"

(* to evaluate an expression and a predicate, a valuation \<phi> is needed, i.e., an assignment of values to metavariables *)
fun eval_E :: "'M state \<Rightarrow> (\<mu>V \<Rightarrow> 64 word) \<Rightarrow> E \<Rightarrow> 64 word"
  where
    "eval_E s \<phi> (Num n)          = n"
  | "eval_E s \<phi> (Var v)          = vars s v"
  | "eval_E s \<phi> (MetaVar v)      = \<phi> v"
  | "eval_E s \<phi> (Deref \<lbrakk>a,si\<rbrakk>)    = read_region (eval_E s \<phi> a,si) s"
  | "eval_E s \<phi> (SP_AL \<lbrakk>a0,s0\<rbrakk> \<lbrakk>a1,s1\<rbrakk> e0 e1) =
      (if  (eval_E s \<phi> a0,s0) \<bowtie> (eval_E s \<phi> a1,s1) then eval_E s \<phi> e0 else eval_E s \<phi> e1)"
  | "eval_E s \<phi> (App e0 op e1)  =  eval_Op op (eval_E s \<phi> e0) (eval_E s \<phi> e1)"

primrec eval_E' :: "'M state \<Rightarrow> (\<mu>V \<Rightarrow> 64 word) \<Rightarrow> E' \<Rightarrow> 64 word set"
  where "eval_E' s \<phi> (DExpr e) = {eval_E s \<phi> e}"
  | "eval_E' s \<phi> (NDExpr \<mu>v e) = { i . eval_E s (\<phi>(\<mu>v := i)) e \<noteq> 0}"

fun eval_P
  where
    "eval_P s \<phi> (Expr e) m = (eval_E s \<phi> e = m)"
  | "eval_P s \<phi> (Exists \<mu>v e P) m = (\<exists> i . eval_E s (\<phi>(\<mu>v := i)) e \<noteq> 0 \<and> eval_P s (\<phi>(\<mu>v := i)) P m)"

(*
  A predicate holds if it holds for some initial valuation
*)
definition holds_P :: "'M state \<Rightarrow> P \<Rightarrow> bool"
  where "holds_P s P \<equiv> \<exists> \<phi> i . eval_P s \<phi> P i \<and> i \<noteq> 0"

abbreviation is_path :: "'s list \<Rightarrow> ('s \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> bool"
  where "is_path \<pi> t \<equiv> \<pi> \<noteq> [] \<and> (\<forall> i < length \<pi> - 1 . t (\<pi>!i) (\<pi>!(i+1)))"

(* Semantics: the step function

  Loop B C:
    goes from state s to s' if there exists some path [s, ...s\<^sub>n, s'] where B possibly holds for all states other than s'
    n may be zero, i.e., it may be that s == s'
  While B C:
    goes from state s to s' if Loop B C goes from s to s' and B does not hold in state s'.

  The reason for the split between Loop and While is because it makes proving easier.
*)
inductive step :: "C \<Rightarrow> 'M state \<Rightarrow> 'M state \<Rightarrow> bool"
  where
    "m \<in> eval_E' s \<phi> e' \<Longrightarrow> s' = s\<lparr>vars := (vars s)(v := m)\<rparr> \<Longrightarrow> step (v ::= e') s s'"
  | "eval_E s \<phi> a = m \<Longrightarrow> eval_E s \<phi> (Var v) = m' \<Longrightarrow> s' = write_region (m,si) m' s \<Longrightarrow> step (Store \<lbrakk>a,si\<rbrakk> v) s s'"
  | "step S0 s s' \<Longrightarrow> step S1 s' s'' \<Longrightarrow> step (S0;S1) s s''"
  | "is_path p (step C) \<Longrightarrow> hd p = s \<Longrightarrow>  last p = s' \<Longrightarrow> \<forall> s0 \<in> set (butlast p) . holds_P s0 (Expr B) \<Longrightarrow> step (Loop B C) s s'"
  | "step (Loop B C) s s' \<Longrightarrow> holds_P s' (Expr (\<not>\<^sub>s B)) \<Longrightarrow> step (While B C) s s'"
  | "step C0 s s' \<or> step C1 s s' \<Longrightarrow> step (C0 \<parallel> C1) s s'"

(*
   The definition of an exploit-triple:
    If P holds, then after execution of code C, postcondition Q may hold.
 *)
definition exploit_triple ("\<lbrace>_\<rbrace> _ \<lbrace>_\<rbrace>")
  where "\<lbrace>P\<rbrace> C \<lbrace>Q\<rbrace> \<equiv> \<forall> s . holds_P s P \<longrightarrow> (\<exists> s' . step C s s' \<and> holds_P s' Q)"

(*
  Substitution: replacing a variable with an expression, i.e:

    subst_E v e' e

  is equal to:

    e[v := e']
*)
fun subst_E :: "V \<Rightarrow> E \<Rightarrow> E \<Rightarrow> E"
  where
    "subst_E v e' (Num n)                    = Num n"
  | "subst_E v e' (Var v')                   = (if v = v' then e' else Var v')"
  | "subst_E v e' (MetaVar v')               = MetaVar v'"
  | "subst_E v e' (Deref \<lbrakk>a,s\<rbrakk>)               = Deref \<lbrakk>subst_E v e' a,s\<rbrakk>"
  | "subst_E v e' (SP_AL \<lbrakk>a,s\<rbrakk> \<lbrakk>a',s'\<rbrakk> e0 e1) = SP_AL \<lbrakk>subst_E v e' a,s\<rbrakk> \<lbrakk>subst_E v e' a',s'\<rbrakk> (subst_E v e' e0) (subst_E v e' e1)"
  | "subst_E v e' (App e0 f e1)              = App (subst_E v e' e0) f (subst_E v e' e1)"

primrec subst_P :: "V \<Rightarrow> E \<Rightarrow> P \<Rightarrow> P"
  where "subst_P v e' (Expr e'') = Expr (subst_E v e' e'')"
  | "subst_P v e' (Exists v'' e'' P) = Exists v'' (subst_E v e' e'') (subst_P v e' P)"

(*
  Substitution: replacing a meta variable with another meta-variable:

    subst_\<mu>v \<mu>v \<mu>v' e

  is equal to:

    e[\<mu>v := \<mu>v']
*)
fun subst_\<mu>v :: "\<mu>V \<Rightarrow> \<mu>V \<Rightarrow> E \<Rightarrow> E"
  where
    "subst_\<mu>v \<mu>v \<mu>v' (Num n)                    = Num n"
  | "subst_\<mu>v \<mu>v \<mu>v' (Var v)                    = Var v"
  | "subst_\<mu>v \<mu>v \<mu>v' (MetaVar \<mu>v'')             = (if \<mu>v'' = \<mu>v then MetaVar \<mu>v' else MetaVar \<mu>v'')"
  | "subst_\<mu>v \<mu>v \<mu>v' (Deref \<lbrakk>a,s\<rbrakk>)               = Deref \<lbrakk>subst_\<mu>v \<mu>v \<mu>v' a,s\<rbrakk>"
  | "subst_\<mu>v \<mu>v \<mu>v' (SP_AL \<lbrakk>a,s\<rbrakk> \<lbrakk>a',s'\<rbrakk> e0 e1) = SP_AL \<lbrakk>subst_\<mu>v \<mu>v \<mu>v' a,s\<rbrakk> \<lbrakk>subst_\<mu>v \<mu>v \<mu>v' a',s'\<rbrakk> (subst_\<mu>v \<mu>v \<mu>v' e0) (subst_\<mu>v \<mu>v \<mu>v' e1)"
  | "subst_\<mu>v \<mu>v \<mu>v' (App e0 f e1)              = App (subst_\<mu>v \<mu>v \<mu>v' e0) f (subst_\<mu>v \<mu>v \<mu>v' e1)"

(*
  The set of metavariables from the expression/predicate
*)
fun \<mu>vars :: "E \<Rightarrow> \<mu>V set"
  where
    "\<mu>vars (Num n) = {}"
  | "\<mu>vars (Var v) = {}"
  | "\<mu>vars (MetaVar v) = {v}"
  | "\<mu>vars (Deref \<lbrakk>a,s\<rbrakk>) = \<mu>vars a"
  | "\<mu>vars (SP_AL \<lbrakk>a,s\<rbrakk> \<lbrakk>a',s'\<rbrakk>  e0 e1) = \<mu>vars a \<union> \<mu>vars a' \<union> \<mu>vars e0 \<union> \<mu>vars e1"
  | "\<mu>vars (App e0 op e1) = \<mu>vars e0 \<union> \<mu>vars e1"

primrec \<mu>vars_P
  where "\<mu>vars_P (Expr e) = \<mu>vars e"
  | "\<mu>vars_P (Exists \<mu>v e P) = {\<mu>v} \<union> \<mu>vars e \<union> \<mu>vars_P P"

(*
  Conjunction of a predicate and an expression
*)
primrec and_P :: "P \<Rightarrow> E \<Rightarrow> P"  (infixr "\<and>\<^sub>P" 35)
  where
    "(Expr e \<and>\<^sub>P e0) = Expr (e \<and>\<^sub>s e0)"
  | "(Exists v e P \<and>\<^sub>P e0) = Exists v e (P \<and>\<^sub>P e0)"

(*
  Implication for predicates
*)

definition implies_P :: "[P,P] \<Rightarrow> bool"  (infixr "\<longrightarrow>\<^sub>P" 25)
  where "P \<longrightarrow>\<^sub>P Q \<equiv> \<forall> s . holds_P s P \<longrightarrow> holds_P s Q"

(* Predicate transformation *)

(* First, predicate transformation for dealing with writing to memory (store) *)
fun \<tau>_store_E   :: "C \<Rightarrow> E \<Rightarrow> E"
and \<tau>_store_R :: "C \<Rightarrow> R \<Rightarrow> E"
  where
    "\<tau>_store_E c (Deref \<lbrakk>a,s\<rbrakk>)               = \<tau>_store_R c \<lbrakk>a,s\<rbrakk> "
  | "\<tau>_store_E c (SP_AL \<lbrakk>a,s\<rbrakk> \<lbrakk>a',s'\<rbrakk> e0 e1)  = (SP_AL \<lbrakk>\<tau>_store_E c a,s\<rbrakk> \<lbrakk>\<tau>_store_E c a',s'\<rbrakk>) (\<tau>_store_E c e0) (\<tau>_store_E c e1)"
  | "\<tau>_store_E c (App e0 op e1)              = App (\<tau>_store_E c e0) op (\<tau>_store_E c e1)"
  | "\<tau>_store_E c (Num n)                     = Num n"
  | "\<tau>_store_E c (Var v)                     = Var v"
  | "\<tau>_store_E c (MetaVar v)                 = MetaVar v"
  | "\<tau>_store_R (Store \<lbrakk>a',s'\<rbrakk> v) \<lbrakk>a,s\<rbrakk>        = (let a_\<tau> = \<tau>_store_E (Store \<lbrakk>a',s'\<rbrakk> v) a in
                                                  SP_AL \<lbrakk>a_\<tau>,s\<rbrakk> \<lbrakk>a',s'\<rbrakk> (Deref \<lbrakk>a_\<tau>,s\<rbrakk>) (Var v))"

primrec \<tau>_store_P :: "C \<Rightarrow> P \<Rightarrow> P"
  where
    "\<tau>_store_P c (Expr e)       = Expr (\<tau>_store_E c e)"
  | "\<tau>_store_P c (Exists v e P) = Exists v (\<tau>_store_E c e) (\<tau>_store_P c P)"

(* The complete predicate transformation function *)
inductive \<tau> :: "C \<Rightarrow> P \<Rightarrow> P \<Rightarrow> bool"
  where
  \<tau>_assign_D:  "\<mu>vars e = {} \<Longrightarrow> P = subst_P v e Q \<Longrightarrow> \<tau> (v ::= DExpr e) P Q"
| \<tau>_assign_ND: "\<mu>v\<^sub>f \<notin> \<mu>vars_P Q \<Longrightarrow> \<mu>v\<^sub>f \<notin> \<mu>vars e \<Longrightarrow> P = Exists \<mu>v\<^sub>f (subst_\<mu>v \<mu>v \<mu>v\<^sub>f e) (subst_P v (MetaVar \<mu>v\<^sub>f) Q) \<Longrightarrow> \<tau> (v ::= NDExpr \<mu>v e) P Q"
| \<tau>_store:     "case r of \<lbrakk>a,si\<rbrakk> \<Rightarrow> \<mu>vars a = {} \<Longrightarrow> P = \<tau>_store_P (Store r v) Q \<Longrightarrow> \<tau> (Store r v) P Q"
| \<tau>_seq:       "\<tau> C1 Q R \<Longrightarrow> \<tau> C0 P Q \<Longrightarrow> \<tau> (C0;C1) P R"
| \<tau>_loop_0:    "P = Q \<Longrightarrow> \<tau> (Loop B C) P Q"
| \<tau>_loop:      "\<mu>vars B = {} \<Longrightarrow> \<tau> C P\<^sub>1 Q \<Longrightarrow> \<tau> (Loop B C) P (P\<^sub>1 \<and>\<^sub>P B) \<Longrightarrow> \<tau> (Loop B C) P Q"
| \<tau>_while:     "\<mu>vars B = {} \<Longrightarrow> \<tau> (Loop B C) P (Q \<and>\<^sub>P (\<not>\<^sub>s B)) \<Longrightarrow> \<tau> (While B C) P Q"
| \<tau>_choice:    "\<tau> C0 P Q \<or> \<tau> C1 P Q \<Longrightarrow> \<tau> (C0 \<parallel> C1) P Q"
| \<tau>_weaken:    "\<tau> C P' Q \<Longrightarrow>  P \<longrightarrow>\<^sub>P P' \<Longrightarrow> \<tau> C P Q"

(* the following rule can be derived *)
lemma \<tau>_while_0:
  shows "\<mu>vars B = {} \<Longrightarrow> P = (Q \<and>\<^sub>P (\<not>\<^sub>s B)) \<Longrightarrow> \<tau> (While B C) P Q"
  apply (rule \<tau>_while)
  apply simp
  apply (rule \<tau>_loop_0)
  by simp

(* We prove correctness of tau.
  First, substitution lemma's:
*)

(* For determinstic expressions *)
lemma eval_E_subst_E:
  shows "eval_E s \<phi> (subst_E v e e') = eval_E (s\<lparr>vars := (vars s)(v := eval_E s \<phi> e)\<rparr>) \<phi> e'"
  by (induct v e e' rule: subst_E.induct,auto)

lemma valuation_independent:
  shows "\<mu>vars e = {} \<Longrightarrow> eval_E s \<phi> e = eval_E s \<phi>' e"
  by (induct s \<phi> e rule: eval_E.induct ,auto)

lemma eval_P_subst_P:
assumes "\<mu>vars e = {}"
  shows "eval_P s \<phi> (subst_P v e c) i \<longleftrightarrow> eval_P (s\<lparr>vars := (vars s)(v := eval_E s \<phi> e)\<rparr>) \<phi> c i"
  using assms
  apply (induct "s\<lparr>vars := (vars s)(v := eval_E s \<phi> e)\<rparr>" \<phi> c i rule: eval_P.induct,auto simp add: eval_E_subst_E fun_upd_twist valuation_independent)
  by (metis (full_types) valuation_independent)+

lemma holds_P_subst_P:
assumes "\<mu>vars e = {}"
    and "holds_P s (subst_P v e Q)"
  shows "\<exists> \<phi> . holds_P (s\<lparr>vars := (vars s)(v := eval_E s \<phi> e)\<rparr>) Q"
  using assms
  by (auto simp add: holds_P_def eval_P_subst_P)

(* For non-determinstic expressions *)
lemma eval_E_subst_E_\<mu>var:
  assumes "\<mu>v \<notin> \<mu>vars e"
  shows "eval_E s (\<phi>(\<mu>v := m)) (subst_E v (MetaVar \<mu>v) e) = eval_E (s\<lparr>vars := (vars s)(v := m)\<rparr>) \<phi> e"
  using assms
  by (induct v "MetaVar \<mu>v" e rule: subst_E.induct,auto)

lemma eval_P_subst_P_\<mu>var:
assumes "\<mu>v  \<notin> \<mu>vars_P c"
shows "eval_P s (\<phi>(\<mu>v := m)) (subst_P v (MetaVar \<mu>v) c) i \<longleftrightarrow> eval_P (s\<lparr>vars := (vars s)(v := m)\<rparr>) \<phi> c i"
  using assms
  by (induct "s\<lparr>vars := (vars s)(v := m)\<rparr>" \<phi> c i arbitrary: m rule: eval_P.induct,auto simp add: eval_E_subst_E_\<mu>var fun_upd_twist)

lemma holds_P_subst_P_\<mu>var:
assumes "\<mu>v \<notin> \<mu>vars_P Q"
    and "holds_P s (Exists \<mu>v e (subst_P v (MetaVar \<mu>v) Q))"
  shows "\<exists> \<phi> m . eval_E s (\<phi>(\<mu>v := m)) e \<noteq> 0 \<and> holds_P (s\<lparr>vars := (vars s)(v := m)\<rparr>) Q"
  using assms
  by (auto simp add: holds_P_def eval_P_subst_P_\<mu>var)

lemma eval_E_subst_fresh_\<mu>var:
  assumes "\<mu>v\<^sub>f \<notin> \<mu>vars e"
  shows "eval_E s (\<phi>(\<mu>v\<^sub>f := m)) (subst_\<mu>v \<mu>v \<mu>v\<^sub>f e) = eval_E s (\<phi>(\<mu>v := m)) e"
  using assms
  by (induct s "(\<phi>(\<mu>v := m))" e rule: eval_E.induct ,auto)

(* we prove correctness of the transformation for a Store *)
lemma \<tau>_store_E_correct_store:
  assumes "c = Store \<lbrakk>a,si\<rbrakk> v"
      and "s' = write_region (eval_E s \<phi> a, si) (vars s v) s"
  shows "eval_E s' \<phi> e          = eval_E s \<phi> (\<tau>_store_E c e)"
    and "eval_E s' \<phi> (Deref r') = eval_E s \<phi> (\<tau>_store_R c r')"
  using assms
  apply (induct c e and c r' rule:  \<tau>_store_E_\<tau>_store_R.induct)
  apply (auto simp add: Let_def read_write_SP separate_symmetric)
  using aliasing_def read_write_AL separate_or_aliasing by metis

lemma \<tau>_store_P_correct_store:
  assumes "eval_P s \<phi> (\<tau>_store_P (Store \<lbrakk>a,si\<rbrakk> v) Q) i"
     and "\<mu>vars a = {}"
  shows "eval_P (write_region (eval_E s \<phi> a, si) (vars s v) s) \<phi> Q i"
  using assms
proof(induct Q arbitrary: \<phi>)
  case (Exists \<mu>v' e Q)
  thus ?case
    using Exists valuation_independent
    apply auto
    by (metis \<tau>_store_E_correct_store(1))
next
  case (Expr x)
  then show ?case
    apply auto
    using \<tau>_store_E_correct_store(1)
    by blast
qed

lemma not_in_butlast:
  shows "a \<in> set p \<Longrightarrow> a \<notin> set (butlast p) \<Longrightarrow> a = last p"
  by (induct p,auto)

lemma eval_P_conj1:
  shows "i \<noteq> 0 \<Longrightarrow> eval_P s \<phi> (P \<and>\<^sub>P B) i \<Longrightarrow> \<exists>i. i \<noteq> 0 \<and> eval_P s \<phi> P i"
  apply (induct s \<phi> P i rule: eval_P.induct)
  apply (auto simp add: split: if_split_asm)
  by blast

lemma holds_P_conj1:
  shows "holds_P s (P\<^sub>1 \<and>\<^sub>P B) \<Longrightarrow> holds_P s P\<^sub>1"
  apply (auto simp add: holds_P_def)
  using eval_P_conj1 by blast

lemma eval_P_conj2:
  shows "i \<noteq> 0 \<Longrightarrow> \<mu>vars B = {} \<Longrightarrow> eval_P s \<phi> (P \<and>\<^sub>P B) i \<Longrightarrow> \<exists>i. i \<noteq> 0 \<and> eval_E s \<phi> B = i"
  apply (induct s \<phi> P i rule: eval_P.induct)
  apply (auto simp add: split: if_split_asm)
  by (metis valuation_independent)

lemma holds_P_conj2:
  shows "holds_P s' (P\<^sub>1 \<and>\<^sub>P B) \<Longrightarrow> \<mu>vars B = {} \<Longrightarrow> holds_P s' (Expr B)"
  apply (auto simp add: holds_P_def )
  using eval_P_conj2 by blast

theorem \<tau>_correct:
assumes "\<tau> S P Q"
  shows "\<lbrace>P\<rbrace> S \<lbrace>Q\<rbrace>"
  using assms
proof(induct S P Q rule: \<tau>.induct)
  case (\<tau>_assign_D e P v Q)
  {
    fix s
    assume "holds_P s P"
    hence "holds_P s (subst_P v e Q)"
      using \<tau>_assign_D
      by simp
    then obtain \<phi> where "holds_P (s\<lparr>vars := (vars s)(v := eval_E s \<phi> e)\<rparr>) Q"
      using holds_P_subst_P[of e s v Q] \<tau>_assign_D(1)
      by auto
    moreover
    hence "step (v ::= DExpr e) s (s\<lparr>vars := (vars s)(v := eval_E s \<phi> e)\<rparr>)"
      using step.intros(1)[of "eval_E s \<phi> e" s \<phi> "DExpr e" "s\<lparr>vars := (vars s)(v := eval_E s \<phi> e)\<rparr>" v]
      by auto
    ultimately
    have "\<exists> s' . step (v ::= DExpr e) s s' \<and> holds_P s' Q"
      by auto
  }
  thus ?case
    by (auto simp add: exploit_triple_def)
next
  case (\<tau>_assign_ND \<mu>v\<^sub>f Q e P \<mu>v v)
  {
    fix s
    assume "holds_P s P"
    hence "holds_P s (Exists \<mu>v\<^sub>f (subst_\<mu>v \<mu>v \<mu>v\<^sub>f e) (subst_P v (MetaVar \<mu>v\<^sub>f) Q))"
      using \<tau>_assign_ND
      by simp
    then obtain \<phi> m where "eval_E s (\<phi>(\<mu>v\<^sub>f := m)) (subst_\<mu>v \<mu>v \<mu>v\<^sub>f e) \<noteq> 0 \<and> holds_P (s\<lparr>vars := (vars s)(v := m)\<rparr>) Q"
      using holds_P_subst_P_\<mu>var[of \<mu>v\<^sub>f Q s "subst_\<mu>v \<mu>v \<mu>v\<^sub>f e" v] \<tau>_assign_ND(1)
      by auto
    hence "eval_E s (\<phi>(\<mu>v := m)) e \<noteq> 0 \<and> holds_P (s\<lparr>vars := (vars s)(v := m)\<rparr>) Q"
      using \<tau>_assign_ND
      by (auto simp add: eval_E_subst_fresh_\<mu>var)
    moreover
    hence "step (v ::= NDExpr \<mu>v e) s (s\<lparr>vars := (vars s)(v := m)\<rparr>)"
      using step.intros(1)[of m s \<phi> "NDExpr \<mu>v e" "s\<lparr>vars := (vars s)(v := m)\<rparr>" v]
      by auto
    ultimately
    have "\<exists> s' . step (v ::= NDExpr \<mu>v e) s s' \<and> holds_P s' Q"
      by auto
  }
  thus ?case
    by (auto simp add: exploit_triple_def)
next
  case (\<tau>_store r P v Q)
  {
    fix s
    assume "holds_P s P"
    hence P: "holds_P s (\<tau>_store_P (Store r v) Q)"
      using \<tau>_store
      by simp
    obtain a si where r: "r = \<lbrakk>a,si\<rbrakk>"
      by (cases r,auto)
    obtain i \<phi> where i: "i \<noteq> 0 \<and> eval_P s \<phi> (\<tau>_store_P (Store r v) Q) i"
      using P
      by (auto simp add: holds_P_def)
    let ?s' = "write_region (eval_E s \<phi> a, si) (eval_E s \<phi> (Var v)) s"
    have "step (Store r v) s ?s'"
      using step.intros(2) r
      by auto
    moreover
    have "i \<noteq> 0 \<and> eval_P ?s' \<phi> Q i"
      using \<tau>_store_P_correct_store[of s \<phi> a si v Q i] P i r \<tau>_store
      by auto
    ultimately
    have "\<exists> s' . step (Store r v) s s' \<and> holds_P s' Q"
      by (auto simp add: holds_P_def)
  }
  thus ?case
    by (auto simp add: exploit_triple_def)
next
  case (\<tau>_seq C2 Q R C1 P)
  let ?S = "C1 ; C2"
  {
    fix s
    assume "holds_P s P"
    from this \<tau>_seq(4) obtain s' where "step C1 s s' \<and> holds_P s' Q"
      by (auto simp add: exploit_triple_def)
    moreover
    from this \<tau>_seq(2) obtain s'' where "step C2 s' s'' \<and> holds_P s'' R"
      by (auto simp add: exploit_triple_def)
    ultimately
    have "\<exists> s'' . step ?S s s'' \<and> holds_P s'' R"
      apply auto
      using step.intros(3)
      by blast
  }
  thus ?case
    by (auto simp add: exploit_triple_def)
next
  case (\<tau>_loop_0 P Q B C)
  {
    fix s
    assume 1: "holds_P s P"
    have "step (Loop B C) s s"
      apply (rule step.intros(4)[of "[s]"])
      using \<tau>_loop_0 1
      by (auto simp add: holds_P_def split: if_split_asm)
    moreover
    have "holds_P s Q"
      using \<tau>_loop_0 1
      by (auto simp add: holds_P_def)
    ultimately
    have "\<exists> s' . step (Loop B C) s s' \<and> holds_P s' Q"
      by auto
  }
  thus ?case
    by (auto simp add: exploit_triple_def)
next
  case (\<tau>_loop B C P\<^sub>1 Q P)
  {
    fix s
    assume 1: "holds_P s P"
    from this \<tau>_loop(5)
    obtain s' where 2: "step (Loop B C) s s' \<and> holds_P  s' (P\<^sub>1 \<and>\<^sub>P B)"
      by (auto simp add: exploit_triple_def)
    from this \<tau>_loop(3)
    obtain s'' where 3: "step C s' s'' \<and> holds_P s'' Q"
      using holds_P_conj1[of s' P\<^sub>1 "B"]
      by (auto simp add: exploit_triple_def)
    obtain p where 4: "is_path p (step C) \<and> hd p = s \<and> last p = s' \<and> (\<forall>s\<in>set (butlast p) . holds_P s (Expr B))"
      using step.cases[of "Loop B C" s s' False] 2
      by auto
    let ?p' = "p @ [s'']"
    have "is_path ?p' (step C)"
      using 4
      apply (auto)
      by (metis "3" One_nat_def Suc_lessI add.commute add_diff_cancel_left' last_conv_nth less_diff_conv nth_append_length plus_1_eq_Suc nth_append)
    moreover
    have "hd ?p' = s"
      using 4
      by auto
    moreover
    have "last ?p' = s''"
      using 4
      by auto
    moreover
    have "\<forall>s\<in>set (butlast ?p'). holds_P s (Expr B)"
      using 2 3 4 not_in_butlast[of _ p] holds_P_conj2 \<tau>_loop(1)
      by auto
    ultimately
    have "step (Loop B C) s s''"
      by (rule step.intros(4))
    moreover
    have "holds_P s'' Q"
      using 3
      by (auto simp add: holds_P_def)
    ultimately
    have "\<exists> s' . step (Loop B C) s s' \<and> holds_P s' Q"
      by auto
  }
  thus ?case
    by (auto simp add: exploit_triple_def)
next
  case (\<tau>_while B C P Q)
  {
    fix s
    assume 1: "holds_P s P"
    from this \<tau>_while(3)
    obtain s' where 2: "step (Loop B C) s s' \<and> holds_P s' (Q \<and>\<^sub>P (\<not>\<^sub>s B))"
      by (auto simp add: exploit_triple_def)
    have "step (While B C) s s'"
      apply (rule step.intros(5))
      using 2 holds_P_conj2 \<tau>_while(1)
      by (auto simp add: split: if_split_asm)
    hence "\<exists> s' . step (While B C) s s' \<and> holds_P s' Q"
      using 2 holds_P_conj1
      by auto
  }
  thus ?case
    by (auto simp add: exploit_triple_def)
next
  case (\<tau>_choice C0 P Q C1)
  {
    fix s
    assume P: "holds_P s P"
    hence "\<exists> s' . step (C0 \<parallel> C1) s s' \<and> holds_P s' Q"
      using \<tau>_choice exploit_triple_def step.intros(6)
      by blast
  }
  thus ?case
    by (auto simp add: exploit_triple_def)
next
  case (\<tau>_weaken C P' Q P)
  {
    fix s
    assume "holds_P s P"
    hence "holds_P s P'"
      using \<tau>_weaken(3)
      by (auto simp add: implies_P_def)
    hence "\<exists> s' . step C s s' \<and> holds_P s' Q"
      using \<tau>_weaken(2)
      by (auto simp add: exploit_triple_def)
  }
  thus ?case
    by (auto simp add: exploit_triple_def)
next
qed

(*
   EXAMPLES
*)
abbreviation "x \<equiv> Var ''x''"
abbreviation "y \<equiv> Var ''y''"
abbreviation "z \<equiv> Var ''z''"

(*
  { y = z^2 \<and> z > 10 }
  While (z \<le> 10)
      x = y + z;
      y = z + x - 1;
      z = z + 1
  { y = z^2 }
*)
schematic_goal example_zero_iteration:
  assumes "C = While (z \<le>\<^sub>s Num 10)
                     (''x'' ::= DExpr (y +\<^sub>s z);
                      ''y'' ::= DExpr (z +\<^sub>s x +\<^sub>s Num (-1));
                      ''z'' ::= DExpr (z +\<^sub>s Num 1))"
      and "Q = Expr (y ==\<^sub>s z *\<^sub>s z)"
    shows "\<tau> C ?P Q"
  apply (subst assms(1,2))+
  (* one iteration of the body *)
  apply (rule \<tau>_while_0)
  apply simp
  apply simp
  done

(*
  { 2z+y-1 = (z+1)^2 \<and> z=10 }
  While (z \<le> 10)
      x = y + z;
      y = z + x - 1;
      z = z + 1
  { y = z^2 }
*)
schematic_goal example_one_iteration:
  assumes "C = While (z \<le>\<^sub>s Num 10)
                     (''x'' ::= DExpr (y +\<^sub>s z);
                      ''y'' ::= DExpr (z +\<^sub>s x +\<^sub>s Num (-1));
                      ''z'' ::= DExpr (z +\<^sub>s Num 1))"
      and "Q = Expr (y ==\<^sub>s z *\<^sub>s z)"
    shows "\<tau> C ?P Q"
  apply (subst assms(1,2))+
  apply (rule \<tau>_while)
  apply simp
  (* one iteration of the body *)
  apply (rule \<tau>_loop)
  apply simp
  apply (rule \<tau>_seq)
  apply (rule \<tau>_assign_D,simp,simp add: Let_def)
  apply (rule \<tau>_seq)
  apply (rule \<tau>_assign_D,simp,simp add: Let_def)
  apply (rule \<tau>_assign_D,simp,simp add: Let_def)
  apply (rule \<tau>_loop_0)
  apply simp
  done

schematic_goal example_Random:
  assumes "C = While (z \<le>\<^sub>s Num 3)
                  (''y'' ::= NDExpr 42 (MetaVar 42 \<le>\<^sub>s Num 2);
                   ''x'' ::= DExpr (x +\<^sub>s y);
                   ''z'' ::= DExpr (z +\<^sub>s Num 1))"
      and "Q = Expr (x ==\<^sub>s Num 5)"
    shows "\<tau> C ?P Q"
  apply (subst assms(1,2))+
  apply (rule \<tau>_while)
  apply simp
  (* one iteration of the body *)
  apply (rule \<tau>_loop,simp)
  apply (rule \<tau>_seq)
  apply (rule \<tau>_assign_D,simp,simp add: subst_P_def)
  apply (rule \<tau>_seq)
  apply (rule \<tau>_assign_D,simp,simp add: subst_P_def)
  apply (rule \<tau>_assign_ND[of 43],simp,simp,simp add: subst_P_def)
  (* one iteration of the body *)
  apply (rule \<tau>_loop,simp)
  apply (rule \<tau>_seq)
  apply (rule \<tau>_assign_D,simp,simp add: subst_P_def)
  apply (rule \<tau>_seq)
  apply (rule \<tau>_assign_D,simp,simp add: subst_P_def)
  apply (rule \<tau>_assign_ND[of 44],simp,simp,simp add: subst_P_def)
  apply (rule \<tau>_loop_0)
  apply simp
  done

(*
(* simplification *)

(* some simple rewrite rules for expressions *)
fun simp_E :: "E \<Rightarrow> E"
  where
    "simp_E (a +\<^sub>s (b +\<^sub>s c)) = a +\<^sub>s b +\<^sub>s c"
  | "simp_E (App e0 op e1) = App (simp_E e0) op (simp_E e1)"
  | "simp_E e = e"

(*
  A more advanced simplification:
  If e is a deterministic expression, then the predicate:
    Exists \<mu>v e c
  is equivalent to:
    c[\<mu>v := e]
  This simplification eliminates a quantifier.
*)
fun deterministic
  where
    "deterministic (Var v) = True"
  | "deterministic (Num n) = True"
  | "deterministic (MetaVar v) = False"
  | "deterministic (Deref \<lbrakk>a,s\<rbrakk>) = deterministic a"
  | "deterministic (SP_AL \<lbrakk>a,s\<rbrakk> \<lbrakk>a',s'\<rbrakk> e0 e1) = (deterministic a \<and> deterministic a' \<and> deterministic e0 \<and> deterministic e1)"
  | "deterministic (App e0 op e1) = (deterministic e0 \<and> deterministic e1)"
  | "deterministic (Fun f e) = False"

fun subst_E' :: "\<mu>V \<Rightarrow> E \<Rightarrow> E \<Rightarrow> E"
  where
    "subst_E' \<mu>v e (Num n)                    = Num n"
  | "subst_E' \<mu>v e (Var v')                   = Var v'"
  | "subst_E' \<mu>v e (MetaVar \<mu>v')              = (if \<mu>v = \<mu>v' then e else MetaVar \<mu>v')"
  | "subst_E' \<mu>v e (Deref \<lbrakk>a,s\<rbrakk>)              = Deref \<lbrakk>subst_E' \<mu>v e a,s\<rbrakk>"
  | "subst_E' \<mu>v e (SP_AL \<lbrakk>a,s\<rbrakk> \<lbrakk>a',s'\<rbrakk> e0 e1) = SP_AL \<lbrakk>subst_E' \<mu>v e  a,s\<rbrakk> \<lbrakk>subst_E' \<mu>v e  a',s'\<rbrakk> (subst_E' \<mu>v e e0) (subst_E' \<mu>v e e1)"
  | "subst_E' \<mu>v e (App e0 f e1)              = App (subst_E' \<mu>v e e0) f (subst_E' \<mu>v e e1)"
  | "subst_E' \<mu>v e (Fun f e')                 = Fun f (subst_E' \<mu>v e e')"

primrec subst_P'
  where "subst_P' \<mu>v e (Expr e') = Expr (subst_E' \<mu>v e e')"
  | "subst_P' \<mu>v e (Exists \<mu>v' e' c) = Exists \<mu>v' (subst_E' \<mu>v e e') (subst_P' \<mu>v e c)"

lemma size_subst_P':
  shows "size (subst_P' \<mu>v e c) < Suc (size c)"
  by (induct c,auto)

primrec quant_vars
  where "quant_vars (Expr e) = []"
  | "quant_vars (Exists \<mu>v e c) = \<mu>v# quant_vars c"

function simp_P
  where
    "simp_P (Expr e) = Expr (simp_E e)"
  | "simp_P (Exists \<mu>v e c) = (if \<mu>v \<notin> set (quant_vars c) \<and> deterministic e then simp_P (subst_P' \<mu>v e c) else Exists \<mu>v (simp_E e) (simp_P c))"
  by (pat_completeness,auto)
termination simp_P
  apply (relation "measure size")
  by (auto simp add: size_subst_P')

lemma simp_E_correct:
  shows "eval_E s \<phi> (simp_E e) m = eval_E s \<phi> e m"
  apply (induct e arbitrary: m rule: simp_E.induct,auto)
  apply fastforce+
  done
thm eval_E.induct

lemma deterministic_unique_value:
  shows "deterministic e \<Longrightarrow> \<exists>! m . eval_E s \<phi> e m"
  apply (induct e rule: \<mu>vars.induct,auto)
  apply blast
  apply (meson separate_or_aliasing)
  apply (metis aliasing_def separate_irreflexive)
  apply (metis aliasing_def separate_irreflexive)
  by blast+

lemma deterministic_valuation_independent:
  assumes "deterministic e"
  shows "eval_E s \<phi>' e m \<longleftrightarrow> eval_E s \<phi> e m"
  using assms
  by (induct e arbitrary: m rule: \<mu>vars.induct, auto)

lemma temp1:
  assumes "deterministic e"
  shows "eval_E s \<phi> (subst_E' \<mu>v e e0) m \<longleftrightarrow> (\<exists>m'. eval_E s \<phi> e m' \<and> eval_E s (\<phi>(\<mu>v := m')) e0 m)"
  using assms
  apply (induct e0 arbitrary: m rule: \<mu>vars.induct, auto simp add: every_term_evaluates_to_at_least_one_value)
  by (metis assms deterministic_unique_value)+

lemma eval_P_subst_P':
  assumes "\<mu>v \<notin> set (quant_vars c)"
      and "deterministic e"
  shows "eval_P s \<phi> (subst_P' \<mu>v e c) m \<longleftrightarrow> eval_P s \<phi> (Exists \<mu>v e c) m"
  using assms
  apply (induct s \<phi> c m arbitrary:  rule: eval_P.induct,auto simp add: temp1)
  apply (metis deterministic_unique_value fun_upd_twist deterministic_valuation_independent)
  by (metis fun_upd_twist deterministic_valuation_independent)

lemma eval_P_simp_P:
  shows "eval_P s \<phi> (simp_P P) = eval_P s \<phi> P"
  by (induct P arbitrary: \<phi> rule: simp_P.induct,auto simp add: simp_E_correct eval_P_subst_P')

lemma holdsP_simp_P:
  shows "holds_P s (simp_P P) = holds_P s P"
  by (auto simp add: holds_P_def eval_P_simp_P)
*)

(*
definition "fresh_\<mu>var c \<equiv> foldr max (\<mu>vars_P c) 0 + 1"

lemma foldr_max_is_max:
  fixes a :: int
  assumes "a \<in> set s"
  shows "foldr max s 0 \<ge> a"
  using assms
  by (induct s arbitrary: a,auto simp add: max.coboundedI2)

lemma fresh_\<mu>var_is_fresh:
  shows "fresh_\<mu>var c \<notin> set (\<mu>vars_P c)"
  using foldr_max_is_max[of "foldr max (\<mu>vars_P c) 0 + 1" "\<mu>vars_P c"]
  by (auto simp add: fresh_\<mu>var_def)
*)
end