431 lines
18 KiB
Plaintext
431 lines
18 KiB
Plaintext
(*
|
|
* Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
|
|
*
|
|
* SPDX-License-Identifier: BSD-2-Clause
|
|
*)
|
|
|
|
(*
|
|
* A simple CCorres framework extension supporting exceptions on the monadic side.
|
|
*)
|
|
|
|
theory CCorresE
|
|
imports SimplBucket NonDetMonadEx
|
|
begin
|
|
|
|
(*
|
|
* A special form of "ccorres" where either side may throw an
|
|
* exception if the other also throws an exception.
|
|
*)
|
|
definition
|
|
ccorresE :: "('t \<Rightarrow> 's) \<Rightarrow> bool \<Rightarrow> ('p \<Rightarrow> ('t, 'p, 'ee) com option)
|
|
\<Rightarrow> ('s \<Rightarrow> bool) \<Rightarrow> ('t set)
|
|
\<Rightarrow> ('s, unit + unit) nondet_monad \<Rightarrow> ('t, 'p, 'ee) com \<Rightarrow> bool"
|
|
where
|
|
"ccorresE st check_term \<Gamma> G G' \<equiv>
|
|
\<lambda>m c. \<forall>s. G (st s) \<and> (s \<in> G') \<and> \<not> snd (m (st s)) \<longrightarrow>
|
|
((\<forall>t. \<Gamma> \<turnstile> \<langle>c, Normal s\<rangle> \<Rightarrow> t \<longrightarrow>
|
|
(case t of
|
|
Normal s' \<Rightarrow> (Inr (), st s') \<in> fst (m (st s))
|
|
| Abrupt s' \<Rightarrow> (Inl (), st s') \<in> fst (m (st s))
|
|
| _ \<Rightarrow> False))
|
|
\<and> (check_term \<longrightarrow> \<Gamma> \<turnstile> c \<down> Normal s))"
|
|
|
|
lemma ccorresE_cong:
|
|
"\<lbrakk> \<And>s. P s = P' s;
|
|
\<And>s. (s \<in> Q) = (s \<in> Q');
|
|
\<And>s. P' s \<Longrightarrow> f s = f' s;
|
|
\<And>s x. s \<in> Q' \<Longrightarrow> \<Gamma>\<turnstile> \<langle>g, Normal s\<rangle> \<Rightarrow> x = \<Gamma>\<turnstile> \<langle>g', Normal s\<rangle> \<Rightarrow> x \<rbrakk> \<Longrightarrow>
|
|
ccorresE st ct \<Gamma> P Q f g = ccorresE st ct \<Gamma> P' Q' f' g"
|
|
apply atomize
|
|
apply (clarsimp simp: ccorresE_def split: xstate.splits)
|
|
apply (rule iffI)
|
|
apply clarsimp
|
|
apply clarsimp
|
|
done
|
|
|
|
lemma ccorresE_guard_imp:
|
|
"\<lbrakk> ccorresE st ct \<Gamma> Q Q' A B; \<And>s. P s \<Longrightarrow> Q s; \<And>t. t \<in> P' \<Longrightarrow> t \<in> Q' \<rbrakk> \<Longrightarrow> ccorresE st ct \<Gamma> P P' A B"
|
|
apply atomize
|
|
apply (clarsimp simp: ccorresE_def split: xstate.splits)
|
|
done
|
|
|
|
lemma ccorresE_guard_imp_stronger:
|
|
"\<lbrakk> ccorresE st ct \<Gamma> Q Q' A B;
|
|
\<And>s. \<lbrakk> P (st s); s \<in> P' \<rbrakk> \<Longrightarrow> Q (st s);
|
|
\<And>s. \<lbrakk> P (st s); s \<in> P' \<rbrakk> \<Longrightarrow> s \<in> Q' \<rbrakk> \<Longrightarrow>
|
|
ccorresE st ct \<Gamma> P P' A B"
|
|
apply atomize
|
|
apply (clarsimp simp: ccorresE_def split_def split: xstate.splits)
|
|
done
|
|
|
|
lemma ccorresE_assume_pre:
|
|
"\<lbrakk> \<And>s. \<lbrakk> G (st s); s \<in> G' \<rbrakk> \<Longrightarrow>
|
|
ccorresE st ct \<Gamma> (G and (\<lambda>s'. s' = st s)) (G' \<inter> {t'. t' = s}) A B \<rbrakk> \<Longrightarrow>
|
|
ccorresE st ct \<Gamma> G G' A B"
|
|
apply atomize
|
|
apply (clarsimp simp: ccorresE_def)
|
|
done
|
|
|
|
lemma ccorresE_Seq:
|
|
"\<lbrakk> ccorresE st ct \<Gamma> \<top> UNIV L L';
|
|
ccorresE st ct \<Gamma> \<top> UNIV R R' \<rbrakk> \<Longrightarrow>
|
|
ccorresE st ct \<Gamma> \<top> UNIV (doE _ \<leftarrow> L; R odE) (L' ;; R')"
|
|
apply (clarsimp simp: ccorresE_def)
|
|
apply (rule conjI)
|
|
apply clarsimp
|
|
apply (erule exec_Normal_elim_cases)
|
|
apply (clarsimp simp: bindE_def split: xstate.splits)
|
|
apply (frule not_snd_bindI1)
|
|
apply (rotate_tac 1, erule allE, erule impE, force)
|
|
apply (monad_eq simp: split_def Bex_def Ball_def split: sum.splits)
|
|
apply (case_tac s', simp_all)[1]
|
|
apply fast
|
|
apply (erule exec_elim_cases)
|
|
apply fastforce
|
|
apply (erule exec_elim_cases)
|
|
apply clarsimp
|
|
apply auto[1]
|
|
apply clarsimp
|
|
apply (rule terminates.Seq)
|
|
apply monad_eq
|
|
apply (monad_eq simp: Bex_def split_def split: xstate.splits)
|
|
apply (metis Abrupt xstate.exhaust)
|
|
done
|
|
|
|
lemma ccorresE_Cond:
|
|
"\<lbrakk> ccorresE st ct \<Gamma> \<top> C A L';
|
|
ccorresE st ct \<Gamma> \<top> (UNIV - C) A R' \<rbrakk> \<Longrightarrow>
|
|
ccorresE st ct \<Gamma> \<top> UNIV A (Cond C L' R')"
|
|
apply (clarsimp simp: ccorresE_def pred_neg_def)
|
|
apply (rule conjI)
|
|
apply clarsimp
|
|
apply (erule exec_Normal_elim_cases)
|
|
apply (erule_tac x=s in allE, erule impE, fastforce, fastforce)
|
|
apply (erule_tac x=s in allE, erule impE, fastforce, fastforce)
|
|
apply clarsimp
|
|
apply (case_tac "s \<in> C")
|
|
apply (rule terminates.CondTrue, assumption)
|
|
apply (erule allE, erule impE, fastforce)
|
|
apply clarsimp
|
|
apply (rule terminates.CondFalse, assumption)
|
|
apply (erule allE, erule impE, fastforce)
|
|
apply clarsimp
|
|
done
|
|
|
|
lemma ccorresE_Cond_match:
|
|
"\<lbrakk> ccorresE st ct \<Gamma> C C' L L';
|
|
ccorresE st ct \<Gamma> (not C) (UNIV - C') R R';
|
|
\<And>s. C (st s) = (s \<in> C') \<rbrakk> \<Longrightarrow>
|
|
ccorresE st ct \<Gamma> \<top> UNIV (condition C L R) (Cond C' L' R')"
|
|
apply atomize
|
|
apply (clarsimp simp: ccorresE_def pred_neg_def condition_def)
|
|
apply (erule_tac x=s in allE)+
|
|
apply (auto elim!: exec_Normal_elim_cases intro: terminates.CondTrue terminates.CondFalse)
|
|
done
|
|
|
|
lemma ccorresE_Guard:
|
|
"\<lbrakk> ccorresE st ct \<Gamma> \<top> G X Y \<rbrakk> \<Longrightarrow> ccorresE st ct \<Gamma> \<top> G X (Guard F G Y)"
|
|
apply (clarsimp simp: ccorresE_def)
|
|
apply (rule conjI)
|
|
apply clarsimp
|
|
apply (erule exec_Normal_elim_cases, auto)[1]
|
|
apply clarsimp
|
|
apply (rule terminates.Guard, assumption)
|
|
apply force
|
|
done
|
|
|
|
lemma ccorresE_Catch:
|
|
"\<lbrakk>ccorresE st ct \<Gamma> \<top> UNIV A A'; ccorresE st ct \<Gamma> \<top> UNIV B B'\<rbrakk> \<Longrightarrow>
|
|
ccorresE st ct \<Gamma> \<top> UNIV (A <handle> (\<lambda>_. B)) (TRY A' CATCH B' END)"
|
|
apply (clarsimp simp: ccorresE_def)
|
|
apply (rule conjI)
|
|
apply clarsimp
|
|
apply (erule_tac x=s in allE)
|
|
apply (erule exec_Normal_elim_cases)
|
|
apply (monad_eq simp: Bex_def Ball_def split: xstate.splits)
|
|
apply metis
|
|
apply (monad_eq simp: Bex_def Ball_def split: xstate.splits)
|
|
apply fastforce
|
|
apply (monad_eq simp: Bex_def Ball_def split: xstate.splits)
|
|
apply (erule allE, erule (1) impE)
|
|
apply clarsimp
|
|
apply (erule terminates.Catch)
|
|
apply clarsimp
|
|
done
|
|
|
|
lemma ccorresE_Call:
|
|
"\<lbrakk> \<Gamma> X' = Some Z'; ccorresE st ct \<Gamma> \<top> UNIV Z Z' \<rbrakk> \<Longrightarrow>
|
|
ccorresE st ct \<Gamma> \<top> UNIV Z (Call X')"
|
|
apply (clarsimp simp: ccorresE_def)
|
|
apply (rule conjI)
|
|
apply clarsimp
|
|
apply (erule exec_Normal_elim_cases)
|
|
apply (clarsimp)
|
|
apply clarsimp
|
|
apply clarify
|
|
apply (erule terminates.Call)
|
|
apply (erule allE, erule (1) impE)
|
|
apply clarsimp
|
|
done
|
|
|
|
lemma ccorresE_exec_Normal:
|
|
"\<lbrakk> ccorresE st ct \<Gamma> G G' B B'; \<Gamma>\<turnstile> \<langle>B', Normal s\<rangle> \<Rightarrow> Normal t; s \<in> G'; G (st s); \<not> snd (B (st s)) \<rbrakk> \<Longrightarrow> (Inr (), st t) \<in> fst (B (st s))"
|
|
apply (clarsimp simp: ccorresE_def)
|
|
apply force
|
|
done
|
|
|
|
lemma ccorresE_exec_Abrupt:
|
|
"\<lbrakk> ccorresE st ct \<Gamma> G G' B B'; \<Gamma>\<turnstile> \<langle>B', Normal s\<rangle> \<Rightarrow> Abrupt t; s \<in> G'; G (st s); \<not> snd (B (st s)) \<rbrakk> \<Longrightarrow> (Inl (), st t) \<in> fst (B (st s))"
|
|
apply (clarsimp simp: ccorresE_def)
|
|
apply force
|
|
done
|
|
|
|
lemma ccorresE_exec_Fault:
|
|
"\<lbrakk> ccorresE st ct \<Gamma> G G' B B'; \<Gamma>\<turnstile> \<langle>B', Normal s\<rangle> \<Rightarrow> Fault f; s \<in> G'; G (st s); \<not> snd (B (st s)) \<rbrakk> \<Longrightarrow> P"
|
|
apply (clarsimp simp: ccorresE_def)
|
|
apply force
|
|
done
|
|
|
|
lemma ccorresE_exec_Stuck:
|
|
"\<lbrakk> ccorresE st ct \<Gamma> G G' B B'; \<Gamma>\<turnstile> \<langle>B', Normal s\<rangle> \<Rightarrow> Stuck; s \<in> G'; G (st s); \<not> snd (B (st s)) \<rbrakk> \<Longrightarrow> P"
|
|
apply (clarsimp simp: ccorresE_def)
|
|
apply force
|
|
done
|
|
|
|
lemma ccorresE_exec_cases [consumes 5]:
|
|
"\<lbrakk> ccorresE st ct \<Gamma> G G' B B'; \<Gamma>\<turnstile> \<langle>B', Normal s\<rangle> \<Rightarrow> s'; s \<in> G'; G (st s); \<not> snd (B (st s));
|
|
\<And>t'. \<lbrakk> s' = Normal t'; (Inr (), st t') \<in> fst (B (st s)) \<rbrakk> \<Longrightarrow> R;
|
|
\<And>t'. \<lbrakk> s' = Abrupt t'; (Inl (), st t') \<in> fst (B (st s)) \<rbrakk> \<Longrightarrow> R
|
|
\<rbrakk> \<Longrightarrow> R"
|
|
apply atomize
|
|
apply (case_tac s')
|
|
apply (drule ccorresE_exec_Normal, auto)[1]
|
|
apply (drule ccorresE_exec_Abrupt, auto)[1]
|
|
apply (drule ccorresE_exec_Fault, auto)[1]
|
|
apply (drule ccorresE_exec_Stuck, auto)[1]
|
|
done
|
|
|
|
lemma ccorresE_terminates:
|
|
"\<lbrakk> ccorresE st ct \<Gamma> \<top> UNIV B B'; \<not> snd (B (st s)); ct \<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> B' \<down> Normal s"
|
|
by (clarsimp simp: ccorresE_def)
|
|
|
|
lemma exec_While_final_inv':
|
|
assumes exec: "\<Gamma>\<turnstile> \<langle>b, x\<rangle> \<Rightarrow> s'"
|
|
shows
|
|
"\<lbrakk> b = While C B; x = Normal s;
|
|
\<And>s. \<lbrakk> s \<notin> C \<rbrakk> \<Longrightarrow> I s (Normal s);
|
|
\<And>t t'. \<lbrakk> t \<in> C; \<Gamma>\<turnstile> \<langle>B, Normal t\<rangle> \<Rightarrow> Normal t'; I t' s' \<rbrakk> \<Longrightarrow> I t s';
|
|
\<And>t t'. \<lbrakk> t \<in> C; \<Gamma>\<turnstile> \<langle>B, Normal t\<rangle> \<Rightarrow> Abrupt t' \<rbrakk> \<Longrightarrow> I t (Abrupt t');
|
|
\<And>t. \<lbrakk> t \<in> C; \<Gamma>\<turnstile> \<langle>B, Normal t\<rangle> \<Rightarrow> Stuck \<rbrakk> \<Longrightarrow> I t Stuck;
|
|
\<And>t f. \<lbrakk> t \<in> C; \<Gamma>\<turnstile> \<langle>B, Normal t\<rangle> \<Rightarrow> Fault f \<rbrakk> \<Longrightarrow> I t (Fault f) \<rbrakk>
|
|
\<Longrightarrow> I s s'"
|
|
using exec
|
|
apply (induct arbitrary: s rule: exec.induct, simp_all)
|
|
apply clarsimp
|
|
apply atomize
|
|
apply clarsimp
|
|
apply (erule allE, erule (1) impE)
|
|
apply (erule exec_elim_cases, auto)
|
|
done
|
|
|
|
lemma exec_While_final_inv:
|
|
"\<lbrakk> \<Gamma>\<turnstile> \<langle>While C B, Normal s\<rangle> \<Rightarrow> s';
|
|
\<And>s. \<lbrakk> s \<notin> C \<rbrakk> \<Longrightarrow> I s (Normal s);
|
|
\<And>t t'. \<lbrakk> t \<in> C; \<Gamma>\<turnstile> \<langle>B, Normal t\<rangle> \<Rightarrow> Normal t'; I t' s' \<rbrakk> \<Longrightarrow> I t s';
|
|
\<And>t t'. \<lbrakk> t \<in> C; \<Gamma>\<turnstile> \<langle>B, Normal t\<rangle> \<Rightarrow> Abrupt t' \<rbrakk> \<Longrightarrow> I t (Abrupt t');
|
|
\<And>t. \<lbrakk> t \<in> C; \<Gamma>\<turnstile> \<langle>B, Normal t\<rangle> \<Rightarrow> Stuck \<rbrakk> \<Longrightarrow> I t Stuck;
|
|
\<And>t f. \<lbrakk> t \<in> C; \<Gamma>\<turnstile> \<langle>B, Normal t\<rangle> \<Rightarrow> Fault f \<rbrakk> \<Longrightarrow> I t (Fault f) \<rbrakk>
|
|
\<Longrightarrow> I s s'"
|
|
apply (erule exec_While_final_inv', (rule refl)+, simp_all)
|
|
done
|
|
|
|
lemma not_snd_loop_terminatesE:
|
|
"\<not> snd (whileLoopE C B r s) \<Longrightarrow> whileLoop_terminatesE C B r s"
|
|
by (clarsimp simp: whileLoopE_def
|
|
whileLoop_terminatesE_def whileLoop_def)
|
|
|
|
lemma ccorresE_termination':
|
|
assumes no_fail: "\<not> snd (whileLoopE CC BB r s)"
|
|
and s_match: "s = st s' \<and> CC = (\<lambda>_. C) \<and> BB = (\<lambda>_. B)"
|
|
and corres: "ccorresE st ct \<Gamma> \<top> UNIV B B'"
|
|
and cond_match: "\<And>s. C (st s) = (s \<in> C')"
|
|
and ct: "ct"
|
|
shows "\<Gamma>\<turnstile> While C' B' \<down> Normal s'"
|
|
apply (insert not_snd_loop_terminatesE[OF no_fail] s_match)
|
|
apply (insert no_fail)
|
|
apply (induct arbitrary: s' rule: whileLoop_terminatesE_induct [where C=CC and B=BB])
|
|
apply clarsimp
|
|
apply (rule terminates.WhileFalse)
|
|
apply (clarsimp simp: cond_match)
|
|
apply (clarsimp simp: s_match split_def split: sum.splits)
|
|
apply (insert corres)[1]
|
|
apply (clarsimp simp: ccorresE_def s_match)
|
|
apply (frule (1) snd_whileLoopE_first_step)
|
|
apply (erule allE, erule (1) impE)
|
|
apply (clarsimp simp: ct)
|
|
apply (rule terminates.intros)
|
|
apply (clarsimp simp: cond_match)
|
|
apply clarsimp
|
|
apply clarsimp
|
|
apply (erule allE, erule (1) impE)
|
|
apply (clarsimp split: sum.splits xstate.splits)
|
|
apply (erule (1) my_BallE)
|
|
apply clarsimp
|
|
apply (erule allE, erule impE, rule refl)
|
|
apply clarsimp
|
|
apply (drule (1) snd_whileLoopE_unfold)
|
|
apply simp
|
|
apply simp
|
|
done
|
|
|
|
lemma ccorresE_termination:
|
|
assumes no_fail: "\<not> snd (whileLoopE (\<lambda>_. C) (\<lambda>_. B) r s)"
|
|
and s_match: "s = st s'"
|
|
and corres: "ccorresE st ct \<Gamma> \<top> UNIV B B'"
|
|
and cond_match: "\<And>s. C (st s) = (s \<in> C')"
|
|
and ct: "ct"
|
|
shows "\<Gamma>\<turnstile> While C' B' \<down> Normal s'"
|
|
apply (auto intro: ccorresE_termination' [OF no_fail _ corres _ ct] simp: s_match cond_match)
|
|
done
|
|
|
|
lemma ccorresE_While:
|
|
assumes body_refines: "ccorresE st ct \<Gamma> \<top> UNIV B B'"
|
|
and cond_match: "\<And>s. C (st s) = (s \<in> C')"
|
|
shows "ccorresE st ct \<Gamma> G G' (whileLoopE (\<lambda>_. C) (\<lambda>_. B) ()) (While C' B')"
|
|
proof (clarsimp simp: ccorresE_def, rule conjI, clarsimp)
|
|
fix s t
|
|
assume guard_abs: "G (st s)"
|
|
assume guard_conc: "s \<in> G'"
|
|
|
|
assume no_fail: "\<not> snd (whileLoopE (\<lambda>_. C) (\<lambda>_. B) () (st s))"
|
|
assume conc_steps: "\<Gamma>\<turnstile> \<langle>While C' B', Normal s\<rangle> \<Rightarrow> t"
|
|
show "case t of
|
|
Normal s' \<Rightarrow> (Inr (), st s') \<in> fst (whileLoopE (\<lambda>_. C) (\<lambda>_. B) () (st s))
|
|
| Abrupt s' \<Rightarrow> (Inl (), st s') \<in> fst (whileLoopE (\<lambda>_. C) (\<lambda>_. B) () (st s))
|
|
| _ \<Rightarrow> False"
|
|
apply (insert no_fail, erule rev_mp)
|
|
apply (rule exec_While_final_inv [OF conc_steps])
|
|
apply clarsimp
|
|
apply (subst whileLoopE_cond_fail)
|
|
apply (force simp: cond_match)
|
|
apply (force simp: in_returnOk)
|
|
apply clarsimp
|
|
apply (insert ccorresE_exec_Normal [OF body_refines])[1]
|
|
apply clarsimp
|
|
apply atomize
|
|
apply (erule allE2, erule (1) impE)
|
|
apply (frule snd_whileLoopE_first_step, force simp: cond_match)
|
|
apply clarsimp
|
|
apply (erule impE)
|
|
apply (erule (1) snd_whileLoopE_unfold)
|
|
apply (force simp: cond_match)
|
|
apply (clarsimp split: xstate.splits)
|
|
apply (subst whileLoopE_unroll)
|
|
apply (monad_eq simp: cond_match)
|
|
apply blast
|
|
apply (subst whileLoopE_unroll)
|
|
apply (monad_eq simp: cond_match)
|
|
apply clarsimp
|
|
apply (insert ccorresE_exec_Abrupt [OF body_refines])[1]
|
|
apply clarsimp
|
|
apply atomize
|
|
apply (erule allE2, erule (1) impE)
|
|
apply (frule snd_whileLoopE_first_step, force simp: cond_match)
|
|
apply clarsimp
|
|
apply (subst whileLoopE_unroll)
|
|
apply (clarsimp simp: in_bindE in_returnOk cond_match split: condition_splits)
|
|
apply (insert ccorresE_exec_Stuck [OF body_refines])[1]
|
|
apply (rule impI)
|
|
apply (frule snd_whileLoopE_first_step)
|
|
apply (force simp: cond_match)
|
|
apply force
|
|
apply (insert ccorresE_exec_Fault [OF body_refines])[1]
|
|
apply (rule impI)
|
|
apply (frule snd_whileLoopE_first_step)
|
|
apply (force simp: cond_match)
|
|
apply force
|
|
done
|
|
next
|
|
fix s
|
|
assume guard_abs: "G (st s)"
|
|
assume guard_conc: "s \<in> G'"
|
|
assume no_fail: "\<not> snd (whileLoopE (\<lambda>_. C) (\<lambda>_. B) () (st s))"
|
|
show "ct \<longrightarrow> \<Gamma>\<turnstile>While C' B' \<down> Normal s"
|
|
apply clarify
|
|
apply (rule ccorresE_termination [OF no_fail])
|
|
apply (rule refl)
|
|
apply (rule body_refines)
|
|
apply (rule cond_match)
|
|
apply simp
|
|
done
|
|
qed
|
|
|
|
lemma ccorresE_get:
|
|
"(\<And>s. ccorresE st ct \<Gamma> (P and (\<lambda>s'. s' = s)) Q (L s) R) \<Longrightarrow> ccorresE st ct \<Gamma> P Q ((liftE get) >>=E L) R"
|
|
apply atomize
|
|
apply (clarsimp simp: liftE_def get_def bindE_def lift_def bind_def return_def)
|
|
apply (clarsimp simp: ccorresE_def)
|
|
done
|
|
|
|
lemma ccorresE_fail:
|
|
"ccorresE st ct \<Gamma> P Q fail R"
|
|
apply (clarsimp simp: ccorresE_def fail_def)
|
|
done
|
|
|
|
lemma ccorresE_DynCom:
|
|
"\<lbrakk> \<And>t. \<lbrakk> t \<in> P' \<rbrakk> \<Longrightarrow> ccorresE st ct \<Gamma> P (P' \<inter> {t'. t' = t}) A (B t) \<rbrakk> \<Longrightarrow> ccorresE st ct \<Gamma> P P' A (DynCom B)"
|
|
apply atomize
|
|
apply (clarsimp simp: ccorresE_def)
|
|
apply (rule conjI)
|
|
apply clarsimp
|
|
apply (erule exec_Normal_elim_cases)
|
|
apply (erule allE, erule(1) impE)
|
|
apply clarsimp
|
|
apply clarify
|
|
apply (rule terminates.DynCom)
|
|
apply clarsimp
|
|
done
|
|
|
|
lemma ccorresE_Catch_nothrow:
|
|
"\<lbrakk>ccorresE st ct \<Gamma> \<top> UNIV A A'; \<not> exceptions_thrown A'\<rbrakk> \<Longrightarrow>
|
|
ccorresE st ct \<Gamma> \<top> UNIV A (TRY A' CATCH B' END)"
|
|
apply (clarsimp simp: ccorresE_def)
|
|
apply (rule conjI)
|
|
apply clarsimp
|
|
apply (erule exec_Normal_elim_cases)
|
|
apply (frule exceptions_thrown_not_abrupt, simp, simp)
|
|
apply simp
|
|
apply simp
|
|
apply clarify
|
|
apply (rule terminates.Catch)
|
|
apply clarsimp
|
|
apply clarsimp
|
|
apply (drule (1) exceptions_thrown_not_abrupt)
|
|
apply simp
|
|
apply simp
|
|
done
|
|
|
|
lemma ccorresE_symb_exec_l:
|
|
"\<lbrakk> \<And>x. ccorresE st ct \<Gamma> (P' x) Q (B x) C;
|
|
\<And>s. P s \<Longrightarrow> \<lbrace> (=) s \<rbrace> A \<exists>\<lbrace> \<lambda>r' s'. (\<exists>a. r' = Inr a) \<and> s = s' \<rbrace>;
|
|
\<lbrace> P \<rbrace> A \<lbrace> P' \<rbrace>,\<lbrace> \<lambda>_ _. False \<rbrace> \<rbrakk>
|
|
\<Longrightarrow> ccorresE st ct \<Gamma> P Q (A >>=E B) C"
|
|
apply atomize
|
|
apply (clarsimp simp: ccorresE_def validE_def valid_def exs_valid_def)
|
|
apply (erule allE, erule impE, assumption)+
|
|
apply (clarsimp)
|
|
apply (erule (1) my_BallE)
|
|
apply clarsimp
|
|
apply (erule_tac x=aa and y=s in allE2)
|
|
apply clarsimp
|
|
apply (monad_eq simp: Bex_def Ball_def split: xstate.splits)
|
|
apply fastforce
|
|
done
|
|
|
|
lemma ccorresE_no_fail_term:
|
|
" \<lbrakk> ccorresE st ct \<Gamma> G G' A B; no_fail G A; s \<in> G'; G (st s); ct \<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> B \<down> Normal s"
|
|
apply (clarsimp simp: ccorresE_def no_fail_def)
|
|
done
|
|
|
|
end
|