header {* Denotational semantics of Circus actions *}

theory Denotational_Semantics
imports Circus_Actions Var_list
begin

text {* In this section, we introduce the definitions of Circus actions denotational semantics.
We provide the proof of well-formedness of every action. We also provide proofs concerning
the monotonicity of operators over actions.*}

subsection {* Skip *}

definition Skip :: "('\<theta>::ev_eq,'\<sigma>) action" where
"Skip \<equiv> action_of
                  (R (true \<turnstile> \<lambda>(A, A'). tr A' = tr A \<and> \<not>wait A' \<and> more A = more A'))"

lemmas Skip_is_CSP = Skip_is_action[simplified]

lemma relation_of_Skip:
"relation_of Skip =
                  (R (true \<turnstile> \<lambda>(A, A'). tr A' = tr A \<and> \<not>wait A' \<and> more A = more A'))"
by (simp add: Skip_def action_of_inverse Skip_is_CSP)

definition CSP3::"(('\<theta>::ev_eq,'\<sigma>) alphabet_rp) Healthiness_condition"
where "CSP3 (P)  \<equiv>  relation_of Skip ;; P"

definition CSP4::"(('\<theta>::ev_eq,'\<sigma>) alphabet_rp) Healthiness_condition"
where "CSP4 (P)  \<equiv>  P ;; relation_of Skip"

lemma Skip_is_CSP3: "(relation_of Skip) is CSP3 healthy"
apply (auto simp: relation_of_Skip rp_defs design_defs fun_eq_iff CSP3_def)
apply (split cond_splits, simp_all)+
apply (rule_tac b=b in comp_intro)
apply (split cond_splits, simp_all)+
apply (rule_tac b=b in comp_intro)
apply (split cond_splits, simp_all)+
prefer 3
apply (split cond_splits, simp_all)+
apply (auto simp add: prefixeq_def)
done

lemma Skip_is_CSP4: "(relation_of Skip) is CSP4 healthy"
apply (auto simp: relation_of_Skip rp_defs design_defs fun_eq_iff CSP4_def)
apply (split cond_splits, simp_all)+
apply (rule_tac b=b in comp_intro)
apply (split cond_splits, simp_all)+
apply (rule_tac b=b in comp_intro)
apply (split cond_splits, simp_all)+
prefer 3
apply (split cond_splits, simp_all)+
apply (auto simp add: prefixeq_def)
done

lemma Skip_comp_absorb: "(relation_of Skip ;; relation_of Skip) = relation_of Skip"
apply (auto simp: relation_of_Skip fun_eq_iff rp_defs true_def design_defs)
apply (clarsimp split: cond_splits)+
apply (case_tac "ok aa", simp_all)
apply (erule disjE)+
apply (clarsimp simp: prefixeq_def)
apply (clarsimp simp: prefixeq_def)
apply (erule disjE)+
apply (clarsimp simp: prefixeq_def)
apply (clarsimp simp: prefixeq_def)
apply (erule disjE)+
apply (clarsimp simp: prefixeq_def)
apply (clarsimp simp: prefixeq_def)
apply (case_tac "ok aa", simp_all)
apply (clarsimp simp: prefixeq_def)
apply (clarsimp split: cond_splits)+
apply (rule_tac b=a in comp_intro)
apply (clarsimp split: cond_splits)+
apply (rule_tac b=a in comp_intro)
apply (clarsimp split: cond_splits)+
done

subsection {* Stop *}

definition Stop :: "('\<theta>::ev_eq,'\<sigma>) action"
where "Stop \<equiv> action_of (R (true \<turnstile> \<lambda>(A, A'). tr A' = tr A \<and> wait A'))"

lemma Stop_is_action:
"(R (true \<turnstile> \<lambda>(A, A'). tr A' = tr A \<and> wait A')) \<in> {p. is_CSP_process p}"
apply (simp)
apply (rule rd_is_CSP)
by auto

lemmas Stop_is_CSP = Stop_is_action[simplified]

lemma relation_of_Stop:
"relation_of Stop = (R (true \<turnstile> \<lambda>(A, A'). tr A' = tr A \<and> wait A'))"
by (simp add: Stop_def action_of_inverse Stop_is_CSP)

lemma Stop_is_CSP3: "(relation_of Stop) is CSP3 healthy"
apply (auto simp: relation_of_Stop relation_of_Skip rp_defs design_defs fun_eq_iff CSP3_def)
apply (rule_tac b=a in comp_intro)
apply (split cond_splits, auto)
apply (split cond_splits)+
apply (simp_all)
apply (case_tac "ok aa", simp_all)
apply (case_tac "tr aa \<le> tr ba", simp_all)
apply (case_tac "ok ba", simp_all)
apply (case_tac "tr ba \<le> tr c", simp_all)
apply (rule disjI1)
apply (simp add: prefixeq_def)
apply (erule exE)+
apply (rule_tac x="zs@zsa" in exI, simp)
apply (rule disjI1)
apply (simp add: prefixeq_def)
apply (erule exE | erule conjE)+
apply (rule_tac x="zs@zsa" in exI, simp)
apply (split cond_splits)+
apply (simp_all add: true_def)
apply (erule disjE)
apply (simp add: prefixeq_def)
apply (erule exE | erule conjE)+
apply (rule_tac x="zs@zsa" in exI, simp)
apply (auto simp add: prefixeq_def)
done

lemma Stop_is_CSP4: "(relation_of Stop) is CSP4 healthy"
apply (auto simp: relation_of_Stop relation_of_Skip rp_defs design_defs fun_eq_iff CSP4_def)
apply (rule_tac b=b in comp_intro)
apply (split cond_splits, simp_all)+
apply (case_tac "ok aa", simp_all)
apply (case_tac "tr aa \<le> tr ba", simp_all)
apply (case_tac "ok ba", simp_all)
apply (case_tac "tr ba \<le> tr c", simp_all)
apply (rule disjI1)
apply (simp add: prefixeq_def)
apply (erule exE)+
apply (rule_tac x="zs@zsa" in exI, simp)
apply (rule disjI1)
apply (simp add: prefixeq_def)
apply (erule exE | erule conjE)+
apply (rule_tac x="zs@zsa" in exI, simp)
apply (split cond_splits)+
apply (simp_all add: true_def)
apply (erule disjE)
apply (simp add: prefixeq_def)
apply (erule exE | erule conjE)+
apply (rule_tac x="zs@zsa" in exI, simp)
apply (auto simp add: prefixeq_def)
done

subsection {* Chaos *}

definition Chaos :: "('\<theta>::ev_eq,'\<sigma>) action"
where "Chaos \<equiv> action_of (R(false \<turnstile> true))"

lemma Chaos_is_action: "(R(false \<turnstile> true)) \<in> {p. is_CSP_process p}"
apply (simp)
apply (rule rd_is_CSP)
by auto

lemmas Chaos_is_CSP = Chaos_is_action[simplified]

lemma relation_of_Chaos: "relation_of Chaos = (R(false \<turnstile> true))"
by (simp add: Chaos_def action_of_inverse Chaos_is_CSP)

subsection {* State update actions*}

definition Pre ::"'\<sigma> relation  \<Rightarrow> '\<sigma> predicate"
where "Pre sc \<equiv> \<lambda>A. \<exists> A'. sc (A, A')"

definition state_update_before :: "'\<sigma> relation \<Rightarrow> ('\<theta>::ev_eq,'\<sigma>) action \<Rightarrow> ('\<theta>,'\<sigma>) action"
where "state_update_before sc Ac = action_of(R ((\<lambda>(A, A'). (Pre sc) (more A)) \<turnstile>
                      (\<lambda>(A, A'). sc (more A, more A') & \<not>wait A' & tr A = tr A')) ;; relation_of Ac)"

lemma state_update_before_is_action:
"(R ((\<lambda>(A, A'). (Pre sc) (more A)) \<turnstile>
                               (\<lambda>(A, A').sc (more A, more A') & \<not>wait A' & tr A = tr A')) ;; relation_of Ac) \<in> {p. is_CSP_process p}"
apply (simp)
apply (rule seq_CSP)
apply (rule rd_is_CSP1)
apply (auto simp: R_idem2 Healthy_def relation_of_CSP)
done

lemmas state_update_before_is_CSP = state_update_before_is_action[simplified]

lemma relation_of_state_update_before:
"relation_of (state_update_before sc Ac) = (R ((\<lambda>(A, A'). (Pre sc) (more A)) \<turnstile>
                               (\<lambda>(A, A'). sc (more A, more A') & \<not>wait A' & tr A = tr A')) ;; relation_of Ac)"
by (simp add: state_update_before_def action_of_inverse state_update_before_is_CSP)

lemma state_update_before_is_CSP3: "relation_of (state_update_before sc Ac) is CSP3 healthy"
apply (auto simp: relation_of_state_update_before relation_of_Skip rp_defs design_defs fun_eq_iff CSP3_def)
apply (rule_tac b=aa in comp_intro)
apply (split cond_splits, auto)
apply (split cond_splits, simp_all)+
apply (rule_tac b=bb in comp_intro)
apply (split cond_splits, simp_all)+
apply (case_tac "ok aa", simp_all)
apply (case_tac "tr aa \<le> tr ab", simp_all)
apply (case_tac "ok ab", simp_all)
apply (case_tac "tr ab \<le> tr bb", simp_all)
apply (rule disjI1)
apply (simp add: prefixeq_def)
apply (erule exE)+
apply (rule_tac x="zs@zsa" in exI, simp)
apply (rule_tac b=bb in comp_intro)
apply (split cond_splits, simp_all)+
apply (rule disjI1)
apply (simp add: prefixeq_def)
apply (erule exE | erule conjE)+
apply (rule_tac x="zs@zsa" in exI, simp)
apply (rule_tac b=bb in comp_intro)
apply (split cond_splits, simp_all)+
apply (simp_all add: true_def)
apply (erule disjE)
apply (simp add: prefixeq_def)
apply (erule exE | erule conjE)+
apply (rule_tac x="zs@zsa" in exI, simp)
apply (auto simp add: prefixeq_def)
done

lemma state_update_before_is_CSP4:
  assumes A : "relation_of Ac is CSP4 healthy"
  shows "relation_of (state_update_before sc Ac) is CSP4 healthy"
apply (auto simp: relation_of_state_update_before relation_of_Skip rp_defs design_defs fun_eq_iff CSP4_def)
apply (rule_tac b=c in comp_intro)
apply (rule_tac b=ba in comp_intro, simp_all)
apply (split cond_splits, simp_all)
apply (rule_tac b=bb in comp_intro, simp_all)
apply (subst A[simplified design_defs rp_defs CSP4_def relation_of_Skip])
apply (auto simp: rp_defs)
done

definition state_update_after :: "'\<sigma> relation \<Rightarrow> ('\<theta>::ev_eq,'\<sigma>) action \<Rightarrow> ('\<theta>,'\<sigma>) action"
where "state_update_after sc Ac = action_of(relation_of Ac ;; R (true \<turnstile> (\<lambda>(A, A'). sc (more A, more A') & \<not>wait A' & tr A = tr A')))"

lemma state_update_after_is_action:
"(relation_of Ac ;; R (true \<turnstile> (\<lambda>(A, A'). sc (more A, more A') & \<not>wait A' & tr A = tr A'))) \<in> {p. is_CSP_process p}"
apply (simp)
apply (rule seq_CSP)
apply (auto simp: relation_of_CSP[simplified is_CSP_process_def])
apply (rule rd_is_CSP, auto)
done

lemmas state_update_after_is_CSP = state_update_after_is_action[simplified]

lemma relation_of_state_update_after:
"relation_of (state_update_after sc Ac) = (relation_of Ac ;; R (true \<turnstile> (\<lambda>(A, A'). sc (more A, more A') & \<not>wait A' & tr A = tr A')))"
by (simp add: state_update_after_def action_of_inverse state_update_after_is_CSP)

lemma mono_state_update_after: "mono (state_update_after sc)"
by (auto simp: mono_def less_eq_action ref_def relation_of_state_update_after design_defs rp_defs fun_eq_iff
            split: cond_splits dest: relation_of_spec_f_f[simplified]
                                     relation_of_spec_t_f[simplified])

lemma state_update_after_is_CSP3:
  assumes A : "relation_of Ac is CSP3 healthy"
  shows "relation_of (state_update_after sc Ac) is CSP3 healthy"
apply (auto simp: relation_of_state_update_after relation_of_Skip rp_defs design_defs fun_eq_iff CSP3_def)
apply (rule_tac b=aa in comp_intro)
apply (split cond_splits, auto)
apply (rule_tac b=bb in comp_intro, simp_all)
apply (subst A[simplified design_defs rp_defs CSP3_def relation_of_Skip])
apply (auto simp: rp_defs)
done

