"(\<And>s. P s \<Longrightarrow> no_fail P f) \<Longrightarrow> no_fail P f"
by (simp add: no_fail_def)
lemma no_fail_liftM_eq [simp]:
"no_fail P (liftM f m) = no_fail P m"
by (auto simp: liftM_def no_fail_def bind_def return_def)
lemma mapME_Cons:
"mapME m (x # xs) = (doE y \<leftarrow> m x; ys \<leftarrow> (mapME m xs); returnOk (y # ys) odE)"
by (simp add: mapME_def sequenceE_def Let_def)
lemma mapME_Nil : "mapME f [] = returnOk []"
unfolding mapME_def by (simp add: sequenceE_def)
lemma hoare_take_disjunct:
"\<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv s. P' rv s \<and> (False \<or> P'' rv s)\<rbrace>
\<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>P''\<rbrace>"
by (erule hoare_strengthen_post, simp)
lemma hoare_post_add:
"\<lbrace>P\<rbrace> S \<lbrace>\<lambda>r s. R r s \<and> Q r s\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> S \<lbrace>Q\<rbrace>"
by (erule hoare_strengthen_post, simp)
lemma hoare_disjI1:
"\<lbrace>R\<rbrace> f \<lbrace>P\<rbrace> \<Longrightarrow> \<lbrace>R\<rbrace> f \<lbrace>\<lambda>r s. P r s \<or> Q r s\<rbrace>"
apply (erule hoare_post_imp [rotated])
apply simp
done
lemma hoare_disjI2:
"\<lbrace>R\<rbrace> f \<lbrace>Q\<rbrace> \<Longrightarrow> \<lbrace>R\<rbrace> f \<lbrace>\<lambda>r s. P r s \<or> Q r s \<rbrace>"
by (rule hoare_post_imp [OF _ hoare_disjI1, where P1=Q], auto)
lemma hoare_name_pre_state:
"\<lbrakk> \<And>s. P s \<Longrightarrow> \<lbrace>op = s\<rbrace> f \<lbrace>Q\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>"
by (clarsimp simp: valid_def)
lemma hoare_name_pre_stateE:
"\<lbrakk>\<And>s. P s \<Longrightarrow> \<lbrace>op = s\<rbrace> f \<lbrace>Q\<rbrace>, \<lbrace>E\<rbrace>\<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>, \<lbrace>E\<rbrace>"
by (clarsimp simp: validE_def2)
lemma valid_prove_more:
"\<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<and> Q' rv s\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q'\<rbrace>"
by (erule hoare_strengthen_post, simp)
lemma hoare_vcg_if_lift:
"\<lbrace>R\<rbrace> f \<lbrace>\<lambda>rv s. (P \<longrightarrow> X rv s) \<and> (\<not>P \<longrightarrow> Y rv s)\<rbrace> \<Longrightarrow>
\<lbrace>R\<rbrace> f \<lbrace>\<lambda>rv s. if P then X rv s else Y rv s\<rbrace>"
"\<lbrace>R\<rbrace> f \<lbrace>\<lambda>rv s. (P \<longrightarrow> X rv s) \<and> (\<not>P \<longrightarrow> Y rv s)\<rbrace> \<Longrightarrow>
\<lbrace>R\<rbrace> f \<lbrace>\<lambda>rv. if P then X rv else Y rv\<rbrace>"
by (auto simp: valid_def split_def)
lemma no_fail_bind [wp]:
assumes f: "no_fail P f"
assumes g: "\<And>rv. no_fail (R rv) (g rv)"
assumes v: "\<lbrace>Q\<rbrace> f \<lbrace>R\<rbrace>"
shows "no_fail (P and Q) (f >>= (\<lambda>rv. g rv))"
apply (clarsimp simp: no_fail_def bind_def)
apply (rule conjI)
prefer 2
apply (erule no_failD [OF f])
apply clarsimp
apply (drule (1) use_valid [OF _ v])
apply (drule no_failD [OF g])
apply simp
done
lemma hoare_lift_Pf2:
assumes P: "\<And>x. \<lbrace>Q x\<rbrace> m \<lbrace>\<lambda>_. P x\<rbrace>"
assumes f: "\<And>P. \<lbrace>\<lambda>s. P (f s)\<rbrace> m \<lbrace>\<lambda>_ s. P (f s)\<rbrace>"
shows "\<lbrace>\<lambda>s. Q (f s) s\<rbrace> m \<lbrace>\<lambda>_ s. P (f s) s\<rbrace>"
lemma assert_def2: "assert v = assert_opt (if v then Some () else None)"
by (cases v, simp_all add: assert_def assert_opt_def)
lemma hoare_if_r_and:
"\<lbrace>P\<rbrace> f \<lbrace>\<lambda>r. if R r then Q r else Q' r\<rbrace>
= \<lbrace>P\<rbrace> f \<lbrace>\<lambda>r s. (R r \<longrightarrow> Q r s) \<and> (\<not>R r \<longrightarrow> Q' r s)\<rbrace>"
by (fastforce simp: valid_def)
lemma no_fail_liftM [wp]:
"no_fail P m \<Longrightarrow> no_fail P (liftM f m)"
by (simp)
lemma no_fail_pre_and:
"no_fail P f \<Longrightarrow> no_fail (P and Q) f"
by (erule no_fail_pre) simp
lemma hoare_convert_imp:
"\<lbrakk> \<lbrace>\<lambda>s. \<not> P s\<rbrace> f \<lbrace>\<lambda>rv s. \<not> Q s\<rbrace>; \<lbrace>R\<rbrace> f \<lbrace>S\<rbrace> \<rbrakk> \<Longrightarrow>
\<lbrace>\<lambda>s. P s \<longrightarrow> R s\<rbrace> f \<lbrace>\<lambda>rv s. Q s \<longrightarrow> S rv s\<rbrace>"
apply (simp only: imp_conv_disj)
apply (erule(1) hoare_vcg_disj_lift)
done
lemma hoare_vcg_ex_lift_R:
"\<lbrakk> \<And>v. \<lbrace>P v\<rbrace> f \<lbrace>Q v\<rbrace>,- \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. \<exists>v. P v s\<rbrace> f \<lbrace>\<lambda>rv s. \<exists>v. Q v rv s\<rbrace>,-"
"\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>P'\<rbrace>,-; \<lbrace>Q\<rbrace> f \<lbrace>Q'\<rbrace>,- \<rbrakk> \<Longrightarrow> \<lbrace>P and Q\<rbrace> f \<lbrace>\<lambda>rv s. P' rv s \<and> Q' rv s\<rbrace>, -"
and hr: "\<And>a as. suffix (a # as) xs \<Longrightarrow> \<lbrace>\<lambda>s. I s \<and> V (a # as) s\<rbrace> m a \<lbrace>\<lambda>r s. I s \<and> V as s\<rbrace>"
by (induct xs) (auto simp: mapM_x_Nil mapM_x_Cons)
lemma hoare_imp_eq_substR:
"\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,- \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv s. rv = x \<longrightarrow> Q x s\<rbrace>,-"
by (fastforce simp add: valid_def validE_R_def validE_def split: sum.splits)
"sequenceE (x # xs) = (doE v \<leftarrow> x; vs \<leftarrow> sequenceE xs; returnOk (v # vs) odE)"
by (simp add: sequenceE_def Let_def)
lemma snd_return [monad_eq]:
"\<not> snd (return a b)"
unfolding return_def by simp
lemma snd_throwError [monad_eq]:
"\<not> snd (throwError e s)"
unfolding throwError_def by (simp add: snd_return)
lemma snd_lift_Inr [monad_eq]:
"snd (lift b (Inr r) t) = snd (b r t)"
unfolding lift_def by simp
lemma snd_lift_Inl [monad_eq]:
"\<not> snd (lift b (Inl r) t)"
unfolding lift_def by (simp add: snd_throwError)
lemma snd_fail [monad_eq]:
"snd (fail s)"
apply (clarsimp simp: fail_def)
done
lemma not_snd_bindD:
"\<lbrakk> \<not> snd ((a >>= b) s); (rv, s') \<in> fst (a s) \<rbrakk> \<Longrightarrow> \<not> snd (a s) \<and> \<not> snd (b rv s')"
by (fastforce simp: bind_def)
lemma whenE_bindE_throwError_to_if:
"whenE P (throwError e) >>=E (\<lambda>_. b) = (if P then (throwError e) else b)"
unfolding whenE_def bindE_def
by (auto simp: NonDetMonad.lift_def throwError_def returnOk_def)
lemma not_snd_bindI1:
"\<not> snd ((a >>= b) s) \<Longrightarrow> \<not> snd (a s)"
by (fastforce simp: bind_def)
lemma not_snd_bindI2:
"\<lbrakk> \<not> snd ((a >>= b) s); (rv, s') \<in> fst (a s) \<rbrakk> \<Longrightarrow> \<not> snd (b rv s')"
by (fastforce simp: bind_def)
lemma empty_fail_not_snd:
"\<lbrakk> \<not> snd (m s); empty_fail m \<rbrakk> \<Longrightarrow> \<exists>v. v \<in> fst (m s)"
by (fastforce simp: empty_fail_def)
lemma mapM_Nil:
"mapM f [] = return []"
by (simp add: mapM_def sequence_def)
lemma hoare_vcg_exI:
"\<lbrace>P\<rbrace> f \<lbrace>Q x\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv s. \<exists>x. Q x rv s\<rbrace>"
apply (simp add: valid_def split_def)
apply blast
done
lemma hoare_exI_tuple:
"\<lbrace>P\<rbrace> f \<lbrace>\<lambda>(rv,rv') s. Q x rv rv' s\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>(rv,rv') s. \<exists>x. Q x rv rv' s\<rbrace>"
by (fastforce simp: valid_def)
lemma hoare_ex_all:
"(\<forall>x. \<lbrace>P x\<rbrace> f \<lbrace>Q\<rbrace>) = \<lbrace>\<lambda>s. \<exists>x. P x s\<rbrace> f \<lbrace>Q\<rbrace>"
= (if P then cutMon (op = s) f else cutMon (op = s) g)"
by (simp add: cutMon_def)
lemma cutMon_valid_drop:
"\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> cutMon R f \<lbrace>Q\<rbrace>"
by (simp add: cutMon_def valid_def fail_def)
lemma cutMon_validE_drop:
"\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> cutMon R f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
by (simp add: validE_def cutMon_valid_drop)
lemma assertE_assert:
"assertE F = liftE (assert F)"
by (clarsimp simp: assertE_def assert_def liftE_def returnOk_def
"\<lbrakk> \<And>s. \<lbrace>op = s\<rbrace> f \<lbrace>\<lambda>_. op = s\<rbrace>; \<And>s. \<lbrace>op = s\<rbrace> g \<lbrace>\<lambda>_. op = s\<rbrace>;
empty_fail f; empty_fail g \<rbrakk> \<Longrightarrow>
do x \<leftarrow> f; y \<leftarrow> g; n od = do y \<leftarrow> g; x \<leftarrow> f; n od"
"\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>; \<And>x. \<lbrace>P'\<rbrace> g x \<lbrace>Q\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>P and P'\<rbrace> case opt of None \<Rightarrow> f | Some x \<Rightarrow> g x \<lbrace>Q\<rbrace>"
apply (cases opt)
apply (clarsimp elim!: hoare_weaken_pre)
apply (rule hoare_weaken_pre [where Q=P'])
apply simp+
done
lemma list_cases_weak_wp:
assumes "\<lbrace>P_A\<rbrace> a \<lbrace>Q\<rbrace>"
assumes "\<And>x xs. \<lbrace>P_B\<rbrace> b x xs \<lbrace>Q\<rbrace>"
"\<lbrace>R\<rbrace> f \<lbrace>\<lambda>rv s. (P rv s \<longrightarrow> X rv s) \<and> (\<not> P rv s \<longrightarrow> Y rv s)\<rbrace> \<Longrightarrow>
\<lbrace>R\<rbrace> f \<lbrace>\<lambda>rv s. if P rv s then X rv s else Y rv s\<rbrace>"
"\<lbrace>R\<rbrace> f \<lbrace>\<lambda>rv s. (P' rv \<longrightarrow> X rv s) \<and> (\<not> P' rv \<longrightarrow> Y rv s)\<rbrace> \<Longrightarrow>
\<lbrace>R\<rbrace> f \<lbrace>\<lambda>rv. if P' rv then X rv else Y rv\<rbrace>"
by (auto simp: valid_def split_def)
lemma hoare_vcg_if_lift_ER: (* Required because of lack of rv in lifting rules *)
"\<lbrace>R\<rbrace> f \<lbrace>\<lambda>rv s. (P rv s \<longrightarrow> X rv s) \<and> (\<not> P rv s \<longrightarrow> Y rv s)\<rbrace>, - \<Longrightarrow>
\<lbrace>R\<rbrace> f \<lbrace>\<lambda>rv s. if P rv s then X rv s else Y rv s\<rbrace>, -"
"\<lbrace>R\<rbrace> f \<lbrace>\<lambda>rv s. (P' rv \<longrightarrow> X rv s) \<and> (\<not> P' rv \<longrightarrow> Y rv s)\<rbrace>, - \<Longrightarrow>
\<lbrace>R\<rbrace> f \<lbrace>\<lambda>rv. if P' rv then X rv else Y rv\<rbrace>, -"
by (auto simp: valid_def validE_R_def validE_def split_def)
lemma liftME_return:
"liftME f (returnOk v) = returnOk (f v)"
by (simp add: liftME_def)
lemma lifted_if_collapse:
"(if P then \<top> else f) = (\<lambda>s. \<not>P \<longrightarrow> f s)"
assumes x: "\<And>x. \<lbrace>\<lambda>s. x \<notin> S s\<rbrace> f \<lbrace>\<lambda>rv s. x \<notin> S s\<rbrace>"
shows
"\<lbrace>\<lambda>s. \<forall>S'. S' \<subseteq> S s \<longrightarrow> P S'\<rbrace>
f
\<lbrace>\<lambda>rv s. P (S s)\<rbrace>"
apply (clarsimp simp: valid_def)
apply (drule spec, erule mp)
apply (clarsimp simp: subset_iff)
apply (rule ccontr)
apply (drule(1) use_valid [OF _ x])
apply simp
done
lemma shrinks_proof:
assumes y: "\<And>s. finite (S s)"
assumes x: "\<And>x. \<lbrace>\<lambda>s. x \<notin> S s \<and> P s\<rbrace> f \<lbrace>\<lambda>rv s. x \<notin> S s\<rbrace>"
assumes z: "\<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv s. x \<notin> S s\<rbrace>"
assumes w: "\<And>s. P s \<Longrightarrow> x \<in> S s"
shows "\<lbrace>\<lambda>s. card (S s) \<le> n \<and> P s\<rbrace> f \<lbrace>\<lambda>rv s. card (S s) < n\<rbrace>"
apply (clarsimp simp: valid_def)
apply (subgoal_tac "S b \<subset> S s")
apply (drule psubset_card_mono [OF y], simp)
apply (rule psubsetI)
apply clarsimp
apply (rule ccontr)
apply (subgoal_tac "x \<notin> S b", simp)
apply (erule use_valid [OF _ x])
apply simp
apply (rule not_sym)
apply (rule set_neqI[where x=x])
apply (erule w)
apply (erule(1) use_valid [OF _ z])
done
lemma unlessE_wp :
"(\<not>P \<Longrightarrow> \<lbrace>Q\<rbrace> f \<lbrace>R\<rbrace>,\<lbrace>E\<rbrace>) \<Longrightarrow> \<lbrace>if P then R () else Q\<rbrace> unlessE P f \<lbrace>R\<rbrace>,\<lbrace>E\<rbrace>"
apply (clarsimp simp: unlessE_whenE whenE_def)
apply wp
done
lemma use_validE_R:
"\<lbrakk> (Inr r, s') \<in> fst (f s); \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,-; P s \<rbrakk> \<Longrightarrow> Q r s'"
unfolding validE_R_def validE_def
by (frule(2) use_valid, simp)
lemma valid_preservation_ex:
assumes x: "\<And>x P. \<lbrace>\<lambda>s. P (f s x :: 'b)\<rbrace> m \<lbrace>\<lambda>rv s. P (f s x)\<rbrace>"
shows "\<lbrace>\<lambda>s. P (f s :: 'a \<Rightarrow> 'b)\<rbrace> m \<lbrace>\<lambda>rv s. P (f s)\<rbrace>"
"\<lbrace>\<top> and K (P \<longrightarrow> distinct xs)\<rbrace> filterM m xs \<lbrace>\<lambda>rv s. (P \<longrightarrow> distinct rv) \<and> set rv \<subseteq> set xs\<rbrace>"
"\<lbrace>\<top>\<rbrace> filterM m xs \<lbrace>\<lambda>rv s. set rv \<subseteq> set xs\<rbrace>"
by (rule hoare_chain, rule filterM_distinct1[where P=False], simp_all)
lemma filterM_all:
"\<lbrakk> \<And>x y. \<lbrakk> x \<in> set xs; y \<in> set xs \<rbrakk> \<Longrightarrow> \<lbrace>P y\<rbrace> m x \<lbrace>\<lambda>rv. P y\<rbrace> \<rbrakk> \<Longrightarrow>
\<lbrace>\<lambda>s. \<forall>x \<in> set xs. P x s\<rbrace> filterM m xs \<lbrace>\<lambda>rv s. \<forall>x \<in> set rv. P x s\<rbrace>"
apply (rule_tac Q="\<lambda>rv s. set rv \<subseteq> set xs \<and> (\<forall>x \<in> set xs. P x s)"
by (fastforce simp add: fun_eq_iff select_def return_def)
lemma static_imp_wp:
"\<lbrace>Q\<rbrace> m \<lbrace>R\<rbrace> \<Longrightarrow> \<lbrace>\<lambda>s. P \<longrightarrow> Q s\<rbrace> m \<lbrace>\<lambda>rv s. P \<longrightarrow> R rv s\<rbrace>"
by (cases P, simp_all add: valid_def)
lemma static_imp_conj_wp:
"\<lbrakk> \<lbrace>Q\<rbrace> m \<lbrace>Q'\<rbrace>; \<lbrace>R\<rbrace> m \<lbrace>R'\<rbrace> \<rbrakk>
\<Longrightarrow> \<lbrace>\<lambda>s. (P \<longrightarrow> Q s) \<and> R s\<rbrace> m \<lbrace>\<lambda>rv s. (P \<longrightarrow> Q' rv s) \<and> R' rv s\<rbrace>"
"\<lbrakk>\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>, -; \<lbrace>P\<rbrace> f \<lbrace>R\<rbrace>, -\<rbrakk> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q And R\<rbrace>, -"
"\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,- \<Longrightarrow> \<lbrace>\<lambda>s. F \<longrightarrow> P s\<rbrace> f \<lbrace>\<lambda>rv s. F \<longrightarrow> Q rv s\<rbrace>,-"
"(\<And>x. \<lbrace>P x\<rbrace> f \<lbrace>\<lambda>rv. Q x\<rbrace>) \<Longrightarrow>
\<lbrace>\<lambda>s. case ep of Some x \<Rightarrow> P x s | _ \<Rightarrow> True\<rbrace>
f \<lbrace>\<lambda>rv s. case ep of Some x \<Rightarrow> Q x s | _ \<Rightarrow> True\<rbrace>"
by (cases ep, simp_all add: hoare_vcg_prop)
lemma P_bool_lift:
assumes t: "\<lbrace>Q\<rbrace> f \<lbrace>\<lambda>r. Q\<rbrace>"
assumes f: "\<lbrace>\<lambda>s. \<not>Q s\<rbrace> f \<lbrace>\<lambda>r s. \<not>Q s\<rbrace>"
shows "\<lbrace>\<lambda>s. P (Q s)\<rbrace> f \<lbrace>\<lambda>r s. P (Q s)\<rbrace>"
apply (clarsimp simp: valid_def)
apply (subgoal_tac "Q b = Q s")
apply simp
apply (rule iffI)
apply (rule classical)
apply (drule (1) use_valid [OF _ f])
apply simp
apply (erule (1) use_valid [OF _ t])
done
lemma fail_inv :
"\<lbrace> P \<rbrace> fail \<lbrace> \<lambda>r. P \<rbrace>"
by wp
lemma gets_sp: "\<lbrace>P\<rbrace> gets f \<lbrace>\<lambda>rv. P and (\<lambda>s. f s = rv)\<rbrace>"
by (wp, simp)
lemma post_by_hoare2:
"\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>; (r, s') \<in> fst (f s); P s \<rbrakk> \<Longrightarrow> Q r s'"
by (rule post_by_hoare, assumption+)
lemma hoare_Ball_helper:
assumes x: "\<And>x. \<lbrace>P x\<rbrace> f \<lbrace>Q x\<rbrace>"
assumes y: "\<And>P. \<lbrace>\<lambda>s. P (S s)\<rbrace> f \<lbrace>\<lambda>rv s. P (S s)\<rbrace>"
shows "\<lbrace>\<lambda>s. \<forall>x \<in> S s. P x s\<rbrace> f \<lbrace>\<lambda>rv s. \<forall>x \<in> S s. Q x rv s\<rbrace>"
apply (clarsimp simp: valid_def)
apply (subgoal_tac "S b = S s")
apply (erule post_by_hoare2 [OF x])
apply (clarsimp simp: Ball_def)
apply (erule_tac P1="\<lambda>x. x = S s" in post_by_hoare2 [OF y])
apply (rule refl)
done
lemma hoare_gets_post:
"\<lbrace> P \<rbrace> gets f \<lbrace> \<lambda>r s. r = f s \<and> P s \<rbrace>"
by (simp add: valid_def get_def gets_def bind_def return_def)
lemma hoare_return_post:
"\<lbrace> P \<rbrace> return x \<lbrace> \<lambda>r s. r = x \<and> P s \<rbrace>"
by (simp add: valid_def return_def)
lemma mapM_wp':
assumes x: "\<And>x. x \<in> set xs \<Longrightarrow> \<lbrace>P\<rbrace> f x \<lbrace>\<lambda>rv. P\<rbrace>"
shows "\<lbrace>P\<rbrace> mapM f xs \<lbrace>\<lambda>rv. P\<rbrace>"
apply (rule mapM_wp)
apply (erule x)
apply simp
done
lemma mapM_set:
assumes "\<And>x. x \<in> set xs \<Longrightarrow> \<lbrace>P\<rbrace> f x \<lbrace>\<lambda>_. P\<rbrace>"
assumes "\<And>x y. x \<in> set xs \<Longrightarrow> \<lbrace>P\<rbrace> f x \<lbrace>\<lambda>_. Q x\<rbrace>"
assumes "\<And>x y. \<lbrakk> x \<in> set xs; y \<in> set xs \<rbrakk> \<Longrightarrow> \<lbrace>P and Q y\<rbrace> f x \<lbrace>\<lambda>_. Q y\<rbrace>"
shows "\<lbrace>P\<rbrace> mapM f xs \<lbrace>\<lambda>_ s. \<forall>x \<in> set xs. Q x s\<rbrace>"
using assms
proof (induct xs)
case Nil show ?case
by (simp add: mapM_def sequence_def) wp
next
case (Cons y ys)
have PQ_inv: "\<And>x. x \<in> set ys \<Longrightarrow> \<lbrace>P and Q y\<rbrace> f x \<lbrace>\<lambda>_. P and Q y\<rbrace>"
assumes x: "\<And>x s'. \<lbrakk> (Inr x, s') \<in> fst (f s) \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. B x s \<and> s = s'\<rbrace> g x \<lbrace>C\<rbrace>, \<lbrace>E\<rbrace>"
shows "\<lbrace>A\<rbrace> f \<lbrace>B\<rbrace>, \<lbrace>E\<rbrace> \<Longrightarrow> \<lbrace>\<lambda>st. A st \<and> st = s\<rbrace> f >>=E g \<lbrace>C\<rbrace>, \<lbrace>E\<rbrace>"
apply (case_tac a, simp_all add: throwError_def return_def)
apply (drule x)
apply (clarsimp simp: validE_def valid_def)
apply (erule(1) my_BallE, simp)
done
lemma bind_known_operation_eq:
"\<lbrakk> no_fail P f; \<lbrace>Q\<rbrace> f \<lbrace>\<lambda>rv s. rv = x \<and> s = t\<rbrace>; P s; Q s; empty_fail f \<rbrakk>
\<Longrightarrow> (f >>= g) s = g x t"
apply (drule(1) no_failD)
apply (subgoal_tac "fst (f s) = {(x, t)}")
apply (clarsimp simp: bind_def)
apply (rule not_psubset_eq)
apply (drule(1) empty_failD2, clarsimp)
apply fastforce
apply clarsimp
apply (drule(1) use_valid, simp+)
done
lemma gets_the_bind_eq:
"\<lbrakk> f s = Some x; g x s = h s \<rbrakk>
\<Longrightarrow> (gets_the f >>= g) s = h s"
by (simp add: gets_the_def bind_assoc exec_gets assert_opt_def)
lemma hoare_const_imp_R:
"\<lbrace>Q\<rbrace> f \<lbrace>R\<rbrace>,- \<Longrightarrow> \<lbrace>\<lambda>s. P \<longrightarrow> Q s\<rbrace> f \<lbrace>\<lambda>rv s. P \<longrightarrow> R rv s\<rbrace>,-"
"\<lbrakk> \<lbrace>P'\<rbrace> f \<lbrace>\<lambda>rv s. \<not> P rv s\<rbrace>, -; \<lbrace>Q'\<rbrace> f \<lbrace>Q\<rbrace>, - \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. P' s \<or> Q' s\<rbrace> f \<lbrace>\<lambda>rv s. P rv s \<longrightarrow> Q rv s\<rbrace>, -"
by (auto simp add: valid_def validE_R_def validE_def split_def split: sum.splits)
"\<lbrakk> P \<or> Q; P \<Longrightarrow> \<lbrace>R\<rbrace> f \<lbrace>S\<rbrace>; Q \<Longrightarrow> \<lbrace>T\<rbrace> f \<lbrace>S\<rbrace> \<rbrakk>
\<Longrightarrow> \<lbrace>\<lambda>s. (P \<longrightarrow> R s) \<and> (Q \<longrightarrow> T s)\<rbrace> f \<lbrace>S\<rbrace>"
apply safe
apply (rule hoare_pre_imp)
prefer 2
apply simp
apply simp
apply (rule hoare_pre_imp)
prefer 2
apply simp
apply simp
done
lemma hoare_grab_asm:
"\<lbrakk> G \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace> \<rbrakk> \<Longrightarrow> \<lbrace>\<lambda>s. G \<and> P s\<rbrace> f \<lbrace>Q\<rbrace>"
by (cases G, simp+)
lemma hoare_grab_asm2:
"(P' \<Longrightarrow> \<lbrace>\<lambda>s. P s \<and> R s\<rbrace> f \<lbrace>Q\<rbrace>)
\<Longrightarrow> \<lbrace>\<lambda>s. P s \<and> P' \<and> R s\<rbrace> f \<lbrace>Q\<rbrace>"
by (fastforce simp: valid_def)
lemma hoare_grab_exs:
assumes x: "\<And>x. P x \<Longrightarrow> \<lbrace>P'\<rbrace> f \<lbrace>Q\<rbrace>"
shows "\<lbrace>\<lambda>s. \<exists>x. P x \<and> P' s\<rbrace> f \<lbrace>Q\<rbrace>"
apply (clarsimp simp: valid_def)
apply (erule(2) use_valid [OF _ x])
done
lemma hoare_prop_E: "\<lbrace>\<lambda>rv. P\<rbrace> f -,\<lbrace>\<lambda>rv s. P\<rbrace>"
unfolding validE_E_def
by (rule hoare_pre, wp, simp)
lemma hoare_vcg_conj_lift_R:
"\<lbrakk> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,-; \<lbrace>R\<rbrace> f \<lbrace>S\<rbrace>,- \<rbrakk> \<Longrightarrow>
\<lbrace>\<lambda>s. P s \<and> R s\<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<and> S rv s\<rbrace>,-"
apply (simp add: validE_R_def validE_def)
apply (drule(1) hoare_vcg_conj_lift)
apply (erule hoare_strengthen_post)
apply (clarsimp split: sum.splits)
done
lemma hoare_walk_assmsE:
assumes x: "\<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv. P\<rbrace>" and y: "\<And>s. P s \<Longrightarrow> Q s" and z: "\<lbrace>P\<rbrace> g \<lbrace>\<lambda>rv. Q\<rbrace>"
shows "\<lbrace>P\<rbrace> doE x \<leftarrow> f; g odE \<lbrace>\<lambda>rv. Q\<rbrace>"
apply (wp z)
apply (simp add: validE_def)
apply (rule hoare_strengthen_post [OF x])
apply (case_tac r, simp_all add: y)
done
lemma mapME_set:
assumes est: "\<And>x. \<lbrace>R\<rbrace> f x \<lbrace>P\<rbrace>, -"
and invp: "\<And>x y. \<lbrace>R and P x\<rbrace> f y \<lbrace>\<lambda>_. P x\<rbrace>, -"
and invr: "\<And>x. \<lbrace>R\<rbrace> f x \<lbrace>\<lambda>_. R\<rbrace>, -"
shows "\<lbrace>R\<rbrace> mapME f xs \<lbrace>\<lambda>rv s. \<forall>x \<in> set rv. P x s\<rbrace>, -"
proof (rule hoare_post_imp_R [where Q' = "\<lambda>rv s. R s \<and> (\<forall>x \<in> set rv. P x s)"], induct xs)
case Nil
thus ?case by (simp add: mapME_Nil | wp returnOKE_R_wp)+
next
case (Cons y ys)
have minvp: "\<And>x. \<lbrace>R and P x\<rbrace> mapME f ys \<lbrace>\<lambda>_. P x\<rbrace>, -"
apply (rule hoare_pre)
apply (rule_tac Q' = "\<lambda>_ s. R s \<and> P x s" in hoare_post_imp_R)
= (unlessE P (throwError x) >>=E (\<lambda>_. returnOk v))"
by (cases P, simp_all add: unlessE_def)
lemma weaker_hoare_ifE:
assumes x: "\<lbrace>P \<rbrace> a \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
assumes y: "\<lbrace>P'\<rbrace> b \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
shows "\<lbrace>P and P'\<rbrace> if test then a else b \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
apply (rule hoare_vcg_precond_impE)
apply (wp x y)
apply simp
done
lemma wp_split_const_if:
assumes x: "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>"
assumes y: "\<lbrace>P'\<rbrace> f \<lbrace>Q'\<rbrace>"
shows "\<lbrace>\<lambda>s. (G \<longrightarrow> P s) \<and> (\<not> G \<longrightarrow> P' s)\<rbrace> f \<lbrace>\<lambda>rv s. (G \<longrightarrow> Q rv s) \<and> (\<not> G \<longrightarrow> Q' rv s)\<rbrace>"
by (case_tac G, simp_all add: x y)
lemma wp_split_const_if_R:
assumes x: "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,-"
assumes y: "\<lbrace>P'\<rbrace> f \<lbrace>Q'\<rbrace>,-"
shows "\<lbrace>\<lambda>s. (G \<longrightarrow> P s) \<and> (\<not> G \<longrightarrow> P' s)\<rbrace> f \<lbrace>\<lambda>rv s. (G \<longrightarrow> Q rv s) \<and> (\<not> G \<longrightarrow> Q' rv s)\<rbrace>,-"
by (case_tac G, simp_all add: x y)
lemma wp_throw_const_imp:
assumes x: "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>"
shows "\<lbrace>\<lambda>s. G \<longrightarrow> P s\<rbrace> f \<lbrace>\<lambda>rv s. G \<longrightarrow> Q rv s\<rbrace>"
by (case_tac G, simp_all add: x hoare_vcg_prop)
lemma wp_throw_const_impE:
assumes x: "\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>"
shows "\<lbrace>\<lambda>s. G \<longrightarrow> P s\<rbrace> f \<lbrace>\<lambda>rv s. G \<longrightarrow> Q rv s\<rbrace>,\<lbrace>\<lambda>rv s. G \<longrightarrow> E rv s\<rbrace>"
apply (case_tac G, simp_all add: x)
apply wp
done
lemma distinct_tuple_helper:
"\<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv s. distinct (x # xs rv s)\<rbrace> \<Longrightarrow>
\<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv s. distinct (x # (map fst (zip (xs rv s) (ys rv s))))\<rbrace>"
apply (erule hoare_strengthen_post)
apply (erule distinct_prefix)
apply (simp add: map_fst_zip_prefix)
done
lemma hoare_whenE_wp:
"(P \<Longrightarrow> \<lbrace>Q\<rbrace> f \<lbrace>R\<rbrace>, \<lbrace>E\<rbrace>) \<Longrightarrow> \<lbrace>if P then Q else R ()\<rbrace> whenE P f \<lbrace>R\<rbrace>, \<lbrace>E\<rbrace>"
unfolding whenE_def
apply clarsimp
apply wp
done
lemma list_case_throw_validE_R:
"\<lbrakk> \<And>y ys. xs = y # ys \<Longrightarrow> \<lbrace>P\<rbrace> f y ys \<lbrace>Q\<rbrace>,- \<rbrakk> \<Longrightarrow>
\<lbrace>P\<rbrace> case xs of [] \<Rightarrow> throwError e | x # xs \<Rightarrow> f x xs \<lbrace>Q\<rbrace>,-"
assumes f: "\<And>x rv. (rv,s) \<in> fst (f x s) \<Longrightarrow> x \<in> set xs \<Longrightarrow> (rv, g s) \<in> fst (f x (g s))"
assumes inv: "\<And>x. \<lbrace>op = s\<rbrace> f x \<lbrace>\<lambda>_. op = s\<rbrace>"
shows "(rv,s) \<in> fst (mapM f xs s) \<Longrightarrow> (rv, g s) \<in> fst (mapM f xs (g s))"
using f inv
proof (induct xs arbitrary: rv s)
case Nil
thus ?case by (simp add: mapM_Nil return_def)
next
case (Cons z zs)
from Cons.prems
show ?case
apply (clarsimp simp: mapM_Cons in_monad)
apply (frule use_valid, assumption, rule refl)
apply clarsimp
apply (drule Cons.prems, simp)
apply (rule exI, erule conjI)
apply (drule Cons.hyps)
apply simp
apply assumption
apply simp
done
qed
(* FUXME: duplicate *)
lemma mapM_x_append2:
"mapM_x f (xs @ ys) = do mapM_x f xs; mapM_x f ys od"
apply (simp add: mapM_x_def sequence_x_def)
apply (induct xs)
apply simp
apply (simp add: bind_assoc)
done
lemma mapM_x_split_append:
"mapM_x f xs = do _ \<leftarrow> mapM_x f (take n xs); mapM_x f (drop n xs) od"
using mapM_x_append[where f=f and xs="take n xs" and ys="drop n xs"]
by simp
lemma hoare_gen_asm':
"(P \<Longrightarrow> \<lbrace>P'\<rbrace> f \<lbrace>Q\<rbrace>) \<Longrightarrow> \<lbrace>P' and (\<lambda>_. P)\<rbrace> f \<lbrace>Q\<rbrace>"
apply (auto intro: hoare_assume_pre)
done
lemma hoare_gen_asm_conj:
"(P \<Longrightarrow> \<lbrace>P'\<rbrace> f \<lbrace>Q\<rbrace>) \<Longrightarrow> \<lbrace>\<lambda>s. P' s \<and> P\<rbrace> f \<lbrace>Q\<rbrace>"
by (fastforce simp: valid_def)
lemma hoare_add_K:
"\<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace> \<Longrightarrow> \<lbrace>\<lambda>s. P s \<and> I\<rbrace> f \<lbrace>\<lambda>rv s. Q rv s \<and> I\<rbrace>"
by (fastforce simp: valid_def)
lemma valid_rv_lift:
"\<lbrace>P'\<rbrace> f \<lbrace>\<lambda>rv s. rv \<longrightarrow> Q rv s\<rbrace> \<Longrightarrow> \<lbrace>\<lambda>s. P \<and> P' s\<rbrace> f \<lbrace>\<lambda>rv s. rv \<longrightarrow> P \<and> Q rv s\<rbrace>"
by (fastforce simp: valid_def)
lemma valid_imp_ex:
"\<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv s. \<exists>x. rv \<longrightarrow> Q rv s x\<rbrace> \<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv s. rv \<longrightarrow> (\<exists>x. Q rv s x)\<rbrace>"
by (fastforce simp: valid_def)
lemma valid_rv_split:
"\<lbrakk>\<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv s. rv \<longrightarrow> Q s\<rbrace>; \<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv s. \<not>rv \<longrightarrow> Q' s\<rbrace>\<rbrakk>
\<Longrightarrow>
\<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv s. if rv then Q s else Q' s\<rbrace>"
by (fastforce simp: valid_def)
lemma hoare_rv_split:
"\<lbrakk>\<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv s. rv \<longrightarrow> (Q rv s)\<rbrace>; \<lbrace>P\<rbrace> f \<lbrace>\<lambda>rv s. (\<not>rv) \<longrightarrow> (Q rv s)\<rbrace>\<rbrakk>
\<Longrightarrow> \<lbrace>P\<rbrace> f \<lbrace>Q\<rbrace>"
"((a, b) \<in> fst (condition C L R s)) = ((C s \<longrightarrow> (a, b) \<in> fst (L s)) \<and> (\<not> C s \<longrightarrow> (a, b) \<in> fst (R s)))"
"\<lbrakk> c s = c' s'; s = s'; \<And>s. c' s \<Longrightarrow> l s = l' s ; \<And>s. \<not> c' s \<Longrightarrow> r s = r' s \<rbrakk> \<Longrightarrow> condition c l r s = condition c' l' r' s'"
apply (clarsimp split: condition_splits)
done
lemma condition_cong [cong, fundef_cong]:
"\<lbrakk> c = c'; \<And>s. c' s \<Longrightarrow> l s = l' s; \<And>s. \<not> c' s \<Longrightarrow> r s = r' s \<rbrakk> \<Longrightarrow> condition c l r = condition c' l' r'"
apply (rule ext)
apply (clarsimp split: condition_splits)
done
(* Alternative definition of no_throw; easier to work with than unfolding validE. *)
lemma no_throw_def': "no_throw P A = (\<forall>s. P s \<longrightarrow> (\<forall>(r, t) \<in> fst (A s). (\<exists>x. r = Inr x)))"
lemma no_throw_bindE: "\<lbrakk> no_throw A X; \<And>a. no_throw B (Y a); \<lbrace> A \<rbrace> X \<lbrace> \<lambda>_. B \<rbrace>,\<lbrace> \<lambda>_ _. True \<rbrace> \<rbrakk> \<Longrightarrow> no_throw A (X >>=E Y)"
lemma no_throw_handle2: "\<lbrakk> \<And>a. no_throw Y (B a); \<lbrace> X \<rbrace> A \<lbrace> \<lambda>_ _. True \<rbrace>,\<lbrace> \<lambda>_. Y \<rbrace> \<rbrakk> \<Longrightarrow> no_throw X (A <handle2> B)"
lemma no_throw_handle: "\<lbrakk> \<And>a. no_throw Y (B a); \<lbrace> X \<rbrace> A \<lbrace> \<lambda>_ _. True \<rbrace>,\<lbrace> \<lambda>_. Y \<rbrace> \<rbrakk> \<Longrightarrow> no_throw X (A <handle> B)"
by (clarsimp simp: modify_def put_def get_def bind_def)
lemma no_fail_False [simp]:
"no_fail (\<lambda>_. False) X"
by (clarsimp simp: no_fail_def)
lemma valid_pre_satisfies_post:
"\<lbrakk> \<And>s r' s'. P s \<Longrightarrow> Q r' s' \<rbrakk> \<Longrightarrow> \<lbrace> P \<rbrace> m \<lbrace> Q \<rbrace>"
by (clarsimp simp: valid_def)
lemma validE_pre_satisfies_post:
"\<lbrakk> \<And>s r' s'. P s \<Longrightarrow> Q r' s'; \<And>s r' s'. P s \<Longrightarrow> R r' s' \<rbrakk> \<Longrightarrow> \<lbrace> P \<rbrace> m \<lbrace> Q \<rbrace>,\<lbrace> R \<rbrace>"
by (clarsimp simp: validE_def2 split: sum.splits)
lemma snd_gets_the [monad_eq]:
"snd (gets_the X s) = (X s = None)"
by (monad_eq simp: gets_the_def gets_def get_def)
lemma validE_K_bind [wp_comb]:
"\<lbrace> P \<rbrace> x \<lbrace> Q \<rbrace>, \<lbrace> E \<rbrace> \<Longrightarrow> \<lbrace> P \<rbrace> K_bind x f \<lbrace> Q \<rbrace>, \<lbrace> E \<rbrace>"
by simp
lemma liftE_K_bind: "liftE ((K_bind (\<lambda>s. A s)) x) = K_bind (liftE (\<lambda>s. A s)) x"
"a s = b s \<Longrightarrow> (a >>= g) s = (b >>= g) s"
by (auto simp:bind_def)
lemma monad_commute_simple:
"\<lbrakk>monad_commute P a b;P s\<rbrakk> \<Longrightarrow> ((do x\<leftarrow>a;y\<leftarrow>b; g x y od) s) = ((do y\<leftarrow>b;x\<leftarrow>a; g x y od) s)"
apply (clarsimp simp:monad_commute_def)
apply (drule spec)
apply (erule(1) impE)
apply (drule_tac g = "(\<lambda>t. g (fst t) (snd t))" in monad_eq)
apply (simp add:bind_assoc)
done
lemma commute_commute:
"monad_commute P f h \<Longrightarrow> monad_commute P h f"