(*
 * Copyright 2022, Proofcraft Pty Ltd
 * Copyright 2014, General Dynamics C4 Systems
 *
 * SPDX-License-Identifier: GPL-2.0-only
 *)

(* Contains proofs that fastpath + callKernel is semantically identical to
   callKernel. *)

theory Fastpath_Equiv
imports Fastpath_Defs IsolatedThreadAction Refine.RAB_FN
begin

lemma setCTE_obj_at'_queued:
  "\<lbrace>obj_at' (\<lambda>tcb. P (tcbQueued tcb)) t\<rbrace> setCTE p v \<lbrace>\<lambda>rv. obj_at' (\<lambda>tcb. P (tcbQueued tcb)) t\<rbrace>"
  unfolding setCTE_def
  by (rule setObject_cte_obj_at_tcb', simp+)

crunch obj_at'_queued: cteInsert "obj_at' (\<lambda>tcb. P (tcbQueued tcb)) t"
  (wp: setCTE_obj_at'_queued crunch_wps)

crunch obj_at'_not_queued: emptySlot "obj_at' (\<lambda>a. \<not> tcbQueued a) p"
  (wp: setCTE_obj_at'_queued)

lemma getEndpoint_obj_at':
  "\<lbrace>obj_at' P ptr\<rbrace> getEndpoint ptr \<lbrace>\<lambda>rv s. P rv\<rbrace>"
  apply (wp getEndpoint_wp)
  apply (clarsimp simp: obj_at'_def projectKOs)
  done

lemmas setEndpoint_obj_at_tcb' = setEndpoint_obj_at'_tcb

lemma tcbSchedEnqueue_tcbContext[wp]:
  "\<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>
     tcbSchedEnqueue t'
   \<lbrace>\<lambda>rv. obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
  apply (rule tcbSchedEnqueue_obj_at_unchangedT[OF all_tcbI])
  apply simp
  done

lemma setCTE_tcbContext:
  "\<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>
   setCTE slot cte
   \<lbrace>\<lambda>rv. obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
  apply (simp add: setCTE_def)
  apply (rule setObject_cte_obj_at_tcb', simp_all)
  done

context begin interpretation Arch . (*FIXME: arch_split*)

lemma seThreadState_tcbContext:
 "\<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>
    setThreadState a b
  \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
  apply (rule setThreadState_obj_at_unchanged)
  apply (clarsimp simp: atcbContext_def)+
  done

lemma setBoundNotification_tcbContext:
 "\<lbrace>obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>
    setBoundNotification a b
  \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t\<rbrace>"
  apply (rule setBoundNotification_obj_at_unchanged)
  apply (clarsimp simp: atcbContext_def)+
  done

declare comp_apply [simp del]
crunch tcbContext[wp]: deleteCallerCap "obj_at' (\<lambda>tcb. P ((atcbContextGet o tcbArch) tcb)) t"
  (wp: setEndpoint_obj_at_tcb' setBoundNotification_tcbContext
       setNotification_tcb crunch_wps seThreadState_tcbContext
   simp: crunch_simps unless_def)
declare comp_apply [simp]


crunch ksArch[wp]: asUser "\<lambda>s. P (ksArchState s)"
  (wp: crunch_wps)

definition
   tcbs_of :: "kernel_state => word32 => tcb option"
where
  "tcbs_of s = (%x. if tcb_at' x s then projectKO_opt (the (ksPSpace s x)) else None)"

lemma obj_at_tcbs_of:
  "obj_at' P t s = (EX tcb. tcbs_of s t = Some tcb & P tcb)"
  apply (simp add: tcbs_of_def split: if_split)
  apply (intro conjI impI)
   apply (clarsimp simp: obj_at'_def projectKOs)
  apply (clarsimp simp: obj_at'_weakenE[OF _ TrueI])
  done

lemma st_tcb_at_tcbs_of:
  "st_tcb_at' P t s = (EX tcb. tcbs_of s t = Some tcb & P (tcbState tcb))"
  by (simp add: st_tcb_at'_def obj_at_tcbs_of)

lemma tcbs_of_ko_at':
  "\<lbrakk> tcbs_of s p = Some tcb \<rbrakk> \<Longrightarrow> ko_at' tcb p s"
  by (simp add: obj_at_tcbs_of)

lemma tcbs_of_valid_tcb':
  "\<lbrakk> valid_objs' s; tcbs_of s p = Some tcb \<rbrakk> \<Longrightarrow> valid_tcb' tcb s"
  by (frule tcbs_of_ko_at')
     (drule (1) ko_at_valid_objs', auto simp: projectKOs valid_obj'_def)

lemma acc_CNodeCap_repr:
  "isCNodeCap cap
     \<Longrightarrow> cap = CNodeCap (capCNodePtr cap) (capCNodeBits cap)
                        (capCNodeGuard cap) (capCNodeGuardSize cap)"
  by (clarsimp simp: isCap_simps)

lemma valid_cnode_cap_cte_at':
  "\<lbrakk> s \<turnstile>' c; isCNodeCap c; ptr = capCNodePtr c; v < 2 ^ capCNodeBits c \<rbrakk>
      \<Longrightarrow> cte_at' (ptr + v * 2^cteSizeBits) s"
  apply (drule less_mask_eq)
  apply (drule(1) valid_cap_cte_at'[where addr=v])
  apply (simp add: mult.commute mult.left_commute)
  done

lemmas valid_cnode_cap_cte_at''
  = valid_cnode_cap_cte_at'[simplified objBits_defs, simplified]

declare of_int_sint_scast[simp]

lemma of_bl_from_bool:
  "of_bl [x] = from_bool x"
  by (cases x, simp_all add: from_bool_def)

lemma dmo_clearExMonitor_setCurThread_swap:
  "(do _ \<leftarrow> doMachineOp ARM.clearExMonitor;
               setCurThread thread
            od)
    = (do _ \<leftarrow> setCurThread thread;
            doMachineOp ARM.clearExMonitor od)"
  apply (simp add: setCurThread_def doMachineOp_def split_def)
  apply (rule oblivious_modify_swap[symmetric])
  apply (intro oblivious_bind, simp_all)
  done

lemma pd_at_asid_inj':
  "pd_at_asid' pd asid s \<Longrightarrow> pd_at_asid' pd' asid s \<Longrightarrow> pd' = pd"
  by (clarsimp simp: pd_at_asid'_def obj_at'_def)

lemma bind_case_sum_rethrow:
  "rethrowFailure fl f >>= case_sum e g
     = f >>= case_sum (e \<circ> fl) g"
  apply (simp add: rethrowFailure_def handleE'_def
                   bind_assoc)
  apply (rule bind_cong[OF refl])
  apply (simp add: throwError_bind split: sum.split)
  done

declare empty_fail_assertE[iff]

declare empty_fail_resolveAddressBits[iff]

lemma lookupExtraCaps_null:
  "msgExtraCaps info = 0 \<Longrightarrow>
     lookupExtraCaps thread buffer info = returnOk []"
  by (clarsimp simp: lookupExtraCaps_def
                     getExtraCPtrs_def liftE_bindE
                     upto_enum_step_def mapM_Nil
              split: Types_H.message_info.split option.split)

lemma isRecvEP_endpoint_case:
  "isRecvEP ep \<Longrightarrow> case_endpoint f g h ep = f (epQueue ep)"
  by (clarsimp simp: isRecvEP_def split: endpoint.split_asm)

lemma unifyFailure_catch_If:
  "catch (unifyFailure f >>=E g) h
     = f >>= (\<lambda>rv. if isRight rv then catch (g (theRight rv)) h else h ())"
  apply (simp add: unifyFailure_def rethrowFailure_def
                   handleE'_def catch_def bind_assoc
                   bind_bindE_assoc cong: if_cong)
  apply (rule bind_cong[OF refl])
  apply (simp add: throwError_bind isRight_def return_returnOk
            split: sum.split)
  done

lemma st_tcb_at_not_in_ep_queue:
  "\<lbrakk> st_tcb_at' P t s; ko_at' ep epptr s; sym_refs (state_refs_of' s);
     ep \<noteq> IdleEP; \<And>ts. P ts \<Longrightarrow> tcb_st_refs_of' ts = {} \<rbrakk>
      \<Longrightarrow> t \<notin> set (epQueue ep)"
  apply clarsimp
  apply (drule(1) sym_refs_ko_atD')
  apply (cases ep, simp_all add: st_tcb_at_refs_of_rev')
   apply (fastforce simp: st_tcb_at'_def obj_at'_def projectKOs)+
  done

lemma st_tcb_at_not_in_ntfn_queue:
  "\<lbrakk> st_tcb_at' P t s; ko_at' ntfn ntfnptr s; sym_refs (state_refs_of' s); ntfnObj ntfn = WaitingNtfn xs;
     \<And>ts. P ts \<Longrightarrow> (ntfnptr, TCBSignal) \<notin> tcb_st_refs_of' ts \<rbrakk>
      \<Longrightarrow> t \<notin> set xs"
  apply (drule(1) sym_refs_ko_atD')
  apply (clarsimp simp: st_tcb_at_refs_of_rev')
  apply (drule_tac x="(t, NTFNSignal)" in bspec, simp)
  apply (fastforce simp: st_tcb_at'_def obj_at'_def projectKOs ko_wp_at'_def tcb_bound_refs'_def)
  done

lemma sym_refs_upd_sD:
  "\<lbrakk> sym_refs ((state_refs_of' s) (p := S)); valid_pspace' s;
            ko_at' ko p s; refs_of' (injectKO koEx) = S;
            objBits koEx = objBits ko \<rbrakk>
      \<Longrightarrow> \<exists>s'. sym_refs (state_refs_of' s')
               \<and> (\<forall>p' (ko' :: endpoint). ko_at' ko' p' s \<and> injectKO ko' \<noteq> injectKO ko
                          \<longrightarrow> ko_at' ko' p' s')
               \<and> (\<forall>p' (ko' :: Structures_H.notification). ko_at' ko' p' s \<and> injectKO ko' \<noteq> injectKO ko
                          \<longrightarrow> ko_at' ko' p' s')
               \<and> (ko_at' koEx p s')"
  apply (rule exI, rule conjI)
   apply (rule state_refs_of'_upd[where ko'="injectKO koEx" and ptr=p and s=s,
                                  THEN ssubst[where P=sym_refs], rotated 2])
     apply simp+
   apply (clarsimp simp: obj_at'_def ko_wp_at'_def projectKOs)
   apply (clarsimp simp: project_inject objBits_def)
  apply (clarsimp simp: obj_at'_def ps_clear_upd projectKOs
                 split: if_split)
  apply (clarsimp simp: project_inject objBits_def)
  apply auto
  done

lemma sym_refs_upd_tcb_sD:
  "\<lbrakk> sym_refs ((state_refs_of' s) (p := {r \<in> state_refs_of' s p. snd r = TCBBound})); valid_pspace' s;
            ko_at' (tcb :: tcb) p s \<rbrakk>
      \<Longrightarrow> \<exists>s'. sym_refs (state_refs_of' s')
               \<and> (\<forall>p' (ko' :: endpoint).
                          ko_at' ko' p' s \<longrightarrow> ko_at' ko' p' s')
               \<and> (\<forall>p' (ko' :: Structures_H.notification).
                          ko_at' ko' p' s \<longrightarrow> ko_at' ko' p' s')
               \<and> (st_tcb_at' ((=) Running) p s')"
  apply (drule(2) sym_refs_upd_sD[where koEx="makeObject\<lparr>tcbState := Running, tcbBoundNotification := tcbBoundNotification tcb\<rparr>"])
    apply (clarsimp dest!: ko_at_state_refs_ofD')
   apply (simp add: objBits_simps)
  apply (erule exEI)
  apply clarsimp
  apply (auto simp: st_tcb_at'_def elim!: obj_at'_weakenE)
  done

lemma updateCap_cte_wp_at_cteMDBNode:
  "\<lbrace>cte_wp_at' (\<lambda>cte. P (cteMDBNode cte)) p\<rbrace>
     updateCap ptr cap
   \<lbrace>\<lambda>rv. cte_wp_at' (\<lambda>cte. P (cteMDBNode cte)) p\<rbrace>"
  apply (wp updateCap_cte_wp_at_cases)
  apply (simp add: o_def)
  done

lemma ctes_of_Some_cte_wp_at:
  "ctes_of s p = Some cte \<Longrightarrow> cte_wp_at' P p s = P cte"
  by (clarsimp simp: cte_wp_at_ctes_of)

lemma user_getreg_wp:
  "\<lbrace>\<lambda>s. tcb_at' t s \<and> (\<forall>rv. obj_at' (\<lambda>tcb. (atcbContextGet o tcbArch) tcb r = rv) t s \<longrightarrow> Q rv s)\<rbrace>
      asUser t (getRegister r) \<lbrace>Q\<rbrace>"
  apply (rule_tac Q="\<lambda>rv s. \<exists>rv'. rv' = rv \<and> Q rv' s" in hoare_post_imp)
   apply simp
  apply (rule hoare_pre, wp hoare_vcg_ex_lift user_getreg_rv)
  apply (clarsimp simp: obj_at'_def)
  done

lemma setUntypedCapAsFull_replyCap[simp]:
  "setUntypedCapAsFull cap (ReplyCap curThread False cg) slot =  return ()"
   by (clarsimp simp:setUntypedCapAsFull_def isCap_simps)

lemma option_case_liftM_getNotification_wp:
  "\<lbrace>\<lambda>s. \<forall>rv. (case x of None \<Rightarrow> rv = v | Some p \<Rightarrow> obj_at' (\<lambda>ntfn. f ntfn = rv) p s)
    \<longrightarrow> Q rv s\<rbrace> case x of None \<Rightarrow> return v | Some ptr \<Rightarrow> liftM f $ getNotification ptr \<lbrace> Q \<rbrace>"
  apply (rule hoare_pre, (wpc; wp getNotification_wp))
  apply (auto simp: obj_at'_def)
  done

lemma threadSet_st_tcb_at_state:
  "\<lbrace>\<lambda>s. tcb_at' t s \<longrightarrow> (if p = t
        then obj_at' (\<lambda>tcb. P (tcbState (f tcb))) t s
        else st_tcb_at' P p s)\<rbrace>
  threadSet f t \<lbrace>\<lambda>_. st_tcb_at' P p\<rbrace>"
  apply (rule hoare_chain)
    apply (rule threadSet_obj_at'_really_strongest)
   prefer 2
   apply (simp add: st_tcb_at'_def)
  apply (clarsimp split: if_splits simp: st_tcb_at'_def o_def)
  done

lemma recv_ep_queued_st_tcb_at':
  "\<lbrakk> ko_at' (Structures_H.endpoint.RecvEP ts) epptr s ;
     t \<in> set ts;
     sym_refs (state_refs_of' s) \<rbrakk>
   \<Longrightarrow> st_tcb_at' isBlockedOnReceive t s"
  apply (drule obj_at_ko_at')
  apply clarsimp
  apply (drule (1) sym_refs_ko_atD')
  apply (clarsimp simp: pred_tcb_at'_def obj_at'_real_def refs_of_rev')
  apply (erule_tac x=t in ballE; clarsimp?)
  apply (erule ko_wp_at'_weakenE)
  apply (clarsimp simp: isBlockedOnReceive_def projectKOs)
  done

lemma valid_ep_typ_at_lift':
  "\<lbrakk> \<And>p. \<lbrace>typ_at' TCBT p\<rbrace> f \<lbrace>\<lambda>rv. typ_at' TCBT p\<rbrace> \<rbrakk>
      \<Longrightarrow> \<lbrace>\<lambda>s. valid_ep' ep s\<rbrace> f \<lbrace>\<lambda>rv s. valid_ep' ep s\<rbrace>"
  apply (cases ep, simp_all add: valid_ep'_def)
   apply (wp hoare_vcg_const_Ball_lift typ_at_lifts | assumption)+
  done

lemma threadSet_tcbState_valid_objs:
  "\<lbrace>valid_tcb_state' st and valid_objs'\<rbrace>
     threadSet (tcbState_update (\<lambda>_. st)) t
   \<lbrace>\<lambda>rv. valid_objs'\<rbrace>"
  apply (wp threadSet_valid_objs')
  apply (clarsimp simp: valid_tcb'_def tcb_cte_cases_def)
  done

lemma possibleSwitchTo_rewrite:
  "monadic_rewrite True True
          (\<lambda>s. obj_at' (\<lambda>tcb. tcbPriority tcb = destPrio \<and> tcbDomain tcb = destDom) t s
              \<and> ksSchedulerAction s = ResumeCurrentThread
              \<and> ksCurThread s = thread
              \<and> ksCurDomain s = curDom
              \<and> destDom = curDom)
    (possibleSwitchTo t) (setSchedulerAction (SwitchToThread t))"
  supply if_split[split del]
  apply (simp add: possibleSwitchTo_def)
  (* under current preconditions both branch conditions are false *)
  apply (monadic_rewrite_l monadic_rewrite_if_l_False \<open>wpsimp wp: threadGet_wp cd_wp\<close>)
   apply (monadic_rewrite_l monadic_rewrite_if_l_False \<open>wpsimp wp: threadGet_wp cd_wp\<close>)
   (* discard unused getters before setSchedulerAction *)
   apply (simp add: getCurThread_def curDomain_def gets_bind_ign getSchedulerAction_def)
   apply (monadic_rewrite_symb_exec_l_drop, rule monadic_rewrite_refl)
  apply (auto simp: obj_at'_def)
  done

lemma scheduleSwitchThreadFastfail_False_wp:
  "\<lbrace>\<lambda>s. ct \<noteq> it \<and> cprio \<le> tprio \<rbrace>
   scheduleSwitchThreadFastfail ct it cprio tprio
   \<lbrace>\<lambda>rv s. \<not> rv \<rbrace>"
  unfolding scheduleSwitchThreadFastfail_def
  by (wp threadGet_wp)
     (auto dest!: obj_at_ko_at' simp: le_def obj_at'_def)

lemma lookupBitmapPriority_lift:
  assumes prqL1: "\<And>P. \<lbrace>\<lambda>s. P (ksReadyQueuesL1Bitmap s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksReadyQueuesL1Bitmap s)\<rbrace>"
  and     prqL2: "\<And>P. \<lbrace>\<lambda>s. P (ksReadyQueuesL2Bitmap s)\<rbrace> f \<lbrace>\<lambda>_ s. P (ksReadyQueuesL2Bitmap s)\<rbrace>"
  shows   "\<lbrace>\<lambda>s. P (lookupBitmapPriority d s) \<rbrace> f \<lbrace>\<lambda>_ s. P (lookupBitmapPriority d s) \<rbrace>"
  unfolding lookupBitmapPriority_def
  apply (rule hoare_pre)
   apply (wps prqL1 prqL2)
   apply wpsimp+
  done

(* slow path additionally requires current thread not idle *)
definition
  "fastpathBestSwitchCandidate t \<equiv> \<lambda>s.
     ksReadyQueuesL1Bitmap s (ksCurDomain s) = 0
   \<or> (\<forall>tprio. obj_at' (\<lambda>tcb. tcbPriority tcb = tprio) t s
              \<longrightarrow> (obj_at' (\<lambda>tcb. tcbPriority tcb \<le> tprio) (ksCurThread s) s
                  \<or> lookupBitmapPriority (ksCurDomain s) s \<le> tprio))"

lemma fastpathBestSwitchCandidateI:
  "\<lbrakk> ksReadyQueuesL1Bitmap s (ksCurDomain s) = 0
     \<or> tcbPriority ctcb \<le> tcbPriority ttcb
     \<or> lookupBitmapPriority (ksCurDomain s) s \<le> tcbPriority ttcb;
     ko_at' ttcb t s; ko_at' ctcb (ksCurThread s) s\<rbrakk>
   \<Longrightarrow> fastpathBestSwitchCandidate t s"
   unfolding fastpathBestSwitchCandidate_def
   by normalise_obj_at'

lemma fastpathBestSwitchCandidate_lift:
  assumes ct[wp]: "\<And>P. \<lbrace>\<lambda>s. P (ksCurThread s) \<rbrace> f \<lbrace> \<lambda>_ s. P (ksCurThread s) \<rbrace>"
  assumes cd[wp]: "\<And>P. \<lbrace>\<lambda>s. P (ksCurDomain s) \<rbrace> f \<lbrace> \<lambda>_ s. P (ksCurDomain s) \<rbrace>"
  assumes l1[wp]: "\<And>P. \<lbrace>\<lambda>s. P (ksReadyQueuesL1Bitmap s) \<rbrace> f \<lbrace> \<lambda>_ s. P (ksReadyQueuesL1Bitmap s) \<rbrace>"
  assumes l2[wp]: "\<And>P. \<lbrace>\<lambda>s. P (ksReadyQueuesL2Bitmap s) \<rbrace> f \<lbrace> \<lambda>_ s. P (ksReadyQueuesL2Bitmap s) \<rbrace>"
  assumes p[wp]: "\<And>P t. \<lbrace> obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t \<rbrace> f \<lbrace> \<lambda>_.  obj_at' (\<lambda>tcb. P (tcbPriority tcb)) t \<rbrace>"
  shows "\<lbrace> tcb_at' t and fastpathBestSwitchCandidate t \<rbrace> f \<lbrace>\<lambda>rv. fastpathBestSwitchCandidate t \<rbrace>"
  unfolding fastpathBestSwitchCandidate_def lookupBitmapPriority_def l1IndexToPrio_def
  apply (rule hoare_pre)
   apply (rule hoare_lift_Pf2[where f=ksCurDomain])
    apply (wp hoare_vcg_disj_lift hoare_vcg_all_lift)
    apply (rule hoare_lift_Pf2[where f=ksCurThread])
     apply (rule hoare_lift_Pf2[where f=ksReadyQueuesL1Bitmap])
      apply (rule hoare_lift_Pf2[where f=ksReadyQueuesL2Bitmap])
       apply (wp hoare_vcg_imp_lift')
        apply (strengthen not_obj_at'_strengthen)
        apply (wpsimp simp: comp_def wp: l1 l2 hoare_vcg_disj_lift)+
  apply (drule (1) tcb_at_not_obj_at_elim'[rotated])
  apply (rename_tac tprio, erule_tac x=tprio in allE)
  apply clarsimp
  apply (drule (1) tcb_at_not_obj_at_elim'[rotated])
  apply (clarsimp simp: obj_at'_def)
  done

lemma fastpathBestSwitchCandidate_ksSchedulerAction_simp[simp]:
  "fastpathBestSwitchCandidate t (s\<lparr>ksSchedulerAction := a\<rparr>)
     = fastpathBestSwitchCandidate t s"
  unfolding fastpathBestSwitchCandidate_def lookupBitmapPriority_def
  by simp

lemma sched_act_SwitchToThread_rewrite:
  "\<lbrakk> sa = SwitchToThread t \<Longrightarrow> monadic_rewrite F E Q (m_sw t) f \<rbrakk>
   \<Longrightarrow> monadic_rewrite F E ((\<lambda>_. sa = SwitchToThread t) and Q)
       (case_scheduler_action m_res m_ch (\<lambda>t. m_sw t) sa) f"
  apply (cases sa; simp add: monadic_rewrite_impossible)
  apply (rename_tac t')
  apply (case_tac "t' = t"; simp add: monadic_rewrite_impossible)
  done

lemma schedule_rewrite_ct_not_runnable':
  "monadic_rewrite True True
            (\<lambda>s. ksSchedulerAction s = SwitchToThread t \<and> ct_in_state' (Not \<circ> runnable') s
                 \<and> (ksCurThread s \<noteq> ksIdleThread s)
                 \<and> fastpathBestSwitchCandidate t s)
            (schedule)
            (do setSchedulerAction ResumeCurrentThread; switchToThread t od)"
  supply subst_all [simp del]
  apply (simp add: schedule_def)
  (* switching to t *)
  apply (monadic_rewrite_l sched_act_SwitchToThread_rewrite[where t=t])
   (* not wasRunnable, skip enqueue *)
   apply (simp add: when_def)
   apply (monadic_rewrite_l monadic_rewrite_if_l_False)
   (* fastpath: \<not> (fastfail \<and> \<not> highest) *)
   apply (monadic_rewrite_l monadic_rewrite_if_l_False
            \<open>wpsimp simp: isHighestPrio_def'
                    wp: hoare_vcg_imp_lift hoare_vcg_disj_lift threadGet_wp''
                        scheduleSwitchThreadFastfail_False_wp\<close>)
   (* fastpath: no scheduleChooseNewThread *)
   apply (monadic_rewrite_l monadic_rewrite_if_l_False
            \<open>wpsimp simp: isHighestPrio_def'
                    wp: hoare_vcg_imp_lift hoare_vcg_disj_lift threadGet_wp''
                        scheduleSwitchThreadFastfail_False_wp\<close>)
   (* remove no-ops *)
   apply (repeat 10 monadic_rewrite_symb_exec_l) (* until switchToThread *)
              apply (simp add: setSchedulerAction_def)
              apply (subst oblivious_modify_swap[symmetric],
                     rule oblivious_switchToThread_schact)
              apply (rule monadic_rewrite_refl)
             apply (wpsimp wp: empty_fail_isRunnable simp: isHighestPrio_def')+
  apply (clarsimp simp: ct_in_state'_def not_pred_tcb_at'_strengthen
                        fastpathBestSwitchCandidate_def)
  apply normalise_obj_at'
  done

lemma resolveAddressBits_points_somewhere:
  "\<lbrace>\<lambda>s. \<forall>slot. Q slot s\<rbrace> resolveAddressBits cp cptr bits \<lbrace>Q\<rbrace>,-"
  apply (rule_tac Q'="\<lambda>rv s. \<forall>rv. Q rv s" in hoare_post_imp_R)
   apply wp
  apply clarsimp
  done

lemma foldr_copy_register_tsrs:
  "foldr (\<lambda>r . copy_register_tsrs x y r r (\<lambda>x. x)) rs s
       = (s (y := TCBStateRegs (tsrState (s y))
                       (\<lambda>r. if r \<in> set rs then tsrContext (s x) r
                                 else tsrContext (s y) r)))"
  apply (induct rs)
   apply simp
  apply (simp add: copy_register_tsrs_def fun_eq_iff
            split: if_split)
  done

lemmas cteInsert_obj_at'_not_queued =  cteInsert_obj_at'_queued[of "\<lambda>a. \<not> a"]

lemma monadic_rewrite_threadGet:
  "monadic_rewrite E F (obj_at' (\<lambda>tcb. f tcb = v) t)
    (threadGet f t) (return v)"
  unfolding getThreadState_def threadGet_def
  apply (simp add: liftM_def)
  apply monadic_rewrite_symb_exec_l
    apply (rule_tac P="\<lambda>_. f x = v" in monadic_rewrite_pre_imp_eq)
    apply blast
   apply (wpsimp wp: OMG_getObject_tcb simp: obj_tcb_at')+
  done

lemma monadic_rewrite_getThreadState:
  "monadic_rewrite E F (obj_at' (\<lambda>tcb. tcbState tcb = v) t)
    (getThreadState t) (return v)"
  unfolding getThreadState_def
  by (rule monadic_rewrite_threadGet)

lemma setCTE_obj_at'_tcbIPCBuffer:
  "\<lbrace>obj_at' (\<lambda>tcb. P (tcbIPCBuffer tcb)) t\<rbrace> setCTE p v \<lbrace>\<lambda>rv. obj_at' (\<lambda>tcb. P (tcbIPCBuffer tcb)) t\<rbrace>"
  unfolding setCTE_def
  by (rule setObject_cte_obj_at_tcb', simp+)

context
notes if_cong[cong]
begin
crunches cteInsert, asUser
  for obj_at'_tcbIPCBuffer[wp]: "obj_at' (\<lambda>tcb. P (tcbIPCBuffer tcb)) t"
  (wp: setCTE_obj_at'_queued crunch_wps threadSet_obj_at'_really_strongest)
end

crunches cteInsert, threadSet, asUser, emptySlot
  for ksReadyQueuesL1Bitmap_inv[wp]: "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
  and ksReadyQueuesL2Bitmap_inv[wp]: "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
  (wp: hoare_drop_imps)

crunch ksReadyQueuesL1Bitmap_inv[wp]: setEndpoint "\<lambda>s. P (ksReadyQueuesL1Bitmap s)"
  (wp: setObject_ksPSpace_only updateObject_default_inv)
crunch ksReadyQueuesL2Bitmap_inv[wp]: setEndpoint "\<lambda>s. P (ksReadyQueuesL2Bitmap s)"
  (wp: setObject_ksPSpace_only updateObject_default_inv)

lemma setThreadState_runnable_bitmap_inv:
  "runnable' ts \<Longrightarrow>
    \<lbrace> \<lambda>s. P (ksReadyQueuesL1Bitmap s) \<rbrace> setThreadState ts t \<lbrace>\<lambda>rv s. P (ksReadyQueuesL1Bitmap s) \<rbrace>"
  "runnable' ts \<Longrightarrow>
    \<lbrace> \<lambda>s. Q (ksReadyQueuesL2Bitmap s) \<rbrace> setThreadState ts t \<lbrace>\<lambda>rv s. Q (ksReadyQueuesL2Bitmap s) \<rbrace>"
   by (simp_all add: setThreadState_runnable_simp, wp+)

(* FIXME move *)
crunches curDomain
  for (no_fail) no_fail[intro!, wp, simp]

lemma fastpath_callKernel_SysCall_corres:
  "monadic_rewrite True False
         (invs' and ct_in_state' ((=) Running)
                and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)
                and (\<lambda>s. ksDomainTime s \<noteq> 0))
     (callKernel (SyscallEvent SysCall)) (fastpaths SysCall)"
  supply if_cong[cong] option.case_cong[cong] if_split[split del]
  supply empty_fail_getMRs[wp] (* FIXME *)
  supply empty_fail_getEndpoint[wp] (* FIXME *)
  apply (rule monadic_rewrite_introduce_alternative[OF callKernel_def[simplified atomize_eq]])
  apply (rule monadic_rewrite_guard_imp)
   apply (simp add: handleEvent_def handleCall_def
                    handleInvocation_def liftE_bindE_handle
                    bind_assoc getMessageInfo_def)
   apply (simp add: catch_liftE_bindE unlessE_throw_catch_If
                    unifyFailure_catch_If catch_liftE
                    getMessageInfo_def alternative_bind
                    fastpaths_def
              cong: if_cong)
   apply (rule monadic_rewrite_bind_alternative_l, wp)
   apply (rule monadic_rewrite_bind_tail)
    apply (rule monadic_rewrite_bind_alternative_l, wp)
    apply (rule monadic_rewrite_bind_tail)
     apply (rename_tac msgInfo)
     apply (rule monadic_rewrite_bind_alternative_l, wp)
     apply (rule monadic_rewrite_bind_tail)
      apply monadic_rewrite_symb_exec_r
       apply (rename_tac tcbFault)
       apply (rule monadic_rewrite_alternative_r[rotated])
        apply (rule monadic_rewrite_alternative_l)
       apply (rule monadic_rewrite_if_r[rotated])
        apply (rule monadic_rewrite_alternative_l)
       apply (simp add: split_def Syscall_H.syscall_def
                        liftE_bindE_handle bind_assoc
                        capFaultOnFailure_def)
       apply (simp only: bindE_bind_linearise[where f="rethrowFailure fn f'" for fn f']
                         bind_case_sum_rethrow)
       apply (simp add: lookupCapAndSlot_def
                        lookupSlotForThread_def bindE_assoc
                        liftE_bind_return_bindE_returnOk split_def
                        getThreadCSpaceRoot_def locateSlot_conv
                        returnOk_liftE[symmetric] const_def
                        getSlotCap_def)
       apply (simp only: liftE_bindE_assoc)
       apply (rule monadic_rewrite_bind_alternative_l, wp)
       apply (rule monadic_rewrite_bind_tail)
        apply (rule monadic_rewrite_bind_alternative_l)
         apply (wp | simp)+
        apply (rule_tac fn="case_sum Inl (Inr \<circ> fst)" in monadic_rewrite_split_fn)
          apply (simp add: liftME_liftM[symmetric] liftME_def bindE_assoc)
          apply (rule monadic_rewrite_refl)
         apply (rule monadic_rewrite_if_r[rotated])
          apply (rule monadic_rewrite_alternative_l)
         apply (simp add: isRight_right_map isRight_case_sum)
         apply (rule monadic_rewrite_if_r[rotated])
          apply (rule monadic_rewrite_alternative_l)
         apply (rule monadic_rewrite_bind_alternative_l[OF lookupIPC_inv])
         apply monadic_rewrite_symb_exec_l
          apply (simp add: lookupExtraCaps_null returnOk_bind liftE_bindE_handle
                           bind_assoc liftE_bindE_assoc
                           decodeInvocation_def Let_def from_bool_0
                           performInvocation_def liftE_handle
                           liftE_bind)
          apply monadic_rewrite_symb_exec_r
           apply (rename_tac "send_ep")
           apply (rule monadic_rewrite_if_r[rotated])
            apply (rule monadic_rewrite_alternative_l)
           apply (simp add: getThreadVSpaceRoot_def locateSlot_conv)
           apply monadic_rewrite_symb_exec_r
            apply (rename_tac "pdCapCTE")
            apply (rule monadic_rewrite_if_r[rotated])
             apply (rule monadic_rewrite_alternative_l)
            apply monadic_rewrite_symb_exec_r
             apply monadic_rewrite_symb_exec_r
              apply monadic_rewrite_symb_exec_r
               apply (simp add: isHighestPrio_def')
               apply monadic_rewrite_symb_exec_r
                apply (rule monadic_rewrite_if_r[rotated])
                 apply (rule monadic_rewrite_alternative_l)
                apply (rule monadic_rewrite_if_r[rotated])
                 apply (rule monadic_rewrite_alternative_l)
                apply monadic_rewrite_symb_exec_r
                 apply (rule monadic_rewrite_if_r[rotated])
                  apply (rule monadic_rewrite_alternative_l)
                 apply monadic_rewrite_symb_exec_r
                  apply (rule monadic_rewrite_if_r[rotated])
                   apply (rule monadic_rewrite_alternative_l)
                  apply (rule monadic_rewrite_trans,
                         rule monadic_rewrite_pick_alternative_1)
                  apply monadic_rewrite_symb_exec_l
                   (* now committed to fastpath *)
                   apply (rule monadic_rewrite_trans)
                    apply (rule_tac F=True and E=True in monadic_rewrite_weaken_flags)
                    apply simp
                    apply (rule monadic_rewrite_bind_tail)
                     apply (monadic_rewrite_symb_exec_l_known thread)
                      apply (simp add: sendIPC_def bind_assoc)
                      apply (monadic_rewrite_symb_exec_l_known send_ep)
                       apply (rule_tac P="epQueue send_ep \<noteq> []" in monadic_rewrite_gen_asm)
                       apply (simp add: isRecvEP_endpoint_case list_case_helper bind_assoc)
                       apply (rule monadic_rewrite_bind_tail)
                        apply (elim conjE)
                        apply (rule monadic_rewrite_bind_tail, rename_tac dest_st)
                         apply (rule_tac P="\<exists>gr. dest_st = BlockedOnReceive (capEPPtr (fst (theRight rv))) gr"
                                  in monadic_rewrite_gen_asm)
                         apply monadic_rewrite_symb_exec_l_drop
                         apply (rule monadic_rewrite_bind)
                           apply clarsimp
                           apply (rule_tac msgInfo=msgInfo in doIPCTransfer_simple_rewrite)
                          apply (rule monadic_rewrite_bind_tail)
                           apply (rule monadic_rewrite_bind)
                             apply (rule_tac destPrio=destPrio
                                      and curDom=curDom and destDom=destDom and thread=thread
                                      in possibleSwitchTo_rewrite)
                            apply (rule monadic_rewrite_bind)
                              apply (rule monadic_rewrite_trans)
                               apply (rule setupCallerCap_rewrite)
                              apply (rule monadic_rewrite_bind_head)
                              apply (rule setThreadState_rewrite_simple, simp)
                             apply (rule monadic_rewrite_trans)
                              apply (monadic_rewrite_symb_exec_l_known BlockedOnReply)
                               apply simp
                               apply (rule monadic_rewrite_refl)
                              apply wpsimp
                             apply (rule monadic_rewrite_trans)
                              apply (rule monadic_rewrite_bind_head)
                              apply (rule_tac t="hd (epQueue send_ep)"
                                       in schedule_rewrite_ct_not_runnable')
                             apply (simp add: bind_assoc)
                             apply (rule monadic_rewrite_bind_tail)
                              apply (rule monadic_rewrite_bind)
                                apply (rule switchToThread_rewrite)
                               apply (rule monadic_rewrite_bind)
                                 apply (rule activateThread_simple_rewrite)
                                apply (rule monadic_rewrite_refl)
                               apply wp
                              apply (wp setCurThread_ct_in_state)
                             apply (simp only: st_tcb_at'_def[symmetric])
                             apply (wp, clarsimp simp: cur_tcb'_def ct_in_state'_def)
                            apply (simp add: getThreadCallerSlot_def getThreadReplySlot_def
                                             locateSlot_conv ct_in_state'_def cur_tcb'_def)

                            apply ((wp assert_inv threadSet_pred_tcb_at_state
                                       cteInsert_obj_at'_not_queued
                                    | wps)+)[1]

                               apply (wp fastpathBestSwitchCandidate_lift[where f="cteInsert c w w'" for c w w'])
                               apply ((wp assert_inv threadSet_pred_tcb_at_state cteInsert_obj_at'_not_queued | wps)+)[1]
                              apply ((wp assert_inv threadSet_pred_tcb_at_state cteInsert_obj_at'_not_queued | wps)+)[1]
                             apply ((wp assert_inv threadSet_pred_tcb_at_state cteInsert_obj_at'_not_queued | wps)+)[1]
                            apply ((wp assert_inv threadSet_pred_tcb_at_state cteInsert_obj_at'_not_queued | wps)+)[1]
                            apply (wp fastpathBestSwitchCandidate_lift[where f="threadSet f t" for f t])
                             apply simp
                            apply ((wp assert_inv threadSet_pred_tcb_at_state
                                       cteInsert_obj_at'_not_queued
                                    | wps)+)[1]
                           apply (simp add: setSchedulerAction_def)
                           apply wp[1]
                          apply (simp cong: if_cong HOL.conj_cong add: if_bool_simps)
                          apply (simp_all only:)[5]
                          apply ((wp setThreadState_oa_queued[of _ "\<lambda>a _ _. \<not> a"]
                                     setThreadState_obj_at_unchanged
                                     asUser_obj_at_unchanged mapM_x_wp'
                                     sts_st_tcb_at'_cases
                                     setThreadState_no_sch_change
                                     setEndpoint_obj_at_tcb'
                                     fastpathBestSwitchCandidate_lift[where f="setThreadState f t" for f t]
                                     setThreadState_oa_queued
                                     fastpathBestSwitchCandidate_lift[where f="asUser t f" for f t]
                                     fastpathBestSwitchCandidate_lift[where f="setEndpoint a b" for a b]
                                     lookupBitmapPriority_lift
                                     setThreadState_runnable_bitmap_inv
                                     getEndpoint_obj_at'
                                   | simp add: setMessageInfo_def
                                   | wp (once) hoare_vcg_disj_lift)+)

                   apply (simp add: setThreadState_runnable_simp
                                    getThreadCallerSlot_def getThreadReplySlot_def
                                    locateSlot_conv bind_assoc)
                   apply (rule_tac P="\<lambda>v.  obj_at' (%tcb. tcbIPCBuffer tcb = v) (hd (epQueue send_ep))"
                           in monadic_rewrite_exists_v)
                   apply (rename_tac ipcBuffer)

                   apply (rule_tac P="\<lambda>v.  obj_at' (\<lambda>tcb. tcbState tcb = v) (hd (epQueue send_ep))"
                           in monadic_rewrite_exists_v)
                   apply (rename_tac destState)

                   apply (simp add: ARM_H.switchToThread_def bind_assoc)
                  (* retrieving state or thread registers is not thread_action_isolatable,
                     translate into return with suitable precondition  *)
                   apply (rule monadic_rewrite_trans[OF _ monadic_rewrite_transverse])
                     apply (rule_tac v=destState in monadic_rewrite_getThreadState
                            | rule monadic_rewrite_bind monadic_rewrite_refl)+
                                    apply (wp mapM_x_wp' getObject_inv | wpc | simp | wp (once) hoare_drop_imps)+
                    apply (rule_tac v=destState in monadic_rewrite_getThreadState
                           | rule monadic_rewrite_bind monadic_rewrite_refl)+
                               apply (wp mapM_x_wp' getObject_inv | wpc | simp | wp (once) hoare_drop_imps)+

                   apply (rule_tac P="inj (case_bool thread (hd (epQueue send_ep)))"
                            in monadic_rewrite_gen_asm)
                   apply (rule monadic_rewrite_trans[OF _ monadic_rewrite_transverse])
                     apply (rule monadic_rewrite_weaken_flags[where F=False and E=True], simp)
                     apply (rule isolate_thread_actions_rewrite_bind
                                 fastpath_isolate_rewrites fastpath_isolatables
                                 bool.simps setRegister_simple
                                 setVMRoot_isolatable[THEN thread_actions_isolatableD] setVMRoot_isolatable
                                 doMachineOp_isolatable[THEN thread_actions_isolatableD] doMachineOp_isolatable
                                 kernelExitAssertions_isolatable[THEN thread_actions_isolatableD]
                                 kernelExitAssertions_isolatable
                                 zipWithM_setRegister_simple
                                 thread_actions_isolatable_bind
                              | assumption
                              | wp assert_inv)+
                   apply (rule_tac P="\<lambda>s. ksSchedulerAction s = ResumeCurrentThread
                                       \<and> tcb_at' thread s"
                              and F=True and E=False in monadic_rewrite_weaken_flags)
                   apply simp
                   apply (rule monadic_rewrite_isolate_final)
                     apply (simp add: isRight_case_sum cong: list.case_cong)
                    apply (clarsimp simp: fun_eq_iff if_flip
                                   cong: if_cong)
                    apply (drule obj_at_ko_at', clarsimp)
                    apply (frule get_tcb_state_regs_ko_at')
                    apply (clarsimp simp: zip_map2 zip_same_conv_map foldl_map
                                         foldl_fun_upd
                                         foldr_copy_register_tsrs
                                         isRight_case_sum
                                   cong: if_cong)
                    apply (simp add: upto_enum_def fromEnum_def
                                    enum_register  toEnum_def
                                    msgRegisters_unfold
                               cong: if_cong)
                    apply (clarsimp split: if_split)
                    apply (rule ext)
                    apply (simp add: badgeRegister_def msgInfoRegister_def
                                    ARM.badgeRegister_def
                                    ARM.msgInfoRegister_def
                             split: if_split)
                   apply simp
                  apply (wp | simp cong: if_cong bool.case_cong
                            | rule getCTE_wp' gts_wp' threadGet_wp
                                  getEndpoint_wp)+
        apply (rule validE_cases_valid)
        apply (simp add: isRight_def getSlotCap_def)
        apply (wp getCTE_wp')
        apply (rule resolveAddressBits_points_somewhere)
       apply (simp cong: if_cong bool.case_cong)
       apply wp
      apply simp
      apply (wp user_getreg_wp threadGet_wp)+

  apply clarsimp
  apply (subgoal_tac "ksCurThread s \<noteq> ksIdleThread s")
   prefer 2
   apply (fastforce simp: ct_in_state'_def dest: ct_running_not_idle' elim: pred_tcb'_weakenE)

  apply (clarsimp simp: ct_in_state'_def pred_tcb_at')
  apply (frule cte_wp_at_valid_objs_valid_cap', clarsimp+)
  apply (clarsimp simp: isCap_simps valid_cap'_def maskCapRights_def)
  apply (frule ko_at_valid_ep', clarsimp)
  apply (frule sym_refs_ko_atD'[where 'a=endpoint], clarsimp)
  apply (clarsimp simp: valid_ep'_def isRecvEP_endpoint_case neq_Nil_conv
                        tcbVTableSlot_def cte_level_bits_def
                        cte_at_tcb_at_16' length_msgRegisters
                        size_msgRegisters_def order_less_imp_le
                        ep_q_refs_of'_def st_tcb_at_refs_of_rev'
                  cong: if_cong)
  apply (rename_tac blockedThread ys tcba tcbb)
  apply (frule invs_mdb')
  apply (thin_tac "Ball S P" for S P)+
  supply imp_disjL[simp del]
  apply (subst imp_disjL[symmetric])

  (* clean up broken up disj implication and excessive references to same tcbs *)
  apply normalise_obj_at'
  apply (clarsimp simp: invs'_def valid_state'_def)
  apply (fold imp_disjL, intro allI impI)

  apply (subgoal_tac "ksCurThread s \<noteq> blockedThread")
   prefer 2
   apply normalise_obj_at'
  apply clarsimp
  apply (frule_tac t="blockedThread" in valid_queues_not_runnable_not_queued, assumption)
  subgoal by (fastforce simp: st_tcb_at'_def elim: obj_at'_weakenE)
  apply (subgoal_tac "fastpathBestSwitchCandidate blockedThread s")
   prefer 2
   apply (rule_tac ttcb=tcbb and ctcb=tcb in fastpathBestSwitchCandidateI)
     apply (solves \<open>simp only: disj_ac\<close>)
    apply simp+
  apply (clarsimp simp: st_tcb_at'_def obj_at'_def objBits_simps projectKOs valid_mdb'_def
                        valid_mdb_ctes_def inj_case_bool
                 split: bool.split)+
  done

lemma capability_case_Null_ReplyCap:
  "(case cap of NullCap \<Rightarrow> f | ReplyCap t b cg \<Rightarrow> g t b cg | _ \<Rightarrow> h)
     = (if isReplyCap cap then g (capTCBPtr cap) (capReplyMaster cap) (capReplyCanGrant cap)
             else if isNullCap cap then f else h)"
  by (simp add: isCap_simps split: capability.split split del: if_split)

lemma injection_handler_catch:
  "catch (injection_handler f x) y
      = catch x (y o f)"
  apply (simp add: injection_handler_def catch_def handleE'_def
                   bind_assoc)
  apply (rule bind_cong[OF refl])
  apply (simp add: throwError_bind split: sum.split)
  done

lemma doReplyTransfer_simple:
  "monadic_rewrite True False
     (obj_at' (\<lambda>tcb. tcbFault tcb = None) receiver)
     (doReplyTransfer sender receiver slot grant)
     (do state \<leftarrow> getThreadState receiver;
         assert (isReply state);
         cte \<leftarrow> getCTE slot;
         mdbnode \<leftarrow> return $ cteMDBNode cte;
         assert (mdbPrev mdbnode \<noteq> 0 \<and> mdbNext mdbnode = 0);
         parentCTE \<leftarrow> getCTE (mdbPrev mdbnode);
         assert (isReplyCap (cteCap parentCTE) \<and> capReplyMaster (cteCap parentCTE));
         doIPCTransfer sender Nothing 0 grant receiver;
         cteDeleteOne slot;
         setThreadState Running receiver;
         possibleSwitchTo receiver
         od)"
  apply (simp add: doReplyTransfer_def liftM_def nullPointer_def getSlotCap_def)
  apply (rule monadic_rewrite_bind_tail)+
        apply (monadic_rewrite_symb_exec_l_known None, simp)
         apply (rule monadic_rewrite_refl)
        apply (wpsimp wp: threadGet_const gts_wp' getCTE_wp' simp: o_def)+
  done

lemma receiveIPC_simple_rewrite:
  "monadic_rewrite True False
     ((\<lambda>_. isEndpointCap ep_cap \<and> \<not> isSendEP ep) and (ko_at' ep (capEPPtr ep_cap) and
      (\<lambda>s. \<forall>ntfnptr. bound_tcb_at' ((=) (Some ntfnptr)) thread s \<longrightarrow> obj_at' (Not \<circ> isActive) ntfnptr s)))
     (receiveIPC thread ep_cap True)
     (do
       setThreadState (BlockedOnReceive (capEPPtr ep_cap) (capEPCanGrant ep_cap)) thread;
       setEndpoint (capEPPtr ep_cap) (RecvEP (case ep of RecvEP q \<Rightarrow> (q @ [thread]) | _ \<Rightarrow> [thread]))
      od)"
  supply empty_fail_getEndpoint[wp]
  apply (rule monadic_rewrite_gen_asm)
  apply (simp add: receiveIPC_def)
  apply (monadic_rewrite_symb_exec_l_known ep)
    apply monadic_rewrite_symb_exec_l+
       apply (monadic_rewrite_l monadic_rewrite_if_l_False)
       apply (rule monadic_rewrite_is_refl)
       apply (cases ep; simp add: isSendEP_def)
      apply (wpsimp wp: getNotification_wp gbn_wp' getEndpoint_wp
                    simp: getBoundNotification_def)+
  apply (clarsimp simp: obj_at'_def projectKOs pred_tcb_at'_def)
  done

lemma empty_fail_isFinalCapability:
  "empty_fail (isFinalCapability cte)"
  by (simp add: isFinalCapability_def Let_def empty_fail_cond split: if_split)

lemma cteDeleteOne_replycap_rewrite:
  "monadic_rewrite True False
     (cte_wp_at' (\<lambda>cte. isReplyCap (cteCap cte)) slot)
     (cteDeleteOne slot)
     (emptySlot slot NullCap)"
  supply isFinalCapability_inv[wp] empty_fail_isFinalCapability[wp] (* FIXME *)
  apply (simp add: cteDeleteOne_def)
  apply (rule monadic_rewrite_symb_exec_l)
     apply (rule_tac P="cteCap cte \<noteq> NullCap \<and> isReplyCap (cteCap cte)
                        \<and> \<not> isEndpointCap (cteCap cte)
                        \<and> \<not> isNotificationCap (cteCap cte)"
              in monadic_rewrite_gen_asm)
     apply (simp add: finaliseCapTrue_standin_def capRemovable_def)
     apply monadic_rewrite_symb_exec_l
      apply (rule monadic_rewrite_refl)
     apply (wpsimp wp: getCTE_wp')+
  apply (clarsimp simp: cte_wp_at_ctes_of isCap_simps)
  done

lemma cteDeleteOne_nullcap_rewrite:
  "monadic_rewrite True False
     (cte_wp_at' (\<lambda>cte. cteCap cte = NullCap) slot)
     (cteDeleteOne slot)
     (return ())"
  apply (simp add: cteDeleteOne_def unless_def when_def)
  apply (monadic_rewrite_l monadic_rewrite_if_l_False \<open>wpsimp wp: getCTE_wp'\<close>)
   apply (monadic_rewrite_symb_exec_l, rule monadic_rewrite_refl)
   apply (wpsimp wp: getCTE_wp' simp: cte_wp_at_ctes_of)+
  done

lemma deleteCallerCap_nullcap_rewrite:
  "monadic_rewrite True False
     (cte_wp_at' (\<lambda>cte. cteCap cte = NullCap) (thread + 2 ^ cte_level_bits * tcbCallerSlot))
     (deleteCallerCap thread)
     (return ())"
  apply (simp add: deleteCallerCap_def getThreadCallerSlot_def locateSlot_conv
                   getSlotCap_def)
  apply (monadic_rewrite_l cteDeleteOne_nullcap_rewrite \<open>wpsimp wp: getCTE_wp\<close>)
   apply (monadic_rewrite_symb_exec_l+, rule monadic_rewrite_refl)
    apply (wpsimp simp: cte_wp_at_ctes_of)+
  done

lemma emptySlot_cnode_caps:
  "\<lbrace>\<lambda>s. P (only_cnode_caps (ctes_of s)) \<and> cte_wp_at' (\<lambda>cte. \<not> isCNodeCap (cteCap cte)) slot s\<rbrace>
     emptySlot slot NullCap
   \<lbrace>\<lambda>rv s. P (only_cnode_caps (ctes_of s))\<rbrace>"
  apply (simp add: only_cnode_caps_def map_option_comp2
                   o_assoc[symmetric] cteCaps_of_def[symmetric])
  apply (wp emptySlot_cteCaps_of)
  apply (clarsimp simp: cteCaps_of_def cte_wp_at_ctes_of
                 elim!: rsubst[where P=P] del: ext intro!: ext
                 split: if_split)
  done

lemma asUser_obj_at_ep[wp]:
  "\<lbrace>obj_at' P p\<rbrace> asUser t m \<lbrace>\<lambda>rv. obj_at' (P :: endpoint \<Rightarrow> bool) p\<rbrace>"
  apply (simp add: asUser_def split_def)
  apply (wp hoare_drop_imps | simp)+
  done

lemma setCTE_obj_at_ep[wp]:
  "\<lbrace>obj_at' (P :: endpoint \<Rightarrow> bool) p\<rbrace> setCTE ptr cte \<lbrace>\<lambda>rv. obj_at' P p\<rbrace>"
  unfolding setCTE_def
  apply (rule obj_at_setObject2)
  apply (clarsimp simp: updateObject_cte typeError_def in_monad
                 split: Structures_H.kernel_object.split_asm
                        if_split_asm)
  done

lemma setCTE_obj_at_ntfn[wp]:
  "\<lbrace>obj_at' (P :: Structures_H.notification \<Rightarrow> bool) p\<rbrace> setCTE ptr cte \<lbrace>\<lambda>rv. obj_at' P p\<rbrace>"
  unfolding setCTE_def
  apply (rule obj_at_setObject2)
  apply (clarsimp simp: updateObject_cte typeError_def in_monad
                 split: Structures_H.kernel_object.split_asm
                        if_split_asm)
  done

crunch obj_at_ep[wp]: emptySlot "obj_at' (P :: endpoint \<Rightarrow> bool) p"

crunches emptySlot, asUser
  for gsCNodes[wp]: "\<lambda>s. P (gsCNodes s)"
  (wp: crunch_wps)

crunch tcbContext[wp]: possibleSwitchTo "obj_at' (\<lambda>tcb. P ( (atcbContextGet o tcbArch) tcb)) t"
  (wp: crunch_wps simp_del: comp_apply)

crunch only_cnode_caps[wp]: doFaultTransfer "\<lambda>s. P (only_cnode_caps (ctes_of s))"
  (wp: crunch_wps simp: crunch_simps)

lemma tcbSchedDequeue_rewrite_not_queued:
  "monadic_rewrite True False (tcb_at' t and obj_at' (Not \<circ> tcbQueued) t)
     (tcbSchedDequeue t) (return ())"
  apply (simp add: tcbSchedDequeue_def when_def)
  apply (monadic_rewrite_l monadic_rewrite_if_l_False \<open>wp threadGet_const\<close>)
   apply (monadic_rewrite_symb_exec_l, rule monadic_rewrite_refl)
   apply wp+
  apply clarsimp
  done

lemma schedule_known_rewrite:
  "monadic_rewrite True False
      (\<lambda>s. ksSchedulerAction s = SwitchToThread t
               \<and> tcb_at' t s
               \<and> obj_at' (Not \<circ> tcbQueued) t s
               \<and> ksCurThread s = t'
               \<and> st_tcb_at' (Not \<circ> runnable') t' s
               \<and> (ksCurThread s \<noteq> ksIdleThread s)
               \<and> fastpathBestSwitchCandidate t s)
      (schedule)
      (do Arch.switchToThread t;
          setCurThread t;
          setSchedulerAction ResumeCurrentThread od)"
  supply subst_all[simp del] if_split[split del]
  apply (simp add: schedule_def)
  apply (simp only: Thread_H.switchToThread_def)
  (* switching to t *)
  apply (monadic_rewrite_l sched_act_SwitchToThread_rewrite[where t=t])
   (* not wasRunnable, skip enqueue *)
   apply (simp add: when_def)
   apply (monadic_rewrite_l monadic_rewrite_if_l_False)
   (* fastpath: \<not> (fastfail \<and> \<not> highest) *)
   apply (monadic_rewrite_l monadic_rewrite_if_l_False
            \<open>wpsimp simp: isHighestPrio_def'
                    wp: hoare_vcg_imp_lift hoare_vcg_disj_lift threadGet_wp''
                        scheduleSwitchThreadFastfail_False_wp\<close>)
   (* fastpath: no scheduleChooseNewThread *)
   apply (monadic_rewrite_l monadic_rewrite_if_l_False
            \<open>wpsimp simp: isHighestPrio_def'
                    wp: hoare_vcg_imp_lift hoare_vcg_disj_lift threadGet_wp''
                        scheduleSwitchThreadFastfail_False_wp\<close>)
   apply (simp add: bind_assoc)
   apply (monadic_rewrite_l tcbSchedDequeue_rewrite_not_queued
                            \<open>wpsimp wp: Arch_switchToThread_obj_at_pre\<close>)
   (* remove no-ops *)
   apply simp
   apply (repeat 9 \<open>rule monadic_rewrite_symb_exec_l\<close>) (* until switchToThread *)
                              apply (rule monadic_rewrite_refl)
                             apply (wpsimp simp: isHighestPrio_def')+
  apply (clarsimp simp: ct_in_state'_def not_pred_tcb_at'_strengthen
                        fastpathBestSwitchCandidate_def)
  apply normalise_obj_at'
  done

lemma tcb_at_cte_at_offset:
  "\<lbrakk> tcb_at' t s; 2 ^ cte_level_bits * off \<in> dom tcb_cte_cases \<rbrakk>
    \<Longrightarrow> cte_at' (t + 2 ^ cte_level_bits * off) s"
  apply (clarsimp simp: obj_at'_def projectKOs objBits_simps)
  apply (erule(2) cte_wp_at_tcbI')
   apply fastforce
  apply simp
  done

lemma emptySlot_cte_wp_at_cteCap:
  "\<lbrace>\<lambda>s. (p = p' \<longrightarrow> P NullCap) \<and> (p \<noteq> p' \<longrightarrow> cte_wp_at' (\<lambda>cte. P (cteCap cte)) p s)\<rbrace>
     emptySlot p' irqopt
   \<lbrace>\<lambda>rv s. cte_wp_at' (\<lambda>cte. P (cteCap cte)) p s\<rbrace>"
  apply (simp add: tree_cte_cteCap_eq[unfolded o_def])
  apply (wp emptySlot_cteCaps_of)
  apply (clarsimp split: if_split)
  done

lemma setEndpoint_getCTE_pivot[unfolded K_bind_def]:
  "do setEndpoint p val; v <- getCTE slot; f v od
     = do v <- getCTE slot; setEndpoint p val; f v od"
  apply (simp add: getCTE_assert_opt setEndpoint_def
                   setObject_modify_assert
                   fun_eq_iff bind_assoc)
  apply (simp add: exec_gets assert_def assert_opt_def
                   exec_modify update_ep_map_to_ctes
            split: if_split option.split)
  done

lemma setEndpoint_setCTE_pivot[unfolded K_bind_def]:
  "do setEndpoint p val; setCTE slot cte; f od =
     do setCTE slot cte; setEndpoint p val; f od"
  supply if_split[split del]
  apply (rule monadic_rewrite_to_eq)
  apply simp
  apply (rule monadic_rewrite_guard_imp)
   apply (rule monadic_rewrite_trans,
          rule_tac f="ep_at' p" in monadic_rewrite_add_gets)
   apply (rule monadic_rewrite_transverse, rule monadic_rewrite_add_gets,
          rule monadic_rewrite_bind_tail)
    apply (rename_tac epat)
    apply (rule monadic_rewrite_transverse)
     apply (rule monadic_rewrite_bind_tail)
      apply (simp add: setEndpoint_def setObject_modify_assert bind_assoc)
      apply (rule_tac rv=epat in monadic_rewrite_gets_known)
     apply (wp setCTE_typ_at'[where T="koType TYPE(endpoint)", unfolded typ_at_to_obj_at']
                  | simp)+
    apply (simp add: setCTE_assert_modify bind_assoc)
    apply (rule monadic_rewrite_trans, rule monadic_rewrite_add_gets,
           rule monadic_rewrite_bind_tail)+
      apply (rename_tac cteat tcbat)
      apply (rule monadic_rewrite_trans, rule monadic_rewrite_bind_tail)
        apply (rule monadic_rewrite_trans)
         apply (rule_tac rv=cteat in monadic_rewrite_gets_known)
        apply (rule_tac rv=tcbat in monadic_rewrite_gets_known)
       apply (wp setEndpoint_typ_at'[where T="koType TYPE(tcb)", unfolded typ_at_to_obj_at']
                 setEndpoint_typ_at'[where T="koType TYPE(cte)", unfolded typ_at_to_obj_at']
                     | simp)+
      apply (rule_tac P="\<lambda>s. epat = ep_at' p s \<and> cteat = real_cte_at' slot s
                           \<and> tcbat = (tcb_at' (slot && ~~ mask 9) and (%y. slot && mask 9 : dom tcb_cte_cases)) s"
                   in monadic_rewrite_pre_imp_eq)
      apply (simp add: setEndpoint_def setObject_modify_assert bind_assoc
                       exec_gets assert_def exec_modify
                split: if_split)
      apply (auto split: if_split simp: obj_at'_def projectKOs objBits_defs
                    del: ext
                 intro!: arg_cong[where f=f] ext kernel_state.fold_congs)[1]
     apply wp+
  apply (simp add: objBits_defs)
  done

lemma setEndpoint_updateMDB_pivot[unfolded K_bind_def]:
  "do setEndpoint p val; updateMDB slot mf; f od =
     do updateMDB slot mf; setEndpoint p val; f od"
  by (clarsimp simp: updateMDB_def bind_assoc
                     setEndpoint_getCTE_pivot
                     setEndpoint_setCTE_pivot
              split: if_split)

lemma setEndpoint_updateCap_pivot[unfolded K_bind_def]:
  "do setEndpoint p val; updateCap slot mf; f od =
     do updateCap slot mf; setEndpoint p val; f od"
  by (clarsimp simp: updateCap_def bind_assoc
                     setEndpoint_getCTE_pivot
                     setEndpoint_setCTE_pivot)

lemma modify_setEndpoint_pivot[unfolded K_bind_def]:
  "\<lbrakk> \<And>ksf s. ksPSpace_update ksf (sf s) = sf (ksPSpace_update ksf s) \<rbrakk>
    \<Longrightarrow> (do modify sf; setEndpoint p val; f od) =
          (do setEndpoint p val; modify sf; f od)"
  apply (subgoal_tac "\<forall>s. ep_at' p (sf s) = ep_at' p s")
   apply (simp add: setEndpoint_def setObject_modify_assert
                    bind_assoc fun_eq_iff
                    exec_gets exec_modify assert_def
             split: if_split)
  apply atomize
  apply clarsimp
  apply (drule_tac x="\<lambda>_. ksPSpace s" in spec)
  apply (drule_tac x="s" in spec)
  apply (drule_tac f="ksPSpace" in arg_cong)
  apply simp
  apply (metis obj_at'_pspaceI)
  done

lemma setEndpoint_clearUntypedFreeIndex_pivot[unfolded K_bind_def]:
  "do setEndpoint p val; v <- clearUntypedFreeIndex slot; f od
     = do v <- clearUntypedFreeIndex slot; setEndpoint p val; f od"
  supply option.case_cong_weak[cong del]
  by (simp add: clearUntypedFreeIndex_def bind_assoc getSlotCap_def setEndpoint_getCTE_pivot
                updateTrackedFreeIndex_def modify_setEndpoint_pivot
         split: capability.split
      | rule bind_cong[OF refl] allI impI bind_apply_cong[OF refl])+

lemma emptySlot_setEndpoint_pivot[unfolded K_bind_def]:
  "(do emptySlot slot NullCap; setEndpoint p val; f od) =
      (do setEndpoint p val; emptySlot slot NullCap; f od)"
  apply (rule ext)
  apply (simp add: emptySlot_def bind_assoc
                   setEndpoint_getCTE_pivot
                   setEndpoint_updateCap_pivot
                   setEndpoint_updateMDB_pivot
                   case_Null_If Retype_H.postCapDeletion_def
                   setEndpoint_clearUntypedFreeIndex_pivot
            split: if_split
         | rule bind_apply_cong[OF refl])+
  done

lemma set_getCTE[unfolded K_bind_def]:
  "do setCTE p cte; v <- getCTE p; f v od
      = do setCTE p cte; f cte od"
  apply (simp add: getCTE_assert_opt bind_assoc)
  apply (rule monadic_rewrite_to_eq)
  apply (rule monadic_rewrite_bind_tail)
   apply (monadic_rewrite_symb_exec_l)
    apply (monadic_rewrite_symb_exec_l_known cte, rule monadic_rewrite_refl)
    apply (wpsimp simp: assert_opt_def wp: gets_wp)+
  done

lemma set_setCTE[unfolded K_bind_def]:
  "do setCTE p val; setCTE p val' od = setCTE p val'"
  supply if_split[split del]
  apply simp
  apply (rule monadic_rewrite_to_eq)
  apply (rule monadic_rewrite_guard_imp)
   apply (rule monadic_rewrite_trans,
          rule_tac f="real_cte_at' p" in monadic_rewrite_add_gets)
   apply (rule monadic_rewrite_transverse, rule monadic_rewrite_add_gets,
          rule monadic_rewrite_bind_tail)
    apply (rule monadic_rewrite_trans,
           rule_tac f="tcb_at' (p && ~~ mask 9) and K (p && mask 9 \<in> dom tcb_cte_cases)"
                  in monadic_rewrite_add_gets)
    apply (rule monadic_rewrite_transverse, rule monadic_rewrite_add_gets,
           rule monadic_rewrite_bind_tail)
     apply (rename_tac cteat tcbat)
     apply (rule monadic_rewrite_trans)
      apply (rule monadic_rewrite_bind_tail)
       apply (simp add: setCTE_assert_modify)
       apply (rule monadic_rewrite_trans, rule_tac rv=cteat in monadic_rewrite_gets_known)
       apply (rule_tac rv=tcbat in monadic_rewrite_gets_known)
      apply (wp setCTE_typ_at'[where T="koType TYPE(tcb)", unfolded typ_at_to_obj_at']
                setCTE_typ_at'[where T="koType TYPE(cte)", unfolded typ_at_to_obj_at']
                  | simp)+
     apply (simp add: setCTE_assert_modify bind_assoc)
     apply (rule monadic_rewrite_bind_tail)+
       apply (rule_tac P="c = cteat \<and> t = tcbat
                           \<and> (tcbat \<longrightarrow>
                                 (\<exists> getF setF. tcb_cte_cases (p && mask 9) = Some (getF, setF)
                                        \<and> (\<forall> f g tcb. setF f (setF g tcb) = setF (f o g) tcb)))"
                   in monadic_rewrite_gen_asm)
       apply (rule monadic_rewrite_is_refl[OF ext])
       apply (simp add: exec_modify split: if_split)
       apply (auto simp: simpler_modify_def projectKO_opt_tcb objBits_defs
                    del: ext
                 intro!: kernel_state.fold_congs ext
                  split: if_split)[1]
      apply wp+
  apply (clarsimp simp: objBits_defs intro!: all_tcbI)
  apply (auto simp: tcb_cte_cases_def split: if_split_asm)
  done

lemma setCTE_updateCapMDB:
  "p \<noteq> 0 \<Longrightarrow>
   setCTE p cte = do updateCap p (cteCap cte); updateMDB p (const (cteMDBNode cte)) od"
  supply if_split[split del]
  apply (simp add: updateCap_def updateMDB_def bind_assoc set_getCTE
                   cte_overwrite set_setCTE)
  apply (simp add: getCTE_assert_opt setCTE_assert_modify bind_assoc)
  apply (rule ext, simp add: exec_gets assert_opt_def exec_modify
                      split: if_split option.split)
  apply (cut_tac P=\<top> and p=p and s=x in cte_wp_at_ctes_of)
  apply (cases cte)
  apply (simp add: cte_wp_at_obj_cases')
  apply (auto simp: mask_out_sub_mask)
  done

lemma clearUntypedFreeIndex_simple_rewrite:
  "monadic_rewrite True False
    (cte_wp_at' (Not o isUntypedCap o cteCap) slot)
        (clearUntypedFreeIndex slot) (return ())"
  apply (simp add: clearUntypedFreeIndex_def getSlotCap_def)
  apply (rule monadic_rewrite_name_pre)
  apply (clarsimp simp: cte_wp_at_ctes_of)
  apply (monadic_rewrite_symb_exec_l_known cte)
    apply (simp split: capability.split, strengthen monadic_rewrite_refl)
    apply (wpsimp wp: getCTE_wp' simp: cte_wp_at_ctes_of)+
  done

lemma emptySlot_replymaster_rewrite[OF refl]:
  "mdbn = cteMDBNode cte \<Longrightarrow>
   monadic_rewrite True False
     ((\<lambda>_. mdbNext mdbn = 0 \<and> mdbPrev mdbn \<noteq> 0)
           and ((\<lambda>_. cteCap cte \<noteq> NullCap)
           and (cte_wp_at' ((=) cte) slot
           and cte_wp_at' (\<lambda>cte. isReplyCap (cteCap cte)) slot
           and cte_wp_at' (\<lambda>cte. isReplyCap (cteCap cte) \<and> capReplyMaster (cteCap cte))
                    (mdbPrev mdbn)
           and (\<lambda>s. reply_masters_rvk_fb (ctes_of s))
           and (\<lambda>s. no_0 (ctes_of s)))))
     (emptySlot slot NullCap)
     (do updateMDB (mdbPrev mdbn) (mdbNext_update (K 0) o mdbFirstBadged_update (K True)
                                              o mdbRevocable_update (K True));
         setCTE slot makeObject
      od)"
  supply if_split[split del]
  apply (rule monadic_rewrite_gen_asm)+
  apply (rule monadic_rewrite_guard_imp)
   apply (rule_tac P="slot \<noteq> 0" in monadic_rewrite_gen_asm)
   apply (clarsimp simp: emptySlot_def setCTE_updateCapMDB)
   apply (monadic_rewrite_l clearUntypedFreeIndex_simple_rewrite, simp)
   apply (monadic_rewrite_symb_exec_l_known cte)
    apply (simp add: updateMDB_def Let_def bind_assoc makeObject_cte case_Null_If)
    apply (rule monadic_rewrite_bind_tail)
     apply (rule monadic_rewrite_bind)
       apply (rule_tac P="mdbFirstBadged (cteMDBNode ctea) \<and> mdbRevocable (cteMDBNode ctea)"
                in monadic_rewrite_gen_asm)
       apply (rule monadic_rewrite_is_refl)
       apply (case_tac ctea, rename_tac mdbnode, case_tac mdbnode)
       apply simp
      apply (simp add: Retype_H.postCapDeletion_def)
      apply (rule monadic_rewrite_refl)
     apply (solves wp | wp getCTE_wp')+
  apply (clarsimp simp: cte_wp_at_ctes_of reply_masters_rvk_fb_def)
  apply (fastforce simp: isCap_simps)
  done

lemma all_prio_not_inQ_not_tcbQueued: "\<lbrakk> obj_at' (\<lambda>a. (\<forall>d p. \<not> inQ d p a)) t s \<rbrakk> \<Longrightarrow> obj_at' (\<lambda>a. \<not> tcbQueued a) t s"
  apply (clarsimp simp: obj_at'_def inQ_def)
  done

crunches setThreadState, emptySlot, asUser
  for ntfn_obj_at[wp]: "obj_at' (P::(Structures_H.notification \<Rightarrow> bool)) ntfnptr"
  (wp: obj_at_setObject2 crunch_wps
   simp: crunch_simps updateObject_default_def in_monad)

lemma st_tcb_at_is_Reply_imp_not_tcbQueued: "\<And>s t.\<lbrakk> invs' s; st_tcb_at' isReply t s\<rbrakk> \<Longrightarrow> obj_at' (\<lambda>a. \<not> tcbQueued a) t s"
  apply (clarsimp simp: invs'_def valid_state'_def valid_queues_def st_tcb_at'_def valid_queues_no_bitmap_def)
  apply (rule all_prio_not_inQ_not_tcbQueued)
  apply (clarsimp simp: obj_at'_def)
  apply (erule_tac x="d" in allE)
  apply (erule_tac x="p" in allE)
  apply (erule conjE)
  apply (erule_tac x="t" in ballE)
   apply (clarsimp simp: obj_at'_def runnable'_def isReply_def)
   apply (case_tac "tcbState obj")
          apply ((clarsimp simp: inQ_def)+)[8]
  apply (clarsimp simp: valid_queues'_def obj_at'_def)
  done

lemma valid_objs_ntfn_at_tcbBoundNotification:
  "ko_at' tcb t s \<Longrightarrow> valid_objs' s \<Longrightarrow> tcbBoundNotification tcb \<noteq> None
   \<Longrightarrow> ntfn_at' (the (tcbBoundNotification tcb)) s"
  apply (drule(1) ko_at_valid_objs', simp add: projectKOs)
  apply (simp add: valid_obj'_def valid_tcb'_def valid_bound_ntfn'_def)
  apply clarsimp
  done

crunch bound_tcb_at'_Q[wp]: setThreadState "\<lambda>s. Q (bound_tcb_at' P t s)"
  (wp: threadSet_pred_tcb_no_state crunch_wps simp: unless_def)

lemmas emptySlot_pred_tcb_at'_Q[wp] = lift_neg_pred_tcb_at'[OF emptySlot_typ_at' emptySlot_pred_tcb_at']

lemma emptySlot_tcb_at'[wp]:
  "\<lbrace>\<lambda>s. Q (tcb_at' t s)\<rbrace> emptySlot a b \<lbrace>\<lambda>_ s. Q (tcb_at' t s)\<rbrace>"
  by (simp add: tcb_at_typ_at', wp)

lemmas cnode_caps_gsCNodes_lift
    = hoare_lift_Pf2[where P="\<lambda>gs s. cnode_caps_gsCNodes (f s) gs" and f=gsCNodes for f]
    hoare_lift_Pf2[where P="\<lambda>gs s. Q s \<longrightarrow> cnode_caps_gsCNodes (f s) gs" and f=gsCNodes for f Q]

lemma resolveAddressBitsFn_eq_name_slot:
  "monadic_rewrite F E (\<lambda>s. (isCNodeCap cap \<longrightarrow> cte_wp_at' (\<lambda>cte. cteCap cte = cap) (slot s) s)
        \<and> valid_objs' s \<and> cnode_caps_gsCNodes' s)
    (resolveAddressBits cap capptr bits)
    (gets (resolveAddressBitsFn cap capptr bits o only_cnode_caps o ctes_of))"
  apply (rule monadic_rewrite_guard_imp, rule resolveAddressBitsFn_eq)
  apply auto
  done

crunch bound_tcb_at'_Q[wp]: asUser "\<lambda>s. Q (bound_tcb_at' P t s)"
  (simp: crunch_simps wp: threadSet_pred_tcb_no_state crunch_wps)


lemma asUser_tcb_at'_Q[wp]:
  "\<lbrace>\<lambda>s. Q (tcb_at' t s)\<rbrace> asUser a b \<lbrace>\<lambda>_ s. Q (tcb_at' t s)\<rbrace>"
  by (simp add: tcb_at_typ_at', wp)

lemma active_ntfn_check_wp:
  "\<lbrace>\<lambda>s. Q (\<exists>ntfnptr. bound_tcb_at' ((=) (Some ntfnptr)) thread s
      \<and> \<not> obj_at' (Not o isActive) ntfnptr s) s \<rbrace> do bound_ntfn \<leftarrow> getBoundNotification thread;
      case bound_ntfn of None \<Rightarrow> return False
       | Some ntfnptr \<Rightarrow> liftM EndpointDecls_H.isActive $ getNotification ntfnptr
   od \<lbrace>Q\<rbrace>"
  apply (rule hoare_pre)
   apply (wp getNotification_wp gbn_wp' | wpc)+
  apply (auto simp: pred_tcb_at'_def obj_at'_def projectKOs)
  done

lemma tcbSchedEnqueue_tcbIPCBuffer:
  "\<lbrace>obj_at' (\<lambda>tcb. P (tcbIPCBuffer tcb)) t\<rbrace>
  tcbSchedEnqueue t'
  \<lbrace>\<lambda>_. obj_at' (\<lambda>tcb. P (tcbIPCBuffer tcb)) t\<rbrace>"
  apply (simp add: tcbSchedEnqueue_def unless_when)
  apply (wp threadSet_obj_at' hoare_drop_imps threadGet_wp
        |simp split: if_split)+
  done

crunch obj_at'_tcbIPCBuffer[wp]: rescheduleRequired "obj_at' (\<lambda>tcb. P (tcbIPCBuffer tcb)) t"
  (wp: crunch_wps tcbSchedEnqueue_tcbIPCBuffer simp: rescheduleRequired_def)

context
notes if_cong[cong]
begin
crunch obj_at'_tcbIPCBuffer[wp]: setThreadState "obj_at' (\<lambda>tcb. P (tcbIPCBuffer tcb)) t"
  (wp: crunch_wps threadSet_obj_at'_really_strongest)

crunch obj_at'_tcbIPCBuffer[wp]: handleFault "obj_at' (\<lambda>tcb. P (tcbIPCBuffer tcb)) t"
  (wp: crunch_wps constOnFailure_wp tcbSchedEnqueue_tcbIPCBuffer threadSet_obj_at'_really_strongest
   simp: zipWithM_x_mapM)
end

crunch obj_at'_tcbIPCBuffer[wp]: emptySlot "obj_at' (\<lambda>tcb. P (tcbIPCBuffer tcb)) t"
  (wp: crunch_wps)

(* FIXME move *)
crunches getBoundNotification
  for (no_fail) no_fail[intro!, wp, simp]

lemma fastpath_callKernel_SysReplyRecv_corres:
  "monadic_rewrite True False
     (invs' and ct_in_state' ((=) Running) and (\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)
         and cnode_caps_gsCNodes')
     (callKernel (SyscallEvent SysReplyRecv)) (fastpaths SysReplyRecv)"
  including no_pre
  supply if_cong[cong] option.case_cong[cong]
  supply if_split[split del]
  supply user_getreg_inv[wp] (* FIXME *)
  apply (rule monadic_rewrite_introduce_alternative[OF callKernel_def[simplified atomize_eq]])
  apply (rule monadic_rewrite_guard_imp)
   apply (simp add: handleEvent_def handleReply_def
                    handleRecv_def liftE_bindE_handle liftE_handle
                    bind_assoc getMessageInfo_def liftE_bind)
   apply (simp add: catch_liftE_bindE unlessE_throw_catch_If
                    unifyFailure_catch_If catch_liftE
                    getMessageInfo_def alternative_bind
                    fastpaths_def getThreadCallerSlot_def
                    locateSlot_conv capability_case_Null_ReplyCap
                    getThreadCSpaceRoot_def
              cong: if_cong)
   apply (rule monadic_rewrite_bind_alternative_l, wp)
   apply (rule monadic_rewrite_bind_tail)
    apply monadic_rewrite_symb_exec_r
     apply (rename_tac msgInfo)
     apply monadic_rewrite_symb_exec_r
      apply monadic_rewrite_symb_exec_r
       apply (rename_tac tcbFault)
       apply (rule monadic_rewrite_alternative_r[rotated])
        apply (rule monadic_rewrite_alternative_l)
       apply (rule monadic_rewrite_if_r[rotated])
        apply (rule monadic_rewrite_alternative_l)
       apply (simp add: lookupCap_def liftME_def lookupCapAndSlot_def
                        lookupSlotForThread_def bindE_assoc
                        split_def getThreadCSpaceRoot_def
                        locateSlot_conv liftE_bindE bindE_bind_linearise
                        capFaultOnFailure_def rethrowFailure_injection
                        injection_handler_catch bind_bindE_assoc
                        getThreadCallerSlot_def bind_assoc
                        getSlotCap_def case_bool_If
                        isRight_def[where x="Inr v" for v]
                        isRight_def[where x="Inl v" for v]
                  cong: if_cong)
       apply monadic_rewrite_symb_exec_r
        apply (rename_tac "cTableCTE")
        apply (rule monadic_rewrite_transverse,
               monadic_rewrite_l resolveAddressBitsFn_eq wpsimp, rule monadic_rewrite_refl)
        apply monadic_rewrite_symb_exec_r
         apply (rename_tac "rab_ret")

         apply (rule_tac P="isRight rab_ret" in monadic_rewrite_cases[rotated])
          apply (case_tac rab_ret, simp_all add: isRight_def)[1]
          apply (rule monadic_rewrite_alternative_l)
         apply clarsimp
         apply (simp add: isRight_case_sum liftE_bind
                          isRight_def[where x="Inr v" for v])
         apply monadic_rewrite_symb_exec_r
          apply (rename_tac ep_cap)
          apply (rule monadic_rewrite_if_r[rotated])
           apply (rule monadic_rewrite_alternative_l)
          apply (monadic_rewrite_symb_exec
                   \<open>rule monadic_rewrite_symb_exec_r_nE[OF _ _ _ active_ntfn_check_wp, unfolded bind_assoc fun_app_def]\<close>
                   \<open>wpsimp simp: getBoundNotification_def wp: threadGet_wp\<close>)
          apply (rename_tac ep)
          apply (rule monadic_rewrite_if_r[rotated])
           apply (rule monadic_rewrite_alternative_l)
          apply monadic_rewrite_symb_exec_r
           apply (rename_tac ep)
           apply (rule monadic_rewrite_if_r[rotated])
            apply (rule monadic_rewrite_alternative_l)
           apply (rule monadic_rewrite_bind_alternative_l, wp)
           apply (rule monadic_rewrite_bind_tail)
            apply (rename_tac replyCTE)
            apply (rule monadic_rewrite_if_r[rotated])
             apply (rule monadic_rewrite_alternative_l)
            apply (simp add: bind_assoc)
            apply (rule monadic_rewrite_bind_alternative_l, wp assert_inv)
            apply (rule monadic_rewrite_assert)
            apply monadic_rewrite_symb_exec_r
             apply (rule monadic_rewrite_if_r[rotated])
              apply (rule monadic_rewrite_alternative_l)
             apply (simp add: getThreadVSpaceRoot_def locateSlot_conv)
             apply monadic_rewrite_symb_exec_r
              apply (rename_tac vTableCTE)
              apply (rule monadic_rewrite_if_r[rotated])
               apply (rule monadic_rewrite_alternative_l)

              apply monadic_rewrite_symb_exec_r
               apply monadic_rewrite_symb_exec_r
                apply (simp add: isHighestPrio_def')
                apply monadic_rewrite_symb_exec_r
                 apply (rule monadic_rewrite_if_r[rotated])
                  apply (rule monadic_rewrite_alternative_l)

                 apply monadic_rewrite_symb_exec_r
                  apply (rule monadic_rewrite_if_r[rotated])
                   apply (rule monadic_rewrite_alternative_l)
                  apply monadic_rewrite_symb_exec_r
                   apply (rule monadic_rewrite_if_r[rotated])
                    apply (rule monadic_rewrite_alternative_l)
                   apply (rule monadic_rewrite_trans,
                              rule monadic_rewrite_pick_alternative_1)
                   (* now committed to fastpath *)
                   apply (rule_tac P="\<lambda>v.  obj_at' (%tcb. tcbIPCBuffer tcb = v) (capTCBPtr (cteCap replyCTE))"
                         in monadic_rewrite_exists_v)
                   apply (rename_tac ipcBuffer)

                   apply (simp add: ARM_H.switchToThread_def bind_assoc)
                   apply (rule monadic_rewrite_trans[OF _ monadic_rewrite_transverse])

                     apply (rule monadic_rewrite_bind monadic_rewrite_refl)+
                          apply (wp mapM_x_wp' getObject_inv | wpc | simp add:
                            | wp (once) hoare_drop_imps )+

                    apply (rule monadic_rewrite_bind monadic_rewrite_refl)+
                               apply (wp setCTE_obj_at'_tcbIPCBuffer assert_inv mapM_x_wp' getObject_inv | wpc | simp
                                 | wp (once) hoare_drop_imps )+

                   apply (rule monadic_rewrite_trans)
                    apply (rule monadic_rewrite_trans)
                     apply (rule monadic_rewrite_bind_head)
                     apply (rule monadic_rewrite_trans)
                      apply (rule doReplyTransfer_simple)
                     apply simp
                     apply (((rule monadic_rewrite_weaken_flags',
                             (rule_tac msgInfo=msgInfo in doIPCTransfer_simple_rewrite
                           | rule_tac destPrio=callerPrio
                                            and curDom=curDom and destDom=callerDom
                                            and thread=thread in possibleSwitchTo_rewrite))
                           | rule cteDeleteOne_replycap_rewrite
                           | rule monadic_rewrite_bind monadic_rewrite_refl
                           | wp assert_inv mapM_x_wp'
                                setThreadState_obj_at_unchanged
                                asUser_obj_at_unchanged
                                hoare_strengthen_post[OF _ obj_at_conj'[simplified atomize_conjL], rotated]
                                 lookupBitmapPriority_lift
                                 setThreadState_runnable_bitmap_inv
                           | simp add: setMessageInfo_def setThreadState_runnable_simp
                           | wp (once) hoare_vcg_disj_lift)+)[1]
                    apply (simp add: setMessageInfo_def)
                    apply (rule monadic_rewrite_bind_tail)
                     apply (rename_tac unblocked)
                     apply (monadic_rewrite_symb_exec_l_known thread)
                      apply (monadic_rewrite_symb_exec_l_known cptr)
                       apply (rule monadic_rewrite_bind)
                         apply (rule monadic_rewrite_catch[OF _ monadic_rewrite_refl True_E_E])
                         apply monadic_rewrite_symb_exec_l
                          apply (rename_tac cTableCTE2,
                                 rule_tac P="cteCap cTableCTE2 = cteCap cTableCTE"
                                   in monadic_rewrite_gen_asm)
                          apply simp
                          apply (rule monadic_rewrite_trans,
                                 rule monadic_rewrite_bindE[OF _ monadic_rewrite_refl])
                            apply (rule_tac slot="\<lambda>s. ksCurThread s + 2 ^ cte_level_bits * tcbCTableSlot"
                                     in resolveAddressBitsFn_eq_name_slot)
                           apply wp
                          apply (rule monadic_rewrite_trans)
                           apply (rule_tac rv=rab_ret
                                    in monadic_rewrite_gets_known[where m="Nondet_Monad.lift f"
                                    for f, folded bindE_def])
                          apply (simp add: Nondet_Monad.lift_def isRight_case_sum)
                          apply monadic_rewrite_symb_exec_l
                           apply (rename_tac ep_cap2)
                           apply (rule_tac P="cteCap ep_cap2 = cteCap ep_cap" in monadic_rewrite_gen_asm)
                           apply (simp add: cap_case_EndpointCap_NotificationCap)
                           apply (rule monadic_rewrite_liftE)
                           apply (rule monadic_rewrite_trans)
                            apply (rule monadic_rewrite_bind)
                              apply (rule deleteCallerCap_nullcap_rewrite)
                             apply (rule_tac ep=ep in receiveIPC_simple_rewrite)
                            apply (wp, simp)
                           apply (rule monadic_rewrite_bind_head)

                           apply (rule monadic_rewrite_weaken_flags[where E=True and F=True], simp)
                           apply (rule setThreadState_rewrite_simple)
                          apply clarsimp
                          apply (wp getCTE_known_cap)+
                        apply (rule monadic_rewrite_bind)
                          apply (rule_tac t="capTCBPtr (cteCap replyCTE)"
                                      and t'=thread
                                       in schedule_known_rewrite)
                         apply (rule monadic_rewrite_weaken_flags[where E=True and F=True], simp)
                         apply (rule monadic_rewrite_bind)
                           apply (rule activateThread_simple_rewrite)
                          apply (rule monadic_rewrite_refl)
                         apply wp
                        apply wp
                         apply (simp add: ct_in_state'_def, simp add: ct_in_state'_def[symmetric])
                         apply ((wp setCurThread_ct_in_state[folded st_tcb_at'_def]
                                    Arch_switchToThread_pred_tcb')+)[2]
                       apply (simp add: catch_liftE)
                       apply ((wpsimp wp: user_getreg_rv setEndpoint_obj_at_tcb'
                                          threadSet_pred_tcb_at_state[unfolded if_bool_eq_conj]
                                          fastpathBestSwitchCandidate_lift[where f="setEndpoint a b" for a b]
                                          fastpathBestSwitchCandidate_lift[where f="threadSet f t" for f t]
                               | wps)+)[3]
                    apply (simp cong: rev_conj_cong)
                    apply (wpsimp wp: seThreadState_tcbContext[simplified comp_apply]
                                      setThreadState_oa_queued user_getreg_rv
                                      setThreadState_no_sch_change setThreadState_obj_at_unchanged
                                      sts_st_tcb_at'_cases sts_bound_tcb_at'
                                      fastpathBestSwitchCandidate_lift[where f="setThreadState s t" for s t]
                                      hoare_weak_lift_imp hoare_vcg_all_lift hoare_vcg_imp_lift
                                      hoare_weak_lift_imp cnode_caps_gsCNodes_lift
                                      hoare_vcg_ex_lift
                          | wps)+
                           apply (strengthen imp_consequent[where Q="tcb_at' t s" for t s])
                           apply ((wp setThreadState_oa_queued user_getreg_rv setThreadState_no_sch_change
                                      setThreadState_obj_at_unchanged
                                      sts_st_tcb_at'_cases sts_bound_tcb_at'
                                      emptySlot_obj_at'_not_queued emptySlot_obj_at_ep
                                      emptySlot_tcbContext[simplified comp_apply]
                                      emptySlot_cte_wp_at_cteCap
                                      emptySlot_cnode_caps
                                      user_getreg_inv asUser_typ_ats
                                      asUser_obj_at_not_queued asUser_obj_at' mapM_x_wp'
                                      hoare_weak_lift_imp hoare_vcg_all_lift hoare_vcg_imp_lift
                                      hoare_weak_lift_imp cnode_caps_gsCNodes_lift
                                      hoare_vcg_ex_lift
                                      fastpathBestSwitchCandidate_lift[where f="emptySlot a b" for a b]
                                   | simp del: comp_apply
                                   | clarsimp simp: obj_at'_weakenE[OF _ TrueI]
                                   | wps)+)

                            apply (wpsimp wp: fastpathBestSwitchCandidate_lift[where f="asUser a b" for a b])+
                           apply (clarsimp cong: conj_cong)
                           apply ((wp user_getreg_inv asUser_typ_ats
                                      asUser_obj_at_not_queued asUser_obj_at' mapM_x_wp'
                                      hoare_weak_lift_imp hoare_vcg_all_lift hoare_vcg_imp_lift
                                      hoare_weak_lift_imp cnode_caps_gsCNodes_lift
                                      hoare_vcg_ex_lift
                                   | clarsimp simp: obj_at'_weakenE[OF _ TrueI]
                                   | solves \<open>
                                       wp fastpathBestSwitchCandidate_lift[where f="asUser a b" for a b]
                                       \<close>)+)

                          apply (clarsimp | wp getCTE_wp' gts_imp')+

                   apply (simp add: ARM_H.switchToThread_def bind_assoc)
                   apply (rule monadic_rewrite_trans[OF _ monadic_rewrite_transverse])

                     apply (rule monadic_rewrite_bind monadic_rewrite_refl)+
                                     apply (wp mapM_x_wp' handleFault_obj_at'_tcbIPCBuffer getObject_inv | wpc | simp
                                       | wp (once) hoare_drop_imps )+
                    apply (rule monadic_rewrite_bind monadic_rewrite_refl)+
                               apply (wp setCTE_obj_at'_tcbIPCBuffer assert_inv mapM_x_wp' getObject_inv | wpc | simp
                                 | wp (once) hoare_drop_imps )+

                   apply (simp add: bind_assoc catch_liftE
                                    receiveIPC_def Let_def liftM_def
                                    setThreadState_runnable_simp)
                   apply monadic_rewrite_symb_exec_l
                    apply (rule monadic_rewrite_assert)

                    apply (rule_tac P="inj (case_bool thread (capTCBPtr (cteCap replyCTE)))"
                                    in monadic_rewrite_gen_asm)
                    apply (rule monadic_rewrite_trans[OF _ monadic_rewrite_transverse])
                      apply (rule monadic_rewrite_weaken_flags[where F=False and E=True], simp)
                      apply (rule isolate_thread_actions_rewrite_bind
                                  fastpath_isolate_rewrites fastpath_isolatables
                                  bool.simps setRegister_simple
                                  zipWithM_setRegister_simple
                                  thread_actions_isolatable_bind
                                  thread_actions_isolatableD[OF setCTE_isolatable]
                                  setCTE_isolatable
                                  setVMRoot_isolatable[THEN thread_actions_isolatableD] setVMRoot_isolatable
                                  doMachineOp_isolatable[THEN thread_actions_isolatableD] doMachineOp_isolatable
                                  kernelExitAssertions_isolatable[THEN thread_actions_isolatableD]
                                  kernelExitAssertions_isolatable
                           | assumption
                           | wp assert_inv)+
                    apply (simp only: )
                    apply (rule_tac P="(\<lambda>s. ksSchedulerAction s = ResumeCurrentThread)
                                       and tcb_at' thread
                                       and (cte_wp_at' (\<lambda>cte. isReplyCap (cteCap cte))
                                                (thread + 2 ^ cte_level_bits * tcbCallerSlot)
                                       and (\<lambda>s. \<forall>x. tcb_at' (case_bool thread (capTCBPtr (cteCap replyCTE)) x) s)
                                       and valid_mdb')"
                                and F=True and E=False in monadic_rewrite_weaken_flags)
                    apply (rule monadic_rewrite_isolate_final2)
                       apply simp
                       apply monadic_rewrite_symb_exec_l
                        apply (rename_tac callerCTE)
                        apply (rule monadic_rewrite_assert)
                        apply monadic_rewrite_symb_exec_l
                         apply (rule monadic_rewrite_assert)
                         apply (simp add: emptySlot_setEndpoint_pivot)
                         apply (rule monadic_rewrite_bind)
                           apply (rule monadic_rewrite_is_refl)
                           apply (clarsimp simp: isSendEP_def split: Structures_H.endpoint.split)
                          apply (monadic_rewrite_symb_exec_r_known callerCTE)
                           apply (rule monadic_rewrite_trans, rule monadic_rewrite_bind_head,
                                       rule_tac cte=callerCTE in emptySlot_replymaster_rewrite)
                           apply (simp add: bind_assoc o_def)
                           apply (rule monadic_rewrite_refl)
                          apply (simp add: cte_wp_at_ctes_of pred_conj_def)
                          apply (clarsimp | wp getCTE_ctes_wp)+
                      apply (clarsimp simp: zip_map2 zip_same_conv_map foldl_map
                                            foldl_fun_upd
                                            foldr_copy_register_tsrs
                                            isRight_case_sum
                                      cong: if_cong)
                      apply (clarsimp simp: fun_eq_iff if_flip
                                      cong: if_cong)
                      apply (drule obj_at_ko_at', clarsimp)
                      apply (frule get_tcb_state_regs_ko_at')
                      apply (clarsimp simp: zip_map2 zip_same_conv_map foldl_map
                                            foldl_fun_upd
                                            foldr_copy_register_tsrs
                                            isRight_case_sum
                                      cong: if_cong)
                      apply (simp add: upto_enum_def fromEnum_def
                                       enum_register toEnum_def
                                       msgRegisters_unfold
                                 cong: if_cong)
                      apply (clarsimp split: if_split)
                      apply (rule ext)
                      apply (simp add: badgeRegister_def msgInfoRegister_def
                                       ARM.msgInfoRegister_def
                                       ARM.badgeRegister_def
                                 cong: if_cong
                                split: if_split)
                     apply simp
                    apply (clarsimp simp: cte_wp_at_ctes_of isCap_simps
                                          map_to_ctes_partial_overwrite)
                    apply (simp add: valid_mdb'_def valid_mdb_ctes_def)
                   apply simp
                   apply (simp cong: if_cong bool.case_cong
                          | rule getCTE_wp' gts_wp' threadGet_wp
                                 getEndpoint_wp gets_wp
                                 user_getreg_wp
                                 gets_the_wp gct_wp getNotification_wp
                                 return_wp liftM_wp gbn_wp'
                          | (simp only: curDomain_def, wp)[1])+

  apply clarsimp
  apply (subgoal_tac "ksCurThread s \<noteq> ksIdleThread s")
   prefer 2
   apply (fastforce simp: ct_in_state'_def dest: ct_running_not_idle' elim: pred_tcb'_weakenE)

  apply (clarsimp simp: ct_in_state'_def pred_tcb_at')
  apply (subst tcb_at_cte_at_offset,
         erule obj_at'_weakenE[OF _ TrueI],
         simp add: tcb_cte_cases_def cte_level_bits_def tcbSlots)
  apply (clarsimp simp: valid_objs_ntfn_at_tcbBoundNotification
                        invs_valid_objs' if_apply_def2)
  apply (rule conjI[rotated])
   apply (fastforce elim: cte_wp_at_weakenE')
  apply (clarsimp simp: isRight_def)
  apply (frule cte_wp_at_valid_objs_valid_cap', clarsimp+)
  apply (frule resolveAddressBitsFn_real_cte_at',
    (clarsimp | erule cte_wp_at_weakenE')+)
  apply (frule real_cte_at', clarsimp)
  apply (frule cte_wp_at_valid_objs_valid_cap', clarsimp,
         clarsimp simp: isCap_simps, simp add: valid_cap_simps')
  apply (clarsimp simp: maskCapRights_def isCap_simps)
  apply (frule_tac p="p' + 2 ^ cte_level_bits * tcbCallerSlot" for p'
              in cte_wp_at_valid_objs_valid_cap', clarsimp+)
  apply (clarsimp simp: valid_cap_simps')
  apply (subst tcb_at_cte_at_offset,
         assumption, simp add: tcb_cte_cases_def cte_level_bits_def tcbSlots)
  apply (clarsimp simp: inj_case_bool cte_wp_at_ctes_of
                        length_msgRegisters
                        order_less_imp_le
                        tcb_at_invs' invs_mdb'
                 split: bool.split)
  apply (subst imp_disjL[symmetric], intro allI impI)
  apply (clarsimp simp: inj_case_bool cte_wp_at_ctes_of
                        length_msgRegisters size_msgRegisters_def order_less_imp_le
                        tcb_at_invs' invs_mdb'
                 split: bool.split)

  apply (subgoal_tac "fastpathBestSwitchCandidate v0a s")
   prefer 2
   apply normalise_obj_at'
   apply (rule_tac ttcb=tcba and ctcb=tcb in fastpathBestSwitchCandidateI)
     apply (erule disjE, blast, blast)
    apply simp+

  apply (clarsimp simp: obj_at_tcbs_of tcbSlots
                        cte_level_bits_def)
  apply (frule(1) st_tcb_at_is_Reply_imp_not_tcbQueued)
  apply (auto simp: obj_at_tcbs_of tcbSlots
                        cte_level_bits_def)
  done

end

lemma cnode_caps_gsCNodes_from_sr:
  "\<lbrakk> valid_objs s; (s, s') \<in> state_relation \<rbrakk> \<Longrightarrow> cnode_caps_gsCNodes' s'"
  apply (clarsimp simp: cnode_caps_gsCNodes_def only_cnode_caps_def
                        o_def ran_map_option)
  apply (safe, simp_all)
  apply (clarsimp elim!: ranE)
  apply (frule(1) pspace_relation_cte_wp_atI[rotated])
   apply clarsimp
  apply (clarsimp simp: is_cap_simps)
  apply (frule(1) cte_wp_at_valid_objs_valid_cap)
  apply (clarsimp simp: valid_cap_simps cap_table_at_gsCNodes_eq)
  done

end