lib+proof: rename bind_assoc_reverse to bind_assoc_return_reverse
This also improves the style of this lemma Signed-off-by: Michael McInerney <michael.mcinerney@proofcraft.systems>
This commit is contained in:
parent
3981e9a60e
commit
27d838af86
|
@ -388,9 +388,17 @@ lemma bind_assoc2:
|
||||||
"(do x \<leftarrow> a; _ \<leftarrow> b; c x od) = (do x \<leftarrow> (do x' \<leftarrow> a; _ \<leftarrow> b; return x' od); c x od)"
|
"(do x \<leftarrow> a; _ \<leftarrow> b; c x od) = (do x \<leftarrow> (do x' \<leftarrow> a; _ \<leftarrow> b; return x' od); c x od)"
|
||||||
by (simp add: bind_assoc)
|
by (simp add: bind_assoc)
|
||||||
|
|
||||||
lemma bind_assoc_reverse:
|
lemma bind_assoc_return_reverse:
|
||||||
"(do x \<leftarrow> A; _ \<leftarrow> B x; C x od) =
|
"do x \<leftarrow> f;
|
||||||
(do x \<leftarrow> do x \<leftarrow> A; _ \<leftarrow> B x; return x od; C x od)"
|
_ \<leftarrow> g x;
|
||||||
|
h x
|
||||||
|
od =
|
||||||
|
do x \<leftarrow> do x \<leftarrow> f;
|
||||||
|
_ \<leftarrow> g x;
|
||||||
|
return x
|
||||||
|
od;
|
||||||
|
h x
|
||||||
|
od"
|
||||||
by (simp only: bind_assoc return_bind)
|
by (simp only: bind_assoc return_bind)
|
||||||
|
|
||||||
lemma if_bind:
|
lemma if_bind:
|
||||||
|
|
|
@ -827,7 +827,7 @@ text \<open>
|
||||||
state.
|
state.
|
||||||
|
|
||||||
The extra return statement on the Haskell side allows us to establish a nontrivial return relation
|
The extra return statement on the Haskell side allows us to establish a nontrivial return relation
|
||||||
between the values set on the concrete and abstract side. The @{thm bind_assoc_reverse} rule
|
between the values set on the concrete and abstract side. The @{thm bind_assoc_return_reverse} rule
|
||||||
may assist with rewriting statements to add the extra return needed by this rule\<close>
|
may assist with rewriting statements to add the extra return needed by this rule\<close>
|
||||||
lemma ccorres_call_getter_setter:
|
lemma ccorres_call_getter_setter:
|
||||||
assumes cul: "ccorresG sr \<Gamma> (=) xf' P (i ` P') [] getter (Call f)"
|
assumes cul: "ccorresG sr \<Gamma> (=) xf' P (i ` P') [] getter (Call f)"
|
||||||
|
|
|
@ -5329,7 +5329,7 @@ lemma corres_retype_region_createNewCaps:
|
||||||
\<comment> \<open>CapTable\<close>
|
\<comment> \<open>CapTable\<close>
|
||||||
apply (subst retype_region2_extra_ext_trivial)
|
apply (subst retype_region2_extra_ext_trivial)
|
||||||
apply (simp add: APIType_map2_def)
|
apply (simp add: APIType_map2_def)
|
||||||
apply (subst bind_assoc_reverse[of "createObjects y n (KOCTE makeObject) us"])
|
apply (subst bind_assoc_return_reverse[of "createObjects y n (KOCTE makeObject) us"])
|
||||||
apply (subst liftM_def
|
apply (subst liftM_def
|
||||||
[of "map (\<lambda>addr. capability.CNodeCap addr us 0 0)", symmetric])
|
[of "map (\<lambda>addr. capability.CNodeCap addr us 0 0)", symmetric])
|
||||||
apply simp
|
apply simp
|
||||||
|
|
|
@ -5381,7 +5381,7 @@ lemma corres_retype_region_createNewCaps:
|
||||||
\<comment> \<open>CapTable\<close>
|
\<comment> \<open>CapTable\<close>
|
||||||
apply (subst retype_region2_extra_ext_trivial)
|
apply (subst retype_region2_extra_ext_trivial)
|
||||||
apply (simp add: APIType_map2_def)
|
apply (simp add: APIType_map2_def)
|
||||||
apply (subst bind_assoc_reverse[of "createObjects y n (KOCTE makeObject) us"])
|
apply (subst bind_assoc_return_reverse[of "createObjects y n (KOCTE makeObject) us"])
|
||||||
apply (subst liftM_def
|
apply (subst liftM_def
|
||||||
[of "map (\<lambda>addr. capability.CNodeCap addr us 0 0)", symmetric])
|
[of "map (\<lambda>addr. capability.CNodeCap addr us 0 0)", symmetric])
|
||||||
apply simp
|
apply simp
|
||||||
|
|
|
@ -5162,7 +5162,7 @@ lemma corres_retype_region_createNewCaps:
|
||||||
\<comment> \<open>CapTable\<close>
|
\<comment> \<open>CapTable\<close>
|
||||||
apply (subst retype_region2_extra_ext_trivial)
|
apply (subst retype_region2_extra_ext_trivial)
|
||||||
apply (simp add: APIType_map2_def)
|
apply (simp add: APIType_map2_def)
|
||||||
apply (subst bind_assoc_reverse[of "createObjects y n (KOCTE makeObject) us"])
|
apply (subst bind_assoc_return_reverse[of "createObjects y n (KOCTE makeObject) us"])
|
||||||
apply (subst liftM_def[of "map (\<lambda>addr. capability.CNodeCap addr us 0 0)", symmetric])
|
apply (subst liftM_def[of "map (\<lambda>addr. capability.CNodeCap addr us 0 0)", symmetric])
|
||||||
apply simp
|
apply simp
|
||||||
apply (rule corres_rel_imp)
|
apply (rule corres_rel_imp)
|
||||||
|
|
|
@ -5436,7 +5436,7 @@ lemma corres_retype_region_createNewCaps:
|
||||||
\<comment> \<open>CapTable\<close>
|
\<comment> \<open>CapTable\<close>
|
||||||
apply (subst retype_region2_extra_ext_trivial)
|
apply (subst retype_region2_extra_ext_trivial)
|
||||||
apply (simp add: APIType_map2_def)
|
apply (simp add: APIType_map2_def)
|
||||||
apply (subst bind_assoc_reverse[of "createObjects y n (KOCTE makeObject) us"])
|
apply (subst bind_assoc_return_reverse[of "createObjects y n (KOCTE makeObject) us"])
|
||||||
apply (subst liftM_def[of "map (\<lambda>addr. capability.CNodeCap addr us 0 0)", symmetric])
|
apply (subst liftM_def[of "map (\<lambda>addr. capability.CNodeCap addr us 0 0)", symmetric])
|
||||||
apply simp
|
apply simp
|
||||||
apply (rule corres_rel_imp)
|
apply (rule corres_rel_imp)
|
||||||
|
|
Loading…
Reference in New Issue