diff -r 92f61f6a0fe7 -r af38526275f8 PrioG.thy --- a/PrioG.thy Thu May 22 17:40:39 2014 +0100 +++ b/PrioG.thy Fri May 23 15:19:32 2014 +0100 @@ -800,9 +800,11 @@ apply(fold wq_def) apply(drule_tac step_back_step) apply(ind_cases " step s (P (hd (wq s cs)) cs)") - apply(auto simp:s_RAG_def wq_def cs_holding_def) + apply(simp add:s_RAG_def wq_def cs_holding_def) + apply(auto) done +(* FIXME: Unused lemma simple_A: fixes A assumes h: "\ x y. \x \ A; y \ A\ \ x = y" @@ -814,6 +816,7 @@ with h have "A = {a}" by auto thus ?thesis by simp qed +*) lemma RAG_target_th: "(Th th, x) \ RAG (s::state) \ \ cs. x = Cs cs" by (unfold s_RAG_def, auto) @@ -822,126 +825,125 @@ fixes s assumes vt: "vt s" shows "acyclic (RAG s)" -proof - - from vt show ?thesis - proof(induct) - case (vt_cons s e) - assume ih: "acyclic (RAG s)" - and stp: "step s e" - and vt: "vt s" - show ?case - proof(cases e) - case (Create th prio) - with ih - show ?thesis by (simp add:RAG_create_unchanged) - next - case (Exit th) - with ih show ?thesis by (simp add:RAG_exit_unchanged) - next - case (V th cs) - from V vt stp have vtt: "vt (V th cs#s)" by auto - from step_RAG_v [OF this] - have eq_de: - "RAG (e # s) = - RAG s - {(Cs cs, Th th)} - {(Th th', Cs cs) |th'. next_th s th cs th'} \ - {(Cs cs, Th th') |th'. next_th s th cs th'}" - (is "?L = (?A - ?B - ?C) \ ?D") by (simp add:V) - from ih have ac: "acyclic (?A - ?B - ?C)" by (auto elim:acyclic_subset) - from step_back_step [OF vtt] - have "step s (V th cs)" . - thus ?thesis - proof(cases) - assume "holding s th cs" - hence th_in: "th \ set (wq s cs)" and - eq_hd: "th = hd (wq s cs)" unfolding s_holding_def wq_def by auto - then obtain rest where - eq_wq: "wq s cs = th#rest" - by (cases "wq s cs", auto) - show ?thesis - proof(cases "rest = []") - case False - let ?th' = "hd (SOME q. distinct q \ set q = set rest)" - from eq_wq False have eq_D: "?D = {(Cs cs, Th ?th')}" - by (unfold next_th_def, auto) - let ?E = "(?A - ?B - ?C)" - have "(Th ?th', Cs cs) \ ?E\<^sup>*" - proof - assume "(Th ?th', Cs cs) \ ?E\<^sup>*" - hence " (Th ?th', Cs cs) \ ?E\<^sup>+" by (simp add: rtrancl_eq_or_trancl) - from tranclD [OF this] - obtain x where th'_e: "(Th ?th', x) \ ?E" by blast - hence th_d: "(Th ?th', x) \ ?A" by simp - from RAG_target_th [OF this] - obtain cs' where eq_x: "x = Cs cs'" by auto - with th_d have "(Th ?th', Cs cs') \ ?A" by simp - hence wt_th': "waiting s ?th' cs'" - unfolding s_RAG_def s_waiting_def cs_waiting_def wq_def by simp - hence "cs' = cs" - proof(rule waiting_unique [OF vt]) - from eq_wq wq_distinct[OF vt, of cs] - show "waiting s ?th' cs" - apply (unfold s_waiting_def wq_def, auto) - proof - - assume hd_in: "hd (SOME q. distinct q \ set q = set rest) \ set rest" +using assms +proof(induct) + case (vt_cons s e) + assume ih: "acyclic (RAG s)" + and stp: "step s e" + and vt: "vt s" + show ?case + proof(cases e) + case (Create th prio) + with ih + show ?thesis by (simp add:RAG_create_unchanged) + next + case (Exit th) + with ih show ?thesis by (simp add:RAG_exit_unchanged) + next + case (V th cs) + from V vt stp have vtt: "vt (V th cs#s)" by auto + from step_RAG_v [OF this] + have eq_de: + "RAG (e # s) = + RAG s - {(Cs cs, Th th)} - {(Th th', Cs cs) |th'. next_th s th cs th'} \ + {(Cs cs, Th th') |th'. next_th s th cs th'}" + (is "?L = (?A - ?B - ?C) \ ?D") by (simp add:V) + from ih have ac: "acyclic (?A - ?B - ?C)" by (auto elim:acyclic_subset) + from step_back_step [OF vtt] + have "step s (V th cs)" . + thus ?thesis + proof(cases) + assume "holding s th cs" + hence th_in: "th \ set (wq s cs)" and + eq_hd: "th = hd (wq s cs)" unfolding s_holding_def wq_def by auto + then obtain rest where + eq_wq: "wq s cs = th#rest" + by (cases "wq s cs", auto) + show ?thesis + proof(cases "rest = []") + case False + let ?th' = "hd (SOME q. distinct q \ set q = set rest)" + from eq_wq False have eq_D: "?D = {(Cs cs, Th ?th')}" + by (unfold next_th_def, auto) + let ?E = "(?A - ?B - ?C)" + have "(Th ?th', Cs cs) \ ?E\<^sup>*" + proof + assume "(Th ?th', Cs cs) \ ?E\<^sup>*" + hence " (Th ?th', Cs cs) \ ?E\<^sup>+" by (simp add: rtrancl_eq_or_trancl) + from tranclD [OF this] + obtain x where th'_e: "(Th ?th', x) \ ?E" by blast + hence th_d: "(Th ?th', x) \ ?A" by simp + from RAG_target_th [OF this] + obtain cs' where eq_x: "x = Cs cs'" by auto + with th_d have "(Th ?th', Cs cs') \ ?A" by simp + hence wt_th': "waiting s ?th' cs'" + unfolding s_RAG_def s_waiting_def cs_waiting_def wq_def by simp + hence "cs' = cs" + proof(rule waiting_unique [OF vt]) + from eq_wq wq_distinct[OF vt, of cs] + show "waiting s ?th' cs" + apply (unfold s_waiting_def wq_def, auto) + proof - + assume hd_in: "hd (SOME q. distinct q \ set q = set rest) \ set rest" and eq_wq: "wq_fun (schs s) cs = th # rest" - have "(SOME q. distinct q \ set q = set rest) \ []" - proof(rule someI2) - from wq_distinct[OF vt, of cs] and eq_wq - show "distinct rest \ set rest = set rest" unfolding wq_def by auto - next - fix x assume "distinct x \ set x = set rest" - with False show "x \ []" by auto - qed - hence "hd (SOME q. distinct q \ set q = set rest) \ - set (SOME q. distinct q \ set q = set rest)" by auto - moreover have "\ = set rest" - proof(rule someI2) - from wq_distinct[OF vt, of cs] and eq_wq - show "distinct rest \ set rest = set rest" unfolding wq_def by auto - next - show "\x. distinct x \ set x = set rest \ set x = set rest" by auto - qed - moreover note hd_in - ultimately show "hd (SOME q. distinct q \ set q = set rest) = th" by auto + have "(SOME q. distinct q \ set q = set rest) \ []" + proof(rule someI2) + from wq_distinct[OF vt, of cs] and eq_wq + show "distinct rest \ set rest = set rest" unfolding wq_def by auto next - assume hd_in: "hd (SOME q. distinct q \ set q = set rest) \ set rest" + fix x assume "distinct x \ set x = set rest" + with False show "x \ []" by auto + qed + hence "hd (SOME q. distinct q \ set q = set rest) \ + set (SOME q. distinct q \ set q = set rest)" by auto + moreover have "\ = set rest" + proof(rule someI2) + from wq_distinct[OF vt, of cs] and eq_wq + show "distinct rest \ set rest = set rest" unfolding wq_def by auto + next + show "\x. distinct x \ set x = set rest \ set x = set rest" by auto + qed + moreover note hd_in + ultimately show "hd (SOME q. distinct q \ set q = set rest) = th" by auto + next + assume hd_in: "hd (SOME q. distinct q \ set q = set rest) \ set rest" and eq_wq: "wq s cs = hd (SOME q. distinct q \ set q = set rest) # rest" - have "(SOME q. distinct q \ set q = set rest) \ []" - proof(rule someI2) - from wq_distinct[OF vt, of cs] and eq_wq - show "distinct rest \ set rest = set rest" by auto - next - fix x assume "distinct x \ set x = set rest" - with False show "x \ []" by auto - qed - hence "hd (SOME q. distinct q \ set q = set rest) \ - set (SOME q. distinct q \ set q = set rest)" by auto - moreover have "\ = set rest" - proof(rule someI2) - from wq_distinct[OF vt, of cs] and eq_wq - show "distinct rest \ set rest = set rest" by auto - next - show "\x. distinct x \ set x = set rest \ set x = set rest" by auto - qed - moreover note hd_in - ultimately show False by auto + have "(SOME q. distinct q \ set q = set rest) \ []" + proof(rule someI2) + from wq_distinct[OF vt, of cs] and eq_wq + show "distinct rest \ set rest = set rest" by auto + next + fix x assume "distinct x \ set x = set rest" + with False show "x \ []" by auto + qed + hence "hd (SOME q. distinct q \ set q = set rest) \ + set (SOME q. distinct q \ set q = set rest)" by auto + moreover have "\ = set rest" + proof(rule someI2) + from wq_distinct[OF vt, of cs] and eq_wq + show "distinct rest \ set rest = set rest" by auto + next + show "\x. distinct x \ set x = set rest \ set x = set rest" by auto qed + moreover note hd_in + ultimately show False by auto qed - with th'_e eq_x have "(Th ?th', Cs cs) \ ?E" by simp - with False - show "False" by (auto simp: next_th_def eq_wq) qed - with acyclic_insert[symmetric] and ac - and eq_de eq_D show ?thesis by auto - next - case True - with eq_wq - have eq_D: "?D = {}" - by (unfold next_th_def, auto) - with eq_de ac - show ?thesis by auto - qed - qed + with th'_e eq_x have "(Th ?th', Cs cs) \ ?E" by simp + with False + show "False" by (auto simp: next_th_def eq_wq) + qed + with acyclic_insert[symmetric] and ac + and eq_de eq_D show ?thesis by auto + next + case True + with eq_wq + have eq_D: "?D = {}" + by (unfold next_th_def, auto) + with eq_de ac + show ?thesis by auto + qed + qed next case (P th cs) from P vt stp have vtt: "vt (P th cs#s)" by auto @@ -970,14 +972,14 @@ proof assume "(Cs cs, Th th) \ (RAG s)\<^sup>*" hence "(Cs cs, Th th) \ (RAG s)\<^sup>+" by (simp add: rtrancl_eq_or_trancl) - moreover from step_back_step [OF vtt] have "step s (P th cs)" . - ultimately show False - proof - - show " \(Cs cs, Th th) \ (RAG s)\<^sup>+; step s (P th cs)\ \ False" - by (ind_cases "step s (P th cs)", simp) - qed + moreover from step_back_step [OF vtt] have "step s (P th cs)" . + ultimately show False + proof - + show " \(Cs cs, Th th) \ (RAG s)\<^sup>+; step s (P th cs)\ \ False" + by (ind_cases "step s (P th cs)", simp) qed - with acyclic_insert ih eq_r show ?thesis by auto + qed + with acyclic_insert ih eq_r show ?thesis by auto qed ultimately show ?thesis by simp next @@ -990,8 +992,8 @@ case vt_nil show "acyclic (RAG ([]::state))" by (auto simp: s_RAG_def cs_waiting_def - cs_holding_def wq_def acyclic_def) - qed + cs_holding_def wq_def acyclic_def) +qed qed lemma finite_RAG: