bulwahn@27656
|
1 |
theory Relational
|
haftmann@28744
|
2 |
imports Array Ref
|
bulwahn@27656
|
3 |
begin
|
bulwahn@27656
|
4 |
|
bulwahn@27656
|
5 |
section{* Definition of the Relational framework *}
|
bulwahn@27656
|
6 |
|
bulwahn@27656
|
7 |
text {* The crel predicate states that when a computation c runs with the heap h
|
bulwahn@27656
|
8 |
will result in return value r and a heap h' (if no exception occurs). *}
|
bulwahn@27656
|
9 |
|
bulwahn@27656
|
10 |
definition crel :: "'a Heap \<Rightarrow> heap \<Rightarrow> heap \<Rightarrow> 'a \<Rightarrow> bool"
|
bulwahn@27656
|
11 |
where
|
haftmann@37709
|
12 |
crel_def': "crel c h h' r \<longleftrightarrow> Heap_Monad.execute c h = Some (r, h')"
|
bulwahn@27656
|
13 |
|
bulwahn@27656
|
14 |
lemma crel_def: -- FIXME
|
haftmann@37709
|
15 |
"crel c h h' r \<longleftrightarrow> Some (r, h') = Heap_Monad.execute c h"
|
bulwahn@27656
|
16 |
unfolding crel_def' by auto
|
bulwahn@27656
|
17 |
|
bulwahn@27656
|
18 |
lemma crel_deterministic: "\<lbrakk> crel f h h' a; crel f h h'' b \<rbrakk> \<Longrightarrow> (a = b) \<and> (h' = h'')"
|
bulwahn@27656
|
19 |
unfolding crel_def' by auto
|
bulwahn@27656
|
20 |
|
bulwahn@27656
|
21 |
section {* Elimination rules *}
|
bulwahn@27656
|
22 |
|
bulwahn@27656
|
23 |
text {* For all commands, we define simple elimination rules. *}
|
bulwahn@27656
|
24 |
(* FIXME: consumes 1 necessary ?? *)
|
bulwahn@27656
|
25 |
|
bulwahn@27656
|
26 |
subsection {* Elimination rules for basic monadic commands *}
|
bulwahn@27656
|
27 |
|
bulwahn@27656
|
28 |
lemma crelE[consumes 1]:
|
bulwahn@27656
|
29 |
assumes "crel (f >>= g) h h'' r'"
|
bulwahn@27656
|
30 |
obtains h' r where "crel f h h' r" "crel (g r) h' h'' r'"
|
haftmann@37709
|
31 |
using assms by (auto simp add: crel_def bindM_def split: option.split_asm)
|
bulwahn@27656
|
32 |
|
bulwahn@27656
|
33 |
lemma crelE'[consumes 1]:
|
bulwahn@27656
|
34 |
assumes "crel (f >> g) h h'' r'"
|
bulwahn@27656
|
35 |
obtains h' r where "crel f h h' r" "crel g h' h'' r'"
|
bulwahn@27656
|
36 |
using assms
|
bulwahn@27656
|
37 |
by (elim crelE) auto
|
bulwahn@27656
|
38 |
|
bulwahn@27656
|
39 |
lemma crel_return[consumes 1]:
|
bulwahn@27656
|
40 |
assumes "crel (return x) h h' r"
|
bulwahn@27656
|
41 |
obtains "r = x" "h = h'"
|
bulwahn@27656
|
42 |
using assms
|
bulwahn@27656
|
43 |
unfolding crel_def return_def by simp
|
bulwahn@27656
|
44 |
|
bulwahn@27656
|
45 |
lemma crel_raise[consumes 1]:
|
bulwahn@27656
|
46 |
assumes "crel (raise x) h h' r"
|
bulwahn@27656
|
47 |
obtains "False"
|
bulwahn@27656
|
48 |
using assms
|
bulwahn@27656
|
49 |
unfolding crel_def raise_def by simp
|
bulwahn@27656
|
50 |
|
bulwahn@27656
|
51 |
lemma crel_if:
|
bulwahn@27656
|
52 |
assumes "crel (if c then t else e) h h' r"
|
bulwahn@27656
|
53 |
obtains "c" "crel t h h' r"
|
bulwahn@27656
|
54 |
| "\<not>c" "crel e h h' r"
|
bulwahn@27656
|
55 |
using assms
|
bulwahn@27656
|
56 |
unfolding crel_def by auto
|
bulwahn@27656
|
57 |
|
bulwahn@27656
|
58 |
lemma crel_option_case:
|
bulwahn@27656
|
59 |
assumes "crel (case x of None \<Rightarrow> n | Some y \<Rightarrow> s y) h h' r"
|
bulwahn@27656
|
60 |
obtains "x = None" "crel n h h' r"
|
bulwahn@27656
|
61 |
| y where "x = Some y" "crel (s y) h h' r"
|
bulwahn@27656
|
62 |
using assms
|
bulwahn@27656
|
63 |
unfolding crel_def by auto
|
bulwahn@27656
|
64 |
|
bulwahn@27656
|
65 |
lemma crel_mapM:
|
bulwahn@27656
|
66 |
assumes "crel (mapM f xs) h h' r"
|
bulwahn@27656
|
67 |
assumes "\<And>h h'. P f [] h h' []"
|
bulwahn@27656
|
68 |
assumes "\<And>h h1 h' x xs y ys. \<lbrakk> crel (f x) h h1 y; crel (mapM f xs) h1 h' ys; P f xs h1 h' ys \<rbrakk> \<Longrightarrow> P f (x#xs) h h' (y#ys)"
|
bulwahn@27656
|
69 |
shows "P f xs h h' r"
|
bulwahn@27656
|
70 |
using assms(1)
|
bulwahn@27656
|
71 |
proof (induct xs arbitrary: h h' r)
|
bulwahn@27656
|
72 |
case Nil with assms(2) show ?case
|
bulwahn@27656
|
73 |
by (auto elim: crel_return)
|
bulwahn@27656
|
74 |
next
|
bulwahn@27656
|
75 |
case (Cons x xs)
|
bulwahn@27656
|
76 |
from Cons(2) obtain h1 y ys where crel_f: "crel (f x) h h1 y"
|
bulwahn@27656
|
77 |
and crel_mapM: "crel (mapM f xs) h1 h' ys"
|
bulwahn@27656
|
78 |
and r_def: "r = y#ys"
|
haftmann@28145
|
79 |
unfolding mapM.simps
|
bulwahn@27656
|
80 |
by (auto elim!: crelE crel_return)
|
bulwahn@27656
|
81 |
from Cons(1)[OF crel_mapM] crel_mapM crel_f assms(3) r_def
|
bulwahn@27656
|
82 |
show ?case by auto
|
bulwahn@27656
|
83 |
qed
|
bulwahn@27656
|
84 |
|
bulwahn@27656
|
85 |
lemma crel_heap:
|
bulwahn@27656
|
86 |
assumes "crel (Heap_Monad.heap f) h h' r"
|
bulwahn@27656
|
87 |
obtains "h' = snd (f h)" "r = fst (f h)"
|
haftmann@37709
|
88 |
using assms by (cases "f h") (simp add: crel_def)
|
haftmann@37709
|
89 |
|
bulwahn@27656
|
90 |
|
bulwahn@27656
|
91 |
subsection {* Elimination rules for array commands *}
|
bulwahn@27656
|
92 |
|
bulwahn@27656
|
93 |
lemma crel_length:
|
haftmann@37716
|
94 |
assumes "crel (len a) h h' r"
|
haftmann@37716
|
95 |
obtains "h = h'" "r = Array.length a h'"
|
bulwahn@27656
|
96 |
using assms
|
haftmann@37716
|
97 |
unfolding Array.len_def
|
bulwahn@27656
|
98 |
by (elim crel_heap) simp
|
bulwahn@27656
|
99 |
|
bulwahn@27656
|
100 |
(* Strong version of the lemma for this operation is missing *)
|
bulwahn@27656
|
101 |
lemma crel_new_weak:
|
bulwahn@27656
|
102 |
assumes "crel (Array.new n v) h h' r"
|
bulwahn@27656
|
103 |
obtains "get_array r h' = List.replicate n v"
|
haftmann@37713
|
104 |
using assms unfolding Array.new_def
|
haftmann@37713
|
105 |
by (elim crel_heap) (auto simp: array_def Let_def split_def)
|
bulwahn@27656
|
106 |
|
bulwahn@27656
|
107 |
lemma crel_nth[consumes 1]:
|
bulwahn@27656
|
108 |
assumes "crel (nth a i) h h' r"
|
haftmann@37716
|
109 |
obtains "r = (get_array a h) ! i" "h = h'" "i < Array.length a h"
|
bulwahn@27656
|
110 |
using assms
|
haftmann@28145
|
111 |
unfolding nth_def
|
bulwahn@27656
|
112 |
by (auto elim!: crelE crel_if crel_raise crel_length crel_heap)
|
bulwahn@27656
|
113 |
|
bulwahn@27656
|
114 |
lemma crel_upd[consumes 1]:
|
bulwahn@27656
|
115 |
assumes "crel (upd i v a) h h' r"
|
haftmann@37716
|
116 |
obtains "r = a" "h' = Array.change a i v h"
|
bulwahn@27656
|
117 |
using assms
|
haftmann@28145
|
118 |
unfolding upd_def
|
bulwahn@27656
|
119 |
by (elim crelE crel_if crel_return crel_raise
|
bulwahn@27656
|
120 |
crel_length crel_heap) auto
|
bulwahn@27656
|
121 |
|
bulwahn@27656
|
122 |
(* Strong version of the lemma for this operation is missing *)
|
bulwahn@27656
|
123 |
lemma crel_of_list_weak:
|
bulwahn@27656
|
124 |
assumes "crel (Array.of_list xs) h h' r"
|
bulwahn@27656
|
125 |
obtains "get_array r h' = xs"
|
bulwahn@27656
|
126 |
using assms
|
bulwahn@27656
|
127 |
unfolding of_list_def
|
bulwahn@27656
|
128 |
by (elim crel_heap) (simp add:get_array_init_array_list)
|
bulwahn@27656
|
129 |
|
bulwahn@27656
|
130 |
lemma crel_map_entry:
|
bulwahn@27656
|
131 |
assumes "crel (Array.map_entry i f a) h h' r"
|
haftmann@37716
|
132 |
obtains "r = a" "h' = Array.change a i (f (get_array a h ! i)) h"
|
bulwahn@27656
|
133 |
using assms
|
haftmann@28145
|
134 |
unfolding Array.map_entry_def
|
bulwahn@27656
|
135 |
by (elim crelE crel_upd crel_nth) auto
|
bulwahn@27656
|
136 |
|
bulwahn@27656
|
137 |
lemma crel_swap:
|
bulwahn@27656
|
138 |
assumes "crel (Array.swap i x a) h h' r"
|
haftmann@37716
|
139 |
obtains "r = get_array a h ! i" "h' = Array.change a i x h"
|
bulwahn@27656
|
140 |
using assms
|
haftmann@28145
|
141 |
unfolding Array.swap_def
|
bulwahn@27656
|
142 |
by (elim crelE crel_upd crel_nth crel_return) auto
|
bulwahn@27656
|
143 |
|
bulwahn@27656
|
144 |
(* Strong version of the lemma for this operation is missing *)
|
bulwahn@27656
|
145 |
lemma crel_make_weak:
|
bulwahn@27656
|
146 |
assumes "crel (Array.make n f) h h' r"
|
bulwahn@27656
|
147 |
obtains "i < n \<Longrightarrow> get_array r h' ! i = f i"
|
bulwahn@27656
|
148 |
using assms
|
bulwahn@27656
|
149 |
unfolding Array.make_def
|
bulwahn@27656
|
150 |
by (elim crel_of_list_weak) auto
|
bulwahn@27656
|
151 |
|
bulwahn@27656
|
152 |
lemma upt_conv_Cons':
|
bulwahn@27656
|
153 |
assumes "Suc a \<le> b"
|
bulwahn@27656
|
154 |
shows "[b - Suc a..<b] = (b - Suc a)#[b - a..<b]"
|
bulwahn@27656
|
155 |
proof -
|
bulwahn@27656
|
156 |
from assms have l: "b - Suc a < b" by arith
|
bulwahn@27656
|
157 |
from assms have "Suc (b - Suc a) = b - a" by arith
|
bulwahn@27656
|
158 |
with l show ?thesis by (simp add: upt_conv_Cons)
|
bulwahn@27656
|
159 |
qed
|
bulwahn@27656
|
160 |
|
bulwahn@27656
|
161 |
lemma crel_mapM_nth:
|
bulwahn@27656
|
162 |
assumes
|
haftmann@37716
|
163 |
"crel (mapM (Array.nth a) [Array.length a h - n..<Array.length a h]) h h' xs"
|
haftmann@37716
|
164 |
assumes "n \<le> Array.length a h"
|
haftmann@37716
|
165 |
shows "h = h' \<and> xs = drop (Array.length a h - n) (get_array a h)"
|
bulwahn@27656
|
166 |
using assms
|
bulwahn@27656
|
167 |
proof (induct n arbitrary: xs h h')
|
bulwahn@27656
|
168 |
case 0 thus ?case
|
haftmann@37716
|
169 |
by (auto elim!: crel_return simp add: Array.length_def)
|
bulwahn@27656
|
170 |
next
|
bulwahn@27656
|
171 |
case (Suc n)
|
haftmann@37716
|
172 |
from Suc(3) have "[Array.length a h - Suc n..<Array.length a h] = (Array.length a h - Suc n)#[Array.length a h - n..<Array.length a h]"
|
bulwahn@27656
|
173 |
by (simp add: upt_conv_Cons')
|
bulwahn@27656
|
174 |
with Suc(2) obtain r where
|
haftmann@37716
|
175 |
crel_mapM: "crel (mapM (Array.nth a) [Array.length a h - n..<Array.length a h]) h h' r"
|
haftmann@37716
|
176 |
and xs_def: "xs = get_array a h ! (Array.length a h - Suc n) # r"
|
haftmann@28145
|
177 |
by (auto elim!: crelE crel_nth crel_return)
|
haftmann@37716
|
178 |
from Suc(3) have "Array.length a h - n = Suc (Array.length a h - Suc n)"
|
bulwahn@27656
|
179 |
by arith
|
bulwahn@27656
|
180 |
with Suc.hyps[OF crel_mapM] xs_def show ?case
|
haftmann@37716
|
181 |
unfolding Array.length_def
|
bulwahn@27656
|
182 |
by (auto simp add: nth_drop')
|
bulwahn@27656
|
183 |
qed
|
bulwahn@27656
|
184 |
|
bulwahn@27656
|
185 |
lemma crel_freeze:
|
bulwahn@27656
|
186 |
assumes "crel (Array.freeze a) h h' xs"
|
bulwahn@27656
|
187 |
obtains "h = h'" "xs = get_array a h"
|
bulwahn@27656
|
188 |
proof
|
haftmann@37716
|
189 |
from assms have "crel (mapM (Array.nth a) [0..<Array.length a h]) h h' xs"
|
haftmann@28145
|
190 |
unfolding freeze_def
|
bulwahn@27656
|
191 |
by (auto elim: crelE crel_length)
|
haftmann@37716
|
192 |
hence "crel (mapM (Array.nth a) [(Array.length a h - Array.length a h)..<Array.length a h]) h h' xs"
|
bulwahn@27656
|
193 |
by simp
|
bulwahn@27656
|
194 |
from crel_mapM_nth[OF this] show "h = h'" and "xs = get_array a h" by auto
|
bulwahn@27656
|
195 |
qed
|
bulwahn@27656
|
196 |
|
bulwahn@27656
|
197 |
lemma crel_mapM_map_entry_remains:
|
haftmann@37716
|
198 |
assumes "crel (mapM (\<lambda>n. map_entry n f a) [Array.length a h - n..<Array.length a h]) h h' r"
|
haftmann@37716
|
199 |
assumes "i < Array.length a h - n"
|
bulwahn@27656
|
200 |
shows "get_array a h ! i = get_array a h' ! i"
|
bulwahn@27656
|
201 |
using assms
|
bulwahn@27656
|
202 |
proof (induct n arbitrary: h h' r)
|
bulwahn@27656
|
203 |
case 0
|
bulwahn@27656
|
204 |
thus ?case
|
bulwahn@27656
|
205 |
by (auto elim: crel_return)
|
bulwahn@27656
|
206 |
next
|
bulwahn@27656
|
207 |
case (Suc n)
|
haftmann@37716
|
208 |
let ?h1 = "Array.change a (Array.length a h - Suc n) (f (get_array a h ! (Array.length a h - Suc n))) h"
|
haftmann@37716
|
209 |
from Suc(3) have "[Array.length a h - Suc n..<Array.length a h] = (Array.length a h - Suc n)#[Array.length a h - n..<Array.length a h]"
|
bulwahn@27656
|
210 |
by (simp add: upt_conv_Cons')
|
bulwahn@27656
|
211 |
from Suc(2) this obtain r where
|
haftmann@37716
|
212 |
crel_mapM: "crel (mapM (\<lambda>n. map_entry n f a) [Array.length a h - n..<Array.length a h]) ?h1 h' r"
|
haftmann@28145
|
213 |
by (auto simp add: elim!: crelE crel_map_entry crel_return)
|
haftmann@37716
|
214 |
have length_remains: "Array.length a ?h1 = Array.length a h" by simp
|
haftmann@37716
|
215 |
from crel_mapM have crel_mapM': "crel (mapM (\<lambda>n. map_entry n f a) [Array.length a ?h1 - n..<Array.length a ?h1]) ?h1 h' r"
|
bulwahn@27656
|
216 |
by simp
|
bulwahn@27656
|
217 |
from Suc(1)[OF this] length_remains Suc(3) show ?case by simp
|
bulwahn@27656
|
218 |
qed
|
bulwahn@27656
|
219 |
|
bulwahn@27656
|
220 |
lemma crel_mapM_map_entry_changes:
|
haftmann@37716
|
221 |
assumes "crel (mapM (\<lambda>n. map_entry n f a) [Array.length a h - n..<Array.length a h]) h h' r"
|
haftmann@37716
|
222 |
assumes "n \<le> Array.length a h"
|
haftmann@37716
|
223 |
assumes "i \<ge> Array.length a h - n"
|
haftmann@37716
|
224 |
assumes "i < Array.length a h"
|
bulwahn@27656
|
225 |
shows "get_array a h' ! i = f (get_array a h ! i)"
|
bulwahn@27656
|
226 |
using assms
|
bulwahn@27656
|
227 |
proof (induct n arbitrary: h h' r)
|
bulwahn@27656
|
228 |
case 0
|
bulwahn@27656
|
229 |
thus ?case
|
bulwahn@27656
|
230 |
by (auto elim!: crel_return)
|
bulwahn@27656
|
231 |
next
|
bulwahn@27656
|
232 |
case (Suc n)
|
haftmann@37716
|
233 |
let ?h1 = "Array.change a (Array.length a h - Suc n) (f (get_array a h ! (Array.length a h - Suc n))) h"
|
haftmann@37716
|
234 |
from Suc(3) have "[Array.length a h - Suc n..<Array.length a h] = (Array.length a h - Suc n)#[Array.length a h - n..<Array.length a h]"
|
bulwahn@27656
|
235 |
by (simp add: upt_conv_Cons')
|
bulwahn@27656
|
236 |
from Suc(2) this obtain r where
|
haftmann@37716
|
237 |
crel_mapM: "crel (mapM (\<lambda>n. map_entry n f a) [Array.length a h - n..<Array.length a h]) ?h1 h' r"
|
haftmann@28145
|
238 |
by (auto simp add: elim!: crelE crel_map_entry crel_return)
|
haftmann@37716
|
239 |
have length_remains: "Array.length a ?h1 = Array.length a h" by simp
|
haftmann@37716
|
240 |
from Suc(3) have less: "Array.length a h - Suc n < Array.length a h - n" by arith
|
haftmann@37716
|
241 |
from Suc(3) have less2: "Array.length a h - Suc n < Array.length a h" by arith
|
haftmann@37716
|
242 |
from Suc(4) length_remains have cases: "i = Array.length a ?h1 - Suc n \<or> i \<ge> Array.length a ?h1 - n" by arith
|
haftmann@37716
|
243 |
from crel_mapM have crel_mapM': "crel (mapM (\<lambda>n. map_entry n f a) [Array.length a ?h1 - n..<Array.length a ?h1]) ?h1 h' r"
|
bulwahn@27656
|
244 |
by simp
|
bulwahn@27656
|
245 |
from Suc(1)[OF this] cases Suc(3) Suc(5) length_remains
|
haftmann@37716
|
246 |
crel_mapM_map_entry_remains[OF this, of "Array.length a h - Suc n", symmetric] less less2
|
bulwahn@27656
|
247 |
show ?case
|
haftmann@37716
|
248 |
by (auto simp add: nth_list_update_eq Array.length_def)
|
bulwahn@27656
|
249 |
qed
|
bulwahn@27656
|
250 |
|
bulwahn@27656
|
251 |
lemma crel_mapM_map_entry_length:
|
haftmann@37716
|
252 |
assumes "crel (mapM (\<lambda>n. map_entry n f a) [Array.length a h - n..<Array.length a h]) h h' r"
|
haftmann@37716
|
253 |
assumes "n \<le> Array.length a h"
|
haftmann@37716
|
254 |
shows "Array.length a h' = Array.length a h"
|
bulwahn@27656
|
255 |
using assms
|
bulwahn@27656
|
256 |
proof (induct n arbitrary: h h' r)
|
bulwahn@27656
|
257 |
case 0
|
bulwahn@27656
|
258 |
thus ?case by (auto elim!: crel_return)
|
bulwahn@27656
|
259 |
next
|
bulwahn@27656
|
260 |
case (Suc n)
|
haftmann@37716
|
261 |
let ?h1 = "Array.change a (Array.length a h - Suc n) (f (get_array a h ! (Array.length a h - Suc n))) h"
|
haftmann@37716
|
262 |
from Suc(3) have "[Array.length a h - Suc n..<Array.length a h] = (Array.length a h - Suc n)#[Array.length a h - n..<Array.length a h]"
|
bulwahn@27656
|
263 |
by (simp add: upt_conv_Cons')
|
bulwahn@27656
|
264 |
from Suc(2) this obtain r where
|
haftmann@37716
|
265 |
crel_mapM: "crel (mapM (\<lambda>n. map_entry n f a) [Array.length a h - n..<Array.length a h]) ?h1 h' r"
|
haftmann@28145
|
266 |
by (auto elim!: crelE crel_map_entry crel_return)
|
haftmann@37716
|
267 |
have length_remains: "Array.length a ?h1 = Array.length a h" by simp
|
haftmann@37716
|
268 |
from crel_mapM have crel_mapM': "crel (mapM (\<lambda>n. map_entry n f a) [Array.length a ?h1 - n..<Array.length a ?h1]) ?h1 h' r"
|
bulwahn@27656
|
269 |
by simp
|
bulwahn@27656
|
270 |
from Suc(1)[OF this] length_remains Suc(3) show ?case by simp
|
bulwahn@27656
|
271 |
qed
|
bulwahn@27656
|
272 |
|
bulwahn@27656
|
273 |
lemma crel_mapM_map_entry:
|
haftmann@37716
|
274 |
assumes "crel (mapM (\<lambda>n. map_entry n f a) [0..<Array.length a h]) h h' r"
|
bulwahn@27656
|
275 |
shows "get_array a h' = List.map f (get_array a h)"
|
bulwahn@27656
|
276 |
proof -
|
haftmann@37716
|
277 |
from assms have "crel (mapM (\<lambda>n. map_entry n f a) [Array.length a h - Array.length a h..<Array.length a h]) h h' r" by simp
|
bulwahn@27656
|
278 |
from crel_mapM_map_entry_length[OF this]
|
bulwahn@27656
|
279 |
crel_mapM_map_entry_changes[OF this] show ?thesis
|
haftmann@37716
|
280 |
unfolding Array.length_def
|
bulwahn@27656
|
281 |
by (auto intro: nth_equalityI)
|
bulwahn@27656
|
282 |
qed
|
bulwahn@27656
|
283 |
|
bulwahn@27656
|
284 |
lemma crel_map_weak:
|
bulwahn@27656
|
285 |
assumes crel_map: "crel (Array.map f a) h h' r"
|
bulwahn@27656
|
286 |
obtains "r = a" "get_array a h' = List.map f (get_array a h)"
|
bulwahn@27656
|
287 |
proof
|
bulwahn@27656
|
288 |
from assms crel_mapM_map_entry show "get_array a h' = List.map f (get_array a h)"
|
haftmann@28145
|
289 |
unfolding Array.map_def
|
bulwahn@27656
|
290 |
by (fastsimp elim!: crelE crel_length crel_return)
|
bulwahn@27656
|
291 |
from assms show "r = a"
|
haftmann@28145
|
292 |
unfolding Array.map_def
|
bulwahn@27656
|
293 |
by (elim crelE crel_return)
|
bulwahn@27656
|
294 |
qed
|
bulwahn@27656
|
295 |
|
bulwahn@27656
|
296 |
subsection {* Elimination rules for reference commands *}
|
bulwahn@27656
|
297 |
|
bulwahn@27656
|
298 |
(* TODO:
|
bulwahn@27656
|
299 |
maybe introduce a new predicate "extends h' h x"
|
bulwahn@27656
|
300 |
which means h' extends h with a new reference x.
|
bulwahn@27656
|
301 |
Then crel_new: would be
|
bulwahn@27656
|
302 |
assumes "crel (Ref.new v) h h' x"
|
bulwahn@27656
|
303 |
obtains "get_ref x h' = v"
|
bulwahn@27656
|
304 |
and "extends h' h x"
|
bulwahn@27656
|
305 |
|
bulwahn@27656
|
306 |
and we would need further rules for extends:
|
bulwahn@27656
|
307 |
extends h' h x \<Longrightarrow> \<not> ref_present x h
|
bulwahn@27656
|
308 |
extends h' h x \<Longrightarrow> ref_present x h'
|
bulwahn@27656
|
309 |
extends h' h x \<Longrightarrow> ref_present y h \<Longrightarrow> ref_present y h'
|
bulwahn@27656
|
310 |
extends h' h x \<Longrightarrow> ref_present y h \<Longrightarrow> get_ref y h = get_ref y h'
|
bulwahn@27656
|
311 |
extends h' h x \<Longrightarrow> lim h' = Suc (lim h)
|
bulwahn@27656
|
312 |
*)
|
bulwahn@27656
|
313 |
|
haftmann@37722
|
314 |
lemma crel_ref:
|
haftmann@37722
|
315 |
assumes "crel (ref v) h h' x"
|
haftmann@37722
|
316 |
obtains "Ref.get h' x = v"
|
haftmann@37722
|
317 |
and "\<not> Ref.present h x"
|
haftmann@37722
|
318 |
and "Ref.present h' x"
|
haftmann@37722
|
319 |
and "\<forall>y. Ref.present h y \<longrightarrow> Ref.get h y = Ref.get h' y"
|
bulwahn@27656
|
320 |
(* and "lim h' = Suc (lim h)" *)
|
haftmann@37722
|
321 |
and "\<forall>y. Ref.present h y \<longrightarrow> Ref.present h' y"
|
bulwahn@27656
|
322 |
using assms
|
haftmann@37722
|
323 |
unfolding Ref.ref_def
|
bulwahn@27656
|
324 |
apply (elim crel_heap)
|
haftmann@37722
|
325 |
unfolding Ref.alloc_def
|
bulwahn@27656
|
326 |
apply (simp add: Let_def)
|
haftmann@37722
|
327 |
unfolding Ref.present_def
|
bulwahn@27656
|
328 |
apply auto
|
haftmann@37722
|
329 |
unfolding Ref.get_def Ref.set_def
|
bulwahn@27656
|
330 |
apply auto
|
bulwahn@27656
|
331 |
done
|
bulwahn@27656
|
332 |
|
bulwahn@27656
|
333 |
lemma crel_lookup:
|
haftmann@37716
|
334 |
assumes "crel (!r') h h' r"
|
haftmann@37722
|
335 |
obtains "h = h'" "r = Ref.get h r'"
|
bulwahn@27656
|
336 |
using assms
|
bulwahn@27656
|
337 |
unfolding Ref.lookup_def
|
bulwahn@27656
|
338 |
by (auto elim: crel_heap)
|
bulwahn@27656
|
339 |
|
bulwahn@27656
|
340 |
lemma crel_update:
|
haftmann@37716
|
341 |
assumes "crel (r' := v) h h' r"
|
haftmann@37722
|
342 |
obtains "h' = Ref.set r' v h" "r = ()"
|
bulwahn@27656
|
343 |
using assms
|
bulwahn@27656
|
344 |
unfolding Ref.update_def
|
bulwahn@27656
|
345 |
by (auto elim: crel_heap)
|
bulwahn@27656
|
346 |
|
bulwahn@27656
|
347 |
lemma crel_change:
|
haftmann@37716
|
348 |
assumes "crel (Ref.change f r') h h' r"
|
haftmann@37722
|
349 |
obtains "h' = Ref.set r' (f (Ref.get h r')) h" "r = f (Ref.get h r')"
|
bulwahn@27656
|
350 |
using assms
|
haftmann@28145
|
351 |
unfolding Ref.change_def Let_def
|
bulwahn@27656
|
352 |
by (auto elim!: crelE crel_lookup crel_update crel_return)
|
bulwahn@27656
|
353 |
|
bulwahn@27656
|
354 |
subsection {* Elimination rules for the assert command *}
|
bulwahn@27656
|
355 |
|
bulwahn@27656
|
356 |
lemma crel_assert[consumes 1]:
|
bulwahn@27656
|
357 |
assumes "crel (assert P x) h h' r"
|
bulwahn@27656
|
358 |
obtains "P x" "r = x" "h = h'"
|
bulwahn@27656
|
359 |
using assms
|
bulwahn@27656
|
360 |
unfolding assert_def
|
bulwahn@27656
|
361 |
by (elim crel_if crel_return crel_raise) auto
|
bulwahn@27656
|
362 |
|
bulwahn@27656
|
363 |
lemma crel_assert_eq: "(\<And>h h' r. crel f h h' r \<Longrightarrow> P r) \<Longrightarrow> f \<guillemotright>= assert P = f"
|
bulwahn@27656
|
364 |
unfolding crel_def bindM_def Let_def assert_def
|
bulwahn@27656
|
365 |
raise_def return_def prod_case_beta
|
bulwahn@27656
|
366 |
apply (cases f)
|
bulwahn@27656
|
367 |
apply simp
|
bulwahn@27656
|
368 |
apply (simp add: expand_fun_eq split_def)
|
haftmann@37709
|
369 |
apply (auto split: option.split)
|
haftmann@37709
|
370 |
apply (erule_tac x="x" in meta_allE)
|
bulwahn@27656
|
371 |
apply auto
|
bulwahn@27656
|
372 |
done
|
bulwahn@27656
|
373 |
|
bulwahn@27656
|
374 |
section {* Introduction rules *}
|
bulwahn@27656
|
375 |
|
bulwahn@27656
|
376 |
subsection {* Introduction rules for basic monadic commands *}
|
bulwahn@27656
|
377 |
|
bulwahn@27656
|
378 |
lemma crelI:
|
bulwahn@27656
|
379 |
assumes "crel f h h' r" "crel (g r) h' h'' r'"
|
bulwahn@27656
|
380 |
shows "crel (f >>= g) h h'' r'"
|
bulwahn@27656
|
381 |
using assms by (simp add: crel_def' bindM_def)
|
bulwahn@27656
|
382 |
|
bulwahn@27656
|
383 |
lemma crelI':
|
bulwahn@27656
|
384 |
assumes "crel f h h' r" "crel g h' h'' r'"
|
bulwahn@27656
|
385 |
shows "crel (f >> g) h h'' r'"
|
bulwahn@27656
|
386 |
using assms by (intro crelI) auto
|
bulwahn@27656
|
387 |
|
bulwahn@27656
|
388 |
lemma crel_returnI:
|
bulwahn@27656
|
389 |
shows "crel (return x) h h x"
|
bulwahn@27656
|
390 |
unfolding crel_def return_def by simp
|
bulwahn@27656
|
391 |
|
bulwahn@27656
|
392 |
lemma crel_raiseI:
|
bulwahn@27656
|
393 |
shows "\<not> (crel (raise x) h h' r)"
|
bulwahn@27656
|
394 |
unfolding crel_def raise_def by simp
|
bulwahn@27656
|
395 |
|
bulwahn@27656
|
396 |
lemma crel_ifI:
|
bulwahn@27656
|
397 |
assumes "c \<longrightarrow> crel t h h' r"
|
bulwahn@27656
|
398 |
"\<not>c \<longrightarrow> crel e h h' r"
|
bulwahn@27656
|
399 |
shows "crel (if c then t else e) h h' r"
|
bulwahn@27656
|
400 |
using assms
|
bulwahn@27656
|
401 |
unfolding crel_def by auto
|
bulwahn@27656
|
402 |
|
bulwahn@27656
|
403 |
lemma crel_option_caseI:
|
bulwahn@27656
|
404 |
assumes "\<And>y. x = Some y \<Longrightarrow> crel (s y) h h' r"
|
bulwahn@27656
|
405 |
assumes "x = None \<Longrightarrow> crel n h h' r"
|
bulwahn@27656
|
406 |
shows "crel (case x of None \<Rightarrow> n | Some y \<Rightarrow> s y) h h' r"
|
bulwahn@27656
|
407 |
using assms
|
bulwahn@27656
|
408 |
by (auto split: option.split)
|
bulwahn@27656
|
409 |
|
bulwahn@27656
|
410 |
lemma crel_heapI:
|
bulwahn@27656
|
411 |
shows "crel (Heap_Monad.heap f) h (snd (f h)) (fst (f h))"
|
bulwahn@27656
|
412 |
by (simp add: crel_def apfst_def split_def prod_fun_def)
|
bulwahn@27656
|
413 |
|
bulwahn@27656
|
414 |
lemma crel_heapI':
|
bulwahn@27656
|
415 |
assumes "h' = snd (f h)" "r = fst (f h)"
|
bulwahn@27656
|
416 |
shows "crel (Heap_Monad.heap f) h h' r"
|
bulwahn@27656
|
417 |
using assms
|
bulwahn@27656
|
418 |
by (simp add: crel_def split_def apfst_def prod_fun_def)
|
bulwahn@27656
|
419 |
|
bulwahn@27656
|
420 |
lemma crelI2:
|
bulwahn@27656
|
421 |
assumes "\<exists>h' rs'. crel f h h' rs' \<and> (\<exists>h'' rs. crel (g rs') h' h'' rs)"
|
bulwahn@27656
|
422 |
shows "\<exists>h'' rs. crel (f\<guillemotright>= g) h h'' rs"
|
bulwahn@27656
|
423 |
oops
|
bulwahn@27656
|
424 |
|
bulwahn@27656
|
425 |
lemma crel_ifI2:
|
bulwahn@27656
|
426 |
assumes "c \<Longrightarrow> \<exists>h' r. crel t h h' r"
|
bulwahn@27656
|
427 |
"\<not> c \<Longrightarrow> \<exists>h' r. crel e h h' r"
|
bulwahn@27656
|
428 |
shows "\<exists> h' r. crel (if c then t else e) h h' r"
|
bulwahn@27656
|
429 |
oops
|
bulwahn@27656
|
430 |
|
bulwahn@27656
|
431 |
subsection {* Introduction rules for array commands *}
|
bulwahn@27656
|
432 |
|
bulwahn@27656
|
433 |
lemma crel_lengthI:
|
haftmann@37716
|
434 |
shows "crel (Array.len a) h h (Array.length a h)"
|
haftmann@37716
|
435 |
unfolding len_def
|
bulwahn@27656
|
436 |
by (rule crel_heapI') auto
|
bulwahn@27656
|
437 |
|
bulwahn@27656
|
438 |
(* thm crel_newI for Array.new is missing *)
|
bulwahn@27656
|
439 |
|
bulwahn@27656
|
440 |
lemma crel_nthI:
|
haftmann@37716
|
441 |
assumes "i < Array.length a h"
|
bulwahn@27656
|
442 |
shows "crel (nth a i) h h ((get_array a h) ! i)"
|
bulwahn@27656
|
443 |
using assms
|
haftmann@28145
|
444 |
unfolding nth_def
|
bulwahn@27656
|
445 |
by (auto intro!: crelI crel_ifI crel_raiseI crel_lengthI crel_heapI')
|
bulwahn@27656
|
446 |
|
bulwahn@27656
|
447 |
lemma crel_updI:
|
haftmann@37716
|
448 |
assumes "i < Array.length a h"
|
haftmann@37716
|
449 |
shows "crel (upd i v a) h (Array.change a i v h) a"
|
bulwahn@27656
|
450 |
using assms
|
haftmann@28145
|
451 |
unfolding upd_def
|
bulwahn@27656
|
452 |
by (auto intro!: crelI crel_ifI crel_returnI crel_raiseI
|
bulwahn@27656
|
453 |
crel_lengthI crel_heapI')
|
bulwahn@27656
|
454 |
|
bulwahn@27656
|
455 |
(* thm crel_of_listI is missing *)
|
bulwahn@27656
|
456 |
|
bulwahn@27656
|
457 |
(* thm crel_map_entryI is missing *)
|
bulwahn@27656
|
458 |
|
bulwahn@27656
|
459 |
(* thm crel_swapI is missing *)
|
bulwahn@27656
|
460 |
|
bulwahn@27656
|
461 |
(* thm crel_makeI is missing *)
|
bulwahn@27656
|
462 |
|
bulwahn@27656
|
463 |
(* thm crel_freezeI is missing *)
|
bulwahn@27656
|
464 |
|
bulwahn@27656
|
465 |
(* thm crel_mapI is missing *)
|
bulwahn@27656
|
466 |
|
bulwahn@36057
|
467 |
subsubsection {* Introduction rules for reference commands *}
|
bulwahn@27656
|
468 |
|
bulwahn@27656
|
469 |
lemma crel_lookupI:
|
haftmann@37722
|
470 |
shows "crel (!r) h h (Ref.get h r)"
|
bulwahn@27656
|
471 |
unfolding lookup_def by (auto intro!: crel_heapI')
|
bulwahn@27656
|
472 |
|
bulwahn@27656
|
473 |
lemma crel_updateI:
|
haftmann@37722
|
474 |
shows "crel (r := v) h (Ref.set r v h) ()"
|
bulwahn@27656
|
475 |
unfolding update_def by (auto intro!: crel_heapI')
|
bulwahn@27656
|
476 |
|
bulwahn@27656
|
477 |
lemma crel_changeI:
|
haftmann@37722
|
478 |
shows "crel (Ref.change f r) h (Ref.set r (f (Ref.get h r)) h) (f (Ref.get h r))"
|
haftmann@28145
|
479 |
unfolding change_def Let_def by (auto intro!: crelI crel_returnI crel_lookupI crel_updateI)
|
bulwahn@27656
|
480 |
|
bulwahn@36057
|
481 |
subsubsection {* Introduction rules for the assert command *}
|
bulwahn@27656
|
482 |
|
bulwahn@27656
|
483 |
lemma crel_assertI:
|
bulwahn@27656
|
484 |
assumes "P x"
|
bulwahn@27656
|
485 |
shows "crel (assert P x) h h x"
|
bulwahn@27656
|
486 |
using assms
|
bulwahn@27656
|
487 |
unfolding assert_def
|
bulwahn@27656
|
488 |
by (auto intro!: crel_ifI crel_returnI crel_raiseI)
|
bulwahn@27656
|
489 |
|
bulwahn@36057
|
490 |
subsection {* Induction rule for the MREC combinator *}
|
bulwahn@36057
|
491 |
|
bulwahn@36057
|
492 |
lemma MREC_induct:
|
bulwahn@36057
|
493 |
assumes "crel (MREC f g x) h h' r"
|
bulwahn@36057
|
494 |
assumes "\<And> x h h' r. crel (f x) h h' (Inl r) \<Longrightarrow> P x h h' r"
|
bulwahn@36057
|
495 |
assumes "\<And> x h h1 h2 h' s z r. crel (f x) h h1 (Inr s) \<Longrightarrow> crel (MREC f g s) h1 h2 z \<Longrightarrow> P s h1 h2 z
|
bulwahn@36057
|
496 |
\<Longrightarrow> crel (g x s z) h2 h' r \<Longrightarrow> P x h h' r"
|
bulwahn@36057
|
497 |
shows "P x h h' r"
|
bulwahn@36057
|
498 |
proof (rule MREC_pinduct[OF assms(1)[unfolded crel_def, symmetric]])
|
bulwahn@36057
|
499 |
fix x h h1 h2 h' s z r
|
haftmann@37709
|
500 |
assume "Heap_Monad.execute (f x) h = Some (Inr s, h1)"
|
haftmann@37709
|
501 |
"Heap_Monad.execute (MREC f g s) h1 = Some (z, h2)"
|
bulwahn@36057
|
502 |
"P s h1 h2 z"
|
haftmann@37709
|
503 |
"Heap_Monad.execute (g x s z) h2 = Some (r, h')"
|
bulwahn@36057
|
504 |
from assms(3)[unfolded crel_def, OF this(1)[symmetric] this(2)[symmetric] this(3) this(4)[symmetric]]
|
bulwahn@36057
|
505 |
show "P x h h' r" .
|
bulwahn@36057
|
506 |
next
|
bulwahn@36057
|
507 |
qed (auto simp add: assms(2)[unfolded crel_def])
|
bulwahn@36057
|
508 |
|
bulwahn@36057
|
509 |
section {* Definition of the noError predicate *}
|
bulwahn@27656
|
510 |
|
bulwahn@27656
|
511 |
text {* We add a simple definitional setting for crel intro rules
|
bulwahn@27656
|
512 |
where we only would like to show that the computation does not result in a exception for heap h,
|
bulwahn@27656
|
513 |
but we do not care about statements about the resulting heap and return value.*}
|
bulwahn@27656
|
514 |
|
bulwahn@27656
|
515 |
definition noError :: "'a Heap \<Rightarrow> heap \<Rightarrow> bool"
|
bulwahn@27656
|
516 |
where
|
haftmann@37709
|
517 |
"noError c h \<longleftrightarrow> (\<exists>r h'. Some (r, h') = Heap_Monad.execute c h)"
|
bulwahn@27656
|
518 |
|
bulwahn@27656
|
519 |
lemma noError_def': -- FIXME
|
haftmann@37709
|
520 |
"noError c h \<longleftrightarrow> (\<exists>r h'. Heap_Monad.execute c h = Some (r, h'))"
|
bulwahn@27656
|
521 |
unfolding noError_def apply auto proof -
|
bulwahn@27656
|
522 |
fix r h'
|
haftmann@37709
|
523 |
assume "Some (r, h') = Heap_Monad.execute c h"
|
haftmann@37709
|
524 |
then have "Heap_Monad.execute c h = Some (r, h')" ..
|
haftmann@37709
|
525 |
then show "\<exists>r h'. Heap_Monad.execute c h = Some (r, h')" by blast
|
bulwahn@27656
|
526 |
qed
|
bulwahn@27656
|
527 |
|
bulwahn@27656
|
528 |
subsection {* Introduction rules for basic monadic commands *}
|
bulwahn@27656
|
529 |
|
bulwahn@27656
|
530 |
lemma noErrorI:
|
bulwahn@27656
|
531 |
assumes "noError f h"
|
bulwahn@27656
|
532 |
assumes "\<And>h' r. crel f h h' r \<Longrightarrow> noError (g r) h'"
|
bulwahn@27656
|
533 |
shows "noError (f \<guillemotright>= g) h"
|
bulwahn@27656
|
534 |
using assms
|
bulwahn@27656
|
535 |
by (auto simp add: noError_def' crel_def' bindM_def)
|
bulwahn@27656
|
536 |
|
bulwahn@27656
|
537 |
lemma noErrorI':
|
bulwahn@27656
|
538 |
assumes "noError f h"
|
bulwahn@27656
|
539 |
assumes "\<And>h' r. crel f h h' r \<Longrightarrow> noError g h'"
|
bulwahn@27656
|
540 |
shows "noError (f \<guillemotright> g) h"
|
bulwahn@27656
|
541 |
using assms
|
bulwahn@27656
|
542 |
by (auto simp add: noError_def' crel_def' bindM_def)
|
bulwahn@27656
|
543 |
|
bulwahn@27656
|
544 |
lemma noErrorI2:
|
bulwahn@27656
|
545 |
"\<lbrakk>crel f h h' r ; noError f h; noError (g r) h'\<rbrakk>
|
bulwahn@27656
|
546 |
\<Longrightarrow> noError (f \<guillemotright>= g) h"
|
bulwahn@27656
|
547 |
by (auto simp add: noError_def' crel_def' bindM_def)
|
bulwahn@27656
|
548 |
|
bulwahn@27656
|
549 |
lemma noError_return:
|
bulwahn@27656
|
550 |
shows "noError (return x) h"
|
bulwahn@27656
|
551 |
unfolding noError_def return_def
|
bulwahn@27656
|
552 |
by auto
|
bulwahn@27656
|
553 |
|
bulwahn@27656
|
554 |
lemma noError_if:
|
bulwahn@27656
|
555 |
assumes "c \<Longrightarrow> noError t h" "\<not> c \<Longrightarrow> noError e h"
|
bulwahn@27656
|
556 |
shows "noError (if c then t else e) h"
|
bulwahn@27656
|
557 |
using assms
|
bulwahn@27656
|
558 |
unfolding noError_def
|
bulwahn@27656
|
559 |
by auto
|
bulwahn@27656
|
560 |
|
bulwahn@27656
|
561 |
lemma noError_option_case:
|
bulwahn@27656
|
562 |
assumes "\<And>y. x = Some y \<Longrightarrow> noError (s y) h"
|
bulwahn@27656
|
563 |
assumes "noError n h"
|
bulwahn@27656
|
564 |
shows "noError (case x of None \<Rightarrow> n | Some y \<Rightarrow> s y) h"
|
bulwahn@27656
|
565 |
using assms
|
bulwahn@27656
|
566 |
by (auto split: option.split)
|
bulwahn@27656
|
567 |
|
bulwahn@27656
|
568 |
lemma noError_mapM:
|
bulwahn@27656
|
569 |
assumes "\<forall>x \<in> set xs. noError (f x) h \<and> crel (f x) h h (r x)"
|
bulwahn@27656
|
570 |
shows "noError (mapM f xs) h"
|
bulwahn@27656
|
571 |
using assms
|
bulwahn@27656
|
572 |
proof (induct xs)
|
bulwahn@27656
|
573 |
case Nil
|
bulwahn@27656
|
574 |
thus ?case
|
bulwahn@27656
|
575 |
unfolding mapM.simps by (intro noError_return)
|
bulwahn@27656
|
576 |
next
|
bulwahn@27656
|
577 |
case (Cons x xs)
|
bulwahn@27656
|
578 |
thus ?case
|
haftmann@28145
|
579 |
unfolding mapM.simps
|
bulwahn@27656
|
580 |
by (auto intro: noErrorI2[of "f x"] noErrorI noError_return)
|
bulwahn@27656
|
581 |
qed
|
bulwahn@27656
|
582 |
|
bulwahn@27656
|
583 |
lemma noError_heap:
|
bulwahn@27656
|
584 |
shows "noError (Heap_Monad.heap f) h"
|
bulwahn@27656
|
585 |
by (simp add: noError_def' apfst_def prod_fun_def split_def)
|
bulwahn@27656
|
586 |
|
bulwahn@27656
|
587 |
subsection {* Introduction rules for array commands *}
|
bulwahn@27656
|
588 |
|
bulwahn@27656
|
589 |
lemma noError_length:
|
haftmann@37716
|
590 |
shows "noError (Array.len a) h"
|
haftmann@37716
|
591 |
unfolding len_def
|
bulwahn@27656
|
592 |
by (intro noError_heap)
|
bulwahn@27656
|
593 |
|
bulwahn@27656
|
594 |
lemma noError_new:
|
bulwahn@27656
|
595 |
shows "noError (Array.new n v) h"
|
bulwahn@27656
|
596 |
unfolding Array.new_def by (intro noError_heap)
|
bulwahn@27656
|
597 |
|
bulwahn@27656
|
598 |
lemma noError_upd:
|
haftmann@37716
|
599 |
assumes "i < Array.length a h"
|
bulwahn@27656
|
600 |
shows "noError (Array.upd i v a) h"
|
bulwahn@27656
|
601 |
using assms
|
haftmann@28145
|
602 |
unfolding upd_def
|
bulwahn@27656
|
603 |
by (auto intro!: noErrorI noError_if noError_return noError_length noError_heap) (auto elim: crel_length)
|
bulwahn@27656
|
604 |
|
bulwahn@27656
|
605 |
lemma noError_nth:
|
haftmann@37716
|
606 |
assumes "i < Array.length a h"
|
bulwahn@27656
|
607 |
shows "noError (Array.nth a i) h"
|
bulwahn@27656
|
608 |
using assms
|
haftmann@28145
|
609 |
unfolding nth_def
|
bulwahn@27656
|
610 |
by (auto intro!: noErrorI noError_if noError_return noError_length noError_heap) (auto elim: crel_length)
|
bulwahn@27656
|
611 |
|
bulwahn@27656
|
612 |
lemma noError_of_list:
|
bulwahn@27656
|
613 |
shows "noError (of_list ls) h"
|
bulwahn@27656
|
614 |
unfolding of_list_def by (rule noError_heap)
|
bulwahn@27656
|
615 |
|
bulwahn@27656
|
616 |
lemma noError_map_entry:
|
haftmann@37716
|
617 |
assumes "i < Array.length a h"
|
bulwahn@27656
|
618 |
shows "noError (map_entry i f a) h"
|
bulwahn@27656
|
619 |
using assms
|
haftmann@28145
|
620 |
unfolding map_entry_def
|
bulwahn@27656
|
621 |
by (auto elim: crel_nth intro!: noErrorI noError_nth noError_upd)
|
bulwahn@27656
|
622 |
|
bulwahn@27656
|
623 |
lemma noError_swap:
|
haftmann@37716
|
624 |
assumes "i < Array.length a h"
|
bulwahn@27656
|
625 |
shows "noError (swap i x a) h"
|
bulwahn@27656
|
626 |
using assms
|
haftmann@28145
|
627 |
unfolding swap_def
|
bulwahn@27656
|
628 |
by (auto elim: crel_nth intro!: noErrorI noError_return noError_nth noError_upd)
|
bulwahn@27656
|
629 |
|
bulwahn@27656
|
630 |
lemma noError_make:
|
bulwahn@27656
|
631 |
shows "noError (make n f) h"
|
bulwahn@27656
|
632 |
unfolding make_def
|
bulwahn@27656
|
633 |
by (auto intro: noError_of_list)
|
bulwahn@27656
|
634 |
|
bulwahn@27656
|
635 |
(*TODO: move to HeapMonad *)
|
bulwahn@27656
|
636 |
lemma mapM_append:
|
bulwahn@27656
|
637 |
"mapM f (xs @ ys) = mapM f xs \<guillemotright>= (\<lambda>xs. mapM f ys \<guillemotright>= (\<lambda>ys. return (xs @ ys)))"
|
haftmann@37709
|
638 |
by (induct xs) simp_all
|
bulwahn@27656
|
639 |
|
bulwahn@27656
|
640 |
lemma noError_freeze:
|
bulwahn@27656
|
641 |
shows "noError (freeze a) h"
|
haftmann@28145
|
642 |
unfolding freeze_def
|
bulwahn@27656
|
643 |
by (auto intro!: noErrorI noError_length noError_mapM[of _ _ _ "\<lambda>x. get_array a h ! x"]
|
bulwahn@27656
|
644 |
noError_nth crel_nthI elim: crel_length)
|
bulwahn@27656
|
645 |
|
bulwahn@27656
|
646 |
lemma noError_mapM_map_entry:
|
haftmann@37716
|
647 |
assumes "n \<le> Array.length a h"
|
haftmann@37716
|
648 |
shows "noError (mapM (\<lambda>n. map_entry n f a) [Array.length a h - n..<Array.length a h]) h"
|
bulwahn@27656
|
649 |
using assms
|
bulwahn@27656
|
650 |
proof (induct n arbitrary: h)
|
bulwahn@27656
|
651 |
case 0
|
bulwahn@27656
|
652 |
thus ?case by (auto intro: noError_return)
|
bulwahn@27656
|
653 |
next
|
bulwahn@27656
|
654 |
case (Suc n)
|
haftmann@37716
|
655 |
from Suc.prems have "[Array.length a h - Suc n..<Array.length a h] = (Array.length a h - Suc n)#[Array.length a h - n..<Array.length a h]"
|
bulwahn@27656
|
656 |
by (simp add: upt_conv_Cons')
|
haftmann@37716
|
657 |
with Suc.hyps[of "(Array.change a (Array.length a h - Suc n) (f (get_array a h ! (Array.length a h - Suc n))) h)"] Suc.prems show ?case
|
haftmann@28145
|
658 |
by (auto simp add: intro!: noErrorI noError_return noError_map_entry elim: crel_map_entry)
|
bulwahn@27656
|
659 |
qed
|
bulwahn@27656
|
660 |
|
bulwahn@27656
|
661 |
lemma noError_map:
|
bulwahn@27656
|
662 |
shows "noError (Array.map f a) h"
|
haftmann@37716
|
663 |
using noError_mapM_map_entry[of "Array.length a h" a h]
|
haftmann@28145
|
664 |
unfolding Array.map_def
|
bulwahn@27656
|
665 |
by (auto intro: noErrorI noError_length noError_return elim!: crel_length)
|
bulwahn@27656
|
666 |
|
bulwahn@27656
|
667 |
subsection {* Introduction rules for the reference commands *}
|
bulwahn@27656
|
668 |
|
bulwahn@27656
|
669 |
lemma noError_Ref_new:
|
haftmann@37722
|
670 |
shows "noError (ref v) h"
|
haftmann@37722
|
671 |
unfolding Ref.ref_def by (intro noError_heap)
|
bulwahn@27656
|
672 |
|
bulwahn@27656
|
673 |
lemma noError_lookup:
|
haftmann@37716
|
674 |
shows "noError (!r) h"
|
bulwahn@27656
|
675 |
unfolding lookup_def by (intro noError_heap)
|
bulwahn@27656
|
676 |
|
bulwahn@27656
|
677 |
lemma noError_update:
|
haftmann@37716
|
678 |
shows "noError (r := v) h"
|
bulwahn@27656
|
679 |
unfolding update_def by (intro noError_heap)
|
bulwahn@27656
|
680 |
|
bulwahn@27656
|
681 |
lemma noError_change:
|
haftmann@37716
|
682 |
shows "noError (Ref.change f r) h"
|
haftmann@28145
|
683 |
unfolding Ref.change_def Let_def by (intro noErrorI noError_lookup noError_update noError_return)
|
bulwahn@27656
|
684 |
|
bulwahn@27656
|
685 |
subsection {* Introduction rules for the assert command *}
|
bulwahn@27656
|
686 |
|
bulwahn@27656
|
687 |
lemma noError_assert:
|
bulwahn@27656
|
688 |
assumes "P x"
|
bulwahn@27656
|
689 |
shows "noError (assert P x) h"
|
bulwahn@27656
|
690 |
using assms
|
bulwahn@27656
|
691 |
unfolding assert_def
|
bulwahn@27656
|
692 |
by (auto intro: noError_if noError_return)
|
bulwahn@27656
|
693 |
|
bulwahn@27656
|
694 |
section {* Cumulative lemmas *}
|
bulwahn@27656
|
695 |
|
bulwahn@27656
|
696 |
lemmas crel_elim_all =
|
bulwahn@27656
|
697 |
crelE crelE' crel_return crel_raise crel_if crel_option_case
|
bulwahn@27656
|
698 |
crel_length crel_new_weak crel_nth crel_upd crel_of_list_weak crel_map_entry crel_swap crel_make_weak crel_freeze crel_map_weak
|
haftmann@37722
|
699 |
crel_ref crel_lookup crel_update crel_change
|
bulwahn@27656
|
700 |
crel_assert
|
bulwahn@27656
|
701 |
|
bulwahn@27656
|
702 |
lemmas crel_intro_all =
|
bulwahn@27656
|
703 |
crelI crelI' crel_returnI crel_raiseI crel_ifI crel_option_caseI
|
bulwahn@27656
|
704 |
crel_lengthI (* crel_newI *) crel_nthI crel_updI (* crel_of_listI crel_map_entryI crel_swapI crel_makeI crel_freezeI crel_mapI *)
|
bulwahn@27656
|
705 |
(* crel_Ref_newI *) crel_lookupI crel_updateI crel_changeI
|
bulwahn@27656
|
706 |
crel_assert
|
bulwahn@27656
|
707 |
|
bulwahn@27656
|
708 |
lemmas noError_intro_all =
|
bulwahn@27656
|
709 |
noErrorI noErrorI' noError_return noError_if noError_option_case
|
bulwahn@27656
|
710 |
noError_length noError_new noError_nth noError_upd noError_of_list noError_map_entry noError_swap noError_make noError_freeze noError_map
|
bulwahn@27656
|
711 |
noError_Ref_new noError_lookup noError_update noError_change
|
bulwahn@27656
|
712 |
noError_assert
|
bulwahn@27656
|
713 |
|
bulwahn@27656
|
714 |
end |