1217 |
1025 |
1218 section {* RAG and threads *} |
1026 section {* RAG and threads *} |
1219 |
1027 |
1220 context valid_trace |
1028 context valid_trace |
1221 begin |
1029 begin |
1222 lemma vt_moment: "\<And> t. vt (moment t s)" |
1030 |
1223 proof(induct rule:ind) |
|
1224 case Nil |
|
1225 thus ?case by (simp add:vt_nil) |
|
1226 next |
|
1227 case (Cons s e t) |
|
1228 show ?case |
|
1229 proof(cases "t \<ge> length (e#s)") |
|
1230 case True |
|
1231 from True have "moment t (e#s) = e#s" by simp |
|
1232 thus ?thesis using Cons |
|
1233 by (simp add:valid_trace_def) |
|
1234 next |
|
1235 case False |
|
1236 from Cons have "vt (moment t s)" by simp |
|
1237 moreover have "moment t (e#s) = moment t s" |
|
1238 proof - |
|
1239 from False have "t \<le> length s" by simp |
|
1240 from moment_app [OF this, of "[e]"] |
|
1241 show ?thesis by simp |
|
1242 qed |
|
1243 ultimately show ?thesis by simp |
|
1244 qed |
|
1245 qed |
|
1246 end |
|
1247 |
|
1248 locale valid_moment = valid_trace + |
|
1249 fixes i :: nat |
|
1250 |
|
1251 sublocale valid_moment < vat_moment: valid_trace "(moment i s)" |
|
1252 by (unfold_locales, insert vt_moment, auto) |
|
1253 |
|
1254 context valid_trace |
|
1255 begin |
|
1256 |
|
1257 <<<<<<< local |
|
1258 lemma dm_RAG_threads: |
1031 lemma dm_RAG_threads: |
1259 assumes in_dom: "(Th th) \<in> Domain (RAG s)" |
1032 assumes in_dom: "(Th th) \<in> Domain (RAG s)" |
1260 shows "th \<in> threads s" |
1033 shows "th \<in> threads s" |
1261 ======= |
1034 proof - |
1262 |
|
1263 text {* (* ddd *) |
|
1264 The nature of the work is like this: since it starts from a very simple and basic |
|
1265 model, even intuitively very `basic` and `obvious` properties need to derived from scratch. |
|
1266 For instance, the fact |
|
1267 that one thread can not be blocked by two critical resources at the same time |
|
1268 is obvious, because only running threads can make new requests, if one is waiting for |
|
1269 a critical resource and get blocked, it can not make another resource request and get |
|
1270 blocked the second time (because it is not running). |
|
1271 |
|
1272 To derive this fact, one needs to prove by contraction and |
|
1273 reason about time (or @{text "moement"}). The reasoning is based on a generic theorem |
|
1274 named @{text "p_split"}, which is about status changing along the time axis. It says if |
|
1275 a condition @{text "Q"} is @{text "True"} at a state @{text "s"}, |
|
1276 but it was @{text "False"} at the very beginning, then there must exits a moment @{text "t"} |
|
1277 in the history of @{text "s"} (notice that @{text "s"} itself is essentially the history |
|
1278 of events leading to it), such that @{text "Q"} switched |
|
1279 from being @{text "False"} to @{text "True"} and kept being @{text "True"} |
|
1280 till the last moment of @{text "s"}. |
|
1281 |
|
1282 Suppose a thread @{text "th"} is blocked |
|
1283 on @{text "cs1"} and @{text "cs2"} in some state @{text "s"}, |
|
1284 since no thread is blocked at the very beginning, by applying |
|
1285 @{text "p_split"} to these two blocking facts, there exist |
|
1286 two moments @{text "t1"} and @{text "t2"} in @{text "s"}, such that |
|
1287 @{text "th"} got blocked on @{text "cs1"} and @{text "cs2"} |
|
1288 and kept on blocked on them respectively ever since. |
|
1289 |
|
1290 Without lost of generality, we assume @{text "t1"} is earlier than @{text "t2"}. |
|
1291 However, since @{text "th"} was blocked ever since memonent @{text "t1"}, so it was still |
|
1292 in blocked state at moment @{text "t2"} and could not |
|
1293 make any request and get blocked the second time: Contradiction. |
|
1294 *} |
|
1295 |
|
1296 lemma waiting_unique_pre: (* ccc *) |
|
1297 assumes h11: "thread \<in> set (wq s cs1)" |
|
1298 and h12: "thread \<noteq> hd (wq s cs1)" |
|
1299 assumes h21: "thread \<in> set (wq s cs2)" |
|
1300 and h22: "thread \<noteq> hd (wq s cs2)" |
|
1301 and neq12: "cs1 \<noteq> cs2" |
|
1302 shows "False" |
|
1303 >>>>>>> other |
|
1304 proof - |
|
1305 <<<<<<< local |
|
1306 from in_dom obtain n where "(Th th, n) \<in> RAG s" by auto |
1035 from in_dom obtain n where "(Th th, n) \<in> RAG s" by auto |
1307 moreover from RAG_target_th[OF this] obtain cs where "n = Cs cs" by auto |
1036 moreover from RAG_target_th[OF this] obtain cs where "n = Cs cs" by auto |
1308 ultimately have "(Th th, Cs cs) \<in> RAG s" by simp |
1037 ultimately have "(Th th, Cs cs) \<in> RAG s" by simp |
1309 hence "th \<in> set (wq s cs)" |
1038 hence "th \<in> set (wq s cs)" |
1310 by (unfold s_RAG_def, auto simp:cs_waiting_def) |
1039 by (unfold s_RAG_def, auto simp:cs_waiting_def) |
1311 from wq_threads [OF this] show ?thesis . |
1040 from wq_threads [OF this] show ?thesis . |
1312 ======= |
1041 qed |
1313 let "?Q cs s" = "thread \<in> set (wq s cs) \<and> thread \<noteq> hd (wq s cs)" |
1042 |
1314 from h11 and h12 have q1: "?Q cs1 s" by simp |
|
1315 from h21 and h22 have q2: "?Q cs2 s" by simp |
|
1316 have nq1: "\<not> ?Q cs1 []" by (simp add:wq_def) |
|
1317 have nq2: "\<not> ?Q cs2 []" by (simp add:wq_def) |
|
1318 from p_split [of "?Q cs1", OF q1 nq1] |
|
1319 obtain t1 where lt1: "t1 < length s" |
|
1320 and np1: "\<not>(thread \<in> set (wq (moment t1 s) cs1) \<and> |
|
1321 thread \<noteq> hd (wq (moment t1 s) cs1))" |
|
1322 and nn1: "(\<forall>i'>t1. thread \<in> set (wq (moment i' s) cs1) \<and> |
|
1323 thread \<noteq> hd (wq (moment i' s) cs1))" by auto |
|
1324 from p_split [of "?Q cs2", OF q2 nq2] |
|
1325 obtain t2 where lt2: "t2 < length s" |
|
1326 and np2: "\<not>(thread \<in> set (wq (moment t2 s) cs2) \<and> |
|
1327 thread \<noteq> hd (wq (moment t2 s) cs2))" |
|
1328 and nn2: "(\<forall>i'>t2. thread \<in> set (wq (moment i' s) cs2) \<and> |
|
1329 thread \<noteq> hd (wq (moment i' s) cs2))" by auto |
|
1330 show ?thesis |
|
1331 proof - |
|
1332 { |
|
1333 assume lt12: "t1 < t2" |
|
1334 let ?t3 = "Suc t2" |
|
1335 from lt2 have le_t3: "?t3 \<le> length s" by auto |
|
1336 from moment_plus [OF this] |
|
1337 obtain e where eq_m: "moment ?t3 s = e#moment t2 s" by auto |
|
1338 have "t2 < ?t3" by simp |
|
1339 from nn2 [rule_format, OF this] and eq_m |
|
1340 have h1: "thread \<in> set (wq (e#moment t2 s) cs2)" and |
|
1341 h2: "thread \<noteq> hd (wq (e#moment t2 s) cs2)" by auto |
|
1342 have "vt (e#moment t2 s)" |
|
1343 proof - |
|
1344 from vt_moment |
|
1345 have "vt (moment ?t3 s)" . |
|
1346 with eq_m show ?thesis by simp |
|
1347 qed |
|
1348 then interpret vt_e: valid_trace_e "moment t2 s" "e" |
|
1349 by (unfold_locales, auto, cases, simp) |
|
1350 have ?thesis |
|
1351 proof(cases "thread \<in> set (wq (moment t2 s) cs2)") |
|
1352 case True |
|
1353 from True and np2 have eq_th: "thread = hd (wq (moment t2 s) cs2)" |
|
1354 by auto |
|
1355 from vt_e.abs2 [OF True eq_th h2 h1] |
|
1356 show ?thesis by auto |
|
1357 next |
|
1358 case False |
|
1359 from vt_e.block_pre[OF False h1] |
|
1360 have "e = P thread cs2" . |
|
1361 with vt_e.vt_e have "vt ((P thread cs2)# moment t2 s)" by simp |
|
1362 from p_pre [OF this] have "thread \<in> runing (moment t2 s)" by simp |
|
1363 with runing_ready have "thread \<in> readys (moment t2 s)" by auto |
|
1364 with nn1 [rule_format, OF lt12] |
|
1365 show ?thesis by (simp add:readys_def wq_def s_waiting_def, auto) |
|
1366 qed |
|
1367 } moreover { |
|
1368 assume lt12: "t2 < t1" |
|
1369 let ?t3 = "Suc t1" |
|
1370 from lt1 have le_t3: "?t3 \<le> length s" by auto |
|
1371 from moment_plus [OF this] |
|
1372 obtain e where eq_m: "moment ?t3 s = e#moment t1 s" by auto |
|
1373 have lt_t3: "t1 < ?t3" by simp |
|
1374 from nn1 [rule_format, OF this] and eq_m |
|
1375 have h1: "thread \<in> set (wq (e#moment t1 s) cs1)" and |
|
1376 h2: "thread \<noteq> hd (wq (e#moment t1 s) cs1)" by auto |
|
1377 have "vt (e#moment t1 s)" |
|
1378 proof - |
|
1379 from vt_moment |
|
1380 have "vt (moment ?t3 s)" . |
|
1381 with eq_m show ?thesis by simp |
|
1382 qed |
|
1383 then interpret vt_e: valid_trace_e "moment t1 s" e |
|
1384 by (unfold_locales, auto, cases, auto) |
|
1385 have ?thesis |
|
1386 proof(cases "thread \<in> set (wq (moment t1 s) cs1)") |
|
1387 case True |
|
1388 from True and np1 have eq_th: "thread = hd (wq (moment t1 s) cs1)" |
|
1389 by auto |
|
1390 from vt_e.abs2 True eq_th h2 h1 |
|
1391 show ?thesis by auto |
|
1392 next |
|
1393 case False |
|
1394 from vt_e.block_pre [OF False h1] |
|
1395 have "e = P thread cs1" . |
|
1396 with vt_e.vt_e have "vt ((P thread cs1)# moment t1 s)" by simp |
|
1397 from p_pre [OF this] have "thread \<in> runing (moment t1 s)" by simp |
|
1398 with runing_ready have "thread \<in> readys (moment t1 s)" by auto |
|
1399 with nn2 [rule_format, OF lt12] |
|
1400 show ?thesis by (simp add:readys_def wq_def s_waiting_def, auto) |
|
1401 qed |
|
1402 } moreover { |
|
1403 assume eqt12: "t1 = t2" |
|
1404 let ?t3 = "Suc t1" |
|
1405 from lt1 have le_t3: "?t3 \<le> length s" by auto |
|
1406 from moment_plus [OF this] |
|
1407 obtain e where eq_m: "moment ?t3 s = e#moment t1 s" by auto |
|
1408 have lt_t3: "t1 < ?t3" by simp |
|
1409 from nn1 [rule_format, OF this] and eq_m |
|
1410 have h1: "thread \<in> set (wq (e#moment t1 s) cs1)" and |
|
1411 h2: "thread \<noteq> hd (wq (e#moment t1 s) cs1)" by auto |
|
1412 have vt_e: "vt (e#moment t1 s)" |
|
1413 proof - |
|
1414 from vt_moment |
|
1415 have "vt (moment ?t3 s)" . |
|
1416 with eq_m show ?thesis by simp |
|
1417 qed |
|
1418 then interpret vt_e: valid_trace_e "moment t1 s" e |
|
1419 by (unfold_locales, auto, cases, auto) |
|
1420 have ?thesis |
|
1421 proof(cases "thread \<in> set (wq (moment t1 s) cs1)") |
|
1422 case True |
|
1423 from True and np1 have eq_th: "thread = hd (wq (moment t1 s) cs1)" |
|
1424 by auto |
|
1425 from vt_e.abs2 [OF True eq_th h2 h1] |
|
1426 show ?thesis by auto |
|
1427 next |
|
1428 case False |
|
1429 from vt_e.block_pre [OF False h1] |
|
1430 have eq_e1: "e = P thread cs1" . |
|
1431 have lt_t3: "t1 < ?t3" by simp |
|
1432 with eqt12 have "t2 < ?t3" by simp |
|
1433 from nn2 [rule_format, OF this] and eq_m and eqt12 |
|
1434 have h1: "thread \<in> set (wq (e#moment t2 s) cs2)" and |
|
1435 h2: "thread \<noteq> hd (wq (e#moment t2 s) cs2)" by auto |
|
1436 show ?thesis |
|
1437 proof(cases "thread \<in> set (wq (moment t2 s) cs2)") |
|
1438 case True |
|
1439 from True and np2 have eq_th: "thread = hd (wq (moment t2 s) cs2)" |
|
1440 by auto |
|
1441 from vt_e and eqt12 have "vt (e#moment t2 s)" by simp |
|
1442 then interpret vt_e2: valid_trace_e "moment t2 s" e |
|
1443 by (unfold_locales, auto, cases, auto) |
|
1444 from vt_e2.abs2 [OF True eq_th h2 h1] |
|
1445 show ?thesis . |
|
1446 next |
|
1447 case False |
|
1448 have "vt (e#moment t2 s)" |
|
1449 proof - |
|
1450 from vt_moment eqt12 |
|
1451 have "vt (moment (Suc t2) s)" by auto |
|
1452 with eq_m eqt12 show ?thesis by simp |
|
1453 qed |
|
1454 then interpret vt_e2: valid_trace_e "moment t2 s" e |
|
1455 by (unfold_locales, auto, cases, auto) |
|
1456 from vt_e2.block_pre [OF False h1] |
|
1457 have "e = P thread cs2" . |
|
1458 with eq_e1 neq12 show ?thesis by auto |
|
1459 qed |
|
1460 qed |
|
1461 } ultimately show ?thesis by arith |
|
1462 qed |
|
1463 >>>>>>> other |
|
1464 qed |
|
1465 |
|
1466 <<<<<<< local |
|
1467 lemma rg_RAG_threads: |
1043 lemma rg_RAG_threads: |
1468 assumes "(Th th) \<in> Range (RAG s)" |
1044 assumes "(Th th) \<in> Range (RAG s)" |
1469 shows "th \<in> threads s" |
1045 shows "th \<in> threads s" |
1470 using assms |
1046 using assms |
1471 by (unfold s_RAG_def cs_waiting_def cs_holding_def, |
1047 by (unfold s_RAG_def cs_waiting_def cs_holding_def, |
1474 lemma RAG_threads: |
1050 lemma RAG_threads: |
1475 assumes "(Th th) \<in> Field (RAG s)" |
1051 assumes "(Th th) \<in> Field (RAG s)" |
1476 shows "th \<in> threads s" |
1052 shows "th \<in> threads s" |
1477 using assms |
1053 using assms |
1478 by (metis Field_def UnE dm_RAG_threads rg_RAG_threads) |
1054 by (metis Field_def UnE dm_RAG_threads rg_RAG_threads) |
1479 ======= |
1055 |
1480 text {* |
1056 end |
1481 This lemma is a simple corrolary of @{text "waiting_unique_pre"}. |
1057 |
1482 *} |
|
1483 |
|
1484 lemma waiting_unique: |
|
1485 assumes "waiting s th cs1" |
|
1486 and "waiting s th cs2" |
|
1487 shows "cs1 = cs2" |
|
1488 using waiting_unique_pre assms |
|
1489 unfolding wq_def s_waiting_def |
|
1490 by auto |
|
1491 >>>>>>> other |
|
1492 |
|
1493 end |
|
1494 |
|
1495 <<<<<<< local |
|
1496 section {* The change of @{term RAG} *} |
1058 section {* The change of @{term RAG} *} |
1497 ======= |
|
1498 (* not used *) |
|
1499 text {* |
|
1500 Every thread can only be blocked on one critical resource, |
|
1501 symmetrically, every critical resource can only be held by one thread. |
|
1502 This fact is much more easier according to our definition. |
|
1503 *} |
|
1504 lemma held_unique: |
|
1505 assumes "holding (s::event list) th1 cs" |
|
1506 and "holding s th2 cs" |
|
1507 shows "th1 = th2" |
|
1508 by (insert assms, unfold s_holding_def, auto) |
|
1509 |
|
1510 |
|
1511 lemma last_set_lt: "th \<in> threads s \<Longrightarrow> last_set th s < length s" |
|
1512 apply (induct s, auto) |
|
1513 by (case_tac a, auto split:if_splits) |
|
1514 |
|
1515 lemma last_set_unique: |
|
1516 "\<lbrakk>last_set th1 s = last_set th2 s; th1 \<in> threads s; th2 \<in> threads s\<rbrakk> |
|
1517 \<Longrightarrow> th1 = th2" |
|
1518 apply (induct s, auto) |
|
1519 by (case_tac a, auto split:if_splits dest:last_set_lt) |
|
1520 |
|
1521 lemma preced_unique : |
|
1522 assumes pcd_eq: "preced th1 s = preced th2 s" |
|
1523 and th_in1: "th1 \<in> threads s" |
|
1524 and th_in2: " th2 \<in> threads s" |
|
1525 shows "th1 = th2" |
|
1526 proof - |
|
1527 from pcd_eq have "last_set th1 s = last_set th2 s" by (simp add:preced_def) |
|
1528 from last_set_unique [OF this th_in1 th_in2] |
|
1529 show ?thesis . |
|
1530 qed |
|
1531 |
|
1532 lemma preced_linorder: |
|
1533 assumes neq_12: "th1 \<noteq> th2" |
|
1534 and th_in1: "th1 \<in> threads s" |
|
1535 and th_in2: " th2 \<in> threads s" |
|
1536 shows "preced th1 s < preced th2 s \<or> preced th1 s > preced th2 s" |
|
1537 proof - |
|
1538 from preced_unique [OF _ th_in1 th_in2] and neq_12 |
|
1539 have "preced th1 s \<noteq> preced th2 s" by auto |
|
1540 thus ?thesis by auto |
|
1541 qed |
|
1542 >>>>>>> other |
|
1543 |
|
1544 (* An aux lemma used later *) |
|
1545 lemma unique_minus: |
|
1546 assumes unique: "\<And> a b c. \<lbrakk>(a, b) \<in> r; (a, c) \<in> r\<rbrakk> \<Longrightarrow> b = c" |
|
1547 and xy: "(x, y) \<in> r" |
|
1548 and xz: "(x, z) \<in> r^+" |
|
1549 and neq: "y \<noteq> z" |
|
1550 shows "(y, z) \<in> r^+" |
|
1551 proof - |
|
1552 from xz and neq show ?thesis |
|
1553 proof(induct) |
|
1554 case (base ya) |
|
1555 have "(x, ya) \<in> r" by fact |
|
1556 from unique [OF xy this] have "y = ya" . |
|
1557 with base show ?case by auto |
|
1558 next |
|
1559 case (step ya z) |
|
1560 show ?case |
|
1561 proof(cases "y = ya") |
|
1562 case True |
|
1563 from step True show ?thesis by simp |
|
1564 next |
|
1565 case False |
|
1566 from step False |
|
1567 show ?thesis by auto |
|
1568 qed |
|
1569 qed |
|
1570 qed |
|
1571 |
|
1572 lemma unique_base: |
|
1573 assumes unique: "\<And> a b c. \<lbrakk>(a, b) \<in> r; (a, c) \<in> r\<rbrakk> \<Longrightarrow> b = c" |
|
1574 and xy: "(x, y) \<in> r" |
|
1575 and xz: "(x, z) \<in> r^+" |
|
1576 and neq_yz: "y \<noteq> z" |
|
1577 shows "(y, z) \<in> r^+" |
|
1578 proof - |
|
1579 from xz neq_yz show ?thesis |
|
1580 proof(induct) |
|
1581 case (base ya) |
|
1582 from xy unique base show ?case by auto |
|
1583 next |
|
1584 case (step ya z) |
|
1585 show ?case |
|
1586 proof(cases "y = ya") |
|
1587 case True |
|
1588 from True step show ?thesis by auto |
|
1589 next |
|
1590 case False |
|
1591 from False step |
|
1592 have "(y, ya) \<in> r\<^sup>+" by auto |
|
1593 with step show ?thesis by auto |
|
1594 qed |
|
1595 qed |
|
1596 qed |
|
1597 |
|
1598 lemma unique_chain: |
|
1599 assumes unique: "\<And> a b c. \<lbrakk>(a, b) \<in> r; (a, c) \<in> r\<rbrakk> \<Longrightarrow> b = c" |
|
1600 and xy: "(x, y) \<in> r^+" |
|
1601 and xz: "(x, z) \<in> r^+" |
|
1602 and neq_yz: "y \<noteq> z" |
|
1603 shows "(y, z) \<in> r^+ \<or> (z, y) \<in> r^+" |
|
1604 proof - |
|
1605 from xy xz neq_yz show ?thesis |
|
1606 proof(induct) |
|
1607 case (base y) |
|
1608 have h1: "(x, y) \<in> r" and h2: "(x, z) \<in> r\<^sup>+" and h3: "y \<noteq> z" using base by auto |
|
1609 from unique_base [OF _ h1 h2 h3] and unique show ?case by auto |
|
1610 next |
|
1611 case (step y za) |
|
1612 show ?case |
|
1613 proof(cases "y = z") |
|
1614 case True |
|
1615 from True step show ?thesis by auto |
|
1616 next |
|
1617 case False |
|
1618 from False step have "(y, z) \<in> r\<^sup>+ \<or> (z, y) \<in> r\<^sup>+" by auto |
|
1619 thus ?thesis |
|
1620 proof |
|
1621 assume "(z, y) \<in> r\<^sup>+" |
|
1622 with step have "(z, za) \<in> r\<^sup>+" by auto |
|
1623 thus ?thesis by auto |
|
1624 next |
|
1625 assume h: "(y, z) \<in> r\<^sup>+" |
|
1626 from step have yza: "(y, za) \<in> r" by simp |
|
1627 from step have "za \<noteq> z" by simp |
|
1628 from unique_minus [OF _ yza h this] and unique |
|
1629 have "(za, z) \<in> r\<^sup>+" by auto |
|
1630 thus ?thesis by auto |
|
1631 qed |
|
1632 qed |
|
1633 qed |
|
1634 qed |
|
1635 |
1059 |
1636 text {* |
1060 text {* |
1637 The following three lemmas show that @{text "RAG"} does not change |
1061 The following three lemmas show that @{text "RAG"} does not change |
1638 by the happening of @{text "Set"}, @{text "Create"} and @{text "Exit"} |
1062 by the happening of @{text "Set"}, @{text "Create"} and @{text "Exit"} |
1639 events, respectively. |
1063 events, respectively. |
1640 *} |
1064 *} |
1641 |
1065 |
1642 <<<<<<< local |
|
1643 lemma (in valid_trace_set) RAG_unchanged [simp]: "(RAG (e # s)) = RAG s" |
1066 lemma (in valid_trace_set) RAG_unchanged [simp]: "(RAG (e # s)) = RAG s" |
1644 by (unfold is_set s_RAG_def s_waiting_def wq_def, simp add:Let_def) |
1067 by (unfold is_set s_RAG_def s_waiting_def wq_def, simp add:Let_def) |
1645 |
1068 |
1646 lemma (in valid_trace_create) RAG_unchanged [simp]: "(RAG (e # s)) = RAG s" |
1069 lemma (in valid_trace_create) RAG_unchanged [simp]: "(RAG (e # s)) = RAG s" |
1647 by (unfold is_create s_RAG_def s_waiting_def wq_def, simp add:Let_def) |
1070 by (unfold is_create s_RAG_def s_waiting_def wq_def, simp add:Let_def) |
1648 |
1071 |
1649 lemma (in valid_trace_exit) RAG_unchanged[simp]: "(RAG (e # s)) = RAG s" |
1072 lemma (in valid_trace_exit) RAG_unchanged[simp]: "(RAG (e # s)) = RAG s" |
1650 by (unfold is_exit s_RAG_def s_waiting_def wq_def, simp add:Let_def) |
1073 by (unfold is_exit s_RAG_def s_waiting_def wq_def, simp add:Let_def) |
1651 ======= |
1074 |
1652 lemma RAG_set_unchanged: "(RAG (Set th prio # s)) = RAG s" |
|
1653 apply (unfold s_RAG_def s_waiting_def wq_def) |
|
1654 by (simp add:Let_def) |
|
1655 |
|
1656 lemma RAG_create_unchanged: "(RAG (Create th prio # s)) = RAG s" |
|
1657 apply (unfold s_RAG_def s_waiting_def wq_def) |
|
1658 by (simp add:Let_def) |
|
1659 |
|
1660 lemma RAG_exit_unchanged: "(RAG (Exit th # s)) = RAG s" |
|
1661 apply (unfold s_RAG_def s_waiting_def wq_def) |
|
1662 by (simp add:Let_def) |
|
1663 |
|
1664 >>>>>>> other |
|
1665 |
|
1666 <<<<<<< local |
|
1667 context valid_trace_v |
1075 context valid_trace_v |
1668 begin |
1076 begin |
1669 |
1077 |
1670 lemma holding_cs_eq_th: |
1078 lemma holding_cs_eq_th: |
1671 assumes "holding s t cs" |
1079 assumes "holding s t cs" |
1672 shows "t = th" |
1080 shows "t = th" |
1673 ======= |
1081 proof - |
1674 text {* |
1082 from pip_e[unfolded is_v] |
1675 The following lemmas are used in the proof of |
1083 show ?thesis |
1676 lemma @{text "step_RAG_v"}, which characterizes how the @{text "RAG"} is changed |
1084 proof(cases) |
1677 by @{text "V"}-events. |
1085 case (thread_V) |
1678 However, since our model is very concise, such seemingly obvious lemmas need to be derived from scratch, |
1086 from held_unique[OF this(2) assms] |
1679 starting from the model definitions. |
1087 show ?thesis by simp |
1680 *} |
1088 qed |
1681 lemma step_v_hold_inv[elim_format]: |
1089 qed |
1682 "\<And>c t. \<lbrakk>vt (V th cs # s); |
1090 |
1683 \<not> holding (wq s) t c; holding (wq (V th cs # s)) t c\<rbrakk> \<Longrightarrow> |
|
1684 next_th s th cs t \<and> c = cs" |
|
1685 >>>>>>> other |
|
1686 proof - |
|
1687 fix c t |
|
1688 assume vt: "vt (V th cs # s)" |
|
1689 and nhd: "\<not> holding (wq s) t c" |
|
1690 and hd: "holding (wq (V th cs # s)) t c" |
|
1691 show "next_th s th cs t \<and> c = cs" |
|
1692 proof(cases "c = cs") |
|
1693 case False |
|
1694 with nhd hd show ?thesis |
|
1695 by (unfold cs_holding_def wq_def, auto simp:Let_def) |
|
1696 next |
|
1697 case True |
|
1698 with step_back_step [OF vt] |
|
1699 have "step s (V th c)" by simp |
|
1700 hence "next_th s th cs t" |
|
1701 proof(cases) |
|
1702 assume "holding s th c" |
|
1703 with nhd hd show ?thesis |
|
1704 apply (unfold s_holding_def cs_holding_def wq_def next_th_def, |
|
1705 auto simp:Let_def split:list.splits if_splits) |
|
1706 proof - |
|
1707 assume " hd (SOME q. distinct q \<and> q = []) \<in> set (SOME q. distinct q \<and> q = [])" |
|
1708 moreover have "\<dots> = set []" |
|
1709 proof(rule someI2) |
|
1710 show "distinct [] \<and> [] = []" by auto |
|
1711 next |
|
1712 fix x assume "distinct x \<and> x = []" |
|
1713 thus "set x = set []" by auto |
|
1714 qed |
|
1715 ultimately show False by auto |
|
1716 next |
|
1717 assume " hd (SOME q. distinct q \<and> q = []) \<in> set (SOME q. distinct q \<and> q = [])" |
|
1718 moreover have "\<dots> = set []" |
|
1719 proof(rule someI2) |
|
1720 show "distinct [] \<and> [] = []" by auto |
|
1721 next |
|
1722 fix x assume "distinct x \<and> x = []" |
|
1723 thus "set x = set []" by auto |
|
1724 qed |
|
1725 ultimately show False by auto |
|
1726 qed |
|
1727 qed |
|
1728 with True show ?thesis by auto |
|
1729 qed |
|
1730 qed |
|
1731 |
|
1732 <<<<<<< local |
|
1733 lemma distinct_wq': "distinct wq'" |
1091 lemma distinct_wq': "distinct wq'" |
1734 by (metis (mono_tags, lifting) distinct_rest some_eq_ex wq'_def) |
1092 by (metis (mono_tags, lifting) distinct_rest some_eq_ex wq'_def) |
1735 |
1093 |
1736 lemma set_wq': "set wq' = set rest" |
1094 lemma set_wq': "set wq' = set rest" |
1737 by (metis (mono_tags, lifting) distinct_rest some_eq_ex wq'_def) |
1095 by (metis (mono_tags, lifting) distinct_rest some_eq_ex wq'_def) |
1793 hence "waiting s t c" using assms |
1127 hence "waiting s t c" using assms |
1794 by (simp add: cs_waiting_def waiting_eq) |
1128 by (simp add: cs_waiting_def waiting_eq) |
1795 hence "t \<notin> readys s" by (unfold readys_def, auto) |
1129 hence "t \<notin> readys s" by (unfold readys_def, auto) |
1796 hence "t \<notin> runing s" using runing_ready by auto |
1130 hence "t \<notin> runing s" using runing_ready by auto |
1797 with runing_th_s[folded otherwise] show ?thesis by auto |
1131 with runing_th_s[folded otherwise] show ?thesis by auto |
1798 ======= |
1132 qed |
1799 from nw[folded True] wt[folded True] |
1133 qed |
1800 have "next_th s th cs t" |
1134 |
1801 apply (unfold next_th_def, auto simp:cs_waiting_def wq_def Let_def split:list.splits) |
1135 lemma waiting_esI1: |
1802 proof - |
1136 assumes "waiting s t c" |
1803 fix a list |
1137 and "c \<noteq> cs" |
1804 assume t_in: "t \<in> set list" |
1138 shows "waiting (e#s) t c" |
1805 and t_ni: "t \<notin> set (SOME q. distinct q \<and> set q = set list)" |
1139 proof - |
1806 and eq_wq: "wq_fun (schs s) cs = a # list" |
1140 have "wq (e#s) c = wq s c" |
1807 have " set (SOME q. distinct q \<and> set q = set list) = set list" |
1141 using assms(2) is_v by auto |
1808 proof(rule someI2) |
1142 with assms(1) show ?thesis |
1809 from vt_v.wq_distinct[of cs] and eq_wq[folded wq_def] |
1143 using cs_waiting_def waiting_eq by auto |
1810 show "distinct list \<and> set list = set list" by auto |
1144 qed |
1811 next |
1145 |
1812 show "\<And>x. distinct x \<and> set x = set list \<Longrightarrow> set x = set list" |
1146 lemma holding_esI2: |
1813 by auto |
1147 assumes "c \<noteq> cs" |
1814 qed |
1148 and "holding s t c" |
1815 with t_ni and t_in show "a = th" by auto |
1149 shows "holding (e#s) t c" |
1816 next |
1150 proof - |
1817 fix a list |
1151 from assms(1) have "wq (e#s) c = wq s c" using is_v by auto |
1818 assume t_in: "t \<in> set list" |
1152 from assms(2)[unfolded s_holding_def, folded wq_def, |
1819 and t_ni: "t \<notin> set (SOME q. distinct q \<and> set q = set list)" |
1153 folded this, unfolded wq_def, folded s_holding_def] |
1820 and eq_wq: "wq_fun (schs s) cs = a # list" |
1154 show ?thesis . |
1821 have " set (SOME q. distinct q \<and> set q = set list) = set list" |
1155 qed |
1822 proof(rule someI2) |
1156 |
1823 from vt_v.wq_distinct[of cs] and eq_wq[folded wq_def] |
1157 lemma holding_esI1: |
1824 show "distinct list \<and> set list = set list" by auto |
1158 assumes "holding s t c" |
1825 next |
1159 and "t \<noteq> th" |
1826 show "\<And>x. distinct x \<and> set x = set list \<Longrightarrow> set x = set list" |
1160 shows "holding (e#s) t c" |
1827 by auto |
1161 proof - |
1828 qed |
1162 have "c \<noteq> cs" using assms using holding_cs_eq_th by blast |
1829 with t_ni and t_in show "t = hd (SOME q. distinct q \<and> set q = set list)" by auto |
1163 from holding_esI2[OF this assms(1)] |
1830 next |
1164 show ?thesis . |
1831 fix a list |
1165 qed |
1832 assume eq_wq: "wq_fun (schs s) cs = a # list" |
1166 |
1833 from step_back_step[OF vt] |
|
1834 show "a = th" |
|
1835 proof(cases) |
|
1836 assume "holding s th cs" |
|
1837 with eq_wq show ?thesis |
|
1838 by (unfold s_holding_def wq_def, auto) |
|
1839 qed |
|
1840 qed |
|
1841 with True show ?thesis by simp |
|
1842 >>>>>>> other |
|
1843 qed |
|
1844 qed |
|
1845 |
|
1846 lemma step_v_not_wait[consumes 3]: |
|
1847 "\<lbrakk>vt (V th cs # s); next_th s th cs t; waiting (wq (V th cs # s)) t cs\<rbrakk> \<Longrightarrow> False" |
|
1848 by (unfold next_th_def cs_waiting_def wq_def, auto simp:Let_def) |
|
1849 |
|
1850 lemma step_v_release: |
|
1851 "\<lbrakk>vt (V th cs # s); holding (wq (V th cs # s)) th cs\<rbrakk> \<Longrightarrow> False" |
|
1852 proof - |
|
1853 assume vt: "vt (V th cs # s)" |
|
1854 and hd: "holding (wq (V th cs # s)) th cs" |
|
1855 from vt interpret vt_v: valid_trace_e s "V th cs" |
|
1856 by (cases, unfold_locales, simp+) |
|
1857 from step_back_step [OF vt] and hd |
|
1858 show "False" |
|
1859 proof(cases) |
|
1860 assume "holding (wq (V th cs # s)) th cs" and "holding s th cs" |
|
1861 thus ?thesis |
|
1862 apply (unfold s_holding_def wq_def cs_holding_def) |
|
1863 apply (auto simp:Let_def split:list.splits) |
|
1864 proof - |
|
1865 fix list |
|
1866 assume eq_wq[folded wq_def]: |
|
1867 "wq_fun (schs s) cs = hd (SOME q. distinct q \<and> set q = set list) # list" |
|
1868 and hd_in: "hd (SOME q. distinct q \<and> set q = set list) |
|
1869 \<in> set (SOME q. distinct q \<and> set q = set list)" |
|
1870 have "set (SOME q. distinct q \<and> set q = set list) = set list" |
|
1871 proof(rule someI2) |
|
1872 from vt_v.wq_distinct[of cs] and eq_wq |
|
1873 show "distinct list \<and> set list = set list" by auto |
|
1874 next |
|
1875 show "\<And>x. distinct x \<and> set x = set list \<Longrightarrow> set x = set list" |
|
1876 by auto |
|
1877 qed |
|
1878 moreover have "distinct (hd (SOME q. distinct q \<and> set q = set list) # list)" |
|
1879 proof - |
|
1880 from vt_v.wq_distinct[of cs] and eq_wq |
|
1881 show ?thesis by auto |
|
1882 qed |
|
1883 moreover note eq_wq and hd_in |
|
1884 ultimately show "False" by auto |
|
1885 qed |
|
1886 qed |
|
1887 qed |
|
1888 |
|
1889 lemma step_v_get_hold: |
|
1890 "\<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" |
|
1891 apply (unfold cs_holding_def next_th_def wq_def, |
|
1892 auto simp:Let_def) |
|
1893 proof - |
|
1894 fix rest |
|
1895 assume vt: "vt (V th cs # s)" |
|
1896 and eq_wq[folded wq_def]: " wq_fun (schs s) cs = th # rest" |
|
1897 and nrest: "rest \<noteq> []" |
|
1898 and ni: "hd (SOME q. distinct q \<and> set q = set rest) |
|
1899 \<notin> set (SOME q. distinct q \<and> set q = set rest)" |
|
1900 from vt interpret vt_v: valid_trace_e s "V th cs" |
|
1901 by (cases, unfold_locales, simp+) |
|
1902 have "(SOME q. distinct q \<and> set q = set rest) \<noteq> []" |
|
1903 proof(rule someI2) |
|
1904 from vt_v.wq_distinct[of cs] and eq_wq |
|
1905 show "distinct rest \<and> set rest = set rest" by auto |
|
1906 next |
|
1907 fix x assume "distinct x \<and> set x = set rest" |
|
1908 hence "set x = set rest" by auto |
|
1909 with nrest |
|
1910 show "x \<noteq> []" by (case_tac x, auto) |
|
1911 qed |
|
1912 with ni show "False" by auto |
|
1913 qed |
|
1914 |
|
1915 lemma step_v_release_inv[elim_format]: |
|
1916 "\<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> |
|
1917 c = cs \<and> t = th" |
|
1918 apply (unfold cs_holding_def wq_def, auto simp:Let_def split:if_splits list.splits) |
|
1919 proof - |
|
1920 fix a list |
|
1921 assume vt: "vt (V th cs # s)" and eq_wq: "wq_fun (schs s) cs = a # list" |
|
1922 from step_back_step [OF vt] show "a = th" |
|
1923 proof(cases) |
|
1924 assume "holding s th cs" with eq_wq |
|
1925 show ?thesis |
|
1926 by (unfold s_holding_def wq_def, auto) |
|
1927 qed |
|
1928 next |
|
1929 fix a list |
|
1930 assume vt: "vt (V th cs # s)" and eq_wq: "wq_fun (schs s) cs = a # list" |
|
1931 from step_back_step [OF vt] show "a = th" |
|
1932 proof(cases) |
|
1933 assume "holding s th cs" with eq_wq |
|
1934 show ?thesis |
|
1935 by (unfold s_holding_def wq_def, auto) |
|
1936 qed |
|
1937 qed |
|
1938 |
|
1939 lemma step_v_waiting_mono: |
|
1940 "\<And>t c. \<lbrakk>vt (V th cs # s); waiting (wq (V th cs # s)) t c\<rbrakk> \<Longrightarrow> waiting (wq s) t c" |
|
1941 proof - |
|
1942 fix t c |
|
1943 let ?s' = "(V th cs # s)" |
|
1944 assume vt: "vt ?s'" |
|
1945 and wt: "waiting (wq ?s') t c" |
|
1946 from vt interpret vt_v: valid_trace_e s "V th cs" |
|
1947 by (cases, unfold_locales, simp+) |
|
1948 show "waiting (wq s) t c" |
|
1949 proof(cases "c = cs") |
|
1950 case False |
|
1951 assume neq_cs: "c \<noteq> cs" |
|
1952 hence "waiting (wq ?s') t c = waiting (wq s) t c" |
|
1953 by (unfold cs_waiting_def wq_def, auto simp:Let_def) |
|
1954 with wt show ?thesis by simp |
|
1955 next |
|
1956 case True |
|
1957 with wt show ?thesis |
|
1958 apply (unfold cs_waiting_def wq_def, auto simp:Let_def split:list.splits) |
|
1959 proof - |
|
1960 fix a list |
|
1961 assume not_in: "t \<notin> set list" |
|
1962 and is_in: "t \<in> set (SOME q. distinct q \<and> set q = set list)" |
|
1963 and eq_wq: "wq_fun (schs s) cs = a # list" |
|
1964 have "set (SOME q. distinct q \<and> set q = set list) = set list" |
|
1965 proof(rule someI2) |
|
1966 from vt_v.wq_distinct [of cs] |
|
1967 and eq_wq[folded wq_def] |
|
1968 show "distinct list \<and> set list = set list" by auto |
|
1969 next |
|
1970 fix x assume "distinct x \<and> set x = set list" |
|
1971 thus "set x = set list" by auto |
|
1972 qed |
|
1973 with not_in is_in show "t = a" by auto |
|
1974 next |
|
1975 fix list |
|
1976 assume is_waiting: "waiting (wq (V th cs # s)) t cs" |
|
1977 and eq_wq: "wq_fun (schs s) cs = t # list" |
|
1978 hence "t \<in> set list" |
|
1979 apply (unfold wq_def, auto simp:Let_def cs_waiting_def) |
|
1980 proof - |
|
1981 assume " t \<in> set (SOME q. distinct q \<and> set q = set list)" |
|
1982 moreover have "\<dots> = set list" |
|
1983 proof(rule someI2) |
|
1984 from vt_v.wq_distinct [of cs] |
|
1985 and eq_wq[folded wq_def] |
|
1986 show "distinct list \<and> set list = set list" by auto |
|
1987 next |
|
1988 fix x assume "distinct x \<and> set x = set list" |
|
1989 thus "set x = set list" by auto |
|
1990 qed |
|
1991 ultimately show "t \<in> set list" by simp |
|
1992 qed |
|
1993 with eq_wq and vt_v.wq_distinct [of cs, unfolded wq_def] |
|
1994 show False by auto |
|
1995 qed |
|
1996 qed |
|
1997 qed |
|
1998 |
|
1999 <<<<<<< local |
|
2000 end |
1167 end |
2001 |
1168 |
2002 context valid_trace_v_n |
1169 context valid_trace_v_n |
2003 begin |
1170 begin |
2004 |
1171 |
3534 |
2701 |
3535 section {* Chain to readys *} |
2702 section {* Chain to readys *} |
3536 |
2703 |
3537 context valid_trace |
2704 context valid_trace |
3538 begin |
2705 begin |
3539 ======= |
|
3540 text {* (* ddd *) |
|
3541 The following @{text "step_RAG_v"} lemma charaterizes how @{text "RAG"} is changed |
|
3542 with the happening of @{text "V"}-events: |
|
3543 *} |
|
3544 lemma step_RAG_v: |
|
3545 assumes vt: |
|
3546 "vt (V th cs#s)" |
|
3547 shows " |
|
3548 RAG (V th cs # s) = |
|
3549 RAG s - {(Cs cs, Th th)} - |
|
3550 {(Th th', Cs cs) |th'. next_th s th cs th'} \<union> |
|
3551 {(Cs cs, Th th') |th'. next_th s th cs th'}" |
|
3552 apply (insert vt, unfold s_RAG_def) |
|
3553 apply (auto split:if_splits list.splits simp:Let_def) |
|
3554 apply (auto elim: step_v_waiting_mono step_v_hold_inv |
|
3555 step_v_release step_v_wait_inv |
|
3556 step_v_get_hold step_v_release_inv) |
|
3557 apply (erule_tac step_v_not_wait, auto) |
|
3558 done |
|
3559 |
|
3560 text {* |
|
3561 The following @{text "step_RAG_p"} lemma charaterizes how @{text "RAG"} is changed |
|
3562 with the happening of @{text "P"}-events: |
|
3563 *} |
|
3564 lemma step_RAG_p: |
|
3565 "vt (P th cs#s) \<Longrightarrow> |
|
3566 RAG (P th cs # s) = (if (wq s cs = []) then RAG s \<union> {(Cs cs, Th th)} |
|
3567 else RAG s \<union> {(Th th, Cs cs)})" |
|
3568 apply(simp only: s_RAG_def wq_def) |
|
3569 apply (auto split:list.splits prod.splits simp:Let_def wq_def cs_waiting_def cs_holding_def) |
|
3570 apply(case_tac "csa = cs", auto) |
|
3571 apply(fold wq_def) |
|
3572 apply(drule_tac step_back_step) |
|
3573 apply(ind_cases " step s (P (hd (wq s cs)) cs)") |
|
3574 apply(simp add:s_RAG_def wq_def cs_holding_def) |
|
3575 apply(auto) |
|
3576 done |
|
3577 |
|
3578 |
|
3579 lemma RAG_target_th: "(Th th, x) \<in> RAG (s::state) \<Longrightarrow> \<exists> cs. x = Cs cs" |
|
3580 by (unfold s_RAG_def, auto) |
|
3581 |
|
3582 context valid_trace |
|
3583 begin |
|
3584 |
|
3585 text {* |
|
3586 The following lemma shows that @{text "RAG"} is acyclic. |
|
3587 The overall structure is by induction on the formation of @{text "vt s"} |
|
3588 and then case analysis on event @{text "e"}, where the non-trivial cases |
|
3589 for those for @{text "V"} and @{text "P"} events. |
|
3590 *} |
|
3591 lemma acyclic_RAG: |
|
3592 shows "acyclic (RAG s)" |
|
3593 using vt |
|
3594 proof(induct) |
|
3595 case (vt_cons s e) |
|
3596 interpret vt_s: valid_trace s using vt_cons(1) |
|
3597 by (unfold_locales, simp) |
|
3598 assume ih: "acyclic (RAG s)" |
|
3599 and stp: "step s e" |
|
3600 and vt: "vt s" |
|
3601 show ?case |
|
3602 proof(cases e) |
|
3603 case (Create th prio) |
|
3604 with ih |
|
3605 show ?thesis by (simp add:RAG_create_unchanged) |
|
3606 next |
|
3607 case (Exit th) |
|
3608 with ih show ?thesis by (simp add:RAG_exit_unchanged) |
|
3609 next |
|
3610 case (V th cs) |
|
3611 from V vt stp have vtt: "vt (V th cs#s)" by auto |
|
3612 from step_RAG_v [OF this] |
|
3613 have eq_de: |
|
3614 "RAG (e # s) = |
|
3615 RAG s - {(Cs cs, Th th)} - {(Th th', Cs cs) |th'. next_th s th cs th'} \<union> |
|
3616 {(Cs cs, Th th') |th'. next_th s th cs th'}" |
|
3617 (is "?L = (?A - ?B - ?C) \<union> ?D") by (simp add:V) |
|
3618 from ih have ac: "acyclic (?A - ?B - ?C)" by (auto elim:acyclic_subset) |
|
3619 from step_back_step [OF vtt] |
|
3620 have "step s (V th cs)" . |
|
3621 thus ?thesis |
|
3622 proof(cases) |
|
3623 assume "holding s th cs" |
|
3624 hence th_in: "th \<in> set (wq s cs)" and |
|
3625 eq_hd: "th = hd (wq s cs)" unfolding s_holding_def wq_def by auto |
|
3626 then obtain rest where |
|
3627 eq_wq: "wq s cs = th#rest" |
|
3628 by (cases "wq s cs", auto) |
|
3629 show ?thesis |
|
3630 proof(cases "rest = []") |
|
3631 case False |
|
3632 let ?th' = "hd (SOME q. distinct q \<and> set q = set rest)" |
|
3633 from eq_wq False have eq_D: "?D = {(Cs cs, Th ?th')}" |
|
3634 by (unfold next_th_def, auto) |
|
3635 let ?E = "(?A - ?B - ?C)" |
|
3636 have "(Th ?th', Cs cs) \<notin> ?E\<^sup>*" |
|
3637 proof |
|
3638 assume "(Th ?th', Cs cs) \<in> ?E\<^sup>*" |
|
3639 hence " (Th ?th', Cs cs) \<in> ?E\<^sup>+" by (simp add: rtrancl_eq_or_trancl) |
|
3640 from tranclD [OF this] |
|
3641 obtain x where th'_e: "(Th ?th', x) \<in> ?E" by blast |
|
3642 hence th_d: "(Th ?th', x) \<in> ?A" by simp |
|
3643 from RAG_target_th [OF this] |
|
3644 obtain cs' where eq_x: "x = Cs cs'" by auto |
|
3645 with th_d have "(Th ?th', Cs cs') \<in> ?A" by simp |
|
3646 hence wt_th': "waiting s ?th' cs'" |
|
3647 unfolding s_RAG_def s_waiting_def cs_waiting_def wq_def by simp |
|
3648 hence "cs' = cs" |
|
3649 proof(rule vt_s.waiting_unique) |
|
3650 from eq_wq vt_s.wq_distinct[of cs] |
|
3651 show "waiting s ?th' cs" |
|
3652 apply (unfold s_waiting_def wq_def, auto) |
|
3653 proof - |
|
3654 assume hd_in: "hd (SOME q. distinct q \<and> set q = set rest) \<notin> set rest" |
|
3655 and eq_wq: "wq_fun (schs s) cs = th # rest" |
|
3656 have "(SOME q. distinct q \<and> set q = set rest) \<noteq> []" |
|
3657 proof(rule someI2) |
|
3658 from vt_s.wq_distinct[of cs] and eq_wq |
|
3659 show "distinct rest \<and> set rest = set rest" unfolding wq_def by auto |
|
3660 next |
|
3661 fix x assume "distinct x \<and> set x = set rest" |
|
3662 with False show "x \<noteq> []" by auto |
|
3663 qed |
|
3664 hence "hd (SOME q. distinct q \<and> set q = set rest) \<in> |
|
3665 set (SOME q. distinct q \<and> set q = set rest)" by auto |
|
3666 moreover have "\<dots> = set rest" |
|
3667 proof(rule someI2) |
|
3668 from vt_s.wq_distinct[of cs] and eq_wq |
|
3669 show "distinct rest \<and> set rest = set rest" unfolding wq_def by auto |
|
3670 next |
|
3671 show "\<And>x. distinct x \<and> set x = set rest \<Longrightarrow> set x = set rest" by auto |
|
3672 qed |
|
3673 moreover note hd_in |
|
3674 ultimately show "hd (SOME q. distinct q \<and> set q = set rest) = th" by auto |
|
3675 next |
|
3676 assume hd_in: "hd (SOME q. distinct q \<and> set q = set rest) \<notin> set rest" |
|
3677 and eq_wq: "wq s cs = hd (SOME q. distinct q \<and> set q = set rest) # rest" |
|
3678 have "(SOME q. distinct q \<and> set q = set rest) \<noteq> []" |
|
3679 proof(rule someI2) |
|
3680 from vt_s.wq_distinct[of cs] and eq_wq |
|
3681 show "distinct rest \<and> set rest = set rest" by auto |
|
3682 next |
|
3683 fix x assume "distinct x \<and> set x = set rest" |
|
3684 with False show "x \<noteq> []" by auto |
|
3685 qed |
|
3686 hence "hd (SOME q. distinct q \<and> set q = set rest) \<in> |
|
3687 set (SOME q. distinct q \<and> set q = set rest)" by auto |
|
3688 moreover have "\<dots> = set rest" |
|
3689 proof(rule someI2) |
|
3690 from vt_s.wq_distinct[of cs] and eq_wq |
|
3691 show "distinct rest \<and> set rest = set rest" by auto |
|
3692 next |
|
3693 show "\<And>x. distinct x \<and> set x = set rest \<Longrightarrow> set x = set rest" by auto |
|
3694 qed |
|
3695 moreover note hd_in |
|
3696 ultimately show False by auto |
|
3697 qed |
|
3698 qed |
|
3699 with th'_e eq_x have "(Th ?th', Cs cs) \<in> ?E" by simp |
|
3700 with False |
|
3701 show "False" by (auto simp: next_th_def eq_wq) |
|
3702 qed |
|
3703 with acyclic_insert[symmetric] and ac |
|
3704 and eq_de eq_D show ?thesis by auto |
|
3705 next |
|
3706 case True |
|
3707 with eq_wq |
|
3708 have eq_D: "?D = {}" |
|
3709 by (unfold next_th_def, auto) |
|
3710 with eq_de ac |
|
3711 show ?thesis by auto |
|
3712 qed |
|
3713 qed |
|
3714 next |
|
3715 case (P th cs) |
|
3716 from P vt stp have vtt: "vt (P th cs#s)" by auto |
|
3717 from step_RAG_p [OF this] P |
|
3718 have "RAG (e # s) = |
|
3719 (if wq s cs = [] then RAG s \<union> {(Cs cs, Th th)} else |
|
3720 RAG s \<union> {(Th th, Cs cs)})" (is "?L = ?R") |
|
3721 by simp |
|
3722 moreover have "acyclic ?R" |
|
3723 proof(cases "wq s cs = []") |
|
3724 case True |
|
3725 hence eq_r: "?R = RAG s \<union> {(Cs cs, Th th)}" by simp |
|
3726 have "(Th th, Cs cs) \<notin> (RAG s)\<^sup>*" |
|
3727 proof |
|
3728 assume "(Th th, Cs cs) \<in> (RAG s)\<^sup>*" |
|
3729 hence "(Th th, Cs cs) \<in> (RAG s)\<^sup>+" by (simp add: rtrancl_eq_or_trancl) |
|
3730 from tranclD2 [OF this] |
|
3731 obtain x where "(x, Cs cs) \<in> RAG s" by auto |
|
3732 with True show False by (auto simp:s_RAG_def cs_waiting_def) |
|
3733 qed |
|
3734 with acyclic_insert ih eq_r show ?thesis by auto |
|
3735 next |
|
3736 case False |
|
3737 hence eq_r: "?R = RAG s \<union> {(Th th, Cs cs)}" by simp |
|
3738 have "(Cs cs, Th th) \<notin> (RAG s)\<^sup>*" |
|
3739 proof |
|
3740 assume "(Cs cs, Th th) \<in> (RAG s)\<^sup>*" |
|
3741 hence "(Cs cs, Th th) \<in> (RAG s)\<^sup>+" by (simp add: rtrancl_eq_or_trancl) |
|
3742 moreover from step_back_step [OF vtt] have "step s (P th cs)" . |
|
3743 ultimately show False |
|
3744 proof - |
|
3745 show " \<lbrakk>(Cs cs, Th th) \<in> (RAG s)\<^sup>+; step s (P th cs)\<rbrakk> \<Longrightarrow> False" |
|
3746 by (ind_cases "step s (P th cs)", simp) |
|
3747 qed |
|
3748 qed |
|
3749 with acyclic_insert ih eq_r show ?thesis by auto |
|
3750 qed |
|
3751 ultimately show ?thesis by simp |
|
3752 next |
|
3753 case (Set thread prio) |
|
3754 with ih |
|
3755 thm RAG_set_unchanged |
|
3756 show ?thesis by (simp add:RAG_set_unchanged) |
|
3757 qed |
|
3758 next |
|
3759 case vt_nil |
|
3760 show "acyclic (RAG ([]::state))" |
|
3761 by (auto simp: s_RAG_def cs_waiting_def |
|
3762 cs_holding_def wq_def acyclic_def) |
|
3763 qed |
|
3764 |
|
3765 |
|
3766 lemma finite_RAG: |
|
3767 shows "finite (RAG s)" |
|
3768 proof - |
|
3769 from vt show ?thesis |
|
3770 proof(induct) |
|
3771 case (vt_cons s e) |
|
3772 interpret vt_s: valid_trace s using vt_cons(1) |
|
3773 by (unfold_locales, simp) |
|
3774 assume ih: "finite (RAG s)" |
|
3775 and stp: "step s e" |
|
3776 and vt: "vt s" |
|
3777 show ?case |
|
3778 proof(cases e) |
|
3779 case (Create th prio) |
|
3780 with ih |
|
3781 show ?thesis by (simp add:RAG_create_unchanged) |
|
3782 next |
|
3783 case (Exit th) |
|
3784 with ih show ?thesis by (simp add:RAG_exit_unchanged) |
|
3785 next |
|
3786 case (V th cs) |
|
3787 from V vt stp have vtt: "vt (V th cs#s)" by auto |
|
3788 from step_RAG_v [OF this] |
|
3789 have eq_de: "RAG (e # s) = |
|
3790 RAG s - {(Cs cs, Th th)} - {(Th th', Cs cs) |th'. next_th s th cs th'} \<union> |
|
3791 {(Cs cs, Th th') |th'. next_th s th cs th'} |
|
3792 " |
|
3793 (is "?L = (?A - ?B - ?C) \<union> ?D") by (simp add:V) |
|
3794 moreover from ih have ac: "finite (?A - ?B - ?C)" by simp |
|
3795 moreover have "finite ?D" |
|
3796 proof - |
|
3797 have "?D = {} \<or> (\<exists> a. ?D = {a})" |
|
3798 by (unfold next_th_def, auto) |
|
3799 thus ?thesis |
|
3800 proof |
|
3801 assume h: "?D = {}" |
|
3802 show ?thesis by (unfold h, simp) |
|
3803 next |
|
3804 assume "\<exists> a. ?D = {a}" |
|
3805 thus ?thesis |
|
3806 by (metis finite.simps) |
|
3807 qed |
|
3808 qed |
|
3809 ultimately show ?thesis by simp |
|
3810 next |
|
3811 case (P th cs) |
|
3812 from P vt stp have vtt: "vt (P th cs#s)" by auto |
|
3813 from step_RAG_p [OF this] P |
|
3814 have "RAG (e # s) = |
|
3815 (if wq s cs = [] then RAG s \<union> {(Cs cs, Th th)} else |
|
3816 RAG s \<union> {(Th th, Cs cs)})" (is "?L = ?R") |
|
3817 by simp |
|
3818 moreover have "finite ?R" |
|
3819 proof(cases "wq s cs = []") |
|
3820 case True |
|
3821 hence eq_r: "?R = RAG s \<union> {(Cs cs, Th th)}" by simp |
|
3822 with True and ih show ?thesis by auto |
|
3823 next |
|
3824 case False |
|
3825 hence "?R = RAG s \<union> {(Th th, Cs cs)}" by simp |
|
3826 with False and ih show ?thesis by auto |
|
3827 qed |
|
3828 ultimately show ?thesis by auto |
|
3829 next |
|
3830 case (Set thread prio) |
|
3831 with ih |
|
3832 show ?thesis by (simp add:RAG_set_unchanged) |
|
3833 qed |
|
3834 next |
|
3835 case vt_nil |
|
3836 show "finite (RAG ([]::state))" |
|
3837 by (auto simp: s_RAG_def cs_waiting_def |
|
3838 cs_holding_def wq_def acyclic_def) |
|
3839 qed |
|
3840 qed |
|
3841 |
|
3842 text {* Several useful lemmas *} |
|
3843 |
|
3844 lemma wf_dep_converse: |
|
3845 shows "wf ((RAG s)^-1)" |
|
3846 proof(rule finite_acyclic_wf_converse) |
|
3847 from finite_RAG |
|
3848 show "finite (RAG s)" . |
|
3849 next |
|
3850 from acyclic_RAG |
|
3851 show "acyclic (RAG s)" . |
|
3852 qed |
|
3853 >>>>>>> other |
|
3854 |
|
3855 end |
|
3856 |
|
3857 lemma hd_np_in: "x \<in> set l \<Longrightarrow> hd l \<in> set l" |
|
3858 by (induct l, auto) |
|
3859 |
|
3860 lemma th_chasing: "(Th th, Cs cs) \<in> RAG (s::state) \<Longrightarrow> \<exists> th'. (Cs cs, Th th') \<in> RAG s" |
|
3861 by (auto simp:s_RAG_def s_holding_def cs_holding_def cs_waiting_def wq_def dest:hd_np_in) |
|
3862 |
|
3863 context valid_trace |
|
3864 begin |
|
3865 |
|
3866 lemma wq_threads: |
|
3867 assumes h: "th \<in> set (wq s cs)" |
|
3868 shows "th \<in> threads s" |
|
3869 proof - |
|
3870 from vt and h show ?thesis |
|
3871 proof(induct arbitrary: th cs) |
|
3872 case (vt_cons s e) |
|
3873 interpret vt_s: valid_trace s |
|
3874 using vt_cons(1) by (unfold_locales, auto) |
|
3875 assume ih: "\<And>th cs. th \<in> set (wq s cs) \<Longrightarrow> th \<in> threads s" |
|
3876 and stp: "step s e" |
|
3877 and vt: "vt s" |
|
3878 and h: "th \<in> set (wq (e # s) cs)" |
|
3879 show ?case |
|
3880 proof(cases e) |
|
3881 case (Create th' prio) |
|
3882 with ih h show ?thesis |
|
3883 by (auto simp:wq_def Let_def) |
|
3884 next |
|
3885 case (Exit th') |
|
3886 with stp ih h show ?thesis |
|
3887 apply (auto simp:wq_def Let_def) |
|
3888 apply (ind_cases "step s (Exit th')") |
|
3889 apply (auto simp:runing_def readys_def s_holding_def s_waiting_def holdents_def |
|
3890 s_RAG_def s_holding_def cs_holding_def) |
|
3891 done |
|
3892 next |
|
3893 case (V th' cs') |
|
3894 show ?thesis |
|
3895 proof(cases "cs' = cs") |
|
3896 case False |
|
3897 with h |
|
3898 show ?thesis |
|
3899 apply(unfold wq_def V, auto simp:Let_def V split:prod.splits, fold wq_def) |
|
3900 by (drule_tac ih, simp) |
|
3901 next |
|
3902 case True |
|
3903 from h |
|
3904 show ?thesis |
|
3905 proof(unfold V wq_def) |
|
3906 assume th_in: "th \<in> set (wq_fun (schs (V th' cs' # s)) cs)" (is "th \<in> set ?l") |
|
3907 show "th \<in> threads (V th' cs' # s)" |
|
3908 proof(cases "cs = cs'") |
|
3909 case False |
|
3910 hence "?l = wq_fun (schs s) cs" by (simp add:Let_def) |
|
3911 with th_in have " th \<in> set (wq s cs)" |
|
3912 by (fold wq_def, simp) |
|
3913 from ih [OF this] show ?thesis by simp |
|
3914 next |
|
3915 case True |
|
3916 show ?thesis |
|
3917 proof(cases "wq_fun (schs s) cs'") |
|
3918 case Nil |
|
3919 with h V show ?thesis |
|
3920 apply (auto simp:wq_def Let_def split:if_splits) |
|
3921 by (fold wq_def, drule_tac ih, simp) |
|
3922 next |
|
3923 case (Cons a rest) |
|
3924 assume eq_wq: "wq_fun (schs s) cs' = a # rest" |
|
3925 with h V show ?thesis |
|
3926 apply (auto simp:Let_def wq_def split:if_splits) |
|
3927 proof - |
|
3928 assume th_in: "th \<in> set (SOME q. distinct q \<and> set q = set rest)" |
|
3929 have "set (SOME q. distinct q \<and> set q = set rest) = set rest" |
|
3930 proof(rule someI2) |
|
3931 from vt_s.wq_distinct[of cs'] and eq_wq[folded wq_def] |
|
3932 show "distinct rest \<and> set rest = set rest" by auto |
|
3933 next |
|
3934 show "\<And>x. distinct x \<and> set x = set rest \<Longrightarrow> set x = set rest" |
|
3935 by auto |
|
3936 qed |
|
3937 with eq_wq th_in have "th \<in> set (wq_fun (schs s) cs')" by auto |
|
3938 from ih[OF this[folded wq_def]] show "th \<in> threads s" . |
|
3939 next |
|
3940 assume th_in: "th \<in> set (wq_fun (schs s) cs)" |
|
3941 from ih[OF this[folded wq_def]] |
|
3942 show "th \<in> threads s" . |
|
3943 qed |
|
3944 qed |
|
3945 qed |
|
3946 qed |
|
3947 qed |
|
3948 next |
|
3949 case (P th' cs') |
|
3950 from h stp |
|
3951 show ?thesis |
|
3952 apply (unfold P wq_def) |
|
3953 apply (auto simp:Let_def split:if_splits, fold wq_def) |
|
3954 apply (auto intro:ih) |
|
3955 apply(ind_cases "step s (P th' cs')") |
|
3956 by (unfold runing_def readys_def, auto) |
|
3957 next |
|
3958 case (Set thread prio) |
|
3959 with ih h show ?thesis |
|
3960 by (auto simp:wq_def Let_def) |
|
3961 qed |
|
3962 next |
|
3963 case vt_nil |
|
3964 thus ?case by (auto simp:wq_def) |
|
3965 qed |
|
3966 qed |
|
3967 |
|
3968 lemma range_in: "\<lbrakk>(Th th) \<in> Range (RAG (s::state))\<rbrakk> \<Longrightarrow> th \<in> threads s" |
|
3969 apply(unfold s_RAG_def cs_waiting_def cs_holding_def) |
|
3970 by (auto intro:wq_threads) |
|
3971 |
|
3972 lemma readys_v_eq: |
|
3973 assumes neq_th: "th \<noteq> thread" |
|
3974 and eq_wq: "wq s cs = thread#rest" |
|
3975 and not_in: "th \<notin> set rest" |
|
3976 shows "(th \<in> readys (V thread cs#s)) = (th \<in> readys s)" |
|
3977 proof - |
|
3978 from assms show ?thesis |
|
3979 apply (auto simp:readys_def) |
|
3980 apply(simp add:s_waiting_def[folded wq_def]) |
|
3981 apply (erule_tac x = csa in allE) |
|
3982 apply (simp add:s_waiting_def wq_def Let_def split:if_splits) |
|
3983 apply (case_tac "csa = cs", simp) |
|
3984 apply (erule_tac x = cs in allE) |
|
3985 apply(auto simp add: s_waiting_def[folded wq_def] Let_def split: list.splits) |
|
3986 apply(auto simp add: wq_def) |
|
3987 apply (auto simp:s_waiting_def wq_def Let_def split:list.splits) |
|
3988 proof - |
|
3989 assume th_nin: "th \<notin> set rest" |
|
3990 and th_in: "th \<in> set (SOME q. distinct q \<and> set q = set rest)" |
|
3991 and eq_wq: "wq_fun (schs s) cs = thread # rest" |
|
3992 have "set (SOME q. distinct q \<and> set q = set rest) = set rest" |
|
3993 proof(rule someI2) |
|
3994 from wq_distinct[of cs, unfolded wq_def] and eq_wq[unfolded wq_def] |
|
3995 show "distinct rest \<and> set rest = set rest" by auto |
|
3996 next |
|
3997 show "\<And>x. distinct x \<and> set x = set rest \<Longrightarrow> set x = set rest" by auto |
|
3998 qed |
|
3999 with th_nin th_in show False by auto |
|
4000 qed |
|
4001 qed |
|
4002 |
|
4003 text {* \noindent |
|
4004 The following lemmas shows that: starting from any node in @{text "RAG"}, |
|
4005 by chasing out-going edges, it is always possible to reach a node representing a ready |
|
4006 thread. In this lemma, it is the @{text "th'"}. |
|
4007 *} |
|
4008 |
2706 |
4009 lemma chain_building: |
2707 lemma chain_building: |
4010 shows "node \<in> Domain (RAG s) \<longrightarrow> (\<exists> th'. th' \<in> readys s \<and> (node, Th th') \<in> (RAG s)^+)" |
2708 assumes "node \<in> Domain (RAG s)" |
4011 proof - |
2709 obtains th' where "th' \<in> readys s" "(node, Th th') \<in> (RAG s)^+" |
4012 from wf_dep_converse |
2710 proof - |
4013 have h: "wf ((RAG s)\<inverse>)" . |
2711 from assms have "node \<in> Range ((RAG s)^-1)" by auto |
4014 show ?thesis |
2712 from wf_base[OF wf_RAG_converse this] |
4015 proof(induct rule:wf_induct [OF h]) |
2713 obtain b where h_b: "(b, node) \<in> ((RAG s)\<inverse>)\<^sup>+" "\<forall>c. (c, b) \<notin> (RAG s)\<inverse>" by auto |
4016 fix x |
2714 obtain th' where eq_b: "b = Th th'" |
4017 assume ih [rule_format]: |
2715 proof(cases b) |
4018 "\<forall>y. (y, x) \<in> (RAG s)\<inverse> \<longrightarrow> |
2716 case (Cs cs) |
4019 y \<in> Domain (RAG s) \<longrightarrow> (\<exists>th'. th' \<in> readys s \<and> (y, Th th') \<in> (RAG s)\<^sup>+)" |
2717 from h_b(1)[unfolded trancl_converse] |
4020 show "x \<in> Domain (RAG s) \<longrightarrow> (\<exists>th'. th' \<in> readys s \<and> (x, Th th') \<in> (RAG s)\<^sup>+)" |
2718 have "(node, b) \<in> ((RAG s)\<^sup>+)" by auto |
4021 proof |
2719 from tranclE[OF this] |
4022 assume x_d: "x \<in> Domain (RAG s)" |
2720 obtain n where "(n, b) \<in> RAG s" by auto |
4023 show "\<exists>th'. th' \<in> readys s \<and> (x, Th th') \<in> (RAG s)\<^sup>+" |
2721 from this[unfolded Cs] |
4024 proof(cases x) |
2722 obtain th1 where "waiting s th1 cs" |
4025 case (Th th) |
2723 by (unfold s_RAG_def, fold waiting_eq, auto) |
4026 from x_d Th obtain cs where x_in: "(Th th, Cs cs) \<in> RAG s" by (auto simp:s_RAG_def) |
2724 from waiting_holding[OF this] |
4027 with Th have x_in_r: "(Cs cs, x) \<in> (RAG s)^-1" by simp |
2725 obtain th2 where "holding s th2 cs" . |
4028 from th_chasing [OF x_in] obtain th' where "(Cs cs, Th th') \<in> RAG s" by blast |
2726 hence "(Cs cs, Th th2) \<in> RAG s" |
4029 hence "Cs cs \<in> Domain (RAG s)" by auto |
2727 by (unfold s_RAG_def, fold holding_eq, auto) |
4030 from ih [OF x_in_r this] obtain th' |
2728 with h_b(2)[unfolded Cs, rule_format] |
4031 where th'_ready: " th' \<in> readys s" and cs_in: "(Cs cs, Th th') \<in> (RAG s)\<^sup>+" by auto |
2729 have False by auto |
4032 have "(x, Th th') \<in> (RAG s)\<^sup>+" using Th x_in cs_in by auto |
2730 thus ?thesis by auto |
4033 with th'_ready show ?thesis by auto |
2731 qed auto |
4034 next |
2732 have "th' \<in> readys s" |
4035 case (Cs cs) |
2733 proof - |
4036 from x_d Cs obtain th' where th'_d: "(Th th', x) \<in> (RAG s)^-1" by (auto simp:s_RAG_def) |
2734 from h_b(2)[unfolded eq_b] |
4037 show ?thesis |
2735 have "\<forall>cs. \<not> waiting s th' cs" |
4038 proof(cases "th' \<in> readys s") |
2736 by (unfold s_RAG_def, fold waiting_eq, auto) |
4039 case True |
2737 moreover have "th' \<in> threads s" |
4040 from True and th'_d show ?thesis by auto |
2738 proof(rule rg_RAG_threads) |
4041 next |
2739 from tranclD[OF h_b(1), unfolded eq_b] |
4042 case False |
2740 obtain z where "(z, Th th') \<in> (RAG s)" by auto |
4043 from th'_d and range_in have "th' \<in> threads s" by auto |
2741 thus "Th th' \<in> Range (RAG s)" by auto |
4044 with False have "Th th' \<in> Domain (RAG s)" |
2742 qed |
4045 by (auto simp:readys_def wq_def s_waiting_def s_RAG_def cs_waiting_def Domain_def) |
2743 ultimately show ?thesis by (auto simp:readys_def) |
4046 from ih [OF th'_d this] |
2744 qed |
4047 obtain th'' where |
2745 moreover have "(node, Th th') \<in> (RAG s)^+" |
4048 th''_r: "th'' \<in> readys s" and |
2746 using h_b(1)[unfolded trancl_converse] eq_b by auto |
4049 th''_in: "(Th th', Th th'') \<in> (RAG s)\<^sup>+" by auto |
2747 ultimately show ?thesis using that by metis |
4050 from th'_d and th''_in |
|
4051 have "(x, Th th'') \<in> (RAG s)\<^sup>+" by auto |
|
4052 with th''_r show ?thesis by auto |
|
4053 qed |
|
4054 qed |
|
4055 qed |
|
4056 qed |
|
4057 qed |
2748 qed |
4058 |
2749 |
4059 text {* \noindent |
2750 text {* \noindent |
4060 The following is just an instance of @{text "chain_building"}. |
2751 The following is just an instance of @{text "chain_building"}. |
4061 *} |
2752 *} |
4071 by (auto simp:readys_def s_waiting_def s_RAG_def wq_def cs_waiting_def Domain_def) |
2762 by (auto simp:readys_def s_waiting_def s_RAG_def wq_def cs_waiting_def Domain_def) |
4072 from chain_building [rule_format, OF this] |
2763 from chain_building [rule_format, OF this] |
4073 show ?thesis by auto |
2764 show ?thesis by auto |
4074 qed |
2765 qed |
4075 |
2766 |
4076 <<<<<<< local |
|
4077 lemma finite_subtree_threads: |
2767 lemma finite_subtree_threads: |
4078 "finite {th'. Th th' \<in> subtree (RAG s) (Th th)}" (is "finite ?A") |
2768 "finite {th'. Th th' \<in> subtree (RAG s) (Th th)}" (is "finite ?A") |
4079 ======= |
2769 proof - |
4080 end |
|
4081 |
|
4082 lemma waiting_eq: "waiting s th cs = waiting (wq s) th cs" |
|
4083 by (unfold s_waiting_def cs_waiting_def wq_def, auto) |
|
4084 |
|
4085 lemma holding_eq: "holding (s::state) th cs = holding (wq s) th cs" |
|
4086 by (unfold s_holding_def wq_def cs_holding_def, simp) |
|
4087 |
|
4088 lemma holding_unique: "\<lbrakk>holding (s::state) th1 cs; holding s th2 cs\<rbrakk> \<Longrightarrow> th1 = th2" |
|
4089 by (unfold s_holding_def cs_holding_def, auto) |
|
4090 |
|
4091 context valid_trace |
|
4092 begin |
|
4093 |
|
4094 lemma unique_RAG: "\<lbrakk>(n, n1) \<in> RAG s; (n, n2) \<in> RAG s\<rbrakk> \<Longrightarrow> n1 = n2" |
|
4095 apply(unfold s_RAG_def, auto, fold waiting_eq holding_eq) |
|
4096 by(auto elim:waiting_unique holding_unique) |
|
4097 |
|
4098 end |
|
4099 |
|
4100 |
|
4101 lemma trancl_split: "(a, b) \<in> r^+ \<Longrightarrow> \<exists> c. (a, c) \<in> r" |
|
4102 by (induct rule:trancl_induct, auto) |
|
4103 |
|
4104 context valid_trace |
|
4105 begin |
|
4106 |
|
4107 lemma dchain_unique: |
|
4108 assumes th1_d: "(n, Th th1) \<in> (RAG s)^+" |
|
4109 and th1_r: "th1 \<in> readys s" |
|
4110 and th2_d: "(n, Th th2) \<in> (RAG s)^+" |
|
4111 and th2_r: "th2 \<in> readys s" |
|
4112 shows "th1 = th2" |
|
4113 proof - |
|
4114 { assume neq: "th1 \<noteq> th2" |
|
4115 hence "Th th1 \<noteq> Th th2" by simp |
|
4116 from unique_chain [OF _ th1_d th2_d this] and unique_RAG |
|
4117 have "(Th th1, Th th2) \<in> (RAG s)\<^sup>+ \<or> (Th th2, Th th1) \<in> (RAG s)\<^sup>+" by auto |
|
4118 hence "False" |
|
4119 proof |
|
4120 assume "(Th th1, Th th2) \<in> (RAG s)\<^sup>+" |
|
4121 from trancl_split [OF this] |
|
4122 obtain n where dd: "(Th th1, n) \<in> RAG s" by auto |
|
4123 then obtain cs where eq_n: "n = Cs cs" |
|
4124 by (auto simp:s_RAG_def s_holding_def cs_holding_def cs_waiting_def wq_def dest:hd_np_in) |
|
4125 from dd eq_n have "th1 \<notin> readys s" |
|
4126 by (auto simp:readys_def s_RAG_def wq_def s_waiting_def cs_waiting_def) |
|
4127 with th1_r show ?thesis by auto |
|
4128 next |
|
4129 assume "(Th th2, Th th1) \<in> (RAG s)\<^sup>+" |
|
4130 from trancl_split [OF this] |
|
4131 obtain n where dd: "(Th th2, n) \<in> RAG s" by auto |
|
4132 then obtain cs where eq_n: "n = Cs cs" |
|
4133 by (auto simp:s_RAG_def s_holding_def cs_holding_def cs_waiting_def wq_def dest:hd_np_in) |
|
4134 from dd eq_n have "th2 \<notin> readys s" |
|
4135 by (auto simp:readys_def wq_def s_RAG_def s_waiting_def cs_waiting_def) |
|
4136 with th2_r show ?thesis by auto |
|
4137 qed |
|
4138 } thus ?thesis by auto |
|
4139 qed |
|
4140 |
|
4141 end |
|
4142 |
|
4143 |
|
4144 lemma step_holdents_p_add: |
|
4145 assumes vt: "vt (P th cs#s)" |
|
4146 and "wq s cs = []" |
|
4147 shows "holdents (P th cs#s) th = holdents s th \<union> {cs}" |
|
4148 proof - |
|
4149 from assms show ?thesis |
|
4150 unfolding holdents_test step_RAG_p[OF vt] by (auto) |
|
4151 qed |
|
4152 |
|
4153 lemma step_holdents_p_eq: |
|
4154 assumes vt: "vt (P th cs#s)" |
|
4155 and "wq s cs \<noteq> []" |
|
4156 shows "holdents (P th cs#s) th = holdents s th" |
|
4157 proof - |
|
4158 from assms show ?thesis |
|
4159 unfolding holdents_test step_RAG_p[OF vt] by auto |
|
4160 qed |
|
4161 |
|
4162 |
|
4163 lemma (in valid_trace) finite_holding : |
|
4164 shows "finite (holdents s th)" |
|
4165 proof - |
|
4166 let ?F = "\<lambda> (x, y). the_cs x" |
|
4167 from finite_RAG |
|
4168 have "finite (RAG s)" . |
|
4169 hence "finite (?F `(RAG s))" by simp |
|
4170 moreover have "{cs . (Cs cs, Th th) \<in> RAG s} \<subseteq> \<dots>" |
|
4171 proof - |
|
4172 { have h: "\<And> a A f. a \<in> A \<Longrightarrow> f a \<in> f ` A" by auto |
|
4173 fix x assume "(Cs x, Th th) \<in> RAG s" |
|
4174 hence "?F (Cs x, Th th) \<in> ?F `(RAG s)" by (rule h) |
|
4175 moreover have "?F (Cs x, Th th) = x" by simp |
|
4176 ultimately have "x \<in> (\<lambda>(x, y). the_cs x) ` RAG s" by simp |
|
4177 } thus ?thesis by auto |
|
4178 qed |
|
4179 ultimately show ?thesis by (unfold holdents_test, auto intro:finite_subset) |
|
4180 qed |
|
4181 |
|
4182 lemma cntCS_v_dec: |
|
4183 assumes vtv: "vt (V thread cs#s)" |
|
4184 shows "(cntCS (V thread cs#s) thread + 1) = cntCS s thread" |
|
4185 proof - |
|
4186 from vtv interpret vt_s: valid_trace s |
|
4187 by (cases, unfold_locales, simp) |
|
4188 from vtv interpret vt_v: valid_trace "V thread cs#s" |
|
4189 by (unfold_locales, simp) |
|
4190 from step_back_step[OF vtv] |
|
4191 have cs_in: "cs \<in> holdents s thread" |
|
4192 apply (cases, unfold holdents_test s_RAG_def, simp) |
|
4193 by (unfold cs_holding_def s_holding_def wq_def, auto) |
|
4194 moreover have cs_not_in: |
|
4195 "(holdents (V thread cs#s) thread) = holdents s thread - {cs}" |
|
4196 apply (insert vt_s.wq_distinct[of cs]) |
|
4197 apply (unfold holdents_test, unfold step_RAG_v[OF vtv], |
|
4198 auto simp:next_th_def) |
|
4199 proof - |
|
4200 fix rest |
|
4201 assume dst: "distinct (rest::thread list)" |
|
4202 and ne: "rest \<noteq> []" |
|
4203 and hd_ni: "hd (SOME q. distinct q \<and> set q = set rest) \<notin> set rest" |
|
4204 moreover have "set (SOME q. distinct q \<and> set q = set rest) = set rest" |
|
4205 proof(rule someI2) |
|
4206 from dst show "distinct rest \<and> set rest = set rest" by auto |
|
4207 next |
|
4208 show "\<And>x. distinct x \<and> set x = set rest \<Longrightarrow> set x = set rest" by auto |
|
4209 qed |
|
4210 ultimately have "hd (SOME q. distinct q \<and> set q = set rest) \<notin> |
|
4211 set (SOME q. distinct q \<and> set q = set rest)" by simp |
|
4212 moreover have "(SOME q. distinct q \<and> set q = set rest) \<noteq> []" |
|
4213 proof(rule someI2) |
|
4214 from dst show "distinct rest \<and> set rest = set rest" by auto |
|
4215 next |
|
4216 fix x assume " distinct x \<and> set x = set rest" with ne |
|
4217 show "x \<noteq> []" by auto |
|
4218 qed |
|
4219 ultimately |
|
4220 show "(Cs cs, Th (hd (SOME q. distinct q \<and> set q = set rest))) \<in> RAG s" |
|
4221 by auto |
|
4222 next |
|
4223 fix rest |
|
4224 assume dst: "distinct (rest::thread list)" |
|
4225 and ne: "rest \<noteq> []" |
|
4226 and hd_ni: "hd (SOME q. distinct q \<and> set q = set rest) \<notin> set rest" |
|
4227 moreover have "set (SOME q. distinct q \<and> set q = set rest) = set rest" |
|
4228 proof(rule someI2) |
|
4229 from dst show "distinct rest \<and> set rest = set rest" by auto |
|
4230 next |
|
4231 show "\<And>x. distinct x \<and> set x = set rest \<Longrightarrow> set x = set rest" by auto |
|
4232 qed |
|
4233 ultimately have "hd (SOME q. distinct q \<and> set q = set rest) \<notin> |
|
4234 set (SOME q. distinct q \<and> set q = set rest)" by simp |
|
4235 moreover have "(SOME q. distinct q \<and> set q = set rest) \<noteq> []" |
|
4236 proof(rule someI2) |
|
4237 from dst show "distinct rest \<and> set rest = set rest" by auto |
|
4238 next |
|
4239 fix x assume " distinct x \<and> set x = set rest" with ne |
|
4240 show "x \<noteq> []" by auto |
|
4241 qed |
|
4242 ultimately show "False" by auto |
|
4243 qed |
|
4244 ultimately |
|
4245 have "holdents s thread = insert cs (holdents (V thread cs#s) thread)" |
|
4246 by auto |
|
4247 moreover have "card \<dots> = |
|
4248 Suc (card ((holdents (V thread cs#s) thread) - {cs}))" |
|
4249 proof(rule card_insert) |
|
4250 from vt_v.finite_holding |
|
4251 show " finite (holdents (V thread cs # s) thread)" . |
|
4252 qed |
|
4253 moreover from cs_not_in |
|
4254 have "cs \<notin> (holdents (V thread cs#s) thread)" by auto |
|
4255 ultimately show ?thesis by (simp add:cntCS_def) |
|
4256 qed |
|
4257 |
|
4258 lemma count_rec1 [simp]: |
|
4259 assumes "Q e" |
|
4260 shows "count Q (e#es) = Suc (count Q es)" |
|
4261 using assms |
|
4262 by (unfold count_def, auto) |
|
4263 |
|
4264 lemma count_rec2 [simp]: |
|
4265 assumes "\<not>Q e" |
|
4266 shows "count Q (e#es) = (count Q es)" |
|
4267 using assms |
|
4268 by (unfold count_def, auto) |
|
4269 |
|
4270 lemma count_rec3 [simp]: |
|
4271 shows "count Q [] = 0" |
|
4272 by (unfold count_def, auto) |
|
4273 |
|
4274 lemma cntP_diff_inv: |
|
4275 assumes "cntP (e#s) th \<noteq> cntP s th" |
|
4276 shows "isP e \<and> actor e = th" |
|
4277 proof(cases e) |
|
4278 case (P th' pty) |
|
4279 show ?thesis |
|
4280 by (cases "(\<lambda>e. \<exists>cs. e = P th cs) (P th' pty)", |
|
4281 insert assms P, auto simp:cntP_def) |
|
4282 qed (insert assms, auto simp:cntP_def) |
|
4283 |
|
4284 lemma isP_E: |
|
4285 assumes "isP e" |
|
4286 obtains cs where "e = P (actor e) cs" |
|
4287 using assms by (cases e, auto) |
|
4288 |
|
4289 lemma isV_E: |
|
4290 assumes "isV e" |
|
4291 obtains cs where "e = V (actor e) cs" |
|
4292 using assms by (cases e, auto) (* ccc *) |
|
4293 |
|
4294 lemma cntV_diff_inv: |
|
4295 assumes "cntV (e#s) th \<noteq> cntV s th" |
|
4296 shows "isV e \<and> actor e = th" |
|
4297 proof(cases e) |
|
4298 case (V th' pty) |
|
4299 show ?thesis |
|
4300 by (cases "(\<lambda>e. \<exists>cs. e = V th cs) (V th' pty)", |
|
4301 insert assms V, auto simp:cntV_def) |
|
4302 qed (insert assms, auto simp:cntV_def) |
|
4303 |
|
4304 context valid_trace |
|
4305 begin |
|
4306 |
|
4307 text {* (* ddd *) \noindent |
|
4308 The relationship between @{text "cntP"}, @{text "cntV"} and @{text "cntCS"} |
|
4309 of one particular thread. |
|
4310 *} |
|
4311 |
|
4312 lemma cnp_cnv_cncs: |
|
4313 shows "cntP s th = cntV s th + (if (th \<in> readys s \<or> th \<notin> threads s) |
|
4314 then cntCS s th else cntCS s th + 1)" |
|
4315 >>>>>>> other |
|
4316 proof - |
|
4317 <<<<<<< local |
|
4318 have "?A = the_thread ` {Th th' | th' . Th th' \<in> subtree (RAG s) (Th th)}" |
2770 have "?A = the_thread ` {Th th' | th' . Th th' \<in> subtree (RAG s) (Th th)}" |
4319 by (auto, insert image_iff, fastforce) |
2771 by (auto, insert image_iff, fastforce) |
4320 moreover have "finite {Th th' | th' . Th th' \<in> subtree (RAG s) (Th th)}" |
2772 moreover have "finite {Th th' | th' . Th th' \<in> subtree (RAG s) (Th th)}" |
4321 (is "finite ?B") |
2773 (is "finite ?B") |
4322 proof - |
2774 proof - |
4325 moreover have "... \<subseteq> (subtree (RAG s) (Th th))" by auto |
2777 moreover have "... \<subseteq> (subtree (RAG s) (Th th))" by auto |
4326 moreover have "finite ..." by (simp add: fsbtRAGs.finite_subtree) |
2778 moreover have "finite ..." by (simp add: fsbtRAGs.finite_subtree) |
4327 ultimately show ?thesis by auto |
2779 ultimately show ?thesis by auto |
4328 qed |
2780 qed |
4329 ultimately show ?thesis by auto |
2781 ultimately show ?thesis by auto |
4330 ======= |
2782 qed |
4331 from vt show ?thesis |
2783 |
4332 proof(induct arbitrary:th) |
|
4333 case (vt_cons s e) |
|
4334 interpret vt_s: valid_trace s using vt_cons(1) by (unfold_locales, simp) |
|
4335 assume vt: "vt s" |
|
4336 and ih: "\<And>th. cntP s th = cntV s th + |
|
4337 (if (th \<in> readys s \<or> th \<notin> threads s) then cntCS s th else cntCS s th + 1)" |
|
4338 and stp: "step s e" |
|
4339 from stp show ?case |
|
4340 proof(cases) |
|
4341 case (thread_create thread prio) |
|
4342 assume eq_e: "e = Create thread prio" |
|
4343 and not_in: "thread \<notin> threads s" |
|
4344 show ?thesis |
|
4345 proof - |
|
4346 { fix cs |
|
4347 assume "thread \<in> set (wq s cs)" |
|
4348 from vt_s.wq_threads [OF this] have "thread \<in> threads s" . |
|
4349 with not_in have "False" by simp |
|
4350 } with eq_e have eq_readys: "readys (e#s) = readys s \<union> {thread}" |
|
4351 by (auto simp:readys_def threads.simps s_waiting_def |
|
4352 wq_def cs_waiting_def Let_def) |
|
4353 from eq_e have eq_cnp: "cntP (e#s) th = cntP s th" by (simp add:cntP_def count_def) |
|
4354 from eq_e have eq_cnv: "cntV (e#s) th = cntV s th" by (simp add:cntV_def count_def) |
|
4355 have eq_cncs: "cntCS (e#s) th = cntCS s th" |
|
4356 unfolding cntCS_def holdents_test |
|
4357 by (simp add:RAG_create_unchanged eq_e) |
|
4358 { assume "th \<noteq> thread" |
|
4359 with eq_readys eq_e |
|
4360 have "(th \<in> readys (e # s) \<or> th \<notin> threads (e # s)) = |
|
4361 (th \<in> readys (s) \<or> th \<notin> threads (s))" |
|
4362 by (simp add:threads.simps) |
|
4363 with eq_cnp eq_cnv eq_cncs ih not_in |
|
4364 have ?thesis by simp |
|
4365 } moreover { |
|
4366 assume eq_th: "th = thread" |
|
4367 with not_in ih have " cntP s th = cntV s th + cntCS s th" by simp |
|
4368 moreover from eq_th and eq_readys have "th \<in> readys (e#s)" by simp |
|
4369 moreover note eq_cnp eq_cnv eq_cncs |
|
4370 ultimately have ?thesis by auto |
|
4371 } ultimately show ?thesis by blast |
|
4372 qed |
|
4373 next |
|
4374 case (thread_exit thread) |
|
4375 assume eq_e: "e = Exit thread" |
|
4376 and is_runing: "thread \<in> runing s" |
|
4377 and no_hold: "holdents s thread = {}" |
|
4378 from eq_e have eq_cnp: "cntP (e#s) th = cntP s th" by (simp add:cntP_def count_def) |
|
4379 from eq_e have eq_cnv: "cntV (e#s) th = cntV s th" by (simp add:cntV_def count_def) |
|
4380 have eq_cncs: "cntCS (e#s) th = cntCS s th" |
|
4381 unfolding cntCS_def holdents_test |
|
4382 by (simp add:RAG_exit_unchanged eq_e) |
|
4383 { assume "th \<noteq> thread" |
|
4384 with eq_e |
|
4385 have "(th \<in> readys (e # s) \<or> th \<notin> threads (e # s)) = |
|
4386 (th \<in> readys (s) \<or> th \<notin> threads (s))" |
|
4387 apply (simp add:threads.simps readys_def) |
|
4388 apply (subst s_waiting_def) |
|
4389 apply (simp add:Let_def) |
|
4390 apply (subst s_waiting_def, simp) |
|
4391 done |
|
4392 with eq_cnp eq_cnv eq_cncs ih |
|
4393 have ?thesis by simp |
|
4394 } moreover { |
|
4395 assume eq_th: "th = thread" |
|
4396 with ih is_runing have " cntP s th = cntV s th + cntCS s th" |
|
4397 by (simp add:runing_def) |
|
4398 moreover from eq_th eq_e have "th \<notin> threads (e#s)" |
|
4399 by simp |
|
4400 moreover note eq_cnp eq_cnv eq_cncs |
|
4401 ultimately have ?thesis by auto |
|
4402 } ultimately show ?thesis by blast |
|
4403 next |
|
4404 case (thread_P thread cs) |
|
4405 assume eq_e: "e = P thread cs" |
|
4406 and is_runing: "thread \<in> runing s" |
|
4407 and no_dep: "(Cs cs, Th thread) \<notin> (RAG s)\<^sup>+" |
|
4408 from thread_P vt stp ih have vtp: "vt (P thread cs#s)" by auto |
|
4409 then interpret vt_p: valid_trace "(P thread cs#s)" |
|
4410 by (unfold_locales, simp) |
|
4411 show ?thesis |
|
4412 proof - |
|
4413 { have hh: "\<And> A B C. (B = C) \<Longrightarrow> (A \<and> B) = (A \<and> C)" by blast |
|
4414 assume neq_th: "th \<noteq> thread" |
|
4415 with eq_e |
|
4416 have eq_readys: "(th \<in> readys (e#s)) = (th \<in> readys (s))" |
|
4417 apply (simp add:readys_def s_waiting_def wq_def Let_def) |
|
4418 apply (rule_tac hh) |
|
4419 apply (intro iffI allI, clarify) |
|
4420 apply (erule_tac x = csa in allE, auto) |
|
4421 apply (subgoal_tac "wq_fun (schs s) cs \<noteq> []", auto) |
|
4422 apply (erule_tac x = cs in allE, auto) |
|
4423 by (case_tac "(wq_fun (schs s) cs)", auto) |
|
4424 moreover from neq_th eq_e have "cntCS (e # s) th = cntCS s th" |
|
4425 apply (simp add:cntCS_def holdents_test) |
|
4426 by (unfold step_RAG_p [OF vtp], auto) |
|
4427 moreover from eq_e neq_th have "cntP (e # s) th = cntP s th" |
|
4428 by (simp add:cntP_def count_def) |
|
4429 moreover from eq_e neq_th have "cntV (e#s) th = cntV s th" |
|
4430 by (simp add:cntV_def count_def) |
|
4431 moreover from eq_e neq_th have "threads (e#s) = threads s" by simp |
|
4432 moreover note ih [of th] |
|
4433 ultimately have ?thesis by simp |
|
4434 } moreover { |
|
4435 assume eq_th: "th = thread" |
|
4436 have ?thesis |
|
4437 proof - |
|
4438 from eq_e eq_th have eq_cnp: "cntP (e # s) th = 1 + (cntP s th)" |
|
4439 by (simp add:cntP_def count_def) |
|
4440 from eq_e eq_th have eq_cnv: "cntV (e#s) th = cntV s th" |
|
4441 by (simp add:cntV_def count_def) |
|
4442 show ?thesis |
|
4443 proof (cases "wq s cs = []") |
|
4444 case True |
|
4445 with is_runing |
|
4446 have "th \<in> readys (e#s)" |
|
4447 apply (unfold eq_e wq_def, unfold readys_def s_RAG_def) |
|
4448 apply (simp add: wq_def[symmetric] runing_def eq_th s_waiting_def) |
|
4449 by (auto simp:readys_def wq_def Let_def s_waiting_def wq_def) |
|
4450 moreover have "cntCS (e # s) th = 1 + cntCS s th" |
|
4451 proof - |
|
4452 have "card {csa. csa = cs \<or> (Cs csa, Th thread) \<in> RAG s} = |
|
4453 Suc (card {cs. (Cs cs, Th thread) \<in> RAG s})" (is "card ?L = Suc (card ?R)") |
|
4454 proof - |
|
4455 have "?L = insert cs ?R" by auto |
|
4456 moreover have "card \<dots> = Suc (card (?R - {cs}))" |
|
4457 proof(rule card_insert) |
|
4458 from vt_s.finite_holding [of thread] |
|
4459 show " finite {cs. (Cs cs, Th thread) \<in> RAG s}" |
|
4460 by (unfold holdents_test, simp) |
|
4461 qed |
|
4462 moreover have "?R - {cs} = ?R" |
|
4463 proof - |
|
4464 have "cs \<notin> ?R" |
|
4465 proof |
|
4466 assume "cs \<in> {cs. (Cs cs, Th thread) \<in> RAG s}" |
|
4467 with no_dep show False by auto |
|
4468 qed |
|
4469 thus ?thesis by auto |
|
4470 qed |
|
4471 ultimately show ?thesis by auto |
|
4472 qed |
|
4473 thus ?thesis |
|
4474 apply (unfold eq_e eq_th cntCS_def) |
|
4475 apply (simp add: holdents_test) |
|
4476 by (unfold step_RAG_p [OF vtp], auto simp:True) |
|
4477 qed |
|
4478 moreover from is_runing have "th \<in> readys s" |
|
4479 by (simp add:runing_def eq_th) |
|
4480 moreover note eq_cnp eq_cnv ih [of th] |
|
4481 ultimately show ?thesis by auto |
|
4482 next |
|
4483 case False |
|
4484 have eq_wq: "wq (e#s) cs = wq s cs @ [th]" |
|
4485 by (unfold eq_th eq_e wq_def, auto simp:Let_def) |
|
4486 have "th \<notin> readys (e#s)" |
|
4487 proof |
|
4488 assume "th \<in> readys (e#s)" |
|
4489 hence "\<forall>cs. \<not> waiting (e # s) th cs" by (simp add:readys_def) |
|
4490 from this[rule_format, of cs] have " \<not> waiting (e # s) th cs" . |
|
4491 hence "th \<in> set (wq (e#s) cs) \<Longrightarrow> th = hd (wq (e#s) cs)" |
|
4492 by (simp add:s_waiting_def wq_def) |
|
4493 moreover from eq_wq have "th \<in> set (wq (e#s) cs)" by auto |
|
4494 ultimately have "th = hd (wq (e#s) cs)" by blast |
|
4495 with eq_wq have "th = hd (wq s cs @ [th])" by simp |
|
4496 hence "th = hd (wq s cs)" using False by auto |
|
4497 with False eq_wq vt_p.wq_distinct [of cs] |
|
4498 show False by (fold eq_e, auto) |
|
4499 qed |
|
4500 moreover from is_runing have "th \<in> threads (e#s)" |
|
4501 by (unfold eq_e, auto simp:runing_def readys_def eq_th) |
|
4502 moreover have "cntCS (e # s) th = cntCS s th" |
|
4503 apply (unfold cntCS_def holdents_test eq_e step_RAG_p[OF vtp]) |
|
4504 by (auto simp:False) |
|
4505 moreover note eq_cnp eq_cnv ih[of th] |
|
4506 moreover from is_runing have "th \<in> readys s" |
|
4507 by (simp add:runing_def eq_th) |
|
4508 ultimately show ?thesis by auto |
|
4509 qed |
|
4510 qed |
|
4511 } ultimately show ?thesis by blast |
|
4512 qed |
|
4513 next |
|
4514 case (thread_V thread cs) |
|
4515 from assms vt stp ih thread_V have vtv: "vt (V thread cs # s)" by auto |
|
4516 then interpret vt_v: valid_trace "(V thread cs # s)" by (unfold_locales, simp) |
|
4517 assume eq_e: "e = V thread cs" |
|
4518 and is_runing: "thread \<in> runing s" |
|
4519 and hold: "holding s thread cs" |
|
4520 from hold obtain rest |
|
4521 where eq_wq: "wq s cs = thread # rest" |
|
4522 by (case_tac "wq s cs", auto simp: wq_def s_holding_def) |
|
4523 have eq_threads: "threads (e#s) = threads s" by (simp add: eq_e) |
|
4524 have eq_set: "set (SOME q. distinct q \<and> set q = set rest) = set rest" |
|
4525 proof(rule someI2) |
|
4526 from vt_v.wq_distinct[of cs] and eq_wq |
|
4527 show "distinct rest \<and> set rest = set rest" |
|
4528 by (metis distinct.simps(2) vt_s.wq_distinct) |
|
4529 next |
|
4530 show "\<And>x. distinct x \<and> set x = set rest \<Longrightarrow> set x = set rest" |
|
4531 by auto |
|
4532 qed |
|
4533 show ?thesis |
|
4534 proof - |
|
4535 { assume eq_th: "th = thread" |
|
4536 from eq_th have eq_cnp: "cntP (e # s) th = cntP s th" |
|
4537 by (unfold eq_e, simp add:cntP_def count_def) |
|
4538 moreover from eq_th have eq_cnv: "cntV (e#s) th = 1 + cntV s th" |
|
4539 by (unfold eq_e, simp add:cntV_def count_def) |
|
4540 moreover from cntCS_v_dec [OF vtv] |
|
4541 have "cntCS (e # s) thread + 1 = cntCS s thread" |
|
4542 by (simp add:eq_e) |
|
4543 moreover from is_runing have rd_before: "thread \<in> readys s" |
|
4544 by (unfold runing_def, simp) |
|
4545 moreover have "thread \<in> readys (e # s)" |
|
4546 proof - |
|
4547 from is_runing |
|
4548 have "thread \<in> threads (e#s)" |
|
4549 by (unfold eq_e, auto simp:runing_def readys_def) |
|
4550 moreover have "\<forall> cs1. \<not> waiting (e#s) thread cs1" |
|
4551 proof |
|
4552 fix cs1 |
|
4553 { assume eq_cs: "cs1 = cs" |
|
4554 have "\<not> waiting (e # s) thread cs1" |
|
4555 proof - |
|
4556 from eq_wq |
|
4557 have "thread \<notin> set (wq (e#s) cs1)" |
|
4558 apply(unfold eq_e wq_def eq_cs s_holding_def) |
|
4559 apply (auto simp:Let_def) |
|
4560 proof - |
|
4561 assume "thread \<in> set (SOME q. distinct q \<and> set q = set rest)" |
|
4562 with eq_set have "thread \<in> set rest" by simp |
|
4563 with vt_v.wq_distinct[of cs] |
|
4564 and eq_wq show False |
|
4565 by (metis distinct.simps(2) vt_s.wq_distinct) |
|
4566 qed |
|
4567 thus ?thesis by (simp add:wq_def s_waiting_def) |
|
4568 qed |
|
4569 } moreover { |
|
4570 assume neq_cs: "cs1 \<noteq> cs" |
|
4571 have "\<not> waiting (e # s) thread cs1" |
|
4572 proof - |
|
4573 from wq_v_neq [OF neq_cs[symmetric]] |
|
4574 have "wq (V thread cs # s) cs1 = wq s cs1" . |
|
4575 moreover have "\<not> waiting s thread cs1" |
|
4576 proof - |
|
4577 from runing_ready and is_runing |
|
4578 have "thread \<in> readys s" by auto |
|
4579 thus ?thesis by (simp add:readys_def) |
|
4580 qed |
|
4581 ultimately show ?thesis |
|
4582 by (auto simp:wq_def s_waiting_def eq_e) |
|
4583 qed |
|
4584 } ultimately show "\<not> waiting (e # s) thread cs1" by blast |
|
4585 qed |
|
4586 ultimately show ?thesis by (simp add:readys_def) |
|
4587 qed |
|
4588 moreover note eq_th ih |
|
4589 ultimately have ?thesis by auto |
|
4590 } moreover { |
|
4591 assume neq_th: "th \<noteq> thread" |
|
4592 from neq_th eq_e have eq_cnp: "cntP (e # s) th = cntP s th" |
|
4593 by (simp add:cntP_def count_def) |
|
4594 from neq_th eq_e have eq_cnv: "cntV (e # s) th = cntV s th" |
|
4595 by (simp add:cntV_def count_def) |
|
4596 have ?thesis |
|
4597 proof(cases "th \<in> set rest") |
|
4598 case False |
|
4599 have "(th \<in> readys (e # s)) = (th \<in> readys s)" |
|
4600 apply (insert step_back_vt[OF vtv]) |
|
4601 by (simp add: False eq_e eq_wq neq_th vt_s.readys_v_eq) |
|
4602 moreover have "cntCS (e#s) th = cntCS s th" |
|
4603 apply (insert neq_th, unfold eq_e cntCS_def holdents_test step_RAG_v[OF vtv], auto) |
|
4604 proof - |
|
4605 have "{csa. (Cs csa, Th th) \<in> RAG s \<or> csa = cs \<and> next_th s thread cs th} = |
|
4606 {cs. (Cs cs, Th th) \<in> RAG s}" |
|
4607 proof - |
|
4608 from False eq_wq |
|
4609 have " next_th s thread cs th \<Longrightarrow> (Cs cs, Th th) \<in> RAG s" |
|
4610 apply (unfold next_th_def, auto) |
|
4611 proof - |
|
4612 assume ne: "rest \<noteq> []" |
|
4613 and ni: "hd (SOME q. distinct q \<and> set q = set rest) \<notin> set rest" |
|
4614 and eq_wq: "wq s cs = thread # rest" |
|
4615 from eq_set ni have "hd (SOME q. distinct q \<and> set q = set rest) \<notin> |
|
4616 set (SOME q. distinct q \<and> set q = set rest) |
|
4617 " by simp |
|
4618 moreover have "(SOME q. distinct q \<and> set q = set rest) \<noteq> []" |
|
4619 proof(rule someI2) |
|
4620 from vt_s.wq_distinct[ of cs] and eq_wq |
|
4621 show "distinct rest \<and> set rest = set rest" by auto |
|
4622 next |
|
4623 fix x assume "distinct x \<and> set x = set rest" |
|
4624 with ne show "x \<noteq> []" by auto |
|
4625 qed |
|
4626 ultimately show |
|
4627 "(Cs cs, Th (hd (SOME q. distinct q \<and> set q = set rest))) \<in> RAG s" |
|
4628 by auto |
|
4629 qed |
|
4630 thus ?thesis by auto |
|
4631 qed |
|
4632 thus "card {csa. (Cs csa, Th th) \<in> RAG s \<or> csa = cs \<and> next_th s thread cs th} = |
|
4633 card {cs. (Cs cs, Th th) \<in> RAG s}" by simp |
|
4634 qed |
|
4635 moreover note ih eq_cnp eq_cnv eq_threads |
|
4636 ultimately show ?thesis by auto |
|
4637 next |
|
4638 case True |
|
4639 assume th_in: "th \<in> set rest" |
|
4640 show ?thesis |
|
4641 proof(cases "next_th s thread cs th") |
|
4642 case False |
|
4643 with eq_wq and th_in have |
|
4644 neq_hd: "th \<noteq> hd (SOME q. distinct q \<and> set q = set rest)" (is "th \<noteq> hd ?rest") |
|
4645 by (auto simp:next_th_def) |
|
4646 have "(th \<in> readys (e # s)) = (th \<in> readys s)" |
|
4647 proof - |
|
4648 from eq_wq and th_in |
|
4649 have "\<not> th \<in> readys s" |
|
4650 apply (auto simp:readys_def s_waiting_def) |
|
4651 apply (rule_tac x = cs in exI, auto) |
|
4652 by (insert vt_s.wq_distinct[of cs], auto simp add: wq_def) |
|
4653 moreover |
|
4654 from eq_wq and th_in and neq_hd |
|
4655 have "\<not> (th \<in> readys (e # s))" |
|
4656 apply (auto simp:readys_def s_waiting_def eq_e wq_def Let_def split:list.splits) |
|
4657 by (rule_tac x = cs in exI, auto simp:eq_set) |
|
4658 ultimately show ?thesis by auto |
|
4659 qed |
|
4660 moreover have "cntCS (e#s) th = cntCS s th" |
|
4661 proof - |
|
4662 from eq_wq and th_in and neq_hd |
|
4663 have "(holdents (e # s) th) = (holdents s th)" |
|
4664 apply (unfold eq_e step_RAG_v[OF vtv], |
|
4665 auto simp:next_th_def eq_set s_RAG_def holdents_test wq_def |
|
4666 Let_def cs_holding_def) |
|
4667 by (insert vt_s.wq_distinct[of cs], auto simp:wq_def) |
|
4668 thus ?thesis by (simp add:cntCS_def) |
|
4669 qed |
|
4670 moreover note ih eq_cnp eq_cnv eq_threads |
|
4671 ultimately show ?thesis by auto |
|
4672 next |
|
4673 case True |
|
4674 let ?rest = " (SOME q. distinct q \<and> set q = set rest)" |
|
4675 let ?t = "hd ?rest" |
|
4676 from True eq_wq th_in neq_th |
|
4677 have "th \<in> readys (e # s)" |
|
4678 apply (auto simp:eq_e readys_def s_waiting_def wq_def |
|
4679 Let_def next_th_def) |
|
4680 proof - |
|
4681 assume eq_wq: "wq_fun (schs s) cs = thread # rest" |
|
4682 and t_in: "?t \<in> set rest" |
|
4683 show "?t \<in> threads s" |
|
4684 proof(rule vt_s.wq_threads) |
|
4685 from eq_wq and t_in |
|
4686 show "?t \<in> set (wq s cs)" by (auto simp:wq_def) |
|
4687 qed |
|
4688 next |
|
4689 fix csa |
|
4690 assume eq_wq: "wq_fun (schs s) cs = thread # rest" |
|
4691 and t_in: "?t \<in> set rest" |
|
4692 and neq_cs: "csa \<noteq> cs" |
|
4693 and t_in': "?t \<in> set (wq_fun (schs s) csa)" |
|
4694 show "?t = hd (wq_fun (schs s) csa)" |
|
4695 proof - |
|
4696 { assume neq_hd': "?t \<noteq> hd (wq_fun (schs s) csa)" |
|
4697 from vt_s.wq_distinct[of cs] and |
|
4698 eq_wq[folded wq_def] and t_in eq_wq |
|
4699 have "?t \<noteq> thread" by auto |
|
4700 with eq_wq and t_in |
|
4701 have w1: "waiting s ?t cs" |
|
4702 by (auto simp:s_waiting_def wq_def) |
|
4703 from t_in' neq_hd' |
|
4704 have w2: "waiting s ?t csa" |
|
4705 by (auto simp:s_waiting_def wq_def) |
|
4706 from vt_s.waiting_unique[OF w1 w2] |
|
4707 and neq_cs have "False" by auto |
|
4708 } thus ?thesis by auto |
|
4709 qed |
|
4710 qed |
|
4711 moreover have "cntP s th = cntV s th + cntCS s th + 1" |
|
4712 proof - |
|
4713 have "th \<notin> readys s" |
|
4714 proof - |
|
4715 from True eq_wq neq_th th_in |
|
4716 show ?thesis |
|
4717 apply (unfold readys_def s_waiting_def, auto) |
|
4718 by (rule_tac x = cs in exI, auto simp add: wq_def) |
|
4719 qed |
|
4720 moreover have "th \<in> threads s" |
|
4721 proof - |
|
4722 from th_in eq_wq |
|
4723 have "th \<in> set (wq s cs)" by simp |
|
4724 from vt_s.wq_threads [OF this] |
|
4725 show ?thesis . |
|
4726 qed |
|
4727 ultimately show ?thesis using ih by auto |
|
4728 qed |
|
4729 moreover from True neq_th have "cntCS (e # s) th = 1 + cntCS s th" |
|
4730 apply (unfold cntCS_def holdents_test eq_e step_RAG_v[OF vtv], auto) |
|
4731 proof - |
|
4732 show "card {csa. (Cs csa, Th th) \<in> RAG s \<or> csa = cs} = |
|
4733 Suc (card {cs. (Cs cs, Th th) \<in> RAG s})" |
|
4734 (is "card ?A = Suc (card ?B)") |
|
4735 proof - |
|
4736 have "?A = insert cs ?B" by auto |
|
4737 hence "card ?A = card (insert cs ?B)" by simp |
|
4738 also have "\<dots> = Suc (card ?B)" |
|
4739 proof(rule card_insert_disjoint) |
|
4740 have "?B \<subseteq> ((\<lambda> (x, y). the_cs x) ` RAG s)" |
|
4741 apply (auto simp:image_def) |
|
4742 by (rule_tac x = "(Cs x, Th th)" in bexI, auto) |
|
4743 with vt_s.finite_RAG |
|
4744 show "finite {cs. (Cs cs, Th th) \<in> RAG s}" by (auto intro:finite_subset) |
|
4745 next |
|
4746 show "cs \<notin> {cs. (Cs cs, Th th) \<in> RAG s}" |
|
4747 proof |
|
4748 assume "cs \<in> {cs. (Cs cs, Th th) \<in> RAG s}" |
|
4749 hence "(Cs cs, Th th) \<in> RAG s" by simp |
|
4750 with True neq_th eq_wq show False |
|
4751 by (auto simp:next_th_def s_RAG_def cs_holding_def) |
|
4752 qed |
|
4753 qed |
|
4754 finally show ?thesis . |
|
4755 qed |
|
4756 qed |
|
4757 moreover note eq_cnp eq_cnv |
|
4758 ultimately show ?thesis by simp |
|
4759 qed |
|
4760 qed |
|
4761 } ultimately show ?thesis by blast |
|
4762 qed |
|
4763 next |
|
4764 case (thread_set thread prio) |
|
4765 assume eq_e: "e = Set thread prio" |
|
4766 and is_runing: "thread \<in> runing s" |
|
4767 show ?thesis |
|
4768 proof - |
|
4769 from eq_e have eq_cnp: "cntP (e#s) th = cntP s th" by (simp add:cntP_def count_def) |
|
4770 from eq_e have eq_cnv: "cntV (e#s) th = cntV s th" by (simp add:cntV_def count_def) |
|
4771 have eq_cncs: "cntCS (e#s) th = cntCS s th" |
|
4772 unfolding cntCS_def holdents_test |
|
4773 by (simp add:RAG_set_unchanged eq_e) |
|
4774 from eq_e have eq_readys: "readys (e#s) = readys s" |
|
4775 by (simp add:readys_def cs_waiting_def s_waiting_def wq_def, |
|
4776 auto simp:Let_def) |
|
4777 { assume "th \<noteq> thread" |
|
4778 with eq_readys eq_e |
|
4779 have "(th \<in> readys (e # s) \<or> th \<notin> threads (e # s)) = |
|
4780 (th \<in> readys (s) \<or> th \<notin> threads (s))" |
|
4781 by (simp add:threads.simps) |
|
4782 with eq_cnp eq_cnv eq_cncs ih is_runing |
|
4783 have ?thesis by simp |
|
4784 } moreover { |
|
4785 assume eq_th: "th = thread" |
|
4786 with is_runing ih have " cntP s th = cntV s th + cntCS s th" |
|
4787 by (unfold runing_def, auto) |
|
4788 moreover from eq_th and eq_readys is_runing have "th \<in> readys (e#s)" |
|
4789 by (simp add:runing_def) |
|
4790 moreover note eq_cnp eq_cnv eq_cncs |
|
4791 ultimately have ?thesis by auto |
|
4792 } ultimately show ?thesis by blast |
|
4793 qed |
|
4794 qed |
|
4795 next |
|
4796 case vt_nil |
|
4797 show ?case |
|
4798 by (unfold cntP_def cntV_def cntCS_def, |
|
4799 auto simp:count_def holdents_test s_RAG_def wq_def cs_holding_def) |
|
4800 qed |
|
4801 >>>>>>> other |
|
4802 qed |
|
4803 |
|
4804 <<<<<<< local |
|
4805 ======= |
|
4806 lemma not_thread_cncs: |
|
4807 assumes not_in: "th \<notin> threads s" |
|
4808 shows "cntCS s th = 0" |
|
4809 proof - |
|
4810 from vt not_in show ?thesis |
|
4811 proof(induct arbitrary:th) |
|
4812 case (vt_cons s e th) |
|
4813 interpret vt_s: valid_trace s using vt_cons(1) |
|
4814 by (unfold_locales, simp) |
|
4815 assume vt: "vt s" |
|
4816 and ih: "\<And>th. th \<notin> threads s \<Longrightarrow> cntCS s th = 0" |
|
4817 and stp: "step s e" |
|
4818 and not_in: "th \<notin> threads (e # s)" |
|
4819 from stp show ?case |
|
4820 proof(cases) |
|
4821 case (thread_create thread prio) |
|
4822 assume eq_e: "e = Create thread prio" |
|
4823 and not_in': "thread \<notin> threads s" |
|
4824 have "cntCS (e # s) th = cntCS s th" |
|
4825 apply (unfold eq_e cntCS_def holdents_test) |
|
4826 by (simp add:RAG_create_unchanged) |
|
4827 moreover have "th \<notin> threads s" |
|
4828 proof - |
|
4829 from not_in eq_e show ?thesis by simp |
|
4830 qed |
|
4831 moreover note ih ultimately show ?thesis by auto |
|
4832 next |
|
4833 case (thread_exit thread) |
|
4834 assume eq_e: "e = Exit thread" |
|
4835 and nh: "holdents s thread = {}" |
|
4836 have eq_cns: "cntCS (e # s) th = cntCS s th" |
|
4837 apply (unfold eq_e cntCS_def holdents_test) |
|
4838 by (simp add:RAG_exit_unchanged) |
|
4839 show ?thesis |
|
4840 proof(cases "th = thread") |
|
4841 case True |
|
4842 have "cntCS s th = 0" by (unfold cntCS_def, auto simp:nh True) |
|
4843 with eq_cns show ?thesis by simp |
|
4844 next |
|
4845 case False |
|
4846 with not_in and eq_e |
|
4847 have "th \<notin> threads s" by simp |
|
4848 from ih[OF this] and eq_cns show ?thesis by simp |
|
4849 qed |
|
4850 next |
|
4851 case (thread_P thread cs) |
|
4852 assume eq_e: "e = P thread cs" |
|
4853 and is_runing: "thread \<in> runing s" |
|
4854 from assms thread_P ih vt stp thread_P have vtp: "vt (P thread cs#s)" by auto |
|
4855 have neq_th: "th \<noteq> thread" |
|
4856 proof - |
|
4857 from not_in eq_e have "th \<notin> threads s" by simp |
|
4858 moreover from is_runing have "thread \<in> threads s" |
|
4859 by (simp add:runing_def readys_def) |
|
4860 ultimately show ?thesis by auto |
|
4861 qed |
|
4862 hence "cntCS (e # s) th = cntCS s th " |
|
4863 apply (unfold cntCS_def holdents_test eq_e) |
|
4864 by (unfold step_RAG_p[OF vtp], auto) |
|
4865 moreover have "cntCS s th = 0" |
|
4866 proof(rule ih) |
|
4867 from not_in eq_e show "th \<notin> threads s" by simp |
|
4868 qed |
|
4869 ultimately show ?thesis by simp |
|
4870 next |
|
4871 case (thread_V thread cs) |
|
4872 assume eq_e: "e = V thread cs" |
|
4873 and is_runing: "thread \<in> runing s" |
|
4874 and hold: "holding s thread cs" |
|
4875 have neq_th: "th \<noteq> thread" |
|
4876 proof - |
|
4877 from not_in eq_e have "th \<notin> threads s" by simp |
|
4878 moreover from is_runing have "thread \<in> threads s" |
|
4879 by (simp add:runing_def readys_def) |
|
4880 ultimately show ?thesis by auto |
|
4881 qed |
|
4882 from assms thread_V vt stp ih |
|
4883 have vtv: "vt (V thread cs#s)" by auto |
|
4884 then interpret vt_v: valid_trace "(V thread cs#s)" |
|
4885 by (unfold_locales, simp) |
|
4886 from hold obtain rest |
|
4887 where eq_wq: "wq s cs = thread # rest" |
|
4888 by (case_tac "wq s cs", auto simp: wq_def s_holding_def) |
|
4889 from not_in eq_e eq_wq |
|
4890 have "\<not> next_th s thread cs th" |
|
4891 apply (auto simp:next_th_def) |
|
4892 proof - |
|
4893 assume ne: "rest \<noteq> []" |
|
4894 and ni: "hd (SOME q. distinct q \<and> set q = set rest) \<notin> threads s" (is "?t \<notin> threads s") |
|
4895 have "?t \<in> set rest" |
|
4896 proof(rule someI2) |
|
4897 from vt_v.wq_distinct[of cs] and eq_wq |
|
4898 show "distinct rest \<and> set rest = set rest" |
|
4899 by (metis distinct.simps(2) vt_s.wq_distinct) |
|
4900 next |
|
4901 fix x assume "distinct x \<and> set x = set rest" with ne |
|
4902 show "hd x \<in> set rest" by (cases x, auto) |
|
4903 qed |
|
4904 with eq_wq have "?t \<in> set (wq s cs)" by simp |
|
4905 from vt_s.wq_threads[OF this] and ni |
|
4906 show False |
|
4907 using `hd (SOME q. distinct q \<and> set q = set rest) \<in> set (wq s cs)` |
|
4908 ni vt_s.wq_threads by blast |
|
4909 qed |
|
4910 moreover note neq_th eq_wq |
|
4911 ultimately have "cntCS (e # s) th = cntCS s th" |
|
4912 by (unfold eq_e cntCS_def holdents_test step_RAG_v[OF vtv], auto) |
|
4913 moreover have "cntCS s th = 0" |
|
4914 proof(rule ih) |
|
4915 from not_in eq_e show "th \<notin> threads s" by simp |
|
4916 qed |
|
4917 ultimately show ?thesis by simp |
|
4918 next |
|
4919 case (thread_set thread prio) |
|
4920 print_facts |
|
4921 assume eq_e: "e = Set thread prio" |
|
4922 and is_runing: "thread \<in> runing s" |
|
4923 from not_in and eq_e have "th \<notin> threads s" by auto |
|
4924 from ih [OF this] and eq_e |
|
4925 show ?thesis |
|
4926 apply (unfold eq_e cntCS_def holdents_test) |
|
4927 by (simp add:RAG_set_unchanged) |
|
4928 qed |
|
4929 next |
|
4930 case vt_nil |
|
4931 show ?case |
|
4932 by (unfold cntCS_def, |
|
4933 auto simp:count_def holdents_test s_RAG_def wq_def cs_holding_def) |
|
4934 qed |
|
4935 qed |
|
4936 |
|
4937 end |
|
4938 |
|
4939 lemma eq_waiting: "waiting (wq (s::state)) th cs = waiting s th cs" |
|
4940 by (auto simp:s_waiting_def cs_waiting_def wq_def) |
|
4941 |
|
4942 context valid_trace |
|
4943 begin |
|
4944 |
|
4945 lemma dm_RAG_threads: |
|
4946 assumes in_dom: "(Th th) \<in> Domain (RAG s)" |
|
4947 shows "th \<in> threads s" |
|
4948 proof - |
|
4949 from in_dom obtain n where "(Th th, n) \<in> RAG s" by auto |
|
4950 moreover from RAG_target_th[OF this] obtain cs where "n = Cs cs" by auto |
|
4951 ultimately have "(Th th, Cs cs) \<in> RAG s" by simp |
|
4952 hence "th \<in> set (wq s cs)" |
|
4953 by (unfold s_RAG_def, auto simp:cs_waiting_def) |
|
4954 from wq_threads [OF this] show ?thesis . |
|
4955 qed |
|
4956 |
|
4957 end |
|
4958 |
|
4959 lemma cp_eq_cpreced: "cp s th = cpreced (wq s) s th" |
|
4960 unfolding cp_def wq_def |
|
4961 apply(induct s rule: schs.induct) |
|
4962 thm cpreced_initial |
|
4963 apply(simp add: Let_def cpreced_initial) |
|
4964 apply(simp add: Let_def) |
|
4965 apply(simp add: Let_def) |
|
4966 apply(simp add: Let_def) |
|
4967 apply(subst (2) schs.simps) |
|
4968 apply(simp add: Let_def) |
|
4969 apply(subst (2) schs.simps) |
|
4970 apply(simp add: Let_def) |
|
4971 done |
|
4972 |
|
4973 context valid_trace |
|
4974 begin |
|
4975 |
|
4976 >>>>>>> other |
|
4977 lemma runing_unique: |
2784 lemma runing_unique: |
4978 assumes runing_1: "th1 \<in> runing s" |
2785 assumes runing_1: "th1 \<in> runing s" |
4979 and runing_2: "th2 \<in> runing s" |
2786 and runing_2: "th2 \<in> runing s" |
4980 shows "th1 = th2" |
2787 shows "th1 = th2" |
4981 proof - |
2788 proof - |
4982 from runing_1 and runing_2 have "cp s th1 = cp s th2" |
2789 from runing_1 and runing_2 have "cp s th1 = cp s th2" |
4983 <<<<<<< local |
|
4984 unfolding runing_def by auto |
2790 unfolding runing_def by auto |
4985 from this[unfolded cp_alt_def] |
2791 from this[unfolded cp_alt_def] |
4986 have eq_max: |
2792 have eq_max: |
4987 "Max (the_preced s ` {th'. Th th' \<in> subtree (RAG s) (Th th1)}) = |
2793 "Max (the_preced s ` {th'. Th th' \<in> subtree (RAG s) (Th th1)}) = |
4988 Max (the_preced s ` {th'. Th th' \<in> subtree (RAG s) (Th th2)})" |
2794 Max (the_preced s ` {th'. Th th' \<in> subtree (RAG s) (Th th2)})" |
4990 have "Max ?L \<in> ?L" |
2796 have "Max ?L \<in> ?L" |
4991 proof(rule Max_in) |
2797 proof(rule Max_in) |
4992 show "finite ?L" by (simp add: finite_subtree_threads) |
2798 show "finite ?L" by (simp add: finite_subtree_threads) |
4993 next |
2799 next |
4994 show "?L \<noteq> {}" using subtree_def by fastforce |
2800 show "?L \<noteq> {}" using subtree_def by fastforce |
4995 ======= |
2801 qed |
4996 unfolding runing_def |
2802 then obtain th1' where |
4997 apply(simp) |
2803 h_1: "Th th1' \<in> subtree (RAG s) (Th th1)" "the_preced s th1' = Max ?L" |
4998 done |
2804 by auto |
4999 hence eq_max: "Max ((\<lambda>th. preced th s) ` ({th1} \<union> dependants (wq s) th1)) = |
2805 have "Max ?R \<in> ?R" |
5000 Max ((\<lambda>th. preced th s) ` ({th2} \<union> dependants (wq s) th2))" |
2806 proof(rule Max_in) |
5001 (is "Max (?f ` ?A) = Max (?f ` ?B)") |
2807 show "finite ?R" by (simp add: finite_subtree_threads) |
5002 unfolding cp_eq_cpreced |
2808 next |
5003 unfolding cpreced_def . |
2809 show "?R \<noteq> {}" using subtree_def by fastforce |
5004 obtain th1' where th1_in: "th1' \<in> ?A" and eq_f_th1: "?f th1' = Max (?f ` ?A)" |
2810 qed |
5005 proof - |
2811 then obtain th2' where |
5006 have h1: "finite (?f ` ?A)" |
2812 h_2: "Th th2' \<in> subtree (RAG s) (Th th2)" "the_preced s th2' = Max ?R" |
5007 proof - |
2813 by auto |
5008 have "finite ?A" |
2814 have "th1' = th2'" |
5009 proof - |
2815 proof(rule preced_unique) |
5010 have "finite (dependants (wq s) th1)" |
2816 from h_1(1) |
5011 proof- |
2817 show "th1' \<in> threads s" |
5012 have "finite {th'. (Th th', Th th1) \<in> (RAG (wq s))\<^sup>+}" |
2818 proof(cases rule:subtreeE) |
5013 proof - |
2819 case 1 |
5014 let ?F = "\<lambda> (x, y). the_th x" |
2820 hence "th1' = th1" by simp |
5015 have "{th'. (Th th', Th th1) \<in> (RAG (wq s))\<^sup>+} \<subseteq> ?F ` ((RAG (wq s))\<^sup>+)" |
2821 with runing_1 show ?thesis by (auto simp:runing_def readys_def) |
5016 apply (auto simp:image_def) |
2822 next |
5017 by (rule_tac x = "(Th x, Th th1)" in bexI, auto) |
2823 case 2 |
5018 moreover have "finite \<dots>" |
2824 from this(2) |
5019 proof - |
2825 have "(Th th1', Th th1) \<in> (RAG s)^+" by (auto simp:ancestors_def) |
5020 from finite_RAG have "finite (RAG s)" . |
2826 from tranclD[OF this] |
5021 hence "finite ((RAG (wq s))\<^sup>+)" |
2827 have "(Th th1') \<in> Domain (RAG s)" by auto |
5022 apply (unfold finite_trancl) |
|
5023 by (auto simp: s_RAG_def cs_RAG_def wq_def) |
|
5024 thus ?thesis by auto |
|
5025 qed |
|
5026 ultimately show ?thesis by (auto intro:finite_subset) |
|
5027 qed |
|
5028 thus ?thesis by (simp add:cs_dependants_def) |
|
5029 qed |
|
5030 thus ?thesis by simp |
|
5031 qed |
|
5032 thus ?thesis by auto |
|
5033 qed |
|
5034 moreover have h2: "(?f ` ?A) \<noteq> {}" |
|
5035 proof - |
|
5036 have "?A \<noteq> {}" by simp |
|
5037 thus ?thesis by simp |
|
5038 qed |
|
5039 from Max_in [OF h1 h2] |
|
5040 have "Max (?f ` ?A) \<in> (?f ` ?A)" . |
|
5041 thus ?thesis |
|
5042 thm cpreced_def |
|
5043 unfolding cpreced_def[symmetric] |
|
5044 unfolding cp_eq_cpreced[symmetric] |
|
5045 unfolding cpreced_def |
|
5046 using that[intro] by (auto) |
|
5047 >>>>>>> other |
|
5048 qed |
|
5049 obtain th2' where th2_in: "th2' \<in> ?B" and eq_f_th2: "?f th2' = Max (?f ` ?B)" |
|
5050 proof - |
|
5051 have h1: "finite (?f ` ?B)" |
|
5052 proof - |
|
5053 have "finite ?B" |
|
5054 proof - |
|
5055 have "finite (dependants (wq s) th2)" |
|
5056 proof- |
|
5057 have "finite {th'. (Th th', Th th2) \<in> (RAG (wq s))\<^sup>+}" |
|
5058 proof - |
|
5059 let ?F = "\<lambda> (x, y). the_th x" |
|
5060 have "{th'. (Th th', Th th2) \<in> (RAG (wq s))\<^sup>+} \<subseteq> ?F ` ((RAG (wq s))\<^sup>+)" |
|
5061 apply (auto simp:image_def) |
|
5062 by (rule_tac x = "(Th x, Th th2)" in bexI, auto) |
|
5063 moreover have "finite \<dots>" |
|
5064 proof - |
|
5065 from finite_RAG have "finite (RAG s)" . |
|
5066 hence "finite ((RAG (wq s))\<^sup>+)" |
|
5067 apply (unfold finite_trancl) |
|
5068 by (auto simp: s_RAG_def cs_RAG_def wq_def) |
|
5069 thus ?thesis by auto |
|
5070 qed |
|
5071 ultimately show ?thesis by (auto intro:finite_subset) |
|
5072 qed |
|
5073 thus ?thesis by (simp add:cs_dependants_def) |
|
5074 qed |
|
5075 thus ?thesis by simp |
|
5076 qed |
|
5077 thus ?thesis by auto |
|
5078 qed |
|
5079 moreover have h2: "(?f ` ?B) \<noteq> {}" |
|
5080 proof - |
|
5081 have "?B \<noteq> {}" by simp |
|
5082 thus ?thesis by simp |
|
5083 qed |
|
5084 from Max_in [OF h1 h2] |
|
5085 have "Max (?f ` ?B) \<in> (?f ` ?B)" . |
|
5086 thus ?thesis by (auto intro:that) |
|
5087 qed |
|
5088 from eq_f_th1 eq_f_th2 eq_max |
|
5089 have eq_preced: "preced th1' s = preced th2' s" by auto |
|
5090 hence eq_th12: "th1' = th2'" |
|
5091 proof (rule preced_unique) |
|
5092 from th1_in have "th1' = th1 \<or> (th1' \<in> dependants (wq s) th1)" by simp |
|
5093 thus "th1' \<in> threads s" |
|
5094 proof |
|
5095 assume "th1' \<in> dependants (wq s) th1" |
|
5096 hence "(Th th1') \<in> Domain ((RAG s)^+)" |
|
5097 apply (unfold cs_dependants_def cs_RAG_def s_RAG_def) |
|
5098 by (auto simp:Domain_def) |
|
5099 hence "(Th th1') \<in> Domain (RAG s)" by (simp add:trancl_domain) |
|
5100 from dm_RAG_threads[OF this] show ?thesis . |
2828 from dm_RAG_threads[OF this] show ?thesis . |
|
2829 qed |
|
2830 next |
|
2831 from h_2(1) |
|
2832 show "th2' \<in> threads s" |
|
2833 proof(cases rule:subtreeE) |
|
2834 case 1 |
|
2835 hence "th2' = th2" by simp |
|
2836 with runing_2 show ?thesis by (auto simp:runing_def readys_def) |
5101 next |
2837 next |
5102 assume "th1' = th1" |
2838 case 2 |
5103 with runing_1 show ?thesis |
2839 from this(2) |
|
2840 have "(Th th2', Th th2) \<in> (RAG s)^+" by (auto simp:ancestors_def) |
|
2841 from tranclD[OF this] |
|
2842 have "(Th th2') \<in> Domain (RAG s)" by auto |
|
2843 from dm_RAG_threads[OF this] show ?thesis . |
|
2844 qed |
|
2845 next |
|
2846 have "the_preced s th1' = the_preced s th2'" |
|
2847 using eq_max h_1(2) h_2(2) by metis |
|
2848 thus "preced th1' s = preced th2' s" by (simp add:the_preced_def) |
|
2849 qed |
|
2850 from h_1(1)[unfolded this] |
|
2851 have star1: "(Th th2', Th th1) \<in> (RAG s)^*" by (auto simp:subtree_def) |
|
2852 from h_2(1)[unfolded this] |
|
2853 have star2: "(Th th2', Th th2) \<in> (RAG s)^*" by (auto simp:subtree_def) |
|
2854 from star_rpath[OF star1] obtain xs1 |
|
2855 where rp1: "rpath (RAG s) (Th th2') xs1 (Th th1)" |
|
2856 by auto |
|
2857 from star_rpath[OF star2] obtain xs2 |
|
2858 where rp2: "rpath (RAG s) (Th th2') xs2 (Th th2)" |
|
2859 by auto |
|
2860 from rp1 rp2 |
|
2861 show ?thesis |
|
2862 proof(cases) |
|
2863 case (less_1 xs') |
|
2864 moreover have "xs' = []" |
|
2865 proof(rule ccontr) |
|
2866 assume otherwise: "xs' \<noteq> []" |
|
2867 from rpath_plus[OF less_1(3) this] |
|
2868 have "(Th th1, Th th2) \<in> (RAG s)\<^sup>+" . |
|
2869 from tranclD[OF this] |
|
2870 obtain cs where "waiting s th1 cs" |
|
2871 by (unfold s_RAG_def, fold waiting_eq, auto) |
|
2872 with runing_1 show False |
5104 by (unfold runing_def readys_def, auto) |
2873 by (unfold runing_def readys_def, auto) |
5105 qed |
2874 qed |
|
2875 ultimately have "xs2 = xs1" by simp |
|
2876 from rpath_dest_eq[OF rp1 rp2[unfolded this]] |
|
2877 show ?thesis by simp |
5106 next |
2878 next |
5107 from th2_in have "th2' = th2 \<or> (th2' \<in> dependants (wq s) th2)" by simp |
2879 case (less_2 xs') |
5108 thus "th2' \<in> threads s" |
2880 moreover have "xs' = []" |
5109 proof |
2881 proof(rule ccontr) |
5110 assume "th2' \<in> dependants (wq s) th2" |
2882 assume otherwise: "xs' \<noteq> []" |
5111 hence "(Th th2') \<in> Domain ((RAG s)^+)" |
2883 from rpath_plus[OF less_2(3) this] |
5112 apply (unfold cs_dependants_def cs_RAG_def s_RAG_def) |
2884 have "(Th th2, Th th1) \<in> (RAG s)\<^sup>+" . |
5113 by (auto simp:Domain_def) |
2885 from tranclD[OF this] |
5114 hence "(Th th2') \<in> Domain (RAG s)" by (simp add:trancl_domain) |
2886 obtain cs where "waiting s th2 cs" |
5115 from dm_RAG_threads[OF this] show ?thesis . |
2887 by (unfold s_RAG_def, fold waiting_eq, auto) |
5116 next |
2888 with runing_2 show False |
5117 assume "th2' = th2" |
|
5118 with runing_2 show ?thesis |
|
5119 by (unfold runing_def readys_def, auto) |
2889 by (unfold runing_def readys_def, auto) |
5120 qed |
2890 qed |
5121 qed |
2891 ultimately have "xs2 = xs1" by simp |
5122 from th1_in have "th1' = th1 \<or> th1' \<in> dependants (wq s) th1" by simp |
2892 from rpath_dest_eq[OF rp1 rp2[unfolded this]] |
5123 thus ?thesis |
2893 show ?thesis by simp |
5124 proof |
2894 qed |
5125 assume eq_th': "th1' = th1" |
2895 qed |
5126 from th2_in have "th2' = th2 \<or> th2' \<in> dependants (wq s) th2" by simp |
2896 |
5127 thus ?thesis |
2897 lemma card_runing: "card (runing s) \<le> 1" |
5128 proof |
2898 proof(cases "runing s = {}") |
5129 assume "th2' = th2" thus ?thesis using eq_th' eq_th12 by simp |
2899 case True |
5130 next |
2900 thus ?thesis by auto |
5131 assume "th2' \<in> dependants (wq s) th2" |
2901 next |
5132 with eq_th12 eq_th' have "th1 \<in> dependants (wq s) th2" by simp |
2902 case False |
5133 hence "(Th th1, Th th2) \<in> (RAG s)^+" |
2903 then obtain th where [simp]: "th \<in> runing s" by auto |
5134 by (unfold cs_dependants_def s_RAG_def cs_RAG_def, simp) |
2904 from runing_unique[OF this] |
5135 hence "Th th1 \<in> Domain ((RAG s)^+)" |
2905 have "runing s = {th}" by auto |
5136 apply (unfold cs_dependants_def cs_RAG_def s_RAG_def) |
2906 thus ?thesis by auto |
5137 by (auto simp:Domain_def) |
2907 qed |
5138 hence "Th th1 \<in> Domain (RAG s)" by (simp add:trancl_domain) |
|
5139 then obtain n where d: "(Th th1, n) \<in> RAG s" by (auto simp:Domain_def) |
|
5140 from RAG_target_th [OF this] |
|
5141 obtain cs' where "n = Cs cs'" by auto |
|
5142 with d have "(Th th1, Cs cs') \<in> RAG s" by simp |
|
5143 with runing_1 have "False" |
|
5144 apply (unfold runing_def readys_def s_RAG_def) |
|
5145 by (auto simp:eq_waiting) |
|
5146 thus ?thesis by simp |
|
5147 qed |
|
5148 next |
|
5149 assume th1'_in: "th1' \<in> dependants (wq s) th1" |
|
5150 from th2_in have "th2' = th2 \<or> th2' \<in> dependants (wq s) th2" by simp |
|
5151 thus ?thesis |
|
5152 proof |
|
5153 assume "th2' = th2" |
|
5154 with th1'_in eq_th12 have "th2 \<in> dependants (wq s) th1" by simp |
|
5155 hence "(Th th2, Th th1) \<in> (RAG s)^+" |
|
5156 by (unfold cs_dependants_def s_RAG_def cs_RAG_def, simp) |
|
5157 hence "Th th2 \<in> Domain ((RAG s)^+)" |
|
5158 apply (unfold cs_dependants_def cs_RAG_def s_RAG_def) |
|
5159 by (auto simp:Domain_def) |
|
5160 hence "Th th2 \<in> Domain (RAG s)" by (simp add:trancl_domain) |
|
5161 then obtain n where d: "(Th th2, n) \<in> RAG s" by (auto simp:Domain_def) |
|
5162 from RAG_target_th [OF this] |
|
5163 obtain cs' where "n = Cs cs'" by auto |
|
5164 with d have "(Th th2, Cs cs') \<in> RAG s" by simp |
|
5165 with runing_2 have "False" |
|
5166 apply (unfold runing_def readys_def s_RAG_def) |
|
5167 by (auto simp:eq_waiting) |
|
5168 thus ?thesis by simp |
|
5169 next |
|
5170 assume "th2' \<in> dependants (wq s) th2" |
|
5171 with eq_th12 have "th1' \<in> dependants (wq s) th2" by simp |
|
5172 hence h1: "(Th th1', Th th2) \<in> (RAG s)^+" |
|
5173 by (unfold cs_dependants_def s_RAG_def cs_RAG_def, simp) |
|
5174 from th1'_in have h2: "(Th th1', Th th1) \<in> (RAG s)^+" |
|
5175 by (unfold cs_dependants_def s_RAG_def cs_RAG_def, simp) |
|
5176 show ?thesis |
|
5177 proof(rule dchain_unique[OF h1 _ h2, symmetric]) |
|
5178 from runing_1 show "th1 \<in> readys s" by (simp add:runing_def) |
|
5179 from runing_2 show "th2 \<in> readys s" by (simp add:runing_def) |
|
5180 qed |
|
5181 qed |
|
5182 qed |
|
5183 qed |
|
5184 |
|
5185 |
|
5186 lemma "card (runing s) \<le> 1" |
|
5187 apply(subgoal_tac "finite (runing s)") |
|
5188 prefer 2 |
|
5189 apply (metis finite_nat_set_iff_bounded lessI runing_unique) |
|
5190 apply(rule ccontr) |
|
5191 apply(simp) |
|
5192 apply(case_tac "Suc (Suc 0) \<le> card (runing s)") |
|
5193 apply(subst (asm) card_le_Suc_iff) |
|
5194 apply(simp) |
|
5195 apply(auto)[1] |
|
5196 apply (metis insertCI runing_unique) |
|
5197 apply(auto) |
|
5198 done |
|
5199 |
|
5200 end |
|
5201 |
|
5202 |
2908 |
5203 end |
2909 end |
5204 |
2910 |
5205 |
2911 |
5206 section {* Relating @{term cp} and @{term the_preced} and @{term preced} *} |
2912 section {* Relating @{term cp} and @{term the_preced} and @{term preced} *} |
6707 proof - |
4357 proof - |
6708 from count_eq_RAG_plus[OF assms, folded dependants_alt_def1] |
4358 from count_eq_RAG_plus[OF assms, folded dependants_alt_def1] |
6709 show ?thesis . |
4359 show ?thesis . |
6710 qed |
4360 qed |
6711 |
4361 |
6712 ======= |
4362 lemma count_eq_tRAG_plus: |
6713 end |
4363 assumes "cntP s th = cntV s th" |
6714 |
4364 shows "{th'. (Th th', Th th) \<in> (tRAG s)^+} = {}" |
6715 lemma Max_f_mono: |
4365 using assms eq_pv_dependants dependants_alt_def eq_dependants by auto |
6716 assumes seq: "A \<subseteq> B" |
4366 |
6717 and np: "A \<noteq> {}" |
4367 lemma count_eq_RAG_plus_Th: |
6718 and fnt: "finite B" |
4368 assumes "cntP s th = cntV s th" |
6719 shows "Max (f ` A) \<le> Max (f ` B)" |
4369 shows "{Th th' | th'. (Th th', Th th) \<in> (RAG s)^+} = {}" |
6720 proof(rule Max_mono) |
4370 using count_eq_RAG_plus[OF assms] by auto |
6721 from seq show "f ` A \<subseteq> f ` B" by auto |
4371 |
6722 next |
4372 lemma count_eq_tRAG_plus_Th: |
6723 from np show "f ` A \<noteq> {}" by auto |
4373 assumes "cntP s th = cntV s th" |
6724 next |
4374 shows "{Th th' | th'. (Th th', Th th) \<in> (tRAG s)^+} = {}" |
6725 from fnt and seq show "finite (f ` B)" by auto |
4375 using count_eq_tRAG_plus[OF assms] by auto |
6726 qed |
4376 |
6727 |
4377 end |
6728 context valid_trace |
|
6729 begin |
|
6730 |
|
6731 lemma cp_le: |
|
6732 assumes th_in: "th \<in> threads s" |
|
6733 shows "cp s th \<le> Max ((\<lambda> th. (preced th s)) ` threads s)" |
|
6734 proof(unfold cp_eq_cpreced cpreced_def cs_dependants_def) |
|
6735 show "Max ((\<lambda>th. preced th s) ` ({th} \<union> {th'. (Th th', Th th) \<in> (RAG (wq s))\<^sup>+})) |
|
6736 \<le> Max ((\<lambda>th. preced th s) ` threads s)" |
|
6737 (is "Max (?f ` ?A) \<le> Max (?f ` ?B)") |
|
6738 proof(rule Max_f_mono) |
|
6739 show "{th} \<union> {th'. (Th th', Th th) \<in> (RAG (wq s))\<^sup>+} \<noteq> {}" by simp |
|
6740 next |
|
6741 from finite_threads |
|
6742 show "finite (threads s)" . |
|
6743 next |
|
6744 from th_in |
|
6745 show "{th} \<union> {th'. (Th th', Th th) \<in> (RAG (wq s))\<^sup>+} \<subseteq> threads s" |
|
6746 apply (auto simp:Domain_def) |
|
6747 apply (rule_tac dm_RAG_threads) |
|
6748 apply (unfold trancl_domain [of "RAG s", symmetric]) |
|
6749 by (unfold cs_RAG_def s_RAG_def, auto simp:Domain_def) |
|
6750 qed |
|
6751 qed |
|
6752 |
|
6753 lemma le_cp: |
|
6754 shows "preced th s \<le> cp s th" |
|
6755 proof(unfold cp_eq_cpreced preced_def cpreced_def, simp) |
|
6756 show "Prc (priority th s) (last_set th s) |
|
6757 \<le> Max (insert (Prc (priority th s) (last_set th s)) |
|
6758 ((\<lambda>th. Prc (priority th s) (last_set th s)) ` dependants (wq s) th))" |
|
6759 (is "?l \<le> Max (insert ?l ?A)") |
|
6760 proof(cases "?A = {}") |
|
6761 case False |
|
6762 have "finite ?A" (is "finite (?f ` ?B)") |
|
6763 proof - |
|
6764 have "finite ?B" |
|
6765 proof- |
|
6766 have "finite {th'. (Th th', Th th) \<in> (RAG (wq s))\<^sup>+}" |
|
6767 proof - |
|
6768 let ?F = "\<lambda> (x, y). the_th x" |
|
6769 have "{th'. (Th th', Th th) \<in> (RAG (wq s))\<^sup>+} \<subseteq> ?F ` ((RAG (wq s))\<^sup>+)" |
|
6770 apply (auto simp:image_def) |
|
6771 by (rule_tac x = "(Th x, Th th)" in bexI, auto) |
|
6772 moreover have "finite \<dots>" |
|
6773 proof - |
|
6774 from finite_RAG have "finite (RAG s)" . |
|
6775 hence "finite ((RAG (wq s))\<^sup>+)" |
|
6776 apply (unfold finite_trancl) |
|
6777 by (auto simp: s_RAG_def cs_RAG_def wq_def) |
|
6778 thus ?thesis by auto |
|
6779 qed |
|
6780 ultimately show ?thesis by (auto intro:finite_subset) |
|
6781 qed |
|
6782 thus ?thesis by (simp add:cs_dependants_def) |
|
6783 qed |
|
6784 thus ?thesis by simp |
|
6785 qed |
|
6786 from Max_insert [OF this False, of ?l] show ?thesis by auto |
|
6787 next |
|
6788 case True |
|
6789 thus ?thesis by auto |
|
6790 qed |
|
6791 qed |
|
6792 |
|
6793 lemma max_cp_eq: |
|
6794 shows "Max ((cp s) ` threads s) = Max ((\<lambda> th. (preced th s)) ` threads s)" |
|
6795 (is "?l = ?r") |
|
6796 proof(cases "threads s = {}") |
|
6797 case True |
|
6798 thus ?thesis by auto |
|
6799 next |
|
6800 case False |
|
6801 have "?l \<in> ((cp s) ` threads s)" |
|
6802 proof(rule Max_in) |
|
6803 from finite_threads |
|
6804 show "finite (cp s ` threads s)" by auto |
|
6805 next |
|
6806 from False show "cp s ` threads s \<noteq> {}" by auto |
|
6807 qed |
|
6808 then obtain th |
|
6809 where th_in: "th \<in> threads s" and eq_l: "?l = cp s th" by auto |
|
6810 have "\<dots> \<le> ?r" by (rule cp_le[OF th_in]) |
|
6811 moreover have "?r \<le> cp s th" (is "Max (?f ` ?A) \<le> cp s th") |
|
6812 proof - |
|
6813 have "?r \<in> (?f ` ?A)" |
|
6814 proof(rule Max_in) |
|
6815 from finite_threads |
|
6816 show " finite ((\<lambda>th. preced th s) ` threads s)" by auto |
|
6817 next |
|
6818 from False show " (\<lambda>th. preced th s) ` threads s \<noteq> {}" by auto |
|
6819 qed |
|
6820 then obtain th' where |
|
6821 th_in': "th' \<in> ?A " and eq_r: "?r = ?f th'" by auto |
|
6822 from le_cp [of th'] eq_r |
|
6823 have "?r \<le> cp s th'" by auto |
|
6824 moreover have "\<dots> \<le> cp s th" |
|
6825 proof(fold eq_l) |
|
6826 show " cp s th' \<le> Max (cp s ` threads s)" |
|
6827 proof(rule Max_ge) |
|
6828 from th_in' show "cp s th' \<in> cp s ` threads s" |
|
6829 by auto |
|
6830 next |
|
6831 from finite_threads |
|
6832 show "finite (cp s ` threads s)" by auto |
|
6833 qed |
|
6834 qed |
|
6835 ultimately show ?thesis by auto |
|
6836 qed |
|
6837 ultimately show ?thesis using eq_l by auto |
|
6838 qed |
|
6839 |
|
6840 lemma max_cp_readys_threads_pre: |
|
6841 assumes np: "threads s \<noteq> {}" |
|
6842 shows "Max (cp s ` readys s) = Max (cp s ` threads s)" |
|
6843 proof(unfold max_cp_eq) |
|
6844 show "Max (cp s ` readys s) = Max ((\<lambda>th. preced th s) ` threads s)" |
|
6845 proof - |
|
6846 let ?p = "Max ((\<lambda>th. preced th s) ` threads s)" |
|
6847 let ?f = "(\<lambda>th. preced th s)" |
|
6848 have "?p \<in> ((\<lambda>th. preced th s) ` threads s)" |
|
6849 proof(rule Max_in) |
|
6850 from finite_threads show "finite (?f ` threads s)" by simp |
|
6851 next |
|
6852 from np show "?f ` threads s \<noteq> {}" by simp |
|
6853 qed |
|
6854 then obtain tm where tm_max: "?f tm = ?p" and tm_in: "tm \<in> threads s" |
|
6855 by (auto simp:Image_def) |
|
6856 from th_chain_to_ready [OF tm_in] |
|
6857 have "tm \<in> readys s \<or> (\<exists>th'. th' \<in> readys s \<and> (Th tm, Th th') \<in> (RAG s)\<^sup>+)" . |
|
6858 thus ?thesis |
|
6859 proof |
|
6860 assume "\<exists>th'. th' \<in> readys s \<and> (Th tm, Th th') \<in> (RAG s)\<^sup>+ " |
|
6861 then obtain th' where th'_in: "th' \<in> readys s" |
|
6862 and tm_chain:"(Th tm, Th th') \<in> (RAG s)\<^sup>+" by auto |
|
6863 have "cp s th' = ?f tm" |
|
6864 proof(subst cp_eq_cpreced, subst cpreced_def, rule Max_eqI) |
|
6865 from dependants_threads finite_threads |
|
6866 show "finite ((\<lambda>th. preced th s) ` ({th'} \<union> dependants (wq s) th'))" |
|
6867 by (auto intro:finite_subset) |
|
6868 next |
|
6869 fix p assume p_in: "p \<in> (\<lambda>th. preced th s) ` ({th'} \<union> dependants (wq s) th')" |
|
6870 from tm_max have " preced tm s = Max ((\<lambda>th. preced th s) ` threads s)" . |
|
6871 moreover have "p \<le> \<dots>" |
|
6872 proof(rule Max_ge) |
|
6873 from finite_threads |
|
6874 show "finite ((\<lambda>th. preced th s) ` threads s)" by simp |
|
6875 next |
|
6876 from p_in and th'_in and dependants_threads[of th'] |
|
6877 show "p \<in> (\<lambda>th. preced th s) ` threads s" |
|
6878 by (auto simp:readys_def) |
|
6879 qed |
|
6880 ultimately show "p \<le> preced tm s" by auto |
|
6881 next |
|
6882 show "preced tm s \<in> (\<lambda>th. preced th s) ` ({th'} \<union> dependants (wq s) th')" |
|
6883 proof - |
|
6884 from tm_chain |
|
6885 have "tm \<in> dependants (wq s) th'" |
|
6886 by (unfold cs_dependants_def s_RAG_def cs_RAG_def, auto) |
|
6887 thus ?thesis by auto |
|
6888 qed |
|
6889 qed |
|
6890 with tm_max |
|
6891 have h: "cp s th' = Max ((\<lambda>th. preced th s) ` threads s)" by simp |
|
6892 show ?thesis |
|
6893 proof (fold h, rule Max_eqI) |
|
6894 fix q |
|
6895 assume "q \<in> cp s ` readys s" |
|
6896 then obtain th1 where th1_in: "th1 \<in> readys s" |
|
6897 and eq_q: "q = cp s th1" by auto |
|
6898 show "q \<le> cp s th'" |
|
6899 apply (unfold h eq_q) |
|
6900 apply (unfold cp_eq_cpreced cpreced_def) |
|
6901 apply (rule Max_mono) |
|
6902 proof - |
|
6903 from dependants_threads [of th1] th1_in |
|
6904 show "(\<lambda>th. preced th s) ` ({th1} \<union> dependants (wq s) th1) \<subseteq> |
|
6905 (\<lambda>th. preced th s) ` threads s" |
|
6906 by (auto simp:readys_def) |
|
6907 next |
|
6908 show "(\<lambda>th. preced th s) ` ({th1} \<union> dependants (wq s) th1) \<noteq> {}" by simp |
|
6909 next |
|
6910 from finite_threads |
|
6911 show " finite ((\<lambda>th. preced th s) ` threads s)" by simp |
|
6912 qed |
|
6913 next |
|
6914 from finite_threads |
|
6915 show "finite (cp s ` readys s)" by (auto simp:readys_def) |
|
6916 next |
|
6917 from th'_in |
|
6918 show "cp s th' \<in> cp s ` readys s" by simp |
|
6919 qed |
|
6920 next |
|
6921 assume tm_ready: "tm \<in> readys s" |
|
6922 show ?thesis |
|
6923 proof(fold tm_max) |
|
6924 have cp_eq_p: "cp s tm = preced tm s" |
|
6925 proof(unfold cp_eq_cpreced cpreced_def, rule Max_eqI) |
|
6926 fix y |
|
6927 assume hy: "y \<in> (\<lambda>th. preced th s) ` ({tm} \<union> dependants (wq s) tm)" |
|
6928 show "y \<le> preced tm s" |
|
6929 proof - |
|
6930 { fix y' |
|
6931 assume hy' : "y' \<in> ((\<lambda>th. preced th s) ` dependants (wq s) tm)" |
|
6932 have "y' \<le> preced tm s" |
|
6933 proof(unfold tm_max, rule Max_ge) |
|
6934 from hy' dependants_threads[of tm] |
|
6935 show "y' \<in> (\<lambda>th. preced th s) ` threads s" by auto |
|
6936 next |
|
6937 from finite_threads |
|
6938 show "finite ((\<lambda>th. preced th s) ` threads s)" by simp |
|
6939 qed |
|
6940 } with hy show ?thesis by auto |
|
6941 qed |
|
6942 next |
|
6943 from dependants_threads[of tm] finite_threads |
|
6944 show "finite ((\<lambda>th. preced th s) ` ({tm} \<union> dependants (wq s) tm))" |
|
6945 by (auto intro:finite_subset) |
|
6946 next |
|
6947 show "preced tm s \<in> (\<lambda>th. preced th s) ` ({tm} \<union> dependants (wq s) tm)" |
|
6948 by simp |
|
6949 qed |
|
6950 moreover have "Max (cp s ` readys s) = cp s tm" |
|
6951 proof(rule Max_eqI) |
|
6952 from tm_ready show "cp s tm \<in> cp s ` readys s" by simp |
|
6953 next |
|
6954 from finite_threads |
|
6955 show "finite (cp s ` readys s)" by (auto simp:readys_def) |
|
6956 next |
|
6957 fix y assume "y \<in> cp s ` readys s" |
|
6958 then obtain th1 where th1_readys: "th1 \<in> readys s" |
|
6959 and h: "y = cp s th1" by auto |
|
6960 show "y \<le> cp s tm" |
|
6961 apply(unfold cp_eq_p h) |
|
6962 apply(unfold cp_eq_cpreced cpreced_def tm_max, rule Max_mono) |
|
6963 proof - |
|
6964 from finite_threads |
|
6965 show "finite ((\<lambda>th. preced th s) ` threads s)" by simp |
|
6966 next |
|
6967 show "(\<lambda>th. preced th s) ` ({th1} \<union> dependants (wq s) th1) \<noteq> {}" |
|
6968 by simp |
|
6969 next |
|
6970 from dependants_threads[of th1] th1_readys |
|
6971 show "(\<lambda>th. preced th s) ` ({th1} \<union> dependants (wq s) th1) |
|
6972 \<subseteq> (\<lambda>th. preced th s) ` threads s" |
|
6973 by (auto simp:readys_def) |
|
6974 qed |
|
6975 qed |
|
6976 ultimately show " Max (cp s ` readys s) = preced tm s" by simp |
|
6977 qed |
|
6978 qed |
|
6979 qed |
|
6980 qed |
|
6981 |
|
6982 text {* (* ccc *) \noindent |
|
6983 Since the current precedence of the threads in ready queue will always be boosted, |
|
6984 there must be one inside it has the maximum precedence of the whole system. |
|
6985 *} |
|
6986 lemma max_cp_readys_threads: |
|
6987 shows "Max (cp s ` readys s) = Max (cp s ` threads s)" |
|
6988 proof(cases "threads s = {}") |
|
6989 case True |
|
6990 thus ?thesis |
|
6991 by (auto simp:readys_def) |
|
6992 next |
|
6993 case False |
|
6994 show ?thesis by (rule max_cp_readys_threads_pre[OF False]) |
|
6995 qed |
|
6996 |
|
6997 end |
|
6998 |
|
6999 lemma eq_holding: "holding (wq s) th cs = holding s th cs" |
|
7000 apply (unfold s_holding_def cs_holding_def wq_def, simp) |
|
7001 done |
|
7002 |
|
7003 lemma f_image_eq: |
|
7004 assumes h: "\<And> a. a \<in> A \<Longrightarrow> f a = g a" |
|
7005 shows "f ` A = g ` A" |
|
7006 proof |
|
7007 show "f ` A \<subseteq> g ` A" |
|
7008 by(rule image_subsetI, auto intro:h) |
|
7009 next |
|
7010 show "g ` A \<subseteq> f ` A" |
|
7011 by (rule image_subsetI, auto intro:h[symmetric]) |
|
7012 qed |
|
7013 |
|
7014 |
4378 |
7015 definition detached :: "state \<Rightarrow> thread \<Rightarrow> bool" |
4379 definition detached :: "state \<Rightarrow> thread \<Rightarrow> bool" |
7016 where "detached s th \<equiv> (\<not>(\<exists> cs. holding s th cs)) \<and> (\<not>(\<exists>cs. waiting s th cs))" |
4380 where "detached s th \<equiv> (\<not>(\<exists> cs. holding s th cs)) \<and> (\<not>(\<exists>cs. waiting s th cs))" |
7017 |
|
7018 |
4381 |
7019 lemma detached_test: |
4382 lemma detached_test: |
7020 shows "detached s th = (Th th \<notin> Field (RAG s))" |
4383 shows "detached s th = (Th th \<notin> Field (RAG s))" |
7021 apply(simp add: detached_def Field_def) |
4384 apply(simp add: detached_def Field_def) |
7022 apply(simp add: s_RAG_def) |
4385 apply(simp add: s_RAG_def) |
7027 done |
4390 done |
7028 |
4391 |
7029 context valid_trace |
4392 context valid_trace |
7030 begin |
4393 begin |
7031 |
4394 |
7032 lemma detached_intro: |
|
7033 assumes eq_pv: "cntP s th = cntV s th" |
|
7034 shows "detached s th" |
|
7035 proof - |
|
7036 from cnp_cnv_cncs |
|
7037 have eq_cnt: "cntP s th = |
|
7038 cntV s th + (if th \<in> readys s \<or> th \<notin> threads s then cntCS s th else cntCS s th + 1)" . |
|
7039 hence cncs_zero: "cntCS s th = 0" |
|
7040 by (auto simp:eq_pv split:if_splits) |
|
7041 with eq_cnt |
|
7042 have "th \<in> readys s \<or> th \<notin> threads s" by (auto simp:eq_pv) |
|
7043 thus ?thesis |
|
7044 proof |
|
7045 assume "th \<notin> threads s" |
|
7046 with range_in dm_RAG_threads |
|
7047 show ?thesis |
|
7048 by (auto simp add: detached_def s_RAG_def s_waiting_abv s_holding_abv wq_def Domain_iff Range_iff) |
|
7049 next |
|
7050 assume "th \<in> readys s" |
|
7051 moreover have "Th th \<notin> Range (RAG s)" |
|
7052 proof - |
|
7053 from card_0_eq [OF finite_holding] and cncs_zero |
|
7054 have "holdents s th = {}" |
|
7055 by (simp add:cntCS_def) |
|
7056 thus ?thesis |
|
7057 apply(auto simp:holdents_test) |
|
7058 apply(case_tac a) |
|
7059 apply(auto simp:holdents_test s_RAG_def) |
|
7060 done |
|
7061 qed |
|
7062 ultimately show ?thesis |
|
7063 by (auto simp add: detached_def s_RAG_def s_waiting_abv s_holding_abv wq_def readys_def) |
|
7064 qed |
|
7065 qed |
|
7066 |
|
7067 lemma detached_elim: |
|
7068 assumes dtc: "detached s th" |
|
7069 shows "cntP s th = cntV s th" |
|
7070 proof - |
|
7071 from cnp_cnv_cncs |
|
7072 have eq_pv: " cntP s th = |
|
7073 cntV s th + (if th \<in> readys s \<or> th \<notin> threads s then cntCS s th else cntCS s th + 1)" . |
|
7074 have cncs_z: "cntCS s th = 0" |
|
7075 proof - |
|
7076 from dtc have "holdents s th = {}" |
|
7077 unfolding detached_def holdents_test s_RAG_def |
|
7078 by (simp add: s_waiting_abv wq_def s_holding_abv Domain_iff Range_iff) |
|
7079 thus ?thesis by (auto simp:cntCS_def) |
|
7080 qed |
|
7081 show ?thesis |
|
7082 proof(cases "th \<in> threads s") |
|
7083 case True |
|
7084 with dtc |
|
7085 have "th \<in> readys s" |
|
7086 by (unfold readys_def detached_def Field_def Domain_def Range_def, |
|
7087 auto simp:eq_waiting s_RAG_def) |
|
7088 with cncs_z and eq_pv show ?thesis by simp |
|
7089 next |
|
7090 case False |
|
7091 with cncs_z and eq_pv show ?thesis by simp |
|
7092 qed |
|
7093 qed |
|
7094 |
|
7095 lemma detached_eq: |
|
7096 shows "(detached s th) = (cntP s th = cntV s th)" |
|
7097 by (insert vt, auto intro:detached_intro detached_elim) |
|
7098 |
|
7099 end |
|
7100 |
|
7101 text {* |
|
7102 The lemmas in this .thy file are all obvious lemmas, however, they still needs to be derived |
|
7103 from the concise and miniature model of PIP given in PrioGDef.thy. |
|
7104 *} |
|
7105 |
|
7106 lemma eq_dependants: "dependants (wq s) = dependants s" |
|
7107 by (simp add: s_dependants_abv wq_def) |
|
7108 |
|
7109 lemma next_th_unique: |
|
7110 assumes nt1: "next_th s th cs th1" |
|
7111 and nt2: "next_th s th cs th2" |
|
7112 shows "th1 = th2" |
|
7113 using assms by (unfold next_th_def, auto) |
|
7114 |
|
7115 lemma birth_time_lt: "s \<noteq> [] \<Longrightarrow> last_set th s < length s" |
|
7116 apply (induct s, simp) |
|
7117 proof - |
|
7118 fix a s |
|
7119 assume ih: "s \<noteq> [] \<Longrightarrow> last_set th s < length s" |
|
7120 and eq_as: "a # s \<noteq> []" |
|
7121 show "last_set th (a # s) < length (a # s)" |
|
7122 proof(cases "s \<noteq> []") |
|
7123 case False |
|
7124 from False show ?thesis |
|
7125 by (cases a, auto simp:last_set.simps) |
|
7126 next |
|
7127 case True |
|
7128 from ih [OF True] show ?thesis |
|
7129 by (cases a, auto simp:last_set.simps) |
|
7130 qed |
|
7131 qed |
|
7132 |
|
7133 lemma th_in_ne: "th \<in> threads s \<Longrightarrow> s \<noteq> []" |
|
7134 by (induct s, auto simp:threads.simps) |
|
7135 |
|
7136 lemma preced_tm_lt: "th \<in> threads s \<Longrightarrow> preced th s = Prc x y \<Longrightarrow> y < length s" |
|
7137 apply (drule_tac th_in_ne) |
|
7138 by (unfold preced_def, auto intro: birth_time_lt) |
|
7139 |
|
7140 lemma inj_the_preced: |
|
7141 "inj_on (the_preced s) (threads s)" |
|
7142 by (metis inj_onI preced_unique the_preced_def) |
|
7143 |
|
7144 lemma tRAG_alt_def: |
|
7145 "tRAG s = {(Th th1, Th th2) | th1 th2. |
|
7146 \<exists> cs. (Th th1, Cs cs) \<in> RAG s \<and> (Cs cs, Th th2) \<in> RAG s}" |
|
7147 by (auto simp:tRAG_def RAG_split wRAG_def hRAG_def) |
|
7148 |
|
7149 lemma tRAG_Field: |
|
7150 "Field (tRAG s) \<subseteq> Field (RAG s)" |
|
7151 by (unfold tRAG_alt_def Field_def, auto) |
|
7152 |
|
7153 lemma tRAG_ancestorsE: |
|
7154 assumes "x \<in> ancestors (tRAG s) u" |
|
7155 obtains th where "x = Th th" |
|
7156 proof - |
|
7157 from assms have "(u, x) \<in> (tRAG s)^+" |
|
7158 by (unfold ancestors_def, auto) |
|
7159 from tranclE[OF this] obtain c where "(c, x) \<in> tRAG s" by auto |
|
7160 then obtain th where "x = Th th" |
|
7161 by (unfold tRAG_alt_def, auto) |
|
7162 from that[OF this] show ?thesis . |
|
7163 qed |
|
7164 |
|
7165 lemma tRAG_mono: |
|
7166 assumes "RAG s' \<subseteq> RAG s" |
|
7167 shows "tRAG s' \<subseteq> tRAG s" |
|
7168 using assms |
|
7169 by (unfold tRAG_alt_def, auto) |
|
7170 |
|
7171 lemma holding_next_thI: |
|
7172 assumes "holding s th cs" |
|
7173 and "length (wq s cs) > 1" |
|
7174 obtains th' where "next_th s th cs th'" |
|
7175 proof - |
|
7176 from assms(1)[folded eq_holding, unfolded cs_holding_def] |
|
7177 have " th \<in> set (wq s cs) \<and> th = hd (wq s cs)" . |
|
7178 then obtain rest where h1: "wq s cs = th#rest" |
|
7179 by (cases "wq s cs", auto) |
|
7180 with assms(2) have h2: "rest \<noteq> []" by auto |
|
7181 let ?th' = "hd (SOME q. distinct q \<and> set q = set rest)" |
|
7182 have "next_th s th cs ?th'" using h1(1) h2 |
|
7183 by (unfold next_th_def, auto) |
|
7184 from that[OF this] show ?thesis . |
|
7185 qed |
|
7186 |
|
7187 lemma RAG_tRAG_transfer: |
|
7188 assumes "vt s'" |
|
7189 assumes "RAG s = RAG s' \<union> {(Th th, Cs cs)}" |
|
7190 and "(Cs cs, Th th'') \<in> RAG s'" |
|
7191 shows "tRAG s = tRAG s' \<union> {(Th th, Th th'')}" (is "?L = ?R") |
|
7192 proof - |
|
7193 interpret vt_s': valid_trace "s'" using assms(1) |
|
7194 by (unfold_locales, simp) |
|
7195 interpret rtree: rtree "RAG s'" |
|
7196 proof |
|
7197 show "single_valued (RAG s')" |
|
7198 apply (intro_locales) |
|
7199 by (unfold single_valued_def, |
|
7200 auto intro:vt_s'.unique_RAG) |
|
7201 |
|
7202 show "acyclic (RAG s')" |
|
7203 by (rule vt_s'.acyclic_RAG) |
|
7204 qed |
|
7205 { fix n1 n2 |
|
7206 assume "(n1, n2) \<in> ?L" |
|
7207 from this[unfolded tRAG_alt_def] |
|
7208 obtain th1 th2 cs' where |
|
7209 h: "n1 = Th th1" "n2 = Th th2" |
|
7210 "(Th th1, Cs cs') \<in> RAG s" |
|
7211 "(Cs cs', Th th2) \<in> RAG s" by auto |
|
7212 from h(4) and assms(2) have cs_in: "(Cs cs', Th th2) \<in> RAG s'" by auto |
|
7213 from h(3) and assms(2) |
|
7214 have "(Th th1, Cs cs') = (Th th, Cs cs) \<or> |
|
7215 (Th th1, Cs cs') \<in> RAG s'" by auto |
|
7216 hence "(n1, n2) \<in> ?R" |
|
7217 proof |
|
7218 assume h1: "(Th th1, Cs cs') = (Th th, Cs cs)" |
|
7219 hence eq_th1: "th1 = th" by simp |
|
7220 moreover have "th2 = th''" |
|
7221 proof - |
|
7222 from h1 have "cs' = cs" by simp |
|
7223 from assms(3) cs_in[unfolded this] rtree.sgv |
|
7224 show ?thesis |
|
7225 by (unfold single_valued_def, auto) |
|
7226 qed |
|
7227 ultimately show ?thesis using h(1,2) by auto |
|
7228 next |
|
7229 assume "(Th th1, Cs cs') \<in> RAG s'" |
|
7230 with cs_in have "(Th th1, Th th2) \<in> tRAG s'" |
|
7231 by (unfold tRAG_alt_def, auto) |
|
7232 from this[folded h(1, 2)] show ?thesis by auto |
|
7233 qed |
|
7234 } moreover { |
|
7235 fix n1 n2 |
|
7236 assume "(n1, n2) \<in> ?R" |
|
7237 hence "(n1, n2) \<in>tRAG s' \<or> (n1, n2) = (Th th, Th th'')" by auto |
|
7238 hence "(n1, n2) \<in> ?L" |
|
7239 proof |
|
7240 assume "(n1, n2) \<in> tRAG s'" |
|
7241 moreover have "... \<subseteq> ?L" |
|
7242 proof(rule tRAG_mono) |
|
7243 show "RAG s' \<subseteq> RAG s" by (unfold assms(2), auto) |
|
7244 qed |
|
7245 ultimately show ?thesis by auto |
|
7246 next |
|
7247 assume eq_n: "(n1, n2) = (Th th, Th th'')" |
|
7248 from assms(2, 3) have "(Cs cs, Th th'') \<in> RAG s" by auto |
|
7249 moreover have "(Th th, Cs cs) \<in> RAG s" using assms(2) by auto |
|
7250 ultimately show ?thesis |
|
7251 by (unfold eq_n tRAG_alt_def, auto) |
|
7252 qed |
|
7253 } ultimately show ?thesis by auto |
|
7254 qed |
|
7255 |
|
7256 context valid_trace |
|
7257 begin |
|
7258 |
|
7259 lemmas RAG_tRAG_transfer = RAG_tRAG_transfer[OF vt] |
|
7260 |
|
7261 end |
|
7262 |
|
7263 lemma cp_alt_def: |
|
7264 "cp s th = |
|
7265 Max ((the_preced s) ` {th'. Th th' \<in> (subtree (RAG s) (Th th))})" |
|
7266 proof - |
|
7267 have "Max (the_preced s ` ({th} \<union> dependants (wq s) th)) = |
|
7268 Max (the_preced s ` {th'. Th th' \<in> subtree (RAG s) (Th th)})" |
|
7269 (is "Max (_ ` ?L) = Max (_ ` ?R)") |
|
7270 proof - |
|
7271 have "?L = ?R" |
|
7272 by (auto dest:rtranclD simp:cs_dependants_def cs_RAG_def s_RAG_def subtree_def) |
|
7273 thus ?thesis by simp |
|
7274 qed |
|
7275 thus ?thesis by (unfold cp_eq_cpreced cpreced_def, fold the_preced_def, simp) |
|
7276 qed |
|
7277 |
|
7278 lemma cp_gen_alt_def: |
|
7279 "cp_gen s = (Max \<circ> (\<lambda>x. (the_preced s \<circ> the_thread) ` subtree (tRAG s) x))" |
|
7280 by (auto simp:cp_gen_def) |
|
7281 |
|
7282 lemma tRAG_nodeE: |
|
7283 assumes "(n1, n2) \<in> tRAG s" |
|
7284 obtains th1 th2 where "n1 = Th th1" "n2 = Th th2" |
|
7285 using assms |
|
7286 by (auto simp: tRAG_def wRAG_def hRAG_def tRAG_def) |
|
7287 |
|
7288 lemma subtree_nodeE: |
|
7289 assumes "n \<in> subtree (tRAG s) (Th th)" |
|
7290 obtains th1 where "n = Th th1" |
|
7291 proof - |
|
7292 show ?thesis |
|
7293 proof(rule subtreeE[OF assms]) |
|
7294 assume "n = Th th" |
|
7295 from that[OF this] show ?thesis . |
|
7296 next |
|
7297 assume "Th th \<in> ancestors (tRAG s) n" |
|
7298 hence "(n, Th th) \<in> (tRAG s)^+" by (auto simp:ancestors_def) |
|
7299 hence "\<exists> th1. n = Th th1" |
|
7300 proof(induct) |
|
7301 case (base y) |
|
7302 from tRAG_nodeE[OF this] show ?case by metis |
|
7303 next |
|
7304 case (step y z) |
|
7305 thus ?case by auto |
|
7306 qed |
|
7307 with that show ?thesis by auto |
|
7308 qed |
|
7309 qed |
|
7310 |
|
7311 lemma tRAG_star_RAG: "(tRAG s)^* \<subseteq> (RAG s)^*" |
|
7312 proof - |
|
7313 have "(wRAG s O hRAG s)^* \<subseteq> (RAG s O RAG s)^*" |
|
7314 by (rule rtrancl_mono, auto simp:RAG_split) |
|
7315 also have "... \<subseteq> ((RAG s)^*)^*" |
|
7316 by (rule rtrancl_mono, auto) |
|
7317 also have "... = (RAG s)^*" by simp |
|
7318 finally show ?thesis by (unfold tRAG_def, simp) |
|
7319 qed |
|
7320 |
|
7321 lemma tRAG_subtree_RAG: "subtree (tRAG s) x \<subseteq> subtree (RAG s) x" |
|
7322 proof - |
|
7323 { fix a |
|
7324 assume "a \<in> subtree (tRAG s) x" |
|
7325 hence "(a, x) \<in> (tRAG s)^*" by (auto simp:subtree_def) |
|
7326 with tRAG_star_RAG[of s] |
|
7327 have "(a, x) \<in> (RAG s)^*" by auto |
|
7328 hence "a \<in> subtree (RAG s) x" by (auto simp:subtree_def) |
|
7329 } thus ?thesis by auto |
|
7330 qed |
|
7331 |
|
7332 lemma tRAG_trancl_eq: |
|
7333 "{th'. (Th th', Th th) \<in> (tRAG s)^+} = |
|
7334 {th'. (Th th', Th th) \<in> (RAG s)^+}" |
|
7335 (is "?L = ?R") |
|
7336 proof - |
|
7337 { fix th' |
|
7338 assume "th' \<in> ?L" |
|
7339 hence "(Th th', Th th) \<in> (tRAG s)^+" by auto |
|
7340 from tranclD[OF this] |
|
7341 obtain z where h: "(Th th', z) \<in> tRAG s" "(z, Th th) \<in> (tRAG s)\<^sup>*" by auto |
|
7342 from tRAG_subtree_RAG[of s] and this(2) |
|
7343 have "(z, Th th) \<in> (RAG s)^*" by (meson subsetCE tRAG_star_RAG) |
|
7344 moreover from h(1) have "(Th th', z) \<in> (RAG s)^+" using tRAG_alt_def by auto |
|
7345 ultimately have "th' \<in> ?R" by auto |
|
7346 } moreover |
|
7347 { fix th' |
|
7348 assume "th' \<in> ?R" |
|
7349 hence "(Th th', Th th) \<in> (RAG s)^+" by (auto) |
|
7350 from plus_rpath[OF this] |
|
7351 obtain xs where rp: "rpath (RAG s) (Th th') xs (Th th)" "xs \<noteq> []" by auto |
|
7352 hence "(Th th', Th th) \<in> (tRAG s)^+" |
|
7353 proof(induct xs arbitrary:th' th rule:length_induct) |
|
7354 case (1 xs th' th) |
|
7355 then obtain x1 xs1 where Cons1: "xs = x1#xs1" by (cases xs, auto) |
|
7356 show ?case |
|
7357 proof(cases "xs1") |
|
7358 case Nil |
|
7359 from 1(2)[unfolded Cons1 Nil] |
|
7360 have rp: "rpath (RAG s) (Th th') [x1] (Th th)" . |
|
7361 hence "(Th th', x1) \<in> (RAG s)" by (cases, simp) |
|
7362 then obtain cs where "x1 = Cs cs" |
|
7363 by (unfold s_RAG_def, auto) |
|
7364 from rpath_nnl_lastE[OF rp[unfolded this]] |
|
7365 show ?thesis by auto |
|
7366 next |
|
7367 case (Cons x2 xs2) |
|
7368 from 1(2)[unfolded Cons1[unfolded this]] |
|
7369 have rp: "rpath (RAG s) (Th th') (x1 # x2 # xs2) (Th th)" . |
|
7370 from rpath_edges_on[OF this] |
|
7371 have eds: "edges_on (Th th' # x1 # x2 # xs2) \<subseteq> RAG s" . |
|
7372 have "(Th th', x1) \<in> edges_on (Th th' # x1 # x2 # xs2)" |
|
7373 by (simp add: edges_on_unfold) |
|
7374 with eds have rg1: "(Th th', x1) \<in> RAG s" by auto |
|
7375 then obtain cs1 where eq_x1: "x1 = Cs cs1" by (unfold s_RAG_def, auto) |
|
7376 have "(x1, x2) \<in> edges_on (Th th' # x1 # x2 # xs2)" |
|
7377 by (simp add: edges_on_unfold) |
|
7378 from this eds |
|
7379 have rg2: "(x1, x2) \<in> RAG s" by auto |
|
7380 from this[unfolded eq_x1] |
|
7381 obtain th1 where eq_x2: "x2 = Th th1" by (unfold s_RAG_def, auto) |
|
7382 from rg1[unfolded eq_x1] rg2[unfolded eq_x1 eq_x2] |
|
7383 have rt1: "(Th th', Th th1) \<in> tRAG s" by (unfold tRAG_alt_def, auto) |
|
7384 from rp have "rpath (RAG s) x2 xs2 (Th th)" |
|
7385 by (elim rpath_ConsE, simp) |
|
7386 from this[unfolded eq_x2] have rp': "rpath (RAG s) (Th th1) xs2 (Th th)" . |
|
7387 show ?thesis |
|
7388 proof(cases "xs2 = []") |
|
7389 case True |
|
7390 from rpath_nilE[OF rp'[unfolded this]] |
|
7391 have "th1 = th" by auto |
|
7392 from rt1[unfolded this] show ?thesis by auto |
|
7393 next |
|
7394 case False |
|
7395 from 1(1)[rule_format, OF _ rp' this, unfolded Cons1 Cons] |
|
7396 have "(Th th1, Th th) \<in> (tRAG s)\<^sup>+" by simp |
|
7397 with rt1 show ?thesis by auto |
|
7398 qed |
|
7399 qed |
|
7400 qed |
|
7401 hence "th' \<in> ?L" by auto |
|
7402 } ultimately show ?thesis by blast |
|
7403 qed |
|
7404 |
|
7405 lemma tRAG_trancl_eq_Th: |
|
7406 "{Th th' | th'. (Th th', Th th) \<in> (tRAG s)^+} = |
|
7407 {Th th' | th'. (Th th', Th th) \<in> (RAG s)^+}" |
|
7408 using tRAG_trancl_eq by auto |
|
7409 |
|
7410 lemma dependants_alt_def: |
|
7411 "dependants s th = {th'. (Th th', Th th) \<in> (tRAG s)^+}" |
|
7412 by (metis eq_RAG s_dependants_def tRAG_trancl_eq) |
|
7413 |
|
7414 context valid_trace |
|
7415 begin |
|
7416 |
|
7417 >>>>>>> other |
|
7418 lemma count_eq_tRAG_plus: |
|
7419 assumes "cntP s th = cntV s th" |
|
7420 shows "{th'. (Th th', Th th) \<in> (tRAG s)^+} = {}" |
|
7421 using assms count_eq_dependants dependants_alt_def eq_dependants by auto |
|
7422 |
|
7423 lemma count_eq_RAG_plus: |
|
7424 assumes "cntP s th = cntV s th" |
|
7425 shows "{th'. (Th th', Th th) \<in> (RAG s)^+} = {}" |
|
7426 using assms count_eq_dependants cs_dependants_def eq_RAG by auto |
|
7427 |
|
7428 lemma count_eq_RAG_plus_Th: |
|
7429 assumes "cntP s th = cntV s th" |
|
7430 shows "{Th th' | th'. (Th th', Th th) \<in> (RAG s)^+} = {}" |
|
7431 using count_eq_RAG_plus[OF assms] by auto |
|
7432 |
|
7433 lemma count_eq_tRAG_plus_Th: |
|
7434 assumes "cntP s th = cntV s th" |
|
7435 shows "{Th th' | th'. (Th th', Th th) \<in> (tRAG s)^+} = {}" |
|
7436 using count_eq_tRAG_plus[OF assms] by auto |
|
7437 <<<<<<< local |
|
7438 ======= |
|
7439 |
|
7440 end |
|
7441 |
|
7442 lemma tRAG_subtree_eq: |
|
7443 "(subtree (tRAG s) (Th th)) = {Th th' | th'. Th th' \<in> (subtree (RAG s) (Th th))}" |
|
7444 (is "?L = ?R") |
|
7445 proof - |
|
7446 { fix n |
|
7447 assume h: "n \<in> ?L" |
|
7448 hence "n \<in> ?R" |
|
7449 by (smt mem_Collect_eq subsetCE subtree_def subtree_nodeE tRAG_subtree_RAG) |
|
7450 } moreover { |
|
7451 fix n |
|
7452 assume "n \<in> ?R" |
|
7453 then obtain th' where h: "n = Th th'" "(Th th', Th th) \<in> (RAG s)^*" |
|
7454 by (auto simp:subtree_def) |
|
7455 from rtranclD[OF this(2)] |
|
7456 have "n \<in> ?L" |
|
7457 proof |
|
7458 assume "Th th' \<noteq> Th th \<and> (Th th', Th th) \<in> (RAG s)\<^sup>+" |
|
7459 with h have "n \<in> {Th th' | th'. (Th th', Th th) \<in> (RAG s)^+}" by auto |
|
7460 thus ?thesis using subtree_def tRAG_trancl_eq by fastforce |
|
7461 qed (insert h, auto simp:subtree_def) |
|
7462 } ultimately show ?thesis by auto |
|
7463 qed |
|
7464 |
|
7465 lemma threads_set_eq: |
|
7466 "the_thread ` (subtree (tRAG s) (Th th)) = |
|
7467 {th'. Th th' \<in> (subtree (RAG s) (Th th))}" (is "?L = ?R") |
|
7468 by (auto intro:rev_image_eqI simp:tRAG_subtree_eq) |
|
7469 |
|
7470 lemma cp_alt_def1: |
|
7471 "cp s th = Max ((the_preced s o the_thread) ` (subtree (tRAG s) (Th th)))" |
|
7472 proof - |
|
7473 have "(the_preced s ` the_thread ` subtree (tRAG s) (Th th)) = |
|
7474 ((the_preced s \<circ> the_thread) ` subtree (tRAG s) (Th th))" |
|
7475 by auto |
|
7476 thus ?thesis by (unfold cp_alt_def, fold threads_set_eq, auto) |
|
7477 qed |
|
7478 |
|
7479 lemma cp_gen_def_cond: |
|
7480 assumes "x = Th th" |
|
7481 shows "cp s th = cp_gen s (Th th)" |
|
7482 by (unfold cp_alt_def1 cp_gen_def, simp) |
|
7483 |
|
7484 lemma cp_gen_over_set: |
|
7485 assumes "\<forall> x \<in> A. \<exists> th. x = Th th" |
|
7486 shows "cp_gen s ` A = (cp s \<circ> the_thread) ` A" |
|
7487 proof(rule f_image_eq) |
|
7488 fix a |
|
7489 assume "a \<in> A" |
|
7490 from assms[rule_format, OF this] |
|
7491 obtain th where eq_a: "a = Th th" by auto |
|
7492 show "cp_gen s a = (cp s \<circ> the_thread) a" |
|
7493 by (unfold eq_a, simp, unfold cp_gen_def_cond[OF refl[of "Th th"]], simp) |
|
7494 qed |
|
7495 |
|
7496 |
|
7497 context valid_trace |
|
7498 begin |
|
7499 |
|
7500 lemma RAG_threads: |
|
7501 assumes "(Th th) \<in> Field (RAG s)" |
|
7502 shows "th \<in> threads s" |
|
7503 using assms |
|
7504 by (metis Field_def UnE dm_RAG_threads range_in vt) |
|
7505 |
|
7506 lemma subtree_tRAG_thread: |
|
7507 assumes "th \<in> threads s" |
|
7508 shows "subtree (tRAG s) (Th th) \<subseteq> Th ` threads s" (is "?L \<subseteq> ?R") |
|
7509 proof - |
|
7510 have "?L = {Th th' |th'. Th th' \<in> subtree (RAG s) (Th th)}" |
|
7511 by (unfold tRAG_subtree_eq, simp) |
|
7512 also have "... \<subseteq> ?R" |
|
7513 proof |
|
7514 fix x |
|
7515 assume "x \<in> {Th th' |th'. Th th' \<in> subtree (RAG s) (Th th)}" |
|
7516 then obtain th' where h: "x = Th th'" "Th th' \<in> subtree (RAG s) (Th th)" by auto |
|
7517 from this(2) |
|
7518 show "x \<in> ?R" |
|
7519 proof(cases rule:subtreeE) |
|
7520 case 1 |
|
7521 thus ?thesis by (simp add: assms h(1)) |
|
7522 next |
|
7523 case 2 |
|
7524 thus ?thesis by (metis ancestors_Field dm_RAG_threads h(1) image_eqI) |
|
7525 qed |
|
7526 qed |
|
7527 finally show ?thesis . |
|
7528 qed |
|
7529 |
|
7530 lemma readys_root: |
|
7531 assumes "th \<in> readys s" |
|
7532 shows "root (RAG s) (Th th)" |
|
7533 proof - |
|
7534 { fix x |
|
7535 assume "x \<in> ancestors (RAG s) (Th th)" |
|
7536 hence h: "(Th th, x) \<in> (RAG s)^+" by (auto simp:ancestors_def) |
|
7537 from tranclD[OF this] |
|
7538 obtain z where "(Th th, z) \<in> RAG s" by auto |
|
7539 with assms(1) have False |
|
7540 apply (case_tac z, auto simp:readys_def s_RAG_def s_waiting_def cs_waiting_def) |
|
7541 by (fold wq_def, blast) |
|
7542 } thus ?thesis by (unfold root_def, auto) |
|
7543 qed |
|
7544 |
|
7545 lemma readys_in_no_subtree: |
|
7546 assumes "th \<in> readys s" |
|
7547 and "th' \<noteq> th" |
|
7548 shows "Th th \<notin> subtree (RAG s) (Th th')" |
|
7549 proof |
|
7550 assume "Th th \<in> subtree (RAG s) (Th th')" |
|
7551 thus False |
|
7552 proof(cases rule:subtreeE) |
|
7553 case 1 |
|
7554 with assms show ?thesis by auto |
|
7555 next |
|
7556 case 2 |
|
7557 with readys_root[OF assms(1)] |
|
7558 show ?thesis by (auto simp:root_def) |
|
7559 qed |
|
7560 qed |
|
7561 |
|
7562 lemma not_in_thread_isolated: |
|
7563 assumes "th \<notin> threads s" |
|
7564 shows "(Th th) \<notin> Field (RAG s)" |
|
7565 proof |
|
7566 assume "(Th th) \<in> Field (RAG s)" |
|
7567 with dm_RAG_threads and range_in assms |
|
7568 show False by (unfold Field_def, blast) |
|
7569 qed |
|
7570 >>>>>>> other |
|
7571 |
|
7572 lemma wf_RAG: "wf (RAG s)" |
|
7573 proof(rule finite_acyclic_wf) |
|
7574 from finite_RAG show "finite (RAG s)" . |
|
7575 next |
|
7576 from acyclic_RAG show "acyclic (RAG s)" . |
|
7577 qed |
|
7578 |
|
7579 lemma sgv_wRAG: "single_valued (wRAG s)" |
|
7580 using waiting_unique |
|
7581 by (unfold single_valued_def wRAG_def, auto) |
|
7582 |
|
7583 lemma sgv_hRAG: "single_valued (hRAG s)" |
|
7584 using holding_unique |
|
7585 by (unfold single_valued_def hRAG_def, auto) |
|
7586 |
|
7587 lemma sgv_tRAG: "single_valued (tRAG s)" |
|
7588 by (unfold tRAG_def, rule single_valued_relcomp, |
|
7589 insert sgv_wRAG sgv_hRAG, auto) |
|
7590 |
|
7591 lemma acyclic_tRAG: "acyclic (tRAG s)" |
|
7592 proof(unfold tRAG_def, rule acyclic_compose) |
|
7593 show "acyclic (RAG s)" using acyclic_RAG . |
|
7594 next |
|
7595 show "wRAG s \<subseteq> RAG s" unfolding RAG_split by auto |
|
7596 next |
|
7597 show "hRAG s \<subseteq> RAG s" unfolding RAG_split by auto |
|
7598 qed |
|
7599 |
|
7600 lemma sgv_RAG: "single_valued (RAG s)" |
|
7601 using unique_RAG by (auto simp:single_valued_def) |
|
7602 |
|
7603 lemma rtree_RAG: "rtree (RAG s)" |
|
7604 using sgv_RAG acyclic_RAG |
|
7605 by (unfold rtree_def rtree_axioms_def sgv_def, auto) |
|
7606 |
|
7607 end |
|
7608 |
|
7609 sublocale valid_trace < rtree_RAG: rtree "RAG s" |
|
7610 proof |
|
7611 show "single_valued (RAG s)" |
|
7612 apply (intro_locales) |
|
7613 by (unfold single_valued_def, |
|
7614 auto intro:unique_RAG) |
|
7615 |
|
7616 <<<<<<< local |
|
7617 lemma detached_test: |
|
7618 shows "detached s th = (Th th \<notin> Field (RAG s))" |
|
7619 apply(simp add: detached_def Field_def) |
|
7620 apply(simp add: s_RAG_def) |
|
7621 apply(simp add: s_holding_abv s_waiting_abv) |
|
7622 apply(simp add: Domain_iff Range_iff) |
|
7623 apply(simp add: wq_def) |
|
7624 apply(auto) |
|
7625 done |
|
7626 ======= |
|
7627 show "acyclic (RAG s)" |
|
7628 by (rule acyclic_RAG) |
|
7629 qed |
|
7630 |
|
7631 sublocale valid_trace < rtree_s: rtree "tRAG s" |
|
7632 proof(unfold_locales) |
|
7633 from sgv_tRAG show "single_valued (tRAG s)" . |
|
7634 next |
|
7635 from acyclic_tRAG show "acyclic (tRAG s)" . |
|
7636 qed |
|
7637 |
|
7638 sublocale valid_trace < fsbtRAGs : fsubtree "RAG s" |
|
7639 proof - |
|
7640 show "fsubtree (RAG s)" |
|
7641 proof(intro_locales) |
|
7642 show "fbranch (RAG s)" using finite_fbranchI[OF finite_RAG] . |
|
7643 next |
|
7644 show "fsubtree_axioms (RAG s)" |
|
7645 proof(unfold fsubtree_axioms_def) |
|
7646 from wf_RAG show "wf (RAG s)" . |
|
7647 qed |
|
7648 qed |
|
7649 qed |
|
7650 |
|
7651 sublocale valid_trace < fsbttRAGs: fsubtree "tRAG s" |
|
7652 proof - |
|
7653 have "fsubtree (tRAG s)" |
|
7654 proof - |
|
7655 have "fbranch (tRAG s)" |
|
7656 proof(unfold tRAG_def, rule fbranch_compose) |
|
7657 show "fbranch (wRAG s)" |
|
7658 proof(rule finite_fbranchI) |
|
7659 from finite_RAG show "finite (wRAG s)" |
|
7660 by (unfold RAG_split, auto) |
|
7661 qed |
|
7662 next |
|
7663 show "fbranch (hRAG s)" |
|
7664 proof(rule finite_fbranchI) |
|
7665 from finite_RAG |
|
7666 show "finite (hRAG s)" by (unfold RAG_split, auto) |
|
7667 qed |
|
7668 qed |
|
7669 moreover have "wf (tRAG s)" |
|
7670 proof(rule wf_subset) |
|
7671 show "wf (RAG s O RAG s)" using wf_RAG |
|
7672 by (fold wf_comp_self, simp) |
|
7673 next |
|
7674 show "tRAG s \<subseteq> (RAG s O RAG s)" |
|
7675 by (unfold tRAG_alt_def, auto) |
|
7676 qed |
|
7677 ultimately show ?thesis |
|
7678 by (unfold fsubtree_def fsubtree_axioms_def,auto) |
|
7679 qed |
|
7680 from this[folded tRAG_def] show "fsubtree (tRAG s)" . |
|
7681 qed |
|
7682 |
|
7683 lemma Max_UNION: |
|
7684 assumes "finite A" |
|
7685 and "A \<noteq> {}" |
|
7686 and "\<forall> M \<in> f ` A. finite M" |
|
7687 and "\<forall> M \<in> f ` A. M \<noteq> {}" |
|
7688 shows "Max (\<Union>x\<in> A. f x) = Max (Max ` f ` A)" (is "?L = ?R") |
|
7689 using assms[simp] |
|
7690 proof - |
|
7691 have "?L = Max (\<Union>(f ` A))" |
|
7692 by (fold Union_image_eq, simp) |
|
7693 also have "... = ?R" |
|
7694 by (subst Max_Union, simp+) |
|
7695 finally show ?thesis . |
|
7696 qed |
|
7697 |
|
7698 lemma max_Max_eq: |
|
7699 assumes "finite A" |
|
7700 and "A \<noteq> {}" |
|
7701 and "x = y" |
|
7702 shows "max x (Max A) = Max ({y} \<union> A)" (is "?L = ?R") |
|
7703 proof - |
|
7704 have "?R = Max (insert y A)" by simp |
|
7705 also from assms have "... = ?L" |
|
7706 by (subst Max.insert, simp+) |
|
7707 finally show ?thesis by simp |
|
7708 qed |
|
7709 >>>>>>> other |
|
7710 |
|
7711 context valid_trace |
|
7712 begin |
|
7713 |
|
7714 <<<<<<< local |
|
7715 lemma detached_intro: |
4395 lemma detached_intro: |
7716 assumes eq_pv: "cntP s th = cntV s th" |
4396 assumes eq_pv: "cntP s th = cntV s th" |
7717 shows "detached s th" |
4397 shows "detached s th" |
7718 proof - |
4398 proof - |
7719 from eq_pv cnp_cnv_cncs |
4399 from eq_pv cnp_cnv_cncs |