lemma state_update_after_is_CSP4: "relation_of (state_update_after sc Ac) is CSP4 healthy"
apply (auto simp: relation_of_state_update_after relation_of_Skip rp_defs design_defs fun_eq_iff CSP4_def)
apply (rule_tac b=c in comp_intro)
apply (rule_tac b=ba in comp_intro, simp_all)
apply (split cond_splits, simp_all)+
apply (rule_tac b=bb in comp_intro, simp_all)
apply (split cond_splits, simp_all)+
apply (case_tac "ok bb", simp_all)
apply (case_tac "tr bb \<le> tr c", simp_all)
apply (case_tac "ok ca", simp_all)
apply (case_tac "tr ca \<le> tr c", simp_all)
apply (simp add: prefixeq_def)
apply (erule exE)+
apply (erule_tac x="zs@zsa" in allE, simp)
apply (rule_tac b=bb in comp_intro, simp_all)
apply (split cond_splits, simp_all add: true_def)+
apply (case_tac "ok ca", simp_all)
apply (case_tac "tr ca \<le> tr c", simp_all)
apply (simp add: prefixeq_def)
apply (erule exE | erule conjE)+
apply (rule_tac x="zsa@zs" in exI, simp)
apply (rule_tac b=bb in comp_intro, simp_all)
apply (split cond_splits, simp_all)+
apply (case_tac "tr bb \<le> tr c", simp_all)
apply (simp add: prefixeq_def)
apply (erule exE | erule conjE)+
apply (erule_tac x="zsa@zs" in allE, simp)
apply (auto simp add: prefixeq_def)
done

subsection {* Sequential composition *}

definition
Seq::"('\<theta>::ev_eq,'\<sigma>) action \<Rightarrow> ('\<theta>,'\<sigma>) action \<Rightarrow> ('\<theta>,'\<sigma>) action" (infixl "`;`" 24)
where "P `;` Q \<equiv> action_of (relation_of P ;; relation_of Q)"

lemma Seq_is_action: "(relation_of P ;; relation_of Q) \<in> {p. is_CSP_process p}"
apply (simp)
apply (rule seq_CSP[OF relation_of_CSP[THEN CSP_is_CSP1] relation_of_CSP[THEN CSP_is_R] relation_of_CSP])
done

lemmas Seq_is_CSP = Seq_is_action[simplified]

lemma relation_of_Seq: "relation_of (P `;` Q) = (relation_of P ;; relation_of Q)"
by (simp add: Seq_def action_of_inverse Seq_is_CSP)

lemma mono_Seq: "mono (op `;` P)"
  by (auto simp: mono_def less_eq_action ref_def relation_of_Seq)

lemma CSP3_imp_left_Skip:
  assumes A: "relation_of P is CSP3 healthy"
  shows "(Skip `;` P) = P"
apply (subst relation_of_inject[symmetric])
apply (simp add: relation_of_Seq A[simplified design_defs CSP3_def, symmetric])
done

lemma CSP4_imp_right_Skip:
  assumes A: "relation_of P is CSP4 healthy"
  shows "(P `;` Skip) = P"
apply (subst relation_of_inject[symmetric])
apply (simp add: relation_of_Seq A[simplified design_defs CSP4_def, symmetric])
done

lemma Seq_assoc: "(A `;` (B `;` C)) = ((A `;` B) `;` C)"
by (auto simp: relation_of_inject[symmetric] fun_eq_iff relation_of_Seq rp_defs design_defs)

lemma Skip_absorb: "(Skip `;` Skip) = Skip"
by (auto simp: Skip_comp_absorb relation_of_inject[symmetric] relation_of_Seq)

subsection {* Internal choice *}

definition
Ndet::"('\<theta>::ev_eq,'\<sigma>) action \<Rightarrow> ('\<theta>,'\<sigma>) action \<Rightarrow> ('\<theta>,'\<sigma>) action" (infixl "\<sqinter>" 18)
where "P \<sqinter> Q \<equiv> action_of ((relation_of P) \<or> (relation_of Q))"

lemma Ndet_is_action: "((relation_of P) \<or> (relation_of Q)) \<in> {p. is_CSP_process p}"
apply (simp)
apply (rule disj_CSP)
apply (simp_all add: relation_of_CSP)
done

lemmas Ndet_is_CSP = Ndet_is_action[simplified]

lemma relation_of_Ndet: "relation_of (P \<sqinter> Q) = ((relation_of P) \<or> (relation_of Q))"
by (simp add: Ndet_def action_of_inverse Ndet_is_CSP)

lemma mono_Ndet: "mono (op \<sqinter> P)"
by (auto simp: mono_def less_eq_action ref_def relation_of_Ndet)

subsection {* External choice *}

definition
Det::"('\<theta>::ev_eq,'\<sigma>) action \<Rightarrow> ('\<theta>,'\<sigma>) action \<Rightarrow> ('\<theta>,'\<sigma>) action" (infixl "[+]" 18)
where "P [+] Q \<equiv> action_of(R((\<not>((relation_of P)\<^isup>f\<^isub>f) \<and> \<not>((relation_of Q)\<^isup>f\<^isub>f)) \<turnstile>
                                             (((relation_of P)\<^isup>t\<^isub>f \<and> ((relation_of Q)\<^isup>t\<^isub>f))
                                                \<triangleleft> \<lambda>(A, A'). tr A = tr A' \<and> wait A' \<triangleright>
                                              ((relation_of P)\<^isup>t\<^isub>f \<or> ((relation_of Q)\<^isup>t\<^isub>f)))))"

notation(xsymbol)
  Det (infixl "\<box>" 18)

lemma Det_is_action:
"(R((\<not>((relation_of P)\<^isup>f\<^isub>f) \<and> \<not>((relation_of Q)\<^isup>f\<^isub>f)) \<turnstile>
           (((relation_of P)\<^isup>t\<^isub>f \<and> ((relation_of Q)\<^isup>t\<^isub>f))
              \<triangleleft> \<lambda>(A, A'). tr A = tr A' \<and> wait A' \<triangleright>
            ((relation_of P)\<^isup>t\<^isub>f \<or> ((relation_of Q)\<^isup>t\<^isub>f))))) \<in> {p. is_CSP_process p}"
apply (simp add: spec_def)
apply (rule rd_is_CSP)
apply (auto)
done

lemmas Det_is_CSP = Det_is_action[simplified]

lemma relation_of_Det:
"relation_of (P \<box> Q) = (R((\<not>((relation_of P)\<^isup>f\<^isub>f) \<and> \<not>((relation_of Q)\<^isup>f\<^isub>f)) \<turnstile>
                                          (((relation_of P)\<^isup>t\<^isub>f \<and> ((relation_of Q)\<^isup>t\<^isub>f))
                                             \<triangleleft> \<lambda>(A, A'). tr A = tr A' \<and> wait A' \<triangleright>
                                           ((relation_of P)\<^isup>t\<^isub>f \<or> ((relation_of Q)\<^isup>t\<^isub>f)))))"
apply (unfold Det_def)
apply (rule action_of_inverse)
apply (rule Det_is_action)
done

lemma mono_Det: "mono (op [+] P)"
by (auto simp: mono_def less_eq_action ref_def relation_of_Det design_defs rp_defs fun_eq_iff
            split: cond_splits dest: relation_of_spec_f_f[simplified]
                                     relation_of_spec_t_f[simplified])

subsection {* Reactive design assignment *}

definition
"rd_assign s = action_of (R (true \<turnstile> \<lambda>(A, A'). ref A' = ref A \<and> tr A' = tr A \<and> \<not>wait A' \<and> more A' = s))"

lemmas rd_assign_is_CSP = rd_assign_is_action[simplified]

lemma relation_of_rd_assign:
"relation_of (rd_assign s) =
                  (R (true \<turnstile> \<lambda>(A, A'). ref A' = ref A \<and> tr A' = tr A \<and> \<not>wait A' \<and> more A' = s))"
by (simp add: rd_assign_def  action_of_inverse rd_assign_is_CSP)

subsection {* Local state external choice *}

definition
Loc::"'\<sigma> \<Rightarrow> ('\<theta>::ev_eq,'\<sigma>) action \<Rightarrow> '\<sigma> \<Rightarrow> ('\<theta>,'\<sigma>) action \<Rightarrow> ('\<theta>,'\<sigma>) action"
                                        ("'(()loc _ \<bullet> _ ') \<boxplus> '(()loc _ \<bullet> _ ')")
where "(loc s1 \<bullet> P) \<boxplus> (loc s2 \<bullet> Q) \<equiv>
                   ((rd_assign s1)`;`P) \<box> ((rd_assign s2)`;` Q)"

subsection {* Schema expression *}

definition Schema :: "'\<sigma> relation \<Rightarrow> ('\<theta>::ev_eq,'\<sigma>) action" where
"Schema sc \<equiv> action_of(R ((\<lambda>(A, A'). (Pre sc) (more A)) \<turnstile>
                           (\<lambda>(A, A'). sc (more A, more A') \<and> \<not>wait A' \<and> tr A = tr A')))"

lemmas Schema_is_CSP = Schema_is_action[simplified]

lemma relation_of_Schema:
"relation_of (Schema sc) = (R ((\<lambda>(A, A'). (Pre sc) (more A)) \<turnstile>
                          (\<lambda>(A, A'). sc (more A, more A') \<and> \<not>wait A' \<and> tr A = tr A')))"
by (simp add: Schema_def action_of_inverse Schema_is_CSP)

lemma Schema_is_state_update_before: "Schema u = state_update_before u Skip"
apply (subst relation_of_inject[symmetric])
apply (auto simp: relation_of_Schema relation_of_state_update_before relation_of_Skip rp_defs fun_eq_iff
                  design_defs)
apply (split cond_splits, simp_all)
apply (rule comp_intro)
apply (split cond_splits, simp_all)+
apply (rule comp_intro)
apply (split cond_splits, simp_all)+
prefer 3
apply (split cond_splits, simp_all)+
apply (auto simp: prefixeq_def)
done

subsection {* Parallel composition *}

