theory ACom
  imports Com
begin

text \<open>acom is the type of annotated commands (wrt. a type of annotation)\<close>
datatype 'a acom =
  SKIP 'a                           ("SKIP {_}" 61) |
  Assign vname aexp 'a              ("(_ ::= _/ {_})" [1000, 61, 0] 61) |
  Seq "('a acom)" "('a acom)"       ("_;;//_"  [60, 61] 60) |
  If bexp 'a "'a acom" 'a "'a acom" 'a
    ("(IF _/ THEN ({_}/ _)/ ELSE ({_}/ _)//{_})"  [0, 0, 0, 61, 0, 0] 61) |
  Or "'a acom" "'a acom" 'a
    ("_ OR// _//{_}" [60, 61, 0] 60) |
  While 'a bexp 'a "'a acom" 'a
    ("({_}//WHILE _//DO ({_}//_)//{_})"  [0, 0, 0, 61, 0] 61)

notation com.SKIP ("SKIP")

text \<open>strip maps acoms back to the original commands\<close>
text_raw\<open>\snip{stripdef}{1}{1}{%\<close>
fun strip :: "'a acom \<Rightarrow> com" where
"strip (SKIP {P}) = SKIP" |
"strip (x ::= e {P}) = x ::= e" |
"strip (C\<^sub>1;;C\<^sub>2) = strip C\<^sub>1;; strip C\<^sub>2" |
"strip (IF b THEN {P\<^sub>1} C\<^sub>1 ELSE {P\<^sub>2} C\<^sub>2 {P}) =
  IF b THEN strip C\<^sub>1 ELSE strip C\<^sub>2" |
"strip (C\<^sub>1 OR C\<^sub>2 {P}) = strip C\<^sub>1 OR strip C\<^sub>2" |
"strip ({I} WHILE b DO {P} C {Q}) = WHILE b DO strip C"
text_raw\<open>}%endsnip\<close>

text \<open>asize counts the number of annotations that a com admits\<close>
text_raw\<open>\snip{asizedef}{1}{1}{%\<close>
fun asize :: "com \<Rightarrow> nat" where
"asize SKIP = 1" |
"asize (x ::= e) = 1" |
"asize (C\<^sub>1;;C\<^sub>2) = asize C\<^sub>1 + asize C\<^sub>2" |
"asize (IF b THEN C\<^sub>1 ELSE C\<^sub>2) = asize C\<^sub>1 + asize C\<^sub>2 + 3" |
"asize (C\<^sub>1 OR C\<^sub>2) = asize C\<^sub>1 + asize C\<^sub>2 + 1" |
"asize (WHILE b DO C) = asize C + 3"
text_raw\<open>}%endsnip\<close>

text \<open>shift eats the first n elements of a sequence\<close>
text_raw\<open>\snip{annotatedef}{1}{1}{%\<close>
definition shift :: "(nat \<Rightarrow> 'a) \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'a" where
"shift f n = (\<lambda>p. f(p+n))"

text \<open>Defined in terms of shift, annotate annotates a command c with a sequence of annotations\<close>
fun annotate :: "(nat \<Rightarrow> 'a) \<Rightarrow> com \<Rightarrow> 'a acom" where
"annotate f SKIP = SKIP {f 0}" |
"annotate f (x ::= e) = x ::= e {f 0}" |
"annotate f (c\<^sub>1;;c\<^sub>2) = annotate f c\<^sub>1;; annotate (shift f (asize c\<^sub>1)) c\<^sub>2" |
"annotate f (IF b THEN c\<^sub>1 ELSE c\<^sub>2) =
  IF b THEN {f 0} annotate (shift f 1) c\<^sub>1
  ELSE {f(asize c\<^sub>1 + 1)} annotate (shift f (asize c\<^sub>1 + 2)) c\<^sub>2
  {f(asize c\<^sub>1 + asize c\<^sub>2 + 2)}" |
"annotate f (c\<^sub>1 OR c\<^sub>2) =
  annotate f c\<^sub>1 OR annotate (shift f (asize c\<^sub>1)) c\<^sub>2 {f (asize c\<^sub>1 + asize c\<^sub>2)}" |
"annotate f (WHILE b DO c) =
  {f 0} WHILE b DO {f 1} annotate (shift f 2) c {f(asize c + 2)}"
text_raw\<open>}%endsnip\<close>

text \<open>annos collects a command's annotations into a list\<close>
text_raw\<open>\snip{annosdef}{1}{1}{%\<close>
fun annos :: "'a acom \<Rightarrow> 'a list" where
"annos (SKIP {P}) = [P]" |
"annos (x ::= e {P}) = [P]" |
"annos (C\<^sub>1;;C\<^sub>2) = annos C\<^sub>1 @ annos C\<^sub>2" |
"annos (IF b THEN {P\<^sub>1} C\<^sub>1 ELSE {P\<^sub>2} C\<^sub>2 {Q}) =
  P\<^sub>1 # annos C\<^sub>1 @  P\<^sub>2 # annos C\<^sub>2 @ [Q]" |
"annos (C\<^sub>1 OR C\<^sub>2 {P}) = annos C\<^sub>1 @ annos C\<^sub>2 @ [P]" |
"annos ({I} WHILE b DO {P} C {Q}) = I # P # annos C @ [Q]"
text_raw\<open>}%endsnip\<close>

text \<open>anno retrives the pth annotation of a command, by first collecting its annotations then
indexing into the pth list element\<close>
definition anno :: "'a acom \<Rightarrow> nat \<Rightarrow> 'a" where
"anno C p = annos C ! p"

text \<open>post retrieves the last annotation of a command, by first collecting its annotations\<close>
definition post :: "'a acom \<Rightarrow>'a" where
"post C = last(annos C)"

text \<open>map_acom maps the annotations of an acom\<close>
text_raw\<open>\snip{mapacomdef}{1}{2}{%\<close>
fun map_acom :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a acom \<Rightarrow> 'b acom" where
"map_acom f (SKIP {P}) = SKIP {f P}" |
"map_acom f (x ::= e {P}) = x ::= e {f P}" |
"map_acom f (C\<^sub>1;;C\<^sub>2) = map_acom f C\<^sub>1;; map_acom f C\<^sub>2" |
"map_acom f (IF b THEN {P\<^sub>1} C\<^sub>1 ELSE {P\<^sub>2} C\<^sub>2 {Q}) =
  IF b THEN {f P\<^sub>1} map_acom f C\<^sub>1 ELSE {f P\<^sub>2} map_acom f C\<^sub>2
  {f Q}" |
"map_acom f (C\<^sub>1 OR C\<^sub>2 {P}) = map_acom f C\<^sub>1 OR map_acom f C\<^sub>2 {f P}" |
"map_acom f ({I} WHILE b DO {P} C {Q}) =
  {f I} WHILE b DO {f P} map_acom f C {f Q}"
text_raw\<open>}%endsnip\<close>

text \<open>the list of annotations for any command is always nonempty\<close>
lemma annos_ne: "annos C \<noteq> []"
by(induction C) auto

text \<open>stripping a command that has been annotated recovers it\<close>
lemma strip_annotate[simp]: "strip(annotate f c) = c"
by(induction c arbitrary: f) auto

text \<open>the list of annotations of a com, once annotated, is as large as the number of annotations it admits\<close>
lemma length_annos_annotate[simp]: "length (annos (annotate f c)) = asize c"
by(induction c arbitrary: f) auto

text \<open>the size of the list of annotations of a command is as large as the number of annotations its underlying com admits\<close>
lemma size_annos: "size(annos C) = asize(strip C)"
by(induction C)(auto)

text \<open>if two acom share the same com, then they have the same number of annotations\<close>
lemma size_annos_same: "strip C1 = strip C2 \<Longrightarrow> size(annos C1) = size(annos C2)"
apply(induct C2 arbitrary: C1)
apply(case_tac C1, simp_all)+
done

lemmas size_annos_same2 = eqTrueI[OF size_annos_same]

text \<open>dually, the pth annotation is the pth element of the annotating sequence\<close>
lemma anno_annotate[simp]: "p < asize c \<Longrightarrow> anno (annotate f c) p = f p"
proof (induction c arbitrary: f p)
  case SKIP
  then show ?case by (auto simp: anno_def)
next
  case (Assign x1 x2)
  then show ?case by (auto simp: anno_def)
next
  case (Seq c1 c2)
  then show ?case by (auto simp: anno_def nth_append shift_def)
next
  case (If x1 c1 c2)
  then show ?case
    by (auto simp: anno_def nth_append nth_Cons shift_def split: nat.split,
        metis add_Suc_right add_diff_inverse add.commute,
        rule_tac f=f in arg_cong,
        arith)
next
  case (Or c1 c2)
  then show ?case
    by (auto simp: anno_def nth_append shift_def,
        rule_tac f=f in arg_cong,
        arith)
next
case (While x1 c)
  then show ?case
    by (auto simp: anno_def nth_append nth_Cons shift_def
        split: nat.split, rule_tac f=f in arg_cong,
        arith)
qed

text \<open>two acoms are equal iff they have the same underlying command and same list of annotations\<close>
text \<open>Proof is by inductive definiton of acom, and list lemmas / annos lemmas\<close>
lemma eq_acom_iff_strip_annos:
  "C1 = C2 \<longleftrightarrow> strip C1 = strip C2 \<and> annos C1 = annos C2"
apply(induction C1 arbitrary: C2)
apply(case_tac C2, auto simp: size_annos_same2)+
done

text \<open>two acoms are equal iff they have the same underlying command and same sublist of annotations\<close>
lemma eq_acom_iff_strip_anno:
  "C1=C2 \<longleftrightarrow> strip C1 = strip C2 \<and> (\<forall>p<size(annos C1). anno C1 p = anno C2 p)"
by(auto simp add: eq_acom_iff_strip_annos anno_def
     list_eq_iff_nth_eq size_annos_same2)

text \<open>the last annotation after mapping through f is exactly the last annotation, then mapping it by f\<close>
lemma post_map_acom[simp]: "post(map_acom f C) = f(post C)"
by (induction C) (auto simp: post_def last_append annos_ne)

text \<open>the underlying command is unchanged by map_acom\<close>
lemma strip_map_acom[simp]: "strip (map_acom f C) = strip C"
by (induction C) auto

