Theory FWProgress

(*  Title:      JinjaThreads/Framework/FWProgress.thy
    Author:     Andreas Lochbihler
*)

section ‹Progress theorem for the multithreaded semantics›

theory FWProgress
imports
  FWDeadlock
begin

locale progress = multithreaded final r convert_RA 
  for final :: "'x  bool"
  and r :: "('l,'t,'x,'m,'w,'o) semantics" (‹_  _ -_ _› [50,0,0,50] 80)
  and convert_RA :: "'l released_locks  'o list"
  +
  fixes wf_state :: "('l,'t,'x,'m,'w) state set"
  assumes wf_stateD: "s  wf_state  lock_thread_ok (locks s) (thr s)  wset_final_ok (wset s) (thr s)"
  and wf_red:
  " s  wf_state; thr s t = (x, no_wait_locks);
     t  (x, shr s) -ta (x', m'); ¬ waiting (wset s t) 
   ta' x' m'. t  (x, shr s) -ta' (x', m')  (actions_ok s t ta'  actions_ok' s t ta'  actions_subset ta' ta)"

  and red_wait_set_not_final:
  " s  wf_state; thr s t = (x, no_wait_locks); 
    t  (x, shr s) -ta (x', m'); ¬ waiting (wset s t); Suspend w  set taw  
   ¬ final x'"

  and wf_progress:
  " s  wf_state; thr s t = (x, no_wait_locks); ¬ final x 
   ta x' m'. t  x, shr s -ta x', m'"

  and ta_Wakeup_no_join_no_lock_no_interrupt: 
  " s  wf_state; thr s t = (x, no_wait_locks); t  xm -ta xm'; Notified  set taw  WokenUp  set taw  
   collect_waits ta = {}"

  and ta_satisfiable:
  " s  wf_state; thr s t = (x, no_wait_locks); t  x, shr s -ta x', m' 
   s'. actions_ok s' t ta"
begin

lemma wf_redE:
  assumes "s  wf_state" "thr s t = (x, no_wait_locks)"
  and "t  x, shr s -ta x'', m''" "¬ waiting (wset s t)"
  obtains ta' x' m'
  where "t  x, shr s -ta' x', m'" "actions_ok' s t ta'" "actions_subset ta' ta"
  | ta' x' m' where "t  x, shr s -ta' x', m'" "actions_ok s t ta'"
using wf_red[OF assms] by blast

lemma wf_progressE:
  assumes "s  wf_state"
  and "thr s t = (x, no_wait_locks)" "¬ final x"
  obtains ta x' m' where "t  x, shr s -ta x', m'"
using assms
by(blast dest: wf_progress)

lemma wf_progress_satisfiable:
  " s  wf_state; thr s t = (x, no_wait_locks); ¬ final x  
   ta x' m' s'. t  x, shr s -ta x', m'  actions_ok s' t ta"
apply(frule (2) wf_progress)
apply(blast dest: ta_satisfiable)
done

theorem redT_progress:
  assumes wfs: "s  wf_state" 
  and ndead: "¬ deadlock s"
  shows "t' ta' s'. s -t'ta' s'"