type_synonym '\<sigma> local_state = "('\<sigma> \<times> ('\<sigma>  \<Rightarrow> '\<sigma> \<Rightarrow> '\<sigma>))"

fun MergeSt :: "'\<sigma> local_state \<Rightarrow> '\<sigma> local_state \<Rightarrow> ('\<theta>,'\<sigma>) relation_rp" where
"MergeSt (s1,s1') (s2,s2') = ((\<lambda>(S, S'). (s1' s1) (more S) = more S');;
                            (\<lambda>(S::('\<theta>,'\<sigma>) alphabet_rp, S'). (s2' s2) (more S) = more S'))"

definition listCons ::"'\<theta> \<Rightarrow> '\<theta> list list \<Rightarrow> '\<theta> list list" ("_ ## _") where
"a ## l = ((map (Cons a)) l)"

fun ParMergel :: "'\<theta>::ev_eq list \<Rightarrow> '\<theta> list \<Rightarrow> '\<theta> set \<Rightarrow> '\<theta> list list" where
    "ParMergel [] [] cs = [[]]"
  | "ParMergel [] (b#tr2) cs = (if (filter_chan_set b cs) then [[]]
                                          else (b ## (ParMergel [] tr2 cs)))"
  | "ParMergel (a#tr1) [] cs = (if (filter_chan_set a cs) then [[]]
                                          else (a ## (ParMergel tr1 [] cs)))"
  | "ParMergel (a#tr1) (b#tr2) cs =
           (if (filter_chan_set a cs)
                   then (if (ev_eq a b)
                              then (a ## (ParMergel tr1 tr2 cs))
                               else (if (filter_chan_set b cs)
                                        then [[]]
                                         else (b ## (ParMergel (a#tr1) tr2 cs))))
                     else (if (filter_chan_set b cs)
                               then (a ## (ParMergel tr1 (b#tr2) cs))
                                 else (a ## (ParMergel tr1 (b#tr2) cs))
                                            @ (b ## (ParMergel (a#tr1) tr2 cs))))"

definition ParMerge::"'\<theta>::ev_eq list \<Rightarrow> '\<theta> list \<Rightarrow> '\<theta> set \<Rightarrow> '\<theta> list set" where
"ParMerge tr1 tr2 cs = set (ParMergel tr1 tr2 cs)"

lemma set_Cons1: "tr1 \<in> set l \<Longrightarrow> a # tr1 \<in> op # a ` set l"
by (auto)

lemma tr_in_set_eq: "(tr1 \<in> op # b ` set l) = (tr1 \<noteq> [] \<and> hd tr1 = b \<and> tl tr1 \<in> set l)"
by (induct l) auto

definition M_par::"(('\<theta>::ev_eq), '\<sigma>) alpha_rp_scheme \<Rightarrow> ('\<sigma>  \<Rightarrow> '\<sigma> \<Rightarrow> '\<sigma>)
                            \<Rightarrow> ('\<theta>, '\<sigma>) alpha_rp_scheme \<Rightarrow> ('\<sigma> \<Rightarrow> '\<sigma> \<Rightarrow> '\<sigma>)
                                \<Rightarrow> ('\<theta> set) \<Rightarrow> ('\<theta>, '\<sigma>) relation_rp" where
"M_par s1 x1 s2 x2 cs =
((\<lambda>(S, S'). ((diff_tr S' S) \<in> ParMerge (diff_tr s1 S) (diff_tr s2 S) cs &
     ev_eq (tr_filter (tr s1) cs) (tr_filter (tr s2) cs))) \<and>
   ((\<lambda>(S, S'). (wait s1 \<or> wait s2) \<and>
                             ref S' \<subseteq> ((((ref s1)\<union>(ref s2))\<inter>cs)\<union>(((ref s1)\<inter>(ref s2))-cs)))
   \<triangleleft> wait o snd \<triangleright>
   ((\<lambda>(S, S'). (\<not>wait s1 \<or> \<not>wait s2)) \<and> MergeSt ((more s1), x1) ((more s2), x2))))"

definition  Par::"('\<theta>::ev_eq,'\<sigma>) action \<Rightarrow>
                    ('\<sigma>  \<Rightarrow> '\<sigma> \<Rightarrow> '\<sigma>) \<Rightarrow> '\<theta> set \<Rightarrow> ('\<sigma>  \<Rightarrow> '\<sigma> \<Rightarrow> '\<sigma>) \<Rightarrow>
                    ('\<theta>,'\<sigma>) action \<Rightarrow> ('\<theta>,'\<sigma>) action" ("_ \<lbrakk> _ | _ | _ \<rbrakk> _") where
"A1 \<lbrakk> ns1 | cs | ns2 \<rbrakk> A2 \<equiv> (action_of (R ((\<lambda> (S, S').
 \<not> (\<exists> tr1 tr2. ((relation_of A1)\<^isup>f\<^isub>f ;; (\<lambda> (S, S'). tr1 = (tr S))) (S, S')
 \<and> (spec False (wait S) (relation_of A2) ;; (\<lambda> (S, _). tr2 = (tr S))) (S, S')
 \<and> ((tr_filter tr1 cs) = (tr_filter tr2 cs))) \<and>
 \<not> (\<exists> tr1 tr2. (spec False (wait S) (relation_of A1);;(\<lambda>(S, _). tr1 = tr S)) (S, S')
 \<and> ((relation_of A2)\<^isup>f\<^isub>f ;; (\<lambda>(S, S'). tr2 = (tr S))) (S, S')
 \<and> ((tr_filter tr1 cs) = (tr_filter tr2 cs)))) \<turnstile>
   (\<lambda> (S, S'). (\<exists> s1 s2. ((\<lambda> (A, A'). (relation_of A1)\<^isup>t\<^isub>f (A, s1)
 \<and> ((relation_of A2)\<^isup>t\<^isub>f (A, s2)));; M_par s1 ns1 s2 ns2 cs) (S, S'))))))"

lemma Par_is_action: "(R ((\<lambda> (S, S').
 \<not> (\<exists> tr1 tr2. ((relation_of A1)\<^isup>f\<^isub>f ;; (\<lambda> (S, S'). tr1 = (tr S))) (S, S')
 \<and> (spec False (wait S) (relation_of A2) ;; (\<lambda> (S, S'). tr2 = (tr S))) (S, S')
 \<and> ((tr_filter tr1 cs) = (tr_filter tr2 cs))) \<and>
 \<not> (\<exists> tr1 tr2. (spec False (wait S) (relation_of A1);;(\<lambda>(S, _). tr1 = tr S)) (S, S')
 \<and> ((relation_of A2)\<^isup>f\<^isub>f ;; (\<lambda> (S, S'). tr2 = (tr S))) (S, S')
 \<and> ((tr_filter tr1 cs) = (tr_filter tr2 cs)))) \<turnstile>
   (\<lambda> (S, S'). (\<exists> s1 s2. ((\<lambda> (A, A'). (relation_of A1)\<^isup>t\<^isub>f (A, s1)
 \<and> ((relation_of A2)\<^isup>t\<^isub>f (A, s2)));; M_par s1 ns1 s2 ns2 cs) (S, S'))))) \<in> {p. is_CSP_process p}"
apply (simp)
apply (rule rd_is_CSP)
apply (blast)
done

lemmas Par_is_CSP = Par_is_action[simplified]

lemma relation_of_Par:
"relation_of (A1 \<lbrakk> ns1 | cs | ns2 \<rbrakk> A2) = (R ((\<lambda> (S, S').
 \<not> (\<exists> tr1 tr2. ((relation_of A1)\<^isup>f\<^isub>f ;; (\<lambda> (S, S'). tr1 = (tr S))) (S, S')
 \<and> (spec False (wait S) (relation_of A2) ;; (\<lambda> (S, S'). tr2 = (tr S))) (S, S')
 \<and> ((tr_filter tr1 cs) = (tr_filter tr2 cs))) \<and>
 \<not> (\<exists> tr1 tr2. (spec False (wait S) (relation_of A1);;(\<lambda>(S, _). tr1 = tr S)) (S, S')
 \<and> ((relation_of A2)\<^isup>f\<^isub>f ;; (\<lambda> (S, S'). tr2 = (tr S))) (S, S')
 \<and> ((tr_filter tr1 cs) = (tr_filter tr2 cs)))) \<turnstile>
   (\<lambda> (S, S'). (\<exists> s1 s2. ((\<lambda> (A, A'). (relation_of A1)\<^isup>t\<^isub>f (A, s1)
 \<and> ((relation_of A2)\<^isup>t\<^isub>f (A, s2)));; M_par s1 ns1 s2 ns2 cs) (S, S')))))"
apply (unfold Par_def)
apply (rule action_of_inverse)
apply (rule Par_is_action)
done

lemma mono_Par: "mono (\<lambda>Q. P \<lbrakk> ns1 | cs | ns2 \<rbrakk> Q)"
  apply (auto simp: mono_def less_eq_action ref_def relation_of_Par design_defs fun_eq_iff rp_defs
              split: cond_splits)
  apply (auto simp: rp_defs dest: relation_of_spec_f_f[simplified] relation_of_spec_t_f[simplified])
  apply (erule_tac x="tr ba" in allE, auto)
  apply (erule notE)
  apply (auto dest: relation_of_spec_f_f relation_of_spec_t_f)
done

subsection {* Local parallel block *}

definition
ParLoc::"'\<sigma> \<Rightarrow> ('\<sigma> \<Rightarrow> '\<sigma> \<Rightarrow> '\<sigma>) \<Rightarrow> ('\<theta>::ev_eq, '\<sigma>) action \<Rightarrow> '\<theta> set \<Rightarrow> '\<sigma> \<Rightarrow> ('\<sigma> \<Rightarrow> '\<sigma> \<Rightarrow> '\<sigma>) \<Rightarrow> ('\<theta>,'\<sigma>) action \<Rightarrow> ('\<theta>,'\<sigma>) action"
                                        ("'(()par _ | _ \<bullet> _ ') \<lbrakk> _ \<rbrakk> '(()par _ | _ \<bullet> _ ')")
where
"(par s1 | ns1 \<bullet> P) \<lbrakk> cs \<rbrakk> (par s2 | ns2 \<bullet> Q) \<equiv> ((rd_assign s1)`;`P) \<lbrakk> ns1 | cs | ns2 \<rbrakk> ((rd_assign s2)`;` Q)"

subsection {* Assignment *}

definition ASSIGN::"('v, '\<sigma>) var_list \<Rightarrow> ('\<sigma> \<Rightarrow> 'v) \<Rightarrow> ('\<theta>::ev_eq, '\<sigma>) action" where
"ASSIGN x e \<equiv> action_of (R (true \<turnstile> (\<lambda> (S, S'). tr S' = tr S \<and> \<not>wait S' \<and>
                                 (more S' = (update x (\<lambda>_. (e (more S)))) (more S)))))"

syntax "_assign"::"id \<Rightarrow> ('\<sigma> \<Rightarrow> 'v) \<Rightarrow> ('\<theta>, '\<sigma>) action"  ("_ `:=` _")
translations "y `:=` vv" => "CONST ASSIGN (VAR y) vv"

lemma Assign_is_action:
"(R (true \<turnstile> (\<lambda> (S, S'). tr S' = tr S \<and> \<not>wait S' \<and>
                (more S' = (update x (\<lambda>_. (e (more S)))) (more S))))) \<in> {p. is_CSP_process p}"
apply (simp)
apply (rule rd_is_CSP)
apply (blast)
done

lemmas Assign_is_CSP = Assign_is_action[simplified]

lemma relation_of_Assign:
"relation_of (ASSIGN x e) = (R (true \<turnstile> (\<lambda> (S, S'). tr S' = tr S \<and> \<not>wait S' \<and>
                                   (more S' = (update x (\<lambda>_. (e (more S)))) (more S)))))"
by (simp add: ASSIGN_def action_of_inverse Assign_is_CSP)

lemma Assign_is_state_update_before: "ASSIGN x e = state_update_before (\<lambda> (s, s') . s' = (update x (\<lambda>_. (e s))) s) Skip"
apply (subst relation_of_inject[symmetric])
apply (auto simp: relation_of_Assign relation_of_state_update_before relation_of_Skip rp_defs fun_eq_iff
                  Pre_def update_def design_defs)
apply (split cond_splits, simp_all)+
apply (rule_tac b=b in comp_intro)
apply (split cond_splits, simp_all)+
apply (rule_tac b=b in comp_intro)
apply (split cond_splits, simp_all)+
defer
apply (split cond_splits, simp_all)+
prefer 3
apply (split cond_splits, simp_all)+
apply (auto simp add: prefixeq_def)
done

subsection {* Variable scope *}

definition Var::"('v, '\<sigma>) var_list \<Rightarrow>('\<theta>, '\<sigma>) action \<Rightarrow> ('\<theta>::ev_eq,'\<sigma>) action" where
"Var v A \<equiv> action_of(
     (R(true \<turnstile> (\<lambda> (A, A'). \<exists> a. tr A' = tr A \<and> \<not>wait A' \<and> more A' = (increase v a (more A)))));;
     (relation_of A;;
     (R(true \<turnstile> (\<lambda> (A, A').  tr A' = tr A \<and> \<not>wait A' \<and> more A' = (decrease v (more A)))))))"

syntax "_var"::"idt \<Rightarrow> ('\<theta>, '\<sigma>) action \<Rightarrow> ('\<theta>, '\<sigma>) action" ("var _ \<bullet> _" [1000] 999)
translations "var y \<bullet> Act" => "CONST Var (VAR_LIST y) Act"

lemma Var_is_action:
"((R(true \<turnstile> (\<lambda> (A, A'). \<exists> a. tr A' = tr A \<and> \<not>wait A' \<and> more A' = (increase v a (more A)))));;
     (relation_of A;;
     (R(true \<turnstile> (\<lambda> (A, A').  tr A' = tr A \<and> \<not>wait A' \<and> more A' = (decrease v (more A))))))) \<in> {p. is_CSP_process p}"
  apply (simp)
  apply (rule seq_CSP)
  prefer 3
  apply (rule seq_CSP)
  apply (auto simp: relation_of_CSP1 relation_of_R)
  apply (rule rd_is_CSP)
  apply (auto simp: csp_defs rp_defs design_defs fun_eq_iff prefixeq_def increase_def decrease_def
               split: cond_splits)
done

lemmas Var_is_CSP = Var_is_action[simplified]

lemma relation_of_Var:
"relation_of (Var v A) =
    ((R(true \<turnstile> (\<lambda> (A, A'). \<exists> a. tr A' = tr A \<and> \<not>wait A' \<and> more A' = (increase v a (more A)))));;
     (relation_of A;;
     (R(true \<turnstile> (\<lambda> (A, A').  tr A' = tr A \<and> \<not>wait A' \<and> more A' = (decrease v (more A)))))))"
apply (simp only: Var_def)
apply (rule action_of_inverse)
apply (rule Var_is_action)
done

lemma mono_Var : "mono (Var x)"
  by (auto simp: mono_def less_eq_action ref_def relation_of_Var)

definition Let::"('v, '\<sigma>) var_list \<Rightarrow>('\<theta>, '\<sigma>) action \<Rightarrow> ('\<theta>::ev_eq,'\<sigma>) action" where
"Let v A \<equiv> action_of((relation_of A;;
     (R(true \<turnstile> (\<lambda> (A, A').  tr A' = tr A \<and> \<not>wait A' \<and> more A' = (decrease v (more A)))))))"

syntax "_let"::"idt \<Rightarrow> ('\<theta>, '\<sigma>) action \<Rightarrow> ('\<theta>, '\<sigma>) action" ("let _ \<bullet> _" [1000] 999)
translations "let y \<bullet> Act" => "CONST Let (VAR_LIST y) Act"

lemma Let_is_action:
"(relation_of A;;
     (R(true \<turnstile> (\<lambda> (A, A').  tr A' = tr A \<and> \<not>wait A' \<and> more A' = (decrease v (more A)))))) \<in> {p. is_CSP_process p}"
  apply (simp)
  apply (rule seq_CSP)
  apply (auto simp: relation_of_CSP1 relation_of_R)
  apply (rule rd_is_CSP)
  apply (auto)
done

lemmas Let_is_CSP = Let_is_action[simplified]

lemma relation_of_Let:
"relation_of (Let v A) =
    (relation_of A;;
     (R(true \<turnstile> (\<lambda> (A, A').  tr A' = tr A \<and> \<not>wait A' \<and> more A' = (decrease v (more A))))))"
by (simp add: Let_def action_of_inverse Let_is_CSP)

lemma mono_Let : "mono (Let x)"
  by (auto simp: mono_def less_eq_action ref_def relation_of_Let)

lemma Var_is_state_update_before: "Var v A = state_update_before (\<lambda> (s, s'). \<exists> a. s' = increase v a s) (Let v A)"
apply (subst relation_of_inject[symmetric])
apply (auto simp: relation_of_Var relation_of_Let relation_of_state_update_before relation_of_Skip fun_eq_iff)
apply (auto simp: rp_defs fun_eq_iff Pre_def design_defs)
apply (split cond_splits, simp_all)+
apply (rule_tac b=ab in comp_intro)
apply (split cond_splits, simp_all)+
apply (rule_tac b=bb in comp_intro, simp_all)
apply (split cond_splits, simp_all)+
apply (rule_tac b=ab in comp_intro)
apply (split cond_splits, simp_all)+
apply (rule_tac b=bb in comp_intro, simp_all)
apply (split cond_splits, simp_all)+
apply (rule_tac b=ab in comp_intro)
apply (split cond_splits, simp_all)+ defer
apply (rule_tac b=bb in comp_intro, simp_all)
apply (split cond_splits, simp_all)+
apply (rule_tac b=ab in comp_intro)
apply (split cond_splits, simp_all)+ defer
apply (rule_tac b=bb in comp_intro, simp_all)
apply (split cond_splits, simp_all)+
apply (rule_tac b=ab in comp_intro)
apply (split cond_splits, simp_all)+
apply (rule_tac b=bb in comp_intro, simp_all)
apply (split cond_splits, simp_all)+
apply (rule_tac b=ab in comp_intro)
apply (split cond_splits, simp_all)+
apply (rule_tac b=bb in comp_intro, simp_all)
apply (split cond_splits, simp_all)+
apply (rule_tac b=ab in comp_intro)
apply (split cond_splits, simp_all)+
apply (case_tac "\<exists>A' a. A' = increase v a (alpha_rp.more aa)", simp_all add: true_def)
apply (erule_tac x="increase v a (alpha_rp.more aa)" in allE)
apply (erule_tac x="a" in allE, simp)
apply (rule_tac b=bb in comp_intro, simp_all)
apply (split cond_splits, simp_all)+
apply (rule_tac b=ab in comp_intro)
apply (split cond_splits, simp_all)+
apply (case_tac "\<exists>A' a. A' = increase v a (alpha_rp.more aa)", simp_all add: true_def)
apply (erule_tac x="increase v a (alpha_rp.more aa)" in allE)
apply (erule_tac x="a" in allE, simp)
apply (rule_tac b=bb in comp_intro, simp_all)
apply (split cond_splits, simp_all)+
done

lemma Let_is_state_update_after: "Let v A = state_update_after (\<lambda> (s, s'). s' = decrease v s) A"
apply (subst relation_of_inject[symmetric])
apply (auto simp: relation_of_Var relation_of_Let relation_of_state_update_after relation_of_Skip fun_eq_iff)
apply (auto simp: rp_defs fun_eq_iff Pre_def design_defs)
apply (auto split: cond_splits)
done

subsection {* Guarded action *}

definition Guard::"'\<sigma> predicate \<Rightarrow> ('\<theta>::ev_eq, '\<sigma>) action \<Rightarrow> ('\<theta>, '\<sigma>) action" ("_ `&` _")
where "g `&` P \<equiv> action_of(R (((g o more o fst) \<longrightarrow> \<not> ((relation_of P)\<^isup>f\<^isub>f)) \<turnstile>
                             (((g o more o fst) \<and> ((relation_of P)\<^isup>t\<^isub>f)) \<or>
                         ((\<not>(g o more o fst)) \<and> (\<lambda> (A, A'). tr A' = tr A \<and> wait A')))))"

lemma Guard_is_action:
"(R ( ((g o more o fst) \<longrightarrow> \<not> ((relation_of P)\<^isup>f\<^isub>f)) \<turnstile>
                (((g o more o fst) \<and> ((relation_of P)\<^isup>t\<^isub>f)) \<or>
                 ((\<not>(g o more o fst)) \<and> (\<lambda> (A, A'). tr A' = tr A \<and> wait A'))))) \<in> {p. is_CSP_process p}"
  by (auto simp add: spec_def intro: rd_is_CSP)

lemmas Guard_is_CSP = Guard_is_action[simplified]

lemma relation_of_Guard:
"relation_of (g `&` P) = (R (((g o more o fst) \<longrightarrow>  \<not> ((relation_of P)\<^isup>f\<^isub>f)) \<turnstile>
                             (((g o more o fst) \<and> ((relation_of P)\<^isup>t\<^isub>f)) \<or>
                          ((\<not>(g o more o fst)) \<and> (\<lambda> (A, A'). tr A' = tr A \<and> wait A')))))"
  apply (unfold Guard_def)
  apply (subst action_of_inverse)
  apply (simp_all only: Guard_is_action)
done

lemma mono_Guard : "mono (Guard g)"
  apply (auto simp: mono_def less_eq_action ref_def rp_defs design_defs relation_of_Guard
                split: cond_splits)
  apply (auto dest: relation_of_spec_f_f relation_of_spec_t_f)
done

lemma false_Guard: "false `&` P = Stop"
apply (subst relation_of_inject[symmetric])
apply (subst relation_of_Stop)
apply (subst relation_of_Guard)
apply (simp add: fun_eq_iff utp_defs csp_defs design_defs rp_defs)
done

lemma false_Guard1: "\<And> a b. g (alpha_rp.more a) = False \<Longrightarrow>
                                (relation_of (g `&` P)) (a, b) = (relation_of Stop) (a, b)"
apply (subst relation_of_Guard)
apply (subst relation_of_Stop)
apply (auto simp: fun_eq_iff csp_defs design_defs rp_defs split: cond_splits)
done

lemma true_Guard: "true `&` P = P"
apply (subst relation_of_inject[symmetric])
apply (subst relation_of_Guard)
apply (subst CSP_is_rd[OF relation_of_CSP]) back back
apply (simp add: fun_eq_iff utp_defs csp_defs design_defs rp_defs)
done

lemma true_Guard1: "\<And> a b. g (alpha_rp.more a) = True \<Longrightarrow>
                                     (relation_of (g `&` P)) (a, b) = (relation_of P) (a, b)"
apply (subst relation_of_Guard)
apply (subst CSP_is_rd[OF relation_of_CSP]) back back
apply (auto simp: fun_eq_iff csp_defs design_defs rp_defs split: cond_splits)
done

lemma Guard_is_state_update_before: "g `&` P = state_update_before (\<lambda> (s, s') . g s) P"
apply (subst relation_of_inject[symmetric])
apply (auto simp: relation_of_Guard relation_of_state_update_before relation_of_Skip rp_defs fun_eq_iff
                  Pre_def update_def design_defs)
apply (rule_tac b=a in comp_intro)
apply (split cond_splits, simp_all)+
apply (subst CSP_is_rd)
apply (simp_all add: relation_of_CSP rp_defs design_defs fun_eq_iff)
apply (split cond_splits, simp_all)+
apply (auto)
apply (subst (asm) CSP_is_rd)
apply (simp_all add: relation_of_CSP rp_defs design_defs fun_eq_iff)
apply (split cond_splits, simp_all)+
apply (subst (asm) CSP_is_rd)
apply (simp_all add: relation_of_CSP rp_defs design_defs fun_eq_iff)
apply (split cond_splits, simp_all)+
apply (subst CSP_is_rd)
apply (simp_all add: relation_of_CSP rp_defs design_defs fun_eq_iff)
apply (split cond_splits, simp_all)+
apply (subst CSP_is_rd)
apply (simp_all add: relation_of_CSP rp_defs design_defs fun_eq_iff)
apply (split cond_splits, simp_all)+
apply (auto) defer
apply (split cond_splits, simp_all)+
apply (subst (asm) CSP_is_rd)
apply (simp_all add: relation_of_CSP rp_defs design_defs fun_eq_iff)
apply (split cond_splits, simp_all)+ defer
apply (rule disjI1) defer
apply (case_tac "g (alpha_rp.more aa)", simp_all)
apply (rule)+
apply (simp add: impl_def) defer
oops

subsection {* Prefixed action *}

definition do where
"do e \<equiv> (\<lambda>(A, A'). tr A = tr A' \<and> (e (more A)) \<notin> (ref A')) \<triangleleft> wait o snd \<triangleright>
         (\<lambda>(A, A'). tr A' = (tr A @[(e (more A))]))"

definition do_I::"('\<sigma> \<Rightarrow>'\<theta>) \<Rightarrow> '\<theta> set \<Rightarrow> ('\<theta>, '\<sigma>) relation_rp"
where "do_I c S \<equiv>  ((\<lambda>(A, A'). tr A = tr A' & S \<inter> (ref A') = {})
                                \<triangleleft> wait o snd \<triangleright>
  (\<lambda>(A, A'). hd (tr A' - tr A) \<in> S & (c (more A) = (last (tr A')))))"

(*
definition do_I::"('v \<Rightarrow> '\<theta>) \<Rightarrow> ('v, '\<sigma>) var_list \<Rightarrow> 'v set \<Rightarrow> ('\<theta>, '\<sigma>) relation_rp"
where "do_I c x P \<equiv>  ((\<lambda>(A, A'). tr A = tr A' \<and> (c`P) \<inter> (ref A') = {})
                                \<triangleleft> wait o fst \<triangleright>
  (\<lambda>(A, A'). hd (tr A' - tr A) \<in> (c`P) \<and> (c (select x (more A)) = (last (tr A')))))"
*)

definition
iPrefix::"('\<sigma> \<Rightarrow>'\<theta>::ev_eq) \<Rightarrow> ('\<sigma> relation) \<Rightarrow> (('\<theta>, '\<sigma>) action \<Rightarrow> ('\<theta>, '\<sigma>) action) \<Rightarrow> ('\<sigma> \<Rightarrow> '\<theta> set) \<Rightarrow> ('\<theta>, '\<sigma>) action \<Rightarrow> ('\<theta>, '\<sigma>) action" where
"iPrefix c i j S P \<equiv> action_of(R(true \<turnstile> (\<lambda> (A, A'). (do_I c (S (more A))) (A, A') & more A' = more A)))`;` P"

definition
oPrefix::"('\<sigma> \<Rightarrow>'\<theta>) \<Rightarrow> ('\<theta>::ev_eq, '\<sigma>) action \<Rightarrow> ('\<theta>, '\<sigma>) action" where
"oPrefix c P \<equiv> action_of(R(true \<turnstile> (do c) \<and> (\<lambda> (A, A'). more A' = more A)))`;` P"

definition Prefix0::"'\<theta> \<Rightarrow> ('\<theta>::ev_eq, '\<sigma>) action \<Rightarrow> ('\<theta>, '\<sigma>) action" where
"Prefix0 c P \<equiv> action_of(R(true \<turnstile> (do (\<lambda> _. c)) \<and> (\<lambda> (A, A'). more A' = more A)))`;` P"

definition
read::"('v \<Rightarrow> '\<theta>) \<Rightarrow> ('v, '\<sigma>) var_list \<Rightarrow> ('\<theta>::ev_eq, '\<sigma>) action \<Rightarrow> ('\<theta>, '\<sigma>) action"
where  "read c x P  \<equiv> iPrefix (\<lambda> A. c (select x A)) (\<lambda> (s, s'). \<exists> a. s' = increase x a s) (Let x) (\<lambda>_. range c) P"

definition
read1::"('v \<Rightarrow> '\<theta>) \<Rightarrow> ('v, '\<sigma>) var_list \<Rightarrow> ('\<sigma> \<Rightarrow> 'v set) \<Rightarrow> ('\<theta>::ev_eq, '\<sigma>) action \<Rightarrow> ('\<theta>, '\<sigma>) action"
where  "read1 c x S P  \<equiv> iPrefix (\<lambda> A. c (select x A)) (\<lambda> (s, s'). \<exists> a. a\<in>(S s) & s' = increase x a s) (Let x) (\<lambda>s. c`(S s)) P"

definition
write1::"('v \<Rightarrow> '\<theta>) \<Rightarrow> ('\<sigma> \<Rightarrow> 'v) \<Rightarrow> ('\<theta>::ev_eq, '\<sigma>) action \<Rightarrow> ('\<theta>, '\<sigma>) action"
where "write1 c a P \<equiv> oPrefix (\<lambda> A. c (a A)) P"

definition
write0::"'\<theta> \<Rightarrow> ('\<theta>::ev_eq, '\<sigma>) action \<Rightarrow> ('\<theta>, '\<sigma>) action"
where "write0 c P \<equiv> Prefix0 c P"

syntax
"_read"  ::"[id, pttrn, ('\<theta>, '\<sigma>) action] => ('\<theta>, '\<sigma>) action" ("(_`?`_ /\<rightarrow> _)")
"_readS" ::"[id, pttrn, '\<theta> set,('\<theta>, '\<sigma>) action] => ('\<theta>, '\<sigma>) action" ("(_`?`_`:`_ /\<rightarrow> _)")
"_readSS" ::"[id, pttrn, '\<sigma> => '\<theta> set,('\<theta>, '\<sigma>) action] => ('\<theta>, '\<sigma>) action" ("(_`?`_`\<in>`_ /\<rightarrow> _)")
"_write" ::"[id, '\<sigma>, ('\<theta>, '\<sigma>) action] => ('\<theta>, '\<sigma>) action" ("(_`!`_ /\<rightarrow> _)")
"_writeS"::"['\<theta>, ('\<theta>, '\<sigma>) action] => ('\<theta>, '\<sigma>) action" ("(_ /\<rightarrow> _)")

translations
"_read c p P"    == "CONST read c (VAR_LIST p) P"
"_readS c p b P" == "CONST read1 c (VAR_LIST p) (\<lambda>_. b) P"
"_readSS c p b P" == "CONST read1 c (VAR_LIST p) b P"
"_write c p P"   == "CONST write1 c p P"
"_writeS a P"    == "CONST write0 a P"

lemma Prefix_is_action:
"(R(true \<turnstile> (do c) \<and> (\<lambda> (A, A'). more A' = more A))) \<in> {p. is_CSP_process p}"
by (auto intro: rd_is_CSP)

lemma Prefix1_is_action:
"(R(true \<turnstile> \<lambda>(A, A'). do_I c (S (alpha_rp.more A)) (A, A') \<and> alpha_rp.more A' = alpha_rp.more A)) \<in> {p. is_CSP_process p}"
by (auto intro: rd_is_CSP)

lemma Prefix0_is_action:
"(R(true \<turnstile> (do c) \<and> (\<lambda> (A, A'). more A' = more A))) \<in> {p. is_CSP_process p}"
by (auto intro: rd_is_CSP)

lemmas Prefix_is_CSP = Prefix_is_action[simplified]

lemmas Prefix1_is_CSP = Prefix1_is_action[simplified]

lemmas Prefix0_is_CSP = Prefix0_is_action[simplified]

lemma relation_of_iPrefix:
"relation_of (iPrefix c i j S P) =
((R(true \<turnstile> (\<lambda> (A, A'). (do_I c (S (more A))) (A, A') & more A' = more A)));; relation_of P)"
by (simp add: iPrefix_def relation_of_Seq action_of_inverse Prefix1_is_CSP)

lemma relation_of_oPrefix:
"relation_of (oPrefix c P) =
((R(true \<turnstile> (do c) \<and> (\<lambda> (A, A'). more A' = more A)));; relation_of P)"
by (simp add: oPrefix_def relation_of_Seq action_of_inverse Prefix_is_CSP)

lemma relation_of_Prefix0:
"relation_of (Prefix0 c P) =
((R(true \<turnstile> (do (\<lambda> _. c)) \<and> (\<lambda> (A, A'). more A' = more A)));; relation_of P)"
by (simp add: Prefix0_def relation_of_Seq action_of_inverse Prefix0_is_CSP)

lemma mono_iPrefix : "mono (iPrefix c i j s)"
by (auto simp: mono_def less_eq_action ref_def relation_of_iPrefix)

lemma mono_oPrefix : "mono (oPrefix c)"
by (auto simp: mono_def less_eq_action ref_def relation_of_oPrefix)

lemma mono_Prefix0 : "mono(Prefix0 c)"
by (auto simp: mono_def less_eq_action ref_def relation_of_Prefix0)

subsection {* Hiding *}

definition Hide::"('\<theta>::ev_eq, '\<sigma>) action \<Rightarrow> '\<theta> set \<Rightarrow> ('\<theta>, '\<sigma>) action" (infixl "\\" 18) where
"P \\ cs \<equiv> action_of(R(\<lambda>(S, S'). \<exists> s. (diff_tr S' S) = (tr_filter (s - (tr S)) cs) &
             (relation_of P)(S, S'\<lparr>tr := s, ref := (ref S') \<union> cs \<rparr>));; (relation_of Skip))"

definition
"hid P cs == (R(\<lambda>(S, S'). \<exists> s. (diff_tr S' S) = (tr_filter (s - (tr S)) cs) & (relation_of P)(S, S'\<lparr>tr := s, ref := (ref S') \<union> cs \<rparr>)) ;; (relation_of Skip))"

lemma hid_is_R: "hid P cs is R healthy"
apply (simp add: hid_def)
apply (rule seq_R)
apply (simp add: Healthy_def R_idem2)
apply (rule CSP_is_R)
apply (rule relation_of_CSP)
done

lemma hid_Skip: "hid P cs = (hid P cs ;; relation_of Skip)"
by (simp add: hid_def comp_assoc[symmetric] Skip_comp_absorb)

lemma hid_is_CSP1: "hid P cs is CSP1 healthy"
apply (auto simp: design_defs CSP1_def hid_def rp_defs fun_eq_iff)
apply (rule_tac b="a" in comp_intro)
apply (clarsimp split: cond_splits)
apply (subst CSP_is_rd, auto simp: rp_defs relation_of_CSP design_defs fun_eq_iff split: cond_splits)
apply (auto simp: diff_tr_def relation_of_Skip rp_defs design_defs true_def split: cond_splits)
apply (rule_tac x="[]" in exI, auto)
done

lemma hid_is_CSP2: "hid P cs is CSP2 healthy"
apply (simp add: hid_def)
apply (rule seq_CSP2)
apply (rule CSP_is_CSP2)
apply (rule relation_of_CSP)
done

lemma hid_is_CSP: "is_CSP_process (hid P cs)"
by (auto simp: csp_defs hid_is_CSP1 hid_is_R hid_is_CSP2)

lemma Hide_is_action:
"(R(\<lambda>(S, S'). \<exists> s. (diff_tr S' S) = (tr_filter (s - (tr S)) cs) &
   (relation_of P)(S, S'\<lparr>tr := s, ref := (ref S') \<union> cs \<rparr>));; (relation_of Skip)) \<in> {p. is_CSP_process p}"
by (simp add: hid_is_CSP[simplified hid_def])

lemmas Hide_is_CSP = Hide_is_action[simplified]

lemma relation_of_Hide:
"relation_of (P \\ cs) = (R(\<lambda>(S, S'). \<exists> s. (diff_tr S' S) = (tr_filter (s - (tr S)) cs)
        & (relation_of P)(S, S'\<lparr>tr :=s, ref := (ref S') \<union> cs \<rparr>));; (relation_of Skip))"
  by (simp add: Hide_def action_of_inverse Hide_is_CSP)

lemma mono_Hide : "mono(\<lambda> P. P \\ cs)"
by (auto simp: mono_def less_eq_action ref_def prefixeq_def utp_defs relation_of_Hide rp_defs)

subsection {* Recursion *}

text {* To represent the recursion operator "@{text \<mu>}" over actions, we use the
universal least fix-point operator "@{const lfp}" defined in the HOL library for lattices.
The operator "@{const lfp}" is inherited from the "Complete Lattice class" under some conditions.
All theorems defined over this operator can be reused. *}

text {* In the @{theory Circus_Actions} theory, we presented the proof that Circus actions
form a complete lattice. The Knaster-Tarski Theorem (in its simplest formulation) states
that any monotone function on a complete lattice has a least fixed-point.
This is a consequence of the basic boundary properties of the complete lattice operations.
Instantiating the complete lattice class allows one to inherit these properties with the
definition of the least fixed-point for monotonic functions over Circus actions.
 *}

syntax "_MU"::"[idt, idt \<Rightarrow> ('\<theta>, '\<sigma>) action] \<Rightarrow> ('\<theta>, '\<sigma>) action"  ("\<mu> _ \<bullet> _")
translations "_MU X P" == "CONST lfp (\<lambda> X. P)"

(*<*)
text{* Instead fo the following: *}
lemma is_action_REP_Mu:
  shows "is_CSP_process (relation_of (lfp P))"
oops

text{* ... we refer to the proof of @{thm Sup_is_action} and its
analogue who capture the essence of this proof at the level of the
type instantiation. *}

text{* Monotonicity: STATUS: probably critical.  Does not seem to be necessary for
parameterless Circus. *}
lemma mono_Mu:
  assumes A : "mono P"
  and     B : "\<And> X. mono (P X)"
  shows  "mono (lfp P)"
apply (subst lfp_unfold)
apply (auto simp: A B)
done

term Nat.Suc
(*>*)
end


(* This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.*)
  theory TIP_sort_NStoogeSortIsSort
  imports "../../Test_Base"
begin

datatype ('a, 'b) pair = pair2 "'a" "'b"

datatype 'a list = nil2 | cons2 "'a" "'a list"

fun x :: "'a list => 'a list => 'a list" where
  "x (nil2) z = z"
| "x (cons2 z2 xs) z = cons2 z2 (x xs z)"

(*fun did not finish the proof*)
function third :: "int => int" where
  "third y =
   (if (y = 2) then 0 else
      (if (y = 1) then 0 else
         (if (y = 0) then 0 else 1 + (third (y - 3)))))"
  by pat_completeness auto

fun take :: "int => 'a list => 'a list" where
  "take y z =
   (if y <= 0 then nil2 else
      (case z of
         nil2 => nil2
         | cons2 z2 xs => cons2 z2 (take (y - 1) xs)))"

fun sort2 :: "int => int => int list" where
  "sort2 y z =
   (if y <= z then cons2 y (cons2 z (nil2)) else
      cons2 z (cons2 y (nil2)))"

fun reverse :: "'a list => 'a list" where
  "reverse (nil2) = nil2"
| "reverse (cons2 z xs) = x (reverse xs) (cons2 z (nil2))"

fun length :: "'a list => int" where
  "length (nil2) = 0"
| "length (cons2 z l) = 1 + (length l)"

fun insert :: "int => int list => int list" where
  "insert y (nil2) = cons2 y (nil2)"
| "insert y (cons2 z2 xs) =
     (if y <= z2 then cons2 y (cons2 z2 xs) else
        cons2 z2 (insert y xs))"

fun isort :: "int list => int list" where
  "isort (nil2) = nil2"
| "isort (cons2 z xs) = insert z (isort xs)"

fun drop :: "int => 'a list => 'a list" where
  "drop y z =
   (if y <= 0 then z else
      (case z of
         nil2 => nil2
         | cons2 z2 xs1 => drop (y - 1) xs1))"

fun splitAt :: "int => 'a list =>
                (('a list), ('a list)) pair" where
  "splitAt y z = pair2 (take y z) (drop y z)"

function nstooge1sort2 :: "int list => int list"
  and nstoogesort :: "int list => int list"
  and nstooge1sort1 :: "int list => int list" where
  "nstooge1sort2 y =
   (case splitAt (third (length y)) (reverse y) of
      pair2 ys2 zs2 => x (nstoogesort zs2) (reverse ys2))"
| "nstoogesort (nil2) = nil2"
| "nstoogesort (cons2 z (nil2)) = cons2 z (nil2)"
| "nstoogesort (cons2 z (cons2 y2 (nil2))) = sort2 z y2"
| "nstoogesort (cons2 z (cons2 y2 (cons2 x3 x4))) =
     nstooge1sort2
       (nstooge1sort1 (nstooge1sort2 (cons2 z (cons2 y2 (cons2 x3 x4)))))"
| "nstooge1sort1 y =
     (case splitAt (third (length y)) y of
        pair2 ys2 zs1 => x ys2 (nstoogesort zs1))"
  by pat_completeness auto

theorem property0 :
  "((nstoogesort xs) = (isort xs))"
  oops

end


theory wp0 imports regular_interpretation pl0
begin

section \<open>weakest precondition\<close>

fun wp where
  \<open>wp q (Assert r) = r \<^bold>\<and> q\<close> |
  \<open>wp q (Assume r) = r \<^bold>\<longrightarrow> q\<close> |
  \<open>wp q (Var x) = Uni x q\<close> |
  \<open>wp q (Assign x a) = psubst x a q\<close> |
  \<open>wp q (Choice s1 s2) = wp q s1 \<^bold>\<and> wp q s2\<close> |
  \<open>wp q (Seq s1 s2) = wp (wp q s2) s1\<close> |
  \<open>wp q (Ghost s) = wp q s\<close>

abbreviation \<open>verified p s q \<equiv> \<forall> i. psem i (p \<^bold>\<longrightarrow> wp q s)\<close>

section \<open>example verifications\<close>

lemma \<open>
  verified
    (V x \<^bold>> N 0)
    (Assign x (V x \<^bold>+ N 1))
    (V x \<^bold>> N 1)\<close>
  by fastforce

lemma \<open>
  verified
    (\<^bold>\<top>)
    (Choice (Assign x (N 1)) (Assign x (N 2)))
    (N 0 \<^bold>< V x \<^bold>\<and> V x \<^bold>< N 3)\<close>
  by fastforce

lemma \<open>
  verified
    (N 0 \<^bold>< V x)
    (Seq (Assign x (V x \<^bold>+ N 1)) (Assign x (V x \<^bold>+ N 1)))
    (N 2 \<^bold>< V x)\<close>
  by fastforce

lemma \<open>
  verified
    \<^bold>\<top>
    (Seq (Seq
      (Ghost (Assign y (V x \<^bold>* V x)))
      (Ghost (Assume (V y \<^bold>< N 0))))
      (Assert \<^bold>\<bottom>))
    \<^bold>\<top>\<close>
  by fastforce

term \<open>Seq (Ghost (Assume (V x \<^bold>> N 0))) (Assert (V x \<^bold>> N 0))\<close>

section \<open>ghost code\<close>

primrec erase_ghost where
  \<open>erase_ghost (Assert b) = Assert b\<close> |
  \<open>erase_ghost (Assume b) = Assume b\<close> |
  \<open>erase_ghost (Var x) = Var x\<close> |
  \<open>erase_ghost (Assign x a) = Assign x a\<close> |
  \<open>erase_ghost (Choice s1 s2) = Choice (erase_ghost s1) (erase_ghost s2)\<close> |
  \<open>erase_ghost (Seq s1 s2) = Seq (erase_ghost s1) (erase_ghost s2)\<close> |
  \<open>erase_ghost (Ghost s) = Assert \<^bold>\<top>\<close>

definition \<open>well_formed p s q \<equiv>
  (\<forall> i. psem i p \<longrightarrow> psem i (wp q s)) \<longrightarrow> (\<forall> i. psem i p \<longrightarrow> psem i (wp q (erase_ghost s)))\<close>

(*the following lemma shows that if one can deduce well-formedness then one can show the validity of any formula*)
proposition validity_by_well_formedness:
  \<open>well_formed \<^bold>\<top> (Seq (Ghost (Assume \<^bold>\<bottom>)) (Assert p)) \<^bold>\<top> \<Longrightarrow> \<forall> i. psem i p\<close>
  unfolding well_formed_def by simp

(*checks that regular code only uses regular variables*)
primrec rc_pure where
  \<open>rc_pure g (Assert b) = regular_p g b\<close> |
  \<open>rc_pure g (Assume b) = regular_p g b\<close> |
  \<open>rc_pure g (Var x) = (\<not>g x)\<close> |
  \<open>rc_pure g (Assign x a) = ((\<not>g x) \<and> regular_a g a)\<close> |
  \<open>rc_pure g (Choice s1 s2) = (rc_pure g s1 \<and> rc_pure g s2)\<close> |
  \<open>rc_pure g (Seq s1 s2) = (rc_pure g s1 \<and> rc_pure g s2)\<close> |
  \<open>rc_pure g (Ghost s) = True\<close>

(*first type checkers for ghost-code annotations*)
(*ghost assumptions are here completely disallowed*)
primrec gc_check where
  \<open>gc_check g (Assert b) = True\<close> |
  \<open>gc_check g (Assume b) = False\<close> |
  \<open>gc_check g (Var x) = True\<close> |
  \<open>gc_check g (Assign x a) = g x\<close> |
  \<open>gc_check g (Choice s1 s2) = (gc_check g s1 \<or> gc_check g s2)\<close> |
  \<open>gc_check g (Seq s1 s2) = (gc_check g s1 \<and> gc_check g s2)\<close> |
  \<open>gc_check g (Ghost s) = gc_check g s\<close>

primrec rc_check where
  \<open>rc_check g (Assert b) = regular_p g b\<close> |
  \<open>rc_check g (Assume b) = regular_p g b\<close> |
  \<open>rc_check g (Var x) = (\<not>g x)\<close> |
  \<open>rc_check g (Assign x a) = ((\<not>g x) \<and> regular_a g a)\<close> |
  \<open>rc_check g (Choice s1 s2) = (rc_check g s1 \<and> rc_check g s2)\<close> |
  \<open>rc_check g (Seq s1 s2) = (rc_check g s1 \<and> rc_check g s2)\<close> |
  \<open>rc_check g (Ghost s) = gc_check g s\<close>

lemma rc_pure_implies_regular_wp: \<open>rc_pure g s \<Longrightarrow> regular_p g q \<Longrightarrow> regular_p g (wp q (erase_ghost s))\<close>
proof (induct s arbitrary: q)
  case (Assume x)
  then show ?case
    using Imp_def by auto
next
  case (Assign x1a x2a)
  then show ?case
    by (metis erase_ghost.simps(4) rc_pure.simps(4) regular_psubst wp.simps(4))
next
  case (Seq s1 s2)
  then have \<open>regular_p g (wp q (erase_ghost s2))\<close>
    using rc_pure.simps(6) by metis
  then have \<open>regular_p g (wp (wp q (erase_ghost s2)) (erase_ghost s1))\<close>
    using Seq rc_pure.simps(6) by metis
  then show ?case
    by simp
next
  case (Choice s1 s2)
  then show ?case
    by (metis Un_iff pexp_fv.simps(2) erase_ghost.simps(5) rc_pure.simps(5) wp.simps(5))
next
  case (Ghost s)
  then show ?case
    by (simp add: Eql_def Tru_def)
qed auto

lemma post_condition_imp:
  \<open>\<forall> i. psem i p \<longrightarrow> psem i q \<Longrightarrow> \<forall> i. psem i (wp p s) \<longrightarrow> psem i (wp q s)\<close>
proof (induct s arbitrary: p q)
  case (Assign x1a x2a)
  then show ?case
    using psubst_iff_psem by auto
next
  case (Seq s1 s2)
  then show ?case
    using wp.simps(6) by (smt (verit, best))
qed auto

lemma regular_erase: \<open>rc_check g s \<Longrightarrow> regular_p g q \<Longrightarrow> regular_p g (wp q (erase_ghost s))\<close>
proof (induct s arbitrary: q)
  case (Assume x)
  then show ?case
    using Imp_def by auto
next
  case (Assign x1a x2a)
  then show ?case
    by (metis erase_ghost.simps(4) rc_check.simps(4) regular_psubst wp.simps(4))
next
  case (Seq s1 s2)
  then show ?case
    by (metis erase_ghost.simps(6) rc_check.simps(6) wp.simps(6))
next
  case (Choice s1 s2)
  then have \<open>regular_p g (wp q (erase_ghost s1))\<close> \<open>regular_p g (wp q (erase_ghost s1))\<close>
    using rc_check.simps(5) by blast+
  then have \<open>regular_p g (wp q (erase_ghost s1) \<^bold>\<and> wp q (erase_ghost s2))\<close>
    by (metis Choice.hyps(2) Choice.prems(1) Choice.prems(2) UnE pexp_fv.simps(2) rc_check.simps(5))
  then show ?case
    by simp
next
  case (Ghost s)
  then show ?case
    by (simp add: Eql_def Tru_def wfE_min')
qed auto

lemma ghost_code_regular_post_condition:
  \<open>gc_check g s \<Longrightarrow> regular_p g q \<Longrightarrow> psem i (wp q s) \<Longrightarrow> psem i q\<close>
proof (induct s arbitrary: q i)
  case (Var x)
  then have \<open>\<forall> v. i(x := v) \<^bold>\<Turnstile> q\<close>
    by simp
  then show ?case
    by (metis fun_upd_triv)
next
  case (Assign x1a x2a)
  then show ?case
    using agreeing_i_pexp psubst_iff_psem by auto
next
  case (Seq s1 s2)
  then show ?case
    by (smt (verit, best) gc_check.simps(6) post_condition_imp wp.simps(6))
qed auto

lemma rc_check_lemma:
  \<open>rc_check g s \<Longrightarrow> regular_p g q \<Longrightarrow> \<forall> i. psem i (wp q s) \<longrightarrow> psem i (wp q (erase_ghost s))\<close>
proof (induct s arbitrary: q)
  case (Seq s1 s2)
  then have \<open>\<forall> i. psem i (wp q s2) \<longrightarrow> psem i (wp q (erase_ghost s2))\<close>
    by simp
  then have \<open>\<forall> i. psem i (wp (wp q s2) s1) \<longrightarrow> psem i(wp (wp q (erase_ghost s2)) s1)\<close>
    using post_condition_imp by simp
  moreover have \<open>\<forall> i. psem i (wp (wp q (erase_ghost s2)) s1) \<longrightarrow> psem i (wp (wp q (erase_ghost s2)) (erase_ghost s1))\<close>
    using Seq regular_erase by force
  ultimately show ?case
    by simp
next
  case (Ghost s)
  then show ?case
    using ghost_code_regular_post_condition by simp
qed auto

theorem rc_check_implies_well_formed:
  \<open>rc_check g s \<Longrightarrow> regular_p g p \<Longrightarrow> regular_p g q \<Longrightarrow> well_formed p s q\<close>
  using rc_check_lemma unfolding well_formed_def by simp

section \<open>non-interference and strengthening\<close>

fun gwp where
  \<open>gwp q (Assert r) = q\<close> | (*wp excluding ghost assertions*)
  \<open>gwp q (Assume r) = r \<^bold>\<longrightarrow> q\<close> |
  \<open>gwp q (Var x) = \<^bold>\<forall> x. q\<close> |
  \<open>gwp q (Assign x a) = psubst x a q\<close> |
  \<open>gwp q (Choice s1 s2) = gwp q s1 \<^bold>\<and> gwp q s2\<close> |
  \<open>gwp q (Seq s1 s2) = gwp (gwp q s2) s1\<close> |
  \<open>gwp q (Ghost s) = gwp q s\<close>

lemma wp_implies_gwp: \<open>i \<^bold>\<Turnstile> wp q s \<Longrightarrow> i \<^bold>\<Turnstile> gwp q s\<close>
proof (induct s arbitrary: q i)
  case (Seq s1 s2)
  then show ?case
    by (smt (verit) gwp.simps(6) post_condition_imp wp.simps(6))
qed auto

lemma post_conditions_imp_gwp: \<open>\<forall> i. i \<^bold>\<Turnstile> p \<longrightarrow> i \<^bold>\<Turnstile> q \<Longrightarrow> \<forall> i. i \<^bold>\<Turnstile> gwp p s \<longrightarrow> i \<^bold>\<Turnstile> gwp q s\<close>
proof (induct s arbitrary: p q)
  case (Assign x1a x2a)
  then show ?case
    using psubst_iff_psem by auto
next
  case (Seq s1 s2)
  then show ?case
    by (smt (verit) gwp.simps(6))
qed auto

lemma gwp_fv: \<open>pexp_fv p \<subseteq> pexp_fv q \<Longrightarrow> pexp_fv (gwp p s) \<subseteq> pexp_fv (wp q s)\<close>
proof (induct s arbitrary: p q)
  case (Assign x1a x2a)
  then show ?case
    using subset_psubst_fv by simp
next
  case (Choice s1 s2)
  then show ?case
    by (metis Un_mono pexp_fv.simps(2) gwp.simps(5) wp.simps(5))
qed auto

fun rwp where
  \<open>rwp q (Assert r) = r \<^bold>\<and> q\<close> |
  \<open>rwp q (Assume r) = r \<^bold>\<longrightarrow> q\<close> |
  \<open>rwp q (Var x) = \<^bold>\<forall> x. q\<close> |
  \<open>rwp q (Assign x a) = psubst x a q\<close> |
  \<open>rwp q (Choice s1 s2) = rwp q s1 \<^bold>\<and> rwp q s2\<close> |
  \<open>rwp q (Seq s1 s2) = rwp (rwp q s2) s1\<close> |
  \<open>rwp q (Ghost s) = gwp q s\<close>

lemma wp_implies_rwp: \<open>i \<^bold>\<Turnstile> wp q s \<Longrightarrow> i \<^bold>\<Turnstile> rwp q s\<close>
proof (induct s arbitrary: q i)
  case (Seq s1 s2)
  then show ?case
    by (smt (verit) rwp.simps(6) post_condition_imp wp.simps(6))
next
  case (Ghost s)
  then show ?case
    using wp_implies_gwp by auto
qed auto

lemma post_conditions_imp_rwp: \<open>\<forall> i. i \<^bold>\<Turnstile> p \<longrightarrow> i \<^bold>\<Turnstile> q \<Longrightarrow> \<forall> i. i \<^bold>\<Turnstile> rwp p s \<longrightarrow> i \<^bold>\<Turnstile> rwp q s\<close>
proof (induct s arbitrary: p q)
  case (Assign x1a x2a)
  then show ?case
    using psubst_iff_psem by auto
next
  case (Seq s1 s2)
  then show ?case
    by (smt (verit) rwp.simps(6))
next
  case (Ghost s)
  then show ?case
    using post_conditions_imp_gwp by simp
qed auto

lemma rwp_implies_erased_wp: \<open>i \<^bold>\<Turnstile> rwp q (erase_ghost s) \<Longrightarrow> i \<^bold>\<Turnstile> wp q (erase_ghost s)\<close>
proof (induct s arbitrary: q i)
  case (Seq s1 s2)
  then show ?case
    by (smt (verit, ccfv_threshold) erase_ghost.simps(6) post_condition_imp rwp.simps(6) wp.simps(6))
qed auto

lemma rwp_fv: \<open>pexp_fv p \<subseteq> pexp_fv q \<Longrightarrow> pexp_fv (rwp p s) \<subseteq> pexp_fv (wp q s)\<close>
proof (induct s arbitrary: p q)
  case (Assign x1a x2a)
  then show ?case
    using subset_psubst_fv by simp
next
  case (Choice s1 s2)
  then show ?case
    by (metis Un_mono pexp_fv.simps(2) rwp.simps(5) wp.simps(5))
next
  case (Ghost s)
  then show ?case
    using gwp_fv by simp
qed auto

primrec gc_check' where
  \<open>gc_check' g q (Assert b) = \<^bold>\<top>\<close> |
  \<open>gc_check' g q (Assume b) = g_uni_form g (b \<^bold>\<longrightarrow> q) \<^bold>\<longrightarrow> q\<close> |
  \<open>gc_check' g q (Var x) = \<^bold>\<top>\<close> |
  \<open>gc_check' g q (Assign x a) = g_uni_form g (psubst x a q) \<^bold>\<longrightarrow> q\<close> |
  \<open>gc_check' g q (Choice s1 s2) = gc_check' g q s1 \<^bold>\<or> gc_check' g q s2\<close> |
  \<open>gc_check' g q (Seq s1 s2) = g_uni_form g (gc_check' g (gwp q s2) s1) \<^bold>\<and> gc_check' g q s2\<close> |
  \<open>gc_check' g q (Ghost s) = gc_check' g q s\<close>

(*this allows ghost assignments to regular variables in very specific circumstances*)

(*I would argue that the following actually corresponds to human intuitive reasoning about ghost code*)
(*test*)
lemma \<open>\<forall> y. y > (0 :: int) \<longrightarrow> x > 0 \<Longrightarrow> x > 0\<close>
(*proof is basically that there is a way to make the new assumption true without affecting the other stuff*)
  by (simp add: gt_ex)
lemma \<open>x \<noteq> y \<Longrightarrow>
  {i \<^bold>\<down> (\<lambda> v. v = y) | i. i \<^bold>\<Turnstile> \<^bold>\<not>(V y \<^bold>> N 0 \<^bold>\<longrightarrow> V x \<^bold>> N 0)} \<supseteq> {i \<^bold>\<down> (\<lambda> v. v = y) | i. i \<^bold>\<Turnstile> \<^bold>\<not>(V x \<^bold>> N 0)}\<close>
proof (clarify)
  fix i
  assume \<open>x \<noteq> y\<close>
  assume \<open>i \<^bold>\<Turnstile> \<^bold>\<not>V x \<^bold>> N 0\<close>
  then have \<open>i(y := 1) \<^bold>\<Turnstile> \<^bold>\<not>V x \<^bold>> N 0\<close>
    using \<open>x \<noteq> y\<close> by simp
  moreover have \<open>i(y := 1) \<^bold>\<Turnstile> V y \<^bold>> N 0\<close>
    by simp
  moreover have \<open>i \<^bold>\<down> (\<lambda>v. v = y) = i(y := 1) \<^bold>\<down> (\<lambda>v. v = y)\<close>
    unfolding regular_interpretation_def using \<open>x \<noteq> y\<close> by auto
  ultimately show \<open>\<exists> i'. i \<^bold>\<down> (\<lambda>v. v = y) = i' \<^bold>\<down> (\<lambda>v. v = y) \<and> i' \<^bold>\<Turnstile> \<^bold>\<not>(V y \<^bold>> N 0 \<^bold>\<longrightarrow> V x \<^bold>> N 0)\<close>
    by fastforce
qed

lemma gc_check'_lemma:
  \<open>i \<^bold>\<Turnstile> gc_check' g q s \<Longrightarrow> i \<^bold>\<Turnstile> \<^bold>\<not>q \<Longrightarrow> \<exists> i'.  i \<^bold>\<down> g = i' \<^bold>\<down> g \<and> i' \<^bold>\<Turnstile> \<^bold>\<not>(gwp q s)\<close>
proof (induct s arbitrary: q i)
  case (Var x)
  moreover have \<open>i \<^bold>\<Turnstile> \<^bold>\<not>q \<Longrightarrow> \<not>(\<forall> v. (i(x := v)) \<^bold>\<Turnstile> q)\<close> for i
    by (metis psem.simps(1) fun_upd_triv)
  ultimately show ?case
    by auto
next
  case (Assume b)
  then have \<open>\<not>i \<^bold>\<Turnstile> g_uni_form g (b \<^bold>\<longrightarrow> q)\<close>
    by auto
  then have \<open>i \<^bold>\<Turnstile> g_exi_form g (\<^bold>\<not>(b \<^bold>\<longrightarrow> q))\<close>
    using uni_exi_translate by fastforce
  then show ?case
    by (metis (mono_tags) psem_exi_form_E gwp.simps(2) vs_exists)
next
  case (Assign x a)
  then have \<open>\<not>i \<^bold>\<Turnstile> g_uni_form g (psubst x a q)\<close>
    by auto
  then have \<open>i \<^bold>\<Turnstile> g_exi_form g (\<^bold>\<not>(psubst x a q))\<close>
    using uni_exi_translate by fastforce
  then show ?case
    by (metis (mono_tags) psem_exi_form_E gwp.simps(4) vs_exists)
next
  case (Choice s1 s2)
  consider \<open>i \<^bold>\<Turnstile> gc_check' g q s1\<close> | \<open>i \<^bold>\<Turnstile> gc_check' g q s2\<close>
    using Choice by force
  then show ?case
  proof cases
    case 1
    then obtain i' where \<open>i \<^bold>\<down> g = i' \<^bold>\<down> g \<and> i' \<^bold>\<Turnstile> \<^bold>\<not>gwp q s1\<close>
      using Choice by blast
    then show ?thesis
      by auto
  next
    case 2
    then obtain i' where \<open>i \<^bold>\<down> g = i' \<^bold>\<down> g \<and> i' \<^bold>\<Turnstile> \<^bold>\<not>gwp q s2\<close>
      using Choice by blast
    then show ?thesis
      by auto
  qed
next
  case (Seq s1 s2)
  then obtain i' where \<open>i \<^bold>\<down> g = i' \<^bold>\<down> g\<close> \<open>i' \<^bold>\<Turnstile> \<^bold>\<not>gwp q s2\<close>
    by fastforce
  have \<open>regular_p g (g_uni_form g (gc_check' g (gwp q s2) s1))\<close>
    using uni_form_regular vs_exists by presburger
  moreover have \<open>i \<^bold>\<Turnstile> g_uni_form g (gc_check' g (gwp q s2) s1)\<close>
    using Seq by simp
  ultimately have \<open>i' \<^bold>\<Turnstile> g_uni_form g (gc_check' g (gwp q s2) s1)\<close>
    using \<open>i \<^bold>\<down> g = i' \<^bold>\<down> g\<close> regular_agree_pexp by blast
  then have \<open>i' \<^bold>\<Turnstile> gc_check' g (gwp q s2) s1\<close>
    using psem_uni_form_E by blast
  then obtain i'' where \<open>i' \<^bold>\<down> g = i'' \<^bold>\<down> g \<and> i'' \<^bold>\<Turnstile> \<^bold>\<not>(gwp (gwp q s2) s1)\<close>
    using Seq \<open>i' \<^bold>\<Turnstile> \<^bold>\<not>gwp q s2\<close> by blast
  then show ?case
    using \<open>i \<^bold>\<down> g = i' \<^bold>\<down> g\<close> by auto
qed auto

corollary gc_check'_corollary:
  \<open>\<forall> i. i \<^bold>\<Turnstile> gc_check' g q s \<Longrightarrow> {i \<^bold>\<down> g | i. i \<^bold>\<Turnstile> \<^bold>\<not>(gwp q s)} \<supseteq> {i \<^bold>\<down> g | i. i \<^bold>\<Turnstile> \<^bold>\<not>q}\<close>
  using gc_check'_lemma by auto

primrec rc_check' where
  \<open>rc_check' g q (Assert b) = regular_p g b\<close> |
  \<open>rc_check' g q (Assume b) = regular_p g b\<close> |
  \<open>rc_check' g q (Var x) = (\<not>g x)\<close> |
  \<open>rc_check' g q (Assign x a) = ((\<not>g x) \<and> regular_a g a)\<close> |
  \<open>rc_check' g q (Choice s1 s2) = (rc_check' g q s1 \<and> rc_check' g q s2)\<close> |
  \<open>rc_check' g q (Seq s1 s2) = (rc_check' g (rwp q s2) s1 \<and> rc_check' g q s2)\<close> |
  \<open>rc_check' g q (Ghost s) = ({i \<^bold>\<down> g | i. i \<^bold>\<Turnstile> \<^bold>\<not>(gwp q s)} \<supseteq> {i \<^bold>\<down> g | i. i \<^bold>\<Turnstile> \<^bold>\<not>q})\<close> (*can be checked by gc_check' f.ex. *)

lemma rc_check'_implies_rc_pure: \<open>rc_check' g q s \<Longrightarrow> rc_pure g s\<close>
  by (induct s arbitrary: q) auto

lemma pure_check: \<open>rc_pure g s \<Longrightarrow> rc_check' g q (erase_ghost s)\<close>
proof (induct s arbitrary: q)
  case (Ghost s)
  then show ?case
    by (simp add: Eql_def Tru_def)
qed auto

lemma rc_check'_lemma:
  assumes \<open>rc_check' g p s\<close> \<open>{i \<^bold>\<down> g | i. i \<^bold>\<Turnstile> \<^bold>\<not>p} \<supseteq> {i \<^bold>\<down> g | i. i \<^bold>\<Turnstile> \<^bold>\<not>q}\<close> \<open>regular_p g q\<close>
  shows \<open>{i \<^bold>\<down> g | i. i \<^bold>\<Turnstile> \<^bold>\<not>rwp p s} \<supseteq> {i \<^bold>\<down> g | i. i \<^bold>\<Turnstile> \<^bold>\<not>rwp q (erase_ghost s)}\<close>
  using assms
proof (induct s arbitrary: p q)
  case (Assert b)
  then have \<open>{i \<^bold>\<down> g |i. i \<^bold>\<Turnstile> \<^bold>\<not>b \<or> i \<^bold>\<Turnstile> \<^bold>\<not>q} \<subseteq> {i \<^bold>\<down> g |i. i \<^bold>\<Turnstile> \<^bold>\<not>b \<or> i \<^bold>\<Turnstile> \<^bold>\<not>p}\<close>
    by blast
  then show ?case
    by simp
next
  case (Assume b)
  have \<open>{i \<^bold>\<down> g |i. i \<^bold>\<Turnstile> b \<and> i \<^bold>\<Turnstile> \<^bold>\<not>q} \<subseteq> {i \<^bold>\<down> g |i. i \<^bold>\<Turnstile> b \<and> i \<^bold>\<Turnstile> \<^bold>\<not>p}\<close>
  proof (clarify)
    fix i
    assume \<open>i \<^bold>\<Turnstile> b\<close>
    assume \<open>i \<^bold>\<Turnstile> \<^bold>\<not>q\<close>
    then obtain i' where \<open>i \<^bold>\<down> g = i' \<^bold>\<down> g \<and> i' \<^bold>\<Turnstile> \<^bold>\<not>p\<close>
      using Assume by auto
    moreover assume \<open>i \<^bold>\<Turnstile> b\<close>
    moreover have \<open>i' \<^bold>\<Turnstile> b\<close>
      using calculation Assume(1) by (metis rc_check'.simps(2) regular_agree_pexp)
    ultimately show \<open>\<exists> i'. i \<^bold>\<down> g = i' \<^bold>\<down> g \<and> i' \<^bold>\<Turnstile> b \<and> i' \<^bold>\<Turnstile> \<^bold>\<not>p\<close>
      by auto
  qed
  then show ?case
    by simp
next
  case (Var x)
  have \<open>{i \<^bold>\<down> g |i. \<exists> v. i(x := v) \<^bold>\<Turnstile> \<^bold>\<not>q} \<subseteq> {i \<^bold>\<down> g |i. \<exists> v. i(x := v) \<^bold>\<Turnstile> \<^bold>\<not>p}\<close>
  proof (clarify)
    fix i v
    assume \<open>i(x := v) \<^bold>\<Turnstile> \<^bold>\<not>q\<close>
    with Var obtain i' where *: \<open>i(x := v) \<^bold>\<down> g = i' \<^bold>\<down> g \<and> i' \<^bold>\<Turnstile> \<^bold>\<not>p\<close>
      by auto
    then have **:\<open>i \<^bold>\<down> g = i'(x := i x) \<^bold>\<down> g\<close>
      unfolding regular_interpretation_def by force
    have \<open>i' x = v\<close>
      using * Var(1) unfolding regular_interpretation_def by force
    then have\<open>(i'(x := i x))(x := v) \<^bold>\<Turnstile> \<^bold>\<not>p\<close>
      using * by auto
    with ** show \<open>\<exists> i'. i \<^bold>\<down> g = i' \<^bold>\<down> g \<and> (\<exists>v. i'(x := v) \<^bold>\<Turnstile> \<^bold>\<not>p)\<close>
      by blast
  qed
  then show ?case
    by simp
next
  case (Assign x a)
  have \<open>{i \<^bold>\<down> g |i. i(x := i\<lparr>a\<rparr>) \<^bold>\<Turnstile> \<^bold>\<not>q} \<subseteq> {i \<^bold>\<down> g |i. i(x := i\<lparr>a\<rparr>) \<^bold>\<Turnstile> \<^bold>\<not>p}\<close>
  proof (clarify)
    fix i
    assume \<open>i(x := i\<lparr> a \<rparr>) \<^bold>\<Turnstile> \<^bold>\<not>q\<close>
    with Assign obtain i' where *: \<open>i(x := i\<lparr> a \<rparr>) \<^bold>\<down> g = i' \<^bold>\<down> g \<and> i' \<^bold>\<Turnstile> \<^bold>\<not>p\<close>
      by auto
    then have **: \<open>i \<^bold>\<down> g = i'(x := i x) \<^bold>\<down> g\<close>
      unfolding regular_interpretation_def by force
    then have 1: \<open>i\<lparr>a\<rparr> = (i'(x := i x))\<lparr>a\<rparr>\<close>
      using Assign(1) regular_agree_aexp by simp
    with * Assign(1) have \<open>i' x = i\<lparr>a\<rparr>\<close>
      unfolding regular_interpretation_def by force
    then have \<open>(i'(x := i x))(x := i'(x := i x)\<lparr> a \<rparr>) \<^bold>\<Turnstile> \<^bold>\<not>p\<close>
      using * 1 by (metis fun_upd_triv fun_upd_upd)
    then show \<open>\<exists>i'. i \<^bold>\<down> g = i' \<^bold>\<down> g \<and> i'(x := i'\<lparr> a \<rparr>) \<^bold>\<Turnstile> \<^bold>\<not>p\<close>
      using ** by blast
  qed
  then show ?case
    using psubst_iff_psem by auto
next
  case (Seq s1 s2)
  then have *: \<open>{i \<^bold>\<down> g | i. i \<^bold>\<Turnstile> \<^bold>\<not>rwp p s2} \<supseteq> {i \<^bold>\<down> g | i. i \<^bold>\<Turnstile> \<^bold>\<not>rwp q (erase_ghost s2)}\<close>
    by auto
  have \<open>regular_p g (wp q (erase_ghost s2))\<close>
    using Seq.prems(1) Seq.prems(3) rc_check'_implies_rc_pure rc_pure.simps(6) rc_pure_implies_regular_wp by blast
  then have \<open>regular_p g (rwp q (erase_ghost s2))\<close>
    using rwp_fv by blast
  moreover have \<open>rc_check' g (rwp p s2) s1\<close>
    using Seq by auto
  ultimately have \<open>{i \<^bold>\<down> g | i. i \<^bold>\<Turnstile> \<^bold>\<not>rwp (rwp p s2) s1} \<supseteq> {i \<^bold>\<down> g | i. i \<^bold>\<Turnstile> \<^bold>\<not>rwp (rwp q (erase_ghost s2)) (erase_ghost s1)}\<close>
    using Seq(1) * by simp
  then show ?case
    using Seq.prems(1) by auto
next
  case (Choice s1 s2)
  have
    \<open>{i \<^bold>\<down> g |i. i \<^bold>\<Turnstile> \<^bold>\<not>rwp q (erase_ghost (s1 \<^bold>[\<^bold>] s2))} \<subseteq>
      {i \<^bold>\<down> g |i. i \<^bold>\<Turnstile> \<^bold>\<not>rwp q (erase_ghost s1)} \<union> {i \<^bold>\<down> g |i.  i \<^bold>\<Turnstile> \<^bold>\<not>rwp q (erase_ghost s2)}\<close> by auto
  moreover have
    \<open>{i \<^bold>\<down> g |i. i \<^bold>\<Turnstile> \<^bold>\<not>rwp q (erase_ghost s1)} \<subseteq> {i \<^bold>\<down> g |i. i \<^bold>\<Turnstile> \<^bold>\<not>rwp p s1}\<close>
    \<open>{i \<^bold>\<down> g |i. i \<^bold>\<Turnstile> \<^bold>\<not>rwp q (erase_ghost s2)} \<subseteq> {i \<^bold>\<down> g |i. i \<^bold>\<Turnstile> \<^bold>\<not>rwp p s2}\<close> using Choice by auto
  moreover have
    \<open>{i \<^bold>\<down> g |i. i \<^bold>\<Turnstile> \<^bold>\<not>rwp p s1} \<union> {i \<^bold>\<down> g |i.  i \<^bold>\<Turnstile> \<^bold>\<not>rwp p s2} \<subseteq>
      {i \<^bold>\<down> g |i. i \<^bold>\<Turnstile> \<^bold>\<not>rwp p (s1 \<^bold>[\<^bold>] s2)}\<close> by auto
  ultimately show ?case
    by (meson Un_subset_iff subset_trans)
next
  case (Ghost s)
  then show ?case
    by auto
qed

corollary rc_check'_implies_well_formed:
  assumes \<open>rc_check' g q s\<close> \<open>regular_p g p\<close> \<open>regular_p g q\<close>
  shows \<open>well_formed p s q\<close>
proof (unfold well_formed_def, rule)
  assume \<open>\<forall>i. i \<^bold>\<Turnstile> p \<longrightarrow> i \<^bold>\<Turnstile> wp q s\<close>
  then have *:\<open>\<forall>i. i \<^bold>\<Turnstile> p \<longrightarrow> i \<^bold>\<Turnstile> rwp q s\<close>
    using wp_implies_rwp by auto
  have \<open>\<forall>i. i \<^bold>\<Turnstile> p \<longrightarrow> i \<^bold>\<Turnstile> rwp q (erase_ghost s)\<close>
  proof (rule, rule, rule ccontr)
    fix i
    have \<open>{i \<^bold>\<down> g | i. i \<^bold>\<Turnstile> \<^bold>\<not>rwp q s} \<supseteq> {i \<^bold>\<down> g | i. i \<^bold>\<Turnstile> \<^bold>\<not>rwp q (erase_ghost s)}\<close>
      using rc_check'_lemma assms(1,3) by simp
    moreover assume \<open>\<not> i \<^bold>\<Turnstile> rwp q (erase_ghost s)\<close>
    ultimately obtain i' where i'_def: \<open>\<not> i' \<^bold>\<Turnstile> rwp q s\<close> \<open>i \<^bold>\<down> g = i' \<^bold>\<down> g\<close>
      by auto
    moreover assume \<open>i \<^bold>\<Turnstile> p\<close>
    ultimately have \<open>i' \<^bold>\<Turnstile> p\<close>
      using assms(2) regular_agree_pexp by blast
    then show False
      using i'_def(1) * by simp
  qed
  then show \<open>\<forall>i. i \<^bold>\<Turnstile> p \<longrightarrow> i \<^bold>\<Turnstile> wp q (erase_ghost s)\<close>
    by (simp add: rwp_implies_erased_wp)
qed

section \<open>rc_check' examples\<close>

(*You can ghost assume false if there is nothing to show*)
lemma \<open>
well_formed
  (\<^bold>\<top>)
  (
    \<^bold>g \<^bold>\<stileturn> \<^bold>\<bottom>
  )
  (\<^bold>\<top>)\<close>
proof-
  have \<open>rc_check' (\<lambda> x. True) \<^bold>\<top> (\<^bold>g \<^bold>\<stileturn> \<^bold>\<bottom>)\<close>
    by simp
  then show ?thesis
    by (simp add: rc_check'_implies_well_formed)
qed

section \<open>Verification patterns\<close>
(*the following shows that you don't need the complicated rc_check' analysis if you use just a single assumption at the fron*)
lemma single_ghost_assumption:
  assumes checked: \<open>rc_check g s\<close>
    and regular: \<open>regular_p g p\<close> \<open>regular_p g q\<close>
    and p_non_interference: \<open>set vs = {v \<in> pexp_fv p. g v}\<close> \<open>\<forall> i. i \<^bold>\<Turnstile> exi_form r vs\<close>
  shows \<open>well_formed p (\<^bold>g \<^bold>\<stileturn> r\<^bold>; s) q\<close>
proof-
  from p_non_interference have *: \<open>{i \<^bold>\<down> g | i. i \<^bold>\<Turnstile> r} = {i \<^bold>\<down> g| i. True}\<close>
    by (metis (no_types, lifting) psem_uni_form_E exi_form_def foldr_cong mem_Collect_eq regular(1) uni_form_def)
  {
    assume  \<open>\<forall> i. i \<^bold>\<Turnstile> p \<longrightarrow> i \<^bold>\<Turnstile> r \<longrightarrow> i \<^bold>\<Turnstile> wp q s\<close>
    then have **:\<open>\<forall> i. i \<^bold>\<Turnstile> r \<longrightarrow> i \<^bold>\<Turnstile> p \<longrightarrow> i \<^bold>\<Turnstile> wp q (erase_ghost s)\<close>
      using checked regular by (simp add: rc_check_lemma)
    fix i
    obtain i' where i'_def: \<open>i \<^bold>\<down> g = i' \<^bold>\<down> g\<close> \<open>i' \<^bold>\<Turnstile> r\<close>
      using * by blast
    moreover assume \<open>i \<^bold>\<Turnstile> p\<close>
    ultimately have \<open>i' \<^bold>\<Turnstile> p\<close>
      using regular(1) regular_agree_pexp by blast
    then have \<open>i' \<^bold>\<Turnstile> wp q (erase_ghost s)\<close>
      using ** i'_def(2) by simp
    then have \<open>i \<^bold>\<Turnstile> wp q (erase_ghost s)\<close>
      using i'_def(1) checked regular(2) regular_agree_pexp regular_erase by presburger
  }
  then show ?thesis
    unfolding well_formed_def by simp
qed

notepad begin (*examples from section Evaluating the Type Checker*)
  (*have \<open>\<exists> x y :: int. x > 1 \<and> y > 1 \<and> x * y = 61190113\<close> *)
  have \<open>((7727 :: int) > 1 \<and> (7919 :: int) > 1 \<and> (7727 :: int) * 7919 = 61190113)\<close>
    by simp
  have \<open>((7727 :: int) > 1 \<and> (7919 :: int) > 1 \<and> (7727 :: int) * 7919 = 61190113) \<longrightarrow> (\<exists> x y :: int. x > 1 \<and> y > 1 \<and> x * y = 61190113)\<close>
    by fast
  have \<open>(\<forall> i j. \<exists> x y :: int. x > 1 \<and> y > 1 \<and> x * y = 61190113) \<longrightarrow> (\<exists> x y :: int. x > 1 \<and> y > 1 \<and> x * y = 61190113)\<close>
    by simp
end

end


theory weird_nat_mul3_comm23
imports Main
        "$HIPSTER_HOME/IsaHipster"
begin

datatype Nat = Z | S "Nat"

fun add3 :: "Nat => Nat => Nat => Nat" where
"add3 (Z) (Z) z = z"
| "add3 (Z) (S y2) z = S (add3 Z y2 z)"
| "add3 (S x2) y z = S (add3 x2 y z)"

fun mul3 :: "Nat => Nat => Nat => Nat" where
"mul3 (Z) y z = Z"
| "mul3 (S x2) (Z) z = Z"
| "mul3 (S x2) (S x3) (Z) = Z"
| "mul3 (S (Z)) (S (Z)) (S (Z)) = S Z"
| "mul3 (S (Z)) (S (Z)) (S (S x5)) =
     S (add3
          (mul3 Z Z (S x5))
          (add3 (mul3 (S Z) Z (S x5)) (mul3 Z (S Z) (S x5)) (mul3 Z Z (S Z)))
          (add3 Z Z (S x5)))"
| "mul3 (S (Z)) (S (S x6)) (S x4) =
     S (add3
          (mul3 Z (S x6) x4)
          (add3
             (mul3 (S Z) (S x6) x4) (mul3 Z (S Z) x4) (mul3 Z (S x6) (S Z)))
          (add3 Z (S x6) x4))"
| "mul3 (S (S x7)) (S x3) (S x4) =
     S (add3
          (mul3 (S x7) x3 x4)
          (add3
             (mul3 (S Z) x3 x4) (mul3 (S x7) (S Z) x4) (mul3 (S x7) x3 (S Z)))
          (add3 (S x7) x3 x4))"

(*hipster add3 mul3 *)

theorem x0 :
  "!! (x :: Nat) (y :: Nat) (z :: Nat) . (mul3 x y z) = (mul3 x z y)"
  by (tactic \<open>Subgoal.FOCUS_PARAMS (K (Tactic_Data.hard_tac @{context})) @{context} 1\<close>)

end