diff --git a/lib/Monads/NonDetMonadVCG.thy b/lib/Monads/NonDetMonadVCG.thy index 2cc8f4ed4..189bdff69 100644 --- a/lib/Monads/NonDetMonadVCG.thy +++ b/lib/Monads/NonDetMonadVCG.thy @@ -306,6 +306,8 @@ lemma hoare_gen_asm: "(P \ \P'\ f \Q\) \ \P' and K P\ f \Q\" by (fastforce simp add: valid_def) +lemmas hoare_gen_asm_single = hoare_gen_asm[where P'="\", simplified pred_conj_def simp_thms] + lemma hoare_gen_asm_lk: "(P \ \P'\ f \Q\) \ \K P and P'\ f \Q\" by (fastforce simp add: valid_def) diff --git a/lib/Monads/OptionMonadWP.thy b/lib/Monads/OptionMonadWP.thy index d64169548..2d60bc52d 100644 --- a/lib/Monads/OptionMonadWP.thy +++ b/lib/Monads/OptionMonadWP.thy @@ -21,8 +21,10 @@ begin TODO: design a sensible syntax for them. *) (* Partial correctness. *) -definition ovalid :: "('s \ bool) \ ('s \ 'a option) \ ('a \ 's \ bool) \ bool" where - "ovalid P f Q \ \s r. P s \ f s = Some r \ Q r s" +definition ovalid :: "('s \ bool) \ ('s \ 'a option) \ ('a \ 's \ bool) \ bool" + ("\_\/ _ /\_\") where + "\P\ f \Q\ \ \s r. P s \ f s = Some r \ Q r s" + (* Total correctness. *) definition ovalidNF :: "('s \ bool) \ ('s \ 'a option) \ ('a \ 's \ bool) \ bool" where "ovalidNF P f Q \ \s. P s \ (f s \ None \ (\r. f s = Some r \ Q r s))" @@ -57,6 +59,10 @@ lemmas owhile_add_inv = owhile_inv_def[symmetric] (* WP rules for ovalid. *) +lemma ovalid_inv[wp]: + "ovalid P f (\_. P)" + by (simp add: ovalid_def) + lemma obind_wp[wp]: "\ \r. ovalid (R r) (g r) Q; ovalid P f R \ \ ovalid P (obind f g) Q" by (simp add: ovalid_def obind_def split: option.splits, fast) diff --git a/lib/Monads/WhileLoopRules.thy b/lib/Monads/WhileLoopRules.thy index e83507f53..a7c2c7f7e 100644 --- a/lib/Monads/WhileLoopRules.thy +++ b/lib/Monads/WhileLoopRules.thy @@ -383,6 +383,22 @@ lemma whileLoop_wp: \ I r \ whileLoop C B r \ Q \" by (rule valid_whileLoop) +lemma whileLoop_valid_inv: + "(\r. \ \s. I r s \ C r s \ B r \ I \) \ \ I r \ whileLoop C B r \ I \" + apply (fastforce intro: whileLoop_wp) + done + +lemma valid_whileLoop_cond_fail: + assumes pre_implies_post: "\s. P r s \ Q r s" + and pre_implies_fail: "\s. P r s \ \ C r s" + shows "\ P r \ whileLoop C B r \ Q \" + using assms + apply (clarsimp simp: valid_def) + apply (subst (asm) whileLoop_cond_fail) + apply blast + apply (clarsimp simp: return_def) + done + lemma whileLoop_wp_inv [wp]: "\ \r. \\s. I r s \ C r s\ B r \I\; \r s. \I r s; \ C r s\ \ Q r s \ \ \ I r \ whileLoop_inv C B r I M \ Q \"