1 section {* |
1 theory CpsG |
2 This file contains lemmas used to guide the recalculation of current precedence |
2 imports PIPDefs |
3 after every system call (or system operation) |
3 begin |
|
4 |
|
5 (* I am going to use this file as a start point to retrofiting |
|
6 PIPBasics.thy, which is originally called CpsG.ghy *) |
|
7 |
|
8 locale valid_trace = |
|
9 fixes s |
|
10 assumes vt : "vt s" |
|
11 |
|
12 locale valid_trace_e = valid_trace + |
|
13 fixes e |
|
14 assumes vt_e: "vt (e#s)" |
|
15 begin |
|
16 |
|
17 lemma pip_e: "PIP s e" |
|
18 using vt_e by (cases, simp) |
|
19 |
|
20 end |
|
21 |
|
22 lemma runing_ready: |
|
23 shows "runing s \<subseteq> readys s" |
|
24 unfolding runing_def readys_def |
|
25 by auto |
|
26 |
|
27 lemma readys_threads: |
|
28 shows "readys s \<subseteq> threads s" |
|
29 unfolding readys_def |
|
30 by auto |
|
31 |
|
32 lemma wq_v_neq [simp]: |
|
33 "cs \<noteq> cs' \<Longrightarrow> wq (V thread cs#s) cs' = wq s cs'" |
|
34 by (auto simp:wq_def Let_def cp_def split:list.splits) |
|
35 |
|
36 lemma runing_head: |
|
37 assumes "th \<in> runing s" |
|
38 and "th \<in> set (wq_fun (schs s) cs)" |
|
39 shows "th = hd (wq_fun (schs s) cs)" |
|
40 using assms |
|
41 by (simp add:runing_def readys_def s_waiting_def wq_def) |
|
42 |
|
43 context valid_trace |
|
44 begin |
|
45 |
|
46 lemma actor_inv: |
|
47 assumes "PIP s e" |
|
48 and "\<not> isCreate e" |
|
49 shows "actor e \<in> runing s" |
|
50 using assms |
|
51 by (induct, auto) |
|
52 |
|
53 |
|
54 lemma isP_E: |
|
55 assumes "isP e" |
|
56 obtains cs where "e = P (actor e) cs" |
|
57 using assms by (cases e, auto) |
|
58 |
|
59 lemma isV_E: |
|
60 assumes "isV e" |
|
61 obtains cs where "e = V (actor e) cs" |
|
62 using assms by (cases e, auto) |
|
63 |
|
64 |
|
65 lemma ind [consumes 0, case_names Nil Cons, induct type]: |
|
66 assumes "PP []" |
|
67 and "(\<And>s e. valid_trace s \<Longrightarrow> valid_trace (e#s) \<Longrightarrow> |
|
68 PP s \<Longrightarrow> PIP s e \<Longrightarrow> PP (e # s))" |
|
69 shows "PP s" |
|
70 proof(rule vt.induct[OF vt]) |
|
71 from assms(1) show "PP []" . |
|
72 next |
|
73 fix s e |
|
74 assume h: "vt s" "PP s" "PIP s e" |
|
75 show "PP (e # s)" |
|
76 proof(cases rule:assms(2)) |
|
77 from h(1) show v1: "valid_trace s" by (unfold_locales, simp) |
|
78 next |
|
79 from h(1,3) have "vt (e#s)" by auto |
|
80 thus "valid_trace (e # s)" by (unfold_locales, simp) |
|
81 qed (insert h, auto) |
|
82 qed |
|
83 |
|
84 lemma wq_distinct: "distinct (wq s cs)" |
|
85 proof(induct rule:ind) |
|
86 case (Cons s e) |
|
87 from Cons(4,3) |
|
88 show ?case |
|
89 proof(induct) |
|
90 case (thread_P th s cs1) |
|
91 show ?case |
|
92 proof(cases "cs = cs1") |
|
93 case True |
|
94 thus ?thesis (is "distinct ?L") |
|
95 proof - |
|
96 have "?L = wq_fun (schs s) cs1 @ [th]" using True |
|
97 by (simp add:wq_def wf_def Let_def split:list.splits) |
|
98 moreover have "distinct ..." |
|
99 proof - |
|
100 have "th \<notin> set (wq_fun (schs s) cs1)" |
|
101 proof |
|
102 assume otherwise: "th \<in> set (wq_fun (schs s) cs1)" |
|
103 from runing_head[OF thread_P(1) this] |
|
104 have "th = hd (wq_fun (schs s) cs1)" . |
|
105 hence "(Cs cs1, Th th) \<in> (RAG s)" using otherwise |
|
106 by (simp add:s_RAG_def s_holding_def wq_def cs_holding_def) |
|
107 with thread_P(2) show False by auto |
|
108 qed |
|
109 moreover have "distinct (wq_fun (schs s) cs1)" |
|
110 using True thread_P wq_def by auto |
|
111 ultimately show ?thesis by auto |
|
112 qed |
|
113 ultimately show ?thesis by simp |
|
114 qed |
|
115 next |
|
116 case False |
|
117 with thread_P(3) |
|
118 show ?thesis |
|
119 by (auto simp:wq_def wf_def Let_def split:list.splits) |
|
120 qed |
|
121 next |
|
122 case (thread_V th s cs1) |
|
123 thus ?case |
|
124 proof(cases "cs = cs1") |
|
125 case True |
|
126 show ?thesis (is "distinct ?L") |
|
127 proof(cases "(wq s cs)") |
|
128 case Nil |
|
129 thus ?thesis |
|
130 by (auto simp:wq_def wf_def Let_def split:list.splits) |
|
131 next |
|
132 case (Cons w_hd w_tl) |
|
133 moreover have "distinct (SOME q. distinct q \<and> set q = set w_tl)" |
|
134 proof(rule someI2) |
|
135 from thread_V(3)[unfolded Cons] |
|
136 show "distinct w_tl \<and> set w_tl = set w_tl" by auto |
|
137 qed auto |
|
138 ultimately show ?thesis |
|
139 by (auto simp:wq_def wf_def Let_def True split:list.splits) |
|
140 qed |
|
141 next |
|
142 case False |
|
143 with thread_V(3) |
|
144 show ?thesis |
|
145 by (auto simp:wq_def wf_def Let_def split:list.splits) |
|
146 qed |
|
147 qed (insert Cons, auto simp: wq_def Let_def split:list.splits) |
|
148 qed (unfold wq_def Let_def, simp) |
|
149 |
|
150 end |
|
151 |
|
152 context valid_trace_e |
|
153 begin |
|
154 |
|
155 text {* |
|
156 The following lemma shows that only the @{text "P"} |
|
157 operation can add new thread into waiting queues. |
|
158 Such kind of lemmas are very obvious, but need to be checked formally. |
|
159 This is a kind of confirmation that our modelling is correct. |
4 *} |
160 *} |
5 theory CpsG |
161 |
6 imports PrioG Max RTree |
162 lemma wq_in_inv: |
|
163 assumes s_ni: "thread \<notin> set (wq s cs)" |
|
164 and s_i: "thread \<in> set (wq (e#s) cs)" |
|
165 shows "e = P thread cs" |
|
166 proof(cases e) |
|
167 -- {* This is the only non-trivial case: *} |
|
168 case (V th cs1) |
|
169 have False |
|
170 proof(cases "cs1 = cs") |
|
171 case True |
|
172 show ?thesis |
|
173 proof(cases "(wq s cs1)") |
|
174 case (Cons w_hd w_tl) |
|
175 have "set (wq (e#s) cs) \<subseteq> set (wq s cs)" |
|
176 proof - |
|
177 have "(wq (e#s) cs) = (SOME q. distinct q \<and> set q = set w_tl)" |
|
178 using Cons V by (auto simp:wq_def Let_def True split:if_splits) |
|
179 moreover have "set ... \<subseteq> set (wq s cs)" |
|
180 proof(rule someI2) |
|
181 show "distinct w_tl \<and> set w_tl = set w_tl" |
|
182 by (metis distinct.simps(2) local.Cons wq_distinct) |
|
183 qed (insert Cons True, auto) |
|
184 ultimately show ?thesis by simp |
|
185 qed |
|
186 with assms show ?thesis by auto |
|
187 qed (insert assms V True, auto simp:wq_def Let_def split:if_splits) |
|
188 qed (insert assms V, auto simp:wq_def Let_def split:if_splits) |
|
189 thus ?thesis by auto |
|
190 qed (insert assms, auto simp:wq_def Let_def split:if_splits) |
|
191 |
|
192 lemma wq_out_inv: |
|
193 assumes s_in: "thread \<in> set (wq s cs)" |
|
194 and s_hd: "thread = hd (wq s cs)" |
|
195 and s_i: "thread \<noteq> hd (wq (e#s) cs)" |
|
196 shows "e = V thread cs" |
|
197 proof(cases e) |
|
198 -- {* There are only two non-trivial cases: *} |
|
199 case (V th cs1) |
|
200 show ?thesis |
|
201 proof(cases "cs1 = cs") |
|
202 case True |
|
203 have "PIP s (V th cs)" using pip_e[unfolded V[unfolded True]] . |
|
204 thus ?thesis |
|
205 proof(cases) |
|
206 case (thread_V) |
|
207 moreover have "th = thread" using thread_V(2) s_hd |
|
208 by (unfold s_holding_def wq_def, simp) |
|
209 ultimately show ?thesis using V True by simp |
|
210 qed |
|
211 qed (insert assms V, auto simp:wq_def Let_def split:if_splits) |
|
212 next |
|
213 case (P th cs1) |
|
214 show ?thesis |
|
215 proof(cases "cs1 = cs") |
|
216 case True |
|
217 with P have "wq (e#s) cs = wq_fun (schs s) cs @ [th]" |
|
218 by (auto simp:wq_def Let_def split:if_splits) |
|
219 with s_i s_hd s_in have False |
|
220 by (metis empty_iff hd_append2 list.set(1) wq_def) |
|
221 thus ?thesis by simp |
|
222 qed (insert assms P, auto simp:wq_def Let_def split:if_splits) |
|
223 qed (insert assms, auto simp:wq_def Let_def split:if_splits) |
|
224 |
|
225 end |
|
226 |
|
227 text {* |
|
228 The following lemmas is also obvious and shallow. It says |
|
229 that only running thread can request for a critical resource |
|
230 and that the requested resource must be one which is |
|
231 not current held by the thread. |
|
232 *} |
|
233 |
|
234 lemma p_pre: "\<lbrakk>vt ((P thread cs)#s)\<rbrakk> \<Longrightarrow> |
|
235 thread \<in> runing s \<and> (Cs cs, Th thread) \<notin> (RAG s)^+" |
|
236 apply (ind_cases "vt ((P thread cs)#s)") |
|
237 apply (ind_cases "step s (P thread cs)") |
|
238 by auto |
|
239 |
|
240 lemma abs1: |
|
241 assumes ein: "e \<in> set es" |
|
242 and neq: "hd es \<noteq> hd (es @ [x])" |
|
243 shows "False" |
|
244 proof - |
|
245 from ein have "es \<noteq> []" by auto |
|
246 then obtain e ess where "es = e # ess" by (cases es, auto) |
|
247 with neq show ?thesis by auto |
|
248 qed |
|
249 |
|
250 lemma q_head: "Q (hd es) \<Longrightarrow> hd es = hd [th\<leftarrow>es . Q th]" |
|
251 by (cases es, auto) |
|
252 |
|
253 inductive_cases evt_cons: "vt (a#s)" |
|
254 |
|
255 context valid_trace_e |
7 begin |
256 begin |
8 |
257 |
9 text {* @{text "the_preced"} is also the same as @{text "preced"}, the only |
258 lemma abs2: |
10 difference is the order of arguemts. *} |
259 assumes inq: "thread \<in> set (wq s cs)" |
11 definition "the_preced s th = preced th s" |
260 and nh: "thread = hd (wq s cs)" |
|
261 and qt: "thread \<noteq> hd (wq (e#s) cs)" |
|
262 and inq': "thread \<in> set (wq (e#s) cs)" |
|
263 shows "False" |
|
264 proof - |
|
265 from vt_e assms show "False" |
|
266 apply (cases e) |
|
267 apply ((simp split:if_splits add:Let_def wq_def)[1])+ |
|
268 apply (insert abs1, fast)[1] |
|
269 apply (auto simp:wq_def simp:Let_def split:if_splits list.splits) |
|
270 proof - |
|
271 fix th qs |
|
272 assume vt: "vt (V th cs # s)" |
|
273 and th_in: "thread \<in> set (SOME q. distinct q \<and> set q = set qs)" |
|
274 and eq_wq: "wq_fun (schs s) cs = thread # qs" |
|
275 show "False" |
|
276 proof - |
|
277 from wq_distinct[of cs] |
|
278 and eq_wq[folded wq_def] have "distinct (thread#qs)" by simp |
|
279 moreover have "thread \<in> set qs" |
|
280 proof - |
|
281 have "set (SOME q. distinct q \<and> set q = set qs) = set qs" |
|
282 proof(rule someI2) |
|
283 from wq_distinct [of cs] |
|
284 and eq_wq [folded wq_def] |
|
285 show "distinct qs \<and> set qs = set qs" by auto |
|
286 next |
|
287 fix x assume "distinct x \<and> set x = set qs" |
|
288 thus "set x = set qs" by auto |
|
289 qed |
|
290 with th_in show ?thesis by auto |
|
291 qed |
|
292 ultimately show ?thesis by auto |
|
293 qed |
|
294 qed |
|
295 qed |
|
296 |
|
297 end |
|
298 |
|
299 |
|
300 context valid_trace |
|
301 begin |
|
302 lemma vt_moment: "\<And> t. vt (moment t s)" |
|
303 proof(induct rule:ind) |
|
304 case Nil |
|
305 thus ?case by (simp add:vt_nil) |
|
306 next |
|
307 case (Cons s e t) |
|
308 show ?case |
|
309 proof(cases "t \<ge> length (e#s)") |
|
310 case True |
|
311 from True have "moment t (e#s) = e#s" by simp |
|
312 thus ?thesis using Cons |
|
313 by (simp add:valid_trace_def) |
|
314 next |
|
315 case False |
|
316 from Cons have "vt (moment t s)" by simp |
|
317 moreover have "moment t (e#s) = moment t s" |
|
318 proof - |
|
319 from False have "t \<le> length s" by simp |
|
320 from moment_app [OF this, of "[e]"] |
|
321 show ?thesis by simp |
|
322 qed |
|
323 ultimately show ?thesis by simp |
|
324 qed |
|
325 qed |
|
326 end |
|
327 |
|
328 |
|
329 locale valid_moment = valid_trace + |
|
330 fixes i :: nat |
|
331 |
|
332 sublocale valid_moment < vat_moment: valid_trace "(moment i s)" |
|
333 by (unfold_locales, insert vt_moment, auto) |
|
334 |
|
335 context valid_trace |
|
336 begin |
|
337 |
|
338 |
|
339 text {* (* ddd *) |
|
340 The nature of the work is like this: since it starts from a very simple and basic |
|
341 model, even intuitively very `basic` and `obvious` properties need to derived from scratch. |
|
342 For instance, the fact |
|
343 that one thread can not be blocked by two critical resources at the same time |
|
344 is obvious, because only running threads can make new requests, if one is waiting for |
|
345 a critical resource and get blocked, it can not make another resource request and get |
|
346 blocked the second time (because it is not running). |
|
347 |
|
348 To derive this fact, one needs to prove by contraction and |
|
349 reason about time (or @{text "moement"}). The reasoning is based on a generic theorem |
|
350 named @{text "p_split"}, which is about status changing along the time axis. It says if |
|
351 a condition @{text "Q"} is @{text "True"} at a state @{text "s"}, |
|
352 but it was @{text "False"} at the very beginning, then there must exits a moment @{text "t"} |
|
353 in the history of @{text "s"} (notice that @{text "s"} itself is essentially the history |
|
354 of events leading to it), such that @{text "Q"} switched |
|
355 from being @{text "False"} to @{text "True"} and kept being @{text "True"} |
|
356 till the last moment of @{text "s"}. |
|
357 |
|
358 Suppose a thread @{text "th"} is blocked |
|
359 on @{text "cs1"} and @{text "cs2"} in some state @{text "s"}, |
|
360 since no thread is blocked at the very beginning, by applying |
|
361 @{text "p_split"} to these two blocking facts, there exist |
|
362 two moments @{text "t1"} and @{text "t2"} in @{text "s"}, such that |
|
363 @{text "th"} got blocked on @{text "cs1"} and @{text "cs2"} |
|
364 and kept on blocked on them respectively ever since. |
|
365 |
|
366 Without lost of generality, we assume @{text "t1"} is earlier than @{text "t2"}. |
|
367 However, since @{text "th"} was blocked ever since memonent @{text "t1"}, so it was still |
|
368 in blocked state at moment @{text "t2"} and could not |
|
369 make any request and get blocked the second time: Contradiction. |
|
370 *} |
|
371 |
|
372 lemma waiting_unique_pre: (* ccc *) |
|
373 assumes h11: "thread \<in> set (wq s cs1)" |
|
374 and h12: "thread \<noteq> hd (wq s cs1)" |
|
375 assumes h21: "thread \<in> set (wq s cs2)" |
|
376 and h22: "thread \<noteq> hd (wq s cs2)" |
|
377 and neq12: "cs1 \<noteq> cs2" |
|
378 shows "False" |
|
379 proof - |
|
380 let "?Q" = "\<lambda> cs s. thread \<in> set (wq s cs) \<and> thread \<noteq> hd (wq s cs)" |
|
381 from h11 and h12 have q1: "?Q cs1 s" by simp |
|
382 from h21 and h22 have q2: "?Q cs2 s" by simp |
|
383 have nq1: "\<not> ?Q cs1 []" by (simp add:wq_def) |
|
384 have nq2: "\<not> ?Q cs2 []" by (simp add:wq_def) |
|
385 from p_split [of "?Q cs1", OF q1 nq1] |
|
386 obtain t1 where lt1: "t1 < length s" |
|
387 and np1: "\<not> ?Q cs1 (moment t1 s)" |
|
388 and nn1: "(\<forall>i'>t1. ?Q cs1 (moment i' s))" by auto |
|
389 from p_split [of "?Q cs2", OF q2 nq2] |
|
390 obtain t2 where lt2: "t2 < length s" |
|
391 and np2: "\<not> ?Q cs2 (moment t2 s)" |
|
392 and nn2: "(\<forall>i'>t2. ?Q cs2 (moment i' s))" by auto |
|
393 { fix s cs |
|
394 assume q: "?Q cs s" |
|
395 have "thread \<notin> runing s" |
|
396 proof |
|
397 assume "thread \<in> runing s" |
|
398 hence " \<forall>cs. \<not> (thread \<in> set (wq_fun (schs s) cs) \<and> |
|
399 thread \<noteq> hd (wq_fun (schs s) cs))" |
|
400 by (unfold runing_def s_waiting_def readys_def, auto) |
|
401 from this[rule_format, of cs] q |
|
402 show False by (simp add: wq_def) |
|
403 qed |
|
404 } note q_not_runing = this |
|
405 { fix i1 i2 |
|
406 let ?i3 = "Suc i2" |
|
407 assume lt12: "i1 < i2" |
|
408 and "i1 < length s" "i2 < length s" |
|
409 hence le_i3: "?i3 \<le> length s" by auto |
|
410 from moment_plus [OF this] |
|
411 obtain e where eq_m: "moment ?i3 s = e#moment i2 s" by auto |
|
412 have "i2 < ?i3" by simp |
|
413 from nn2 [rule_format, OF this] and eq_m |
|
414 have h1: "thread \<in> set (wq (e#moment t2 s) cs2)" and |
|
415 h2: "thread \<noteq> hd (wq (e#moment t2 s) cs2)" by auto |
|
416 have "vt (e#moment t2 s)" |
|
417 proof - |
|
418 from vt_moment |
|
419 have "vt (moment ?t3 s)" . |
|
420 with eq_m show ?thesis by simp |
|
421 qed |
|
422 then interpret vt_e: valid_trace_e "moment t2 s" "e" |
|
423 by (unfold_locales, auto, cases, simp) |
|
424 have ?thesis |
|
425 proof(cases "thread \<in> set (wq (moment t2 s) cs2)") |
|
426 case True |
|
427 from True and np2 have eq_th: "thread = hd (wq (moment t2 s) cs2)" |
|
428 by auto |
|
429 from vt_e.abs2 [OF True eq_th h2 h1] |
|
430 show ?thesis by auto |
|
431 next |
|
432 case False |
|
433 from vt_e.block_pre[OF False h1] |
|
434 have "e = P thread cs2" . |
|
435 with vt_e.vt_e have "vt ((P thread cs2)# moment t2 s)" by simp |
|
436 from p_pre [OF this] have "thread \<in> runing (moment t2 s)" by simp |
|
437 with runing_ready have "thread \<in> readys (moment t2 s)" by auto |
|
438 with nn1 [rule_format, OF lt12] |
|
439 show ?thesis by (simp add:readys_def wq_def s_waiting_def, auto) |
|
440 qed |
|
441 } |
|
442 show ?thesis |
|
443 proof - |
|
444 { |
|
445 assume lt12: "t1 < t2" |
|
446 let ?t3 = "Suc t2" |
|
447 from lt2 have le_t3: "?t3 \<le> length s" by auto |
|
448 from moment_plus [OF this] |
|
449 obtain e where eq_m: "moment ?t3 s = e#moment t2 s" by auto |
|
450 have "t2 < ?t3" by simp |
|
451 from nn2 [rule_format, OF this] and eq_m |
|
452 have h1: "thread \<in> set (wq (e#moment t2 s) cs2)" and |
|
453 h2: "thread \<noteq> hd (wq (e#moment t2 s) cs2)" by auto |
|
454 have "vt (e#moment t2 s)" |
|
455 proof - |
|
456 from vt_moment |
|
457 have "vt (moment ?t3 s)" . |
|
458 with eq_m show ?thesis by simp |
|
459 qed |
|
460 then interpret vt_e: valid_trace_e "moment t2 s" "e" |
|
461 by (unfold_locales, auto, cases, simp) |
|
462 have ?thesis |
|
463 proof(cases "thread \<in> set (wq (moment t2 s) cs2)") |
|
464 case True |
|
465 from True and np2 have eq_th: "thread = hd (wq (moment t2 s) cs2)" |
|
466 by auto |
|
467 from vt_e.abs2 [OF True eq_th h2 h1] |
|
468 show ?thesis by auto |
|
469 next |
|
470 case False |
|
471 from vt_e.block_pre[OF False h1] |
|
472 have "e = P thread cs2" . |
|
473 with vt_e.vt_e have "vt ((P thread cs2)# moment t2 s)" by simp |
|
474 from p_pre [OF this] have "thread \<in> runing (moment t2 s)" by simp |
|
475 with runing_ready have "thread \<in> readys (moment t2 s)" by auto |
|
476 with nn1 [rule_format, OF lt12] |
|
477 show ?thesis by (simp add:readys_def wq_def s_waiting_def, auto) |
|
478 qed |
|
479 } moreover { |
|
480 assume lt12: "t2 < t1" |
|
481 let ?t3 = "Suc t1" |
|
482 from lt1 have le_t3: "?t3 \<le> length s" by auto |
|
483 from moment_plus [OF this] |
|
484 obtain e where eq_m: "moment ?t3 s = e#moment t1 s" by auto |
|
485 have lt_t3: "t1 < ?t3" by simp |
|
486 from nn1 [rule_format, OF this] and eq_m |
|
487 have h1: "thread \<in> set (wq (e#moment t1 s) cs1)" and |
|
488 h2: "thread \<noteq> hd (wq (e#moment t1 s) cs1)" by auto |
|
489 have "vt (e#moment t1 s)" |
|
490 proof - |
|
491 from vt_moment |
|
492 have "vt (moment ?t3 s)" . |
|
493 with eq_m show ?thesis by simp |
|
494 qed |
|
495 then interpret vt_e: valid_trace_e "moment t1 s" e |
|
496 by (unfold_locales, auto, cases, auto) |
|
497 have ?thesis |
|
498 proof(cases "thread \<in> set (wq (moment t1 s) cs1)") |
|
499 case True |
|
500 from True and np1 have eq_th: "thread = hd (wq (moment t1 s) cs1)" |
|
501 by auto |
|
502 from vt_e.abs2 True eq_th h2 h1 |
|
503 show ?thesis by auto |
|
504 next |
|
505 case False |
|
506 from vt_e.block_pre [OF False h1] |
|
507 have "e = P thread cs1" . |
|
508 with vt_e.vt_e have "vt ((P thread cs1)# moment t1 s)" by simp |
|
509 from p_pre [OF this] have "thread \<in> runing (moment t1 s)" by simp |
|
510 with runing_ready have "thread \<in> readys (moment t1 s)" by auto |
|
511 with nn2 [rule_format, OF lt12] |
|
512 show ?thesis by (simp add:readys_def wq_def s_waiting_def, auto) |
|
513 qed |
|
514 } moreover { |
|
515 assume eqt12: "t1 = t2" |
|
516 let ?t3 = "Suc t1" |
|
517 from lt1 have le_t3: "?t3 \<le> length s" by auto |
|
518 from moment_plus [OF this] |
|
519 obtain e where eq_m: "moment ?t3 s = e#moment t1 s" by auto |
|
520 have lt_t3: "t1 < ?t3" by simp |
|
521 from nn1 [rule_format, OF this] and eq_m |
|
522 have h1: "thread \<in> set (wq (e#moment t1 s) cs1)" and |
|
523 h2: "thread \<noteq> hd (wq (e#moment t1 s) cs1)" by auto |
|
524 have vt_e: "vt (e#moment t1 s)" |
|
525 proof - |
|
526 from vt_moment |
|
527 have "vt (moment ?t3 s)" . |
|
528 with eq_m show ?thesis by simp |
|
529 qed |
|
530 then interpret vt_e: valid_trace_e "moment t1 s" e |
|
531 by (unfold_locales, auto, cases, auto) |
|
532 have ?thesis |
|
533 proof(cases "thread \<in> set (wq (moment t1 s) cs1)") |
|
534 case True |
|
535 from True and np1 have eq_th: "thread = hd (wq (moment t1 s) cs1)" |
|
536 by auto |
|
537 from vt_e.abs2 [OF True eq_th h2 h1] |
|
538 show ?thesis by auto |
|
539 next |
|
540 case False |
|
541 from vt_e.block_pre [OF False h1] |
|
542 have eq_e1: "e = P thread cs1" . |
|
543 have lt_t3: "t1 < ?t3" by simp |
|
544 with eqt12 have "t2 < ?t3" by simp |
|
545 from nn2 [rule_format, OF this] and eq_m and eqt12 |
|
546 have h1: "thread \<in> set (wq (e#moment t2 s) cs2)" and |
|
547 h2: "thread \<noteq> hd (wq (e#moment t2 s) cs2)" by auto |
|
548 show ?thesis |
|
549 proof(cases "thread \<in> set (wq (moment t2 s) cs2)") |
|
550 case True |
|
551 from True and np2 have eq_th: "thread = hd (wq (moment t2 s) cs2)" |
|
552 by auto |
|
553 from vt_e and eqt12 have "vt (e#moment t2 s)" by simp |
|
554 then interpret vt_e2: valid_trace_e "moment t2 s" e |
|
555 by (unfold_locales, auto, cases, auto) |
|
556 from vt_e2.abs2 [OF True eq_th h2 h1] |
|
557 show ?thesis . |
|
558 next |
|
559 case False |
|
560 have "vt (e#moment t2 s)" |
|
561 proof - |
|
562 from vt_moment eqt12 |
|
563 have "vt (moment (Suc t2) s)" by auto |
|
564 with eq_m eqt12 show ?thesis by simp |
|
565 qed |
|
566 then interpret vt_e2: valid_trace_e "moment t2 s" e |
|
567 by (unfold_locales, auto, cases, auto) |
|
568 from vt_e2.block_pre [OF False h1] |
|
569 have "e = P thread cs2" . |
|
570 with eq_e1 neq12 show ?thesis by auto |
|
571 qed |
|
572 qed |
|
573 } ultimately show ?thesis by arith |
|
574 qed |
|
575 qed |
|
576 |
|
577 text {* |
|
578 This lemma is a simple corrolary of @{text "waiting_unique_pre"}. |
|
579 *} |
|
580 |
|
581 lemma waiting_unique: |
|
582 assumes "waiting s th cs1" |
|
583 and "waiting s th cs2" |
|
584 shows "cs1 = cs2" |
|
585 using waiting_unique_pre assms |
|
586 unfolding wq_def s_waiting_def |
|
587 by auto |
|
588 |
|
589 end |
|
590 |
|
591 (* not used *) |
|
592 text {* |
|
593 Every thread can only be blocked on one critical resource, |
|
594 symmetrically, every critical resource can only be held by one thread. |
|
595 This fact is much more easier according to our definition. |
|
596 *} |
|
597 lemma held_unique: |
|
598 assumes "holding (s::event list) th1 cs" |
|
599 and "holding s th2 cs" |
|
600 shows "th1 = th2" |
|
601 by (insert assms, unfold s_holding_def, auto) |
|
602 |
|
603 |
|
604 lemma last_set_lt: "th \<in> threads s \<Longrightarrow> last_set th s < length s" |
|
605 apply (induct s, auto) |
|
606 by (case_tac a, auto split:if_splits) |
|
607 |
|
608 lemma last_set_unique: |
|
609 "\<lbrakk>last_set th1 s = last_set th2 s; th1 \<in> threads s; th2 \<in> threads s\<rbrakk> |
|
610 \<Longrightarrow> th1 = th2" |
|
611 apply (induct s, auto) |
|
612 by (case_tac a, auto split:if_splits dest:last_set_lt) |
|
613 |
|
614 lemma preced_unique : |
|
615 assumes pcd_eq: "preced th1 s = preced th2 s" |
|
616 and th_in1: "th1 \<in> threads s" |
|
617 and th_in2: " th2 \<in> threads s" |
|
618 shows "th1 = th2" |
|
619 proof - |
|
620 from pcd_eq have "last_set th1 s = last_set th2 s" by (simp add:preced_def) |
|
621 from last_set_unique [OF this th_in1 th_in2] |
|
622 show ?thesis . |
|
623 qed |
|
624 |
|
625 lemma preced_linorder: |
|
626 assumes neq_12: "th1 \<noteq> th2" |
|
627 and th_in1: "th1 \<in> threads s" |
|
628 and th_in2: " th2 \<in> threads s" |
|
629 shows "preced th1 s < preced th2 s \<or> preced th1 s > preced th2 s" |
|
630 proof - |
|
631 from preced_unique [OF _ th_in1 th_in2] and neq_12 |
|
632 have "preced th1 s \<noteq> preced th2 s" by auto |
|
633 thus ?thesis by auto |
|
634 qed |
|
635 |
|
636 (* An aux lemma used later *) |
|
637 lemma unique_minus: |
|
638 assumes unique: "\<And> a b c. \<lbrakk>(a, b) \<in> r; (a, c) \<in> r\<rbrakk> \<Longrightarrow> b = c" |
|
639 and xy: "(x, y) \<in> r" |
|
640 and xz: "(x, z) \<in> r^+" |
|
641 and neq: "y \<noteq> z" |
|
642 shows "(y, z) \<in> r^+" |
|
643 proof - |
|
644 from xz and neq show ?thesis |
|
645 proof(induct) |
|
646 case (base ya) |
|
647 have "(x, ya) \<in> r" by fact |
|
648 from unique [OF xy this] have "y = ya" . |
|
649 with base show ?case by auto |
|
650 next |
|
651 case (step ya z) |
|
652 show ?case |
|
653 proof(cases "y = ya") |
|
654 case True |
|
655 from step True show ?thesis by simp |
|
656 next |
|
657 case False |
|
658 from step False |
|
659 show ?thesis by auto |
|
660 qed |
|
661 qed |
|
662 qed |
|
663 |
|
664 lemma unique_base: |
|
665 assumes unique: "\<And> a b c. \<lbrakk>(a, b) \<in> r; (a, c) \<in> r\<rbrakk> \<Longrightarrow> b = c" |
|
666 and xy: "(x, y) \<in> r" |
|
667 and xz: "(x, z) \<in> r^+" |
|
668 and neq_yz: "y \<noteq> z" |
|
669 shows "(y, z) \<in> r^+" |
|
670 proof - |
|
671 from xz neq_yz show ?thesis |
|
672 proof(induct) |
|
673 case (base ya) |
|
674 from xy unique base show ?case by auto |
|
675 next |
|
676 case (step ya z) |
|
677 show ?case |
|
678 proof(cases "y = ya") |
|
679 case True |
|
680 from True step show ?thesis by auto |
|
681 next |
|
682 case False |
|
683 from False step |
|
684 have "(y, ya) \<in> r\<^sup>+" by auto |
|
685 with step show ?thesis by auto |
|
686 qed |
|
687 qed |
|
688 qed |
|
689 |
|
690 lemma unique_chain: |
|
691 assumes unique: "\<And> a b c. \<lbrakk>(a, b) \<in> r; (a, c) \<in> r\<rbrakk> \<Longrightarrow> b = c" |
|
692 and xy: "(x, y) \<in> r^+" |
|
693 and xz: "(x, z) \<in> r^+" |
|
694 and neq_yz: "y \<noteq> z" |
|
695 shows "(y, z) \<in> r^+ \<or> (z, y) \<in> r^+" |
|
696 proof - |
|
697 from xy xz neq_yz show ?thesis |
|
698 proof(induct) |
|
699 case (base y) |
|
700 have h1: "(x, y) \<in> r" and h2: "(x, z) \<in> r\<^sup>+" and h3: "y \<noteq> z" using base by auto |
|
701 from unique_base [OF _ h1 h2 h3] and unique show ?case by auto |
|
702 next |
|
703 case (step y za) |
|
704 show ?case |
|
705 proof(cases "y = z") |
|
706 case True |
|
707 from True step show ?thesis by auto |
|
708 next |
|
709 case False |
|
710 from False step have "(y, z) \<in> r\<^sup>+ \<or> (z, y) \<in> r\<^sup>+" by auto |
|
711 thus ?thesis |
|
712 proof |
|
713 assume "(z, y) \<in> r\<^sup>+" |
|
714 with step have "(z, za) \<in> r\<^sup>+" by auto |
|
715 thus ?thesis by auto |
|
716 next |
|
717 assume h: "(y, z) \<in> r\<^sup>+" |
|
718 from step have yza: "(y, za) \<in> r" by simp |
|
719 from step have "za \<noteq> z" by simp |
|
720 from unique_minus [OF _ yza h this] and unique |
|
721 have "(za, z) \<in> r\<^sup>+" by auto |
|
722 thus ?thesis by auto |
|
723 qed |
|
724 qed |
|
725 qed |
|
726 qed |
|
727 |
|
728 text {* |
|
729 The following three lemmas show that @{text "RAG"} does not change |
|
730 by the happening of @{text "Set"}, @{text "Create"} and @{text "Exit"} |
|
731 events, respectively. |
|
732 *} |
|
733 |
|
734 lemma RAG_set_unchanged: "(RAG (Set th prio # s)) = RAG s" |
|
735 apply (unfold s_RAG_def s_waiting_def wq_def) |
|
736 by (simp add:Let_def) |
|
737 |
|
738 lemma RAG_create_unchanged: "(RAG (Create th prio # s)) = RAG s" |
|
739 apply (unfold s_RAG_def s_waiting_def wq_def) |
|
740 by (simp add:Let_def) |
|
741 |
|
742 lemma RAG_exit_unchanged: "(RAG (Exit th # s)) = RAG s" |
|
743 apply (unfold s_RAG_def s_waiting_def wq_def) |
|
744 by (simp add:Let_def) |
|
745 |
|
746 |
|
747 text {* |
|
748 The following lemmas are used in the proof of |
|
749 lemma @{text "step_RAG_v"}, which characterizes how the @{text "RAG"} is changed |
|
750 by @{text "V"}-events. |
|
751 However, since our model is very concise, such seemingly obvious lemmas need to be derived from scratch, |
|
752 starting from the model definitions. |
|
753 *} |
|
754 lemma step_v_hold_inv[elim_format]: |
|
755 "\<And>c t. \<lbrakk>vt (V th cs # s); |
|
756 \<not> holding (wq s) t c; holding (wq (V th cs # s)) t c\<rbrakk> \<Longrightarrow> |
|
757 next_th s th cs t \<and> c = cs" |
|
758 proof - |
|
759 fix c t |
|
760 assume vt: "vt (V th cs # s)" |
|
761 and nhd: "\<not> holding (wq s) t c" |
|
762 and hd: "holding (wq (V th cs # s)) t c" |
|
763 show "next_th s th cs t \<and> c = cs" |
|
764 proof(cases "c = cs") |
|
765 case False |
|
766 with nhd hd show ?thesis |
|
767 by (unfold cs_holding_def wq_def, auto simp:Let_def) |
|
768 next |
|
769 case True |
|
770 with step_back_step [OF vt] |
|
771 have "step s (V th c)" by simp |
|
772 hence "next_th s th cs t" |
|
773 proof(cases) |
|
774 assume "holding s th c" |
|
775 with nhd hd show ?thesis |
|
776 apply (unfold s_holding_def cs_holding_def wq_def next_th_def, |
|
777 auto simp:Let_def split:list.splits if_splits) |
|
778 proof - |
|
779 assume " hd (SOME q. distinct q \<and> q = []) \<in> set (SOME q. distinct q \<and> q = [])" |
|
780 moreover have "\<dots> = set []" |
|
781 proof(rule someI2) |
|
782 show "distinct [] \<and> [] = []" by auto |
|
783 next |
|
784 fix x assume "distinct x \<and> x = []" |
|
785 thus "set x = set []" by auto |
|
786 qed |
|
787 ultimately show False by auto |
|
788 next |
|
789 assume " hd (SOME q. distinct q \<and> q = []) \<in> set (SOME q. distinct q \<and> q = [])" |
|
790 moreover have "\<dots> = set []" |
|
791 proof(rule someI2) |
|
792 show "distinct [] \<and> [] = []" by auto |
|
793 next |
|
794 fix x assume "distinct x \<and> x = []" |
|
795 thus "set x = set []" by auto |
|
796 qed |
|
797 ultimately show False by auto |
|
798 qed |
|
799 qed |
|
800 with True show ?thesis by auto |
|
801 qed |
|
802 qed |
|
803 |
|
804 text {* |
|
805 The following @{text "step_v_wait_inv"} is also an obvious lemma, which, however, needs to be |
|
806 derived from scratch, which confirms the correctness of the definition of @{text "next_th"}. |
|
807 *} |
|
808 lemma step_v_wait_inv[elim_format]: |
|
809 "\<And>t c. \<lbrakk>vt (V th cs # s); \<not> waiting (wq (V th cs # s)) t c; waiting (wq s) t c |
|
810 \<rbrakk> |
|
811 \<Longrightarrow> (next_th s th cs t \<and> cs = c)" |
|
812 proof - |
|
813 fix t c |
|
814 assume vt: "vt (V th cs # s)" |
|
815 and nw: "\<not> waiting (wq (V th cs # s)) t c" |
|
816 and wt: "waiting (wq s) t c" |
|
817 from vt interpret vt_v: valid_trace_e s "V th cs" |
|
818 by (cases, unfold_locales, simp) |
|
819 show "next_th s th cs t \<and> cs = c" |
|
820 proof(cases "cs = c") |
|
821 case False |
|
822 with nw wt show ?thesis |
|
823 by (auto simp:cs_waiting_def wq_def Let_def) |
|
824 next |
|
825 case True |
|
826 from nw[folded True] wt[folded True] |
|
827 have "next_th s th cs t" |
|
828 apply (unfold next_th_def, auto simp:cs_waiting_def wq_def Let_def split:list.splits) |
|
829 proof - |
|
830 fix a list |
|
831 assume t_in: "t \<in> set list" |
|
832 and t_ni: "t \<notin> set (SOME q. distinct q \<and> set q = set list)" |
|
833 and eq_wq: "wq_fun (schs s) cs = a # list" |
|
834 have " set (SOME q. distinct q \<and> set q = set list) = set list" |
|
835 proof(rule someI2) |
|
836 from vt_v.wq_distinct[of cs] and eq_wq[folded wq_def] |
|
837 show "distinct list \<and> set list = set list" by auto |
|
838 next |
|
839 show "\<And>x. distinct x \<and> set x = set list \<Longrightarrow> set x = set list" |
|
840 by auto |
|
841 qed |
|
842 with t_ni and t_in show "a = th" by auto |
|
843 next |
|
844 fix a list |
|
845 assume t_in: "t \<in> set list" |
|
846 and t_ni: "t \<notin> set (SOME q. distinct q \<and> set q = set list)" |
|
847 and eq_wq: "wq_fun (schs s) cs = a # list" |
|
848 have " set (SOME q. distinct q \<and> set q = set list) = set list" |
|
849 proof(rule someI2) |
|
850 from vt_v.wq_distinct[of cs] and eq_wq[folded wq_def] |
|
851 show "distinct list \<and> set list = set list" by auto |
|
852 next |
|
853 show "\<And>x. distinct x \<and> set x = set list \<Longrightarrow> set x = set list" |
|
854 by auto |
|
855 qed |
|
856 with t_ni and t_in show "t = hd (SOME q. distinct q \<and> set q = set list)" by auto |
|
857 next |
|
858 fix a list |
|
859 assume eq_wq: "wq_fun (schs s) cs = a # list" |
|
860 from step_back_step[OF vt] |
|
861 show "a = th" |
|
862 proof(cases) |
|
863 assume "holding s th cs" |
|
864 with eq_wq show ?thesis |
|
865 by (unfold s_holding_def wq_def, auto) |
|
866 qed |
|
867 qed |
|
868 with True show ?thesis by simp |
|
869 qed |
|
870 qed |
|
871 |
|
872 lemma step_v_not_wait[consumes 3]: |
|
873 "\<lbrakk>vt (V th cs # s); next_th s th cs t; waiting (wq (V th cs # s)) t cs\<rbrakk> \<Longrightarrow> False" |
|
874 by (unfold next_th_def cs_waiting_def wq_def, auto simp:Let_def) |
|
875 |
|
876 lemma step_v_release: |
|
877 "\<lbrakk>vt (V th cs # s); holding (wq (V th cs # s)) th cs\<rbrakk> \<Longrightarrow> False" |
|
878 proof - |
|
879 assume vt: "vt (V th cs # s)" |
|
880 and hd: "holding (wq (V th cs # s)) th cs" |
|
881 from vt interpret vt_v: valid_trace_e s "V th cs" |
|
882 by (cases, unfold_locales, simp+) |
|
883 from step_back_step [OF vt] and hd |
|
884 show "False" |
|
885 proof(cases) |
|
886 assume "holding (wq (V th cs # s)) th cs" and "holding s th cs" |
|
887 thus ?thesis |
|
888 apply (unfold s_holding_def wq_def cs_holding_def) |
|
889 apply (auto simp:Let_def split:list.splits) |
|
890 proof - |
|
891 fix list |
|
892 assume eq_wq[folded wq_def]: |
|
893 "wq_fun (schs s) cs = hd (SOME q. distinct q \<and> set q = set list) # list" |
|
894 and hd_in: "hd (SOME q. distinct q \<and> set q = set list) |
|
895 \<in> set (SOME q. distinct q \<and> set q = set list)" |
|
896 have "set (SOME q. distinct q \<and> set q = set list) = set list" |
|
897 proof(rule someI2) |
|
898 from vt_v.wq_distinct[of cs] and eq_wq |
|
899 show "distinct list \<and> set list = set list" by auto |
|
900 next |
|
901 show "\<And>x. distinct x \<and> set x = set list \<Longrightarrow> set x = set list" |
|
902 by auto |
|
903 qed |
|
904 moreover have "distinct (hd (SOME q. distinct q \<and> set q = set list) # list)" |
|
905 proof - |
|
906 from vt_v.wq_distinct[of cs] and eq_wq |
|
907 show ?thesis by auto |
|
908 qed |
|
909 moreover note eq_wq and hd_in |
|
910 ultimately show "False" by auto |
|
911 qed |
|
912 qed |
|
913 qed |
|
914 |
|
915 lemma step_v_get_hold: |
|
916 "\<And>th'. \<lbrakk>vt (V th cs # s); \<not> holding (wq (V th cs # s)) th' cs; next_th s th cs th'\<rbrakk> \<Longrightarrow> False" |
|
917 apply (unfold cs_holding_def next_th_def wq_def, |
|
918 auto simp:Let_def) |
|
919 proof - |
|
920 fix rest |
|
921 assume vt: "vt (V th cs # s)" |
|
922 and eq_wq[folded wq_def]: " wq_fun (schs s) cs = th # rest" |
|
923 and nrest: "rest \<noteq> []" |
|
924 and ni: "hd (SOME q. distinct q \<and> set q = set rest) |
|
925 \<notin> set (SOME q. distinct q \<and> set q = set rest)" |
|
926 from vt interpret vt_v: valid_trace_e s "V th cs" |
|
927 by (cases, unfold_locales, simp+) |
|
928 have "(SOME q. distinct q \<and> set q = set rest) \<noteq> []" |
|
929 proof(rule someI2) |
|
930 from vt_v.wq_distinct[of cs] and eq_wq |
|
931 show "distinct rest \<and> set rest = set rest" by auto |
|
932 next |
|
933 fix x assume "distinct x \<and> set x = set rest" |
|
934 hence "set x = set rest" by auto |
|
935 with nrest |
|
936 show "x \<noteq> []" by (case_tac x, auto) |
|
937 qed |
|
938 with ni show "False" by auto |
|
939 qed |
|
940 |
|
941 lemma step_v_release_inv[elim_format]: |
|
942 "\<And>c t. \<lbrakk>vt (V th cs # s); \<not> holding (wq (V th cs # s)) t c; holding (wq s) t c\<rbrakk> \<Longrightarrow> |
|
943 c = cs \<and> t = th" |
|
944 apply (unfold cs_holding_def wq_def, auto simp:Let_def split:if_splits list.splits) |
|
945 proof - |
|
946 fix a list |
|
947 assume vt: "vt (V th cs # s)" and eq_wq: "wq_fun (schs s) cs = a # list" |
|
948 from step_back_step [OF vt] show "a = th" |
|
949 proof(cases) |
|
950 assume "holding s th cs" with eq_wq |
|
951 show ?thesis |
|
952 by (unfold s_holding_def wq_def, auto) |
|
953 qed |
|
954 next |
|
955 fix a list |
|
956 assume vt: "vt (V th cs # s)" and eq_wq: "wq_fun (schs s) cs = a # list" |
|
957 from step_back_step [OF vt] show "a = th" |
|
958 proof(cases) |
|
959 assume "holding s th cs" with eq_wq |
|
960 show ?thesis |
|
961 by (unfold s_holding_def wq_def, auto) |
|
962 qed |
|
963 qed |
|
964 |
|
965 lemma step_v_waiting_mono: |
|
966 "\<And>t c. \<lbrakk>vt (V th cs # s); waiting (wq (V th cs # s)) t c\<rbrakk> \<Longrightarrow> waiting (wq s) t c" |
|
967 proof - |
|
968 fix t c |
|
969 let ?s' = "(V th cs # s)" |
|
970 assume vt: "vt ?s'" |
|
971 and wt: "waiting (wq ?s') t c" |
|
972 from vt interpret vt_v: valid_trace_e s "V th cs" |
|
973 by (cases, unfold_locales, simp+) |
|
974 show "waiting (wq s) t c" |
|
975 proof(cases "c = cs") |
|
976 case False |
|
977 assume neq_cs: "c \<noteq> cs" |
|
978 hence "waiting (wq ?s') t c = waiting (wq s) t c" |
|
979 by (unfold cs_waiting_def wq_def, auto simp:Let_def) |
|
980 with wt show ?thesis by simp |
|
981 next |
|
982 case True |
|
983 with wt show ?thesis |
|
984 apply (unfold cs_waiting_def wq_def, auto simp:Let_def split:list.splits) |
|
985 proof - |
|
986 fix a list |
|
987 assume not_in: "t \<notin> set list" |
|
988 and is_in: "t \<in> set (SOME q. distinct q \<and> set q = set list)" |
|
989 and eq_wq: "wq_fun (schs s) cs = a # list" |
|
990 have "set (SOME q. distinct q \<and> set q = set list) = set list" |
|
991 proof(rule someI2) |
|
992 from vt_v.wq_distinct [of cs] |
|
993 and eq_wq[folded wq_def] |
|
994 show "distinct list \<and> set list = set list" by auto |
|
995 next |
|
996 fix x assume "distinct x \<and> set x = set list" |
|
997 thus "set x = set list" by auto |
|
998 qed |
|
999 with not_in is_in show "t = a" by auto |
|
1000 next |
|
1001 fix list |
|
1002 assume is_waiting: "waiting (wq (V th cs # s)) t cs" |
|
1003 and eq_wq: "wq_fun (schs s) cs = t # list" |
|
1004 hence "t \<in> set list" |
|
1005 apply (unfold wq_def, auto simp:Let_def cs_waiting_def) |
|
1006 proof - |
|
1007 assume " t \<in> set (SOME q. distinct q \<and> set q = set list)" |
|
1008 moreover have "\<dots> = set list" |
|
1009 proof(rule someI2) |
|
1010 from vt_v.wq_distinct [of cs] |
|
1011 and eq_wq[folded wq_def] |
|
1012 show "distinct list \<and> set list = set list" by auto |
|
1013 next |
|
1014 fix x assume "distinct x \<and> set x = set list" |
|
1015 thus "set x = set list" by auto |
|
1016 qed |
|
1017 ultimately show "t \<in> set list" by simp |
|
1018 qed |
|
1019 with eq_wq and vt_v.wq_distinct [of cs, unfolded wq_def] |
|
1020 show False by auto |
|
1021 qed |
|
1022 qed |
|
1023 qed |
|
1024 |
|
1025 text {* (* ddd *) |
|
1026 The following @{text "step_RAG_v"} lemma charaterizes how @{text "RAG"} is changed |
|
1027 with the happening of @{text "V"}-events: |
|
1028 *} |
|
1029 lemma step_RAG_v: |
|
1030 assumes vt: |
|
1031 "vt (V th cs#s)" |
|
1032 shows " |
|
1033 RAG (V th cs # s) = |
|
1034 RAG s - {(Cs cs, Th th)} - |
|
1035 {(Th th', Cs cs) |th'. next_th s th cs th'} \<union> |
|
1036 {(Cs cs, Th th') |th'. next_th s th cs th'}" |
|
1037 apply (insert vt, unfold s_RAG_def) |
|
1038 apply (auto split:if_splits list.splits simp:Let_def) |
|
1039 apply (auto elim: step_v_waiting_mono step_v_hold_inv |
|
1040 step_v_release step_v_wait_inv |
|
1041 step_v_get_hold step_v_release_inv) |
|
1042 apply (erule_tac step_v_not_wait, auto) |
|
1043 done |
|
1044 |
|
1045 text {* |
|
1046 The following @{text "step_RAG_p"} lemma charaterizes how @{text "RAG"} is changed |
|
1047 with the happening of @{text "P"}-events: |
|
1048 *} |
|
1049 lemma step_RAG_p: |
|
1050 "vt (P th cs#s) \<Longrightarrow> |
|
1051 RAG (P th cs # s) = (if (wq s cs = []) then RAG s \<union> {(Cs cs, Th th)} |
|
1052 else RAG s \<union> {(Th th, Cs cs)})" |
|
1053 apply(simp only: s_RAG_def wq_def) |
|
1054 apply (auto split:list.splits prod.splits simp:Let_def wq_def cs_waiting_def cs_holding_def) |
|
1055 apply(case_tac "csa = cs", auto) |
|
1056 apply(fold wq_def) |
|
1057 apply(drule_tac step_back_step) |
|
1058 apply(ind_cases " step s (P (hd (wq s cs)) cs)") |
|
1059 apply(simp add:s_RAG_def wq_def cs_holding_def) |
|
1060 apply(auto) |
|
1061 done |
|
1062 |
|
1063 |
|
1064 lemma RAG_target_th: "(Th th, x) \<in> RAG (s::state) \<Longrightarrow> \<exists> cs. x = Cs cs" |
|
1065 by (unfold s_RAG_def, auto) |
|
1066 |
|
1067 context valid_trace |
|
1068 begin |
|
1069 |
|
1070 text {* |
|
1071 The following lemma shows that @{text "RAG"} is acyclic. |
|
1072 The overall structure is by induction on the formation of @{text "vt s"} |
|
1073 and then case analysis on event @{text "e"}, where the non-trivial cases |
|
1074 for those for @{text "V"} and @{text "P"} events. |
|
1075 *} |
|
1076 lemma acyclic_RAG: |
|
1077 shows "acyclic (RAG s)" |
|
1078 using vt |
|
1079 proof(induct) |
|
1080 case (vt_cons s e) |
|
1081 interpret vt_s: valid_trace s using vt_cons(1) |
|
1082 by (unfold_locales, simp) |
|
1083 assume ih: "acyclic (RAG s)" |
|
1084 and stp: "step s e" |
|
1085 and vt: "vt s" |
|
1086 show ?case |
|
1087 proof(cases e) |
|
1088 case (Create th prio) |
|
1089 with ih |
|
1090 show ?thesis by (simp add:RAG_create_unchanged) |
|
1091 next |
|
1092 case (Exit th) |
|
1093 with ih show ?thesis by (simp add:RAG_exit_unchanged) |
|
1094 next |
|
1095 case (V th cs) |
|
1096 from V vt stp have vtt: "vt (V th cs#s)" by auto |
|
1097 from step_RAG_v [OF this] |
|
1098 have eq_de: |
|
1099 "RAG (e # s) = |
|
1100 RAG s - {(Cs cs, Th th)} - {(Th th', Cs cs) |th'. next_th s th cs th'} \<union> |
|
1101 {(Cs cs, Th th') |th'. next_th s th cs th'}" |
|
1102 (is "?L = (?A - ?B - ?C) \<union> ?D") by (simp add:V) |
|
1103 from ih have ac: "acyclic (?A - ?B - ?C)" by (auto elim:acyclic_subset) |
|
1104 from step_back_step [OF vtt] |
|
1105 have "step s (V th cs)" . |
|
1106 thus ?thesis |
|
1107 proof(cases) |
|
1108 assume "holding s th cs" |
|
1109 hence th_in: "th \<in> set (wq s cs)" and |
|
1110 eq_hd: "th = hd (wq s cs)" unfolding s_holding_def wq_def by auto |
|
1111 then obtain rest where |
|
1112 eq_wq: "wq s cs = th#rest" |
|
1113 by (cases "wq s cs", auto) |
|
1114 show ?thesis |
|
1115 proof(cases "rest = []") |
|
1116 case False |
|
1117 let ?th' = "hd (SOME q. distinct q \<and> set q = set rest)" |
|
1118 from eq_wq False have eq_D: "?D = {(Cs cs, Th ?th')}" |
|
1119 by (unfold next_th_def, auto) |
|
1120 let ?E = "(?A - ?B - ?C)" |
|
1121 have "(Th ?th', Cs cs) \<notin> ?E\<^sup>*" |
|
1122 proof |
|
1123 assume "(Th ?th', Cs cs) \<in> ?E\<^sup>*" |
|
1124 hence " (Th ?th', Cs cs) \<in> ?E\<^sup>+" by (simp add: rtrancl_eq_or_trancl) |
|
1125 from tranclD [OF this] |
|
1126 obtain x where th'_e: "(Th ?th', x) \<in> ?E" by blast |
|
1127 hence th_d: "(Th ?th', x) \<in> ?A" by simp |
|
1128 from RAG_target_th [OF this] |
|
1129 obtain cs' where eq_x: "x = Cs cs'" by auto |
|
1130 with th_d have "(Th ?th', Cs cs') \<in> ?A" by simp |
|
1131 hence wt_th': "waiting s ?th' cs'" |
|
1132 unfolding s_RAG_def s_waiting_def cs_waiting_def wq_def by simp |
|
1133 hence "cs' = cs" |
|
1134 proof(rule vt_s.waiting_unique) |
|
1135 from eq_wq vt_s.wq_distinct[of cs] |
|
1136 show "waiting s ?th' cs" |
|
1137 apply (unfold s_waiting_def wq_def, auto) |
|
1138 proof - |
|
1139 assume hd_in: "hd (SOME q. distinct q \<and> set q = set rest) \<notin> set rest" |
|
1140 and eq_wq: "wq_fun (schs s) cs = th # rest" |
|
1141 have "(SOME q. distinct q \<and> set q = set rest) \<noteq> []" |
|
1142 proof(rule someI2) |
|
1143 from vt_s.wq_distinct[of cs] and eq_wq |
|
1144 show "distinct rest \<and> set rest = set rest" unfolding wq_def by auto |
|
1145 next |
|
1146 fix x assume "distinct x \<and> set x = set rest" |
|
1147 with False show "x \<noteq> []" by auto |
|
1148 qed |
|
1149 hence "hd (SOME q. distinct q \<and> set q = set rest) \<in> |
|
1150 set (SOME q. distinct q \<and> set q = set rest)" by auto |
|
1151 moreover have "\<dots> = set rest" |
|
1152 proof(rule someI2) |
|
1153 from vt_s.wq_distinct[of cs] and eq_wq |
|
1154 show "distinct rest \<and> set rest = set rest" unfolding wq_def by auto |
|
1155 next |
|
1156 show "\<And>x. distinct x \<and> set x = set rest \<Longrightarrow> set x = set rest" by auto |
|
1157 qed |
|
1158 moreover note hd_in |
|
1159 ultimately show "hd (SOME q. distinct q \<and> set q = set rest) = th" by auto |
|
1160 next |
|
1161 assume hd_in: "hd (SOME q. distinct q \<and> set q = set rest) \<notin> set rest" |
|
1162 and eq_wq: "wq s cs = hd (SOME q. distinct q \<and> set q = set rest) # rest" |
|
1163 have "(SOME q. distinct q \<and> set q = set rest) \<noteq> []" |
|
1164 proof(rule someI2) |
|
1165 from vt_s.wq_distinct[of cs] and eq_wq |
|
1166 show "distinct rest \<and> set rest = set rest" by auto |
|
1167 next |
|
1168 fix x assume "distinct x \<and> set x = set rest" |
|
1169 with False show "x \<noteq> []" by auto |
|
1170 qed |
|
1171 hence "hd (SOME q. distinct q \<and> set q = set rest) \<in> |
|
1172 set (SOME q. distinct q \<and> set q = set rest)" by auto |
|
1173 moreover have "\<dots> = set rest" |
|
1174 proof(rule someI2) |
|
1175 from vt_s.wq_distinct[of cs] and eq_wq |
|
1176 show "distinct rest \<and> set rest = set rest" by auto |
|
1177 next |
|
1178 show "\<And>x. distinct x \<and> set x = set rest \<Longrightarrow> set x = set rest" by auto |
|
1179 qed |
|
1180 moreover note hd_in |
|
1181 ultimately show False by auto |
|
1182 qed |
|
1183 qed |
|
1184 with th'_e eq_x have "(Th ?th', Cs cs) \<in> ?E" by simp |
|
1185 with False |
|
1186 show "False" by (auto simp: next_th_def eq_wq) |
|
1187 qed |
|
1188 with acyclic_insert[symmetric] and ac |
|
1189 and eq_de eq_D show ?thesis by auto |
|
1190 next |
|
1191 case True |
|
1192 with eq_wq |
|
1193 have eq_D: "?D = {}" |
|
1194 by (unfold next_th_def, auto) |
|
1195 with eq_de ac |
|
1196 show ?thesis by auto |
|
1197 qed |
|
1198 qed |
|
1199 next |
|
1200 case (P th cs) |
|
1201 from P vt stp have vtt: "vt (P th cs#s)" by auto |
|
1202 from step_RAG_p [OF this] P |
|
1203 have "RAG (e # s) = |
|
1204 (if wq s cs = [] then RAG s \<union> {(Cs cs, Th th)} else |
|
1205 RAG s \<union> {(Th th, Cs cs)})" (is "?L = ?R") |
|
1206 by simp |
|
1207 moreover have "acyclic ?R" |
|
1208 proof(cases "wq s cs = []") |
|
1209 case True |
|
1210 hence eq_r: "?R = RAG s \<union> {(Cs cs, Th th)}" by simp |
|
1211 have "(Th th, Cs cs) \<notin> (RAG s)\<^sup>*" |
|
1212 proof |
|
1213 assume "(Th th, Cs cs) \<in> (RAG s)\<^sup>*" |
|
1214 hence "(Th th, Cs cs) \<in> (RAG s)\<^sup>+" by (simp add: rtrancl_eq_or_trancl) |
|
1215 from tranclD2 [OF this] |
|
1216 obtain x where "(x, Cs cs) \<in> RAG s" by auto |
|
1217 with True show False by (auto simp:s_RAG_def cs_waiting_def) |
|
1218 qed |
|
1219 with acyclic_insert ih eq_r show ?thesis by auto |
|
1220 next |
|
1221 case False |
|
1222 hence eq_r: "?R = RAG s \<union> {(Th th, Cs cs)}" by simp |
|
1223 have "(Cs cs, Th th) \<notin> (RAG s)\<^sup>*" |
|
1224 proof |
|
1225 assume "(Cs cs, Th th) \<in> (RAG s)\<^sup>*" |
|
1226 hence "(Cs cs, Th th) \<in> (RAG s)\<^sup>+" by (simp add: rtrancl_eq_or_trancl) |
|
1227 moreover from step_back_step [OF vtt] have "step s (P th cs)" . |
|
1228 ultimately show False |
|
1229 proof - |
|
1230 show " \<lbrakk>(Cs cs, Th th) \<in> (RAG s)\<^sup>+; step s (P th cs)\<rbrakk> \<Longrightarrow> False" |
|
1231 by (ind_cases "step s (P th cs)", simp) |
|
1232 qed |
|
1233 qed |
|
1234 with acyclic_insert ih eq_r show ?thesis by auto |
|
1235 qed |
|
1236 ultimately show ?thesis by simp |
|
1237 next |
|
1238 case (Set thread prio) |
|
1239 with ih |
|
1240 thm RAG_set_unchanged |
|
1241 show ?thesis by (simp add:RAG_set_unchanged) |
|
1242 qed |
|
1243 next |
|
1244 case vt_nil |
|
1245 show "acyclic (RAG ([]::state))" |
|
1246 by (auto simp: s_RAG_def cs_waiting_def |
|
1247 cs_holding_def wq_def acyclic_def) |
|
1248 qed |
|
1249 |
|
1250 |
|
1251 lemma finite_RAG: |
|
1252 shows "finite (RAG s)" |
|
1253 proof - |
|
1254 from vt show ?thesis |
|
1255 proof(induct) |
|
1256 case (vt_cons s e) |
|
1257 interpret vt_s: valid_trace s using vt_cons(1) |
|
1258 by (unfold_locales, simp) |
|
1259 assume ih: "finite (RAG s)" |
|
1260 and stp: "step s e" |
|
1261 and vt: "vt s" |
|
1262 show ?case |
|
1263 proof(cases e) |
|
1264 case (Create th prio) |
|
1265 with ih |
|
1266 show ?thesis by (simp add:RAG_create_unchanged) |
|
1267 next |
|
1268 case (Exit th) |
|
1269 with ih show ?thesis by (simp add:RAG_exit_unchanged) |
|
1270 next |
|
1271 case (V th cs) |
|
1272 from V vt stp have vtt: "vt (V th cs#s)" by auto |
|
1273 from step_RAG_v [OF this] |
|
1274 have eq_de: "RAG (e # s) = |
|
1275 RAG s - {(Cs cs, Th th)} - {(Th th', Cs cs) |th'. next_th s th cs th'} \<union> |
|
1276 {(Cs cs, Th th') |th'. next_th s th cs th'} |
|
1277 " |
|
1278 (is "?L = (?A - ?B - ?C) \<union> ?D") by (simp add:V) |
|
1279 moreover from ih have ac: "finite (?A - ?B - ?C)" by simp |
|
1280 moreover have "finite ?D" |
|
1281 proof - |
|
1282 have "?D = {} \<or> (\<exists> a. ?D = {a})" |
|
1283 by (unfold next_th_def, auto) |
|
1284 thus ?thesis |
|
1285 proof |
|
1286 assume h: "?D = {}" |
|
1287 show ?thesis by (unfold h, simp) |
|
1288 next |
|
1289 assume "\<exists> a. ?D = {a}" |
|
1290 thus ?thesis |
|
1291 by (metis finite.simps) |
|
1292 qed |
|
1293 qed |
|
1294 ultimately show ?thesis by simp |
|
1295 next |
|
1296 case (P th cs) |
|
1297 from P vt stp have vtt: "vt (P th cs#s)" by auto |
|
1298 from step_RAG_p [OF this] P |
|
1299 have "RAG (e # s) = |
|
1300 (if wq s cs = [] then RAG s \<union> {(Cs cs, Th th)} else |
|
1301 RAG s \<union> {(Th th, Cs cs)})" (is "?L = ?R") |
|
1302 by simp |
|
1303 moreover have "finite ?R" |
|
1304 proof(cases "wq s cs = []") |
|
1305 case True |
|
1306 hence eq_r: "?R = RAG s \<union> {(Cs cs, Th th)}" by simp |
|
1307 with True and ih show ?thesis by auto |
|
1308 next |
|
1309 case False |
|
1310 hence "?R = RAG s \<union> {(Th th, Cs cs)}" by simp |
|
1311 with False and ih show ?thesis by auto |
|
1312 qed |
|
1313 ultimately show ?thesis by auto |
|
1314 next |
|
1315 case (Set thread prio) |
|
1316 with ih |
|
1317 show ?thesis by (simp add:RAG_set_unchanged) |
|
1318 qed |
|
1319 next |
|
1320 case vt_nil |
|
1321 show "finite (RAG ([]::state))" |
|
1322 by (auto simp: s_RAG_def cs_waiting_def |
|
1323 cs_holding_def wq_def acyclic_def) |
|
1324 qed |
|
1325 qed |
|
1326 |
|
1327 text {* Several useful lemmas *} |
|
1328 |
|
1329 lemma wf_dep_converse: |
|
1330 shows "wf ((RAG s)^-1)" |
|
1331 proof(rule finite_acyclic_wf_converse) |
|
1332 from finite_RAG |
|
1333 show "finite (RAG s)" . |
|
1334 next |
|
1335 from acyclic_RAG |
|
1336 show "acyclic (RAG s)" . |
|
1337 qed |
|
1338 |
|
1339 end |
|
1340 |
|
1341 lemma hd_np_in: "x \<in> set l \<Longrightarrow> hd l \<in> set l" |
|
1342 by (induct l, auto) |
|
1343 |
|
1344 lemma th_chasing: "(Th th, Cs cs) \<in> RAG (s::state) \<Longrightarrow> \<exists> th'. (Cs cs, Th th') \<in> RAG s" |
|
1345 by (auto simp:s_RAG_def s_holding_def cs_holding_def cs_waiting_def wq_def dest:hd_np_in) |
|
1346 |
|
1347 context valid_trace |
|
1348 begin |
|
1349 |
|
1350 lemma wq_threads: |
|
1351 assumes h: "th \<in> set (wq s cs)" |
|
1352 shows "th \<in> threads s" |
|
1353 proof - |
|
1354 from vt and h show ?thesis |
|
1355 proof(induct arbitrary: th cs) |
|
1356 case (vt_cons s e) |
|
1357 interpret vt_s: valid_trace s |
|
1358 using vt_cons(1) by (unfold_locales, auto) |
|
1359 assume ih: "\<And>th cs. th \<in> set (wq s cs) \<Longrightarrow> th \<in> threads s" |
|
1360 and stp: "step s e" |
|
1361 and vt: "vt s" |
|
1362 and h: "th \<in> set (wq (e # s) cs)" |
|
1363 show ?case |
|
1364 proof(cases e) |
|
1365 case (Create th' prio) |
|
1366 with ih h show ?thesis |
|
1367 by (auto simp:wq_def Let_def) |
|
1368 next |
|
1369 case (Exit th') |
|
1370 with stp ih h show ?thesis |
|
1371 apply (auto simp:wq_def Let_def) |
|
1372 apply (ind_cases "step s (Exit th')") |
|
1373 apply (auto simp:runing_def readys_def s_holding_def s_waiting_def holdents_def |
|
1374 s_RAG_def s_holding_def cs_holding_def) |
|
1375 done |
|
1376 next |
|
1377 case (V th' cs') |
|
1378 show ?thesis |
|
1379 proof(cases "cs' = cs") |
|
1380 case False |
|
1381 with h |
|
1382 show ?thesis |
|
1383 apply(unfold wq_def V, auto simp:Let_def V split:prod.splits, fold wq_def) |
|
1384 by (drule_tac ih, simp) |
|
1385 next |
|
1386 case True |
|
1387 from h |
|
1388 show ?thesis |
|
1389 proof(unfold V wq_def) |
|
1390 assume th_in: "th \<in> set (wq_fun (schs (V th' cs' # s)) cs)" (is "th \<in> set ?l") |
|
1391 show "th \<in> threads (V th' cs' # s)" |
|
1392 proof(cases "cs = cs'") |
|
1393 case False |
|
1394 hence "?l = wq_fun (schs s) cs" by (simp add:Let_def) |
|
1395 with th_in have " th \<in> set (wq s cs)" |
|
1396 by (fold wq_def, simp) |
|
1397 from ih [OF this] show ?thesis by simp |
|
1398 next |
|
1399 case True |
|
1400 show ?thesis |
|
1401 proof(cases "wq_fun (schs s) cs'") |
|
1402 case Nil |
|
1403 with h V show ?thesis |
|
1404 apply (auto simp:wq_def Let_def split:if_splits) |
|
1405 by (fold wq_def, drule_tac ih, simp) |
|
1406 next |
|
1407 case (Cons a rest) |
|
1408 assume eq_wq: "wq_fun (schs s) cs' = a # rest" |
|
1409 with h V show ?thesis |
|
1410 apply (auto simp:Let_def wq_def split:if_splits) |
|
1411 proof - |
|
1412 assume th_in: "th \<in> set (SOME q. distinct q \<and> set q = set rest)" |
|
1413 have "set (SOME q. distinct q \<and> set q = set rest) = set rest" |
|
1414 proof(rule someI2) |
|
1415 from vt_s.wq_distinct[of cs'] and eq_wq[folded wq_def] |
|
1416 show "distinct rest \<and> set rest = set rest" by auto |
|
1417 next |
|
1418 show "\<And>x. distinct x \<and> set x = set rest \<Longrightarrow> set x = set rest" |
|
1419 by auto |
|
1420 qed |
|
1421 with eq_wq th_in have "th \<in> set (wq_fun (schs s) cs')" by auto |
|
1422 from ih[OF this[folded wq_def]] show "th \<in> threads s" . |
|
1423 next |
|
1424 assume th_in: "th \<in> set (wq_fun (schs s) cs)" |
|
1425 from ih[OF this[folded wq_def]] |
|
1426 show "th \<in> threads s" . |
|
1427 qed |
|
1428 qed |
|
1429 qed |
|
1430 qed |
|
1431 qed |
|
1432 next |
|
1433 case (P th' cs') |
|
1434 from h stp |
|
1435 show ?thesis |
|
1436 apply (unfold P wq_def) |
|
1437 apply (auto simp:Let_def split:if_splits, fold wq_def) |
|
1438 apply (auto intro:ih) |
|
1439 apply(ind_cases "step s (P th' cs')") |
|
1440 by (unfold runing_def readys_def, auto) |
|
1441 next |
|
1442 case (Set thread prio) |
|
1443 with ih h show ?thesis |
|
1444 by (auto simp:wq_def Let_def) |
|
1445 qed |
|
1446 next |
|
1447 case vt_nil |
|
1448 thus ?case by (auto simp:wq_def) |
|
1449 qed |
|
1450 qed |
|
1451 |
|
1452 lemma range_in: "\<lbrakk>(Th th) \<in> Range (RAG (s::state))\<rbrakk> \<Longrightarrow> th \<in> threads s" |
|
1453 apply(unfold s_RAG_def cs_waiting_def cs_holding_def) |
|
1454 by (auto intro:wq_threads) |
|
1455 |
|
1456 lemma readys_v_eq: |
|
1457 assumes neq_th: "th \<noteq> thread" |
|
1458 and eq_wq: "wq s cs = thread#rest" |
|
1459 and not_in: "th \<notin> set rest" |
|
1460 shows "(th \<in> readys (V thread cs#s)) = (th \<in> readys s)" |
|
1461 proof - |
|
1462 from assms show ?thesis |
|
1463 apply (auto simp:readys_def) |
|
1464 apply(simp add:s_waiting_def[folded wq_def]) |
|
1465 apply (erule_tac x = csa in allE) |
|
1466 apply (simp add:s_waiting_def wq_def Let_def split:if_splits) |
|
1467 apply (case_tac "csa = cs", simp) |
|
1468 apply (erule_tac x = cs in allE) |
|
1469 apply(auto simp add: s_waiting_def[folded wq_def] Let_def split: list.splits) |
|
1470 apply(auto simp add: wq_def) |
|
1471 apply (auto simp:s_waiting_def wq_def Let_def split:list.splits) |
|
1472 proof - |
|
1473 assume th_nin: "th \<notin> set rest" |
|
1474 and th_in: "th \<in> set (SOME q. distinct q \<and> set q = set rest)" |
|
1475 and eq_wq: "wq_fun (schs s) cs = thread # rest" |
|
1476 have "set (SOME q. distinct q \<and> set q = set rest) = set rest" |
|
1477 proof(rule someI2) |
|
1478 from wq_distinct[of cs, unfolded wq_def] and eq_wq[unfolded wq_def] |
|
1479 show "distinct rest \<and> set rest = set rest" by auto |
|
1480 next |
|
1481 show "\<And>x. distinct x \<and> set x = set rest \<Longrightarrow> set x = set rest" by auto |
|
1482 qed |
|
1483 with th_nin th_in show False by auto |
|
1484 qed |
|
1485 qed |
|
1486 |
|
1487 text {* \noindent |
|
1488 The following lemmas shows that: starting from any node in @{text "RAG"}, |
|
1489 by chasing out-going edges, it is always possible to reach a node representing a ready |
|
1490 thread. In this lemma, it is the @{text "th'"}. |
|
1491 *} |
|
1492 |
|
1493 lemma chain_building: |
|
1494 shows "node \<in> Domain (RAG s) \<longrightarrow> (\<exists> th'. th' \<in> readys s \<and> (node, Th th') \<in> (RAG s)^+)" |
|
1495 proof - |
|
1496 from wf_dep_converse |
|
1497 have h: "wf ((RAG s)\<inverse>)" . |
|
1498 show ?thesis |
|
1499 proof(induct rule:wf_induct [OF h]) |
|
1500 fix x |
|
1501 assume ih [rule_format]: |
|
1502 "\<forall>y. (y, x) \<in> (RAG s)\<inverse> \<longrightarrow> |
|
1503 y \<in> Domain (RAG s) \<longrightarrow> (\<exists>th'. th' \<in> readys s \<and> (y, Th th') \<in> (RAG s)\<^sup>+)" |
|
1504 show "x \<in> Domain (RAG s) \<longrightarrow> (\<exists>th'. th' \<in> readys s \<and> (x, Th th') \<in> (RAG s)\<^sup>+)" |
|
1505 proof |
|
1506 assume x_d: "x \<in> Domain (RAG s)" |
|
1507 show "\<exists>th'. th' \<in> readys s \<and> (x, Th th') \<in> (RAG s)\<^sup>+" |
|
1508 proof(cases x) |
|
1509 case (Th th) |
|
1510 from x_d Th obtain cs where x_in: "(Th th, Cs cs) \<in> RAG s" by (auto simp:s_RAG_def) |
|
1511 with Th have x_in_r: "(Cs cs, x) \<in> (RAG s)^-1" by simp |
|
1512 from th_chasing [OF x_in] obtain th' where "(Cs cs, Th th') \<in> RAG s" by blast |
|
1513 hence "Cs cs \<in> Domain (RAG s)" by auto |
|
1514 from ih [OF x_in_r this] obtain th' |
|
1515 where th'_ready: " th' \<in> readys s" and cs_in: "(Cs cs, Th th') \<in> (RAG s)\<^sup>+" by auto |
|
1516 have "(x, Th th') \<in> (RAG s)\<^sup>+" using Th x_in cs_in by auto |
|
1517 with th'_ready show ?thesis by auto |
|
1518 next |
|
1519 case (Cs cs) |
|
1520 from x_d Cs obtain th' where th'_d: "(Th th', x) \<in> (RAG s)^-1" by (auto simp:s_RAG_def) |
|
1521 show ?thesis |
|
1522 proof(cases "th' \<in> readys s") |
|
1523 case True |
|
1524 from True and th'_d show ?thesis by auto |
|
1525 next |
|
1526 case False |
|
1527 from th'_d and range_in have "th' \<in> threads s" by auto |
|
1528 with False have "Th th' \<in> Domain (RAG s)" |
|
1529 by (auto simp:readys_def wq_def s_waiting_def s_RAG_def cs_waiting_def Domain_def) |
|
1530 from ih [OF th'_d this] |
|
1531 obtain th'' where |
|
1532 th''_r: "th'' \<in> readys s" and |
|
1533 th''_in: "(Th th', Th th'') \<in> (RAG s)\<^sup>+" by auto |
|
1534 from th'_d and th''_in |
|
1535 have "(x, Th th'') \<in> (RAG s)\<^sup>+" by auto |
|
1536 with th''_r show ?thesis by auto |
|
1537 qed |
|
1538 qed |
|
1539 qed |
|
1540 qed |
|
1541 qed |
|
1542 |
|
1543 text {* \noindent |
|
1544 The following is just an instance of @{text "chain_building"}. |
|
1545 *} |
|
1546 lemma th_chain_to_ready: |
|
1547 assumes th_in: "th \<in> threads s" |
|
1548 shows "th \<in> readys s \<or> (\<exists> th'. th' \<in> readys s \<and> (Th th, Th th') \<in> (RAG s)^+)" |
|
1549 proof(cases "th \<in> readys s") |
|
1550 case True |
|
1551 thus ?thesis by auto |
|
1552 next |
|
1553 case False |
|
1554 from False and th_in have "Th th \<in> Domain (RAG s)" |
|
1555 by (auto simp:readys_def s_waiting_def s_RAG_def wq_def cs_waiting_def Domain_def) |
|
1556 from chain_building [rule_format, OF this] |
|
1557 show ?thesis by auto |
|
1558 qed |
|
1559 |
|
1560 end |
|
1561 |
|
1562 lemma waiting_eq: "waiting s th cs = waiting (wq s) th cs" |
|
1563 by (unfold s_waiting_def cs_waiting_def wq_def, auto) |
|
1564 |
|
1565 lemma holding_eq: "holding (s::state) th cs = holding (wq s) th cs" |
|
1566 by (unfold s_holding_def wq_def cs_holding_def, simp) |
|
1567 |
|
1568 lemma holding_unique: "\<lbrakk>holding (s::state) th1 cs; holding s th2 cs\<rbrakk> \<Longrightarrow> th1 = th2" |
|
1569 by (unfold s_holding_def cs_holding_def, auto) |
|
1570 |
|
1571 context valid_trace |
|
1572 begin |
|
1573 |
|
1574 lemma unique_RAG: "\<lbrakk>(n, n1) \<in> RAG s; (n, n2) \<in> RAG s\<rbrakk> \<Longrightarrow> n1 = n2" |
|
1575 apply(unfold s_RAG_def, auto, fold waiting_eq holding_eq) |
|
1576 by(auto elim:waiting_unique holding_unique) |
|
1577 |
|
1578 end |
|
1579 |
|
1580 |
|
1581 lemma trancl_split: "(a, b) \<in> r^+ \<Longrightarrow> \<exists> c. (a, c) \<in> r" |
|
1582 by (induct rule:trancl_induct, auto) |
|
1583 |
|
1584 context valid_trace |
|
1585 begin |
|
1586 |
|
1587 lemma dchain_unique: |
|
1588 assumes th1_d: "(n, Th th1) \<in> (RAG s)^+" |
|
1589 and th1_r: "th1 \<in> readys s" |
|
1590 and th2_d: "(n, Th th2) \<in> (RAG s)^+" |
|
1591 and th2_r: "th2 \<in> readys s" |
|
1592 shows "th1 = th2" |
|
1593 proof - |
|
1594 { assume neq: "th1 \<noteq> th2" |
|
1595 hence "Th th1 \<noteq> Th th2" by simp |
|
1596 from unique_chain [OF _ th1_d th2_d this] and unique_RAG |
|
1597 have "(Th th1, Th th2) \<in> (RAG s)\<^sup>+ \<or> (Th th2, Th th1) \<in> (RAG s)\<^sup>+" by auto |
|
1598 hence "False" |
|
1599 proof |
|
1600 assume "(Th th1, Th th2) \<in> (RAG s)\<^sup>+" |
|
1601 from trancl_split [OF this] |
|
1602 obtain n where dd: "(Th th1, n) \<in> RAG s" by auto |
|
1603 then obtain cs where eq_n: "n = Cs cs" |
|
1604 by (auto simp:s_RAG_def s_holding_def cs_holding_def cs_waiting_def wq_def dest:hd_np_in) |
|
1605 from dd eq_n have "th1 \<notin> readys s" |
|
1606 by (auto simp:readys_def s_RAG_def wq_def s_waiting_def cs_waiting_def) |
|
1607 with th1_r show ?thesis by auto |
|
1608 next |
|
1609 assume "(Th th2, Th th1) \<in> (RAG s)\<^sup>+" |
|
1610 from trancl_split [OF this] |
|
1611 obtain n where dd: "(Th th2, n) \<in> RAG s" by auto |
|
1612 then obtain cs where eq_n: "n = Cs cs" |
|
1613 by (auto simp:s_RAG_def s_holding_def cs_holding_def cs_waiting_def wq_def dest:hd_np_in) |
|
1614 from dd eq_n have "th2 \<notin> readys s" |
|
1615 by (auto simp:readys_def wq_def s_RAG_def s_waiting_def cs_waiting_def) |
|
1616 with th2_r show ?thesis by auto |
|
1617 qed |
|
1618 } thus ?thesis by auto |
|
1619 qed |
|
1620 |
|
1621 end |
|
1622 |
|
1623 |
|
1624 lemma step_holdents_p_add: |
|
1625 assumes vt: "vt (P th cs#s)" |
|
1626 and "wq s cs = []" |
|
1627 shows "holdents (P th cs#s) th = holdents s th \<union> {cs}" |
|
1628 proof - |
|
1629 from assms show ?thesis |
|
1630 unfolding holdents_test step_RAG_p[OF vt] by (auto) |
|
1631 qed |
|
1632 |
|
1633 lemma step_holdents_p_eq: |
|
1634 assumes vt: "vt (P th cs#s)" |
|
1635 and "wq s cs \<noteq> []" |
|
1636 shows "holdents (P th cs#s) th = holdents s th" |
|
1637 proof - |
|
1638 from assms show ?thesis |
|
1639 unfolding holdents_test step_RAG_p[OF vt] by auto |
|
1640 qed |
|
1641 |
|
1642 |
|
1643 lemma (in valid_trace) finite_holding : |
|
1644 shows "finite (holdents s th)" |
|
1645 proof - |
|
1646 let ?F = "\<lambda> (x, y). the_cs x" |
|
1647 from finite_RAG |
|
1648 have "finite (RAG s)" . |
|
1649 hence "finite (?F `(RAG s))" by simp |
|
1650 moreover have "{cs . (Cs cs, Th th) \<in> RAG s} \<subseteq> \<dots>" |
|
1651 proof - |
|
1652 { have h: "\<And> a A f. a \<in> A \<Longrightarrow> f a \<in> f ` A" by auto |
|
1653 fix x assume "(Cs x, Th th) \<in> RAG s" |
|
1654 hence "?F (Cs x, Th th) \<in> ?F `(RAG s)" by (rule h) |
|
1655 moreover have "?F (Cs x, Th th) = x" by simp |
|
1656 ultimately have "x \<in> (\<lambda>(x, y). the_cs x) ` RAG s" by simp |
|
1657 } thus ?thesis by auto |
|
1658 qed |
|
1659 ultimately show ?thesis by (unfold holdents_test, auto intro:finite_subset) |
|
1660 qed |
|
1661 |
|
1662 lemma cntCS_v_dec: |
|
1663 assumes vtv: "vt (V thread cs#s)" |
|
1664 shows "(cntCS (V thread cs#s) thread + 1) = cntCS s thread" |
|
1665 proof - |
|
1666 from vtv interpret vt_s: valid_trace s |
|
1667 by (cases, unfold_locales, simp) |
|
1668 from vtv interpret vt_v: valid_trace "V thread cs#s" |
|
1669 by (unfold_locales, simp) |
|
1670 from step_back_step[OF vtv] |
|
1671 have cs_in: "cs \<in> holdents s thread" |
|
1672 apply (cases, unfold holdents_test s_RAG_def, simp) |
|
1673 by (unfold cs_holding_def s_holding_def wq_def, auto) |
|
1674 moreover have cs_not_in: |
|
1675 "(holdents (V thread cs#s) thread) = holdents s thread - {cs}" |
|
1676 apply (insert vt_s.wq_distinct[of cs]) |
|
1677 apply (unfold holdents_test, unfold step_RAG_v[OF vtv], |
|
1678 auto simp:next_th_def) |
|
1679 proof - |
|
1680 fix rest |
|
1681 assume dst: "distinct (rest::thread list)" |
|
1682 and ne: "rest \<noteq> []" |
|
1683 and hd_ni: "hd (SOME q. distinct q \<and> set q = set rest) \<notin> set rest" |
|
1684 moreover have "set (SOME q. distinct q \<and> set q = set rest) = set rest" |
|
1685 proof(rule someI2) |
|
1686 from dst show "distinct rest \<and> set rest = set rest" by auto |
|
1687 next |
|
1688 show "\<And>x. distinct x \<and> set x = set rest \<Longrightarrow> set x = set rest" by auto |
|
1689 qed |
|
1690 ultimately have "hd (SOME q. distinct q \<and> set q = set rest) \<notin> |
|
1691 set (SOME q. distinct q \<and> set q = set rest)" by simp |
|
1692 moreover have "(SOME q. distinct q \<and> set q = set rest) \<noteq> []" |
|
1693 proof(rule someI2) |
|
1694 from dst show "distinct rest \<and> set rest = set rest" by auto |
|
1695 next |
|
1696 fix x assume " distinct x \<and> set x = set rest" with ne |
|
1697 show "x \<noteq> []" by auto |
|
1698 qed |
|
1699 ultimately |
|
1700 show "(Cs cs, Th (hd (SOME q. distinct q \<and> set q = set rest))) \<in> RAG s" |
|
1701 by auto |
|
1702 next |
|
1703 fix rest |
|
1704 assume dst: "distinct (rest::thread list)" |
|
1705 and ne: "rest \<noteq> []" |
|
1706 and hd_ni: "hd (SOME q. distinct q \<and> set q = set rest) \<notin> set rest" |
|
1707 moreover have "set (SOME q. distinct q \<and> set q = set rest) = set rest" |
|
1708 proof(rule someI2) |
|
1709 from dst show "distinct rest \<and> set rest = set rest" by auto |
|
1710 next |
|
1711 show "\<And>x. distinct x \<and> set x = set rest \<Longrightarrow> set x = set rest" by auto |
|
1712 qed |
|
1713 ultimately have "hd (SOME q. distinct q \<and> set q = set rest) \<notin> |
|
1714 set (SOME q. distinct q \<and> set q = set rest)" by simp |
|
1715 moreover have "(SOME q. distinct q \<and> set q = set rest) \<noteq> []" |
|
1716 proof(rule someI2) |
|
1717 from dst show "distinct rest \<and> set rest = set rest" by auto |
|
1718 next |
|
1719 fix x assume " distinct x \<and> set x = set rest" with ne |
|
1720 show "x \<noteq> []" by auto |
|
1721 qed |
|
1722 ultimately show "False" by auto |
|
1723 qed |
|
1724 ultimately |
|
1725 have "holdents s thread = insert cs (holdents (V thread cs#s) thread)" |
|
1726 by auto |
|
1727 moreover have "card \<dots> = |
|
1728 Suc (card ((holdents (V thread cs#s) thread) - {cs}))" |
|
1729 proof(rule card_insert) |
|
1730 from vt_v.finite_holding |
|
1731 show " finite (holdents (V thread cs # s) thread)" . |
|
1732 qed |
|
1733 moreover from cs_not_in |
|
1734 have "cs \<notin> (holdents (V thread cs#s) thread)" by auto |
|
1735 ultimately show ?thesis by (simp add:cntCS_def) |
|
1736 qed |
|
1737 |
|
1738 lemma count_rec1 [simp]: |
|
1739 assumes "Q e" |
|
1740 shows "count Q (e#es) = Suc (count Q es)" |
|
1741 using assms |
|
1742 by (unfold count_def, auto) |
|
1743 |
|
1744 lemma count_rec2 [simp]: |
|
1745 assumes "\<not>Q e" |
|
1746 shows "count Q (e#es) = (count Q es)" |
|
1747 using assms |
|
1748 by (unfold count_def, auto) |
|
1749 |
|
1750 lemma count_rec3 [simp]: |
|
1751 shows "count Q [] = 0" |
|
1752 by (unfold count_def, auto) |
|
1753 |
|
1754 lemma cntP_diff_inv: |
|
1755 assumes "cntP (e#s) th \<noteq> cntP s th" |
|
1756 shows "isP e \<and> actor e = th" |
|
1757 proof(cases e) |
|
1758 case (P th' pty) |
|
1759 show ?thesis |
|
1760 by (cases "(\<lambda>e. \<exists>cs. e = P th cs) (P th' pty)", |
|
1761 insert assms P, auto simp:cntP_def) |
|
1762 qed (insert assms, auto simp:cntP_def) |
|
1763 |
|
1764 lemma cntV_diff_inv: |
|
1765 assumes "cntV (e#s) th \<noteq> cntV s th" |
|
1766 shows "isV e \<and> actor e = th" |
|
1767 proof(cases e) |
|
1768 case (V th' pty) |
|
1769 show ?thesis |
|
1770 by (cases "(\<lambda>e. \<exists>cs. e = V th cs) (V th' pty)", |
|
1771 insert assms V, auto simp:cntV_def) |
|
1772 qed (insert assms, auto simp:cntV_def) |
|
1773 |
|
1774 context valid_trace |
|
1775 begin |
|
1776 |
|
1777 text {* (* ddd *) \noindent |
|
1778 The relationship between @{text "cntP"}, @{text "cntV"} and @{text "cntCS"} |
|
1779 of one particular thread. |
|
1780 *} |
|
1781 |
|
1782 lemma cnp_cnv_cncs: |
|
1783 shows "cntP s th = cntV s th + (if (th \<in> readys s \<or> th \<notin> threads s) |
|
1784 then cntCS s th else cntCS s th + 1)" |
|
1785 proof - |
|
1786 from vt show ?thesis |
|
1787 proof(induct arbitrary:th) |
|
1788 case (vt_cons s e) |
|
1789 interpret vt_s: valid_trace s using vt_cons(1) by (unfold_locales, simp) |
|
1790 assume vt: "vt s" |
|
1791 and ih: "\<And>th. cntP s th = cntV s th + |
|
1792 (if (th \<in> readys s \<or> th \<notin> threads s) then cntCS s th else cntCS s th + 1)" |
|
1793 and stp: "step s e" |
|
1794 from stp show ?case |
|
1795 proof(cases) |
|
1796 case (thread_create thread prio) |
|
1797 assume eq_e: "e = Create thread prio" |
|
1798 and not_in: "thread \<notin> threads s" |
|
1799 show ?thesis |
|
1800 proof - |
|
1801 { fix cs |
|
1802 assume "thread \<in> set (wq s cs)" |
|
1803 from vt_s.wq_threads [OF this] have "thread \<in> threads s" . |
|
1804 with not_in have "False" by simp |
|
1805 } with eq_e have eq_readys: "readys (e#s) = readys s \<union> {thread}" |
|
1806 by (auto simp:readys_def threads.simps s_waiting_def |
|
1807 wq_def cs_waiting_def Let_def) |
|
1808 from eq_e have eq_cnp: "cntP (e#s) th = cntP s th" by (simp add:cntP_def count_def) |
|
1809 from eq_e have eq_cnv: "cntV (e#s) th = cntV s th" by (simp add:cntV_def count_def) |
|
1810 have eq_cncs: "cntCS (e#s) th = cntCS s th" |
|
1811 unfolding cntCS_def holdents_test |
|
1812 by (simp add:RAG_create_unchanged eq_e) |
|
1813 { assume "th \<noteq> thread" |
|
1814 with eq_readys eq_e |
|
1815 have "(th \<in> readys (e # s) \<or> th \<notin> threads (e # s)) = |
|
1816 (th \<in> readys (s) \<or> th \<notin> threads (s))" |
|
1817 by (simp add:threads.simps) |
|
1818 with eq_cnp eq_cnv eq_cncs ih not_in |
|
1819 have ?thesis by simp |
|
1820 } moreover { |
|
1821 assume eq_th: "th = thread" |
|
1822 with not_in ih have " cntP s th = cntV s th + cntCS s th" by simp |
|
1823 moreover from eq_th and eq_readys have "th \<in> readys (e#s)" by simp |
|
1824 moreover note eq_cnp eq_cnv eq_cncs |
|
1825 ultimately have ?thesis by auto |
|
1826 } ultimately show ?thesis by blast |
|
1827 qed |
|
1828 next |
|
1829 case (thread_exit thread) |
|
1830 assume eq_e: "e = Exit thread" |
|
1831 and is_runing: "thread \<in> runing s" |
|
1832 and no_hold: "holdents s thread = {}" |
|
1833 from eq_e have eq_cnp: "cntP (e#s) th = cntP s th" by (simp add:cntP_def count_def) |
|
1834 from eq_e have eq_cnv: "cntV (e#s) th = cntV s th" by (simp add:cntV_def count_def) |
|
1835 have eq_cncs: "cntCS (e#s) th = cntCS s th" |
|
1836 unfolding cntCS_def holdents_test |
|
1837 by (simp add:RAG_exit_unchanged eq_e) |
|
1838 { assume "th \<noteq> thread" |
|
1839 with eq_e |
|
1840 have "(th \<in> readys (e # s) \<or> th \<notin> threads (e # s)) = |
|
1841 (th \<in> readys (s) \<or> th \<notin> threads (s))" |
|
1842 apply (simp add:threads.simps readys_def) |
|
1843 apply (subst s_waiting_def) |
|
1844 apply (simp add:Let_def) |
|
1845 apply (subst s_waiting_def, simp) |
|
1846 done |
|
1847 with eq_cnp eq_cnv eq_cncs ih |
|
1848 have ?thesis by simp |
|
1849 } moreover { |
|
1850 assume eq_th: "th = thread" |
|
1851 with ih is_runing have " cntP s th = cntV s th + cntCS s th" |
|
1852 by (simp add:runing_def) |
|
1853 moreover from eq_th eq_e have "th \<notin> threads (e#s)" |
|
1854 by simp |
|
1855 moreover note eq_cnp eq_cnv eq_cncs |
|
1856 ultimately have ?thesis by auto |
|
1857 } ultimately show ?thesis by blast |
|
1858 next |
|
1859 case (thread_P thread cs) |
|
1860 assume eq_e: "e = P thread cs" |
|
1861 and is_runing: "thread \<in> runing s" |
|
1862 and no_dep: "(Cs cs, Th thread) \<notin> (RAG s)\<^sup>+" |
|
1863 from thread_P vt stp ih have vtp: "vt (P thread cs#s)" by auto |
|
1864 then interpret vt_p: valid_trace "(P thread cs#s)" |
|
1865 by (unfold_locales, simp) |
|
1866 show ?thesis |
|
1867 proof - |
|
1868 { have hh: "\<And> A B C. (B = C) \<Longrightarrow> (A \<and> B) = (A \<and> C)" by blast |
|
1869 assume neq_th: "th \<noteq> thread" |
|
1870 with eq_e |
|
1871 have eq_readys: "(th \<in> readys (e#s)) = (th \<in> readys (s))" |
|
1872 apply (simp add:readys_def s_waiting_def wq_def Let_def) |
|
1873 apply (rule_tac hh) |
|
1874 apply (intro iffI allI, clarify) |
|
1875 apply (erule_tac x = csa in allE, auto) |
|
1876 apply (subgoal_tac "wq_fun (schs s) cs \<noteq> []", auto) |
|
1877 apply (erule_tac x = cs in allE, auto) |
|
1878 by (case_tac "(wq_fun (schs s) cs)", auto) |
|
1879 moreover from neq_th eq_e have "cntCS (e # s) th = cntCS s th" |
|
1880 apply (simp add:cntCS_def holdents_test) |
|
1881 by (unfold step_RAG_p [OF vtp], auto) |
|
1882 moreover from eq_e neq_th have "cntP (e # s) th = cntP s th" |
|
1883 by (simp add:cntP_def count_def) |
|
1884 moreover from eq_e neq_th have "cntV (e#s) th = cntV s th" |
|
1885 by (simp add:cntV_def count_def) |
|
1886 moreover from eq_e neq_th have "threads (e#s) = threads s" by simp |
|
1887 moreover note ih [of th] |
|
1888 ultimately have ?thesis by simp |
|
1889 } moreover { |
|
1890 assume eq_th: "th = thread" |
|
1891 have ?thesis |
|
1892 proof - |
|
1893 from eq_e eq_th have eq_cnp: "cntP (e # s) th = 1 + (cntP s th)" |
|
1894 by (simp add:cntP_def count_def) |
|
1895 from eq_e eq_th have eq_cnv: "cntV (e#s) th = cntV s th" |
|
1896 by (simp add:cntV_def count_def) |
|
1897 show ?thesis |
|
1898 proof (cases "wq s cs = []") |
|
1899 case True |
|
1900 with is_runing |
|
1901 have "th \<in> readys (e#s)" |
|
1902 apply (unfold eq_e wq_def, unfold readys_def s_RAG_def) |
|
1903 apply (simp add: wq_def[symmetric] runing_def eq_th s_waiting_def) |
|
1904 by (auto simp:readys_def wq_def Let_def s_waiting_def wq_def) |
|
1905 moreover have "cntCS (e # s) th = 1 + cntCS s th" |
|
1906 proof - |
|
1907 have "card {csa. csa = cs \<or> (Cs csa, Th thread) \<in> RAG s} = |
|
1908 Suc (card {cs. (Cs cs, Th thread) \<in> RAG s})" (is "card ?L = Suc (card ?R)") |
|
1909 proof - |
|
1910 have "?L = insert cs ?R" by auto |
|
1911 moreover have "card \<dots> = Suc (card (?R - {cs}))" |
|
1912 proof(rule card_insert) |
|
1913 from vt_s.finite_holding [of thread] |
|
1914 show " finite {cs. (Cs cs, Th thread) \<in> RAG s}" |
|
1915 by (unfold holdents_test, simp) |
|
1916 qed |
|
1917 moreover have "?R - {cs} = ?R" |
|
1918 proof - |
|
1919 have "cs \<notin> ?R" |
|
1920 proof |
|
1921 assume "cs \<in> {cs. (Cs cs, Th thread) \<in> RAG s}" |
|
1922 with no_dep show False by auto |
|
1923 qed |
|
1924 thus ?thesis by auto |
|
1925 qed |
|
1926 ultimately show ?thesis by auto |
|
1927 qed |
|
1928 thus ?thesis |
|
1929 apply (unfold eq_e eq_th cntCS_def) |
|
1930 apply (simp add: holdents_test) |
|
1931 by (unfold step_RAG_p [OF vtp], auto simp:True) |
|
1932 qed |
|
1933 moreover from is_runing have "th \<in> readys s" |
|
1934 by (simp add:runing_def eq_th) |
|
1935 moreover note eq_cnp eq_cnv ih [of th] |
|
1936 ultimately show ?thesis by auto |
|
1937 next |
|
1938 case False |
|
1939 have eq_wq: "wq (e#s) cs = wq s cs @ [th]" |
|
1940 by (unfold eq_th eq_e wq_def, auto simp:Let_def) |
|
1941 have "th \<notin> readys (e#s)" |
|
1942 proof |
|
1943 assume "th \<in> readys (e#s)" |
|
1944 hence "\<forall>cs. \<not> waiting (e # s) th cs" by (simp add:readys_def) |
|
1945 from this[rule_format, of cs] have " \<not> waiting (e # s) th cs" . |
|
1946 hence "th \<in> set (wq (e#s) cs) \<Longrightarrow> th = hd (wq (e#s) cs)" |
|
1947 by (simp add:s_waiting_def wq_def) |
|
1948 moreover from eq_wq have "th \<in> set (wq (e#s) cs)" by auto |
|
1949 ultimately have "th = hd (wq (e#s) cs)" by blast |
|
1950 with eq_wq have "th = hd (wq s cs @ [th])" by simp |
|
1951 hence "th = hd (wq s cs)" using False by auto |
|
1952 with False eq_wq vt_p.wq_distinct [of cs] |
|
1953 show False by (fold eq_e, auto) |
|
1954 qed |
|
1955 moreover from is_runing have "th \<in> threads (e#s)" |
|
1956 by (unfold eq_e, auto simp:runing_def readys_def eq_th) |
|
1957 moreover have "cntCS (e # s) th = cntCS s th" |
|
1958 apply (unfold cntCS_def holdents_test eq_e step_RAG_p[OF vtp]) |
|
1959 by (auto simp:False) |
|
1960 moreover note eq_cnp eq_cnv ih[of th] |
|
1961 moreover from is_runing have "th \<in> readys s" |
|
1962 by (simp add:runing_def eq_th) |
|
1963 ultimately show ?thesis by auto |
|
1964 qed |
|
1965 qed |
|
1966 } ultimately show ?thesis by blast |
|
1967 qed |
|
1968 next |
|
1969 case (thread_V thread cs) |
|
1970 from assms vt stp ih thread_V have vtv: "vt (V thread cs # s)" by auto |
|
1971 then interpret vt_v: valid_trace "(V thread cs # s)" by (unfold_locales, simp) |
|
1972 assume eq_e: "e = V thread cs" |
|
1973 and is_runing: "thread \<in> runing s" |
|
1974 and hold: "holding s thread cs" |
|
1975 from hold obtain rest |
|
1976 where eq_wq: "wq s cs = thread # rest" |
|
1977 by (case_tac "wq s cs", auto simp: wq_def s_holding_def) |
|
1978 have eq_threads: "threads (e#s) = threads s" by (simp add: eq_e) |
|
1979 have eq_set: "set (SOME q. distinct q \<and> set q = set rest) = set rest" |
|
1980 proof(rule someI2) |
|
1981 from vt_v.wq_distinct[of cs] and eq_wq |
|
1982 show "distinct rest \<and> set rest = set rest" |
|
1983 by (metis distinct.simps(2) vt_s.wq_distinct) |
|
1984 next |
|
1985 show "\<And>x. distinct x \<and> set x = set rest \<Longrightarrow> set x = set rest" |
|
1986 by auto |
|
1987 qed |
|
1988 show ?thesis |
|
1989 proof - |
|
1990 { assume eq_th: "th = thread" |
|
1991 from eq_th have eq_cnp: "cntP (e # s) th = cntP s th" |
|
1992 by (unfold eq_e, simp add:cntP_def count_def) |
|
1993 moreover from eq_th have eq_cnv: "cntV (e#s) th = 1 + cntV s th" |
|
1994 by (unfold eq_e, simp add:cntV_def count_def) |
|
1995 moreover from cntCS_v_dec [OF vtv] |
|
1996 have "cntCS (e # s) thread + 1 = cntCS s thread" |
|
1997 by (simp add:eq_e) |
|
1998 moreover from is_runing have rd_before: "thread \<in> readys s" |
|
1999 by (unfold runing_def, simp) |
|
2000 moreover have "thread \<in> readys (e # s)" |
|
2001 proof - |
|
2002 from is_runing |
|
2003 have "thread \<in> threads (e#s)" |
|
2004 by (unfold eq_e, auto simp:runing_def readys_def) |
|
2005 moreover have "\<forall> cs1. \<not> waiting (e#s) thread cs1" |
|
2006 proof |
|
2007 fix cs1 |
|
2008 { assume eq_cs: "cs1 = cs" |
|
2009 have "\<not> waiting (e # s) thread cs1" |
|
2010 proof - |
|
2011 from eq_wq |
|
2012 have "thread \<notin> set (wq (e#s) cs1)" |
|
2013 apply(unfold eq_e wq_def eq_cs s_holding_def) |
|
2014 apply (auto simp:Let_def) |
|
2015 proof - |
|
2016 assume "thread \<in> set (SOME q. distinct q \<and> set q = set rest)" |
|
2017 with eq_set have "thread \<in> set rest" by simp |
|
2018 with vt_v.wq_distinct[of cs] |
|
2019 and eq_wq show False |
|
2020 by (metis distinct.simps(2) vt_s.wq_distinct) |
|
2021 qed |
|
2022 thus ?thesis by (simp add:wq_def s_waiting_def) |
|
2023 qed |
|
2024 } moreover { |
|
2025 assume neq_cs: "cs1 \<noteq> cs" |
|
2026 have "\<not> waiting (e # s) thread cs1" |
|
2027 proof - |
|
2028 from wq_v_neq [OF neq_cs[symmetric]] |
|
2029 have "wq (V thread cs # s) cs1 = wq s cs1" . |
|
2030 moreover have "\<not> waiting s thread cs1" |
|
2031 proof - |
|
2032 from runing_ready and is_runing |
|
2033 have "thread \<in> readys s" by auto |
|
2034 thus ?thesis by (simp add:readys_def) |
|
2035 qed |
|
2036 ultimately show ?thesis |
|
2037 by (auto simp:wq_def s_waiting_def eq_e) |
|
2038 qed |
|
2039 } ultimately show "\<not> waiting (e # s) thread cs1" by blast |
|
2040 qed |
|
2041 ultimately show ?thesis by (simp add:readys_def) |
|
2042 qed |
|
2043 moreover note eq_th ih |
|
2044 ultimately have ?thesis by auto |
|
2045 } moreover { |
|
2046 assume neq_th: "th \<noteq> thread" |
|
2047 from neq_th eq_e have eq_cnp: "cntP (e # s) th = cntP s th" |
|
2048 by (simp add:cntP_def count_def) |
|
2049 from neq_th eq_e have eq_cnv: "cntV (e # s) th = cntV s th" |
|
2050 by (simp add:cntV_def count_def) |
|
2051 have ?thesis |
|
2052 proof(cases "th \<in> set rest") |
|
2053 case False |
|
2054 have "(th \<in> readys (e # s)) = (th \<in> readys s)" |
|
2055 apply (insert step_back_vt[OF vtv]) |
|
2056 by (simp add: False eq_e eq_wq neq_th vt_s.readys_v_eq) |
|
2057 moreover have "cntCS (e#s) th = cntCS s th" |
|
2058 apply (insert neq_th, unfold eq_e cntCS_def holdents_test step_RAG_v[OF vtv], auto) |
|
2059 proof - |
|
2060 have "{csa. (Cs csa, Th th) \<in> RAG s \<or> csa = cs \<and> next_th s thread cs th} = |
|
2061 {cs. (Cs cs, Th th) \<in> RAG s}" |
|
2062 proof - |
|
2063 from False eq_wq |
|
2064 have " next_th s thread cs th \<Longrightarrow> (Cs cs, Th th) \<in> RAG s" |
|
2065 apply (unfold next_th_def, auto) |
|
2066 proof - |
|
2067 assume ne: "rest \<noteq> []" |
|
2068 and ni: "hd (SOME q. distinct q \<and> set q = set rest) \<notin> set rest" |
|
2069 and eq_wq: "wq s cs = thread # rest" |
|
2070 from eq_set ni have "hd (SOME q. distinct q \<and> set q = set rest) \<notin> |
|
2071 set (SOME q. distinct q \<and> set q = set rest) |
|
2072 " by simp |
|
2073 moreover have "(SOME q. distinct q \<and> set q = set rest) \<noteq> []" |
|
2074 proof(rule someI2) |
|
2075 from vt_s.wq_distinct[ of cs] and eq_wq |
|
2076 show "distinct rest \<and> set rest = set rest" by auto |
|
2077 next |
|
2078 fix x assume "distinct x \<and> set x = set rest" |
|
2079 with ne show "x \<noteq> []" by auto |
|
2080 qed |
|
2081 ultimately show |
|
2082 "(Cs cs, Th (hd (SOME q. distinct q \<and> set q = set rest))) \<in> RAG s" |
|
2083 by auto |
|
2084 qed |
|
2085 thus ?thesis by auto |
|
2086 qed |
|
2087 thus "card {csa. (Cs csa, Th th) \<in> RAG s \<or> csa = cs \<and> next_th s thread cs th} = |
|
2088 card {cs. (Cs cs, Th th) \<in> RAG s}" by simp |
|
2089 qed |
|
2090 moreover note ih eq_cnp eq_cnv eq_threads |
|
2091 ultimately show ?thesis by auto |
|
2092 next |
|
2093 case True |
|
2094 assume th_in: "th \<in> set rest" |
|
2095 show ?thesis |
|
2096 proof(cases "next_th s thread cs th") |
|
2097 case False |
|
2098 with eq_wq and th_in have |
|
2099 neq_hd: "th \<noteq> hd (SOME q. distinct q \<and> set q = set rest)" (is "th \<noteq> hd ?rest") |
|
2100 by (auto simp:next_th_def) |
|
2101 have "(th \<in> readys (e # s)) = (th \<in> readys s)" |
|
2102 proof - |
|
2103 from eq_wq and th_in |
|
2104 have "\<not> th \<in> readys s" |
|
2105 apply (auto simp:readys_def s_waiting_def) |
|
2106 apply (rule_tac x = cs in exI, auto) |
|
2107 by (insert vt_s.wq_distinct[of cs], auto simp add: wq_def) |
|
2108 moreover |
|
2109 from eq_wq and th_in and neq_hd |
|
2110 have "\<not> (th \<in> readys (e # s))" |
|
2111 apply (auto simp:readys_def s_waiting_def eq_e wq_def Let_def split:list.splits) |
|
2112 by (rule_tac x = cs in exI, auto simp:eq_set) |
|
2113 ultimately show ?thesis by auto |
|
2114 qed |
|
2115 moreover have "cntCS (e#s) th = cntCS s th" |
|
2116 proof - |
|
2117 from eq_wq and th_in and neq_hd |
|
2118 have "(holdents (e # s) th) = (holdents s th)" |
|
2119 apply (unfold eq_e step_RAG_v[OF vtv], |
|
2120 auto simp:next_th_def eq_set s_RAG_def holdents_test wq_def |
|
2121 Let_def cs_holding_def) |
|
2122 by (insert vt_s.wq_distinct[of cs], auto simp:wq_def) |
|
2123 thus ?thesis by (simp add:cntCS_def) |
|
2124 qed |
|
2125 moreover note ih eq_cnp eq_cnv eq_threads |
|
2126 ultimately show ?thesis by auto |
|
2127 next |
|
2128 case True |
|
2129 let ?rest = " (SOME q. distinct q \<and> set q = set rest)" |
|
2130 let ?t = "hd ?rest" |
|
2131 from True eq_wq th_in neq_th |
|
2132 have "th \<in> readys (e # s)" |
|
2133 apply (auto simp:eq_e readys_def s_waiting_def wq_def |
|
2134 Let_def next_th_def) |
|
2135 proof - |
|
2136 assume eq_wq: "wq_fun (schs s) cs = thread # rest" |
|
2137 and t_in: "?t \<in> set rest" |
|
2138 show "?t \<in> threads s" |
|
2139 proof(rule vt_s.wq_threads) |
|
2140 from eq_wq and t_in |
|
2141 show "?t \<in> set (wq s cs)" by (auto simp:wq_def) |
|
2142 qed |
|
2143 next |
|
2144 fix csa |
|
2145 assume eq_wq: "wq_fun (schs s) cs = thread # rest" |
|
2146 and t_in: "?t \<in> set rest" |
|
2147 and neq_cs: "csa \<noteq> cs" |
|
2148 and t_in': "?t \<in> set (wq_fun (schs s) csa)" |
|
2149 show "?t = hd (wq_fun (schs s) csa)" |
|
2150 proof - |
|
2151 { assume neq_hd': "?t \<noteq> hd (wq_fun (schs s) csa)" |
|
2152 from vt_s.wq_distinct[of cs] and |
|
2153 eq_wq[folded wq_def] and t_in eq_wq |
|
2154 have "?t \<noteq> thread" by auto |
|
2155 with eq_wq and t_in |
|
2156 have w1: "waiting s ?t cs" |
|
2157 by (auto simp:s_waiting_def wq_def) |
|
2158 from t_in' neq_hd' |
|
2159 have w2: "waiting s ?t csa" |
|
2160 by (auto simp:s_waiting_def wq_def) |
|
2161 from vt_s.waiting_unique[OF w1 w2] |
|
2162 and neq_cs have "False" by auto |
|
2163 } thus ?thesis by auto |
|
2164 qed |
|
2165 qed |
|
2166 moreover have "cntP s th = cntV s th + cntCS s th + 1" |
|
2167 proof - |
|
2168 have "th \<notin> readys s" |
|
2169 proof - |
|
2170 from True eq_wq neq_th th_in |
|
2171 show ?thesis |
|
2172 apply (unfold readys_def s_waiting_def, auto) |
|
2173 by (rule_tac x = cs in exI, auto simp add: wq_def) |
|
2174 qed |
|
2175 moreover have "th \<in> threads s" |
|
2176 proof - |
|
2177 from th_in eq_wq |
|
2178 have "th \<in> set (wq s cs)" by simp |
|
2179 from vt_s.wq_threads [OF this] |
|
2180 show ?thesis . |
|
2181 qed |
|
2182 ultimately show ?thesis using ih by auto |
|
2183 qed |
|
2184 moreover from True neq_th have "cntCS (e # s) th = 1 + cntCS s th" |
|
2185 apply (unfold cntCS_def holdents_test eq_e step_RAG_v[OF vtv], auto) |
|
2186 proof - |
|
2187 show "card {csa. (Cs csa, Th th) \<in> RAG s \<or> csa = cs} = |
|
2188 Suc (card {cs. (Cs cs, Th th) \<in> RAG s})" |
|
2189 (is "card ?A = Suc (card ?B)") |
|
2190 proof - |
|
2191 have "?A = insert cs ?B" by auto |
|
2192 hence "card ?A = card (insert cs ?B)" by simp |
|
2193 also have "\<dots> = Suc (card ?B)" |
|
2194 proof(rule card_insert_disjoint) |
|
2195 have "?B \<subseteq> ((\<lambda> (x, y). the_cs x) ` RAG s)" |
|
2196 apply (auto simp:image_def) |
|
2197 by (rule_tac x = "(Cs x, Th th)" in bexI, auto) |
|
2198 with vt_s.finite_RAG |
|
2199 show "finite {cs. (Cs cs, Th th) \<in> RAG s}" by (auto intro:finite_subset) |
|
2200 next |
|
2201 show "cs \<notin> {cs. (Cs cs, Th th) \<in> RAG s}" |
|
2202 proof |
|
2203 assume "cs \<in> {cs. (Cs cs, Th th) \<in> RAG s}" |
|
2204 hence "(Cs cs, Th th) \<in> RAG s" by simp |
|
2205 with True neq_th eq_wq show False |
|
2206 by (auto simp:next_th_def s_RAG_def cs_holding_def) |
|
2207 qed |
|
2208 qed |
|
2209 finally show ?thesis . |
|
2210 qed |
|
2211 qed |
|
2212 moreover note eq_cnp eq_cnv |
|
2213 ultimately show ?thesis by simp |
|
2214 qed |
|
2215 qed |
|
2216 } ultimately show ?thesis by blast |
|
2217 qed |
|
2218 next |
|
2219 case (thread_set thread prio) |
|
2220 assume eq_e: "e = Set thread prio" |
|
2221 and is_runing: "thread \<in> runing s" |
|
2222 show ?thesis |
|
2223 proof - |
|
2224 from eq_e have eq_cnp: "cntP (e#s) th = cntP s th" by (simp add:cntP_def count_def) |
|
2225 from eq_e have eq_cnv: "cntV (e#s) th = cntV s th" by (simp add:cntV_def count_def) |
|
2226 have eq_cncs: "cntCS (e#s) th = cntCS s th" |
|
2227 unfolding cntCS_def holdents_test |
|
2228 by (simp add:RAG_set_unchanged eq_e) |
|
2229 from eq_e have eq_readys: "readys (e#s) = readys s" |
|
2230 by (simp add:readys_def cs_waiting_def s_waiting_def wq_def, |
|
2231 auto simp:Let_def) |
|
2232 { assume "th \<noteq> thread" |
|
2233 with eq_readys eq_e |
|
2234 have "(th \<in> readys (e # s) \<or> th \<notin> threads (e # s)) = |
|
2235 (th \<in> readys (s) \<or> th \<notin> threads (s))" |
|
2236 by (simp add:threads.simps) |
|
2237 with eq_cnp eq_cnv eq_cncs ih is_runing |
|
2238 have ?thesis by simp |
|
2239 } moreover { |
|
2240 assume eq_th: "th = thread" |
|
2241 with is_runing ih have " cntP s th = cntV s th + cntCS s th" |
|
2242 by (unfold runing_def, auto) |
|
2243 moreover from eq_th and eq_readys is_runing have "th \<in> readys (e#s)" |
|
2244 by (simp add:runing_def) |
|
2245 moreover note eq_cnp eq_cnv eq_cncs |
|
2246 ultimately have ?thesis by auto |
|
2247 } ultimately show ?thesis by blast |
|
2248 qed |
|
2249 qed |
|
2250 next |
|
2251 case vt_nil |
|
2252 show ?case |
|
2253 by (unfold cntP_def cntV_def cntCS_def, |
|
2254 auto simp:count_def holdents_test s_RAG_def wq_def cs_holding_def) |
|
2255 qed |
|
2256 qed |
|
2257 |
|
2258 lemma not_thread_cncs: |
|
2259 assumes not_in: "th \<notin> threads s" |
|
2260 shows "cntCS s th = 0" |
|
2261 proof - |
|
2262 from vt not_in show ?thesis |
|
2263 proof(induct arbitrary:th) |
|
2264 case (vt_cons s e th) |
|
2265 interpret vt_s: valid_trace s using vt_cons(1) |
|
2266 by (unfold_locales, simp) |
|
2267 assume vt: "vt s" |
|
2268 and ih: "\<And>th. th \<notin> threads s \<Longrightarrow> cntCS s th = 0" |
|
2269 and stp: "step s e" |
|
2270 and not_in: "th \<notin> threads (e # s)" |
|
2271 from stp show ?case |
|
2272 proof(cases) |
|
2273 case (thread_create thread prio) |
|
2274 assume eq_e: "e = Create thread prio" |
|
2275 and not_in': "thread \<notin> threads s" |
|
2276 have "cntCS (e # s) th = cntCS s th" |
|
2277 apply (unfold eq_e cntCS_def holdents_test) |
|
2278 by (simp add:RAG_create_unchanged) |
|
2279 moreover have "th \<notin> threads s" |
|
2280 proof - |
|
2281 from not_in eq_e show ?thesis by simp |
|
2282 qed |
|
2283 moreover note ih ultimately show ?thesis by auto |
|
2284 next |
|
2285 case (thread_exit thread) |
|
2286 assume eq_e: "e = Exit thread" |
|
2287 and nh: "holdents s thread = {}" |
|
2288 have eq_cns: "cntCS (e # s) th = cntCS s th" |
|
2289 apply (unfold eq_e cntCS_def holdents_test) |
|
2290 by (simp add:RAG_exit_unchanged) |
|
2291 show ?thesis |
|
2292 proof(cases "th = thread") |
|
2293 case True |
|
2294 have "cntCS s th = 0" by (unfold cntCS_def, auto simp:nh True) |
|
2295 with eq_cns show ?thesis by simp |
|
2296 next |
|
2297 case False |
|
2298 with not_in and eq_e |
|
2299 have "th \<notin> threads s" by simp |
|
2300 from ih[OF this] and eq_cns show ?thesis by simp |
|
2301 qed |
|
2302 next |
|
2303 case (thread_P thread cs) |
|
2304 assume eq_e: "e = P thread cs" |
|
2305 and is_runing: "thread \<in> runing s" |
|
2306 from assms thread_P ih vt stp thread_P have vtp: "vt (P thread cs#s)" by auto |
|
2307 have neq_th: "th \<noteq> thread" |
|
2308 proof - |
|
2309 from not_in eq_e have "th \<notin> threads s" by simp |
|
2310 moreover from is_runing have "thread \<in> threads s" |
|
2311 by (simp add:runing_def readys_def) |
|
2312 ultimately show ?thesis by auto |
|
2313 qed |
|
2314 hence "cntCS (e # s) th = cntCS s th " |
|
2315 apply (unfold cntCS_def holdents_test eq_e) |
|
2316 by (unfold step_RAG_p[OF vtp], auto) |
|
2317 moreover have "cntCS s th = 0" |
|
2318 proof(rule ih) |
|
2319 from not_in eq_e show "th \<notin> threads s" by simp |
|
2320 qed |
|
2321 ultimately show ?thesis by simp |
|
2322 next |
|
2323 case (thread_V thread cs) |
|
2324 assume eq_e: "e = V thread cs" |
|
2325 and is_runing: "thread \<in> runing s" |
|
2326 and hold: "holding s thread cs" |
|
2327 have neq_th: "th \<noteq> thread" |
|
2328 proof - |
|
2329 from not_in eq_e have "th \<notin> threads s" by simp |
|
2330 moreover from is_runing have "thread \<in> threads s" |
|
2331 by (simp add:runing_def readys_def) |
|
2332 ultimately show ?thesis by auto |
|
2333 qed |
|
2334 from assms thread_V vt stp ih |
|
2335 have vtv: "vt (V thread cs#s)" by auto |
|
2336 then interpret vt_v: valid_trace "(V thread cs#s)" |
|
2337 by (unfold_locales, simp) |
|
2338 from hold obtain rest |
|
2339 where eq_wq: "wq s cs = thread # rest" |
|
2340 by (case_tac "wq s cs", auto simp: wq_def s_holding_def) |
|
2341 from not_in eq_e eq_wq |
|
2342 have "\<not> next_th s thread cs th" |
|
2343 apply (auto simp:next_th_def) |
|
2344 proof - |
|
2345 assume ne: "rest \<noteq> []" |
|
2346 and ni: "hd (SOME q. distinct q \<and> set q = set rest) \<notin> threads s" (is "?t \<notin> threads s") |
|
2347 have "?t \<in> set rest" |
|
2348 proof(rule someI2) |
|
2349 from vt_v.wq_distinct[of cs] and eq_wq |
|
2350 show "distinct rest \<and> set rest = set rest" |
|
2351 by (metis distinct.simps(2) vt_s.wq_distinct) |
|
2352 next |
|
2353 fix x assume "distinct x \<and> set x = set rest" with ne |
|
2354 show "hd x \<in> set rest" by (cases x, auto) |
|
2355 qed |
|
2356 with eq_wq have "?t \<in> set (wq s cs)" by simp |
|
2357 from vt_s.wq_threads[OF this] and ni |
|
2358 show False |
|
2359 using `hd (SOME q. distinct q \<and> set q = set rest) \<in> set (wq s cs)` |
|
2360 ni vt_s.wq_threads by blast |
|
2361 qed |
|
2362 moreover note neq_th eq_wq |
|
2363 ultimately have "cntCS (e # s) th = cntCS s th" |
|
2364 by (unfold eq_e cntCS_def holdents_test step_RAG_v[OF vtv], auto) |
|
2365 moreover have "cntCS s th = 0" |
|
2366 proof(rule ih) |
|
2367 from not_in eq_e show "th \<notin> threads s" by simp |
|
2368 qed |
|
2369 ultimately show ?thesis by simp |
|
2370 next |
|
2371 case (thread_set thread prio) |
|
2372 print_facts |
|
2373 assume eq_e: "e = Set thread prio" |
|
2374 and is_runing: "thread \<in> runing s" |
|
2375 from not_in and eq_e have "th \<notin> threads s" by auto |
|
2376 from ih [OF this] and eq_e |
|
2377 show ?thesis |
|
2378 apply (unfold eq_e cntCS_def holdents_test) |
|
2379 by (simp add:RAG_set_unchanged) |
|
2380 qed |
|
2381 next |
|
2382 case vt_nil |
|
2383 show ?case |
|
2384 by (unfold cntCS_def, |
|
2385 auto simp:count_def holdents_test s_RAG_def wq_def cs_holding_def) |
|
2386 qed |
|
2387 qed |
|
2388 |
|
2389 end |
|
2390 |
|
2391 lemma eq_waiting: "waiting (wq (s::state)) th cs = waiting s th cs" |
|
2392 by (auto simp:s_waiting_def cs_waiting_def wq_def) |
|
2393 |
|
2394 context valid_trace |
|
2395 begin |
|
2396 |
|
2397 lemma dm_RAG_threads: |
|
2398 assumes in_dom: "(Th th) \<in> Domain (RAG s)" |
|
2399 shows "th \<in> threads s" |
|
2400 proof - |
|
2401 from in_dom obtain n where "(Th th, n) \<in> RAG s" by auto |
|
2402 moreover from RAG_target_th[OF this] obtain cs where "n = Cs cs" by auto |
|
2403 ultimately have "(Th th, Cs cs) \<in> RAG s" by simp |
|
2404 hence "th \<in> set (wq s cs)" |
|
2405 by (unfold s_RAG_def, auto simp:cs_waiting_def) |
|
2406 from wq_threads [OF this] show ?thesis . |
|
2407 qed |
|
2408 |
|
2409 end |
|
2410 |
|
2411 lemma cp_eq_cpreced: "cp s th = cpreced (wq s) s th" |
|
2412 unfolding cp_def wq_def |
|
2413 apply(induct s rule: schs.induct) |
|
2414 thm cpreced_initial |
|
2415 apply(simp add: Let_def cpreced_initial) |
|
2416 apply(simp add: Let_def) |
|
2417 apply(simp add: Let_def) |
|
2418 apply(simp add: Let_def) |
|
2419 apply(subst (2) schs.simps) |
|
2420 apply(simp add: Let_def) |
|
2421 apply(subst (2) schs.simps) |
|
2422 apply(simp add: Let_def) |
|
2423 done |
|
2424 |
|
2425 context valid_trace |
|
2426 begin |
|
2427 |
|
2428 lemma runing_unique: |
|
2429 assumes runing_1: "th1 \<in> runing s" |
|
2430 and runing_2: "th2 \<in> runing s" |
|
2431 shows "th1 = th2" |
|
2432 proof - |
|
2433 from runing_1 and runing_2 have "cp s th1 = cp s th2" |
|
2434 unfolding runing_def |
|
2435 apply(simp) |
|
2436 done |
|
2437 hence eq_max: "Max ((\<lambda>th. preced th s) ` ({th1} \<union> dependants (wq s) th1)) = |
|
2438 Max ((\<lambda>th. preced th s) ` ({th2} \<union> dependants (wq s) th2))" |
|
2439 (is "Max (?f ` ?A) = Max (?f ` ?B)") |
|
2440 unfolding cp_eq_cpreced |
|
2441 unfolding cpreced_def . |
|
2442 obtain th1' where th1_in: "th1' \<in> ?A" and eq_f_th1: "?f th1' = Max (?f ` ?A)" |
|
2443 proof - |
|
2444 have h1: "finite (?f ` ?A)" |
|
2445 proof - |
|
2446 have "finite ?A" |
|
2447 proof - |
|
2448 have "finite (dependants (wq s) th1)" |
|
2449 proof- |
|
2450 have "finite {th'. (Th th', Th th1) \<in> (RAG (wq s))\<^sup>+}" |
|
2451 proof - |
|
2452 let ?F = "\<lambda> (x, y). the_th x" |
|
2453 have "{th'. (Th th', Th th1) \<in> (RAG (wq s))\<^sup>+} \<subseteq> ?F ` ((RAG (wq s))\<^sup>+)" |
|
2454 apply (auto simp:image_def) |
|
2455 by (rule_tac x = "(Th x, Th th1)" in bexI, auto) |
|
2456 moreover have "finite \<dots>" |
|
2457 proof - |
|
2458 from finite_RAG have "finite (RAG s)" . |
|
2459 hence "finite ((RAG (wq s))\<^sup>+)" |
|
2460 apply (unfold finite_trancl) |
|
2461 by (auto simp: s_RAG_def cs_RAG_def wq_def) |
|
2462 thus ?thesis by auto |
|
2463 qed |
|
2464 ultimately show ?thesis by (auto intro:finite_subset) |
|
2465 qed |
|
2466 thus ?thesis by (simp add:cs_dependants_def) |
|
2467 qed |
|
2468 thus ?thesis by simp |
|
2469 qed |
|
2470 thus ?thesis by auto |
|
2471 qed |
|
2472 moreover have h2: "(?f ` ?A) \<noteq> {}" |
|
2473 proof - |
|
2474 have "?A \<noteq> {}" by simp |
|
2475 thus ?thesis by simp |
|
2476 qed |
|
2477 from Max_in [OF h1 h2] |
|
2478 have "Max (?f ` ?A) \<in> (?f ` ?A)" . |
|
2479 thus ?thesis |
|
2480 thm cpreced_def |
|
2481 unfolding cpreced_def[symmetric] |
|
2482 unfolding cp_eq_cpreced[symmetric] |
|
2483 unfolding cpreced_def |
|
2484 using that[intro] by (auto) |
|
2485 qed |
|
2486 obtain th2' where th2_in: "th2' \<in> ?B" and eq_f_th2: "?f th2' = Max (?f ` ?B)" |
|
2487 proof - |
|
2488 have h1: "finite (?f ` ?B)" |
|
2489 proof - |
|
2490 have "finite ?B" |
|
2491 proof - |
|
2492 have "finite (dependants (wq s) th2)" |
|
2493 proof- |
|
2494 have "finite {th'. (Th th', Th th2) \<in> (RAG (wq s))\<^sup>+}" |
|
2495 proof - |
|
2496 let ?F = "\<lambda> (x, y). the_th x" |
|
2497 have "{th'. (Th th', Th th2) \<in> (RAG (wq s))\<^sup>+} \<subseteq> ?F ` ((RAG (wq s))\<^sup>+)" |
|
2498 apply (auto simp:image_def) |
|
2499 by (rule_tac x = "(Th x, Th th2)" in bexI, auto) |
|
2500 moreover have "finite \<dots>" |
|
2501 proof - |
|
2502 from finite_RAG have "finite (RAG s)" . |
|
2503 hence "finite ((RAG (wq s))\<^sup>+)" |
|
2504 apply (unfold finite_trancl) |
|
2505 by (auto simp: s_RAG_def cs_RAG_def wq_def) |
|
2506 thus ?thesis by auto |
|
2507 qed |
|
2508 ultimately show ?thesis by (auto intro:finite_subset) |
|
2509 qed |
|
2510 thus ?thesis by (simp add:cs_dependants_def) |
|
2511 qed |
|
2512 thus ?thesis by simp |
|
2513 qed |
|
2514 thus ?thesis by auto |
|
2515 qed |
|
2516 moreover have h2: "(?f ` ?B) \<noteq> {}" |
|
2517 proof - |
|
2518 have "?B \<noteq> {}" by simp |
|
2519 thus ?thesis by simp |
|
2520 qed |
|
2521 from Max_in [OF h1 h2] |
|
2522 have "Max (?f ` ?B) \<in> (?f ` ?B)" . |
|
2523 thus ?thesis by (auto intro:that) |
|
2524 qed |
|
2525 from eq_f_th1 eq_f_th2 eq_max |
|
2526 have eq_preced: "preced th1' s = preced th2' s" by auto |
|
2527 hence eq_th12: "th1' = th2'" |
|
2528 proof (rule preced_unique) |
|
2529 from th1_in have "th1' = th1 \<or> (th1' \<in> dependants (wq s) th1)" by simp |
|
2530 thus "th1' \<in> threads s" |
|
2531 proof |
|
2532 assume "th1' \<in> dependants (wq s) th1" |
|
2533 hence "(Th th1') \<in> Domain ((RAG s)^+)" |
|
2534 apply (unfold cs_dependants_def cs_RAG_def s_RAG_def) |
|
2535 by (auto simp:Domain_def) |
|
2536 hence "(Th th1') \<in> Domain (RAG s)" by (simp add:trancl_domain) |
|
2537 from dm_RAG_threads[OF this] show ?thesis . |
|
2538 next |
|
2539 assume "th1' = th1" |
|
2540 with runing_1 show ?thesis |
|
2541 by (unfold runing_def readys_def, auto) |
|
2542 qed |
|
2543 next |
|
2544 from th2_in have "th2' = th2 \<or> (th2' \<in> dependants (wq s) th2)" by simp |
|
2545 thus "th2' \<in> threads s" |
|
2546 proof |
|
2547 assume "th2' \<in> dependants (wq s) th2" |
|
2548 hence "(Th th2') \<in> Domain ((RAG s)^+)" |
|
2549 apply (unfold cs_dependants_def cs_RAG_def s_RAG_def) |
|
2550 by (auto simp:Domain_def) |
|
2551 hence "(Th th2') \<in> Domain (RAG s)" by (simp add:trancl_domain) |
|
2552 from dm_RAG_threads[OF this] show ?thesis . |
|
2553 next |
|
2554 assume "th2' = th2" |
|
2555 with runing_2 show ?thesis |
|
2556 by (unfold runing_def readys_def, auto) |
|
2557 qed |
|
2558 qed |
|
2559 from th1_in have "th1' = th1 \<or> th1' \<in> dependants (wq s) th1" by simp |
|
2560 thus ?thesis |
|
2561 proof |
|
2562 assume eq_th': "th1' = th1" |
|
2563 from th2_in have "th2' = th2 \<or> th2' \<in> dependants (wq s) th2" by simp |
|
2564 thus ?thesis |
|
2565 proof |
|
2566 assume "th2' = th2" thus ?thesis using eq_th' eq_th12 by simp |
|
2567 next |
|
2568 assume "th2' \<in> dependants (wq s) th2" |
|
2569 with eq_th12 eq_th' have "th1 \<in> dependants (wq s) th2" by simp |
|
2570 hence "(Th th1, Th th2) \<in> (RAG s)^+" |
|
2571 by (unfold cs_dependants_def s_RAG_def cs_RAG_def, simp) |
|
2572 hence "Th th1 \<in> Domain ((RAG s)^+)" |
|
2573 apply (unfold cs_dependants_def cs_RAG_def s_RAG_def) |
|
2574 by (auto simp:Domain_def) |
|
2575 hence "Th th1 \<in> Domain (RAG s)" by (simp add:trancl_domain) |
|
2576 then obtain n where d: "(Th th1, n) \<in> RAG s" by (auto simp:Domain_def) |
|
2577 from RAG_target_th [OF this] |
|
2578 obtain cs' where "n = Cs cs'" by auto |
|
2579 with d have "(Th th1, Cs cs') \<in> RAG s" by simp |
|
2580 with runing_1 have "False" |
|
2581 apply (unfold runing_def readys_def s_RAG_def) |
|
2582 by (auto simp:eq_waiting) |
|
2583 thus ?thesis by simp |
|
2584 qed |
|
2585 next |
|
2586 assume th1'_in: "th1' \<in> dependants (wq s) th1" |
|
2587 from th2_in have "th2' = th2 \<or> th2' \<in> dependants (wq s) th2" by simp |
|
2588 thus ?thesis |
|
2589 proof |
|
2590 assume "th2' = th2" |
|
2591 with th1'_in eq_th12 have "th2 \<in> dependants (wq s) th1" by simp |
|
2592 hence "(Th th2, Th th1) \<in> (RAG s)^+" |
|
2593 by (unfold cs_dependants_def s_RAG_def cs_RAG_def, simp) |
|
2594 hence "Th th2 \<in> Domain ((RAG s)^+)" |
|
2595 apply (unfold cs_dependants_def cs_RAG_def s_RAG_def) |
|
2596 by (auto simp:Domain_def) |
|
2597 hence "Th th2 \<in> Domain (RAG s)" by (simp add:trancl_domain) |
|
2598 then obtain n where d: "(Th th2, n) \<in> RAG s" by (auto simp:Domain_def) |
|
2599 from RAG_target_th [OF this] |
|
2600 obtain cs' where "n = Cs cs'" by auto |
|
2601 with d have "(Th th2, Cs cs') \<in> RAG s" by simp |
|
2602 with runing_2 have "False" |
|
2603 apply (unfold runing_def readys_def s_RAG_def) |
|
2604 by (auto simp:eq_waiting) |
|
2605 thus ?thesis by simp |
|
2606 next |
|
2607 assume "th2' \<in> dependants (wq s) th2" |
|
2608 with eq_th12 have "th1' \<in> dependants (wq s) th2" by simp |
|
2609 hence h1: "(Th th1', Th th2) \<in> (RAG s)^+" |
|
2610 by (unfold cs_dependants_def s_RAG_def cs_RAG_def, simp) |
|
2611 from th1'_in have h2: "(Th th1', Th th1) \<in> (RAG s)^+" |
|
2612 by (unfold cs_dependants_def s_RAG_def cs_RAG_def, simp) |
|
2613 show ?thesis |
|
2614 proof(rule dchain_unique[OF h1 _ h2, symmetric]) |
|
2615 from runing_1 show "th1 \<in> readys s" by (simp add:runing_def) |
|
2616 from runing_2 show "th2 \<in> readys s" by (simp add:runing_def) |
|
2617 qed |
|
2618 qed |
|
2619 qed |
|
2620 qed |
|
2621 |
|
2622 |
|
2623 lemma "card (runing s) \<le> 1" |
|
2624 apply(subgoal_tac "finite (runing s)") |
|
2625 prefer 2 |
|
2626 apply (metis finite_nat_set_iff_bounded lessI runing_unique) |
|
2627 apply(rule ccontr) |
|
2628 apply(simp) |
|
2629 apply(case_tac "Suc (Suc 0) \<le> card (runing s)") |
|
2630 apply(subst (asm) card_le_Suc_iff) |
|
2631 apply(simp) |
|
2632 apply(auto)[1] |
|
2633 apply (metis insertCI runing_unique) |
|
2634 apply(auto) |
|
2635 done |
|
2636 |
|
2637 end |
|
2638 |
|
2639 |
|
2640 lemma create_pre: |
|
2641 assumes stp: "step s e" |
|
2642 and not_in: "th \<notin> threads s" |
|
2643 and is_in: "th \<in> threads (e#s)" |
|
2644 obtains prio where "e = Create th prio" |
|
2645 proof - |
|
2646 from assms |
|
2647 show ?thesis |
|
2648 proof(cases) |
|
2649 case (thread_create thread prio) |
|
2650 with is_in not_in have "e = Create th prio" by simp |
|
2651 from that[OF this] show ?thesis . |
|
2652 next |
|
2653 case (thread_exit thread) |
|
2654 with assms show ?thesis by (auto intro!:that) |
|
2655 next |
|
2656 case (thread_P thread) |
|
2657 with assms show ?thesis by (auto intro!:that) |
|
2658 next |
|
2659 case (thread_V thread) |
|
2660 with assms show ?thesis by (auto intro!:that) |
|
2661 next |
|
2662 case (thread_set thread) |
|
2663 with assms show ?thesis by (auto intro!:that) |
|
2664 qed |
|
2665 qed |
|
2666 |
|
2667 lemma length_down_to_in: |
|
2668 assumes le_ij: "i \<le> j" |
|
2669 and le_js: "j \<le> length s" |
|
2670 shows "length (down_to j i s) = j - i" |
|
2671 proof - |
|
2672 have "length (down_to j i s) = length (from_to i j (rev s))" |
|
2673 by (unfold down_to_def, auto) |
|
2674 also have "\<dots> = j - i" |
|
2675 proof(rule length_from_to_in[OF le_ij]) |
|
2676 from le_js show "j \<le> length (rev s)" by simp |
|
2677 qed |
|
2678 finally show ?thesis . |
|
2679 qed |
|
2680 |
|
2681 |
|
2682 lemma moment_head: |
|
2683 assumes le_it: "Suc i \<le> length t" |
|
2684 obtains e where "moment (Suc i) t = e#moment i t" |
|
2685 proof - |
|
2686 have "i \<le> Suc i" by simp |
|
2687 from length_down_to_in [OF this le_it] |
|
2688 have "length (down_to (Suc i) i t) = 1" by auto |
|
2689 then obtain e where "down_to (Suc i) i t = [e]" |
|
2690 apply (cases "(down_to (Suc i) i t)") by auto |
|
2691 moreover have "down_to (Suc i) 0 t = down_to (Suc i) i t @ down_to i 0 t" |
|
2692 by (rule down_to_conc[symmetric], auto) |
|
2693 ultimately have eq_me: "moment (Suc i) t = e#(moment i t)" |
|
2694 by (auto simp:down_to_moment) |
|
2695 from that [OF this] show ?thesis . |
|
2696 qed |
|
2697 |
|
2698 context valid_trace |
|
2699 begin |
|
2700 |
|
2701 lemma cnp_cnv_eq: |
|
2702 assumes "th \<notin> threads s" |
|
2703 shows "cntP s th = cntV s th" |
|
2704 using assms |
|
2705 using cnp_cnv_cncs not_thread_cncs by auto |
|
2706 |
|
2707 end |
|
2708 |
|
2709 |
|
2710 lemma eq_RAG: |
|
2711 "RAG (wq s) = RAG s" |
|
2712 by (unfold cs_RAG_def s_RAG_def, auto) |
|
2713 |
|
2714 context valid_trace |
|
2715 begin |
|
2716 |
|
2717 lemma count_eq_dependants: |
|
2718 assumes eq_pv: "cntP s th = cntV s th" |
|
2719 shows "dependants (wq s) th = {}" |
|
2720 proof - |
|
2721 from cnp_cnv_cncs and eq_pv |
|
2722 have "cntCS s th = 0" |
|
2723 by (auto split:if_splits) |
|
2724 moreover have "finite {cs. (Cs cs, Th th) \<in> RAG s}" |
|
2725 proof - |
|
2726 from finite_holding[of th] show ?thesis |
|
2727 by (simp add:holdents_test) |
|
2728 qed |
|
2729 ultimately have h: "{cs. (Cs cs, Th th) \<in> RAG s} = {}" |
|
2730 by (unfold cntCS_def holdents_test cs_dependants_def, auto) |
|
2731 show ?thesis |
|
2732 proof(unfold cs_dependants_def) |
|
2733 { assume "{th'. (Th th', Th th) \<in> (RAG (wq s))\<^sup>+} \<noteq> {}" |
|
2734 then obtain th' where "(Th th', Th th) \<in> (RAG (wq s))\<^sup>+" by auto |
|
2735 hence "False" |
|
2736 proof(cases) |
|
2737 assume "(Th th', Th th) \<in> RAG (wq s)" |
|
2738 thus "False" by (auto simp:cs_RAG_def) |
|
2739 next |
|
2740 fix c |
|
2741 assume "(c, Th th) \<in> RAG (wq s)" |
|
2742 with h and eq_RAG show "False" |
|
2743 by (cases c, auto simp:cs_RAG_def) |
|
2744 qed |
|
2745 } thus "{th'. (Th th', Th th) \<in> (RAG (wq s))\<^sup>+} = {}" by auto |
|
2746 qed |
|
2747 qed |
|
2748 |
|
2749 lemma dependants_threads: |
|
2750 shows "dependants (wq s) th \<subseteq> threads s" |
|
2751 proof |
|
2752 { fix th th' |
|
2753 assume h: "th \<in> {th'a. (Th th'a, Th th') \<in> (RAG (wq s))\<^sup>+}" |
|
2754 have "Th th \<in> Domain (RAG s)" |
|
2755 proof - |
|
2756 from h obtain th' where "(Th th, Th th') \<in> (RAG (wq s))\<^sup>+" by auto |
|
2757 hence "(Th th) \<in> Domain ( (RAG (wq s))\<^sup>+)" by (auto simp:Domain_def) |
|
2758 with trancl_domain have "(Th th) \<in> Domain (RAG (wq s))" by simp |
|
2759 thus ?thesis using eq_RAG by simp |
|
2760 qed |
|
2761 from dm_RAG_threads[OF this] |
|
2762 have "th \<in> threads s" . |
|
2763 } note hh = this |
|
2764 fix th1 |
|
2765 assume "th1 \<in> dependants (wq s) th" |
|
2766 hence "th1 \<in> {th'a. (Th th'a, Th th) \<in> (RAG (wq s))\<^sup>+}" |
|
2767 by (unfold cs_dependants_def, simp) |
|
2768 from hh [OF this] show "th1 \<in> threads s" . |
|
2769 qed |
|
2770 |
|
2771 lemma finite_threads: |
|
2772 shows "finite (threads s)" |
|
2773 using vt by (induct) (auto elim: step.cases) |
|
2774 |
|
2775 end |
|
2776 |
|
2777 lemma Max_f_mono: |
|
2778 assumes seq: "A \<subseteq> B" |
|
2779 and np: "A \<noteq> {}" |
|
2780 and fnt: "finite B" |
|
2781 shows "Max (f ` A) \<le> Max (f ` B)" |
|
2782 proof(rule Max_mono) |
|
2783 from seq show "f ` A \<subseteq> f ` B" by auto |
|
2784 next |
|
2785 from np show "f ` A \<noteq> {}" by auto |
|
2786 next |
|
2787 from fnt and seq show "finite (f ` B)" by auto |
|
2788 qed |
|
2789 |
|
2790 context valid_trace |
|
2791 begin |
|
2792 |
|
2793 lemma cp_le: |
|
2794 assumes th_in: "th \<in> threads s" |
|
2795 shows "cp s th \<le> Max ((\<lambda> th. (preced th s)) ` threads s)" |
|
2796 proof(unfold cp_eq_cpreced cpreced_def cs_dependants_def) |
|
2797 show "Max ((\<lambda>th. preced th s) ` ({th} \<union> {th'. (Th th', Th th) \<in> (RAG (wq s))\<^sup>+})) |
|
2798 \<le> Max ((\<lambda>th. preced th s) ` threads s)" |
|
2799 (is "Max (?f ` ?A) \<le> Max (?f ` ?B)") |
|
2800 proof(rule Max_f_mono) |
|
2801 show "{th} \<union> {th'. (Th th', Th th) \<in> (RAG (wq s))\<^sup>+} \<noteq> {}" by simp |
|
2802 next |
|
2803 from finite_threads |
|
2804 show "finite (threads s)" . |
|
2805 next |
|
2806 from th_in |
|
2807 show "{th} \<union> {th'. (Th th', Th th) \<in> (RAG (wq s))\<^sup>+} \<subseteq> threads s" |
|
2808 apply (auto simp:Domain_def) |
|
2809 apply (rule_tac dm_RAG_threads) |
|
2810 apply (unfold trancl_domain [of "RAG s", symmetric]) |
|
2811 by (unfold cs_RAG_def s_RAG_def, auto simp:Domain_def) |
|
2812 qed |
|
2813 qed |
|
2814 |
|
2815 lemma le_cp: |
|
2816 shows "preced th s \<le> cp s th" |
|
2817 proof(unfold cp_eq_cpreced preced_def cpreced_def, simp) |
|
2818 show "Prc (priority th s) (last_set th s) |
|
2819 \<le> Max (insert (Prc (priority th s) (last_set th s)) |
|
2820 ((\<lambda>th. Prc (priority th s) (last_set th s)) ` dependants (wq s) th))" |
|
2821 (is "?l \<le> Max (insert ?l ?A)") |
|
2822 proof(cases "?A = {}") |
|
2823 case False |
|
2824 have "finite ?A" (is "finite (?f ` ?B)") |
|
2825 proof - |
|
2826 have "finite ?B" |
|
2827 proof- |
|
2828 have "finite {th'. (Th th', Th th) \<in> (RAG (wq s))\<^sup>+}" |
|
2829 proof - |
|
2830 let ?F = "\<lambda> (x, y). the_th x" |
|
2831 have "{th'. (Th th', Th th) \<in> (RAG (wq s))\<^sup>+} \<subseteq> ?F ` ((RAG (wq s))\<^sup>+)" |
|
2832 apply (auto simp:image_def) |
|
2833 by (rule_tac x = "(Th x, Th th)" in bexI, auto) |
|
2834 moreover have "finite \<dots>" |
|
2835 proof - |
|
2836 from finite_RAG have "finite (RAG s)" . |
|
2837 hence "finite ((RAG (wq s))\<^sup>+)" |
|
2838 apply (unfold finite_trancl) |
|
2839 by (auto simp: s_RAG_def cs_RAG_def wq_def) |
|
2840 thus ?thesis by auto |
|
2841 qed |
|
2842 ultimately show ?thesis by (auto intro:finite_subset) |
|
2843 qed |
|
2844 thus ?thesis by (simp add:cs_dependants_def) |
|
2845 qed |
|
2846 thus ?thesis by simp |
|
2847 qed |
|
2848 from Max_insert [OF this False, of ?l] show ?thesis by auto |
|
2849 next |
|
2850 case True |
|
2851 thus ?thesis by auto |
|
2852 qed |
|
2853 qed |
|
2854 |
|
2855 lemma max_cp_eq: |
|
2856 shows "Max ((cp s) ` threads s) = Max ((\<lambda> th. (preced th s)) ` threads s)" |
|
2857 (is "?l = ?r") |
|
2858 proof(cases "threads s = {}") |
|
2859 case True |
|
2860 thus ?thesis by auto |
|
2861 next |
|
2862 case False |
|
2863 have "?l \<in> ((cp s) ` threads s)" |
|
2864 proof(rule Max_in) |
|
2865 from finite_threads |
|
2866 show "finite (cp s ` threads s)" by auto |
|
2867 next |
|
2868 from False show "cp s ` threads s \<noteq> {}" by auto |
|
2869 qed |
|
2870 then obtain th |
|
2871 where th_in: "th \<in> threads s" and eq_l: "?l = cp s th" by auto |
|
2872 have "\<dots> \<le> ?r" by (rule cp_le[OF th_in]) |
|
2873 moreover have "?r \<le> cp s th" (is "Max (?f ` ?A) \<le> cp s th") |
|
2874 proof - |
|
2875 have "?r \<in> (?f ` ?A)" |
|
2876 proof(rule Max_in) |
|
2877 from finite_threads |
|
2878 show " finite ((\<lambda>th. preced th s) ` threads s)" by auto |
|
2879 next |
|
2880 from False show " (\<lambda>th. preced th s) ` threads s \<noteq> {}" by auto |
|
2881 qed |
|
2882 then obtain th' where |
|
2883 th_in': "th' \<in> ?A " and eq_r: "?r = ?f th'" by auto |
|
2884 from le_cp [of th'] eq_r |
|
2885 have "?r \<le> cp s th'" by auto |
|
2886 moreover have "\<dots> \<le> cp s th" |
|
2887 proof(fold eq_l) |
|
2888 show " cp s th' \<le> Max (cp s ` threads s)" |
|
2889 proof(rule Max_ge) |
|
2890 from th_in' show "cp s th' \<in> cp s ` threads s" |
|
2891 by auto |
|
2892 next |
|
2893 from finite_threads |
|
2894 show "finite (cp s ` threads s)" by auto |
|
2895 qed |
|
2896 qed |
|
2897 ultimately show ?thesis by auto |
|
2898 qed |
|
2899 ultimately show ?thesis using eq_l by auto |
|
2900 qed |
|
2901 |
|
2902 lemma max_cp_readys_threads_pre: |
|
2903 assumes np: "threads s \<noteq> {}" |
|
2904 shows "Max (cp s ` readys s) = Max (cp s ` threads s)" |
|
2905 proof(unfold max_cp_eq) |
|
2906 show "Max (cp s ` readys s) = Max ((\<lambda>th. preced th s) ` threads s)" |
|
2907 proof - |
|
2908 let ?p = "Max ((\<lambda>th. preced th s) ` threads s)" |
|
2909 let ?f = "(\<lambda>th. preced th s)" |
|
2910 have "?p \<in> ((\<lambda>th. preced th s) ` threads s)" |
|
2911 proof(rule Max_in) |
|
2912 from finite_threads show "finite (?f ` threads s)" by simp |
|
2913 next |
|
2914 from np show "?f ` threads s \<noteq> {}" by simp |
|
2915 qed |
|
2916 then obtain tm where tm_max: "?f tm = ?p" and tm_in: "tm \<in> threads s" |
|
2917 by (auto simp:Image_def) |
|
2918 from th_chain_to_ready [OF tm_in] |
|
2919 have "tm \<in> readys s \<or> (\<exists>th'. th' \<in> readys s \<and> (Th tm, Th th') \<in> (RAG s)\<^sup>+)" . |
|
2920 thus ?thesis |
|
2921 proof |
|
2922 assume "\<exists>th'. th' \<in> readys s \<and> (Th tm, Th th') \<in> (RAG s)\<^sup>+ " |
|
2923 then obtain th' where th'_in: "th' \<in> readys s" |
|
2924 and tm_chain:"(Th tm, Th th') \<in> (RAG s)\<^sup>+" by auto |
|
2925 have "cp s th' = ?f tm" |
|
2926 proof(subst cp_eq_cpreced, subst cpreced_def, rule Max_eqI) |
|
2927 from dependants_threads finite_threads |
|
2928 show "finite ((\<lambda>th. preced th s) ` ({th'} \<union> dependants (wq s) th'))" |
|
2929 by (auto intro:finite_subset) |
|
2930 next |
|
2931 fix p assume p_in: "p \<in> (\<lambda>th. preced th s) ` ({th'} \<union> dependants (wq s) th')" |
|
2932 from tm_max have " preced tm s = Max ((\<lambda>th. preced th s) ` threads s)" . |
|
2933 moreover have "p \<le> \<dots>" |
|
2934 proof(rule Max_ge) |
|
2935 from finite_threads |
|
2936 show "finite ((\<lambda>th. preced th s) ` threads s)" by simp |
|
2937 next |
|
2938 from p_in and th'_in and dependants_threads[of th'] |
|
2939 show "p \<in> (\<lambda>th. preced th s) ` threads s" |
|
2940 by (auto simp:readys_def) |
|
2941 qed |
|
2942 ultimately show "p \<le> preced tm s" by auto |
|
2943 next |
|
2944 show "preced tm s \<in> (\<lambda>th. preced th s) ` ({th'} \<union> dependants (wq s) th')" |
|
2945 proof - |
|
2946 from tm_chain |
|
2947 have "tm \<in> dependants (wq s) th'" |
|
2948 by (unfold cs_dependants_def s_RAG_def cs_RAG_def, auto) |
|
2949 thus ?thesis by auto |
|
2950 qed |
|
2951 qed |
|
2952 with tm_max |
|
2953 have h: "cp s th' = Max ((\<lambda>th. preced th s) ` threads s)" by simp |
|
2954 show ?thesis |
|
2955 proof (fold h, rule Max_eqI) |
|
2956 fix q |
|
2957 assume "q \<in> cp s ` readys s" |
|
2958 then obtain th1 where th1_in: "th1 \<in> readys s" |
|
2959 and eq_q: "q = cp s th1" by auto |
|
2960 show "q \<le> cp s th'" |
|
2961 apply (unfold h eq_q) |
|
2962 apply (unfold cp_eq_cpreced cpreced_def) |
|
2963 apply (rule Max_mono) |
|
2964 proof - |
|
2965 from dependants_threads [of th1] th1_in |
|
2966 show "(\<lambda>th. preced th s) ` ({th1} \<union> dependants (wq s) th1) \<subseteq> |
|
2967 (\<lambda>th. preced th s) ` threads s" |
|
2968 by (auto simp:readys_def) |
|
2969 next |
|
2970 show "(\<lambda>th. preced th s) ` ({th1} \<union> dependants (wq s) th1) \<noteq> {}" by simp |
|
2971 next |
|
2972 from finite_threads |
|
2973 show " finite ((\<lambda>th. preced th s) ` threads s)" by simp |
|
2974 qed |
|
2975 next |
|
2976 from finite_threads |
|
2977 show "finite (cp s ` readys s)" by (auto simp:readys_def) |
|
2978 next |
|
2979 from th'_in |
|
2980 show "cp s th' \<in> cp s ` readys s" by simp |
|
2981 qed |
|
2982 next |
|
2983 assume tm_ready: "tm \<in> readys s" |
|
2984 show ?thesis |
|
2985 proof(fold tm_max) |
|
2986 have cp_eq_p: "cp s tm = preced tm s" |
|
2987 proof(unfold cp_eq_cpreced cpreced_def, rule Max_eqI) |
|
2988 fix y |
|
2989 assume hy: "y \<in> (\<lambda>th. preced th s) ` ({tm} \<union> dependants (wq s) tm)" |
|
2990 show "y \<le> preced tm s" |
|
2991 proof - |
|
2992 { fix y' |
|
2993 assume hy' : "y' \<in> ((\<lambda>th. preced th s) ` dependants (wq s) tm)" |
|
2994 have "y' \<le> preced tm s" |
|
2995 proof(unfold tm_max, rule Max_ge) |
|
2996 from hy' dependants_threads[of tm] |
|
2997 show "y' \<in> (\<lambda>th. preced th s) ` threads s" by auto |
|
2998 next |
|
2999 from finite_threads |
|
3000 show "finite ((\<lambda>th. preced th s) ` threads s)" by simp |
|
3001 qed |
|
3002 } with hy show ?thesis by auto |
|
3003 qed |
|
3004 next |
|
3005 from dependants_threads[of tm] finite_threads |
|
3006 show "finite ((\<lambda>th. preced th s) ` ({tm} \<union> dependants (wq s) tm))" |
|
3007 by (auto intro:finite_subset) |
|
3008 next |
|
3009 show "preced tm s \<in> (\<lambda>th. preced th s) ` ({tm} \<union> dependants (wq s) tm)" |
|
3010 by simp |
|
3011 qed |
|
3012 moreover have "Max (cp s ` readys s) = cp s tm" |
|
3013 proof(rule Max_eqI) |
|
3014 from tm_ready show "cp s tm \<in> cp s ` readys s" by simp |
|
3015 next |
|
3016 from finite_threads |
|
3017 show "finite (cp s ` readys s)" by (auto simp:readys_def) |
|
3018 next |
|
3019 fix y assume "y \<in> cp s ` readys s" |
|
3020 then obtain th1 where th1_readys: "th1 \<in> readys s" |
|
3021 and h: "y = cp s th1" by auto |
|
3022 show "y \<le> cp s tm" |
|
3023 apply(unfold cp_eq_p h) |
|
3024 apply(unfold cp_eq_cpreced cpreced_def tm_max, rule Max_mono) |
|
3025 proof - |
|
3026 from finite_threads |
|
3027 show "finite ((\<lambda>th. preced th s) ` threads s)" by simp |
|
3028 next |
|
3029 show "(\<lambda>th. preced th s) ` ({th1} \<union> dependants (wq s) th1) \<noteq> {}" |
|
3030 by simp |
|
3031 next |
|
3032 from dependants_threads[of th1] th1_readys |
|
3033 show "(\<lambda>th. preced th s) ` ({th1} \<union> dependants (wq s) th1) |
|
3034 \<subseteq> (\<lambda>th. preced th s) ` threads s" |
|
3035 by (auto simp:readys_def) |
|
3036 qed |
|
3037 qed |
|
3038 ultimately show " Max (cp s ` readys s) = preced tm s" by simp |
|
3039 qed |
|
3040 qed |
|
3041 qed |
|
3042 qed |
|
3043 |
|
3044 text {* (* ccc *) \noindent |
|
3045 Since the current precedence of the threads in ready queue will always be boosted, |
|
3046 there must be one inside it has the maximum precedence of the whole system. |
|
3047 *} |
|
3048 lemma max_cp_readys_threads: |
|
3049 shows "Max (cp s ` readys s) = Max (cp s ` threads s)" |
|
3050 proof(cases "threads s = {}") |
|
3051 case True |
|
3052 thus ?thesis |
|
3053 by (auto simp:readys_def) |
|
3054 next |
|
3055 case False |
|
3056 show ?thesis by (rule max_cp_readys_threads_pre[OF False]) |
|
3057 qed |
|
3058 |
|
3059 end |
|
3060 |
|
3061 lemma eq_holding: "holding (wq s) th cs = holding s th cs" |
|
3062 apply (unfold s_holding_def cs_holding_def wq_def, simp) |
|
3063 done |
|
3064 |
|
3065 lemma f_image_eq: |
|
3066 assumes h: "\<And> a. a \<in> A \<Longrightarrow> f a = g a" |
|
3067 shows "f ` A = g ` A" |
|
3068 proof |
|
3069 show "f ` A \<subseteq> g ` A" |
|
3070 by(rule image_subsetI, auto intro:h) |
|
3071 next |
|
3072 show "g ` A \<subseteq> f ` A" |
|
3073 by (rule image_subsetI, auto intro:h[symmetric]) |
|
3074 qed |
|
3075 |
|
3076 |
|
3077 definition detached :: "state \<Rightarrow> thread \<Rightarrow> bool" |
|
3078 where "detached s th \<equiv> (\<not>(\<exists> cs. holding s th cs)) \<and> (\<not>(\<exists>cs. waiting s th cs))" |
|
3079 |
|
3080 |
|
3081 lemma detached_test: |
|
3082 shows "detached s th = (Th th \<notin> Field (RAG s))" |
|
3083 apply(simp add: detached_def Field_def) |
|
3084 apply(simp add: s_RAG_def) |
|
3085 apply(simp add: s_holding_abv s_waiting_abv) |
|
3086 apply(simp add: Domain_iff Range_iff) |
|
3087 apply(simp add: wq_def) |
|
3088 apply(auto) |
|
3089 done |
|
3090 |
|
3091 context valid_trace |
|
3092 begin |
|
3093 |
|
3094 lemma detached_intro: |
|
3095 assumes eq_pv: "cntP s th = cntV s th" |
|
3096 shows "detached s th" |
|
3097 proof - |
|
3098 from cnp_cnv_cncs |
|
3099 have eq_cnt: "cntP s th = |
|
3100 cntV s th + (if th \<in> readys s \<or> th \<notin> threads s then cntCS s th else cntCS s th + 1)" . |
|
3101 hence cncs_zero: "cntCS s th = 0" |
|
3102 by (auto simp:eq_pv split:if_splits) |
|
3103 with eq_cnt |
|
3104 have "th \<in> readys s \<or> th \<notin> threads s" by (auto simp:eq_pv) |
|
3105 thus ?thesis |
|
3106 proof |
|
3107 assume "th \<notin> threads s" |
|
3108 with range_in dm_RAG_threads |
|
3109 show ?thesis |
|
3110 by (auto simp add: detached_def s_RAG_def s_waiting_abv s_holding_abv wq_def Domain_iff Range_iff) |
|
3111 next |
|
3112 assume "th \<in> readys s" |
|
3113 moreover have "Th th \<notin> Range (RAG s)" |
|
3114 proof - |
|
3115 from card_0_eq [OF finite_holding] and cncs_zero |
|
3116 have "holdents s th = {}" |
|
3117 by (simp add:cntCS_def) |
|
3118 thus ?thesis |
|
3119 apply(auto simp:holdents_test) |
|
3120 apply(case_tac a) |
|
3121 apply(auto simp:holdents_test s_RAG_def) |
|
3122 done |
|
3123 qed |
|
3124 ultimately show ?thesis |
|
3125 by (auto simp add: detached_def s_RAG_def s_waiting_abv s_holding_abv wq_def readys_def) |
|
3126 qed |
|
3127 qed |
|
3128 |
|
3129 lemma detached_elim: |
|
3130 assumes dtc: "detached s th" |
|
3131 shows "cntP s th = cntV s th" |
|
3132 proof - |
|
3133 from cnp_cnv_cncs |
|
3134 have eq_pv: " cntP s th = |
|
3135 cntV s th + (if th \<in> readys s \<or> th \<notin> threads s then cntCS s th else cntCS s th + 1)" . |
|
3136 have cncs_z: "cntCS s th = 0" |
|
3137 proof - |
|
3138 from dtc have "holdents s th = {}" |
|
3139 unfolding detached_def holdents_test s_RAG_def |
|
3140 by (simp add: s_waiting_abv wq_def s_holding_abv Domain_iff Range_iff) |
|
3141 thus ?thesis by (auto simp:cntCS_def) |
|
3142 qed |
|
3143 show ?thesis |
|
3144 proof(cases "th \<in> threads s") |
|
3145 case True |
|
3146 with dtc |
|
3147 have "th \<in> readys s" |
|
3148 by (unfold readys_def detached_def Field_def Domain_def Range_def, |
|
3149 auto simp:eq_waiting s_RAG_def) |
|
3150 with cncs_z and eq_pv show ?thesis by simp |
|
3151 next |
|
3152 case False |
|
3153 with cncs_z and eq_pv show ?thesis by simp |
|
3154 qed |
|
3155 qed |
|
3156 |
|
3157 lemma detached_eq: |
|
3158 shows "(detached s th) = (cntP s th = cntV s th)" |
|
3159 by (insert vt, auto intro:detached_intro detached_elim) |
|
3160 |
|
3161 end |
|
3162 |
|
3163 text {* |
|
3164 The lemmas in this .thy file are all obvious lemmas, however, they still needs to be derived |
|
3165 from the concise and miniature model of PIP given in PrioGDef.thy. |
|
3166 *} |
|
3167 |
|
3168 lemma eq_dependants: "dependants (wq s) = dependants s" |
|
3169 by (simp add: s_dependants_abv wq_def) |
|
3170 |
|
3171 lemma next_th_unique: |
|
3172 assumes nt1: "next_th s th cs th1" |
|
3173 and nt2: "next_th s th cs th2" |
|
3174 shows "th1 = th2" |
|
3175 using assms by (unfold next_th_def, auto) |
|
3176 |
|
3177 lemma birth_time_lt: "s \<noteq> [] \<Longrightarrow> last_set th s < length s" |
|
3178 apply (induct s, simp) |
|
3179 proof - |
|
3180 fix a s |
|
3181 assume ih: "s \<noteq> [] \<Longrightarrow> last_set th s < length s" |
|
3182 and eq_as: "a # s \<noteq> []" |
|
3183 show "last_set th (a # s) < length (a # s)" |
|
3184 proof(cases "s \<noteq> []") |
|
3185 case False |
|
3186 from False show ?thesis |
|
3187 by (cases a, auto simp:last_set.simps) |
|
3188 next |
|
3189 case True |
|
3190 from ih [OF True] show ?thesis |
|
3191 by (cases a, auto simp:last_set.simps) |
|
3192 qed |
|
3193 qed |
|
3194 |
|
3195 lemma th_in_ne: "th \<in> threads s \<Longrightarrow> s \<noteq> []" |
|
3196 by (induct s, auto simp:threads.simps) |
|
3197 |
|
3198 lemma preced_tm_lt: "th \<in> threads s \<Longrightarrow> preced th s = Prc x y \<Longrightarrow> y < length s" |
|
3199 apply (drule_tac th_in_ne) |
|
3200 by (unfold preced_def, auto intro: birth_time_lt) |
12 |
3201 |
13 lemma inj_the_preced: |
3202 lemma inj_the_preced: |
14 "inj_on (the_preced s) (threads s)" |
3203 "inj_on (the_preced s) (threads s)" |
15 by (metis inj_onI preced_unique the_preced_def) |
3204 by (metis inj_onI preced_unique the_preced_def) |
16 |
|
17 text {* @{term "the_thread"} extracts thread out of RAG node. *} |
|
18 fun the_thread :: "node \<Rightarrow> thread" where |
|
19 "the_thread (Th th) = th" |
|
20 |
|
21 text {* The following @{text "wRAG"} is the waiting sub-graph of @{text "RAG"}. *} |
|
22 definition "wRAG (s::state) = {(Th th, Cs cs) | th cs. waiting s th cs}" |
|
23 |
|
24 text {* The following @{text "hRAG"} is the holding sub-graph of @{text "RAG"}. *} |
|
25 definition "hRAG (s::state) = {(Cs cs, Th th) | th cs. holding s th cs}" |
|
26 |
|
27 text {* The following lemma splits @{term "RAG"} graph into the above two sub-graphs. *} |
|
28 lemma RAG_split: "RAG s = (wRAG s \<union> hRAG s)" |
|
29 by (unfold s_RAG_abv wRAG_def hRAG_def s_waiting_abv |
|
30 s_holding_abv cs_RAG_def, auto) |
|
31 |
|
32 text {* |
|
33 The following @{text "tRAG"} is the thread-graph derived from @{term "RAG"}. |
|
34 It characterizes the dependency between threads when calculating current |
|
35 precedences. It is defined as the composition of the above two sub-graphs, |
|
36 names @{term "wRAG"} and @{term "hRAG"}. |
|
37 *} |
|
38 definition "tRAG s = wRAG s O hRAG s" |
|
39 |
|
40 (* ccc *) |
|
41 |
|
42 definition "cp_gen s x = |
|
43 Max ((the_preced s \<circ> the_thread) ` subtree (tRAG s) x)" |
|
44 |
3205 |
45 lemma tRAG_alt_def: |
3206 lemma tRAG_alt_def: |
46 "tRAG s = {(Th th1, Th th2) | th1 th2. |
3207 "tRAG s = {(Th th1, Th th2) | th1 th2. |
47 \<exists> cs. (Th th1, Cs cs) \<in> RAG s \<and> (Cs cs, Th th2) \<in> RAG s}" |
3208 \<exists> cs. (Th th1, Cs cs) \<in> RAG s \<and> (Cs cs, Th th2) \<in> RAG s}" |
48 by (auto simp:tRAG_def RAG_split wRAG_def hRAG_def) |
3209 by (auto simp:tRAG_def RAG_split wRAG_def hRAG_def) |
727 |
3886 |
728 -- {* A useless definition *} |
3887 -- {* A useless definition *} |
729 definition cps:: "state \<Rightarrow> (thread \<times> precedence) set" |
3888 definition cps:: "state \<Rightarrow> (thread \<times> precedence) set" |
730 where "cps s = {(th, cp s th) | th . th \<in> threads s}" |
3889 where "cps s = {(th, cp s th) | th . th \<in> threads s}" |
731 |
3890 |
732 |
|
733 text {* (* ddd *) |
|
734 One beauty of our modelling is that we follow the definitional extension tradition of HOL. |
|
735 The benefit of such a concise and miniature model is that large number of intuitively |
|
736 obvious facts are derived as lemmas, rather than asserted as axioms. |
|
737 *} |
|
738 |
|
739 text {* |
|
740 However, the lemmas in the forthcoming several locales are no longer |
|
741 obvious. These lemmas show how the current precedences should be recalculated |
|
742 after every execution step (in our model, every step is represented by an event, |
|
743 which in turn, represents a system call, or operation). Each operation is |
|
744 treated in a separate locale. |
|
745 |
|
746 The complication of current precedence recalculation comes |
|
747 because the changing of RAG needs to be taken into account, |
|
748 in addition to the changing of precedence. |
|
749 The reason RAG changing affects current precedence is that, |
|
750 according to the definition, current precedence |
|
751 of a thread is the maximum of the precedences of its dependants, |
|
752 where the dependants are defined in terms of RAG. |
|
753 |
|
754 Therefore, each operation, lemmas concerning the change of the precedences |
|
755 and RAG are derived first, so that the lemmas about |
|
756 current precedence recalculation can be based on. |
|
757 *} |
|
758 |
|
759 text {* (* ddd *) |
|
760 The following locale @{text "step_set_cps"} investigates the recalculation |
|
761 after the @{text "Set"} operation. |
|
762 *} |
|
763 locale step_set_cps = |
|
764 fixes s' th prio s |
|
765 -- {* @{text "s'"} is the system state before the operation *} |
|
766 -- {* @{text "s"} is the system state after the operation *} |
|
767 defines s_def : "s \<equiv> (Set th prio#s')" |
|
768 -- {* @{text "s"} is assumed to be a legitimate state, from which |
|
769 the legitimacy of @{text "s"} can be derived. *} |
|
770 assumes vt_s: "vt s" |
|
771 |
|
772 sublocale step_set_cps < vat_s : valid_trace "s" |
|
773 proof |
|
774 from vt_s show "vt s" . |
|
775 qed |
|
776 |
|
777 sublocale step_set_cps < vat_s' : valid_trace "s'" |
|
778 proof |
|
779 from step_back_vt[OF vt_s[unfolded s_def]] show "vt s'" . |
|
780 qed |
|
781 |
|
782 context step_set_cps |
|
783 begin |
|
784 |
|
785 text {* (* ddd *) |
|
786 The following two lemmas confirm that @{text "Set"}-operating only changes the precedence |
|
787 of the initiating thread. |
|
788 *} |
|
789 |
|
790 lemma eq_preced: |
|
791 assumes "th' \<noteq> th" |
|
792 shows "preced th' s = preced th' s'" |
|
793 proof - |
|
794 from assms show ?thesis |
|
795 by (unfold s_def, auto simp:preced_def) |
|
796 qed |
|
797 |
|
798 lemma eq_the_preced: |
|
799 fixes th' |
|
800 assumes "th' \<noteq> th" |
|
801 shows "the_preced s th' = the_preced s' th'" |
|
802 using assms |
|
803 by (unfold the_preced_def, intro eq_preced, simp) |
|
804 |
|
805 text {* |
|
806 The following lemma assures that the resetting of priority does not change the RAG. |
|
807 *} |
|
808 |
|
809 lemma eq_dep: "RAG s = RAG s'" |
|
810 by (unfold s_def RAG_set_unchanged, auto) |
|
811 |
|
812 text {* (* ddd *) |
|
813 Th following lemma @{text "eq_cp_pre"} says the priority change of @{text "th"} |
|
814 only affects those threads, which as @{text "Th th"} in their sub-trees. |
|
815 |
|
816 The proof of this lemma is simplified by using the alternative definition of @{text "cp"}. |
|
817 *} |
|
818 |
|
819 lemma eq_cp_pre: |
|
820 fixes th' |
|
821 assumes nd: "Th th \<notin> subtree (RAG s') (Th th')" |
|
822 shows "cp s th' = cp s' th'" |
|
823 proof - |
|
824 -- {* After unfolding using the alternative definition, elements |
|
825 affecting the @{term "cp"}-value of threads become explicit. |
|
826 We only need to prove the following: *} |
|
827 have "Max (the_preced s ` {th'a. Th th'a \<in> subtree (RAG s) (Th th')}) = |
|
828 Max (the_preced s' ` {th'a. Th th'a \<in> subtree (RAG s') (Th th')})" |
|
829 (is "Max (?f ` ?S1) = Max (?g ` ?S2)") |
|
830 proof - |
|
831 -- {* The base sets are equal. *} |
|
832 have "?S1 = ?S2" using eq_dep by simp |
|
833 -- {* The function values on the base set are equal as well. *} |
|
834 moreover have "\<forall> e \<in> ?S2. ?f e = ?g e" |
|
835 proof |
|
836 fix th1 |
|
837 assume "th1 \<in> ?S2" |
|
838 with nd have "th1 \<noteq> th" by (auto) |
|
839 from eq_the_preced[OF this] |
|
840 show "the_preced s th1 = the_preced s' th1" . |
|
841 qed |
|
842 -- {* Therefore, the image of the functions are equal. *} |
|
843 ultimately have "(?f ` ?S1) = (?g ` ?S2)" by (auto intro!:f_image_eq) |
|
844 thus ?thesis by simp |
|
845 qed |
|
846 thus ?thesis by (simp add:cp_alt_def) |
|
847 qed |
|
848 |
|
849 text {* |
|
850 The following lemma shows that @{term "th"} is not in the |
|
851 sub-tree of any other thread. |
|
852 *} |
|
853 lemma th_in_no_subtree: |
|
854 assumes "th' \<noteq> th" |
|
855 shows "Th th \<notin> subtree (RAG s') (Th th')" |
|
856 proof - |
|
857 have "th \<in> readys s'" |
|
858 proof - |
|
859 from step_back_step [OF vt_s[unfolded s_def]] |
|
860 have "step s' (Set th prio)" . |
|
861 hence "th \<in> runing s'" by (cases, simp) |
|
862 thus ?thesis by (simp add:readys_def runing_def) |
|
863 qed |
|
864 find_theorems readys subtree |
|
865 from vat_s'.readys_in_no_subtree[OF this assms(1)] |
|
866 show ?thesis by blast |
|
867 qed |
|
868 |
|
869 text {* |
|
870 By combining @{thm "eq_cp_pre"} and @{thm "th_in_no_subtree"}, |
|
871 it is obvious that the change of priority only affects the @{text "cp"}-value |
|
872 of the initiating thread @{text "th"}. |
|
873 *} |
|
874 lemma eq_cp: |
|
875 fixes th' |
|
876 assumes "th' \<noteq> th" |
|
877 shows "cp s th' = cp s' th'" |
|
878 by (rule eq_cp_pre[OF th_in_no_subtree[OF assms]]) |
|
879 |
|
880 end |
3891 end |
881 |
|
882 text {* |
|
883 The following @{text "step_v_cps"} is the locale for @{text "V"}-operation. |
|
884 *} |
|
885 |
|
886 locale step_v_cps = |
|
887 -- {* @{text "th"} is the initiating thread *} |
|
888 -- {* @{text "cs"} is the critical resource release by the @{text "V"}-operation *} |
|
889 fixes s' th cs s -- {* @{text "s'"} is the state before operation*} |
|
890 defines s_def : "s \<equiv> (V th cs#s')" -- {* @{text "s"} is the state after operation*} |
|
891 -- {* @{text "s"} is assumed to be valid, which implies the validity of @{text "s'"} *} |
|
892 assumes vt_s: "vt s" |
|
893 |
|
894 sublocale step_v_cps < vat_s : valid_trace "s" |
|
895 proof |
|
896 from vt_s show "vt s" . |
|
897 qed |
|
898 |
|
899 sublocale step_v_cps < vat_s' : valid_trace "s'" |
|
900 proof |
|
901 from step_back_vt[OF vt_s[unfolded s_def]] show "vt s'" . |
|
902 qed |
|
903 |
|
904 context step_v_cps |
|
905 begin |
|
906 |
|
907 lemma ready_th_s': "th \<in> readys s'" |
|
908 using step_back_step[OF vt_s[unfolded s_def]] |
|
909 by (cases, simp add:runing_def) |
|
910 |
|
911 lemma ancestors_th: "ancestors (RAG s') (Th th) = {}" |
|
912 proof - |
|
913 from vat_s'.readys_root[OF ready_th_s'] |
|
914 show ?thesis |
|
915 by (unfold root_def, simp) |
|
916 qed |
|
917 |
|
918 lemma holding_th: "holding s' th cs" |
|
919 proof - |
|
920 from vt_s[unfolded s_def] |
|
921 have " PIP s' (V th cs)" by (cases, simp) |
|
922 thus ?thesis by (cases, auto) |
|
923 qed |
|
924 |
|
925 lemma edge_of_th: |
|
926 "(Cs cs, Th th) \<in> RAG s'" |
|
927 proof - |
|
928 from holding_th |
|
929 show ?thesis |
|
930 by (unfold s_RAG_def holding_eq, auto) |
|
931 qed |
|
932 |
|
933 lemma ancestors_cs: |
|
934 "ancestors (RAG s') (Cs cs) = {Th th}" |
|
935 proof - |
|
936 have "ancestors (RAG s') (Cs cs) = ancestors (RAG s') (Th th) \<union> {Th th}" |
|
937 proof(rule vat_s'.rtree_RAG.ancestors_accum) |
|
938 from vt_s[unfolded s_def] |
|
939 have " PIP s' (V th cs)" by (cases, simp) |
|
940 thus "(Cs cs, Th th) \<in> RAG s'" |
|
941 proof(cases) |
|
942 assume "holding s' th cs" |
|
943 from this[unfolded holding_eq] |
|
944 show ?thesis by (unfold s_RAG_def, auto) |
|
945 qed |
|
946 qed |
|
947 from this[unfolded ancestors_th] show ?thesis by simp |
|
948 qed |
|
949 |
|
950 lemma preced_kept: "the_preced s = the_preced s'" |
|
951 by (auto simp: s_def the_preced_def preced_def) |
|
952 |
|
953 end |
|
954 |
|
955 text {* |
|
956 The following @{text "step_v_cps_nt"} is the sub-locale for @{text "V"}-operation, |
|
957 which represents the case when there is another thread @{text "th'"} |
|
958 to take over the critical resource released by the initiating thread @{text "th"}. |
|
959 *} |
|
960 locale step_v_cps_nt = step_v_cps + |
|
961 fixes th' |
|
962 -- {* @{text "th'"} is assumed to take over @{text "cs"} *} |
|
963 assumes nt: "next_th s' th cs th'" |
|
964 |
|
965 context step_v_cps_nt |
|
966 begin |
|
967 |
|
968 text {* |
|
969 Lemma @{text "RAG_s"} confirms the change of RAG: |
|
970 two edges removed and one added, as shown by the following diagram. |
|
971 *} |
|
972 |
|
973 (* |
|
974 RAG before the V-operation |
|
975 th1 ----| |
|
976 | |
|
977 th' ----| |
|
978 |----> cs -----| |
|
979 th2 ----| | |
|
980 | | |
|
981 th3 ----| | |
|
982 |------> th |
|
983 th4 ----| | |
|
984 | | |
|
985 th5 ----| | |
|
986 |----> cs'-----| |
|
987 th6 ----| |
|
988 | |
|
989 th7 ----| |
|
990 |
|
991 RAG after the V-operation |
|
992 th1 ----| |
|
993 | |
|
994 |----> cs ----> th' |
|
995 th2 ----| |
|
996 | |
|
997 th3 ----| |
|
998 |
|
999 th4 ----| |
|
1000 | |
|
1001 th5 ----| |
|
1002 |----> cs'----> th |
|
1003 th6 ----| |
|
1004 | |
|
1005 th7 ----| |
|
1006 *) |
|
1007 |
|
1008 lemma sub_RAGs': "{(Cs cs, Th th), (Th th', Cs cs)} \<subseteq> RAG s'" |
|
1009 using next_th_RAG[OF nt] . |
|
1010 |
|
1011 lemma ancestors_th': |
|
1012 "ancestors (RAG s') (Th th') = {Th th, Cs cs}" |
|
1013 proof - |
|
1014 have "ancestors (RAG s') (Th th') = ancestors (RAG s') (Cs cs) \<union> {Cs cs}" |
|
1015 proof(rule vat_s'.rtree_RAG.ancestors_accum) |
|
1016 from sub_RAGs' show "(Th th', Cs cs) \<in> RAG s'" by auto |
|
1017 qed |
|
1018 thus ?thesis using ancestors_th ancestors_cs by auto |
|
1019 qed |
|
1020 |
|
1021 lemma RAG_s: |
|
1022 "RAG s = (RAG s' - {(Cs cs, Th th), (Th th', Cs cs)}) \<union> |
|
1023 {(Cs cs, Th th')}" |
|
1024 proof - |
|
1025 from step_RAG_v[OF vt_s[unfolded s_def], folded s_def] |
|
1026 and nt show ?thesis by (auto intro:next_th_unique) |
|
1027 qed |
|
1028 |
|
1029 lemma subtree_kept: |
|
1030 assumes "th1 \<notin> {th, th'}" |
|
1031 shows "subtree (RAG s) (Th th1) = subtree (RAG s') (Th th1)" (is "_ = ?R") |
|
1032 proof - |
|
1033 let ?RAG' = "(RAG s' - {(Cs cs, Th th), (Th th', Cs cs)})" |
|
1034 let ?RAG'' = "?RAG' \<union> {(Cs cs, Th th')}" |
|
1035 have "subtree ?RAG' (Th th1) = ?R" |
|
1036 proof(rule subset_del_subtree_outside) |
|
1037 show "Range {(Cs cs, Th th), (Th th', Cs cs)} \<inter> subtree (RAG s') (Th th1) = {}" |
|
1038 proof - |
|
1039 have "(Th th) \<notin> subtree (RAG s') (Th th1)" |
|
1040 proof(rule subtree_refute) |
|
1041 show "Th th1 \<notin> ancestors (RAG s') (Th th)" |
|
1042 by (unfold ancestors_th, simp) |
|
1043 next |
|
1044 from assms show "Th th1 \<noteq> Th th" by simp |
|
1045 qed |
|
1046 moreover have "(Cs cs) \<notin> subtree (RAG s') (Th th1)" |
|
1047 proof(rule subtree_refute) |
|
1048 show "Th th1 \<notin> ancestors (RAG s') (Cs cs)" |
|
1049 by (unfold ancestors_cs, insert assms, auto) |
|
1050 qed simp |
|
1051 ultimately have "{Th th, Cs cs} \<inter> subtree (RAG s') (Th th1) = {}" by auto |
|
1052 thus ?thesis by simp |
|
1053 qed |
|
1054 qed |
|
1055 moreover have "subtree ?RAG'' (Th th1) = subtree ?RAG' (Th th1)" |
|
1056 proof(rule subtree_insert_next) |
|
1057 show "Th th' \<notin> subtree (RAG s' - {(Cs cs, Th th), (Th th', Cs cs)}) (Th th1)" |
|
1058 proof(rule subtree_refute) |
|
1059 show "Th th1 \<notin> ancestors (RAG s' - {(Cs cs, Th th), (Th th', Cs cs)}) (Th th')" |
|
1060 (is "_ \<notin> ?R") |
|
1061 proof - |
|
1062 have "?R \<subseteq> ancestors (RAG s') (Th th')" by (rule ancestors_mono, auto) |
|
1063 moreover have "Th th1 \<notin> ..." using ancestors_th' assms by simp |
|
1064 ultimately show ?thesis by auto |
|
1065 qed |
|
1066 next |
|
1067 from assms show "Th th1 \<noteq> Th th'" by simp |
|
1068 qed |
|
1069 qed |
|
1070 ultimately show ?thesis by (unfold RAG_s, simp) |
|
1071 qed |
|
1072 |
|
1073 lemma cp_kept: |
|
1074 assumes "th1 \<notin> {th, th'}" |
|
1075 shows "cp s th1 = cp s' th1" |
|
1076 by (unfold cp_alt_def preced_kept subtree_kept[OF assms], simp) |
|
1077 |
|
1078 end |
|
1079 |
|
1080 locale step_v_cps_nnt = step_v_cps + |
|
1081 assumes nnt: "\<And> th'. (\<not> next_th s' th cs th')" |
|
1082 |
|
1083 context step_v_cps_nnt |
|
1084 begin |
|
1085 |
|
1086 lemma RAG_s: "RAG s = RAG s' - {(Cs cs, Th th)}" |
|
1087 proof - |
|
1088 from nnt and step_RAG_v[OF vt_s[unfolded s_def], folded s_def] |
|
1089 show ?thesis by auto |
|
1090 qed |
|
1091 |
|
1092 lemma subtree_kept: |
|
1093 assumes "th1 \<noteq> th" |
|
1094 shows "subtree (RAG s) (Th th1) = subtree (RAG s') (Th th1)" |
|
1095 proof(unfold RAG_s, rule subset_del_subtree_outside) |
|
1096 show "Range {(Cs cs, Th th)} \<inter> subtree (RAG s') (Th th1) = {}" |
|
1097 proof - |
|
1098 have "(Th th) \<notin> subtree (RAG s') (Th th1)" |
|
1099 proof(rule subtree_refute) |
|
1100 show "Th th1 \<notin> ancestors (RAG s') (Th th)" |
|
1101 by (unfold ancestors_th, simp) |
|
1102 next |
|
1103 from assms show "Th th1 \<noteq> Th th" by simp |
|
1104 qed |
|
1105 thus ?thesis by auto |
|
1106 qed |
|
1107 qed |
|
1108 |
|
1109 lemma cp_kept_1: |
|
1110 assumes "th1 \<noteq> th" |
|
1111 shows "cp s th1 = cp s' th1" |
|
1112 by (unfold cp_alt_def preced_kept subtree_kept[OF assms], simp) |
|
1113 |
|
1114 lemma subtree_cs: "subtree (RAG s') (Cs cs) = {Cs cs}" |
|
1115 proof - |
|
1116 { fix n |
|
1117 have "(Cs cs) \<notin> ancestors (RAG s') n" |
|
1118 proof |
|
1119 assume "Cs cs \<in> ancestors (RAG s') n" |
|
1120 hence "(n, Cs cs) \<in> (RAG s')^+" by (auto simp:ancestors_def) |
|
1121 from tranclE[OF this] obtain nn where h: "(nn, Cs cs) \<in> RAG s'" by auto |
|
1122 then obtain th' where "nn = Th th'" |
|
1123 by (unfold s_RAG_def, auto) |
|
1124 from h[unfolded this] have "(Th th', Cs cs) \<in> RAG s'" . |
|
1125 from this[unfolded s_RAG_def] |
|
1126 have "waiting (wq s') th' cs" by auto |
|
1127 from this[unfolded cs_waiting_def] |
|
1128 have "1 < length (wq s' cs)" |
|
1129 by (cases "wq s' cs", auto) |
|
1130 from holding_next_thI[OF holding_th this] |
|
1131 obtain th' where "next_th s' th cs th'" by auto |
|
1132 with nnt show False by auto |
|
1133 qed |
|
1134 } note h = this |
|
1135 { fix n |
|
1136 assume "n \<in> subtree (RAG s') (Cs cs)" |
|
1137 hence "n = (Cs cs)" |
|
1138 by (elim subtreeE, insert h, auto) |
|
1139 } moreover have "(Cs cs) \<in> subtree (RAG s') (Cs cs)" |
|
1140 by (auto simp:subtree_def) |
|
1141 ultimately show ?thesis by auto |
|
1142 qed |
|
1143 |
|
1144 lemma subtree_th: |
|
1145 "subtree (RAG s) (Th th) = subtree (RAG s') (Th th) - {Cs cs}" |
|
1146 find_theorems "subtree" "_ - _" RAG |
|
1147 proof(unfold RAG_s, fold subtree_cs, rule vat_s'.rtree_RAG.subtree_del_inside) |
|
1148 from edge_of_th |
|
1149 show "(Cs cs, Th th) \<in> edges_in (RAG s') (Th th)" |
|
1150 by (unfold edges_in_def, auto simp:subtree_def) |
|
1151 qed |
|
1152 |
|
1153 lemma cp_kept_2: |
|
1154 shows "cp s th = cp s' th" |
|
1155 by (unfold cp_alt_def subtree_th preced_kept, auto) |
|
1156 |
|
1157 lemma eq_cp: |
|
1158 fixes th' |
|
1159 shows "cp s th' = cp s' th'" |
|
1160 using cp_kept_1 cp_kept_2 |
|
1161 by (cases "th' = th", auto) |
|
1162 end |
|
1163 |
|
1164 |
|
1165 locale step_P_cps = |
|
1166 fixes s' th cs s |
|
1167 defines s_def : "s \<equiv> (P th cs#s')" |
|
1168 assumes vt_s: "vt s" |
|
1169 |
|
1170 sublocale step_P_cps < vat_s : valid_trace "s" |
|
1171 proof |
|
1172 from vt_s show "vt s" . |
|
1173 qed |
|
1174 |
|
1175 sublocale step_P_cps < vat_s' : valid_trace "s'" |
|
1176 proof |
|
1177 from step_back_vt[OF vt_s[unfolded s_def]] show "vt s'" . |
|
1178 qed |
|
1179 |
|
1180 context step_P_cps |
|
1181 begin |
|
1182 |
|
1183 lemma readys_th: "th \<in> readys s'" |
|
1184 proof - |
|
1185 from step_back_step [OF vt_s[unfolded s_def]] |
|
1186 have "PIP s' (P th cs)" . |
|
1187 hence "th \<in> runing s'" by (cases, simp) |
|
1188 thus ?thesis by (simp add:readys_def runing_def) |
|
1189 qed |
|
1190 |
|
1191 lemma root_th: "root (RAG s') (Th th)" |
|
1192 using readys_root[OF readys_th] . |
|
1193 |
|
1194 lemma in_no_others_subtree: |
|
1195 assumes "th' \<noteq> th" |
|
1196 shows "Th th \<notin> subtree (RAG s') (Th th')" |
|
1197 proof |
|
1198 assume "Th th \<in> subtree (RAG s') (Th th')" |
|
1199 thus False |
|
1200 proof(cases rule:subtreeE) |
|
1201 case 1 |
|
1202 with assms show ?thesis by auto |
|
1203 next |
|
1204 case 2 |
|
1205 with root_th show ?thesis by (auto simp:root_def) |
|
1206 qed |
|
1207 qed |
|
1208 |
|
1209 lemma preced_kept: "the_preced s = the_preced s'" |
|
1210 by (auto simp: s_def the_preced_def preced_def) |
|
1211 |
|
1212 end |
|
1213 |
|
1214 locale step_P_cps_ne =step_P_cps + |
|
1215 fixes th' |
|
1216 assumes ne: "wq s' cs \<noteq> []" |
|
1217 defines th'_def: "th' \<equiv> hd (wq s' cs)" |
|
1218 |
|
1219 locale step_P_cps_e =step_P_cps + |
|
1220 assumes ee: "wq s' cs = []" |
|
1221 |
|
1222 context step_P_cps_e |
|
1223 begin |
|
1224 |
|
1225 lemma RAG_s: "RAG s = RAG s' \<union> {(Cs cs, Th th)}" |
|
1226 proof - |
|
1227 from ee and step_RAG_p[OF vt_s[unfolded s_def], folded s_def] |
|
1228 show ?thesis by auto |
|
1229 qed |
|
1230 |
|
1231 lemma subtree_kept: |
|
1232 assumes "th' \<noteq> th" |
|
1233 shows "subtree (RAG s) (Th th') = subtree (RAG s') (Th th')" |
|
1234 proof(unfold RAG_s, rule subtree_insert_next) |
|
1235 from in_no_others_subtree[OF assms] |
|
1236 show "Th th \<notin> subtree (RAG s') (Th th')" . |
|
1237 qed |
|
1238 |
|
1239 lemma cp_kept: |
|
1240 assumes "th' \<noteq> th" |
|
1241 shows "cp s th' = cp s' th'" |
|
1242 proof - |
|
1243 have "(the_preced s ` {th'a. Th th'a \<in> subtree (RAG s) (Th th')}) = |
|
1244 (the_preced s' ` {th'a. Th th'a \<in> subtree (RAG s') (Th th')})" |
|
1245 by (unfold preced_kept subtree_kept[OF assms], simp) |
|
1246 thus ?thesis by (unfold cp_alt_def, simp) |
|
1247 qed |
|
1248 |
|
1249 end |
|
1250 |
|
1251 context step_P_cps_ne |
|
1252 begin |
|
1253 |
|
1254 lemma RAG_s: "RAG s = RAG s' \<union> {(Th th, Cs cs)}" |
|
1255 proof - |
|
1256 from step_RAG_p[OF vt_s[unfolded s_def]] and ne |
|
1257 show ?thesis by (simp add:s_def) |
|
1258 qed |
|
1259 |
|
1260 lemma cs_held: "(Cs cs, Th th') \<in> RAG s'" |
|
1261 proof - |
|
1262 have "(Cs cs, Th th') \<in> hRAG s'" |
|
1263 proof - |
|
1264 from ne |
|
1265 have " holding s' th' cs" |
|
1266 by (unfold th'_def holding_eq cs_holding_def, auto) |
|
1267 thus ?thesis |
|
1268 by (unfold hRAG_def, auto) |
|
1269 qed |
|
1270 thus ?thesis by (unfold RAG_split, auto) |
|
1271 qed |
|
1272 |
|
1273 lemma tRAG_s: |
|
1274 "tRAG s = tRAG s' \<union> {(Th th, Th th')}" |
|
1275 using RAG_tRAG_transfer[OF RAG_s cs_held] . |
|
1276 |
|
1277 lemma cp_kept: |
|
1278 assumes "Th th'' \<notin> ancestors (tRAG s) (Th th)" |
|
1279 shows "cp s th'' = cp s' th''" |
|
1280 proof - |
|
1281 have h: "subtree (tRAG s) (Th th'') = subtree (tRAG s') (Th th'')" |
|
1282 proof - |
|
1283 have "Th th' \<notin> subtree (tRAG s') (Th th'')" |
|
1284 proof |
|
1285 assume "Th th' \<in> subtree (tRAG s') (Th th'')" |
|
1286 thus False |
|
1287 proof(rule subtreeE) |
|
1288 assume "Th th' = Th th''" |
|
1289 from assms[unfolded tRAG_s ancestors_def, folded this] |
|
1290 show ?thesis by auto |
|
1291 next |
|
1292 assume "Th th'' \<in> ancestors (tRAG s') (Th th')" |
|
1293 moreover have "... \<subseteq> ancestors (tRAG s) (Th th')" |
|
1294 proof(rule ancestors_mono) |
|
1295 show "tRAG s' \<subseteq> tRAG s" by (unfold tRAG_s, auto) |
|
1296 qed |
|
1297 ultimately have "Th th'' \<in> ancestors (tRAG s) (Th th')" by auto |
|
1298 moreover have "Th th' \<in> ancestors (tRAG s) (Th th)" |
|
1299 by (unfold tRAG_s, auto simp:ancestors_def) |
|
1300 ultimately have "Th th'' \<in> ancestors (tRAG s) (Th th)" |
|
1301 by (auto simp:ancestors_def) |
|
1302 with assms show ?thesis by auto |
|
1303 qed |
|
1304 qed |
|
1305 from subtree_insert_next[OF this] |
|
1306 have "subtree (tRAG s' \<union> {(Th th, Th th')}) (Th th'') = subtree (tRAG s') (Th th'')" . |
|
1307 from this[folded tRAG_s] show ?thesis . |
|
1308 qed |
|
1309 show ?thesis by (unfold cp_alt_def1 h preced_kept, simp) |
|
1310 qed |
|
1311 |
|
1312 lemma cp_gen_update_stop: (* ddd *) |
|
1313 assumes "u \<in> ancestors (tRAG s) (Th th)" |
|
1314 and "cp_gen s u = cp_gen s' u" |
|
1315 and "y \<in> ancestors (tRAG s) u" |
|
1316 shows "cp_gen s y = cp_gen s' y" |
|
1317 using assms(3) |
|
1318 proof(induct rule:wf_induct[OF vat_s.fsbttRAGs.wf]) |
|
1319 case (1 x) |
|
1320 show ?case (is "?L = ?R") |
|
1321 proof - |
|
1322 from tRAG_ancestorsE[OF 1(2)] |
|
1323 obtain th2 where eq_x: "x = Th th2" by blast |
|
1324 from vat_s.cp_gen_rec[OF this] |
|
1325 have "?L = |
|
1326 Max ({the_preced s th2} \<union> cp_gen s ` RTree.children (tRAG s) x)" . |
|
1327 also have "... = |
|
1328 Max ({the_preced s' th2} \<union> cp_gen s' ` RTree.children (tRAG s') x)" |
|
1329 |
|
1330 proof - |
|
1331 from preced_kept have "the_preced s th2 = the_preced s' th2" by simp |
|
1332 moreover have "cp_gen s ` RTree.children (tRAG s) x = |
|
1333 cp_gen s' ` RTree.children (tRAG s') x" |
|
1334 proof - |
|
1335 have "RTree.children (tRAG s) x = RTree.children (tRAG s') x" |
|
1336 proof(unfold tRAG_s, rule children_union_kept) |
|
1337 have start: "(Th th, Th th') \<in> tRAG s" |
|
1338 by (unfold tRAG_s, auto) |
|
1339 note x_u = 1(2) |
|
1340 show "x \<notin> Range {(Th th, Th th')}" |
|
1341 proof |
|
1342 assume "x \<in> Range {(Th th, Th th')}" |
|
1343 hence eq_x: "x = Th th'" using RangeE by auto |
|
1344 show False |
|
1345 proof(cases rule:vat_s.rtree_s.ancestors_headE[OF assms(1) start]) |
|
1346 case 1 |
|
1347 from x_u[folded this, unfolded eq_x] vat_s.acyclic_tRAG |
|
1348 show ?thesis by (auto simp:ancestors_def acyclic_def) |
|
1349 next |
|
1350 case 2 |
|
1351 with x_u[unfolded eq_x] |
|
1352 have "(Th th', Th th') \<in> (tRAG s)^+" by (auto simp:ancestors_def) |
|
1353 with vat_s.acyclic_tRAG show ?thesis by (auto simp:acyclic_def) |
|
1354 qed |
|
1355 qed |
|
1356 qed |
|
1357 moreover have "cp_gen s ` RTree.children (tRAG s) x = |
|
1358 cp_gen s' ` RTree.children (tRAG s) x" (is "?f ` ?A = ?g ` ?A") |
|
1359 proof(rule f_image_eq) |
|
1360 fix a |
|
1361 assume a_in: "a \<in> ?A" |
|
1362 from 1(2) |
|
1363 show "?f a = ?g a" |
|
1364 proof(cases rule:vat_s.rtree_s.ancestors_childrenE[case_names in_ch out_ch]) |
|
1365 case in_ch |
|
1366 show ?thesis |
|
1367 proof(cases "a = u") |
|
1368 case True |
|
1369 from assms(2)[folded this] show ?thesis . |
|
1370 next |
|
1371 case False |
|
1372 have a_not_in: "a \<notin> ancestors (tRAG s) (Th th)" |
|
1373 proof |
|
1374 assume a_in': "a \<in> ancestors (tRAG s) (Th th)" |
|
1375 have "a = u" |
|
1376 proof(rule vat_s.rtree_s.ancestors_children_unique) |
|
1377 from a_in' a_in show "a \<in> ancestors (tRAG s) (Th th) \<inter> |
|
1378 RTree.children (tRAG s) x" by auto |
|
1379 next |
|
1380 from assms(1) in_ch show "u \<in> ancestors (tRAG s) (Th th) \<inter> |
|
1381 RTree.children (tRAG s) x" by auto |
|
1382 qed |
|
1383 with False show False by simp |
|
1384 qed |
|
1385 from a_in obtain th_a where eq_a: "a = Th th_a" |
|
1386 by (unfold RTree.children_def tRAG_alt_def, auto) |
|
1387 from cp_kept[OF a_not_in[unfolded eq_a]] |
|
1388 have "cp s th_a = cp s' th_a" . |
|
1389 from this [unfolded cp_gen_def_cond[OF eq_a], folded eq_a] |
|
1390 show ?thesis . |
|
1391 qed |
|
1392 next |
|
1393 case (out_ch z) |
|
1394 hence h: "z \<in> ancestors (tRAG s) u" "z \<in> RTree.children (tRAG s) x" by auto |
|
1395 show ?thesis |
|
1396 proof(cases "a = z") |
|
1397 case True |
|
1398 from h(2) have zx_in: "(z, x) \<in> (tRAG s)" by (auto simp:RTree.children_def) |
|
1399 from 1(1)[rule_format, OF this h(1)] |
|
1400 have eq_cp_gen: "cp_gen s z = cp_gen s' z" . |
|
1401 with True show ?thesis by metis |
|
1402 next |
|
1403 case False |
|
1404 from a_in obtain th_a where eq_a: "a = Th th_a" |
|
1405 by (auto simp:RTree.children_def tRAG_alt_def) |
|
1406 have "a \<notin> ancestors (tRAG s) (Th th)" |
|
1407 proof |
|
1408 assume a_in': "a \<in> ancestors (tRAG s) (Th th)" |
|
1409 have "a = z" |
|
1410 proof(rule vat_s.rtree_s.ancestors_children_unique) |
|
1411 from assms(1) h(1) have "z \<in> ancestors (tRAG s) (Th th)" |
|
1412 by (auto simp:ancestors_def) |
|
1413 with h(2) show " z \<in> ancestors (tRAG s) (Th th) \<inter> |
|
1414 RTree.children (tRAG s) x" by auto |
|
1415 next |
|
1416 from a_in a_in' |
|
1417 show "a \<in> ancestors (tRAG s) (Th th) \<inter> RTree.children (tRAG s) x" |
|
1418 by auto |
|
1419 qed |
|
1420 with False show False by auto |
|
1421 qed |
|
1422 from cp_kept[OF this[unfolded eq_a]] |
|
1423 have "cp s th_a = cp s' th_a" . |
|
1424 from this[unfolded cp_gen_def_cond[OF eq_a], folded eq_a] |
|
1425 show ?thesis . |
|
1426 qed |
|
1427 qed |
|
1428 qed |
|
1429 ultimately show ?thesis by metis |
|
1430 qed |
|
1431 ultimately show ?thesis by simp |
|
1432 qed |
|
1433 also have "... = ?R" |
|
1434 by (fold vat_s'.cp_gen_rec[OF eq_x], simp) |
|
1435 finally show ?thesis . |
|
1436 qed |
|
1437 qed |
|
1438 |
|
1439 lemma cp_up: |
|
1440 assumes "(Th th') \<in> ancestors (tRAG s) (Th th)" |
|
1441 and "cp s th' = cp s' th'" |
|
1442 and "(Th th'') \<in> ancestors (tRAG s) (Th th')" |
|
1443 shows "cp s th'' = cp s' th''" |
|
1444 proof - |
|
1445 have "cp_gen s (Th th'') = cp_gen s' (Th th'')" |
|
1446 proof(rule cp_gen_update_stop[OF assms(1) _ assms(3)]) |
|
1447 from assms(2) cp_gen_def_cond[OF refl[of "Th th'"]] |
|
1448 show "cp_gen s (Th th') = cp_gen s' (Th th')" by metis |
|
1449 qed |
|
1450 with cp_gen_def_cond[OF refl[of "Th th''"]] |
|
1451 show ?thesis by metis |
|
1452 qed |
|
1453 |
|
1454 end |
|
1455 |
|
1456 locale step_create_cps = |
|
1457 fixes s' th prio s |
|
1458 defines s_def : "s \<equiv> (Create th prio#s')" |
|
1459 assumes vt_s: "vt s" |
|
1460 |
|
1461 sublocale step_create_cps < vat_s: valid_trace "s" |
|
1462 by (unfold_locales, insert vt_s, simp) |
|
1463 |
|
1464 sublocale step_create_cps < vat_s': valid_trace "s'" |
|
1465 by (unfold_locales, insert step_back_vt[OF vt_s[unfolded s_def]], simp) |
|
1466 |
|
1467 context step_create_cps |
|
1468 begin |
|
1469 |
|
1470 lemma RAG_kept: "RAG s = RAG s'" |
|
1471 by (unfold s_def RAG_create_unchanged, auto) |
|
1472 |
|
1473 lemma tRAG_kept: "tRAG s = tRAG s'" |
|
1474 by (unfold tRAG_alt_def RAG_kept, auto) |
|
1475 |
|
1476 lemma preced_kept: |
|
1477 assumes "th' \<noteq> th" |
|
1478 shows "the_preced s th' = the_preced s' th'" |
|
1479 by (unfold s_def the_preced_def preced_def, insert assms, auto) |
|
1480 |
|
1481 lemma th_not_in: "Th th \<notin> Field (tRAG s')" |
|
1482 proof - |
|
1483 from vt_s[unfolded s_def] |
|
1484 have "PIP s' (Create th prio)" by (cases, simp) |
|
1485 hence "th \<notin> threads s'" by(cases, simp) |
|
1486 from vat_s'.not_in_thread_isolated[OF this] |
|
1487 have "Th th \<notin> Field (RAG s')" . |
|
1488 with tRAG_Field show ?thesis by auto |
|
1489 qed |
|
1490 |
|
1491 lemma eq_cp: |
|
1492 assumes neq_th: "th' \<noteq> th" |
|
1493 shows "cp s th' = cp s' th'" |
|
1494 proof - |
|
1495 have "(the_preced s \<circ> the_thread) ` subtree (tRAG s) (Th th') = |
|
1496 (the_preced s' \<circ> the_thread) ` subtree (tRAG s') (Th th')" |
|
1497 proof(unfold tRAG_kept, rule f_image_eq) |
|
1498 fix a |
|
1499 assume a_in: "a \<in> subtree (tRAG s') (Th th')" |
|
1500 then obtain th_a where eq_a: "a = Th th_a" |
|
1501 proof(cases rule:subtreeE) |
|
1502 case 2 |
|
1503 from ancestors_Field[OF 2(2)] |
|
1504 and that show ?thesis by (unfold tRAG_alt_def, auto) |
|
1505 qed auto |
|
1506 have neq_th_a: "th_a \<noteq> th" |
|
1507 proof - |
|
1508 have "(Th th) \<notin> subtree (tRAG s') (Th th')" |
|
1509 proof |
|
1510 assume "Th th \<in> subtree (tRAG s') (Th th')" |
|
1511 thus False |
|
1512 proof(cases rule:subtreeE) |
|
1513 case 2 |
|
1514 from ancestors_Field[OF this(2)] |
|
1515 and th_not_in[unfolded Field_def] |
|
1516 show ?thesis by auto |
|
1517 qed (insert assms, auto) |
|
1518 qed |
|
1519 with a_in[unfolded eq_a] show ?thesis by auto |
|
1520 qed |
|
1521 from preced_kept[OF this] |
|
1522 show "(the_preced s \<circ> the_thread) a = (the_preced s' \<circ> the_thread) a" |
|
1523 by (unfold eq_a, simp) |
|
1524 qed |
|
1525 thus ?thesis by (unfold cp_alt_def1, simp) |
|
1526 qed |
|
1527 |
|
1528 lemma children_of_th: "RTree.children (tRAG s) (Th th) = {}" |
|
1529 proof - |
|
1530 { fix a |
|
1531 assume "a \<in> RTree.children (tRAG s) (Th th)" |
|
1532 hence "(a, Th th) \<in> tRAG s" by (auto simp:RTree.children_def) |
|
1533 with th_not_in have False |
|
1534 by (unfold Field_def tRAG_kept, auto) |
|
1535 } thus ?thesis by auto |
|
1536 qed |
|
1537 |
|
1538 lemma eq_cp_th: "cp s th = preced th s" |
|
1539 by (unfold vat_s.cp_rec children_of_th, simp add:the_preced_def) |
|
1540 |
|
1541 end |
|
1542 |
|
1543 locale step_exit_cps = |
|
1544 fixes s' th prio s |
|
1545 defines s_def : "s \<equiv> Exit th # s'" |
|
1546 assumes vt_s: "vt s" |
|
1547 |
|
1548 sublocale step_exit_cps < vat_s: valid_trace "s" |
|
1549 by (unfold_locales, insert vt_s, simp) |
|
1550 |
|
1551 sublocale step_exit_cps < vat_s': valid_trace "s'" |
|
1552 by (unfold_locales, insert step_back_vt[OF vt_s[unfolded s_def]], simp) |
|
1553 |
|
1554 context step_exit_cps |
|
1555 begin |
|
1556 |
|
1557 lemma preced_kept: |
|
1558 assumes "th' \<noteq> th" |
|
1559 shows "the_preced s th' = the_preced s' th'" |
|
1560 by (unfold s_def the_preced_def preced_def, insert assms, auto) |
|
1561 |
|
1562 lemma RAG_kept: "RAG s = RAG s'" |
|
1563 by (unfold s_def RAG_exit_unchanged, auto) |
|
1564 |
|
1565 lemma tRAG_kept: "tRAG s = tRAG s'" |
|
1566 by (unfold tRAG_alt_def RAG_kept, auto) |
|
1567 |
|
1568 lemma th_ready: "th \<in> readys s'" |
|
1569 proof - |
|
1570 from vt_s[unfolded s_def] |
|
1571 have "PIP s' (Exit th)" by (cases, simp) |
|
1572 hence h: "th \<in> runing s' \<and> holdents s' th = {}" by (cases, metis) |
|
1573 thus ?thesis by (unfold runing_def, auto) |
|
1574 qed |
|
1575 |
|
1576 lemma th_holdents: "holdents s' th = {}" |
|
1577 proof - |
|
1578 from vt_s[unfolded s_def] |
|
1579 have "PIP s' (Exit th)" by (cases, simp) |
|
1580 thus ?thesis by (cases, metis) |
|
1581 qed |
|
1582 |
|
1583 lemma th_RAG: "Th th \<notin> Field (RAG s')" |
|
1584 proof - |
|
1585 have "Th th \<notin> Range (RAG s')" |
|
1586 proof |
|
1587 assume "Th th \<in> Range (RAG s')" |
|
1588 then obtain cs where "holding (wq s') th cs" |
|
1589 by (unfold Range_iff s_RAG_def, auto) |
|
1590 with th_holdents[unfolded holdents_def] |
|
1591 show False by (unfold eq_holding, auto) |
|
1592 qed |
|
1593 moreover have "Th th \<notin> Domain (RAG s')" |
|
1594 proof |
|
1595 assume "Th th \<in> Domain (RAG s')" |
|
1596 then obtain cs where "waiting (wq s') th cs" |
|
1597 by (unfold Domain_iff s_RAG_def, auto) |
|
1598 with th_ready show False by (unfold readys_def eq_waiting, auto) |
|
1599 qed |
|
1600 ultimately show ?thesis by (auto simp:Field_def) |
|
1601 qed |
|
1602 |
|
1603 lemma th_tRAG: "(Th th) \<notin> Field (tRAG s')" |
|
1604 using th_RAG tRAG_Field[of s'] by auto |
|
1605 |
|
1606 lemma eq_cp: |
|
1607 assumes neq_th: "th' \<noteq> th" |
|
1608 shows "cp s th' = cp s' th'" |
|
1609 proof - |
|
1610 have "(the_preced s \<circ> the_thread) ` subtree (tRAG s) (Th th') = |
|
1611 (the_preced s' \<circ> the_thread) ` subtree (tRAG s') (Th th')" |
|
1612 proof(unfold tRAG_kept, rule f_image_eq) |
|
1613 fix a |
|
1614 assume a_in: "a \<in> subtree (tRAG s') (Th th')" |
|
1615 then obtain th_a where eq_a: "a = Th th_a" |
|
1616 proof(cases rule:subtreeE) |
|
1617 case 2 |
|
1618 from ancestors_Field[OF 2(2)] |
|
1619 and that show ?thesis by (unfold tRAG_alt_def, auto) |
|
1620 qed auto |
|
1621 have neq_th_a: "th_a \<noteq> th" |
|
1622 proof - |
|
1623 find_theorems readys subtree s' |
|
1624 from vat_s'.readys_in_no_subtree[OF th_ready assms] |
|
1625 have "(Th th) \<notin> subtree (RAG s') (Th th')" . |
|
1626 with tRAG_subtree_RAG[of s' "Th th'"] |
|
1627 have "(Th th) \<notin> subtree (tRAG s') (Th th')" by auto |
|
1628 with a_in[unfolded eq_a] show ?thesis by auto |
|
1629 qed |
|
1630 from preced_kept[OF this] |
|
1631 show "(the_preced s \<circ> the_thread) a = (the_preced s' \<circ> the_thread) a" |
|
1632 by (unfold eq_a, simp) |
|
1633 qed |
|
1634 thus ?thesis by (unfold cp_alt_def1, simp) |
|
1635 qed |
|
1636 |
|
1637 end |
|
1638 |
|
1639 end |
|
1640 |
|