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