proof -
  from wfs have lok: "lock_thread_ok (locks s) (thr s)"
    and wfin: "wset_final_ok (wset s) (thr s)"
    by(auto dest: wf_stateD)
  from ndead
  have "t x ln l. thr s t = (x, ln)  
          (wset s t = None  ln = no_wait_locks  ¬ final x  (LT. t  x, shr s LT   (lt  LT. ¬ must_wait s t lt (dom (thr s)))) 
           ¬ waiting (wset s t)  ln $ l > 0  (l. ln $ l > 0  may_lock (locks s $ l) t) 
          (w. ln = no_wait_locks  wset s t = PostWS w))"
    by(rule contrapos_np)(blast intro!: all_waiting_implies_deadlock[OF lok] intro: must_syncI[OF wf_progress_satisfiable[OF wfs]])
  then obtain t x ln l
    where tst: "thr s t = (x, ln)"
    and a: "wset s t = None  ln = no_wait_locks  ¬ final x  
              (LT. t  x, shr s LT   (lt  LT. ¬ must_wait s t lt (dom (thr s)))) 
            ¬ waiting (wset s t)  ln $ l > 0  (l. ln $ l > 0  may_lock (locks s $ l) t) 
            (w. ln = no_wait_locks  wset s t = PostWS w)"
    by blast
  from a have cases[case_names normal acquire wakeup]:
    "thesis. 
         LT.  wset s t = None; ln = no_wait_locks; ¬ final x; t  x, shr s LT ; 
                 lt. lt  LT  ¬ must_wait s t lt (dom (thr s))   thesis;
           ¬ waiting (wset s t); ln $ l > 0; l. ln $ l > 0  may_lock (locks s $ l) t   thesis;
          w.  ln = no_wait_locks; wset s t = PostWS w   thesis   thesis"
    by auto
  show ?thesis
  proof(cases rule: cases)
    case (normal LT)
    note [simp] = ln = no_wait_locks 
      and nfine' = ¬ final x
      and cl' = t  x, shr s LT  
      and mw = lt. ltLT  ¬ must_wait s t lt (dom (thr s))
    from tst nfine' obtain x'' m'' ta'
      where red: "t  x, shr s -ta' x'', m''"
      by(auto intro: wf_progressE[OF wfs])
    from cl'
    have "ta''' x''' m'''. t  x, shr s -ta''' x''', m'''  
            LT = collect_waits ta'''"
      by (fastforce elim!: can_syncE)
    then obtain ta''' x''' m'''
      where red'': "t  x, shr s -ta''' x''', m'''"
      and L: "LT = collect_waits ta'''"
      by blast
    from wset s t = None have "¬ waiting (wset s t)" by(simp add: not_waiting_iff)
    with tst obtain ta'' x'' m''
      where red': "t  x, shr s -ta'' x'', m''"
      and aok': "actions_ok s t ta''  actions_ok' s t ta''  actions_subset ta'' ta'''"
      by -(rule wf_redE[OF wfs _ red''], auto)
    from aok' have "actions_ok s t ta''"
    proof
      assume "actions_ok' s t ta''  actions_subset ta'' ta'''"
      hence aok': "actions_ok' s t ta''" and aos: "actions_subset ta'' ta'''" by simp_all

      { fix l
        assume "Inl l  LT"
        { fix t'
          assume "t  t'"
          have "¬ has_lock (locks s $ l) t'"
          proof
            assume "has_lock (locks s $ l) t'"
            moreover with lok have "thr s t'  None" by(auto dest: lock_thread_okD)
            ultimately have "must_wait s t (Inl l) (dom (thr s))" using t  t' by(auto)
            moreover from Inl l  LT have "¬ must_wait s t (Inl l) (dom (thr s))" by(rule mw)
            ultimately show False by contradiction
          qed }
        hence "may_lock (locks s $ l) t"
          by-(rule classical, auto simp add: not_may_lock_conv) }
      note mayl = this
      { fix t'
        assume t'LT: "Inr (Inl t')  LT"
        hence "¬ not_final_thread s t'  t'  t"
        proof(cases "t' = t")
          case False with t'LT mw L show ?thesis by(fastforce)
        next
          case True with tst mw[OF t'LT] nfine' L have False
            by(auto intro!: must_wait.intros simp add: not_final_thread_iff)
          thus ?thesis ..
        qed }
      note mayj = this
      { fix t'
        assume t': "Inr (Inr t')  LT"
        from t' have "¬ must_wait s t (Inr (Inr t')) (dom (thr s))" by(rule mw)
        hence "t'  interrupts s"
          by(rule contrapos_np)(fastforce intro: all_final_exceptI simp add: not_final_thread_iff) }
      note interrupt = this
      from aos L mayl
      have "l. l  collect_locks' ta''l  may_lock (locks s $ l) t" by auto
      with aok' have "lock_ok_las (locks s) t ta''l" by(auto intro: lock_ok_las'_into_lock_on_las)
      moreover
      from mayj aos L
      have "cond_action_oks s t ta''c"
        by(fastforce intro: may_join_cond_action_oks)
      moreover
      from ta_satisfiable[OF wfs tst[simplified] red']
      obtain is' where "interrupt_actions_ok is' ta''i" by auto
      with interrupt aos aok' L have "interrupt_actions_ok (interrupts s) ta''i"
        by(auto 5 2 intro: interrupt_actions_ok'_collect_interrupts_imp_interrupt_actions_ok)
      ultimately show "actions_ok s t ta''" using aok' by auto
    qed
    moreover obtain ws'' where "redT_updWs t (wset s) ta''w ws''"
      using redT_updWs_total[of t "wset s" "ta''w"] ..
    then obtain s' where "redT_upd s t ta'' x'' m'' s'" by fastforce
    ultimately have "s -tta'' s'"
      using red' tst wset s t = None by(auto intro: redT_normal)
    thus ?thesis by blast
  next
    case acquire
    hence "may_acquire_all (locks s) t ln" by(auto)
    with tst ¬ waiting (wset s t) 0 < ln $ l
    show ?thesis by(fastforce intro: redT_acquire)
  next
    case (wakeup w)
    from wset s t = PostWS w
    have "¬ waiting (wset s t)" by(simp add: not_waiting_iff)
    from tst wakeup have tst: "thr s t = (x, no_wait_locks)" by simp
    from wakeup tst wfin have "¬ final x" by(auto dest: wset_final_okD)
    from wf_progress[OF wfs tst this]
    obtain ta x' m' where red: "t  x, shr s -ta x', m'" by auto
    from wf_red[OF wfs tst red ¬ waiting (wset s t)]
    obtain ta' x'' m'' 
      where red': "t  x, shr s -ta' x'', m''"
      and aok': "actions_ok s t ta'  actions_ok' s t ta'  actions_subset ta' ta" by blast
    from aok' have "actions_ok s t ta'"
    proof
      assume "actions_ok' s t ta'  actions_subset ta' ta"
      hence aok': "actions_ok' s t ta'"
        and subset: "actions_subset ta' ta" by simp_all
      from wakeup aok' have "Notified  set ta'w  WokenUp  set ta'w"
        by(auto simp add: wset_actions_ok_def split: if_split_asm)
      from ta_Wakeup_no_join_no_lock_no_interrupt[OF wfs tst red' this]
      have no_join: "collect_cond_actions ta'c = {}" 
        and no_lock: "collect_locks ta'l = {}" 
        and no_interrupt: "collect_interrupts ta'i = {}" by auto
      from no_lock have no_lock': "collect_locks' ta'l = {}"
        using collect_locks'_subset_collect_locks[of "ta'l"] by auto
      from aok' have "lock_ok_las' (locks s) t ta'l" by auto
      hence "lock_ok_las (locks s) t ta'l"
        by(rule lock_ok_las'_into_lock_on_las)(simp add: no_lock')
      moreover from subset aok' no_join have "cond_action_oks s t ta'c"
        by(auto intro: may_join_cond_action_oks)
      moreover from ta_satisfiable[OF wfs tst[simplified] red']
      obtain is' where "interrupt_actions_ok is' ta'i" by auto
      with aok' no_interrupt have "interrupt_actions_ok (interrupts s) ta'i"
        by(auto intro: interrupt_actions_ok'_collect_interrupts_imp_interrupt_actions_ok)
      ultimately show "actions_ok s t ta'" using aok' by auto
    qed
    moreover obtain ws'' where "redT_updWs t (wset s) ta'w ws''"
      using redT_updWs_total[of t "wset s" "ta'w"] ..
    then obtain s' where "redT_upd s t ta' x'' m'' s'" by fastforce
    ultimately have "s -tta' s'" using tst red' wakeup
      by(auto intro: redT_normal)
    thus ?thesis by blast
  qed
qed

end

end