text \<open>the pth annotation after mapping through f is exactly the pth annotation, then mapping it by f\<close>
lemma anno_map_acom: "p < size(annos C) \<Longrightarrow> anno (map_acom f C) p = f(anno C p)"
apply(induction C arbitrary: p)
apply(auto simp: anno_def nth_append nth_Cons' size_annos)
done

text \<open>inversion lemma for strip C\<close>

lemma strip_eq_SKIP:
  "strip C = SKIP \<longleftrightarrow> (\<exists>P. C = SKIP {P})"
by (cases C) simp_all

lemma strip_eq_Assign:
  "strip C = x::=e \<longleftrightarrow> (\<exists>P. C = x::=e {P})"
by (cases C) simp_all

lemma strip_eq_Seq:
  "strip C = c1;;c2 \<longleftrightarrow> (\<exists>C1 C2. C = C1;;C2 & strip C1 = c1 & strip C2 = c2)"
by (cases C) simp_all

lemma strip_eq_If:
  "strip C = IF b THEN c1 ELSE c2 \<longleftrightarrow>
  (\<exists>P1 P2 C1 C2 Q. C = IF b THEN {P1} C1 ELSE {P2} C2 {Q} & strip C1 = c1 & strip C2 = c2)"
by (cases C) simp_all

lemma strip_eq_Or:
  "strip C = c1 OR c2 \<longleftrightarrow>
  (\<exists>C1 C2 P. C = C1 OR C2 {P} & strip C1 = c1 & strip C2 = c2)"
by (cases C) simp_all

lemma strip_eq_While:
  "strip C = WHILE b DO c1 \<longleftrightarrow>
  (\<exists>I P C1 Q. C = {I} WHILE b DO {P} C1 {Q} & strip C1 = c1)"
by (cases C) simp_all

text \<open>shifting a constant sequence does nothing\<close>

text \<open>the set of all members of an acom created by annotate with a constant sequence on that annotation is a singleton\<close>
lemma set_annos_anno[simp]: "set (annos (annotate (\<lambda>p. a) c)) = {a}"
  by(induction c) simp_all

text \<open>the last annotation of an acom is in the set of list of annotations of that acom\<close>
lemma post_in_annos: "post C \<in> set(annos C)"
by(auto simp: post_def annos_ne)

text \<open>the last annotation of C is the last element of the list of annotations generated from C.\<close>
lemma post_anno_asize: "post C = anno C (size(annos C) - 1)"
  by(simp add: post_def last_conv_nth[OF annos_ne] anno_def)

end


(******************************************************************************
 * Orca: A Functional Correctness Verifier for Imperative Programs
 *       Based on Isabelle/UTP
 *
 * Copyright (c) 2016-2018 Virginia Tech, USA
 *               2016-2018 Technische Universität München, Germany
 *               2016-2018 University of York, UK
 *               2016-2018 Université Paris-Saclay, Univ. Paris-Sud, France
 *
 * This software may be distributed and modified according to the terms of
 * the GNU Lesser General Public License version 3.0 or any later version.
 * Note that NO WARRANTY is provided.
 *
 * See CONTRIBUTORS, LICENSE and CITATION files for details.
 ******************************************************************************)

subsection {* Relational Hoare calculus *}

theory utp_hoare
imports "../../utp/utp_rec_total"
begin

named_theorems hoare_sp_rules and hoare_wp_rules and hoare_wp_proof_annotation_rules

subsection {*Hoare triple definition*}

definition hoare_r :: "'\<alpha> cond \<Rightarrow> '\<alpha> hrel \<Rightarrow> '\<alpha> cond \<Rightarrow> bool" ("\<lbrace>_\<rbrace>_\<lbrace>_\<rbrace>\<^sub>u") where
"\<lbrace>p\<rbrace>Q\<lbrace>r\<rbrace>\<^sub>u = ((\<lceil>p\<rceil>\<^sub>< \<Rightarrow> \<lceil>r\<rceil>\<^sub>>) \<sqsubseteq> Q)"

declare hoare_r_def[upred_defs]
lemma assisgns_true_hoare_rel:
  "\<lbrace>p\<rbrace> \<langle>\<sigma>\<rangle>\<^sub>a \<lbrace>true\<rbrace>\<^sub>u"
  by rel_simp

lemma skip_true_hoare_rel:
  "\<lbrace>p\<rbrace>SKIP\<^sub>r\<lbrace>true\<rbrace>\<^sub>u"
   by rel_simp

lemma pre_false_hoare_rel:
  "\<lbrace>false\<rbrace>C\<lbrace>q\<rbrace>\<^sub>u"
  by rel_simp

subsection {*Precondition weakening*}

lemma pre_str_hoare_rel:
  assumes "`p\<^sub>1 \<Rightarrow> p\<^sub>2`" and "\<lbrace>p\<^sub>2\<rbrace>C\<lbrace>q\<rbrace>\<^sub>u"
  shows "\<lbrace>p\<^sub>1\<rbrace>C\<lbrace>q\<rbrace>\<^sub>u"
  using assms
  by rel_simp

subsection {*Post-condition strengthening*}

lemma post_weak_hoare_rel:
  assumes "\<lbrace>p\<rbrace>C\<lbrace>q\<^sub>2\<rbrace>\<^sub>u" and "`q\<^sub>2 \<Rightarrow> q\<^sub>1`"
  shows "\<lbrace>p\<rbrace>C\<lbrace>q\<^sub>1\<rbrace>\<^sub>u"
  using assms
  by rel_simp

subsection {*Consequence rule*}

lemma consequence_hoare_rel:
  assumes I0': "`p \<Rightarrow> p'`"
  assumes induct_step:"\<lbrace>p'\<rbrace> C \<lbrace>q'\<rbrace>\<^sub>u"
  assumes I0 :"`q'\<Rightarrow> q`"
  shows "\<lbrace>p\<rbrace>C\<lbrace>q\<rbrace>\<^sub>u"
proof(rule post_weak_hoare_rel[OF _ I0], goal_cases)
  case 1
  then show ?case by (rule pre_str_hoare_rel[OF I0' induct_step])
qed

subsection {*Hoare and assertion logic*}

lemma conj_hoare_rel:
  assumes"\<lbrace>p\<rbrace>C\<lbrace>r\<rbrace>\<^sub>u" and "\<lbrace>p\<rbrace>C\<lbrace>s\<rbrace>\<^sub>u"
  shows "\<lbrace>p\<rbrace>C\<lbrace>r \<and> s\<rbrace>\<^sub>u"
  using assms
  by rel_simp

subsection {*Hoare SKIP*}

lemma skip_hoare_rel[hoare_sp_rules, hoare_wp_rules, hoare_wp_proof_annotation_rules]:
  "\<lbrace>p\<rbrace>SKIP\<^sub>r\<lbrace>p\<rbrace>\<^sub>u"
  by rel_simp

lemma skip_rel_hoare_rel_intro:
  "`p \<Rightarrow> q`\<Longrightarrow>\<lbrace>p\<rbrace>SKIP\<^sub>r\<lbrace>q\<rbrace>\<^sub>u"
  by rel_simp

subsection {*Hoare for assignment*}

lemma assigns_hoare_rel_intro:
  assumes"`p \<Rightarrow> \<sigma> \<dagger> q`"
  shows  "\<lbrace>p\<rbrace>\<langle>\<sigma>\<rangle>\<^sub>a\<lbrace>q\<rbrace>\<^sub>u"
  using assms
  by rel_simp

lemma assigns_backward_hoare_rel[hoare_wp_rules, hoare_wp_proof_annotation_rules]:
  "\<lbrace>\<sigma> \<dagger> p\<rbrace>\<langle>\<sigma>\<rangle>\<^sub>a\<lbrace>p\<rbrace>\<^sub>u"
  by rel_simp

lemma assigns_floyd_hoare_rel[hoare_sp_rules]:
  assumes "vwb_lens x"
  shows \<open>\<lbrace>p\<rbrace>assign_r x e\<lbrace>\<^bold>\<exists>v \<bullet> p\<lbrakk>\<guillemotleft>v\<guillemotright>/x\<rbrakk> \<and> &x =\<^sub>u e\<lbrakk>\<guillemotleft>v\<guillemotright>/x\<rbrakk>\<rbrace>\<^sub>u\<close> (*If I use the syntax sugar the rule  does not match because the same syntax sugar is used for H1 and H3 designs *)
  using assms
  apply rel_simp
  subgoal for a
    apply (rule exI[where x = "lens_get x a"])
    apply simp
    done
  done

subsection {*Hoare for Sequential Composition*}

lemma seq_invariant_hoare_rel:
 "\<lbrakk>\<lbrace>p\<rbrace>Q\<^sub>1\<lbrace>p\<rbrace>\<^sub>u ; \<lbrace>p\<rbrace>Q\<^sub>2\<lbrace>p\<rbrace>\<^sub>u\<rbrakk> \<Longrightarrow> \<lbrace>p\<rbrace>Q\<^sub>1 ;; Q\<^sub>2\<lbrace>p\<rbrace>\<^sub>u"
  by rel_simp

lemma seq_stronger_pre_1_hoare_rel:
  "\<lbrakk> \<lbrace>p \<and> q\<rbrace>Q\<^sub>1\<lbrace>p \<and> q\<rbrace>\<^sub>u ; \<lbrace>p \<and> q\<rbrace>Q\<^sub>2\<lbrace>q\<rbrace>\<^sub>u \<rbrakk> \<Longrightarrow> \<lbrace>p \<and> q\<rbrace>Q\<^sub>1 ;; Q\<^sub>2\<lbrace>q\<rbrace>\<^sub>u"
  by rel_simp

lemma seq_stronger_pre_2_hoare_rel:
  "\<lbrakk> \<lbrace>p \<and> q\<rbrace>Q\<^sub>1\<lbrace>p \<and> q\<rbrace>\<^sub>u ; \<lbrace>p \<and> q\<rbrace>Q\<^sub>2\<lbrace>p\<rbrace>\<^sub>u\<rbrakk> \<Longrightarrow> \<lbrace>p \<and> q\<rbrace>Q\<^sub>1 ;; Q\<^sub>2\<lbrace>p\<rbrace>\<^sub>u"
  by rel_simp

lemma seq_hoare_rel[hoare_wp_rules, hoare_sp_rules]:
  assumes"\<lbrace>p\<rbrace>C\<^sub>1\<lbrace>s\<rbrace>\<^sub>u" and "\<lbrace>s\<rbrace>C\<^sub>2\<lbrace>r\<rbrace>\<^sub>u"
  shows"\<lbrace>p\<rbrace>C\<^sub>1 ;; C\<^sub>2\<lbrace>r\<rbrace>\<^sub>u"
  using assms
  by rel_simp

subsection {*Hoare for Conditional*}

lemma cond_hoare_rel:
  assumes "\<lbrace>b \<and> p\<rbrace>C\<^sub>1\<lbrace>q\<rbrace>\<^sub>u" and "\<lbrace>\<not>b \<and> p\<rbrace>C\<^sub>2\<lbrace>q\<rbrace>\<^sub>u"
  shows "\<lbrace>p\<rbrace> bif b then C\<^sub>1 else C\<^sub>2 eif\<lbrace>q\<rbrace>\<^sub>u"
  using assms
  by pred_simp

lemma cond_hoare_rel_wp[hoare_wp_rules, hoare_wp_proof_annotation_rules]:
  assumes "\<lbrace>p'\<rbrace>C\<^sub>1\<lbrace>q\<rbrace>\<^sub>u" and "\<lbrace>p''\<rbrace>C\<^sub>2\<lbrace>q\<rbrace>\<^sub>u"
  shows "\<lbrace>(b \<and> p')\<or> (\<not>b \<and> p'')\<rbrace>bif b then C\<^sub>1 else C\<^sub>2 eif\<lbrace>q\<rbrace>\<^sub>u"
  using assms
  by pred_simp

lemma cond_hoare_rel_sp[hoare_sp_rules]:
  assumes \<open>\<lbrace>b \<and> p\<rbrace>C\<^sub>1\<lbrace>q\<rbrace>\<^sub>u\<close> and \<open>\<lbrace>\<not>b \<and> p\<rbrace>C\<^sub>2\<lbrace>s\<rbrace>\<^sub>u\<close>
  shows \<open>\<lbrace>p\<rbrace>bif b then C\<^sub>1 else C\<^sub>2 eif\<lbrace>q \<or> s\<rbrace>\<^sub>u\<close>
  using assms
  by pred_simp

subsection {*Hoare for recursion*}

lemma nu_hoare_rel_partial:
  assumes induct_step:
    "\<And> P. \<lbrace>p\<rbrace>P\<lbrace>q\<rbrace>\<^sub>u \<Longrightarrow> \<lbrace>p\<rbrace>F P\<lbrace>q\<rbrace>\<^sub>u"
  shows "\<lbrace>p\<rbrace>\<nu> F \<lbrace>q\<rbrace>\<^sub>u"
  unfolding hoare_r_def
  apply (rule lfp_lowerbound)
    apply (rule induct_step[unfolded hoare_r_def])
    apply simp
  done

lemma mu_hoare_rel:
  assumes WF: "wf R"
  assumes M:"mono F"
  assumes induct_step:
    "\<And> st P. \<lbrace>p \<and>(e,\<guillemotleft>st\<guillemotright>)\<^sub>u\<in>\<^sub>u\<guillemotleft>R\<guillemotright>\<rbrace>P\<lbrace>q\<rbrace>\<^sub>u \<Longrightarrow> \<lbrace>p \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright>\<rbrace>F P\<lbrace>q\<rbrace>\<^sub>u"
  shows "\<lbrace>p\<rbrace>\<mu> F \<lbrace>q\<rbrace>\<^sub>u"
  unfolding hoare_r_def
proof (rule mu_rec_total_utp_rule[OF WF M , of _ e ], goal_cases)
  case (1 st)
  then show ?case
  by (rule induct_step[unfolded hoare_r_def], simp)
qed

lemma mu_hoare_rel':
  assumes WF: "wf R"
  assumes M:"mono F"
  assumes induct_step:
    "\<And> st P. \<lbrace>p \<and>(e,\<guillemotleft>st\<guillemotright>)\<^sub>u\<in>\<^sub>u\<guillemotleft>R\<guillemotright>\<rbrace> P \<lbrace>q\<rbrace>\<^sub>u \<Longrightarrow> \<lbrace>p \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright>\<rbrace> F P \<lbrace>q\<rbrace>\<^sub>u"
  assumes I0: "`p' \<Rightarrow> p`"
  shows "\<lbrace>p'\<rbrace>\<mu> F \<lbrace>q\<rbrace>\<^sub>u"
  by (simp add: pre_str_hoare_rel[OF I0 mu_hoare_rel[OF WF M induct_step]])

subsection {*Hoare for frames*}

lemma antiframe_hoare_rel:
  assumes "vwb_lens a"
  assumes "a \<sharp> r"
  assumes "a \<natural> q"
  assumes "\<lbrace>p\<rbrace>P\<lbrace>q\<rbrace>\<^sub>u"
  shows "\<lbrace>p \<and> r\<rbrace>a:[P]\<lbrace>q \<and> r\<rbrace>\<^sub>u"
  using assms
  by rel_simp

lemma antiframe_hoar_rel_stronger:
  assumes "vwb_lens a"
  assumes "a \<sharp> r"
  assumes "a \<natural> q"
  assumes "\<lbrace>p \<and> r\<rbrace>P\<lbrace>q\<rbrace>\<^sub>u"
  shows "\<lbrace>p \<and> r\<rbrace>a:[P]\<lbrace>q \<and> r\<rbrace>\<^sub>u"
  using assms
  by rel_simp

lemma frame_hoare_rel:
  assumes "vwb_lens a"
  assumes "a \<natural> r"
  assumes "a \<sharp> q"
  assumes "\<lbrace>p\<rbrace>P\<lbrace>q\<rbrace>\<^sub>u"
  shows "\<lbrace>p \<and> r\<rbrace> a:\<lbrakk>P\<rbrakk> \<lbrace>q \<and> r\<rbrace>\<^sub>u"
  using assms
  by rel_simp

lemma frame_hoare_rel_stronger:
  assumes "vwb_lens a"
  assumes "a \<natural> r"
  assumes "a \<sharp> q"
  assumes "\<lbrace>p \<and> r\<rbrace>P\<lbrace>q\<rbrace>\<^sub>u"
  shows "\<lbrace>p \<and> r\<rbrace> a:\<lbrakk>P\<rbrakk> \<lbrace>q \<and> r\<rbrace>\<^sub>u"
  using assms
  by rel_simp

lemma anti_frame_intro:
  assumes 1:"vwb_lens g"
  assumes 2:"vwb_lens g'"
  assumes 3:"vwb_lens l"
  assumes 4:"l \<bowtie> g"
  assumes 8:"g' \<subseteq>\<^sub>L g"
  assumes 5:"{&g', &l}:[C] = C"
  assumes 6:"\<lbrace>p\<rbrace>C\<lbrace>q\<rbrace>\<^sub>u"
  assumes 7:"`r \<Rightarrow> p`"
  shows "\<lbrace>r\<rbrace> l:\<lbrakk>C\<rbrakk> \<lbrace>(\<exists> l \<bullet> q) \<and> (\<exists>g' \<bullet> r)\<rbrace>\<^sub>u"
  using 1 2 3 4 5 6 7 unfolding lens_indep_def
  apply rel_auto
   apply (metis (no_types, lifting) vwb_lens_wb wb_lens.get_put)
  apply (rule_tac x="get\<^bsub> g'\<^esub> a" in exI) using 8 4
proof -
  fix a :: 'b and x :: 'b
  assume a1: "\<lbrakk>r\<rbrakk>\<^sub>e a"
  assume a2: "\<forall>\<sigma> v u. put\<^bsub>l\<^esub> (put\<^bsub>g\<^esub> \<sigma> v) u = put\<^bsub>g\<^esub> (put\<^bsub>l\<^esub> \<sigma> u) v"
  assume a3: "vwb_lens g"
  assume a4: "\<lbrakk>C\<rbrakk>\<^sub>e (a, x)"
  assume a5: "\<forall>a b. (\<exists>x. \<lbrakk>C\<rbrakk>\<^sub>e (a, x) \<and> b = put\<^bsub>g'\<^esub> (put\<^bsub>l\<^esub> a (get\<^bsub>l\<^esub> x)) (get\<^bsub>g'\<^esub> x)) = \<lbrakk>C\<rbrakk>\<^sub>e (a, b)"
  assume a6: "vwb_lens l"
  assume a7: "\<forall>\<sigma> u. get\<^bsub>g\<^esub> (put\<^bsub>l\<^esub> \<sigma> u) = get\<^bsub>g\<^esub> \<sigma>"
  assume a8: "vwb_lens g'"
  have f9: "\<forall>l la b c a. \<not> mwb_lens l \<or> \<not> la \<subseteq>\<^sub>L l \<or> put\<^bsub>l\<^esub> (put\<^bsub>la\<^esub> (b::'b) (c::'c)) (a::'a) = put\<^bsub>l\<^esub> b a"
    by (meson sublens_put_put)
  have "mwb_lens g"
    using a3 vwb_lens_mwb by blast
  then have f10: "put\<^bsub>g\<^esub> (put\<^bsub>g'\<^esub> (put\<^bsub>l\<^esub> a (get\<^bsub>l\<^esub> (v2_0 x a))) (get\<^bsub>g'\<^esub> (v2_0 x a))) (get\<^bsub>g\<^esub> x) = put\<^bsub>g\<^esub> (put\<^bsub>l\<^esub> a (get\<^bsub>l\<^esub> (v2_0 x a))) (get\<^bsub>g\<^esub> x)"
    using f9 by (metis "8") (* > 1.0 s, timed out *)
  obtain bb :: "'b \<Rightarrow> 'b \<Rightarrow> 'b" where
    "\<forall>x0 x1. (\<exists>v2. \<lbrakk>C\<rbrakk>\<^sub>e (x1, v2) \<and> x0 = put\<^bsub>g'\<^esub> (put\<^bsub>l\<^esub> x1 (get\<^bsub>l\<^esub> v2)) (get\<^bsub>g'\<^esub> v2)) = (\<lbrakk>C\<rbrakk>\<^sub>e (x1, bb x0 x1) \<and> x0 = put\<^bsub>g'\<^esub> (put\<^bsub>l\<^esub> x1 (get\<^bsub>l\<^esub> (bb x0 x1))) (get\<^bsub>g'\<^esub> (bb x0 x1)))"
    by moura
  then have f11: "\<lbrakk>C\<rbrakk>\<^sub>e (a, bb x a) \<and> x = put\<^bsub>g'\<^esub> (put\<^bsub>l\<^esub> a (get\<^bsub>l\<^esub> (bb x a))) (get\<^bsub>g'\<^esub> (bb x a))"
    using a5 a4 by presburger
  have "mwb_lens g"
    using a3 vwb_lens_mwb by blast
  then have f12: "put\<^bsub>g\<^esub> (put\<^bsub>g'\<^esub> a (get\<^bsub>g'\<^esub> (bb x a))) (get\<^bsub>g\<^esub> x) = put\<^bsub>g\<^esub> a (get\<^bsub>g\<^esub> x)"
    using f9 by (metis "8")
  have f13: "\<forall>l la b c. \<not> vwb_lens l \<or> \<not> la \<subseteq>\<^sub>L l \<or> get\<^bsub>l\<^esub> (put\<^bsub>la\<^esub> (b::'b) (c::'c)) = put\<^bsub>la /\<^sub>L l\<^esub> (get\<^bsub>l\<^esub> b::'a) c"
    by (simp add: lens_get_put_quasi_commute)
  then have f14: "get\<^bsub>g\<^esub> (put\<^bsub>g'\<^esub> a (get\<^bsub>g'\<^esub> (bb x a))) = put\<^bsub>g' /\<^sub>L g\<^esub> (get\<^bsub>g\<^esub> a) (get\<^bsub>g'\<^esub> (bb x a))"
    using a3 "8" by fastforce
  have "get\<^bsub>g\<^esub> (put\<^bsub>g'\<^esub> (put\<^bsub>l\<^esub> a (get\<^bsub>l\<^esub> (bb x a))) (get\<^bsub>g'\<^esub> (bb x a))) = put\<^bsub>g' /\<^sub>L g\<^esub> (get\<^bsub>g\<^esub> (put\<^bsub>l\<^esub> a (get\<^bsub>l\<^esub> (bb x a)))) (get\<^bsub>g'\<^esub> (bb x a))"
    using a3 f13 "8" by fastforce
  then show "\<lbrakk>r\<rbrakk>\<^sub>e (put\<^bsub>g'\<^esub> (put\<^bsub>l\<^esub> x (get\<^bsub>l\<^esub> a)) (get\<^bsub>g'\<^esub> a))"
    using f14 f12 f11 f10 a8 a7 a6 a3 a2 a1
  proof -
    have "\<forall>l la b c a. \<not> mwb_lens l \<or> \<not> la \<subseteq>\<^sub>L l \<or> put\<^bsub>l\<^esub> (put\<^bsub>la\<^esub> (b::'b) (c::'c)) (a::'a) = put\<^bsub>l\<^esub> b a"
      by (meson sublens_put_put)
    then have "put\<^bsub>g\<^esub> (put\<^bsub>g'\<^esub> (put\<^bsub>l\<^esub> a (get\<^bsub>l\<^esub> (bb x a))) (get\<^bsub>g'\<^esub> (bb x a))) (put\<^bsub>g' /\<^sub>L g\<^esub> (get\<^bsub>g\<^esub> (put\<^bsub>l\<^esub> a (get\<^bsub>l\<^esub> (bb x a)))) (get\<^bsub>g'\<^esub> (bb x a))) = put\<^bsub>g\<^esub> (put\<^bsub>l\<^esub> a (get\<^bsub>l\<^esub> (bb x a))) (put\<^bsub>g' /\<^sub>L g\<^esub> (get\<^bsub>g\<^esub> (put\<^bsub>l\<^esub> a (get\<^bsub>l\<^esub> (bb x a)))) (get\<^bsub>g'\<^esub> (bb x a)))"
      by (metis "8" \<open>mwb_lens g\<close>)
    then show ?thesis
      by (metis (no_types) \<open>get\<^bsub>g\<^esub> (put\<^bsub>g'\<^esub> (put\<^bsub>l\<^esub> a (get\<^bsub>l\<^esub> (bb x a))) (get\<^bsub>g'\<^esub> (bb x a))) = put\<^bsub>g' /\<^sub>L g\<^esub> (get\<^bsub>g\<^esub> (put\<^bsub>l\<^esub> a (get\<^bsub>l\<^esub> (bb x a)))) (get\<^bsub>g'\<^esub> (bb x a))\<close> a1 a2 a3 a6 a7 a8 f11 f12 f14 vwb_lens.put_eq vwb_lens_wb wb_lens.get_put)
  qed
qed

subsection {*Hoare for while loop*}

lemma if_rel_mono:
  "mono (\<lambda>X. bif b then P ;; X else Q eif)"
  by (auto intro: monoI seqr_mono cond_mono)

lemma while_gfp_hoare_rel_minimal_partial:
  assumes seq_step: "`p \<Rightarrow> invar`"
  assumes induct_step: "\<lbrace>invar\<and> b\<rbrace> C \<lbrace>invar\<rbrace>\<^sub>u"
  shows "\<lbrace>p\<rbrace>while\<^sup>\<top> b do C od\<lbrace>\<not>b \<and> invar\<rbrace>\<^sub>u"
  unfolding while_gfp_rel_def_alt
  apply (rule pre_str_hoare_rel[OF seq_step])
  apply (rule nu_hoare_rel_partial)
  apply (rule cond_hoare_rel)
   apply (rule seq_hoare_rel[where s="invar"])
  subgoal for st
    using pre_str_hoare_rel induct_step seq_step
    unfolding hoare_r_def
    apply pred_simp
    done
  subgoal for st
    apply assumption
    done
  subgoal for st
    apply pred_simp
    done
  done

lemma while_gfp_invr_hoare_rel_minimal_partial:
  assumes seq_step: "`p \<Rightarrow> invar`"
  assumes induct_step: "\<lbrace>invar\<and> b\<rbrace> C \<lbrace>invar\<rbrace>\<^sub>u"
  shows "\<lbrace>p\<rbrace>invr invar while\<^sup>\<top> b do C od\<lbrace>\<not>b \<and> invar\<rbrace>\<^sub>u"
  unfolding while_gfp_invr_rel_def
  by (auto intro!: assms while_gfp_hoare_rel_minimal_partial)

lemma while_gfp_hoare_rel_consequence_partial:
  assumes seq_step: "`p\<Rightarrow>invar`"
  assumes PHI: "`\<not>b \<and> invar \<Rightarrow> q`"
  assumes I0': "` invar \<and> b  \<Rightarrow> p'`"
  assumes induct_step: "\<lbrace>p'\<rbrace>C \<lbrace>q'\<rbrace>\<^sub>u"
  assumes I0: "`q' \<Rightarrow> invar`"
  shows "\<lbrace>p\<rbrace>while\<^sup>\<top> b do C od\<lbrace>q\<rbrace>\<^sub>u"
  by (rule consequence_hoare_rel[OF seq_step _ PHI,
                                 OF while_gfp_hoare_rel_minimal_partial[OF uimp_refl],
                                 OF consequence_hoare_rel[OF I0' induct_step I0]])

lemma while_gfp_invr_hoare_rel_consequence_partial:
  assumes seq_step: "`p\<Rightarrow>invar`"
  assumes PHI: "`\<not>b \<and> invar \<Rightarrow> q`"
  assumes I0': "` invar \<and> b  \<Rightarrow> p'`"
  assumes induct_step: "\<lbrace>p'\<rbrace>C \<lbrace>q'\<rbrace>\<^sub>u"
  assumes I0: "`q' \<Rightarrow> invar`"
  shows "\<lbrace>p\<rbrace>invr invar while\<^sup>\<top> b do C od\<lbrace>q\<rbrace>\<^sub>u"
  unfolding while_gfp_invr_rel_def
  by (auto intro!: assms while_gfp_hoare_rel_consequence_partial)

lemma while_gfp_hoare_rel_wp_partial:
  assumes PHI: "`\<not>b \<and> invar \<Rightarrow> q`"
  assumes I0': "`invar \<and> b \<Rightarrow> p'`"
  assumes induct_step: "\<lbrace>p'\<rbrace>C \<lbrace>invar\<rbrace>\<^sub>u"
  shows "\<lbrace>invar\<rbrace>while\<^sup>\<top> b do C od\<lbrace>q\<rbrace>\<^sub>u"
  by (rule consequence_hoare_rel[OF uimp_refl _ PHI,
                                 OF while_gfp_hoare_rel_minimal_partial[OF uimp_refl],
                                 OF consequence_hoare_rel[OF I0' induct_step uimp_refl]])

lemma while_gfp_invr_hoare_rel_wp_partial:
  assumes PHI: "`\<not>b \<and> invar \<Rightarrow> q`"
  assumes I0': "`invar \<and> b \<Rightarrow> p'`"
  assumes induct_step: "\<lbrace>p'\<rbrace>C \<lbrace>invar\<rbrace>\<^sub>u"
  shows "\<lbrace>invar\<rbrace>invr invar while\<^sup>\<top> b do C od\<lbrace>q\<rbrace>\<^sub>u"
  unfolding while_gfp_invr_rel_def
  by (auto intro!: assms while_gfp_hoare_rel_consequence_partial)

lemma while_gfp_hoare_rel_sp_partial:
  assumes seq_step: "`p \<Rightarrow> invar`"
  assumes induct_step: "\<lbrace>invar \<and> b\<rbrace>C \<lbrace>q'\<rbrace>\<^sub>u"
  assumes I0: "`q' \<Rightarrow> invar`"
  shows "\<lbrace>p\<rbrace>while\<^sup>\<top> b do C od\<lbrace>\<not>b \<and> invar\<rbrace>\<^sub>u"
  by (rule consequence_hoare_rel[OF seq_step _ uimp_refl,
                                 OF while_gfp_hoare_rel_minimal_partial[OF uimp_refl],
                                 OF consequence_hoare_rel[OF uimp_refl induct_step I0]])

lemma while_gfp_invr_hoare_rel_sp_partial:
  assumes seq_step: "`p \<Rightarrow> invar`"
  assumes induct_step: "\<lbrace>invar \<and> b\<rbrace>C \<lbrace>q'\<rbrace>\<^sub>u"
  assumes I0: "`q' \<Rightarrow> invar`"
  shows "\<lbrace>p\<rbrace>invr invar while\<^sup>\<top> b do C od\<lbrace>\<not>b \<and> invar\<rbrace>\<^sub>u"
  unfolding while_gfp_invr_rel_def
  by (rule consequence_hoare_rel[OF seq_step _ uimp_refl,
                                 OF while_gfp_hoare_rel_minimal_partial[OF uimp_refl],
                                 OF consequence_hoare_rel[OF uimp_refl induct_step I0]])

lemma while_lfp_hoare_rel_minimal:
  assumes WF: "wf R"
  assumes seq_step: "`p \<Rightarrow> invar`"
  assumes induct_step:"\<And>st. \<lbrace>b \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright>\<rbrace>body\<lbrace>invar \<and>(e,\<guillemotleft>st\<guillemotright>)\<^sub>u\<in>\<^sub>u\<guillemotleft>R\<guillemotright>\<rbrace>\<^sub>u"
  shows "\<lbrace>p\<rbrace>while\<^sub>\<bottom> b do body od\<lbrace>\<not>b \<and> invar\<rbrace>\<^sub>u"
  unfolding while_lfp_rel_def_alt
proof (rule pre_str_hoare_rel[OF seq_step mu_hoare_rel[OF WF if_rel_mono cond_hoare_rel, of _ e]], goal_cases)
  case (1 st X)
  assume *: "\<lbrace>invar \<and> (e, \<guillemotleft>st\<guillemotright>)\<^sub>u \<in>\<^sub>u \<guillemotleft>R\<guillemotright>\<rbrace>X\<lbrace>\<not> b \<and> invar\<rbrace>\<^sub>u"
  show ?case
  proof (rule seq_hoare_rel [of _ _ "invar \<and> (e, \<guillemotleft>st\<guillemotright>)\<^sub>u \<in>\<^sub>u \<guillemotleft>R\<guillemotright>"], goal_cases)
    case 1
    then show ?case by (rule induct_step)
  next
    case 2
    then show ?case by (rule *)
  qed
next
  case (2 st X)
  then show ?case by rel_simp
qed

lemma while_lfp_invr_hoare_rel_minimal:
  assumes WF: "wf R"
  assumes seq_step: "`p \<Rightarrow> invar`"
  assumes induct_step:"\<And>st. \<lbrace>b \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright>\<rbrace>body\<lbrace>invar \<and>(e,\<guillemotleft>st\<guillemotright>)\<^sub>u\<in>\<^sub>u\<guillemotleft>R\<guillemotright>\<rbrace>\<^sub>u"
  shows "\<lbrace>p\<rbrace>invr invar while\<^sub>\<bottom> b do body od\<lbrace>\<not>b \<and> invar\<rbrace>\<^sub>u"
  unfolding while_lfp_invr_rel_def
  using assms while_lfp_hoare_rel_minimal
  by blast

lemma while_lfp_invr_vrt_hoare_rel_minimal:
  assumes WF: "wf R"
  assumes seq_step: "`p \<Rightarrow> invar`"
  assumes induct_step:"\<And>st. \<lbrace>b \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright>\<rbrace>body\<lbrace>invar \<and>(e,\<guillemotleft>st\<guillemotright>)\<^sub>u\<in>\<^sub>u\<guillemotleft>R\<guillemotright>\<rbrace>\<^sub>u"
  shows "\<lbrace>p\<rbrace>invr invar vrt \<guillemotleft>R\<guillemotright> while\<^sub>\<bottom> b do body od\<lbrace>\<not>b \<and> invar\<rbrace>\<^sub>u"
  unfolding while_lfp_invr_vrt_rel_def
  using assms while_lfp_hoare_rel_minimal
  by blast

lemma while_lfp_hoare_rel_consequence:
  assumes WF: "wf R"
  assumes seq_step: "`p \<Rightarrow> invar`"
  assumes PHI: "`\<not>b \<and> invar \<Rightarrow> q`"
  assumes I0': "\<And>st. `b \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright> \<Rightarrow> p' st`"
  assumes induct_step: "\<And>st. \<lbrace>p' st\<rbrace>body\<lbrace>q' st\<rbrace>\<^sub>u"
  assumes  I0: "\<And> st. `q' st \<Rightarrow> invar \<and>(e,\<guillemotleft>st\<guillemotright>)\<^sub>u\<in>\<^sub>u\<guillemotleft>R\<guillemotright> `"
  shows "\<lbrace>p\<rbrace>while\<^sub>\<bottom> b do body od\<lbrace>q\<rbrace>\<^sub>u"
  by (rule consequence_hoare_rel[OF seq_step _ PHI,
                                 OF while_lfp_hoare_rel_minimal[OF WF uimp_refl, of _ _ e],
                                 OF consequence_hoare_rel[OF I0' induct_step I0]])

lemma while_lfp_invr_hoare_rel_consequence:
  assumes WF: "wf R"
  assumes seq_step: "`p \<Rightarrow> invar`"
  assumes PHI: "`\<not>b \<and> invar \<Rightarrow> q`"
  assumes I0': "\<And>st. `b \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright> \<Rightarrow> p' st`"
  assumes induct_step: "\<And>st. \<lbrace>p' st\<rbrace>body\<lbrace>q' st\<rbrace>\<^sub>u"
  assumes  I0: "\<And> st. `q' st \<Rightarrow> invar \<and>(e,\<guillemotleft>st\<guillemotright>)\<^sub>u\<in>\<^sub>u\<guillemotleft>R\<guillemotright> `"
  shows "\<lbrace>p\<rbrace>invr invar while\<^sub>\<bottom> b do body od\<lbrace>q\<rbrace>\<^sub>u"
  unfolding while_lfp_invr_rel_def
  by (rule consequence_hoare_rel[OF seq_step _ PHI,
                                 OF while_lfp_hoare_rel_minimal[OF WF uimp_refl, of _ _ e],
                                 OF consequence_hoare_rel[OF I0' induct_step I0]])

lemma while_lfp_invr_vrt_hoare_rel_consequence:
  assumes WF: "wf R"
  assumes seq_step: "`p \<Rightarrow> invar`"
  assumes PHI: "`\<not>b \<and> invar \<Rightarrow> q`"
  assumes I0': "\<And>st. `b \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright> \<Rightarrow> p' st`"
  assumes induct_step: "\<And>st. \<lbrace>p' st\<rbrace>body\<lbrace>q' st\<rbrace>\<^sub>u"
  assumes  I0: "\<And> st. `q' st \<Rightarrow> invar \<and>(e,\<guillemotleft>st\<guillemotright>)\<^sub>u\<in>\<^sub>u\<guillemotleft>R\<guillemotright> `"
  shows "\<lbrace>p\<rbrace>invr invar vrt \<guillemotleft>R\<guillemotright> while\<^sub>\<bottom> b do body od\<lbrace>q\<rbrace>\<^sub>u"
  unfolding while_lfp_invr_vrt_rel_def
  by (rule consequence_hoare_rel[OF seq_step _ PHI,
                                 OF while_lfp_hoare_rel_minimal[OF WF uimp_refl, of _ _ e],
                                 OF consequence_hoare_rel[OF I0' induct_step I0]])

lemma while_lfp_hoare_rel_wp:
  assumes WF: "wf R"
  assumes PHI: "`\<not>b \<and> invar \<Rightarrow> q`"
  assumes I0': "\<And>st. `b \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright> \<Rightarrow> p' st`"
  assumes induct_step: "\<And>st. \<lbrace>p' st\<rbrace>body\<lbrace>invar \<and>(e,\<guillemotleft>st\<guillemotright>)\<^sub>u\<in>\<^sub>u\<guillemotleft>R\<guillemotright> \<rbrace>\<^sub>u"
  shows "\<lbrace>invar\<rbrace>while\<^sub>\<bottom> b do body od\<lbrace>q\<rbrace>\<^sub>u"
  by (rule consequence_hoare_rel[OF uimp_refl _ PHI,
                                 OF while_lfp_hoare_rel_minimal[OF WF uimp_refl, of _ _ e],
                                 OF consequence_hoare_rel[OF I0' induct_step uimp_refl]])

lemma while_lfp_invr_hoare_rel_wp:
  assumes WF: "wf R"
  assumes PHI: "`\<not>b \<and> invar \<Rightarrow> q`"
  assumes I0': "\<And>st. `b \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright> \<Rightarrow> p' st`"
  assumes induct_step: "\<And>st. \<lbrace>p' st\<rbrace>body\<lbrace>invar \<and>(e,\<guillemotleft>st\<guillemotright>)\<^sub>u\<in>\<^sub>u\<guillemotleft>R\<guillemotright> \<rbrace>\<^sub>u"
  shows "\<lbrace>invar\<rbrace>invr invar while\<^sub>\<bottom> b do body od\<lbrace>q\<rbrace>\<^sub>u"
  unfolding while_lfp_invr_rel_def
  by (rule consequence_hoare_rel[OF uimp_refl _ PHI,
                                 OF while_lfp_hoare_rel_minimal[OF WF uimp_refl, of _ _ e],
                                 OF consequence_hoare_rel[OF I0' induct_step uimp_refl]])

lemma while_lfp_invr_vrt_hoare_rel_wp:
  assumes WF: "wf R"
  assumes PHI: "`\<not>b \<and> invar \<Rightarrow> q`"
  assumes I0': "\<And>st. `b \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright> \<Rightarrow> p' st`"
  assumes induct_step: "\<And>st. \<lbrace>p' st\<rbrace>body\<lbrace>invar \<and>(e,\<guillemotleft>st\<guillemotright>)\<^sub>u\<in>\<^sub>u\<guillemotleft>R\<guillemotright> \<rbrace>\<^sub>u"
  shows "\<lbrace>invar\<rbrace>invr invar vrt \<guillemotleft>R\<guillemotright> while\<^sub>\<bottom> b do body od\<lbrace>q\<rbrace>\<^sub>u"
  unfolding while_lfp_invr_vrt_rel_def
  by (rule consequence_hoare_rel[OF uimp_refl _ PHI,
                                 OF while_lfp_hoare_rel_minimal[OF WF uimp_refl, of _ _ e],
                                 OF consequence_hoare_rel[OF I0' induct_step uimp_refl]])

lemma while_lfp_hoare_rel_sp:
  assumes WF: "wf R"
  assumes seq_step: "`p \<Rightarrow> invar`"
  assumes induct_step: "\<And>st. \<lbrace>b \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright>\<rbrace>body\<lbrace>q' st\<rbrace>\<^sub>u"
  assumes  I0: "\<And> st. `q' st \<Rightarrow> invar \<and>(e,\<guillemotleft>st\<guillemotright>)\<^sub>u\<in>\<^sub>u\<guillemotleft>R\<guillemotright> `"
  shows "\<lbrace>p\<rbrace>while\<^sub>\<bottom> b do body od\<lbrace>\<not>b \<and> invar\<rbrace>\<^sub>u"
  by (rule consequence_hoare_rel [OF seq_step _ uimp_refl,
                                  OF while_lfp_hoare_rel_minimal[OF WF uimp_refl, of _ _ e],
                                  OF consequence_hoare_rel[OF uimp_refl induct_step I0]])

lemma while_lfp_invr_hoare_rel_sp:
  assumes WF: "wf R"
  assumes seq_step: "`p \<Rightarrow> invar`"
  assumes induct_step: "\<And>st. \<lbrace>b \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright>\<rbrace>body\<lbrace>q' st\<rbrace>\<^sub>u"
  assumes  I0: "\<And> st. `q' st \<Rightarrow> invar \<and>(e,\<guillemotleft>st\<guillemotright>)\<^sub>u\<in>\<^sub>u\<guillemotleft>R\<guillemotright> `"
  shows "\<lbrace>p\<rbrace>invr invar while\<^sub>\<bottom> b do body od\<lbrace>\<not>b \<and> invar\<rbrace>\<^sub>u"
  unfolding while_lfp_invr_rel_def
  by (rule consequence_hoare_rel[OF seq_step _ uimp_refl,
                                 OF while_lfp_hoare_rel_minimal[OF WF uimp_refl, of _ _ e],
                                 OF consequence_hoare_rel[OF uimp_refl induct_step I0]])

lemma while_lfp_invr_vrt_hoare_rel_sp:
  assumes WF: "wf R"
  assumes seq_step: "`p \<Rightarrow> invar`"
  assumes induct_step: "\<And>st. \<lbrace>b \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright>\<rbrace>body\<lbrace>q' st\<rbrace>\<^sub>u"
  assumes  I0: "\<And> st. `q' st \<Rightarrow> invar \<and>(e,\<guillemotleft>st\<guillemotright>)\<^sub>u\<in>\<^sub>u\<guillemotleft>R\<guillemotright> `"
  shows "\<lbrace>p\<rbrace>invr invar vrt \<guillemotleft>R\<guillemotright> while\<^sub>\<bottom> b do body od\<lbrace>\<not>b \<and> invar\<rbrace>\<^sub>u"
  unfolding while_lfp_invr_vrt_rel_def
  by (rule consequence_hoare_rel[OF seq_step _ uimp_refl,
                                  OF while_lfp_hoare_rel_minimal[OF WF uimp_refl, of _ _ e],
                                  OF consequence_hoare_rel[OF uimp_refl induct_step I0]])

subsection {*Hoare for from_until_loop*}

lemma from_until_lfp_hoare_rel_minimal_partial:
  assumes seq_step:"\<lbrace>p\<rbrace>init\<lbrace>invar\<rbrace>\<^sub>u"
  assumes induct_step: "\<lbrace>\<not> exit \<and> invar\<rbrace> body\<lbrace>invar\<rbrace>\<^sub>u"
  shows "\<lbrace>p\<rbrace>from\<^sup>\<top> init until exit do body od\<lbrace>exit \<and> invar\<rbrace>\<^sub>u"
  unfolding from_until_gfp_rel_alt_def
  proof -
    have induct_step': "\<lbrace>invar \<and> \<not> exit\<rbrace>body\<lbrace>invar\<rbrace>\<^sub>u"
      by (metis assms(2) utp_pred_laws.inf.commute)
    have "`\<not> \<not> exit \<and> invar \<Rightarrow> invar \<and> exit`"
      by (simp add: utp_pred_laws.inf.commute)
    then have "\<lbrace>invar\<rbrace>while\<^sup>\<top> \<not> exit do body od\<lbrace>invar \<and> exit\<rbrace>\<^sub>u"
      using induct_step' by (metis (no_types) p_imp_p taut_true while_gfp_hoare_rel_wp_partial)
    then show "\<lbrace>p\<rbrace>init ;; while\<^sup>\<top> \<not> exit do body od\<lbrace>exit \<and> invar\<rbrace>\<^sub>u"
      by (metis (no_types) seq_hoare_rel seq_step utp_pred_laws.inf.commute)
  qed

lemma from_until_lfp_invr_hoare_rel_minimal_partial:
  assumes seq_step:"\<lbrace>p\<rbrace>init\<lbrace>invar\<rbrace>\<^sub>u"
  assumes induct_step: "\<lbrace>\<not> exit \<and> invar\<rbrace> body\<lbrace>invar\<rbrace>\<^sub>u"
  shows "\<lbrace>p\<rbrace>from\<^sup>\<top> init invr invar until exit do body od\<lbrace>exit \<and> invar\<rbrace>\<^sub>u"
  unfolding from_until_gfp_invr_rel_def
  by (auto intro!: assms from_until_lfp_hoare_rel_minimal_partial)

lemma from_until_gfp_hoare_rel_consequence_partial:
  assumes seq_step:"\<lbrace>p\<rbrace>init\<lbrace>invar\<rbrace>\<^sub>u"
  assumes PHI: "`exit \<and> invar \<Rightarrow> q `"
  assumes I0': "`invar \<and> \<not> exit \<Rightarrow> p'`"
  assumes induct_step: "\<lbrace>p'\<rbrace> body\<lbrace>q'\<rbrace>\<^sub>u"
  assumes I0: "`q' \<Rightarrow> invar`"
  shows "\<lbrace>p\<rbrace>from\<^sup>\<top> init until exit do body od\<lbrace>q\<rbrace>\<^sub>u"
  unfolding from_until_gfp_rel_alt_def
  proof -
    have PHI': "`\<not> \<not> exit \<and> invar \<Rightarrow> q`"
      by (metis PHI utp_pred_laws.double_compl)
    have "`invar \<Rightarrow> invar`"
      by (metis uimp_refl)
    then have "\<lbrace>invar\<rbrace>while\<^sup>\<top> \<not> exit do body od\<lbrace>q\<rbrace>\<^sub>u"
      using PHI' I0 I0' induct_step while_gfp_hoare_rel_consequence_partial by blast
    then show "\<lbrace>p\<rbrace>init ;; while\<^sup>\<top> \<not> exit do body od\<lbrace>q\<rbrace>\<^sub>u"
      using seq_hoare_rel seq_step by blast
  qed

lemma from_until_gfp_invr_hoare_rel_consequence_partial:
  assumes seq_step:"\<lbrace>p\<rbrace>init\<lbrace>invar\<rbrace>\<^sub>u"
  assumes PHI: "`exit \<and> invar \<Rightarrow> q `"
  assumes I0': "`invar \<and> \<not> exit \<Rightarrow> p'`"
  assumes induct_step: "\<lbrace>p'\<rbrace> body\<lbrace>q'\<rbrace>\<^sub>u"
  assumes I0: "`q' \<Rightarrow> invar`"
  shows "\<lbrace>p\<rbrace>from\<^sup>\<top> init invr invar until exit do body od\<lbrace>q\<rbrace>\<^sub>u"
  unfolding from_until_gfp_invr_rel_def
  by (auto intro!: assms from_until_gfp_hoare_rel_consequence_partial)

lemma from_until_gfp_hoare_rel_wp_partial:
  assumes seq_step:"\<lbrace>p\<rbrace>init\<lbrace>invar\<rbrace>\<^sub>u"
  assumes PHI: "`exit \<and> invar \<Rightarrow> q`"
  assumes I0': "`invar \<and> \<not> exit \<Rightarrow> p'`"
  assumes induct_step:"\<lbrace>p'\<rbrace> body\<lbrace>invar\<rbrace>\<^sub>u"
  shows "\<lbrace>p\<rbrace>from\<^sup>\<top> init until exit do body od\<lbrace>q\<rbrace>\<^sub>u"
  unfolding from_until_gfp_rel_alt_def
proof -
  have "\<lbrace>invar\<rbrace>while\<^sup>\<top> \<not> exit do body od\<lbrace>q\<rbrace>\<^sub>u"
    by (metis (no_types) I0' PHI induct_step utp_pred_laws.double_compl while_gfp_hoare_rel_wp_partial)
  then show "\<lbrace>p\<rbrace>init ;; while\<^sup>\<top> \<not> exit do body od\<lbrace>q\<rbrace>\<^sub>u"
    using seq_hoare_rel seq_step by blast
qed

lemma from_until_gfp_invr_hoare_rel_wp_partial:
  assumes seq_step:"\<lbrace>p\<rbrace>init\<lbrace>invar\<rbrace>\<^sub>u"
  assumes PHI: "`exit \<and> invar \<Rightarrow> q`"
  assumes I0': "`invar \<and> \<not> exit \<Rightarrow> p'`"
  assumes induct_step:"\<lbrace>p'\<rbrace>body\<lbrace>invar\<rbrace>\<^sub>u"
  shows "\<lbrace>p\<rbrace>from\<^sup>\<top> init invr invar until exit do body od\<lbrace>q\<rbrace>\<^sub>u"
  unfolding from_until_gfp_invr_rel_def
  by (auto intro!: assms from_until_gfp_hoare_rel_wp_partial)

lemma from_until_gfp_hoare_rel_sp_partial:
  assumes seq_step:"\<lbrace>p\<rbrace>init\<lbrace>invar\<rbrace>\<^sub>u"
  assumes PHI: "`exit \<and> invar \<Rightarrow> q`"
  assumes induct_step: "\<lbrace>invar \<and> \<not> exit\<rbrace> body\<lbrace>q'\<rbrace>\<^sub>u"
  assumes I0: "`q' \<Rightarrow> invar`"
  shows "\<lbrace>p\<rbrace>from\<^sup>\<top> init until exit do body od\<lbrace>exit \<and> invar\<rbrace>\<^sub>u"
  unfolding from_until_gfp_rel_alt_def
proof -
  have "\<lbrace>invar\<rbrace>while\<^sup>\<top> \<not> exit do body od\<lbrace>\<not> \<not> exit \<and> invar\<rbrace>\<^sub>u"
    by (metis I0 induct_step uimp_refl while_gfp_hoare_rel_sp_partial)
  then have "\<lbrace>invar\<rbrace>while\<^sup>\<top> \<not> exit do body od\<lbrace>exit \<and> invar\<rbrace>\<^sub>u"
    by (metis double_negation)
  then show "\<lbrace>p\<rbrace>init ;; while\<^sup>\<top> \<not> exit do body od\<lbrace>exit \<and> invar\<rbrace>\<^sub>u"
    by (metis seq_hoare_rel seq_step)
qed

lemma from_until_gfp_invr_hoare_rel_sp_partial:
  assumes seq_step:"\<lbrace>p\<rbrace>init\<lbrace>invar\<rbrace>\<^sub>u"
  assumes PHI: "`exit \<and> invar \<Rightarrow> q`"
  assumes induct_step: "\<lbrace>invar \<and> \<not> exit\<rbrace> body\<lbrace>q'\<rbrace>\<^sub>u"
  assumes I0: "`q' \<Rightarrow> invar`"
  shows "\<lbrace>p\<rbrace>from\<^sup>\<top> init invr invar until exit do body od\<lbrace>exit \<and> invar\<rbrace>\<^sub>u"
  unfolding  from_until_gfp_invr_rel_def
  by (auto intro!: assms from_until_gfp_hoare_rel_sp_partial)

lemma from_until_lfp_hoare_rel_minimal:
  assumes WF: "wf R"
  assumes seq_step: "\<lbrace>p\<rbrace>init\<lbrace>invar\<rbrace>\<^sub>u"
  assumes induct_step: "\<And>st. \<lbrace>\<not> exit \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright>\<rbrace>body\<lbrace>invar \<and>(e,\<guillemotleft>st\<guillemotright>)\<^sub>u\<in>\<^sub>u\<guillemotleft>R\<guillemotright>\<rbrace>\<^sub>u"
  shows "\<lbrace>p\<rbrace>from\<^sub>\<bottom> init until exit do body od\<lbrace>exit \<and> invar\<rbrace>\<^sub>u"
  unfolding from_until_lfp_rel_alt_def while_lfp_rel_def_alt
  by (rule seq_hoare_rel[OF seq_step,
                         OF mu_hoare_rel[OF WF if_rel_mono cond_hoare_rel, of _ e],
                         OF seq_hoare_rel[OF induct_step], OF _ skip_rel_hoare_rel_intro],
      rel_auto+)

lemma from_until_lfp_invr_hoare_rel_minimal:
  assumes WF: "wf R"
  assumes seq_step: "\<lbrace>p\<rbrace>init\<lbrace>invar\<rbrace>\<^sub>u"
  assumes induct_step: "\<And>st. \<lbrace>\<not> exit \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright>\<rbrace>body\<lbrace>invar \<and>(e,\<guillemotleft>st\<guillemotright>)\<^sub>u\<in>\<^sub>u\<guillemotleft>R\<guillemotright>\<rbrace>\<^sub>u"
  shows "\<lbrace>p\<rbrace>from\<^sub>\<bottom> init invr invar until exit do body od\<lbrace>exit \<and> invar\<rbrace>\<^sub>u"
  unfolding from_until_lfp_invr_rel_def
  using     from_until_lfp_hoare_rel_minimal [OF WF seq_step induct_step] .

lemma from_until_lfp_invr_vrt_hoare_rel_minimal:
  assumes WF: "wf R"
  assumes seq_step: "\<lbrace>p\<rbrace>init\<lbrace>invar\<rbrace>\<^sub>u"
  assumes induct_step: "\<And>st. \<lbrace>\<not> exit \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright>\<rbrace>body\<lbrace>invar \<and>(e,\<guillemotleft>st\<guillemotright>)\<^sub>u\<in>\<^sub>u\<guillemotleft>R\<guillemotright>\<rbrace>\<^sub>u"
  shows "\<lbrace>p\<rbrace>from\<^sub>\<bottom> init invr invar vrt \<guillemotleft>R\<guillemotright> until exit do body od\<lbrace>exit \<and> invar\<rbrace>\<^sub>u"
  unfolding from_until_lfp_invr_vrt_rel_def
  using     from_until_lfp_hoare_rel_minimal [OF WF seq_step induct_step] .

lemma from_until_lfp_hoare_rel_consequence:
  assumes WF: "wf R"
  assumes seq_step: "\<lbrace>p\<rbrace>init\<lbrace>invar\<rbrace>\<^sub>u"
  assumes PHI: "`exit \<and> invar \<Rightarrow> q`"
  assumes I0': "\<And>st. `\<not> exit \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright> \<Rightarrow> p' st`"
  assumes induct_step: "\<And>st. \<lbrace>p' st\<rbrace>body\<lbrace>q' st\<rbrace>\<^sub>u"
  assumes I0: "\<And>st. `q' st \<Rightarrow> invar \<and>(e,\<guillemotleft>st\<guillemotright>)\<^sub>u\<in>\<^sub>u\<guillemotleft>R\<guillemotright>`"
  shows "\<lbrace>p\<rbrace>from\<^sub>\<bottom> init until exit do body od\<lbrace>q\<rbrace>\<^sub>u"
  unfolding from_until_lfp_rel_alt_def
  by (simp add: PHI seq_hoare_rel[OF seq_step]
                while_lfp_hoare_rel_consequence[OF WF uimp_refl _ I0' induct_step I0])

lemma from_until_lfp_invr_hoare_rel_consequence:
  assumes WF: "wf R"
  assumes seq_step: "\<lbrace>p\<rbrace>init\<lbrace>invar\<rbrace>\<^sub>u"
  assumes PHI: "`exit \<and> invar \<Rightarrow> q`"
  assumes I0': "\<And>st. `\<not> exit \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright> \<Rightarrow> p' st`"
  assumes induct_step: "\<And>st. \<lbrace>p' st\<rbrace>body\<lbrace>q' st\<rbrace>\<^sub>u"
  assumes I0: "\<And>st. `q' st \<Rightarrow> invar \<and>(e,\<guillemotleft>st\<guillemotright>)\<^sub>u\<in>\<^sub>u\<guillemotleft>R\<guillemotright>`"
  shows "\<lbrace>p\<rbrace>from\<^sub>\<bottom> init invr invar until exit do body od\<lbrace>q\<rbrace>\<^sub>u"
  unfolding from_until_lfp_invr_rel_def
  using     from_until_lfp_hoare_rel_consequence [OF WF seq_step PHI I0' induct_step I0].

lemma from_until_lfp_invr_vrt_hoare_rel_consequence:
  assumes WF: "wf R"
  assumes seq_step: "\<lbrace>p\<rbrace>init\<lbrace>invar\<rbrace>\<^sub>u"
  assumes PHI: "`exit \<and> invar \<Rightarrow> q`"
  assumes I0': "\<And>st. `\<not> exit \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright> \<Rightarrow> p' st`"
  assumes induct_step: "\<And>st. \<lbrace>p' st\<rbrace>body\<lbrace>q' st\<rbrace>\<^sub>u"
  assumes I0: "\<And>st. `q' st \<Rightarrow> invar \<and>(e,\<guillemotleft>st\<guillemotright>)\<^sub>u\<in>\<^sub>u\<guillemotleft>R\<guillemotright>`"
  shows "\<lbrace>p\<rbrace>from\<^sub>\<bottom> init invr invar vrt \<guillemotleft>R\<guillemotright> until exit do body od\<lbrace>q\<rbrace>\<^sub>u"
  unfolding from_until_lfp_invr_vrt_rel_def
  using     from_until_lfp_hoare_rel_consequence [OF WF seq_step PHI I0' induct_step I0].

lemma from_until_lfp_hoare_rel_wp:
  assumes WF: "wf R"
  assumes seq_step: "\<lbrace>p\<rbrace>init\<lbrace>invar\<rbrace>\<^sub>u"
  assumes PHI: "`exit \<and> invar \<Rightarrow> q`"
  assumes I0': "\<And>st. `\<not> exit \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright> \<Rightarrow> p' st`"
  assumes induct_step: "\<And>st. \<lbrace>p' st\<rbrace>body\<lbrace>invar \<and>(e,\<guillemotleft>st\<guillemotright>)\<^sub>u\<in>\<^sub>u\<guillemotleft>R\<guillemotright>\<rbrace>\<^sub>u"
  shows "\<lbrace>p\<rbrace>from\<^sub>\<bottom> init until exit do body od\<lbrace>q\<rbrace>\<^sub>u"
  unfolding from_until_lfp_rel_alt_def
  by (simp add: PHI seq_hoare_rel[OF seq_step]
                while_lfp_hoare_rel_consequence[OF WF uimp_refl _ I0' induct_step uimp_refl])

lemma from_until_lfp_invr_hoare_rel_wp:
  assumes WF: "wf R"
  assumes seq_step: "\<lbrace>p\<rbrace>init\<lbrace>invar\<rbrace>\<^sub>u"
  assumes PHI: "`exit \<and> invar \<Rightarrow> q`"
  assumes I0': "\<And>st. `\<not> exit \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright> \<Rightarrow> p' st`"
  assumes induct_step: "\<And>st. \<lbrace>p' st\<rbrace>body\<lbrace>invar \<and>(e,\<guillemotleft>st\<guillemotright>)\<^sub>u\<in>\<^sub>u\<guillemotleft>R\<guillemotright>\<rbrace>\<^sub>u"
  shows "\<lbrace>p\<rbrace>from\<^sub>\<bottom> init invr invar until exit do body od\<lbrace>q\<rbrace>\<^sub>u"
  unfolding from_until_lfp_invr_rel_def
  using from_until_lfp_hoare_rel_wp [OF WF seq_step PHI I0' induct_step] .

lemma from_until_lfp_invr_vrt_hoare_rel_wp:
  assumes WF: "wf R"
  assumes seq_step: "\<lbrace>p\<rbrace>init\<lbrace>invar\<rbrace>\<^sub>u"
  assumes PHI: "`exit \<and> invar \<Rightarrow> q`"
  assumes I0': "\<And>st. `\<not> exit \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright> \<Rightarrow> p' st`"
  assumes induct_step: "\<And>st. \<lbrace>p' st\<rbrace>body\<lbrace>invar \<and>(e,\<guillemotleft>st\<guillemotright>)\<^sub>u\<in>\<^sub>u\<guillemotleft>R\<guillemotright>\<rbrace>\<^sub>u"
  shows "\<lbrace>p\<rbrace>from\<^sub>\<bottom> init invr invar vrt \<guillemotleft>R\<guillemotright> until exit do body od\<lbrace>q\<rbrace>\<^sub>u"
  unfolding from_until_lfp_invr_vrt_rel_def
  using from_until_lfp_hoare_rel_wp[OF WF seq_step PHI I0' induct_step] .

lemma from_until_lfp_hoare_rel_sp:
  assumes WF: "wf R"
  assumes seq_step: "\<lbrace>p\<rbrace>init\<lbrace>q''\<rbrace>\<^sub>u"
  assumes I0': "`q'' \<Rightarrow> invar`"
  assumes induct_step: "\<And>st. \<lbrace>\<not> exit \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright>\<rbrace>body\<lbrace>q' st\<rbrace>\<^sub>u"
  assumes I0: "\<And>st. `q' st \<Rightarrow> invar \<and>(e,\<guillemotleft>st\<guillemotright>)\<^sub>u\<in>\<^sub>u\<guillemotleft>R\<guillemotright>`"
  shows "\<lbrace>p\<rbrace>from\<^sub>\<bottom> init until exit do body od\<lbrace>exit \<and> invar\<rbrace>\<^sub>u"
  unfolding from_until_lfp_rel_alt_def
  by (simp add: uimp_refl seq_hoare_rel[OF seq_step] pre_str_hoare_rel[OF I0']
                while_lfp_hoare_rel_consequence[OF WF uimp_refl _ uimp_refl induct_step I0])

lemma from_until_lfp_invr_hoare_rel_sp:
  assumes WF: "wf R"
  assumes seq_step: "\<lbrace>p\<rbrace>init\<lbrace>q''\<rbrace>\<^sub>u"
  assumes I0': "`q'' \<Rightarrow> invar`"
  assumes induct_step: "\<And>st. \<lbrace>\<not> exit \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright>\<rbrace>body\<lbrace>q' st\<rbrace>\<^sub>u"
  assumes I0: "\<And>st. `q' st \<Rightarrow> invar \<and>(e,\<guillemotleft>st\<guillemotright>)\<^sub>u\<in>\<^sub>u\<guillemotleft>R\<guillemotright>`"
  shows "\<lbrace>p\<rbrace>from\<^sub>\<bottom> init invr invar until exit do body od\<lbrace>exit \<and> invar\<rbrace>\<^sub>u"
  unfolding from_until_lfp_invr_rel_def
  using from_until_lfp_hoare_rel_sp[OF WF seq_step I0' induct_step I0] .

lemma from_until_lfp_invr_vrt_hoare_rel_sp:
  assumes WF: "wf R"
  assumes seq_step: "\<lbrace>p\<rbrace>init\<lbrace>q''\<rbrace>\<^sub>u"
   assumes I0': "`q'' \<Rightarrow> invar`"
  assumes induct_step: "\<And>st. \<lbrace>\<not> exit \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright>\<rbrace>body\<lbrace>q' st\<rbrace>\<^sub>u"
  assumes I0: "\<And>st. `q' st \<Rightarrow> invar \<and>(e,\<guillemotleft>st\<guillemotright>)\<^sub>u\<in>\<^sub>u\<guillemotleft>R\<guillemotright>`"
  shows "\<lbrace>p\<rbrace>from\<^sub>\<bottom> init invr invar vrt \<guillemotleft>R\<guillemotright> until exit do body od\<lbrace>exit \<and> invar\<rbrace>\<^sub>u"
  unfolding from_until_lfp_invr_vrt_rel_def
  using from_until_lfp_hoare_rel_sp[OF WF seq_step I0' induct_step I0] .

subsection {*Hoare for do_while_loop*}

lemma do_while_gfp_hoare_rel_minimal_partial:
  assumes seq_step:"\<lbrace>p\<rbrace>body\<lbrace>invar\<rbrace>\<^sub>u"
  assumes induct_step: "\<lbrace>b \<and> invar\<rbrace>body\<lbrace>invar\<rbrace>\<^sub>u"
  shows "\<lbrace>p\<rbrace>do body while\<^sup>\<top> b od\<lbrace>\<not>b \<and> invar\<rbrace>\<^sub>u"
  unfolding do_while_gfp_rel_alt_def
  proof -
    have "\<lbrace>invar\<rbrace>while\<^sup>\<top> b do body od\<lbrace>invar \<and> \<not> b\<rbrace>\<^sub>u"
      by (metis (no_types) assms(2) conj_comm p_imp_p taut_true while_gfp_hoare_rel_wp_partial)
    then show "\<lbrace>p\<rbrace>body ;; while\<^sup>\<top> b do body od\<lbrace>\<not> b \<and> invar\<rbrace>\<^sub>u"
      by (metis (no_types) conj_comm seq_hoare_rel seq_step)
  qed

lemma do_while_gfp_invr_hoare_rel_minimal_partial:
  assumes seq_step:"\<lbrace>p\<rbrace>body\<lbrace>invar\<rbrace>\<^sub>u"
  assumes induct_step: "\<lbrace>b \<and> invar\<rbrace>body\<lbrace>invar\<rbrace>\<^sub>u"
  shows "\<lbrace>p\<rbrace>do body while\<^sup>\<top> b invr invar od\<lbrace>\<not>b \<and> invar\<rbrace>\<^sub>u"
  unfolding do_while_gfp_invr_rel_def
  by (simp add: from_until_lfp_hoare_rel_minimal_partial induct_step seq_step)

lemma do_while_gfp_hoare_rel_consequence_partial:
  assumes seq_step: "\<lbrace>p\<rbrace>body\<lbrace>invar\<rbrace>\<^sub>u"
  assumes PHI: "`\<not>b \<and> invar \<Rightarrow> q`"
  assumes I0': "`b \<and> invar \<Rightarrow> p'`"
  assumes induct_step: "\<lbrace>p'\<rbrace>body\<lbrace>q'\<rbrace>\<^sub>u"
  assumes I0: "`q' \<Rightarrow> invar`"
  shows "\<lbrace>p\<rbrace>do body while\<^sup>\<top> b od\<lbrace>q\<rbrace>\<^sub>u"
proof -
  have "`invar \<and> \<not> \<not> b \<Rightarrow> p'`"
    by (simp add: I0' utp_pred_laws.inf_commute)
  then have "\<lbrace>p\<rbrace>from\<^sup>\<top> body until \<not> b do body od\<lbrace>q\<rbrace>\<^sub>u"
    using I0 PHI from_until_gfp_hoare_rel_consequence_partial induct_step seq_step by blast
  then show ?thesis
    by (metis do_while_gfp_rel_def)
qed

lemma do_while_gfp_invr_hoare_rel_consequence_partial:
  assumes seq_step: "\<lbrace>p\<rbrace>body\<lbrace>invar\<rbrace>\<^sub>u"
  assumes PHI: "`\<not>b \<and> invar \<Rightarrow> q`"
  assumes I0': "`b \<and> invar \<Rightarrow> p'`"
  assumes induct_step: "\<lbrace>p'\<rbrace>body\<lbrace>q'\<rbrace>\<^sub>u"
  assumes I0: "`q' \<Rightarrow> invar`"
  shows "\<lbrace>p\<rbrace>do body while\<^sup>\<top> b invr invar od\<lbrace>q\<rbrace>\<^sub>u"
  unfolding do_while_gfp_invr_rel_def
  proof -
    have "`invar \<and> \<not> \<not> b \<Rightarrow> p'`"
      by (simp add: I0' utp_pred_laws.inf_commute)
    then show "\<lbrace>p\<rbrace>from\<^sup>\<top> body until \<not> b do body od\<lbrace>q\<rbrace>\<^sub>u"
      using I0 PHI from_until_gfp_hoare_rel_consequence_partial induct_step seq_step by blast
  qed

lemma do_while_gfp_hoare_rel_wp_partial:
  assumes seq_step: "\<lbrace>invar\<rbrace>body\<lbrace>invar\<rbrace>\<^sub>u"
  assumes PHI: "`\<not>b \<and> invar \<Rightarrow> q`"
  assumes induct_step: "\<lbrace>b \<and> invar\<rbrace>body\<lbrace>invar\<rbrace>\<^sub>u"
  shows "\<lbrace>invar\<rbrace>do body while\<^sup>\<top> b od\<lbrace>q\<rbrace>\<^sub>u"
  unfolding do_while_gfp_rel_alt_def
  using PHI reverse_impl_refine seq_hoare_rel seq_step utp_pred_laws.inf.cobounded2
        while_gfp_hoare_rel_wp_partial
  by fastforce

lemma do_while_gfp_invr_hoare_rel_wp_partial:
  assumes seq_step: "\<lbrace>invar\<rbrace>body\<lbrace>invar\<rbrace>\<^sub>u"
  assumes PHI: "`\<not>b \<and> invar \<Rightarrow> q`"
  assumes induct_step: "\<lbrace>b \<and> invar\<rbrace>body\<lbrace>invar\<rbrace>\<^sub>u"
  shows "\<lbrace>invar\<rbrace>do body while\<^sup>\<top> b invr invar od\<lbrace>q\<rbrace>\<^sub>u"
  unfolding do_while_gfp_invr_rel_def
  using PHI from_until_gfp_hoare_rel_wp_partial reverse_impl_refine seq_step utp_pred_laws.inf_le1
  by blast

lemma do_while_gfp_hoare_rel_sp_partial:
  assumes seq_step: "\<lbrace>p\<rbrace>body\<lbrace>invar\<rbrace>\<^sub>u"
  assumes induct_step: "\<lbrace>b \<and> invar\<rbrace>body\<lbrace>q'\<rbrace>\<^sub>u"
  assumes I0: "`q' \<Rightarrow> invar`"
  shows "\<lbrace>p\<rbrace>do body while\<^sup>\<top> b od\<lbrace>\<not>b \<and> invar\<rbrace>\<^sub>u"
  unfolding do_while_gfp_rel_alt_def
  proof -
    have "\<lbrace>invar \<and> b\<rbrace>body\<lbrace>q'\<rbrace>\<^sub>u"
      by (metis conj_comm induct_step)
    then show "\<lbrace>p\<rbrace>body ;; while\<^sup>\<top> b do body od\<lbrace>\<not> b \<and> invar\<rbrace>\<^sub>u"
      by (meson I0 seq_hoare_rel seq_step uimp_refl while_gfp_hoare_rel_sp_partial)
  qed

lemma do_while_gfp_invr_hoare_rel_sp_partial:
  assumes seq_step: "\<lbrace>p\<rbrace>body\<lbrace>invar\<rbrace>\<^sub>u"
  assumes induct_step: "\<lbrace>b \<and> invar\<rbrace>body\<lbrace>q'\<rbrace>\<^sub>u"
  assumes I0: "`q' \<Rightarrow> invar`"
  shows "\<lbrace>p\<rbrace>do body while\<^sup>\<top> b invr invar od\<lbrace>\<not>b \<and> invar\<rbrace>\<^sub>u"
  unfolding do_while_gfp_rel_alt_def
  using I0 do_while_gfp_invr_hoare_rel_minimal_partial induct_step post_weak_hoare_rel seq_step
  by blast

lemma do_while_lfp_hoare_rel_minimal:
  assumes WF: "wf R"
  assumes seq_step: "\<lbrace>p\<rbrace>body\<lbrace>invar\<rbrace>\<^sub>u"
  assumes induct_step: "\<And> st. \<lbrace>b \<and> invar \<and>  e =\<^sub>u \<guillemotleft>st\<guillemotright>\<rbrace>body\<lbrace>invar \<and> (e, \<guillemotleft>st\<guillemotright>)\<^sub>u \<in>\<^sub>u \<guillemotleft>R\<guillemotright>\<rbrace>\<^sub>u"
  shows "\<lbrace>p\<rbrace>do body while\<^sub>\<bottom> b od\<lbrace>\<not>b \<and> invar\<rbrace>\<^sub>u"
  unfolding do_while_lfp_rel_alt_def
  by (rule seq_hoare_rel[OF seq_step while_lfp_hoare_rel_minimal[OF WF uimp_refl induct_step]])

lemma do_while_lfp_invr_hoare_rel_minimal:
  assumes WF: "wf R"
  assumes seq_step: "\<lbrace>p\<rbrace>body\<lbrace>invar\<rbrace>\<^sub>u"
  assumes induct_step: "\<And> st. \<lbrace>b \<and> invar \<and>  e =\<^sub>u \<guillemotleft>st\<guillemotright>\<rbrace>body\<lbrace>invar \<and> (e, \<guillemotleft>st\<guillemotright>)\<^sub>u \<in>\<^sub>u \<guillemotleft>R\<guillemotright>\<rbrace>\<^sub>u"
  shows" \<lbrace>p\<rbrace>do body while\<^sub>\<bottom> b invr invar od\<lbrace>\<not>b \<and> invar\<rbrace>\<^sub>u"
  unfolding do_while_lfp_invr_rel_def
  by (auto intro!: induct_step from_until_lfp_hoare_rel_minimal[OF WF seq_step ])

lemma do_while_lfp_invr_vrt_hoare_rel_minimal:
  assumes WF: "wf R"
  assumes seq_step: "\<lbrace>p\<rbrace>body\<lbrace>invar\<rbrace>\<^sub>u"
  assumes induct_step: "\<And> st. \<lbrace>b \<and> invar \<and>  e =\<^sub>u \<guillemotleft>st\<guillemotright>\<rbrace>body\<lbrace>invar \<and> (e, \<guillemotleft>st\<guillemotright>)\<^sub>u \<in>\<^sub>u \<guillemotleft>R\<guillemotright>\<rbrace>\<^sub>u"
  shows" \<lbrace>p\<rbrace>do body while\<^sub>\<bottom> b invr invar vrt \<guillemotleft>R\<guillemotright> od\<lbrace>\<not>b \<and> invar\<rbrace>\<^sub>u"
  unfolding do_while_lfp_invr_vrt_rel_def
  by (auto intro!: induct_step from_until_lfp_hoare_rel_minimal[OF WF seq_step ])

lemma do_while_lfp_hoare_rel_consequence:
  assumes WF: "wf R"
  assumes seq_step: "\<lbrace>p\<rbrace>body\<lbrace>invar\<rbrace>\<^sub>u"
  assumes PHI : "`\<not>b  \<and> invar \<Rightarrow> q`"
  assumes I0': "\<And>st. `b \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright> \<Rightarrow> p' st`"
  assumes induct_step: "\<And> st. \<lbrace>p' st\<rbrace>body\<lbrace>q' st\<rbrace>\<^sub>u"
  assumes I0: "\<And>st. `q' st \<Rightarrow> invar \<and> (e, \<guillemotleft>st\<guillemotright>)\<^sub>u \<in>\<^sub>u \<guillemotleft>R\<guillemotright>`"
  shows "\<lbrace>p\<rbrace>do body while\<^sub>\<bottom> b od\<lbrace>q\<rbrace>\<^sub>u"
  unfolding do_while_lfp_rel_alt_def
  by (rule seq_hoare_rel[OF seq_step
                            while_lfp_hoare_rel_consequence[OF WF uimp_refl PHI I0' induct_step I0]])

lemma do_while_lfp_invr_hoare_rel_consequence:
  assumes WF: "wf R"
  assumes seq_step: "\<lbrace>p\<rbrace>body\<lbrace>invar\<rbrace>\<^sub>u"
  assumes PHI : "`\<not>b  \<and> invar \<Rightarrow> q`"
  assumes I0': "\<And>st. `b \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright> \<Rightarrow> p' st`"
  assumes induct_step: "\<And> st. \<lbrace>p' st\<rbrace>body\<lbrace>q' st\<rbrace>\<^sub>u"
  assumes I0: "\<And>st. `q' st \<Rightarrow> invar \<and> (e, \<guillemotleft>st\<guillemotright>)\<^sub>u \<in>\<^sub>u \<guillemotleft>R\<guillemotright>`"
  shows "\<lbrace>p\<rbrace>do body while\<^sub>\<bottom> b invr invar  od\<lbrace>q\<rbrace>\<^sub>u"
  unfolding do_while_lfp_invr_rel_def
  by (auto intro!: assms from_until_lfp_hoare_rel_consequence[OF WF seq_step])

lemma do_while_lfp_invr_vrt_hoare_rel_consequence:
  assumes WF: "wf R"
  assumes seq_step: "\<lbrace>p\<rbrace>body\<lbrace>invar\<rbrace>\<^sub>u"
  assumes PHI : "`\<not>b  \<and> invar \<Rightarrow> q`"
  assumes I0': "\<And>st. `b \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright> \<Rightarrow> p' st`"
  assumes induct_step: "\<And> st. \<lbrace>p' st\<rbrace>body\<lbrace>q' st\<rbrace>\<^sub>u"
  assumes I0: "\<And>st. `q' st \<Rightarrow> invar \<and> (e, \<guillemotleft>st\<guillemotright>)\<^sub>u \<in>\<^sub>u \<guillemotleft>R\<guillemotright>`"
  shows "\<lbrace>p\<rbrace>do body while\<^sub>\<bottom> b invr invar vrt \<guillemotleft>R\<guillemotright> od\<lbrace>q\<rbrace>\<^sub>u"
  unfolding do_while_lfp_invr_vrt_rel_def
  by (auto intro!: assms from_until_lfp_hoare_rel_consequence[OF WF seq_step])

lemma do_while_lfp_hoare_rel_wp:
  assumes WF: "wf R"
  assumes seq_step: "\<lbrace>invar\<rbrace>body\<lbrace>invar\<rbrace>\<^sub>u"
  assumes PHI : "`\<not>b  \<and> invar \<Rightarrow> q`"
  assumes I0': "\<And>st. `b \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright> \<Rightarrow> p' st`"
  assumes induct_step: "\<And> st. \<lbrace>p' st\<rbrace>body\<lbrace>invar \<and> (e, \<guillemotleft>st\<guillemotright>)\<^sub>u \<in>\<^sub>u \<guillemotleft>R\<guillemotright>\<rbrace>\<^sub>u"
  shows "\<lbrace>invar\<rbrace>do body while\<^sub>\<bottom> b od\<lbrace>q\<rbrace>\<^sub>u"
  unfolding do_while_lfp_rel_alt_def
  by (simp add: uimp_refl seq_hoare_rel[OF seq_step]
                while_lfp_hoare_rel_wp[OF WF PHI I0' induct_step])

lemma do_while_lfp_invr_hoare_rel_wp:
  assumes WF: "wf R"
  assumes seq_step: "\<lbrace>invar\<rbrace>body\<lbrace>invar\<rbrace>\<^sub>u"
  assumes PHI : "`\<not>b \<and> invar \<Rightarrow> q`"
  assumes I0': "\<And>st. `b \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright> \<Rightarrow> p' st`"
  assumes induct_step: "\<And> st. \<lbrace>p' st\<rbrace>body\<lbrace>invar \<and> (e, \<guillemotleft>st\<guillemotright>)\<^sub>u \<in>\<^sub>u \<guillemotleft>R\<guillemotright>\<rbrace>\<^sub>u"
  shows "\<lbrace>invar\<rbrace>do body while\<^sub>\<bottom> b invr invar od\<lbrace>q\<rbrace>\<^sub>u"
  unfolding do_while_lfp_invr_rel_def do_while_lfp_rel_alt_def
  by (auto intro!: assms from_until_lfp_hoare_rel_wp)

lemma do_while_lfp_invr_vrt_hoare_rel_wp:
  assumes WF: "wf R"
  assumes seq_step: "\<lbrace>invar\<rbrace>body\<lbrace>invar\<rbrace>\<^sub>u"
  assumes PHI : "`\<not>b \<and> invar \<Rightarrow> q`"
  assumes I0': "\<And>st. `b \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright> \<Rightarrow> p' st`"
  assumes induct_step: "\<And> st. \<lbrace>p' st\<rbrace>body\<lbrace>invar \<and> (e, \<guillemotleft>st\<guillemotright>)\<^sub>u \<in>\<^sub>u \<guillemotleft>R\<guillemotright>\<rbrace>\<^sub>u"
  shows "\<lbrace>invar\<rbrace>do body while\<^sub>\<bottom> b invr invar vrt \<guillemotleft>R\<guillemotright> od\<lbrace>q\<rbrace>\<^sub>u"
  unfolding do_while_lfp_invr_vrt_rel_def do_while_lfp_invr_rel_def do_while_lfp_rel_alt_def
  by (auto intro!: assms from_until_lfp_hoare_rel_wp)

lemma do_while_lfp_hoare_rel_sp:
  assumes WF: "wf R"
  assumes seq_step: "\<lbrace>p\<rbrace>body\<lbrace>q''\<rbrace>\<^sub>u"
  assumes I0': "`q'' \<Rightarrow> invar`"
  assumes induct_step: "\<And> st. \<lbrace>b \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright>\<rbrace>body\<lbrace>q' st\<rbrace>\<^sub>u"
  assumes I0: "\<And>st. `q' st \<Rightarrow> invar \<and> (e, \<guillemotleft>st\<guillemotright>)\<^sub>u \<in>\<^sub>u \<guillemotleft>R\<guillemotright>`"
  shows "\<lbrace>p\<rbrace>do body while\<^sub>\<bottom> b od\<lbrace>\<not>b  \<and> invar\<rbrace>\<^sub>u"
  unfolding  do_while_lfp_rel_alt_def
  by (simp add: uimp_refl seq_hoare_rel[OF seq_step] pre_str_hoare_rel[OF I0']
                while_lfp_hoare_rel_sp[OF WF uimp_refl induct_step I0])

lemma do_while_lfp_invr_hoare_rel_sp:
  assumes WF: "wf R"
  assumes seq_step: "\<lbrace>p\<rbrace>body\<lbrace>q''\<rbrace>\<^sub>u"
  assumes I0': "`q'' \<Rightarrow> invar`"
  assumes induct_step: "\<And> st. \<lbrace>b \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright>\<rbrace>body\<lbrace>q' st\<rbrace>\<^sub>u"
  assumes I0: "\<And>st. `q' st \<Rightarrow> invar \<and> (e, \<guillemotleft>st\<guillemotright>)\<^sub>u \<in>\<^sub>u \<guillemotleft>R\<guillemotright>`"
  shows "\<lbrace>p\<rbrace>do body  while\<^sub>\<bottom> b invr invar od \<lbrace>\<not>b  \<and> invar\<rbrace>\<^sub>u"
  unfolding do_while_lfp_invr_vrt_rel_def do_while_lfp_invr_rel_def do_while_lfp_rel_alt_def
  by (auto intro!: assms from_until_lfp_hoare_rel_sp)

lemma do_while_lfp_invr_vrt_hoare_rel_sp:
  assumes WF: "wf R"
  assumes seq_step: "\<lbrace>p\<rbrace>body\<lbrace>q''\<rbrace>\<^sub>u"
  assumes I0': "`q'' \<Rightarrow> invar`"
  assumes induct_step: "\<And> st. \<lbrace>b \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright>\<rbrace>body\<lbrace>q' st\<rbrace>\<^sub>u"
  assumes I0: "\<And>st. `q' st \<Rightarrow> invar \<and> (e, \<guillemotleft>st\<guillemotright>)\<^sub>u \<in>\<^sub>u \<guillemotleft>R\<guillemotright>`"
  shows "\<lbrace>p\<rbrace>do body while\<^sub>\<bottom> b invr invar vrt \<guillemotleft>R\<guillemotright> od\<lbrace>\<not>b  \<and> invar\<rbrace>\<^sub>u"
  unfolding do_while_lfp_invr_vrt_rel_def do_while_lfp_rel_alt_def
  by (auto intro!: assms from_until_lfp_hoare_rel_sp)

subsection {*Hoare for for_loop*}

lemma for_hoare_gfp_rel_minimal_partial:
  assumes seq_step:"\<lbrace>p\<rbrace>init\<lbrace>invar\<rbrace>\<^sub>u"
  assumes induct_step: "\<lbrace>b \<and> invar\<rbrace>body;;incr\<lbrace>invar\<rbrace>\<^sub>u"
  shows "\<lbrace>p\<rbrace>for\<^sup>\<top> (init, b, incr) do body od\<lbrace>\<not>b \<and> invar\<rbrace>\<^sub>u"
  unfolding for_gfp_rel_alt_def
proof -
  have "\<lbrace>invar\<rbrace>while\<^sup>\<top> b do body ;; incr od\<lbrace>invar \<and> \<not> b\<rbrace>\<^sub>u"
    by (metis (no_types) assms(2) p_imp_p taut_true utp_pred_laws.inf_commute while_gfp_hoare_rel_wp_partial)
  then show "\<lbrace>p\<rbrace>init ;; while\<^sup>\<top> b do body ;; incr od\<lbrace>\<not> b \<and> invar\<rbrace>\<^sub>u"
    by (metis (no_types) seq_hoare_rel seq_step utp_pred_laws.inf_commute)
qed

lemma for_gfp_invr_hoare_rel_minimal_partial:
  assumes seq_step:"\<lbrace>p\<rbrace>init\<lbrace>invar\<rbrace>\<^sub>u"
  assumes induct_step: "\<lbrace>b \<and> invar\<rbrace>body;;incr\<lbrace>invar\<rbrace>\<^sub>u"
  shows "\<lbrace>p\<rbrace>for\<^sup>\<top> (init, b, incr) invr invar do body od\<lbrace>\<not>b \<and> invar\<rbrace>\<^sub>u"
  by (simp add: for_gfp_invr_rel_def from_until_lfp_hoare_rel_minimal_partial induct_step seq_step)

lemma for_gfp_hoare_rel_consequence_partial:
  assumes seq_step:"\<lbrace>p\<rbrace>init\<lbrace>invar\<rbrace>\<^sub>u"
  assumes PHI: "`\<not>b \<and> invar \<Rightarrow> q`"
  assumes I0': "`b \<and> invar \<Rightarrow> p'`"
  assumes induct_step: "\<lbrace>p'\<rbrace>body;;incr\<lbrace>q'\<rbrace>\<^sub>u"
  assumes I0: "`q'\<Rightarrow> invar`"
  shows "\<lbrace>p\<rbrace>for\<^sup>\<top> (init, b, incr) do body od\<lbrace>q\<rbrace>\<^sub>u"
proof -
  have "`invar \<and> \<not> \<not> b \<Rightarrow> p'`"
    by (metis I0' conj_comm double_negation)
  then have "\<lbrace>p\<rbrace>from\<^sup>\<top> init until \<not> b do body ;; incr od\<lbrace>q\<rbrace>\<^sub>u"
    by (meson I0 PHI from_until_gfp_hoare_rel_consequence_partial induct_step seq_step)
  then show ?thesis
    by (metis for_gfp_rel_def)
qed

lemma for_gfp_invr_hoare_rel_consequence_partial:
  assumes seq_step:"\<lbrace>p\<rbrace>init\<lbrace>invar\<rbrace>\<^sub>u"
  assumes PHI: "`\<not>b \<and> invar \<Rightarrow> q`"
  assumes I0': "`b \<and> invar \<Rightarrow> p'`"
  assumes induct_step: "\<lbrace>p'\<rbrace>body;;incr\<lbrace>q'\<rbrace>\<^sub>u"
  assumes I0: "`q'\<Rightarrow> invar`"
  shows "\<lbrace>p\<rbrace>for\<^sup>\<top> (init, b, incr) invr invar  do body od\<lbrace>q\<rbrace>\<^sub>u"
  using I0 I0' PHI consequence_hoare_rel for_gfp_invr_hoare_rel_minimal_partial induct_step
        post_weak_hoare_rel seq_step
  by blast

lemma for_gfp_hoare_rel_wp_partial:
  assumes seq_step:"\<lbrace>p\<rbrace>init\<lbrace>invar\<rbrace>\<^sub>u"
  assumes PHI: "`\<not>b \<and> invar \<Rightarrow> q`"
  assumes I0': "`b \<and> invar \<Rightarrow> p'`"
  assumes induct_step: "\<lbrace>p'\<rbrace>body;;incr\<lbrace>invar\<rbrace>\<^sub>u"
  shows "\<lbrace>p\<rbrace>for\<^sup>\<top> (init, b, incr) do body od\<lbrace>q\<rbrace>\<^sub>u"
  using I0' PHI for_gfp_hoare_rel_consequence_partial induct_step seq_step uimp_refl
  by blast

lemma for_gfp_invr_hoare_rel_wp_partial:
  assumes seq_step:"\<lbrace>p\<rbrace>init\<lbrace>invar\<rbrace>\<^sub>u"
  assumes PHI: "`\<not>b \<and> invar \<Rightarrow> q`"
  assumes I0': "`b \<and> invar \<Rightarrow> p'`"
  assumes induct_step: "\<lbrace>p'\<rbrace>body;;incr\<lbrace>invar\<rbrace>\<^sub>u"
  shows "\<lbrace>p\<rbrace>for\<^sup>\<top> (init, b, incr) invr invar do body od\<lbrace>q\<rbrace>\<^sub>u"
  using I0' PHI for_gfp_invr_hoare_rel_consequence_partial induct_step seq_step uimp_refl
  by blast

lemma for_gfp_hoare_rel_sp_partial:
  assumes seq_step:"\<lbrace>p\<rbrace>init\<lbrace>invar\<rbrace>\<^sub>u"
  assumes induct_step: "\<lbrace>b \<and> invar\<rbrace>body;;incr\<lbrace>q'\<rbrace>\<^sub>u"
  assumes I0: "`q'\<Rightarrow> invar`"
  shows "\<lbrace>p\<rbrace>for\<^sup>\<top> (init, b, incr) do body od\<lbrace>\<not>b \<and> invar\<rbrace>\<^sub>u"
  using I0 for_hoare_gfp_rel_minimal_partial induct_step post_weak_hoare_rel seq_step
  by blast

lemma for_gfp_invr_hoare_rel_sp_partial:
  assumes seq_step:"\<lbrace>p\<rbrace>init\<lbrace>invar\<rbrace>\<^sub>u"
  assumes induct_step: "\<lbrace>b \<and> invar\<rbrace>body;;incr\<lbrace>q'\<rbrace>\<^sub>u"
  assumes I0: "`q'\<Rightarrow> invar`"
  shows "\<lbrace>p\<rbrace>for\<^sup>\<top> (init, b, incr) invr invar do body od\<lbrace>\<not>b \<and> invar\<rbrace>\<^sub>u"
  using I0 for_gfp_invr_hoare_rel_minimal_partial induct_step post_weak_hoare_rel seq_step
  by blast

lemma for_lfp_hoare_rel_minimal:
  assumes WF: "wf R"
  assumes seq_step: "\<lbrace>p\<rbrace>init\<lbrace>invar\<rbrace>\<^sub>u"
  assumes induct_step: "\<And>st. \<lbrace>b \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright>\<rbrace>body ;; incr\<lbrace>invar \<and> (e,\<guillemotleft>st\<guillemotright>)\<^sub>u \<in>\<^sub>u \<guillemotleft>R\<guillemotright>\<rbrace>\<^sub>u"
  shows "\<lbrace>p\<rbrace>for\<^sub>\<bottom> (init, b, incr) do body od\<lbrace>\<not>b \<and> invar\<rbrace>\<^sub>u"
  unfolding for_lfp_rel_def
  by (auto intro!: assms from_until_lfp_hoare_rel_minimal)

lemma for_lfp_invr_hoare_rel_minimal:
  assumes WF: "wf R"
  assumes seq_step: "\<lbrace>p\<rbrace>init\<lbrace>invar\<rbrace>\<^sub>u"
  assumes induct_step: "\<And>st. \<lbrace>b \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright>\<rbrace>body ;; incr\<lbrace>invar \<and> (e,\<guillemotleft>st\<guillemotright>)\<^sub>u \<in>\<^sub>u \<guillemotleft>R\<guillemotright>\<rbrace>\<^sub>u"
  shows "\<lbrace>p\<rbrace>for\<^sub>\<bottom> (init, b, incr) invr invar do body od\<lbrace>\<not>b \<and> invar\<rbrace>\<^sub>u"
  unfolding for_lfp_invr_rel_def for_lfp_rel_def
  by (simp add: from_until_lfp_hoare_rel_minimal [OF WF seq_step, of _ e] induct_step)

lemma for_lfp_invr_vrt_hoare_rel_minimal:
  assumes WF: "wf R"
  assumes seq_step: "\<lbrace>p\<rbrace>init\<lbrace>invar\<rbrace>\<^sub>u"
  assumes induct_step: "\<And>st. \<lbrace>b \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright>\<rbrace>body ;; incr\<lbrace>invar \<and> (e,\<guillemotleft>st\<guillemotright>)\<^sub>u \<in>\<^sub>u \<guillemotleft>R\<guillemotright>\<rbrace>\<^sub>u"
  shows "\<lbrace>p\<rbrace>for\<^sub>\<bottom> (init, b, incr) invr invar vrt \<guillemotleft>R\<guillemotright> do body od\<lbrace>\<not>b \<and> invar\<rbrace>\<^sub>u"
  unfolding for_lfp_invr_vrt_rel_def for_lfp_rel_def
  by (simp add: from_until_lfp_hoare_rel_minimal [OF WF seq_step, of _ e] induct_step)

lemma for_lfp_hoare_rel_consequence:
  assumes WF: "wf R"
  assumes seq_step:  "\<lbrace>p\<rbrace>init\<lbrace>invar\<rbrace>\<^sub>u"
  assumes PHI: "`\<not>b \<and> invar \<Rightarrow>q`"
  assumes I0': "\<And>st. `b \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright> \<Rightarrow> p' st`"
  assumes induct_step: "\<And>st. \<lbrace>p' st\<rbrace>body;;incr\<lbrace>q' st\<rbrace>\<^sub>u"
  assumes I0: "\<And>st. `q' st \<Rightarrow> invar \<and> (e, \<guillemotleft>st\<guillemotright>)\<^sub>u \<in>\<^sub>u \<guillemotleft>R\<guillemotright>`"
  shows "\<lbrace>p\<rbrace>for\<^sub>\<bottom> (init, b, incr) do body od\<lbrace>q\<rbrace>\<^sub>u"
  unfolding for_lfp_rel_def
  by(simp add: from_until_lfp_hoare_rel_consequence [OF WF seq_step PHI _ induct_step I0] I0')

lemma for_lfp_invr_hoare_rel_consequence:
  assumes WF: "wf R"
  assumes seq_step:  "\<lbrace>p\<rbrace>init\<lbrace>invar\<rbrace>\<^sub>u"
  assumes PHI: "`\<not>b \<and> invar \<Rightarrow>q`"
  assumes I0': "\<And>st. `b \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright> \<Rightarrow> p' st`"
  assumes induct_step: "\<And>st. \<lbrace>p' st\<rbrace>body;;incr\<lbrace>q' st\<rbrace>\<^sub>u"
  assumes I0: "\<And>st. `q' st \<Rightarrow> invar \<and> (e, \<guillemotleft>st\<guillemotright>)\<^sub>u \<in>\<^sub>u \<guillemotleft>R\<guillemotright>`"
  shows "\<lbrace>p\<rbrace>for\<^sub>\<bottom> (init, b, incr) invr invar do body od\<lbrace>q\<rbrace>\<^sub>u"
  unfolding for_lfp_rel_def for_lfp_invr_rel_def
  by(simp add: from_until_lfp_hoare_rel_consequence [OF WF seq_step PHI _ induct_step I0] I0')

lemma for_lfp_invr_vrt_hoare_rel_consequence:
  assumes WF: "wf R"
  assumes seq_step:  "\<lbrace>p\<rbrace>init\<lbrace>invar\<rbrace>\<^sub>u"
  assumes PHI: "`\<not>b \<and> invar \<Rightarrow>q`"
  assumes I0': "\<And>st. `b \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright> \<Rightarrow> p' st`"
  assumes induct_step: "\<And>st. \<lbrace>p' st\<rbrace>body;;incr\<lbrace>q' st\<rbrace>\<^sub>u"
  assumes I0: "\<And>st. `q' st \<Rightarrow> invar \<and> (e, \<guillemotleft>st\<guillemotright>)\<^sub>u \<in>\<^sub>u \<guillemotleft>R\<guillemotright>`"
  shows "\<lbrace>p\<rbrace>for\<^sub>\<bottom> (init, b, incr) invr invar vrt \<guillemotleft>R\<guillemotright> do body od\<lbrace>q\<rbrace>\<^sub>u"
  unfolding for_lfp_rel_def for_lfp_invr_vrt_rel_def
  by(simp add: from_until_lfp_hoare_rel_consequence [OF WF seq_step PHI _ induct_step I0] I0')

lemma for_lfp_hoare_rel_wp:
  assumes WF : "wf R"
  assumes seq_step: "\<lbrace>p\<rbrace>init\<lbrace>invar\<rbrace>\<^sub>u"
  assumes PHI: "`\<not>b \<and> invar \<Rightarrow>q`"
  assumes I0': "\<And>st. `b \<and> invar \<and> e=\<^sub>u \<guillemotleft>st\<guillemotright> \<Rightarrow> p' st`"
  assumes induct_step: "\<And>st. \<lbrace>p' st\<rbrace>body;;incr\<lbrace>invar \<and> (e, \<guillemotleft>st\<guillemotright>)\<^sub>u \<in>\<^sub>u \<guillemotleft>R\<guillemotright>\<rbrace>\<^sub>u"
  shows "\<lbrace>p\<rbrace>for\<^sub>\<bottom> (init,b,incr) do body od\<lbrace>q\<rbrace>\<^sub>u"
  unfolding for_lfp_rel_alt_def
  by (simp add: uimp_refl seq_hoare_rel[OF seq_step]
                while_lfp_hoare_rel_wp[OF WF PHI I0' induct_step])

lemma for_lfp_invr_hoare_rel_wp:
  assumes WF : "wf R"
  assumes seq_step: "\<lbrace>p\<rbrace>init\<lbrace>invar\<rbrace>\<^sub>u"
  assumes PHI: "`\<not>b \<and> invar \<Rightarrow>q`"
  assumes I0': "\<And>st. `b \<and> invar \<and> e=\<^sub>u \<guillemotleft>st\<guillemotright> \<Rightarrow> p' st`"
  assumes induct_step: "\<And>st. \<lbrace>p' st\<rbrace>body;;incr\<lbrace>invar \<and> (e, \<guillemotleft>st\<guillemotright>)\<^sub>u \<in>\<^sub>u \<guillemotleft>R\<guillemotright>\<rbrace>\<^sub>u"
  shows "\<lbrace>p\<rbrace>for\<^sub>\<bottom> (init,b,incr) invr invar do body od\<lbrace>q\<rbrace>\<^sub>u"
  unfolding for_lfp_invr_rel_def for_lfp_rel_alt_def from_until_lfp_rel_alt_def
  by (simp add: seq_hoare_rel[OF seq_step]
                while_lfp_hoare_rel_wp[OF WF PHI I0' induct_step])

lemma for_lfp_invr_vrt_hoare_rel_wp:
  assumes WF : "wf R"
  assumes seq_step: "\<lbrace>p\<rbrace>init\<lbrace>invar\<rbrace>\<^sub>u"
  assumes PHI: "`\<not>b \<and> invar \<Rightarrow>q`"
  assumes I0': "\<And>st. `b \<and> invar \<and> e=\<^sub>u \<guillemotleft>st\<guillemotright> \<Rightarrow> p' st`"
  assumes induct_step: "\<And>st. \<lbrace>p' st\<rbrace>body;;incr\<lbrace>invar \<and> (e, \<guillemotleft>st\<guillemotright>)\<^sub>u \<in>\<^sub>u \<guillemotleft>R\<guillemotright>\<rbrace>\<^sub>u"
  shows "\<lbrace>p\<rbrace>for\<^sub>\<bottom> (init,b,incr) invr invar vrt \<guillemotleft>R\<guillemotright> do body od\<lbrace>q\<rbrace>\<^sub>u"
  unfolding for_lfp_invr_vrt_rel_def for_lfp_rel_alt_def from_until_lfp_rel_alt_def
  by (simp add: uimp_refl seq_hoare_rel[OF seq_step]
                while_lfp_hoare_rel_wp[OF WF  PHI I0' induct_step])

lemma for_lfp_hoare_rel_sp:
  assumes WF: "wf R"
  assumes seq_step:"\<lbrace>p\<rbrace>init\<lbrace>q''\<rbrace>\<^sub>u"
  assumes I0': "`q'' \<Rightarrow> invar`"
  assumes induct_step: "\<And>st. \<lbrace>b \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright>\<rbrace>body;;incr\<lbrace>q' st\<rbrace>\<^sub>u"
  assumes I0: "\<And>st. `q' st \<Rightarrow> invar \<and> (e, \<guillemotleft>st\<guillemotright>)\<^sub>u \<in>\<^sub>u \<guillemotleft>R\<guillemotright>`"
  shows "\<lbrace>p\<rbrace>for\<^sub>\<bottom> (init,b,incr) do body od\<lbrace>\<not>b \<and> invar\<rbrace>\<^sub>u"
  unfolding for_lfp_rel_alt_def
  by (simp add: seq_hoare_rel[OF seq_step] pre_str_hoare_rel[OF I0']
                while_lfp_hoare_rel_sp[OF WF uimp_refl induct_step I0])

lemma for_lfp_invr_hoare_rel_sp:
  assumes WF: "wf R"
  assumes seq_step:"\<lbrace>p\<rbrace>init\<lbrace>q''\<rbrace>\<^sub>u"
  assumes I0':  "`q'' \<Rightarrow> invar`"
  assumes induct_step: "\<And>st. \<lbrace>b \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright>\<rbrace>body;;incr\<lbrace>q' st\<rbrace>\<^sub>u"
  assumes I0: "\<And>st. `q' st \<Rightarrow> invar \<and> (e, \<guillemotleft>st\<guillemotright>)\<^sub>u \<in>\<^sub>u \<guillemotleft>R\<guillemotright>`"
  shows "\<lbrace>p\<rbrace>for\<^sub>\<bottom> (init,b,incr) invr invar do body od\<lbrace>\<not>b \<and> invar\<rbrace>\<^sub>u"
  unfolding for_lfp_invr_rel_def for_lfp_rel_alt_def from_until_lfp_rel_alt_def
  by (simp add: seq_hoare_rel[OF seq_step] pre_str_hoare_rel[OF I0']
                while_lfp_hoare_rel_sp[OF WF uimp_refl induct_step I0])

lemma for_lfp_invr_vrt_hoare_rel_sp:
  assumes WF: "wf R"
  assumes seq_step:"\<lbrace>p\<rbrace>init\<lbrace>q''\<rbrace>\<^sub>u"
  assumes I0':"`q''\<Rightarrow> invar`"
  assumes induct_step: "\<And>st. \<lbrace>b \<and> invar \<and> e =\<^sub>u \<guillemotleft>st\<guillemotright>\<rbrace>body;;incr\<lbrace>q' st\<rbrace>\<^sub>u"
  assumes I0: "\<And>st. `q' st \<Rightarrow> invar \<and> (e, \<guillemotleft>st\<guillemotright>)\<^sub>u \<in>\<^sub>u \<guillemotleft>R\<guillemotright>`"
  shows "\<lbrace>p\<rbrace>for\<^sub>\<bottom> (init,b,incr) invr invar vrt \<guillemotleft>R\<guillemotright> do body od\<lbrace>\<not>b \<and> invar\<rbrace>\<^sub>u"
  unfolding for_lfp_invr_vrt_rel_def for_lfp_rel_alt_def  from_until_lfp_rel_alt_def
  by (simp add: seq_hoare_rel[OF seq_step] pre_str_hoare_rel[OF I0']
                while_lfp_hoare_rel_sp[OF WF uimp_refl induct_step I0])

lemmas loop_invr_vrt_hoare_rel_sp_instantiated [hoare_sp_rules] =
       while_lfp_invr_vrt_hoare_rel_sp [where e = "&\<Sigma>"]
       for_lfp_invr_vrt_hoare_rel_sp [where e = "&\<Sigma>"]
       do_while_lfp_invr_vrt_hoare_rel_sp [where e = "&\<Sigma>"]
       from_until_lfp_invr_vrt_hoare_rel_sp[where e = "&\<Sigma>"]

lemmas loop_invr_vrt_hoare_rel_wp_instantiated [hoare_wp_rules] =
       while_lfp_invr_vrt_hoare_rel_wp [where e = "&\<Sigma>"]
       for_lfp_invr_vrt_hoare_rel_wp [where e = "&\<Sigma>"]
       do_while_lfp_invr_vrt_hoare_rel_wp [where e = "&\<Sigma>"]
       from_until_lfp_invr_vrt_hoare_rel_wp[where e = "&\<Sigma>"]

end