where "measure' = (\<lambda>f. {(a, b). f a < f b})"
lemma in_measure'[simp, code_unfold]:
"((x,y) : measure' f) = (f x < f y)"
by (simp add:measure'_def)
lemma wf_measure' [iff]: "wf (measure' f)"
apply (clarsimp simp: measure'_def)
apply (insert wf_inv_image [OF wellorder_class.wf, where f=f])
apply (clarsimp simp: inv_image_def)
done
lemma wf_wellorder_measure: "wf {(a, b). (M a :: 'a :: wellorder) < M b}"
apply (subgoal_tac "wf (inv_image ({(a, b). a < b}) M)")
apply (clarsimp simp: inv_image_def)
apply (rule wf_inv_image)
apply (rule wellorder_class.wf)
done
section "whileLoop lemmas"
text {*
The following @{const whileLoop} definitions with additional
invariant/variant annotations allow the user to annotate
@{const whileLoop} terms with information that can be used
by automated tools.
*}
definition
"whileLoop_inv (C :: 'a \<Rightarrow> 'b \<Rightarrow> bool) B x (I :: 'a \<Rightarrow> 'b \<Rightarrow> bool) (R :: (('a \<times> 'b) \<times> ('a \<times> 'b)) set) \<equiv> whileLoop C B x"
definition
"whileLoopE_inv (C :: 'a \<Rightarrow> 'b \<Rightarrow> bool) B x (I :: 'a \<Rightarrow> 'b \<Rightarrow> bool) (R :: (('a \<times> 'b) \<times> ('a \<times> 'b)) set) \<equiv> whileLoopE C B x"
lemma whileLoop_add_inv: "whileLoop B C = (\<lambda>x. whileLoop_inv B C x I (measure' M))"
by (clarsimp simp: whileLoop_inv_def)
lemma whileLoopE_add_inv: "whileLoopE B C = (\<lambda>x. whileLoopE_inv B C x I (measure' M))"
by (clarsimp simp: whileLoopE_inv_def)
subsection "Simple base rules"
lemma whileLoop_terminates_unfold:
"\<lbrakk> whileLoop_terminates C B r s; (r', s') \<in> fst (B r s); C r s \<rbrakk>
\<Longrightarrow> whileLoop_terminates C B r' s'"
apply (erule whileLoop_terminates.cases)
apply simp
apply force
done
lemma snd_whileLoop_first_step: "\<lbrakk> \<not> snd (whileLoop C B r s); C r s \<rbrakk> \<Longrightarrow> \<not> snd (B r s)"
apply (subst (asm) whileLoop_unroll)
apply (clarsimp simp: bind_def condition_def)
done
lemma snd_whileLoopE_first_step: "\<lbrakk> \<not> snd (whileLoopE C B r s); C r s \<rbrakk> \<Longrightarrow> \<not> snd (B r s)"
apply (subgoal_tac "\<lbrakk> \<not> snd (whileLoopE C B r s); C r s \<rbrakk> \<Longrightarrow> \<not> snd ((lift B (Inr r)) s)")
apply (clarsimp simp: lift_def)
apply (unfold whileLoopE_def)
apply (erule snd_whileLoop_first_step)
apply clarsimp
done
lemma snd_whileLoop_unfold:
"\<lbrakk> \<not> snd (whileLoop C B r s); C r s; (r', s') \<in> fst (B r s) \<rbrakk> \<Longrightarrow> \<not> snd (whileLoop C B r' s')"
and init: "\<And>r s. \<not> C r s \<Longrightarrow> I r s"
and step: "\<And>r s r' s'. \<lbrakk> C r s; \<forall>(v', s') \<in> fst (B r s). case v' of Inl _ \<Rightarrow> True | Inr r' \<Rightarrow> I r' s' \<rbrakk> \<Longrightarrow> I r s"
shows "I r s"
apply (insert induct)
apply (clarsimp simp: whileLoop_terminatesE_def)
apply (subgoal_tac "(\<lambda>r s. case (Inr r) of Inl x \<Rightarrow> True | Inr x \<Rightarrow> I x s) r s")
subsection "Direct reasoning about whileLoop components"
lemma fst_whileLoop_cond_false:
assumes loop_result: "(r', s') \<in> fst (whileLoop C B r s)"
shows "\<not> C r' s'"
using loop_result
by (rule in_whileLoop_induct, auto)
lemma snd_whileLoop:
assumes init_I: "I r s"
and cond_I: "C r s"
and non_term: "\<And>r. \<lbrace> \<lambda>s. I r s \<and> C r s \<and> \<not> snd (B r s) \<rbrace>
B r \<exists>\<lbrace> \<lambda>r' s'. C r' s' \<and> I r' s' \<rbrace>"
shows "snd (whileLoop C B r s)"
apply (clarsimp simp: whileLoop_def)
apply (rotate_tac)
apply (insert init_I cond_I)
apply (induct rule: whileLoop_terminates.induct)
apply clarsimp
apply (cut_tac r=r in non_term)
apply (clarsimp simp: exs_valid_def)
apply (subst (asm) (2) whileLoop_results.simps)
apply clarsimp
apply (insert whileLoop_results.simps)
apply fast
done
lemma whileLoop_terminates_inv:
assumes init_I: "I r s"
assumes inv: "\<And>r s. \<lbrace>\<lambda>s'. I r s' \<and> C r s' \<and> s' = s \<rbrace> B r \<lbrace> \<lambda>r' s'. I r' s' \<and> ((r', s'), (r, s)) \<in> R \<rbrace>"
assumes wf_R: "wf R"
shows "whileLoop_terminates C B r s"
apply (insert init_I)
using wf_R
apply (induction "(r, s)" arbitrary: r s)
apply atomize
apply (subst whileLoop_terminates_simps)
apply clarsimp
apply (erule use_valid)
apply (rule hoare_strengthen_post, rule inv)
apply force
apply force
done
lemma not_snd_whileLoop:
assumes init_I: "I r s"
and inv_holds: "\<And>r s. \<lbrace>\<lambda>s'. I r s' \<and> C r s' \<and> s' = s \<rbrace> B r \<lbrace> \<lambda>r' s'. I r' s' \<and> ((r', s'), (r, s)) \<in> R \<rbrace>!"
and wf_R: "wf R"
shows "\<not> snd (whileLoop C B r s)"
proof -
{
fix x y
have "\<lbrakk> (x, y) \<in> whileLoop_results C B; x = Some (r, s); y = None \<rbrakk> \<Longrightarrow> False"
apply (insert init_I)
apply (induct arbitrary: r s rule: whileLoop_results.inducts)
apply simp
apply simp
apply (insert snd_validNF [OF inv_holds])[1]
apply blast
apply (drule use_validNF [OF _ inv_holds])
apply simp
apply clarsimp
apply blast
done
}
also have "whileLoop_terminates C B r s"
apply (rule whileLoop_terminates_inv [where I=I, OF init_I _ wf_R])
apply (insert inv_holds)
apply (clarsimp simp: validNF_def)
done
ultimately show ?thesis
by (clarsimp simp: whileLoop_def, blast)
qed
lemma valid_whileLoop:
assumes first_step: "\<And>s. P r s \<Longrightarrow> I r s"
and inv_step: "\<And>r. \<lbrace> \<lambda>s. I r s \<and> C r s \<rbrace> B r \<lbrace> I \<rbrace>"
and final_step: "\<And>r s. \<lbrakk> I r s; \<not> C r s \<rbrakk> \<Longrightarrow> Q r s"
shows "\<lbrace> P r \<rbrace> whileLoop C B r \<lbrace> Q \<rbrace>"
proof -
{
fix r' s' s
assume inv: "I r s"
assume step: "(r', s') \<in> fst (whileLoop C B r s)"
have "I r' s'"
using step inv
apply (induct rule: in_whileLoop_induct)
apply simp
apply (drule use_valid, rule inv_step, auto)
done
}
thus ?thesis
apply (clarsimp simp: valid_def)
apply (drule first_step)
apply (rule final_step, simp)
apply (metis fst_whileLoop_cond_false)
done
qed
lemma whileLoop_wp:
"\<lbrakk> \<And>r. \<lbrace> \<lambda>s. I r s \<and> C r s \<rbrace> B r \<lbrace> I \<rbrace>;
\<And>r s. \<lbrakk> I r s; \<not> C r s \<rbrakk> \<Longrightarrow> Q r s \<rbrakk> \<Longrightarrow>
\<lbrace> I r \<rbrace> whileLoop C B r \<lbrace> Q \<rbrace>"
by (rule valid_whileLoop)
lemma whileLoop_wp_inv [wp]:
"\<lbrakk> \<And>r. \<lbrace>\<lambda>s. I r s \<and> C r s\<rbrace> B r \<lbrace>I\<rbrace>; \<And>r s. \<lbrakk>I r s; \<not> C r s\<rbrakk> \<Longrightarrow> Q r s \<rbrakk>
\<Longrightarrow> \<lbrace> I r \<rbrace> whileLoop_inv C B r I M \<lbrace> Q \<rbrace>"
apply (clarsimp simp: whileLoop_inv_def)
apply (rule valid_whileLoop [where P=I and I=I], auto)
done
lemma validE_whileLoopE:
"\<lbrakk>\<And>s. P r s \<Longrightarrow> I r s;
\<And>r. \<lbrace> \<lambda>s. I r s \<and> C r s \<rbrace> B r \<lbrace> I \<rbrace>,\<lbrace> A \<rbrace>;
\<And>r s. \<lbrakk> I r s; \<not> C r s \<rbrakk> \<Longrightarrow> Q r s
\<rbrakk> \<Longrightarrow> \<lbrace> P r \<rbrace> whileLoopE C B r \<lbrace> Q \<rbrace>,\<lbrace> A \<rbrace>"
apply (clarsimp simp: whileLoopE_def validE_def)
apply (rule valid_whileLoop [where I="\<lambda>r s. (case r of Inl x \<Rightarrow> A x s | Inr x \<Rightarrow> I x s)"
and Q="\<lambda>r s. (case r of Inl x \<Rightarrow> A x s | Inr x \<Rightarrow> Q x s)"])
apply (erule whileLoop_results_bisim [where rt=theRight and st="\<lambda>x. x" and I="\<lambda>r s. case r of Inr x \<Rightarrow> True | _ \<Rightarrow> False"],
apply (erule whileLoop_results_bisim [where rt=theRight and st="\<lambda>x. x" and I="\<lambda>r s. case r of Inr x \<Rightarrow> True | _ \<Rightarrow> False"],
assumes pre: "\<And>s. P r s \<Longrightarrow> I r s"
and inv: "\<And>r s. \<lbrace>\<lambda>s'. I r s' \<and> C r s' \<and> s' = s \<rbrace> B r \<lbrace> \<lambda>r' s'. I r' s' \<and> ((r', s'), (r, s)) \<in> R \<rbrace>!"
and wf: "wf R"
and post_cond: "\<And>r s. \<lbrakk>I r s; \<not> C r s\<rbrakk> \<Longrightarrow> Q r s"
shows "\<lbrace>P r\<rbrace> whileLoop C B r \<lbrace>Q\<rbrace>!"
apply rule
apply (rule valid_whileLoop)
apply fact
apply (insert inv, clarsimp simp: validNF_def
valid_def split: prod.splits, force)[1]
apply (metis post_cond)
apply (unfold no_fail_def)
apply (intro allI impI)
apply (rule not_snd_whileLoop [where I=I and R=R])
apply (auto intro: assms)
done
lemma validNF_whileLoop_inv [wp]:
assumes inv: "\<And>r s. \<lbrace>\<lambda>s'. I r s' \<and> C r s' \<and> s' = s \<rbrace> B r \<lbrace> \<lambda>r' s'. I r' s' \<and> ((r', s'), (r, s)) \<in> R \<rbrace>!"
and wf: "wf R"
and post_cond: "\<And>r s. \<lbrakk>I r s; \<not> C r s\<rbrakk> \<Longrightarrow> Q r s"
shows "\<lbrace>I r\<rbrace> whileLoop_inv C B r I R \<lbrace>Q\<rbrace>!"
apply (clarsimp simp: whileLoop_inv_def)
apply (rule validNF_whileLoop [where I=I and R=R])
apply simp
apply (rule inv)
apply (rule wf)
apply (metis post_cond)
done
lemma validNF_whileLoop_inv_measure [wp]:
assumes inv: "\<And>r s. \<lbrace>\<lambda>s'. I r s' \<and> C r s' \<and> s' = s \<rbrace> B r \<lbrace> \<lambda>r' s'. I r' s' \<and> M r' s' < M r s \<rbrace>!"
and post_cond: "\<And>r s. \<lbrakk>I r s; \<not> C r s\<rbrakk> \<Longrightarrow> Q r s"
shows "\<lbrace>I r\<rbrace> whileLoop_inv C B r I (measure' (\<lambda>(r, s). M r s)) \<lbrace>Q\<rbrace>!"
apply (clarsimp simp: whileLoop_inv_def)
apply (rule validNF_whileLoop [where R="measure' (\<lambda>(r, s). M r s)" and I=I])
apply simp
apply clarsimp
apply (rule inv)
apply simp
apply (metis post_cond)
done
lemma validNF_whileLoop_inv_measure_twosteps:
assumes inv: "\<And>r s. \<lbrace>\<lambda>s'. I r s' \<and> C r s' \<rbrace> B r \<lbrace> \<lambda>r' s'. I r' s' \<rbrace>!"
assumes measure: "\<And>r m. \<lbrace>\<lambda>s. I r s \<and> C r s \<and> M r s = m \<rbrace> B r \<lbrace> \<lambda>r' s'. M r' s' < m \<rbrace>"
and post_cond: "\<And>r s. \<lbrakk>I r s; \<not> C r s\<rbrakk> \<Longrightarrow> Q r s"
shows "\<lbrace>I r\<rbrace> whileLoop_inv C B r I (measure' (\<lambda>(r, s). M r s)) \<lbrace>Q\<rbrace>!"
apply (rule validNF_whileLoop_inv_measure)
apply (rule validNF_weaken_pre)
apply (rule validNF_post_comb_conj_L)
apply (rule inv)
apply (rule measure)
apply fast
apply (metis post_cond)
done
lemma wf_custom_measure:
"\<lbrakk> \<And>a b. (a, b) \<in> R \<Longrightarrow> f a < (f :: 'a \<Rightarrow> nat) b \<rbrakk> \<Longrightarrow> wf R"
by (metis in_measure wf_def wf_measure)
lemma validNF_whileLoopE:
assumes pre: "\<And>s. P r s \<Longrightarrow> I r s"
and inv: "\<And>r s. \<lbrace>\<lambda>s'. I r s' \<and> C r s' \<and> s' = s \<rbrace> B r \<lbrace> \<lambda>r' s'. I r' s' \<and> ((r', s'), (r, s)) \<in> R \<rbrace>,\<lbrace> E \<rbrace>!"
and wf: "wf R"
and post_cond: "\<And>r s. \<lbrakk>I r s; \<not> C r s\<rbrakk> \<Longrightarrow> Q r s"
shows "\<lbrace> P r \<rbrace> whileLoopE C B r \<lbrace> Q \<rbrace>,\<lbrace> E \<rbrace>!"
apply (unfold validE_NF_alt_def whileLoopE_def)
apply (rule validNF_whileLoop [
where I="\<lambda>r s. case r of Inl x \<Rightarrow> E x s | Inr x \<Rightarrow> I x s"
and R="{((r', s'), (r, s)). \<exists>x x'. r' = Inl x' \<and> r = Inr x}
assumes inv: "\<And>r s. \<lbrace>\<lambda>s'. I r s' \<and> C r s' \<and> s' = s \<rbrace> B r \<lbrace> \<lambda>r' s'. I r' s' \<and> ((r', s'), (r, s)) \<in> R \<rbrace>,\<lbrace> E \<rbrace>!"
and wf_R: "wf R"
and post_cond: "\<And>r s. \<lbrakk>I r s; \<not> C r s\<rbrakk> \<Longrightarrow> Q r s"
shows "\<lbrace>I r\<rbrace> whileLoopE_inv C B r I R \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>!"
assumes inv: "\<And>r s. \<lbrace>\<lambda>s'. I r s' \<and> C r s' \<and> s' = s \<rbrace> B r \<lbrace> \<lambda>r' s'. I r' s' \<and> M r' s' < M r s \<rbrace>, \<lbrace> E \<rbrace>!"
and post_cond: "\<And>r s. \<lbrakk>I r s; \<not> C r s\<rbrakk> \<Longrightarrow> Q r s"
shows "\<lbrace>I r\<rbrace> whileLoopE_inv C B r I (measure' (\<lambda>(r, s). M r s)) \<lbrace>Q\<rbrace>,\<lbrace>E\<rbrace>!"
apply (rule validNF_whileLoopE_inv)
apply clarsimp
apply (rule inv)
apply clarsimp
apply (metis post_cond)
done
lemma validNF_whileLoopE_inv_measure_twosteps:
assumes inv: "\<And>r s. \<lbrace>\<lambda>s'. I r s' \<and> C r s' \<rbrace> B r \<lbrace> \<lambda>r' s'. I r' s' \<rbrace>, \<lbrace> E \<rbrace>!"
assumes measure: "\<And>r m. \<lbrace>\<lambda>s. I r s \<and> C r s \<and> M r s = m \<rbrace> B r \<lbrace> \<lambda>r' s'. M r' s' < m \<rbrace>, \<lbrace> \<lambda>_ _. True \<rbrace>"
and post_cond: "\<And>r s. \<lbrakk>I r s; \<not> C r s\<rbrakk> \<Longrightarrow> Q r s"
shows "\<lbrace>I r\<rbrace> whileLoopE_inv C B r I (measure' (\<lambda>(r, s). M r s)) \<lbrace>Q\<rbrace>, \<lbrace>E\<rbrace>!"
apply (rule validNF_whileLoopE_inv_measure)
apply (rule validE_NF_weaken_pre)
apply (rule validE_NF_post_comb_conj_L)
apply (rule inv)
apply (rule measure)
apply fast
apply (metis post_cond)
done
lemma whileLoopE_wp_inv [wp]:
"\<lbrakk> \<And>r. \<lbrace>\<lambda>s. I r s \<and> C r s\<rbrace> B r \<lbrace>I\<rbrace>,\<lbrace>E\<rbrace>; \<And>r s. \<lbrakk>I r s; \<not> C r s\<rbrakk> \<Longrightarrow> Q r s \<rbrakk>
\<Longrightarrow> \<lbrace> I r \<rbrace> whileLoopE_inv C B r I M \<lbrace> Q \<rbrace>,\<lbrace> E \<rbrace>"
apply (clarsimp simp: whileLoopE_inv_def)
apply (rule validE_whileLoopE [where I=I], auto)
done
subsection "Stronger whileLoop rules"
lemma whileLoop_rule_strong:
assumes init_U: "\<lbrace> \<lambda>s'. s' = s \<rbrace> whileLoop C B r \<lbrace> \<lambda>r s. (r, s) \<in> fst Q \<rbrace>"
and path_exists: "\<And>r'' s''. \<lbrakk> (r'', s'') \<in> fst Q \<rbrakk> \<Longrightarrow> \<lbrace> \<lambda>s'. s' = s \<rbrace> whileLoop C B r \<exists>\<lbrace> \<lambda>r s. r = r'' \<and> s = s'' \<rbrace>"
and loop_fail: "snd Q \<Longrightarrow> snd (whileLoop C B r s)"
and loop_nofail: "\<not> snd Q \<Longrightarrow> \<lbrace> \<lambda>s'. s' = s \<rbrace> whileLoop C B r \<lbrace> \<lambda>_ _. True \<rbrace>!"
assumes init_U: "\<lbrace> \<lambda>s'. s' = s \<rbrace> whileLoop C B r \<lbrace> \<lambda>r s. (r, s) \<in> fst Q \<rbrace>!"
and path_exists: "\<And>r'' s''. \<lbrakk> (r'', s'') \<in> fst Q \<rbrakk> \<Longrightarrow> \<lbrace> \<lambda>s'. s' = s \<rbrace> whileLoop C B r \<exists>\<lbrace> \<lambda>r s. r = r'' \<and> s = s'' \<rbrace>"