prio/CpsG.thy
changeset 272 ee4611c1e13c
parent 262 4190df6f4488
child 290 6a6d0bd16035
--- a/prio/CpsG.thy	Mon Jan 30 09:44:33 2012 +0000
+++ b/prio/CpsG.thy	Wed Feb 01 08:16:00 2012 +0000
@@ -1356,6 +1356,142 @@
 locale step_P_cps_ne =step_P_cps +
   assumes ne: "wq s' cs \<noteq> []"
 
+locale step_P_cps_e =step_P_cps +
+  assumes ee: "wq s' cs = []"
+
+context step_P_cps_e
+begin
+
+lemma depend_s: "depend s = depend s' \<union> {(Cs cs, Th th)}"
+proof -
+  from ee and  step_depend_p[OF vt_s[unfolded s_def], folded s_def]
+  show ?thesis by auto
+qed
+
+lemma child_kept_left:
+  assumes 
+  "(n1, n2) \<in> (child s')^+"
+  shows "(n1, n2) \<in> (child s)^+"
+proof -
+  from assms show ?thesis 
+  proof(induct rule: converse_trancl_induct)
+    case (base y)
+    from base obtain th1 cs1 th2
+      where h1: "(Th th1, Cs cs1) \<in> depend s'"
+      and h2: "(Cs cs1, Th th2) \<in> depend s'"
+      and eq_y: "y = Th th1" and eq_n2: "n2 = Th th2"  by (auto simp:child_def)
+    have "cs1 \<noteq> cs"
+    proof
+      assume eq_cs: "cs1 = cs"
+      with h1 have "(Th th1, Cs cs) \<in> depend s'" by simp
+      with ee show False
+        by (auto simp:s_depend_def cs_waiting_def)
+    qed
+    with h1 h2 depend_s have 
+      h1': "(Th th1, Cs cs1) \<in> depend s" and
+      h2': "(Cs cs1, Th th2) \<in> depend s" by auto
+    hence "(Th th1, Th th2) \<in> child s" by (auto simp:child_def)
+    with eq_y eq_n2 have "(y, n2) \<in> child s" by simp
+    thus ?case by auto
+  next
+    case (step y z)
+    have "(y, z) \<in> child s'" by fact
+    then obtain th1 cs1 th2
+      where h1: "(Th th1, Cs cs1) \<in> depend s'"
+      and h2: "(Cs cs1, Th th2) \<in> depend s'"
+      and eq_y: "y = Th th1" and eq_z: "z = Th th2"  by (auto simp:child_def)
+    have "cs1 \<noteq> cs"
+    proof
+      assume eq_cs: "cs1 = cs"
+      with h1 have "(Th th1, Cs cs) \<in> depend s'" by simp
+      with ee show False 
+        by (auto simp:s_depend_def cs_waiting_def)
+    qed
+    with h1 h2 depend_s have 
+      h1': "(Th th1, Cs cs1) \<in> depend s" and
+      h2': "(Cs cs1, Th th2) \<in> depend s" by auto
+    hence "(Th th1, Th th2) \<in> child s" by (auto simp:child_def)
+    with eq_y eq_z have "(y, z) \<in> child s" by simp
+    moreover have "(z, n2) \<in> (child s)^+" by fact
+    ultimately show ?case by auto
+  qed
+qed
+
+lemma  child_kept_right:
+  assumes
+  "(n1, n2) \<in> (child s)^+"
+  shows "(n1, n2) \<in> (child s')^+"
+proof -
+  from assms show ?thesis
+  proof(induct)
+    case (base y)
+    from base and depend_s
+    have "(n1, y) \<in> child s'"
+      apply (auto simp:child_def)
+      proof -
+        fix th'
+        assume "(Th th', Cs cs) \<in> depend s'"
+        with ee have "False"
+          by (auto simp:s_depend_def cs_waiting_def)
+        thus "\<exists>cs. (Th th', Cs cs) \<in> depend s' \<and> (Cs cs, Th th) \<in> depend s'" by auto 
+      qed
+    thus ?case by auto
+  next
+    case (step y z)
+    have "(y, z) \<in> child s" by fact
+    with depend_s have "(y, z) \<in> child s'"
+      apply (auto simp:child_def)
+      proof -
+        fix th'
+        assume "(Th th', Cs cs) \<in> depend s'"
+        with ee have "False"
+          by (auto simp:s_depend_def cs_waiting_def)
+        thus "\<exists>cs. (Th th', Cs cs) \<in> depend s' \<and> (Cs cs, Th th) \<in> depend s'" by auto 
+      qed
+    moreover have "(n1, y) \<in> (child s')\<^sup>+" by fact
+    ultimately show ?case by auto
+  qed
+qed
+
+lemma eq_child: "(child s)^+ = (child s')^+"
+  by (insert child_kept_left child_kept_right, auto)
+
+lemma eq_cp:
+  fixes th' 
+  shows "cp s th' = cp s' th'"
+  apply (unfold cp_eq_cpreced cpreced_def)
+proof -
+  have eq_dp: "\<And> th. dependents (wq s) th = dependents (wq s') th"
+    apply (unfold cs_dependents_def, unfold eq_depend)
+  proof -
+    from eq_child
+    have "\<And>th. {th'. (Th th', Th th) \<in> (child s)\<^sup>+} = {th'. (Th th', Th th) \<in> (child s')\<^sup>+}"
+      by auto
+    with child_depend_eq[OF vt_s] child_depend_eq[OF step_back_vt[OF vt_s[unfolded s_def]]]
+    show "\<And>th. {th'. (Th th', Th th) \<in> (depend s)\<^sup>+} = {th'. (Th th', Th th) \<in> (depend s')\<^sup>+}"
+      by simp
+  qed
+  moreover {
+    fix th1 
+    assume "th1 \<in> {th'} \<union> dependents (wq s') th'"
+    hence "th1 = th' \<or> th1 \<in> dependents (wq s') th'" by auto
+    hence "preced th1 s = preced th1 s'"
+    proof
+      assume "th1 = th'"
+      show "preced th1 s = preced th1 s'" by (simp add:s_def preced_def)
+    next
+      assume "th1 \<in> dependents (wq s') th'"
+      show "preced th1 s = preced th1 s'" by (simp add:s_def preced_def)
+    qed
+  } ultimately have "((\<lambda>th. preced th s) ` ({th'} \<union> dependents (wq s) th')) = 
+                     ((\<lambda>th. preced th s') ` ({th'} \<union> dependents (wq s') th'))" 
+    by (auto simp:image_def)
+  thus "Max ((\<lambda>th. preced th s) ` ({th'} \<union> dependents (wq s) th')) =
+        Max ((\<lambda>th. preced th s') ` ({th'} \<union> dependents (wq s') th'))" by simp
+qed
+
+end
+
 context step_P_cps_ne
 begin