\<rbrakk> \<Longrightarrow> corresXF st ret_state ex_state P M M'"
apply atomize
apply (clarsimp simp: corresXF_def)
apply (erule_tac x=s in allE, erule (1) impE)
apply (erule_tac x=s in allE, erule (1) impE)
apply (erule_tac x=s in allE, erule (1) impE)
apply (clarsimp split: sum.splits)
apply auto
done
lemma corresXF_assume_pre:
"\<lbrakk> \<And>s s'. \<lbrakk> P s'; s = st s' \<rbrakk> \<Longrightarrow> corresXF st xf_normal xf_exception P L R \<rbrakk> \<Longrightarrow> corresXF st xf_normal xf_exception P L R"
apply atomize
apply (clarsimp simp: corresXF_def)
apply force
done
lemma corresXF_guard_imp:
"\<lbrakk> corresXF st xf_normal xf_exception Q f g; \<And>s. P s \<Longrightarrow> Q s \<rbrakk>
\<Longrightarrow> corresXF st xf_normal xf_exception P f g"
apply (clarsimp simp: corresXF_def)
done
lemma corresXF_return:
"\<lbrakk> \<And>s. \<lbrakk> P s \<rbrakk> \<Longrightarrow> xf_normal b s = a \<rbrakk> \<Longrightarrow>
corresXF st xf_normal xf_exception P (returnOk a) (returnOk b)"
"\<lbrakk> corresXF st V E P L L'; \<And>x y. corresXF st V' E (P' x y) (R x) (R' y); \<lbrace> Q \<rbrace> L' \<lbrace> \<lambda>r s. P' (V r s) r s \<rbrace>, \<lbrace> \<lambda>_. \<top> \<rbrace>; \<And>s. Q s \<Longrightarrow> P s \<rbrakk> \<Longrightarrow>
apply (erule corresXF_simple_join [where P'="\<lambda>a b s. (case b of Inl r \<Rightarrow> a = Inl (E r s) | Inr r \<Rightarrow> a = Inr (V r s) \<and> P' (theRight a) r s)"])
"\<lbrakk> corresXF st V E P L L'; \<And>x y. corresXF st V E' (P' x y) (R x) (R' y); \<lbrace> Q \<rbrace> L' \<lbrace> \<lambda>_. \<top> \<rbrace>, \<lbrace> \<lambda>r s. P' (E r s) r s \<rbrace>; \<And>s. Q s \<Longrightarrow> P s \<rbrakk> \<Longrightarrow>
corresXF st V E' Q ( L <handle2> R) (L' <handle2> R')"
apply (erule corresXF_simple_join [where P'="\<lambda>a b s. (case b of Inr r \<Rightarrow> a = Inr (V r s) | Inl r \<Rightarrow> a = Inl (E r s) \<and> P' (theLeft a) r s)"])
"\<lbrakk> corresXF st V E P L L'; corresXF st V E P R R'; \<And>s. P s \<Longrightarrow> A (st s) = A' s \<rbrakk> \<Longrightarrow>
corresXF st V E P (condition A L R) (condition A' L' R')"
apply atomize
apply (clarsimp simp: corresXF_def)
apply (erule_tac x=s in allE)
apply (erule_tac x=s in allE)
apply (erule_tac x=s in allE)
apply (clarsimp split: condition_splits)
done
(* The concrete loop "B" terminates if the abstract loop "A" also terminates. *)
lemma corresXF_simple_loop_terminates:
assumes induct: "whileLoop_terminates C' A r' s'"
and s_match1: "s' = st s"
and s_match2: "r' = xf r s"
and body_corres: "\<And>x y. corresXF_simple st xf (\<lambda>s. P y s \<and> x = xf y s) (A x) (B y)"
and no_fail: "\<not> snd (whileLoop C' A r' s')"
and cond_match: "\<And>s r. P r s \<Longrightarrow> C r s = C' (xf r s) (st s)"
and precond: "P r s"
and pred_inv: "\<And>r. \<lbrace> \<lambda>s. P r s \<and> C r s \<and> \<not> snd (whileLoop C' A (xf r s) (st s)) \<rbrace> B r \<lbrace> \<lambda>r s. P r s \<rbrace>"
assumes body_corres: "\<And>x y. corresXF_simple st xf (\<lambda>s. P x s \<and> y = xf x s) (A y) (B x)"
and cond_match: "\<And>s r. P r s \<Longrightarrow> C r s = C' (xf r s) (st s)"
and pred_inv: "\<And>r. \<lbrace> \<lambda>s. P r s \<and> C r s \<and> \<not> snd (whileLoop C' A (xf r s) (st s)) \<rbrace> B r \<lbrace> \<lambda>r s. P r s \<rbrace>"
and pred_eq: "\<And>s. P' x s \<Longrightarrow> y = xf x s"
and pred_imply: "\<And>s. P' x s \<Longrightarrow> P x s"
and P: "P' x s"
and no_fail_abs: "\<not> snd (whileLoop C' A y (st s))"
shows "\<not> snd (whileLoop C B x s)"
proof -
(* If the concrete body fails, so will the abstract body. *)
have conc_fail_impl_abs_fail:
"\<And>r s. \<lbrakk> P r s; snd (B r s) \<rbrakk> \<Longrightarrow> snd (A (xf r s) (st s))"
by (metis (mono_tags) body_corres corresXF_simple_fail)
have pred_eq': "y = xf x s"
by (auto intro: pred_eq P)
(* If the abstract loop terminates, so will the concrete
* loop. *)
have loop_term: "whileLoop_terminates C' A (xf x s) (st s) \<Longrightarrow> whileLoop_terminates C B x s"
apply (erule corresXF_simple_loop_terminates [where xf=xf and st=st and P="\<lambda>r s. P r s"])
apply simp
apply simp
apply fact
apply (metis P no_fail_abs pred_eq)
apply fact
apply (metis P pred_imply)
apply fact
done
(* Assume that the concrete spec fails. Thus,
* the abstract spec will also fail. *)
{
assume conc_fail: "snd (whileLoop C B x s)"
have "snd (whileLoop C' A (xf x s) (st s))"
using pred_imply [OF P] pred_eq'
proof (induct arbitrary: y rule: snd_whileLoop_induct [OF conc_fail])
(* If the concrete loop doesn't terminate,
* we need to prove that the abstract loop fails. *)
fix i
assume no_term: "\<not> whileLoop_terminates C B x s"
show ?thesis
by (metis loop_term no_term snd_conv whileLoop_def)
next
fix r s i
assume conc_body_fail: "snd (B r s)"
assume cond_true: "C r s"
assume pred_eq: "i = xf r s"
assume P: "P r s"
(* If the concrete body is going to fail, so must the
* abstract body. *)
have "snd (A (xf r s) (st s))"
by (metis P conc_body_fail conc_fail_impl_abs_fail pred_eq)
thus "snd (whileLoop C' A (xf r s) (st s))"
by (metis P cond_match cond_true pred_eq snd_whileLoop_first_step)
next
fix r s i r' s'
assume P: "P r s"
assume cond_true: "C r s"
assume conc_step: "(r', s') \<in> fst (B r s)"
assume conc_fail: "snd (whileLoop C B r' s')"
assume cond_induct: "\<And>i. \<lbrakk> P r' s'; i = xf r' s' \<rbrakk> \<Longrightarrow> snd (whileLoop C' A (xf r' s') (st s'))"
assume pred_eq: "i = xf r s"
show "snd (whileLoop C' A (xf r s) (st s))"
proof (rule ccontr)
assume abs_no_fail: "\<not> snd (whileLoop C' A (xf r s) (st s))"
(* As the abstract doesn't fail, it must refine. *)
have abs_step: "(xf r' s', st s') \<in> fst (A (xf r s) (st s))"
(* The intermediate step fulfills the precondition. *)
have P_step: "P r' s'"
apply (rule use_valid [OF conc_step pred_inv])
apply (metis cond_true P pred_eq abs_no_fail)
done
(* Inductive condition is true. *)
have abs_induct: "snd (whileLoop C' A (xf r' s') (st s'))"
by (metis P_step cond_induct)
show False
by (metis (full_types) P abs_induct abs_no_fail abs_step cond_match cond_true pred_eq snd_whileLoop_unfold)
qed
qed
}
thus "\<not> snd (whileLoop C B x s)"
by (metis no_fail_abs pred_eq')
qed
lemma corresXF_simple_while:
assumes body_corres: "\<And>x y. corresXF_simple st xf (\<lambda>s. P x s \<and> y = xf x s) (A y) (B x)"
and cond_match: "\<And>s r. P r s \<Longrightarrow> C r s = C' (xf r s) (st s)"
and pred_inv: "\<And>r. \<lbrace> \<lambda>s. P r s \<and> C r s \<and> \<not> snd (whileLoop C' A (xf r s) (st s)) \<rbrace> B r \<lbrace> \<lambda>r s. P r s \<rbrace>"
and pred_imply: "\<And>s. P' x s \<Longrightarrow> P x s"
and pred_init: "\<And>s. P' x s \<Longrightarrow> y = xf x s"
shows "corresXF_simple st xf (P' x) (whileLoop C' A y) (whileLoop C B x)"
"\<lbrakk> corresXF_simple st xf P A C; \<And>s. P' s \<Longrightarrow> P s \<rbrakk> \<Longrightarrow> corresXF_simple st xf P' A C"
by (clarsimp simp: corresXF_simple_def)
lemma corresXF_simple_cong:
"\<lbrakk> st = st'; xf = xf'; \<And>s. P s = P' s; \<And>s. P' s \<Longrightarrow> A (st s) = A' (st s); \<And>s. P' s \<Longrightarrow> B s = B' s \<rbrakk>
\<Longrightarrow> corresXF_simple st xf P A B = corresXF_simple st xf P' A' B'"
by (auto simp: corresXF_simple_def)
lemma corresXF_while:
assumes body_corres: "\<And>x y. corresXF st ret ex (\<lambda>s. P x s \<and> y = ret x s) (\<lambda>s. A y s) (B x)"
and cond_match: "\<And>s r. P r s \<Longrightarrow> C r s = C' (ret r s) (st s)"
and pred_inv: "\<And>r. \<lbrace> \<lambda>s. P r s \<and> C r s \<and> \<not> snd (whileLoopE C' A (ret r s) (st s)) \<rbrace>
B r \<lbrace> \<lambda>r s. P r s \<rbrace>,\<lbrace> \<lambda>_ _. True \<rbrace>"
and init_match: "\<And>s. P' x s \<Longrightarrow> y = ret x s"
and pred_imply: "\<And>s. P' x s \<Longrightarrow> P x s"
shows "corresXF st ret ex (P' x) (whileLoopE C' A y) (whileLoopE C B x)"
apply (subst corresXF_simple_corresXF[symmetric])
apply (clarsimp simp: whileLoopE_def)
apply (rule corresXF_simple_weaken_pre)
apply (rule corresXF_simple_while [where
P ="\<lambda>x s. (case x of Inl _ \<Rightarrow> True| Inr v \<Rightarrow> P v s)"
assumes body_corres: "\<And>x y. corresXF st ret ex (\<lambda>s. P x s \<and> y = ret x s) (\<lambda>s. A y s) (B x)"
and cond_match: "\<And>s r. \<lbrakk> P r s; G (ret r s) (st s) \<rbrakk> \<Longrightarrow> C r s = C' (ret r s) (st s)"
and pred_inv: "\<And>r. \<lbrace> \<lambda>s. P r s \<and> C r s \<and> \<not> snd (whileLoopE C' A (ret r s) (st s)) \<and> G (ret r s) (st s) \<rbrace>
B r \<lbrace> \<lambda>r s. G (ret r s) (st s) \<longrightarrow> P r s \<rbrace>,\<lbrace> \<lambda>_ _. True \<rbrace>"
and pred_imply: "\<And>s. \<lbrakk> G y (st s); P' x s \<rbrakk> \<Longrightarrow> P x s"
and init_match: "\<And>s. \<lbrakk> G y (st s); P' x s \<rbrakk> \<Longrightarrow> y = ret x s"
shows "corresXF st ret ex (P' x)
(doE
_ \<leftarrow> guardE (G y);
whileLoopE C' (\<lambda>i. (doE
r \<leftarrow> A i;
_ \<leftarrow> guardE (G r);
returnOk r
odE)) y
odE)
(whileLoopE C B x)"
proof -
have new_body_fails_more:
"\<And>i s. snd (whileLoopE C' A i s) \<Longrightarrow>
"\<lbrakk> ac_corres st ct G rx P' A C; \<lbrace> \<lambda>s. P s \<rbrace> A \<lbrace> \<lambda>rv s. Q rv s \<rbrace>, \<lbrace> \<lambda>rv s. True \<rbrace>!; \<And>s. P (st s) \<Longrightarrow> P' s \<rbrakk>
"\<lbrakk> ac_corres st ct G rx P' A C; \<lbrace> \<lambda>s. P s \<rbrace> A \<lbrace> \<lambda>rv s. Q rv s \<rbrace>, \<lbrace> \<lambda>rv s. True \<rbrace>!;
\<And>s. P (st s) \<Longrightarrow> P' s; ct \<rbrakk>