(*
 * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
 *
 * SPDX-License-Identifier: GPL-2.0-only
 *)

theory Finalise_IF
imports ArchArch_IF ArchIRQMasks_IF
begin

locale Finalise_IF_1 =
  fixes aag :: "'a subject_label PAS"
  assumes dmo_maskInterrupt_reads_respects:
    "reads_respects aag l \<top> (do_machine_op (maskInterrupt m irq))"
  and arch_post_cap_deletion_read_respects[wp]:
    "reads_respects aag l \<top> (arch_post_cap_deletion acap)"
  and equiv_asid_sa_update[simp]:
    "\<And>f. equiv_asid asid (scheduler_action_update f s) s' = equiv_asid asid s s'"
    "\<And>f. equiv_asid asid s (scheduler_action_update f s') = equiv_asid asid s s'"
  and equiv_asid_ready_queues_update[simp]:
    "\<And>f. equiv_asid asid (ready_queues_update f s) s' = equiv_asid asid s s'"
    "\<And>f. equiv_asid asid s (ready_queues_update f s') = equiv_asid asid s s'"
  and set_thread_state_reads_respects:
    "pas_domains_distinct aag
     \<Longrightarrow> reads_respects aag l (\<lambda>s. is_subject aag (cur_thread s)) (set_thread_state ref ts)"
  and set_bound_notification_globals_equiv:
    "\<lbrace>globals_equiv s and valid_arch_state\<rbrace> set_bound_notification ref nopt \<lbrace>\<lambda>_. globals_equiv s\<rbrace>"
  and set_thread_state_runnable_reads_respects:
    "\<lbrakk> pas_domains_distinct aag; runnable ts \<rbrakk> \<Longrightarrow> reads_respects aag l \<top> (set_thread_state ref ts)"
  and set_bound_notification_none_reads_respects:
    "pas_domains_distinct aag \<Longrightarrow> reads_respects aag l \<top> (set_bound_notification ref None)"
  and thread_set_reads_respects:
    "pas_domains_distinct aag \<Longrightarrow> reads_respects aag l \<top> (thread_set x y)"
  and set_tcb_queue_reads_respects[wp]:
    "reads_respects aag l \<top> (set_tcb_queue d prio queue)"
  and set_notification_equiv_but_for_labels:
    "\<lbrace>equiv_but_for_labels aag L st and K (pasObjectAbs aag ntfnptr \<in> L)\<rbrace>
     set_notification ntfnptr ntfn
     \<lbrace>\<lambda>_. equiv_but_for_labels aag L st\<rbrace>"
  and prepare_thread_delete_reads_respects_f:
    "reads_respects_f aag l \<top> (prepare_thread_delete t)"
  and arch_finalise_cap_reads_respects:
    "reads_respects aag l (pas_refined aag and invs and cte_wp_at ((=) (ArchObjectCap cap)) slot
                                           and K (pas_cap_cur_auth aag (ArchObjectCap cap)))
                          (arch_finalise_cap cap is_final)"
  and arch_finalise_cap_makes_halted:
    "\<lbrace>invs and valid_cap (ArchObjectCap acap)
           and (\<lambda>s. ex = is_final_cap' (ArchObjectCap acap) s)
           and cte_wp_at ((=) (ArchObjectCap acap)) slot\<rbrace>
     arch_finalise_cap acap ex
     \<lbrace>\<lambda>rv s :: det_state. \<forall>t \<in> obj_refs_ac (fst rv). halted_if_tcb t s\<rbrace>"
  and set_notification_globals_equiv:
    "\<lbrace>globals_equiv st and valid_arch_state\<rbrace>
     set_notification ntfnptr ntfn
     \<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
  and arch_post_cap_deletion_globals_equiv[wp]:
    "arch_post_cap_deletion acap \<lbrace>globals_equiv st\<rbrace>"
  and set_irq_state_globals_equiv:
    "set_irq_state state irq \<lbrace>globals_equiv st\<rbrace>"
  and arch_finalise_cap_globals_equiv:
    "\<lbrace>globals_equiv st and invs and valid_arch_cap acap\<rbrace>
     arch_finalise_cap acap ex
     \<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
  and prepare_thread_delete_globals_equiv[wp]:
    "prepare_thread_delete t \<lbrace>globals_equiv st\<rbrace>"
begin

lemma set_irq_state_reads_respects:
  "reads_respects aag l \<top> (set_irq_state state irq)"
  unfolding set_irq_state_def fun_app_def
  apply (wp dmo_maskInterrupt_reads_respects)
    apply (subst equiv_valid_def2)
    apply (rule_tac P="\<top>" and P'="\<top>" in modify_ev2)
    apply (fastforce elim: affects_equivE reads_equivE equiv_forE intro: equiv_forI
                   intro!: reads_equiv_interrupt_states_update affects_equiv_interrupt_states_update)
   apply wpsimp+
  done

lemma deleted_irq_handler_reads_respects:
  "reads_respects aag l \<top> (deleted_irq_handler irq)"
  unfolding deleted_irq_handler_def
  by (rule set_irq_state_reads_respects)

lemma empty_slot_reads_respects:
  notes split_paired_All[simp del] split_paired_Ex[simp del]
  shows "reads_respects aag l (K (aag_can_read aag (fst slot))) (empty_slot slot free_irq)"
  unfolding empty_slot_def post_cap_deletion_def fun_app_def
  apply (simp add: bind_assoc[symmetric] cong: if_cong)
  apply (fold update_cdt_def)
  apply (simp add: bind_assoc empty_slot_ext_def cong: if_cong)
  apply (rule gen_asm_ev)
  apply (wp deleted_irq_handler_reads_respects set_cap_reads_respects set_original_reads_respects
            update_cdt_list_reads_respects update_cdt_reads_respects get_cap_wp get_cap_rev
         | wpsimp
         | frule aag_can_read_self, fastforce simp: equiv_for_def split: option.splits)+
  by (fastforce simp: reads_equiv_def2 equiv_for_def
                elim: states_equiv_forE_cdt
                dest: aag_can_read_self
               split: option.splits)

lemma scheduler_action_states_equiv[simp]:
  "states_equiv_for P Q R S st (scheduler_action_update f s) = states_equiv_for P Q R S st s"
  by (simp add: states_equiv_for_def equiv_for_def equiv_asids_def)

crunch states_equiv[wp]: set_thread_state_ext "states_equiv_for P Q R S st"
  (ignore_del: set_thread_state_ext)

end


lemma requiv_get_tcb_eq':
  "\<lbrakk> reads_equiv aag s t; aag_can_read aag thread \<rbrakk>
     \<Longrightarrow> get_tcb thread s = get_tcb thread t"
  by (auto simp: reads_equiv_def2 get_tcb_def
           elim: states_equiv_forE_kheap
          dest!: aag_can_read_self)

lemma set_scheduler_action_reads_respects[wp]:
  "reads_respects aag l \<top> (set_scheduler_action action)"
  by (simp add: set_scheduler_action_def equiv_valid_def2 equiv_valid_2_def modify_def bind_def put_def
                get_def reads_equiv_scheduler_action_update affects_equiv_scheduler_action_update)

lemma set_thread_state_ext_reads_respects:
  "reads_respects aag l (\<lambda>s. is_subject aag (cur_thread s)) (set_thread_state_ext ref)"
  apply (case_tac "is_subject aag ref")
   apply (simp add: set_thread_state_ext_def when_def get_thread_state_def | wp thread_get_rev)+
   apply (simp add: reads_equiv_def)
  apply (simp add: set_thread_state_ext_def when_def)
  apply (simp add: equiv_valid_def2)
  apply (rule equiv_valid_rv_bind[where W="\<top>\<top>"])
    apply (clarsimp simp: equiv_valid_2_def get_thread_state_def thread_get_def gets_the_def
                          return_def bind_def assert_opt_def gets_def get_tcb_def fail_def get_def
                   split: option.splits)
   apply clarsimp
   apply (rule equiv_valid_2_bind[where R'="(=)" and Q="\<lambda>rv _. rv \<noteq> ref" and Q'="\<lambda>rv _. rv \<noteq> ref"])
      apply (rule gen_asm_ev2)
      apply (simp add: equiv_valid_def2[symmetric] | wp)+
      apply (clarsimp simp: reads_equiv_def)
     apply (subst equiv_valid_def2[symmetric])
     apply wp+
  apply force
  done

lemma set_thread_state_ext_owned_reads_respects:
  "reads_respects aag l (\<lambda>s. aag_can_read aag ref) (set_thread_state_ext ref)"
  apply (simp add: set_thread_state_ext_def when_def get_thread_state_def | wp thread_get_rev)+
  apply (simp add: reads_equiv_def)
  done

lemma set_thread_state_owned_reads_respects:
  "reads_respects aag l (\<lambda>s. aag_can_read aag ref) (set_thread_state ref ts)"
  apply (simp add: set_thread_state_def)
  apply (wp set_object_reads_respects gets_the_ev set_thread_state_ext_owned_reads_respects)
  by (fastforce intro: kheap_get_tcb_eq elim: reads_equivE equiv_forD)

lemma set_bound_notification_owned_reads_respects:
  "reads_respects aag l (\<lambda>s. is_subject aag ref) (set_bound_notification ref ntfn)"
  apply (simp add: set_bound_notification_def)
  apply (wp set_object_reads_respects gets_the_ev)
  apply (force elim: reads_equivE equiv_forE)
  done

lemma get_thread_state_runnable[wp]:
   "\<lbrace>st_tcb_at runnable ref\<rbrace> get_thread_state ref \<lbrace>\<lambda>rv _. runnable rv\<rbrace>"
  by (wpsimp wp: gts_st_tcb_at)

lemma set_thread_state_ext_runnable_reads_respects:
  "reads_respects aag l (st_tcb_at runnable ref) (set_thread_state_ext ref)"
  apply (simp add: set_thread_state_ext_def when_def)
  apply (simp add: equiv_valid_def2)
  apply (rule equiv_valid_rv_bind[where W="\<top>\<top>" and Q="\<lambda>rv _. runnable rv"])
    apply (clarsimp simp: equiv_valid_2_def get_thread_state_def thread_get_def gets_the_def
                          return_def bind_def assert_opt_def gets_def get_tcb_def fail_def get_def
                   split: option.splits)
   apply (rule gen_asm_ev2)
   apply (clarsimp simp: equiv_valid_def2[symmetric] | wp)+
   apply (simp add: reads_equiv_def)
  apply wp
  done

lemma set_simple_ko_reads_respects:
  "reads_respects aag l \<top> (set_simple_ko f ptr ep)"
  unfolding set_simple_ko_def
  apply (simp add: equiv_valid_def2)
  apply (rule equiv_valid_rv_bind)
    apply (rule equiv_valid_rv_guard_imp)
     apply (rule get_object_revrv)
    apply (simp, simp)
   apply (rule_tac R'="\<top>\<top>" in equiv_valid_2_bind)
      apply (rule_tac R'="\<top>\<top>" in equiv_valid_2_bind)
         apply (subst equiv_valid_def2[symmetric])
         apply (rule set_object_reads_respects)
        apply (rule assert_ev2)
        apply (simp)
       apply (rule assert_inv)+
     apply (rule assert_ev2)
     apply (simp)
    apply (rule assert_inv)+
  apply (simp)
  apply (wp get_object_inv)
  done

lemma get_ep_queue_reads_respects:
  "reads_respects aag l \<top> (get_ep_queue ep)"
  unfolding get_ep_queue_def
  apply (rule equiv_valid_guard_imp)
   apply (wp | wpc)+
  apply (simp)
  done

lemma get_object_reads_respects:
  "reads_respects aag l (K (aag_can_read aag ptr \<or> (aag_can_affect aag l ptr))) (get_object ptr)"
  apply (unfold get_object_def fun_app_def)
  apply (subst gets_apply)
  apply (wp gets_apply_ev | wp (once) hoare_drop_imps)+
  apply (fastforce elim: reads_equivE affects_equivE equiv_forE)
  done

lemma get_simple_ko_reads_respects:
  "reads_respects aag l (K (aag_can_read aag ptr \<or> aag_can_affect aag l ptr))
    (get_simple_ko f ptr)"
  unfolding get_simple_ko_def
  by (wp get_object_reads_respects | wpc | simp)+

lemma get_epq_SendEP_ret:
  "\<lbrace>\<lambda>s. \<forall>x\<in>set list. P x\<rbrace> get_ep_queue (SendEP list) \<lbrace>\<lambda>rv s. \<forall>x\<in>set rv. P x\<rbrace>"
  by (wpsimp simp: get_ep_queue_def)

lemma get_epq_RecvEP_ret:
  "\<lbrace>\<lambda>s. \<forall>x\<in>set list. P x\<rbrace> get_ep_queue (RecvEP list) \<lbrace>\<lambda>rv s. \<forall>x\<in>set rv. P x\<rbrace>"
  by (wpsimp simp: get_ep_queue_def)


fun ep_queue_invisible where
  "ep_queue_invisible aag l (SendEP list) = labels_are_invisible aag l ((pasObjectAbs aag) ` (set list))"
| "ep_queue_invisible aag l (RecvEP list) = labels_are_invisible aag l ((pasObjectAbs aag) ` (set list))"
| "ep_queue_invisible aag l IdleEP = True"


lemma obj_eq_st_tcb_at:
  "\<lbrakk> kheap s x = kheap s' x; st_tcb_at P x s' \<rbrakk>
    \<Longrightarrow> st_tcb_at P x s"
  by (clarsimp simp: st_tcb_at_def obj_at_def)

lemma send_blocked_on_tcb_st_to_auth:
  "send_blocked_on epptr ts \<Longrightarrow> (epptr, SyncSend) \<in> tcb_st_to_auth ts"
  by (case_tac ts, simp_all)

lemma receive_blocked_on_tcb_st_to_auth:
  "receive_blocked_on epptr ts \<Longrightarrow> (epptr, Receive) \<in> tcb_st_to_auth ts"
  by (case_tac ts, simp_all)

lemma not_ep_queue_invisible:
  "\<lbrakk> \<not> ep_queue_invisible aag l eplist; eplist = SendEP list \<or> eplist = RecvEP list \<rbrakk>
     \<Longrightarrow> \<exists>t \<in> set list. aag_can_read aag t \<or> aag_can_affect aag l t"
  by (auto simp: labels_are_invisible_def)

lemma ep_queued_st_tcb_at'':
  "\<And>P. \<lbrakk> ko_at (Endpoint ep) ptr s; (t, rt) \<in> ep_q_refs_of ep;
          valid_objs s; sym_refs (state_refs_of s);
          \<And>pl pl'. (rt = EPSend \<and> P (BlockedOnSend ptr pl)) \<or>
                    (rt = EPRecv \<and> P (BlockedOnReceive ptr pl')) \<rbrakk>
          \<Longrightarrow> st_tcb_at P t s"
  apply (case_tac ep, simp_all)
  apply (frule (1) sym_refs_ko_atD, fastforce simp: st_tcb_at_def obj_at_def refs_of_rev)+
  done

lemma ep_queues_are_invisible_or_eps_are_equal':
  "\<lbrakk> (pasSubject aag, Reset, pasObjectAbs aag epptr) \<in> pasPolicy aag;
     ko_at (Endpoint ep) epptr s; ko_at (Endpoint ep') epptr s';
     reads_equiv aag s s'; affects_equiv aag l s s';
     valid_objs s; sym_refs (state_refs_of s); valid_objs s';
     sym_refs (state_refs_of s'); pas_refined aag s; pas_refined aag s' \<rbrakk>
     \<Longrightarrow> (\<not> ep_queue_invisible aag l ep) \<longrightarrow> ep = ep'"
  apply (rule impI)
  apply (case_tac "\<exists>list. ep = SendEP list \<or> ep = RecvEP list")
   apply (erule exE)
   apply (drule (1) not_ep_queue_invisible)
   apply clarsimp
   apply (erule disjE)
    apply (erule disjE)
     apply (drule_tac auth="SyncSend" and t="pasObjectAbs aag t" in reads_read_queued_thread_read_ep)
         apply blast
        apply (erule pas_refined_mem[rotated])
        apply (rule sta_ts)
        apply (drule_tac P="send_blocked_on epptr" and s=s and t=t in ep_queued_st_tcb_at'')
            apply (simp)+
        apply (simp add: thread_st_auth_def split: option.splits)
        apply (clarsimp simp: tcb_states_of_state_def st_tcb_def2 send_blocked_on_tcb_st_to_auth)
       apply blast
      apply assumption
     apply (fastforce dest: reads_affects_equiv_kheap_eq simp: obj_at_def)
    apply (drule_tac auth="SyncSend" and t="pasObjectAbs aag t" in reads_read_queued_thread_read_ep)
        apply blast
       apply (erule pas_refined_mem[rotated])
       apply (rule sta_ts)
       apply (drule_tac P="send_blocked_on epptr" and s=s and t=t in ep_queued_st_tcb_at'')
           apply (simp)+
       apply (simp add: thread_st_auth_def split: option.splits)
       apply (clarsimp simp: tcb_states_of_state_def st_tcb_def2 send_blocked_on_tcb_st_to_auth)
      apply blast
     apply (erule conjE, assumption)
    apply (drule_tac x=epptr in reads_affects_equiv_kheap_eq, simp+)
    apply (fastforce simp: obj_at_def)
   apply (erule disjE)
    apply (drule_tac auth="Receive" and t="pasObjectAbs aag t" in reads_read_queued_thread_read_ep)
        apply blast
       apply (erule pas_refined_mem[rotated])
       apply (rule sta_ts)
       apply (drule_tac P="receive_blocked_on epptr" and s=s and t=t in ep_queued_st_tcb_at'')
           apply (simp)+
       apply (simp add: thread_st_auth_def split: option.splits)
       apply (clarsimp simp: tcb_states_of_state_def st_tcb_def2 receive_blocked_on_tcb_st_to_auth)
      apply blast
     apply assumption
    apply (fastforce dest: reads_affects_equiv_kheap_eq simp: obj_at_def)
   apply (drule_tac auth="Receive" and t="pasObjectAbs aag t" in reads_read_queued_thread_read_ep)
       apply blast
      apply (erule pas_refined_mem[rotated])
      apply (rule sta_ts)
      apply (drule_tac P="receive_blocked_on epptr" and s=s and t=t in ep_queued_st_tcb_at'')
          apply (simp)+
      apply (simp add: thread_st_auth_def split: option.splits)
      apply (clarsimp simp: tcb_states_of_state_def st_tcb_def2 receive_blocked_on_tcb_st_to_auth)
     apply blast
    apply (erule conjE, assumption)
   apply (drule_tac x=epptr in reads_affects_equiv_kheap_eq, simp+)
   apply (fastforce simp: obj_at_def)
  apply (case_tac ep, auto)
  done

lemma ep_queues_are_invisible_or_eps_are_equal:
  "\<lbrakk> (pasSubject aag, Reset, pasObjectAbs aag epptr) \<in> pasPolicy aag;
     ko_at (Endpoint ep) epptr s; ko_at (Endpoint ep') epptr s';
     reads_equiv aag s s'; affects_equiv aag l s s';
     valid_objs s; sym_refs (state_refs_of s); valid_objs s';
     sym_refs (state_refs_of s'); pas_refined aag s; pas_refined aag s' \<rbrakk>
     \<Longrightarrow> (\<not> ep_queue_invisible aag l ep \<or> \<not> ep_queue_invisible aag l ep') \<longrightarrow> ep = ep'"
  apply (rule impI)
  apply (erule disjE)
   apply (blast intro!: ep_queues_are_invisible_or_eps_are_equal'[rule_format])
  apply (rule sym)
  apply (erule ep_queues_are_invisible_or_eps_are_equal'[rule_format])
  by (assumption | erule reads_equiv_sym | erule affects_equiv_sym)+

lemma get_simple_ko_revrv:
  "inj C \<Longrightarrow> reads_equiv_valid_rv_inv R aag (\<lambda>obj obj'. \<exists>s t. reads_equiv aag s t
                                                            \<and> R s t \<and> P s \<and> P t
                                                            \<and> ko_at (C obj) ptr s
                                                            \<and> ko_at (C obj') ptr t)
                                      P (get_simple_ko C ptr)"
  apply (simp add: get_simple_ko_def)
  apply (rule_tac Q="\<lambda> rv. ko_at rv ptr and P" in equiv_valid_rv_bind)
    apply (rule equiv_valid_rv_guard_imp[OF equiv_valid_rv_trivial])
     apply wpsimp+
   apply (clarsimp simp add: assert_def fail_ev2_l fail_ev2_r
                   simp del: imp_disjL split: option.split)
   apply (rule return_ev2)
   apply (auto simp: proj_inj)[1]
  apply (rule hoare_strengthen_post[OF get_object_sp])
  apply simp
  done

lemma get_endpoint_revrv:
  "reads_equiv_valid_rv_inv (affects_equiv aag l) aag
     (\<lambda>ep ep'. (\<not> ep_queue_invisible aag l ep \<or> \<not> ep_queue_invisible aag l ep') \<longrightarrow> ep = ep')
     (pas_refined aag and valid_objs and sym_refs \<circ> state_refs_of
                      and K ((pasSubject aag, Reset, pasObjectAbs aag epptr) \<in> pasPolicy aag))
     (get_endpoint epptr)"
  apply (rule equiv_valid_2_rvrel_imp, rule get_simple_ko_revrv)
   apply (simp add: inj_Endpoint)
  apply (auto elim: ep_queues_are_invisible_or_eps_are_equal[rule_format])
  done

lemma gen_asm_ev2_r:
  "(P' \<Longrightarrow> equiv_valid_2 I A B R P \<top> f f') \<Longrightarrow> equiv_valid_2 I A B R P (\<lambda>s. P') f f'"
  by (rule gen_asm_ev2_r')

lemma gen_asm_ev2_l:
  "(P \<Longrightarrow> equiv_valid_2 I A B R \<top> P' f f') \<Longrightarrow> equiv_valid_2 I A B R (\<lambda>s. P) P' f f'"
  by (rule gen_asm_ev2_l')

lemma bind_return_unit2:
  "f = return () >>= (\<lambda>_. f)"
  by simp

lemma mapM_x_ev2_invisible:
  assumes domains_distinct:
    "pas_domains_distinct aag"
  assumes mam:
    "\<And>ptr. modifies_at_most aag (L ptr) \<top> ((f :: obj_ref \<Rightarrow> (unit, det_ext) s_monad) ptr)"
  assumes mam':
    "\<And>ptr. modifies_at_most aag (L' ptr) \<top> ((f' :: obj_ref \<Rightarrow> (unit, det_ext) s_monad) ptr)"
  shows
    "equiv_valid_2 (reads_equiv aag) (affects_equiv aag l) (affects_equiv aag l) (=)
                   (K (\<forall>x. x \<in> set list' \<longrightarrow> (labels_are_invisible aag l (L' x))))
                   (K (\<forall>x. x \<in> set list \<longrightarrow> (labels_are_invisible aag l (L x))))
                   (mapM_x f' list') (mapM_x f list)"
  apply (induct list)
   apply (induct_tac list')
    apply (simp add: mapM_x_Nil)
    apply (blast intro: return_ev2)
   apply (simp add: mapM_x_Cons mapM_x_Nil)
   apply (subst bind_return_unit[where f="return ()"])
   apply (rule_tac R'="(=)" and P="\<lambda>s. labels_are_invisible aag l (L' a)" in equiv_valid_2_bind_pre)
        apply simp
       apply (rule gen_asm_ev2_l)
       apply (rule equiv_valid_2_guard_imp[OF ev2_invisible[OF domains_distinct]], assumption+)
           apply (rule mam')
          apply (rule_tac P="\<top>" in modifies_at_mostI)
          apply (wp | simp)+
  apply (simp add: mapM_x_Cons)
  apply (subst bind_return_unit2)
  apply (rule_tac R'="(=)" and P'="\<lambda>s. labels_are_invisible aag l (L a)" in equiv_valid_2_bind_pre)
       apply simp
      apply (rule gen_asm_ev2_r)
      apply (rule equiv_valid_2_guard_imp[OF ev2_invisible[OF domains_distinct]], assumption+)
          apply (rule_tac P="\<top>" in modifies_at_mostI)
          apply (wp | simp)+
         apply (rule mam)
        apply (wp | simp)+
  done

lemma ev2_inv:
  assumes inv: "\<And>P. f \<lbrace>P\<rbrace>"
  assumes inv': "\<And>P. g \<lbrace>P\<rbrace>"
  shows "equiv_valid_2 I A A \<top>\<top> \<top> \<top> f g"
  apply (clarsimp simp: equiv_valid_2_def)
  apply (drule state_unchanged[OF inv])
  apply (drule state_unchanged[OF inv'])
  by simp

lemma mapM_x_ev2_r_invisible:
  assumes domains_distinct:
    "pas_domains_distinct aag"
  assumes mam:
    "\<And>ptr. modifies_at_most aag (L ptr) \<top> ((f :: obj_ref \<Rightarrow> (unit, det_ext) s_monad) ptr)"
  assumes inv:
    "\<And>P. g \<lbrace>P\<rbrace>"
  shows
    "equiv_valid_2 (reads_equiv aag) (affects_equiv aag l) (affects_equiv aag l) (=) \<top>
                   (K (\<forall>x. x \<in> set list \<longrightarrow>  labels_are_invisible aag l (L x))) g (mapM_x f list)"
  apply (induct list)
   apply (simp add: mapM_x_Nil)
   apply (rule ev2_inv[OF inv])
   apply wp
  apply (simp add: mapM_x_Cons)
  apply (subst bind_return_unit2)
  apply (rule_tac R'="(=)" and P'="\<lambda> s. labels_are_invisible aag l (L a)" in equiv_valid_2_bind_pre)
       apply simp
      apply (rule gen_asm_ev2_r)
      apply (rule equiv_valid_2_guard_imp[OF ev2_invisible[OF domains_distinct]], assumption+)
          apply (rule_tac P="\<top>" in modifies_at_mostI)
          apply (wp | simp)+
         apply (rule mam)
        apply (wp | simp)+
  done

(* MOVE *)
lemma ev2_sym:
  assumes symI: "\<And>x y. I x y \<Longrightarrow> I y x"
  assumes symA: "\<And>x y. A x y \<Longrightarrow> A y x"
  assumes symB: "\<And>x y. B x y \<Longrightarrow> B y x"
  assumes symR: "\<And>x y. R x y \<Longrightarrow> R y x"
  shows "equiv_valid_2 I A B R P' P f' f \<Longrightarrow>
         equiv_valid_2 I A B R P P' f f'"
  apply (clarsimp simp: equiv_valid_2_def)
  apply (blast intro: symA symB symI symR)
  done

lemma mapM_x_ev2_l_invisible:
  assumes domains_distinct:
    "pas_domains_distinct aag"
  assumes mam:
    "\<And>ptr. modifies_at_most aag (L ptr) \<top> ((f :: obj_ref \<Rightarrow> (unit, det_ext) s_monad) ptr)"
  assumes inv:
    "\<And>P. g \<lbrace>P\<rbrace>"
  shows
    "equiv_valid_2 (reads_equiv aag) (affects_equiv aag l) (affects_equiv aag l) (=)
                   (K (\<forall>x. x \<in> set list \<longrightarrow> labels_are_invisible aag l (L x))) \<top> (mapM_x f list) g"
  apply (rule ev2_sym[OF reads_equiv_sym affects_equiv_sym affects_equiv_sym])
      apply (simp_all)[4]
  apply (rule mapM_x_ev2_r_invisible[OF domains_distinct mam inv])
  done

lemma not_label_is_invisible:
  "(\<not> labels_are_invisible aag l {(pasObjectAbs aag x)}) =
   (aag_can_read aag x \<or> aag_can_affect aag l x)"
  by (simp add: labels_are_invisible_def)

lemma label_is_invisible:
  "(labels_are_invisible aag l {(pasObjectAbs aag x)}) =
   (\<not> (aag_can_read aag x \<or> aag_can_affect aag l x))"
  by (simp add: labels_are_invisible_def)

lemma op_eq_unit_taut: "(=) = (\<lambda> (_:: unit) _. True)"
  by (rule ext | simp)+

lemma ev2_symmetric:
  "equiv_valid_2 (reads_equiv aag) (affects_equiv aag l) (affects_equiv aag l) (=) P P f f'
   \<Longrightarrow> equiv_valid_2 (reads_equiv aag) (affects_equiv aag l) (affects_equiv aag l) (=) P P f' f"
  apply (clarsimp simp add: equiv_valid_2_def)
  apply (drule_tac x=t in spec)
  apply (drule_tac x=s in spec)
  apply (fastforce elim: affects_equiv_sym reads_equiv_sym)
  done

lemma reads_respects_ethread_get:
  "reads_respects aag l (\<lambda>_. is_subject aag thread) (ethread_get f thread)"
  apply (simp add: ethread_get_def)
  apply wp
  apply (drule aag_can_read_self)
  apply (fastforce simp: reads_equiv_def2 get_etcb_def equiv_for_def states_equiv_for_def)
  done

lemma aag_can_read_self'[simp]:
  "aag_can_read_label aag (pasSubject aag)"
  by fastforce

lemma gets_apply_ready_queues_reads_respects:
  "reads_respects aag l (\<lambda>_. pasSubject aag \<in> pasDomainAbs aag d) (gets_apply ready_queues d)"
  apply (rule gets_apply_ev')
  apply (force elim: reads_equivE simp: equiv_for_def)
  done

(* FIXME: move *)
lemma equiv_valid_rv_trivial':
  assumes inv: "\<And>P. f \<lbrace>P\<rbrace>"
  shows "equiv_valid_rv_inv I A \<top>\<top> Q f"
  by (auto simp: equiv_valid_2_def dest: state_unchanged[OF inv])

lemma gets_cur_domain_ev:
  "reads_equiv_valid_inv A aag \<top> (gets cur_domain)"
  apply (rule equiv_valid_guard_imp)
   apply wp
  apply (simp add: reads_equiv_def)
  done

crunch sched_act[wp]: set_simple_ko "\<lambda>s. P (scheduler_action s)"
  (wp: crunch_wps)



context Finalise_IF_1 begin

lemma set_tcb_queue_modifies_at_most:
  "modifies_at_most aag L (\<lambda>s. pasDomainAbs aag d \<inter> L \<noteq> {}) (set_tcb_queue d prio queue)"
  apply (rule modifies_at_mostI)
  apply (simp add: set_tcb_queue_def modify_def, wp)
  apply (force simp: equiv_but_for_labels_def states_equiv_for_def equiv_for_def equiv_asids_def)
  done

lemma tcb_sched_action_reads_respects:
  assumes domains_distinct: "pas_domains_distinct aag"
  shows "reads_respects aag l (pas_refined aag) (tcb_sched_action action t)"
  apply (simp add: tcb_sched_action_def get_tcb_queue_def)
  apply (subst gets_apply)
  apply (case_tac "aag_can_read aag t \<or> aag_can_affect aag l t")
   apply (simp add: ethread_get_def)
   apply wp
         apply (rule_tac Q="\<lambda>s. pasObjectAbs aag t \<in> pasDomainAbs aag (tcb_domain rv)"
                      in equiv_valid_guard_imp)
          apply (wp gets_apply_ev')
          apply (fastforce simp: reads_equiv_def affects_equiv_def equiv_for_def states_equiv_for_def)
         apply (wp | simp)+
   apply (intro conjI impI allI
          | fastforce simp: get_etcb_def elim: reads_equivE affects_equivE equiv_forE)+
   apply (clarsimp simp: pas_refined_def tcb_domain_map_wellformed_aux_def split: option.splits)
   apply (erule_tac x="(t, tcb_domain y)" in ballE, force)
   apply (force intro: domtcbs simp: get_etcb_def)
  apply (simp add: equiv_valid_def2 ethread_get_def)
  apply (rule equiv_valid_rv_bind)
    apply (wp equiv_valid_rv_trivial', simp)
   apply (rule equiv_valid_2_bind)
      prefer 2
      apply (wp equiv_valid_rv_trivial, simp)
     apply (rule equiv_valid_2_bind)
        apply (rule_tac P=\<top> and P'=\<top> and L="{pasObjectAbs aag t}" and L'="{pasObjectAbs aag t}"
                     in ev2_invisible[OF domains_distinct])
            apply (blast | simp add: labels_are_invisible_def)+
          apply (rule set_tcb_queue_modifies_at_most)
         apply (rule set_tcb_queue_modifies_at_most)
        apply (simp | wp)+
       apply (clarsimp simp: equiv_valid_2_def gets_apply_def get_def
                             bind_def return_def labels_are_invisible_def)
      apply wpsimp+
  apply (force intro: domtcbs simp: get_etcb_def pas_refined_def tcb_domain_map_wellformed_aux_def)
  done

lemma reschedule_required_reads_respects[wp]:
  assumes domains_distinct[wp]: "pas_domains_distinct aag"
  shows "reads_respects aag l (pas_refined aag) reschedule_required"
  apply (simp add: reschedule_required_def | wp tcb_sched_action_reads_respects | wpc)+
  apply (simp add: reads_equiv_def)
  done

lemma possible_switch_to_reads_respects:
  assumes domains_distinct[wp]: "pas_domains_distinct aag"
  shows "reads_respects aag l (pas_refined aag and pas_cur_domain aag
                                               and (\<lambda>s. is_subject aag (cur_thread s)))
                              (possible_switch_to tptr)"
  apply (simp add: possible_switch_to_def ethread_get_def)
  apply (case_tac "aag_can_read aag tptr \<or> aag_can_affect aag l tptr")
   apply (wp hoare_weak_lift_imp tcb_sched_action_reads_respects | wpc | simp)+
   apply (clarsimp simp: get_etcb_def)
   apply ((intro conjI impI allI
          | elim aag_can_read_self reads_equivE affects_equivE equiv_forE conjE disjE
          | force)+)[1]
  apply clarsimp
  apply (wp (once), rename_tac cur_dom)
     apply (simp add: equiv_valid_def2)
     apply (rule_tac W="\<top>\<top>" and Q="\<lambda>tcb. pas_refined aag and K (tcb_domain tcb \<noteq> cur_dom)"
                  in equiv_valid_rv_bind)
       prefer 3
       apply wp
      apply (monad_eq simp: get_etcb_def equiv_valid_2_def)
     apply (rule gen_asm_ev2')
     apply (simp add: equiv_valid_def2[symmetric])
     apply (wp tcb_sched_action_reads_respects)
     apply (simp add: reads_equiv_def)
    apply (wp gets_cur_domain_ev)+
  apply (clarsimp simp: get_etcb_def pas_refined_def tcb_domain_map_wellformed_aux_def)
  apply (frule_tac x="(tptr, tcb_domain y)" in bspec, force intro: domtcbs)
  apply (erule notE)
  apply (fastforce dest: domains_distinct[THEN pas_domains_distinct_inj])
  done

lemma cancel_all_ipc_reads_respects:
  assumes domains_distinct[wp]: "pas_domains_distinct aag"
  shows "reads_respects aag l (pas_refined aag and pspace_aligned and valid_vspace_objs
                                               and valid_arch_state and K (aag_can_read aag epptr))
                        (cancel_all_ipc epptr)"
  unfolding cancel_all_ipc_def fun_app_def
  by (wp mapM_x_ev'' tcb_sched_action_reads_respects set_thread_state_runnable_reads_respects
         set_thread_state_pas_refined hoare_vcg_ball_lift
         set_thread_state_runnable_valid_sched_action
         set_simple_ko_reads_respects get_ep_queue_reads_respects get_epq_SendEP_ret
         get_epq_RecvEP_ret get_simple_ko_reads_respects get_simple_ko_wp
      | wpc
      | clarsimp simp: ball_conj_distrib
      | rule subset_refl
      | wp (once) hoare_drop_imps
      | assumption
      | rule hoare_strengthen_post[where Q="\<lambda>_. pas_refined aag and pspace_aligned
                                                                and valid_vspace_objs
                                                                and valid_arch_state", OF mapM_x_wp])+

end


fun ntfn_queue_invisible where
  "ntfn_queue_invisible aag l (WaitingNtfn list) = labels_are_invisible aag l ((pasObjectAbs aag) ` (set list))"
| "ntfn_queue_invisible aag l _ = True"


lemma not_ntfn_queue_invisible:
  "\<lbrakk> \<not> ntfn_queue_invisible aag l eplist; eplist = WaitingNtfn list \<rbrakk>
     \<Longrightarrow> (\<exists>t \<in> set list. aag_can_read aag t \<or> aag_can_affect aag l t)"
  by (auto simp: labels_are_invisible_def)

lemma ntfn_queues_are_invisible_or_ntfns_are_equal':
  "\<lbrakk> (pasSubject aag, Reset, pasObjectAbs aag ntfnptr) \<in> pasPolicy aag;
     ko_at (Notification ntfn) ntfnptr s; ko_at (Notification ntfn') ntfnptr s';
     reads_equiv aag s s'; affects_equiv aag l s s';
     valid_objs s; sym_refs (state_refs_of s); valid_objs s';
     sym_refs (state_refs_of s'); pas_refined aag s; pas_refined aag s' \<rbrakk>
     \<Longrightarrow> \<not> ntfn_queue_invisible aag l (ntfn_obj ntfn) \<longrightarrow> ntfn_obj ntfn = ntfn_obj ntfn'"
  apply (rule impI)
  apply (case_tac "\<exists>list. ntfn_obj ntfn = WaitingNtfn list")
   apply (erule exE)
   apply (drule (1) not_ntfn_queue_invisible)
   apply clarsimp
   apply (erule disjE)
    apply (drule_tac auth="Receive" and t="pasObjectAbs aag t" in reads_read_queued_thread_read_ep)
        apply blast
       apply (erule pas_refined_mem[rotated])
       apply (rule sta_ts)
       apply (drule_tac P="receive_blocked_on ntfnptr" and s=s and t=t in ntfn_queued_st_tcb_at')
           apply (simp)+
       apply (simp add: thread_st_auth_def split: option.splits)
       apply (clarsimp simp: tcb_states_of_state_def st_tcb_def2 receive_blocked_on_tcb_st_to_auth)
      apply blast
     apply assumption
    apply (fastforce dest: reads_affects_equiv_kheap_eq simp: obj_at_def)
   apply (drule_tac auth="Receive" and t="pasObjectAbs aag t" in reads_read_queued_thread_read_ep)
       apply blast
      apply (erule pas_refined_mem[rotated])
      apply (rule sta_ts)
      apply (drule_tac P="receive_blocked_on ntfnptr" and s=s and t=t in ntfn_queued_st_tcb_at')
          apply (simp)+
      apply (simp add: thread_st_auth_def split: option.splits)
      apply (clarsimp simp: tcb_states_of_state_def st_tcb_def2 receive_blocked_on_tcb_st_to_auth)
     apply blast
    apply (erule conjE, assumption)
   apply (drule_tac x=ntfnptr in reads_affects_equiv_kheap_eq, simp+)
   apply (fastforce simp: obj_at_def)
  apply (case_tac "ntfn_obj ntfn", auto)
  done

lemma get_bound_notification_reads_respects':
  "reads_respects aag l (K(is_subject aag thread)) (get_bound_notification thread)"
  unfolding get_bound_notification_def thread_get_def
  apply (wp | simp)+
  apply clarify
  apply (rule requiv_get_tcb_eq)
   apply simp+
  done

lemma thread_get_reads_respects:
  "reads_respects aag l (K (aag_can_read aag thread \<or> aag_can_affect aag l thread))
                  (thread_get f thread)"
  unfolding thread_get_def fun_app_def
  apply (wp gets_the_ev)
  apply (auto intro: reads_affects_equiv_get_tcb_eq)
  done

lemma get_bound_notification_reads_respects:
  "reads_respects aag l (\<lambda> s. aag_can_read aag thread \<or> aag_can_affect aag l thread)
                  (get_bound_notification thread)"
  unfolding get_bound_notification_def
  apply (rule equiv_valid_guard_imp)
   apply (wp thread_get_reads_respects | simp)+
  done

lemma bound_tcb_at_implies_read:
  "\<lbrakk> pas_refined aag s; is_subject aag t; bound_tcb_at ((=) (Some x)) t s \<rbrakk>
     \<Longrightarrow> aag_can_read_label aag (pasObjectAbs aag x)"
  apply (frule bound_tcb_at_implies_receive, simp)
  apply clarsimp
  apply (frule_tac l="pasSubject aag" and auth=Receive in reads_ep, simp)
  apply (auto simp: aag_can_read_read)
  done

lemma bound_tcb_at_eq:
  "\<lbrakk> sym_refs (state_refs_of s); valid_objs s; kheap s ntfnptr = Some (Notification ntfn);
     ntfn_bound_tcb ntfn = Some tcbptr; bound_tcb_at ((=) (Some ntfnptr')) tcbptr s \<rbrakk>
     \<Longrightarrow> ntfnptr = ntfnptr'"
  apply (drule_tac x=ntfnptr in sym_refsD[rotated])
   apply (fastforce simp: state_refs_of_def)
  apply (auto simp: pred_tcb_at_def obj_at_def valid_obj_def valid_ntfn_def
                    is_tcb state_refs_of_def refs_of_rev
          simp del: refs_of_simps)
  done

lemma unbind_notification_is_subj_reads_respects:
  "reads_respects aag l (pas_refined aag and invs and K (is_subject aag t))
                  (unbind_notification t)"
  apply (clarsimp simp: unbind_notification_def)
  apply (wp set_bound_notification_owned_reads_respects set_simple_ko_reads_respects
            get_simple_ko_reads_respects get_bound_notification_reads_respects
            gbn_wp[unfolded get_bound_notification_def, simplified]
         | wpc
         | simp add: get_bound_notification_def)+
  apply (clarsimp)
  apply (rule bound_tcb_at_implies_read, auto)
  done


context Finalise_IF_1 begin

lemma cancel_all_signals_reads_respects:
  assumes domains_distinct[wp]: "pas_domains_distinct aag"
  shows
    "reads_respects aag l (pas_refined aag and pspace_aligned and valid_vspace_objs
                                           and valid_arch_state and K (aag_can_read aag ntfnptr))
                   (cancel_all_signals ntfnptr)"
  unfolding cancel_all_signals_def
  by (wp mapM_x_ev'' tcb_sched_action_reads_respects set_thread_state_runnable_reads_respects
         set_thread_state_pas_refined hoare_vcg_ball_lift
         set_thread_state_runnable_valid_sched_action
         set_simple_ko_reads_respects get_epq_SendEP_ret get_epq_RecvEP_ret
         get_simple_ko_reads_respects get_simple_ko_wp
      | wpc
      | clarsimp simp: ball_conj_distrib
      | rule subset_refl
      | wp (once) hoare_drop_imps
      | simp
      | rule hoare_strengthen_post[where Q="\<lambda>_. pas_refined aag and pspace_aligned
                                                                and valid_vspace_objs
                                                                and valid_arch_state", OF mapM_x_wp])+

lemma unbind_maybe_notification_reads_respects:
  assumes domains_distinct[wp]: "pas_domains_distinct aag"
  shows
  "reads_respects aag l (pas_refined aag and invs and K (aag_can_read aag ntfnptr))
                  (unbind_maybe_notification ntfnptr)"
  unfolding unbind_maybe_notification_def
  by (wp set_bound_notification_none_reads_respects
         set_simple_ko_reads_respects get_simple_ko_reads_respects
      | wpc | simp)+

(* aag_can_read is transitive on endpoints but intransitive on notifications *)
lemma fast_finalise_reads_respects:
  assumes domains_distinct[wp]: "pas_domains_distinct aag"
  shows
    "reads_respects aag l (pas_refined aag and invs and
                           K (fin \<longrightarrow> (case cap of EndpointCap r badge rights \<Rightarrow> aag_can_read aag r
                                             | NotificationCap r badge rights \<Rightarrow> is_subject aag r
                                             | _ \<Rightarrow> True)))
                    (fast_finalise cap fin)"
  apply (case_tac cap, simp_all)
  by (wp equiv_valid_guard_imp[OF cancel_all_ipc_reads_respects]
         equiv_valid_guard_imp[OF cancel_all_signals_reads_respects]
         unbind_notification_is_subj_reads_respects
         unbind_maybe_notification_reads_respects
         get_simple_ko_reads_respects get_simple_ko_wp
      | simp add: when_def
      | wpc
      | intro conjI impI
      | fastforce simp: aag_cap_auth_def cap_auth_conferred_def cap_rights_to_auth_def)+

lemma cap_delete_one_reads_respects_f:
  assumes domains_distinct[wp]: "pas_domains_distinct aag"
  shows "reads_respects_f aag l (silc_inv aag st and invs and pas_refined aag
                                                 and K (is_subject aag (fst slot)))
                          (cap_delete_one slot)"
  unfolding cap_delete_one_def fun_app_def
  apply (unfold unless_def when_def)
  apply (rule equiv_valid_guard_imp)
   apply (wp is_final_cap_reads_respects
            reads_respects_f[OF empty_slot_reads_respects, where st=st]
            reads_respects_f[OF fast_finalise_reads_respects, where st=st]
            empty_slot_silc_inv
        | simp | elim conjE)+
      apply (rule_tac Q="\<lambda>rva s. rva = is_final_cap' rv s \<and>
                                 cte_wp_at ((=) rv) slot s \<and>
                                 silc_inv aag st s \<and>
                                 is_subject aag (fst slot) \<and>
                                 pasObjectAbs aag (fst slot) \<noteq> SilcLabel"
                   in hoare_strengthen_post)
       apply wp
      apply (rule conjI)
       apply clarsimp
       apply (drule silc_inv)
       apply (erule_tac x=rv in allE, erule_tac x=slot in allE)
       apply simp
       apply (drule(1) intra_label_capD)
       apply (clarsimp simp: cap_points_to_label_def split: cap.splits)
      apply force
     apply (wp reads_respects_f[OF get_cap_rev] get_cap_auth_wp | simp | elim conjE)+
  by (fastforce simp: cte_wp_at_caps_of_state silc_inv_def)

lemma cap_delete_one_reads_respects_f_transferable:
  assumes domains_distinct[wp]: "pas_domains_distinct aag"
  shows
  "reads_respects_f aag l
     (silc_inv aag st and invs and pas_refined aag
                      and K (aag_can_read_not_silc aag (fst slot)) and is_transferable_in slot)
     (cap_delete_one slot)"
  unfolding cap_delete_one_def fun_app_def
  apply (unfold unless_def when_def)
  apply (rule equiv_valid_guard_imp)
   apply (wp is_final_cap_reads_respects empty_slot_silc_inv
             reads_respects_f[OF empty_slot_reads_respects, where st=st]
             reads_respects_f[OF fast_finalise_reads_respects, where st=st]
          | simp | elim conjE)+
      apply (rule_tac Q="\<lambda>rva s. rva = is_final_cap' rv s \<and>
                                 cte_wp_at ((=) rv) slot s \<and>
                                 silc_inv aag st s \<and>
                                 is_transferable_in slot s \<and>
                                 aag_can_read_not_silc aag (fst slot)"
                   in hoare_strengthen_post)
       apply wp
      apply (rule conjI)
       apply clarsimp
       apply (drule silc_inv)
       apply (erule_tac x=rv in allE, erule_tac x=slot in allE)
       apply simp
       apply (drule(1) intra_label_capD)
       apply (clarsimp simp: cap_points_to_label_def' cte_wp_at_caps_of_state split: cap.splits)
      apply (force elim: is_transferable_capE)
     apply (wp reads_respects_f[OF get_cap_rev] get_cap_wp | simp | elim conjE)+
  by (fastforce simp: cte_wp_at_caps_of_state silc_inv_def)

end


lemma get_blocking_object_reads_respects:
  "reads_respects aag l \<top> (get_blocking_object state)"
  unfolding get_blocking_object_def
  apply (rule equiv_valid_guard_imp)
   apply (wp | wpc | simp)+
  done


fun tcb_st_to_auth' where
  "tcb_st_to_auth' (BlockedOnSend x pl) = SyncSend"
| "tcb_st_to_auth' (BlockedOnReceive x pl) = Receive"
| "tcb_st_to_auth' (BlockedOnNotification x) = Receive"


lemma owns_thread_blocked_reads_endpoint:
  "\<lbrakk> pas_refined aag s; invs s; st_tcb_at (\<lambda> y. y = state) tptr s; is_subject aag tptr;
     state = BlockedOnReceive x pl \<or> state = BlockedOnSend x xb \<or> state = BlockedOnNotification x \<rbrakk>
     \<Longrightarrow> aag_can_read aag x"
  apply (rule_tac auth="tcb_st_to_auth' state" in reads_ep)
   apply (drule sym, simp, rule pas_refined_mem)
    apply (rule_tac s=s in sta_ts)
    apply (clarsimp simp: thread_st_auth_def tcb_states_of_state_def
                          st_tcb_at_def get_tcb_def obj_at_def)
    apply fastforce
   apply assumption
  apply fastforce
  done

lemma st_tcb_at_sym:
  "st_tcb_at ((=) x) t s = st_tcb_at (\<lambda> y. y = x) t s"
  by (auto simp: st_tcb_at_def obj_at_def)

lemma blocked_cancel_ipc_reads_respects:
  "reads_respects aag l (pas_refined aag and invs and st_tcb_at ((=) state) tptr
                                                  and K (is_subject aag tptr))
                  (blocked_cancel_ipc state tptr)"
  unfolding blocked_cancel_ipc_def
  apply (wp set_thread_state_owned_reads_respects set_simple_ko_reads_respects
            get_ep_queue_reads_respects get_simple_ko_reads_respects get_blocking_object_reads_respects
         | simp add: get_blocking_object_def | wpc)+
  apply (fastforce intro: aag_can_read_self owns_thread_blocked_reads_endpoint simp: st_tcb_at_sym)
  done

lemma select_singleton_ev:
  "equiv_valid_inv I B (K (\<exists>a. A = {a})) (select A)"
  by (fastforce simp: equiv_valid_def2 equiv_valid_2_def select_def)

lemma thread_set_fault_pas_refined':
  "\<lbrace>pas_refined aag and pspace_aligned and valid_vspace_objs and valid_arch_state\<rbrace>
   thread_set (tcb_fault_update fault) thread
   \<lbrace>\<lambda>_. pas_refined aag\<rbrace>"
  by (wp thread_set_pas_refined | simp)+

(* FIXME MERGE names *)
lemmas thread_set_fault_empty_invs = thread_set_tcb_fault_reset_invs

lemma get_thread_state_rev:
  "reads_equiv_valid_inv A aag (K (aag_can_read aag ref)) (get_thread_state ref)"
  unfolding get_thread_state_def
  by (rule thread_get_rev)

lemma get_irq_slot_reads_respects:
  "reads_respects aag l (K (is_subject_irq aag irq)) (get_irq_slot irq)"
  unfolding get_irq_slot_def
  apply (rule equiv_valid_guard_imp)
   apply (rule gets_ev)
  apply (simp add: reads_equiv_def states_equiv_for_def equiv_for_def affects_equiv_def)
  apply (drule aag_can_read_irq_self)
  apply (simp)
  done

lemma thread_set_tcb_at:
  "\<lbrace>\<lambda>s. Q s\<rbrace> thread_set x ptr \<lbrace>\<lambda>_ s. P s\<rbrace>
   \<Longrightarrow> \<lbrace>\<lambda>s. tcb_at ptr s \<longrightarrow> Q s\<rbrace> thread_set x ptr \<lbrace>\<lambda>_ s. P s\<rbrace>"
  apply (rule use_spec(1))
  apply (case_tac "tcb_at ptr s")
   apply (clarsimp simp add: spec_valid_def valid_def)
  apply (simp add: spec_valid_def thread_set_def set_object_def[abs_def])
  apply (wp get_object_wp)
  apply (force simp: get_tcb_def obj_at_def is_tcb_def
              split: option.splits Structures_A.kernel_object.splits)
  done

(* FIXME: Why was the [wp] attribute on this lemma clobbered by interpretation of the Arch locale? *)
lemmas [wp] = thread_set_fault_valid_global_refs

lemma cancel_signal_owned_reads_respects:
  "reads_respects aag l
     (K (is_subject aag threadptr \<and> (aag_can_read aag ntfnptr \<or> aag_can_affect aag l ntfnptr)))
     (cancel_signal threadptr ntfnptr)"
  unfolding cancel_signal_def
  by (wp set_thread_state_owned_reads_respects set_simple_ko_reads_respects
         get_simple_ko_reads_respects hoare_drop_imps
      | wpc | simp)+

lemma as_user_get_register_reads_respects:
  "reads_respects aag l (K (is_subject aag thread)) (as_user thread (getRegister reg))"
  by (fastforce simp: equiv_valid_guard_imp[OF as_user_reads_respects] det_getRegister)

lemma update_restart_pc_reads_respects[wp]:
  assumes domains_distinct[wp]: "pas_domains_distinct aag"
  shows "reads_respects aag l (silc_inv aag s and K (is_subject aag thread))
                        (update_restart_pc thread)"
  unfolding update_restart_pc_def
  apply (subst as_user_bind)
  apply (wpsimp wp: as_user_set_register_reads_respects' as_user_get_register_reads_respects)
  done


context Finalise_IF_1 begin

lemma reply_cancel_ipc_reads_respects_f:
  assumes domains_distinct[wp]: "pas_domains_distinct aag"
  shows "reads_respects_f aag l (silc_inv aag st and pas_refined aag and invs
                                                 and tcb_at tptr and K (is_subject aag tptr))
                          (reply_cancel_ipc tptr)"
  unfolding reply_cancel_ipc_def
  apply (rule gen_asm_ev)
  apply (wp cap_delete_one_reads_respects_f_transferable[where st=st]
            select_singleton_ev select_inv assert_wp
            reads_respects_f[OF get_cap_rev, where st=st]
            reads_respects_f[OF thread_set_reads_respects, where st=st]
            reads_respects_f[OF gets_descendants_of_revrv[folded equiv_valid_def2]]
         | simp add: when_def split del: if_split | elim conjE)+
   apply (rule_tac Q="\<lambda> rv s. silc_inv aag st s \<and> invs s \<and> pas_refined aag s
                                                \<and> tcb_at tptr s \<and> is_subject aag tptr"
                in hoare_strengthen_post)
    apply (wp thread_set_tcb_fault_update_silc_inv hoare_vcg_imp_lift hoare_vcg_ball_lift
              thread_set_fault_empty_invs thread_set_fault_pas_refined'
           | wps | simp)+
   apply clarsimp apply (rule conjI,rule TrueI)
   apply clarsimp
   apply (frule(1) reply_cap_descends_from_master0)
   apply (frule all_children_subjectReads[THEN all_children_descendants_of],force,force)
   apply (fastforce simp: cte_wp_at_caps_of_state
                    elim: silc_inv_no_transferable'[where slot = "(a,b)" for a b,simplified])
  by fastforce

lemma cancel_ipc_reads_respects_f:
  assumes domains_distinct[wp]: "pas_domains_distinct aag"
  shows "reads_respects_f aag l (silc_inv aag st and pas_refined aag and invs and tcb_at t and
                          (K (is_subject aag t))) (cancel_ipc t)"
  unfolding cancel_ipc_def
  apply (wp reads_respects_f[OF blocked_cancel_ipc_reads_respects, where st=st and Q="\<top>"]
            reply_cancel_ipc_reads_respects_f[where st=st]
            reads_respects_f[OF cancel_signal_owned_reads_respects, where st=st and Q="\<top>"]
            reads_respects_f[OF get_thread_state_rev, where st=st and Q="\<top>"] gts_wp
         | wpc | simp add: blocked_cancel_ipc_def | erule conjE)+
  apply (clarsimp simp: st_tcb_at_def obj_at_def)
  apply (rule owns_thread_blocked_reads_endpoint)
      apply (simp add: st_tcb_at_def obj_at_def | blast)+
  done

lemma suspend_reads_respects_f:
  assumes domains_distinct[wp]: "pas_domains_distinct aag"
  shows "reads_respects_f aag l (silc_inv aag st and pas_refined aag and invs and tcb_at thread
                                                 and K (is_subject aag thread))
                          (suspend thread)"
  unfolding suspend_def
  apply (wp reads_respects_f[OF set_thread_state_owned_reads_respects, where st=st and Q="\<top>"]
            reads_respects_f[OF tcb_sched_action_reads_respects, where st=st and Q=\<top>]
            reads_respects_f[OF get_thread_state_rev, where st=st and Q="\<top>"]
            reads_respects_f[OF update_restart_pc_reads_respects, where st=st and Q="\<top>"]
            gts_wp set_thread_state_pas_refined | simp)+
    apply (wp cancel_ipc_reads_respects_f[where st=st] cancel_ipc_silc_inv)+
   apply clarsimp
   apply (wp hoare_allI hoare_drop_imps)
    apply clarsimp
    apply (wp cancel_ipc_silc_inv)+
  apply auto
  done

lemma deleting_irq_handler_reads_respects:
  assumes domains_distinct[wp]: "pas_domains_distinct aag"
  shows "reads_respects_f aag l (silc_inv aag st and invs and pas_refined aag
                                                 and K (is_subject_irq aag irq))
                          (deleting_irq_handler irq)"
  unfolding deleting_irq_handler_def
  by (wp cap_delete_one_reads_respects_f reads_respects_f[OF get_irq_slot_reads_respects]
      | simp | blast)+

lemma finalise_cap_reads_respects:
  assumes domains_distinct[wp]: "pas_domains_distinct aag"
  shows
    "reads_respects_f aag l
       (silc_inv aag st and pas_refined aag and invs and cte_wp_at ((=) cap) slot
                        and K (pas_cap_cur_auth aag cap)
                        and K (final \<longrightarrow> (case cap of EndpointCap r badge rights \<Rightarrow> is_subject aag r
                                                | NotificationCap r badge rights \<Rightarrow> is_subject aag r
                                                | _ \<Rightarrow> True)))
       (finalise_cap cap final)"
  apply (case_tac cap, simp_all split del: if_split)
             apply ((wp cancel_all_ipc_reads_respects cancel_all_signals_reads_respects
                        prepare_thread_delete_reads_respects_f
                        suspend_reads_respects_f[where st=st] deleting_irq_handler_reads_respects
                        unbind_notification_is_subj_reads_respects
                        unbind_maybe_notification_reads_respects
                        unbind_notification_invs unbind_maybe_notification_invs
                     | simp add: when_def invs_valid_objs invs_sym_refs aag_cap_auth_def
                                 cap_auth_conferred_def cap_rights_to_auth_def cap_links_irq_def
                                 aag_has_Control_iff_owns cte_wp_at_caps_of_state
                            split del: if_split
                     | rule aag_Control_into_owns_irq
                     | clarsimp split del: if_split
                     | rule conjI
                     | wp (once) reads_respects_f[where st=st]
                     | blast
                     | clarsimp
                     | force dest: caps_of_state_valid simp: valid_cap_def)+)[11]
  apply (rule equiv_valid_guard_imp)
  by (wp arch_finalise_cap_reads_respects reads_respects_f[where st=st] arch_finalise_cap_silc_inv
      | simp | elim conjE)+

end


lemma cap_swap_for_delete_reads_respects:
  "reads_respects aag l (K (is_subject aag (fst slot1) \<and> is_subject aag (fst slot2)))
                 (cap_swap_for_delete slot1 slot2)"
  unfolding cap_swap_for_delete_def
  apply (simp add: when_def)
  apply (rule conjI, rule impI)
   apply (rule equiv_valid_guard_imp)
    apply (wp cap_swap_reads_respects get_cap_rev)
   apply (simp)
  apply (rule impI, wp)
  done

lemma owns_cnode_owns_obj_ref_of_child_cnodes_threads_and_zombies:
  "\<lbrakk> pas_refined aag s; is_subject aag (fst slot); cte_wp_at ((=) cap) slot s;
     is_cnode_cap cap \<or> is_thread_cap cap \<or> is_zombie cap \<rbrakk>
     \<Longrightarrow> is_subject aag (obj_ref_of cap)"
  apply (frule (1) cap_cur_auth_caps_of_state[rotated])
   apply (simp add: cte_wp_at_caps_of_state)
  apply (clarsimp simp: aag_cap_auth_def)
  apply (case_tac cap, simp_all add: is_zombie_def)
    apply (drule_tac x=Control in bspec)
     apply (clarsimp simp: cap_auth_conferred_def)
    apply (erule (1) aag_Control_into_owns)
   apply (drule_tac x=Control in bspec)
    apply (clarsimp simp: cap_auth_conferred_def)
   apply (erule (1) aag_Control_into_owns)
  apply (drule_tac x=Control in bspec)
   apply (clarsimp simp: cap_auth_conferred_def)
  apply (erule (1) aag_Control_into_owns)
  done

lemmas only_timer_irq_inv_irq_state_independent_A[intro!] =
  irq_state_independent_A_only_timer_irq_inv

lemma rec_del_only_timer_irq:
  "\<lbrace>only_timer_irq_inv irq (st :: det_state)\<rbrace>
   rec_del call
   \<lbrace>\<lambda>_. only_timer_irq irq\<rbrace>"
  apply (simp add: only_timer_irq_inv_def)
  apply (rule hoare_pre, rule only_timer_irq_pres)
    apply (rule hoare_pre, wp rec_del_irq_masks)
    apply (wp rec_del_domain_sep_inv | force | rule hoare_pre, wp (once) rec_del_domain_sep_inv)+
  done

lemma rec_del_only_timer_irq_inv:
  "\<lbrace>only_timer_irq_inv irq (st :: det_state)\<rbrace>
   rec_del call
   \<lbrace>\<lambda>_. only_timer_irq_inv irq st\<rbrace>"
  apply (simp add: only_timer_irq_inv_def)
  apply (rule hoare_wp_simps)
  apply (rule hoare_conjI)
   apply (wp rec_del_domain_sep_inv rec_del_only_timer_irq | force simp: only_timer_irq_inv_def)+
  done

lemma set_cap_only_timer_irq_inv:
  "\<lbrace>only_timer_irq_inv irq (st :: det_state) and K (domain_sep_inv_cap False cap)\<rbrace>
   set_cap cap slot
   \<lbrace>\<lambda>_. only_timer_irq_inv irq st\<rbrace>"
  apply (simp add: only_timer_irq_inv_def)
  apply (wp only_timer_irq_pres set_cap_domain_sep_inv | force)+
  done

lemma finalise_cap_only_timer_irq_inv:
  "\<lbrace>only_timer_irq_inv irq (st :: det_state)\<rbrace>
   finalise_cap cap final
   \<lbrace>\<lambda>_. only_timer_irq_inv irq st\<rbrace>"
  apply (simp add: only_timer_irq_inv_def)
  apply (wp only_timer_irq_pres | force)+
  done


context Finalise_IF_1 begin

lemma rec_del_spec_reads_respects_f:
  assumes domains_distinct[wp]: "pas_domains_distinct aag"
  notes drop_spec_valid[wp_split del] drop_spec_validE[wp_split del]
        drop_spec_ev[wp_split del] rec_del.simps[simp del]
  shows
  "spec_reads_respects_f s aag l
     (silc_inv aag st and only_timer_irq_inv irq st' and einvs and simple_sched_action
                      and pas_refined aag and valid_rec_del_call call and emptyable (slot_rdcall call)
                      and (\<lambda>s. \<not> exposed_rdcall call
                               \<longrightarrow> ex_cte_cap_wp_to (\<lambda>cp. cap_irqs cp = {}) (slot_rdcall call) s)
                      and K (case call of CTEDeleteCall slot exposed \<Rightarrow> is_subject aag (fst slot)
                               | FinaliseSlotCall slot exposed \<Rightarrow> is_subject aag (fst slot)
                               | ReduceZombieCall cap slot exposed \<Rightarrow> is_subject aag (fst slot) \<and>
                                                                      is_subject aag (obj_ref_of cap)))
     (rec_del call)"
proof (induct s rule: rec_del.induct, simp_all only: rec_del_fails drop_spec_ev[OF fail_ev_pre])
  case (1 slot exposed s) show ?case
    apply (rule spec_equiv_valid_guard_imp)
     apply (simp add: rec_del.simps split_def when_def)
     apply (wp drop_spec_ev[OF returnOk_ev_pre] drop_spec_ev[OF liftE_ev] hoareE_TrueI
               reads_respects_f[OF empty_slot_reads_respects, where st=st] empty_slot_silc_inv)
      apply (rule "1.hyps")
     apply (rule_tac Q'="\<lambda>r s. silc_inv aag st s \<and> is_subject aag (fst slot)" in hoare_post_imp_R)
      apply (wp validE_validE_R'[OF rec_del_silc_inv_not_transferable] | fastforce simp: silc_inv_def)+
    done
next
  case (2 slot exposed s) show ?case
    apply (simp add: rec_del.simps)
    apply (rule spec_equiv_valid_guard_imp)
     apply (wp drop_spec_ev[OF returnOk_ev] drop_spec_ev[OF liftE_ev]
               set_cap_reads_respects_f "2.hyps" preemption_point_inv'
               drop_spec_ev[OF preemption_point_reads_respects_f[where st=st and st'=st']]
               validE_validE_R'[OF rec_del_silc_inv_not_transferable] rec_del_invs
               rec_del_respects(2) rec_del_only_timer_irq_inv
            | simp add: split_def split del: if_split | (rule irq_state_independent_A_conjI, simp)+)+
             apply (rule_tac
                    Q'="\<lambda>rv s. emptyable (slot_rdcall (ReduceZombieCall (fst rvb) slot exposed)) s \<and>
                               (\<not> exposed \<longrightarrow> ex_cte_cap_wp_to (\<lambda>cp. cap_irqs cp = {}) slot s) \<and>
                               is_subject aag (fst slot)" in hoare_post_imp_R)
              apply (wp rec_del_emptyable reduce_zombie_cap_to)
             apply simp
            apply (wp drop_spec_ev[OF liftE_ev] set_cap_reads_respects_f[where st=st]
                      set_cap_silc_inv[where st=st] | simp)+
           apply (wp replace_cap_invs set_cap_cte_wp_at set_cap_sets final_cap_same_objrefs
                     set_cap_cte_cap_wp_to  hoare_vcg_const_Ball_lift hoare_weak_lift_imp
                     drop_spec_ev[OF liftE_ev] finalise_cap_reads_respects set_cap_silc_inv
                     set_cap_only_timer_irq_inv set_cap_pas_refined_not_transferable
                  | simp add: cte_wp_at_eq_simp
                  | erule finalise_cap_not_reply_master[simplified Inr_in_liftE_simp])+
         apply (rule hoare_strengthen_post)
          apply (rule_tac
                 Q="\<lambda>fin s. silc_inv aag st s \<and> only_timer_irq_inv irq st' s
                         \<and> (\<not> cap_points_to_label aag (fst fin) (pasObjectAbs aag (fst slot))
                            \<longrightarrow> (\<exists>lslot. lslot \<in> slots_holding_overlapping_caps (fst fin) s \<and>
                                         pasObjectAbs aag (fst lslot) = SilcLabel))
                         \<and> einvs s \<and> replaceable s slot (fst fin) rv
                         \<and> cte_wp_at ((=) rv) slot s \<and> s \<turnstile> (fst fin)
                         \<and> ex_cte_cap_wp_to (appropriate_cte_cap rv) slot s
                         \<and> (\<forall>t\<in>obj_refs_ac (fst fin). halted_if_tcb t s)
                         \<and> pas_refined aag s
                         \<and> emptyable slot s
                         \<and> simple_sched_action s
                         \<and> pas_cap_cur_auth aag (fst fin)
                         \<and> is_subject aag (fst slot)
                         \<and> (case (fst fin) of Zombie _ _ _ \<Rightarrow> is_subject aag (obj_ref_of (fst fin))
                                                       | _ \<Rightarrow> True)
                         \<and> (is_zombie (fst fin) \<or> fst fin = NullCap)
                         \<and> (is_zombie (fst fin) \<or> fst fin = NullCap)" in hoare_vcg_conj_lift)
           apply (wp finalise_cap_replaceable Finalise_AC_1.finalise_cap_makes_halted
                     finalise_cap_invs finalise_cap_auth' finalise_cap_ret_is_subject finalise_cap_ret'
                     finalise_cap_silc_inv finalise_cap_ret_is_silc finalise_cap_only_timer_irq_inv)[1]
          apply (rule finalise_cap_cases[where slot=slot])
         apply (clarsimp simp: cte_wp_at_caps_of_state)
         apply (erule disjE)
          apply (clarsimp simp: cap_irq_opt_def cte_wp_at_def is_zombie_def gen_obj_refs_eq
                         split: cap.split_asm if_split_asm
                         elim!: ranE dest!: caps_of_state_cteD)
          apply (clarsimp cong: conj_cong simp: conj_comms)
          apply (rename_tac word option nat)
          apply (drule_tac s="{word}" in sym)
          apply (clarsimp simp: invs_psp_aligned invs_arch_state invs_vspace_objs)
          apply (rule conjI, fastforce)
          apply (clarsimp, rule conjI)
           apply (erule replaceable_zombie_not_transferable)(* WHY *)
          apply (rule conjI)
           apply (fastforce simp: silc_inv_def)
          apply (rule conjI)
           apply (fastforce simp: domain_sep_inv_def domain_sep_inv_cap_def only_timer_irq_inv_def)
          apply (rule conjI[rotated], force)
          apply (clarsimp simp: ex_cte_cap_wp_to_def)+
          apply (rule_tac x="a" in exI, rule_tac x="b" in exI)
          apply (clarsimp simp: cte_wp_at_def appropriate_cte_cap_def)
          apply (drule_tac x="cap" in fun_cong)
          apply (clarsimp simp: appropriate_cte_cap_def split: cap.splits)
         apply (clarsimp cong: conj_cong simp: conj_comms)
        apply (wp drop_spec_ev[OF liftE_ev] is_final_cap_reads_respects | simp)+
       apply (rule_tac Q="\<lambda>rva s. rva = is_final_cap' rv s \<and> cte_wp_at ((=) rv) slot s \<and>
                                  only_timer_irq_inv irq st' s \<and> silc_inv aag st s \<and>
                                  pas_refined aag s \<and> pas_cap_cur_auth aag rv \<and>
                                  invs s \<and> valid_list s \<and> valid_sched s \<and> simple_sched_action s \<and>
                                  s \<turnstile> rv \<and> is_subject aag (fst slot) \<and> emptyable slot s \<and>
                                  ex_cte_cap_wp_to (appropriate_cte_cap rv) slot s"
                    in hoare_strengthen_post)
        apply (wp is_final_cap_is_final | simp)+
       apply clarsimp
       apply (rule conjI)
        apply clarsimp
        apply (frule silc_inv)
        apply (erule_tac x=rv in allE, erule_tac x=slot in allE)
        apply simp
        apply (erule disjE)
         apply (drule(1) intra_label_capD)
         apply (clarsimp simp: cap_points_to_label_def split: cap.splits)
        apply (simp add: silc_inv_def)
       apply (force simp: owns_cnode_owns_obj_ref_of_child_cnodes_threads_and_zombies)
      apply (wp drop_spec_ev reads_respects_f[OF get_cap_rev, where st=st and Q="\<top>"] get_cap_wp
             | simp)+
    apply (clarsimp cong: conj_cong simp: invs_valid_objs invs_arch_state invs_psp_aligned)
    apply (intro conjI impI | clarsimp | assumption | fastforce dest: silc_inv_not_subject)+
      apply (erule (1) cap_cur_auth_caps_of_state[rotated])
      apply (simp add: cte_wp_at_caps_of_state)
     apply (fastforce dest: cte_wp_at_valid_objs_valid_cap simp: invs_valid_objs)
    apply (drule if_unsafe_then_capD)
      apply (simp add: invs_ifunsafe)
     apply simp
    apply (clarsimp simp: ex_cte_cap_wp_to_def)
    done
next
  case (3 ptr bits n slot s) show ?case
    apply (simp add: rec_del.simps)
    apply (rule spec_equiv_valid_guard_imp)
     apply (wp drop_spec_ev[OF liftE_ev] drop_spec_ev[OF returnOk_ev]
              reads_respects_f[OF cap_swap_for_delete_reads_respects] cap_swap_for_delete_silc_inv
              drop_spec_ev[OF assertE_ev])+
    apply (fastforce simp: silc_inv_def)
    done
next
  case (4 ptr bits n slot s) show ?case
    apply (simp add: rec_del.simps)
    apply (rule spec_equiv_valid_guard_imp)
     apply (wp drop_spec_ev[OF returnOk_ev] drop_spec_ev[OF liftE_ev] set_cap_reads_respects_f
               drop_spec_ev[OF assertE_ev] get_cap_wp "4.hyps"
               reads_respects_f[OF get_cap_rev, where st=st and Q="\<top>"]
               validE_validE_R'[OF rec_del_silc_inv_not_transferable]
            | simp add: in_monad)+
     apply (rule_tac Q'="\<lambda> _. silc_inv aag st and
                            K (pasObjectAbs aag (fst slot) \<noteq> SilcLabel \<and> is_subject aag (fst slot))"
                  in hoare_post_imp_R)
      prefer 2
      apply (clarsimp)
      apply (rule conjI, assumption)
      apply (rule impI)
      apply (drule silc_invD)
        apply assumption
       apply (simp add: intra_label_cap_def)
       apply (rule exI)
       apply (rule conjI)
        apply assumption
       apply (fastforce simp: cap_points_to_label_def)
      apply (clarsimp simp: slots_holding_overlapping_caps_def2 ctes_wp_at_def)
     apply (wp validE_validE_R'[OF rec_del_silc_inv_not_transferable] | simp)+
    apply (clarsimp simp: zombie_is_cap_toE cte_wp_at_caps_of_state zombie_ptr_emptyable silc_inv_def)
    done
qed

lemmas rec_del_reads_respects_f = use_spec_ev[OF rec_del_spec_reads_respects_f]

end


(* FIXME MOVE in lib *)
lemma ev_pre_cont:
  "equiv_valid I A B \<bottom> f"
  by (simp add: equiv_valid_def2 equiv_valid_2_def)

lemma finalise_cap_transferable_ev:
  "equiv_valid_inv I A (K(is_transferable_cap cap)) (finalise_cap cap final)"
  by (rule gen_asm_ev) (erule is_transferable_capE; wpsimp wp: return_ev)

lemma rec_del_Finalise_transferable_read_respects_f:
  "reads_respects_f aag l
     (silc_inv aag st and is_transferable_in slot and K(aag_can_read_not_silc aag (fst slot)))
     (rec_del (FinaliseSlotCall slot exposed))"
  apply (subst rec_del.simps[abs_def])
  apply (wp | wpc | simp)+
           apply ((wp ev_pre_cont hoare_pre_cont)+)[3]
        apply simp
        apply (wp liftE_ev finalise_cap_transferable_ev | simp)+
       apply (rule hoare_post_imp[OF _ finalise_cap_transferable[where P=\<top>]], fastforce)
      apply (wpsimp wp: is_final_cap_reads_respects hoare_drop_imp get_cap_wp
                        reads_respects_f[OF get_cap_rev, where st=st and Q="\<top>"])+
  by (fastforce simp: cte_wp_at_caps_of_state)

lemma rec_del_Finalise_transferableE_R:
  "\<lbrace>(\<lambda>s. is_transferable (caps_of_state s slot)) and P\<rbrace>
   rec_del (FinaliseSlotCall slot exposed)
   \<lbrace>\<lambda>_. P\<rbrace>, -"
  apply (rule hoare_pre)
   apply (simp add: validE_R_def)
   apply (rule hoare_post_impErr)
     apply (rule rec_del_Finalise_transferable)
  by force+


context Finalise_IF_1 begin

lemma rec_del_CTEDeleteCall_reads_respects_f:
  assumes domains_distinct[wp]: "pas_domains_distinct aag"
  shows
  "reads_respects_f aag l
     (silc_inv aag st and only_timer_irq_inv irq st' and einvs and simple_sched_action
                      and pas_refined aag and emptyable slot and cdt_change_allowed' aag slot
                      and (\<lambda>s. \<not> exposed \<longrightarrow> ex_cte_cap_wp_to (\<lambda>cp. cap_irqs cp = {}) slot s))
     (rec_del (CTEDeleteCall slot exposed))"
  apply (cases "is_subject aag (fst slot)")
   apply (rule equiv_valid_guard_imp)
   apply (wp rec_del_reads_respects_f)
   apply fastforce
  apply (subst rec_del.simps[abs_def])
  apply (wp when_ev reads_respects_f[OF empty_slot_reads_respects] empty_slot_silc_inv
            rec_del_Finalise_transferable_read_respects_f hoare_vcg_all_lift_R hoare_drop_impE_R
            rec_del_Finalise_transferableE_R
         | wpc | simp)+
  apply clarsimp
  apply (frule(3) cca_can_read[OF invs_mdb invs_valid_objs])
  apply (frule(2) cdt_change_allowed_not_silc[rotated 2], force, force)
  apply (frule(1) cca_to_transferable_or_subject[rotated 2], force, force)
  apply force
  done

lemma cap_delete_reads_respects:
  assumes domains_distinct[wp]: "pas_domains_distinct aag"
  shows
  "reads_respects_f aag l (silc_inv aag st and only_timer_irq_inv irq st' and einvs
                                           and simple_sched_action and pas_refined aag
                                           and emptyable slot and K (is_subject aag (fst slot)))
                    (cap_delete slot)"
  unfolding cap_delete_def
  by (wp rec_del_spec_reads_respects_f | rule use_spec_ev | simp | elim conjE | force)+

end


lemma globals_equiv_interrupt_states_update:
  "globals_equiv st (s\<lparr>interrupt_states := x\<rparr>) = globals_equiv st s"
  by (auto simp: globals_equiv_def idle_equiv_def)

lemma cancel_all_ipc_globals_equiv':
  "cancel_all_ipc epptr \<lbrace>globals_equiv st and valid_arch_state\<rbrace>"
  unfolding cancel_all_ipc_def
  by (wp mapM_x_wp[OF _ subset_refl] set_thread_state_globals_equiv
         set_simple_ko_globals_equiv hoare_vcg_all_lift get_object_inv dxo_wp_weak
      | wpc | simp | wp (once) hoare_drop_imps)+

lemma cancel_all_ipc_globals_equiv:
  "\<lbrace>globals_equiv st and valid_arch_state\<rbrace>
   cancel_all_ipc epptr
   \<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
  by (fastforce intro: hoare_strengthen_post[OF cancel_all_ipc_globals_equiv'])

crunch valid_global_objs: fast_finalise "valid_global_objs"
  (wp: crunch_wps dxo_wp_weak ignore: reschedule_required)

lemma cancel_all_signals_globals_equiv':
  "cancel_all_signals epptr \<lbrace>globals_equiv st and valid_arch_state\<rbrace>"
  unfolding cancel_all_signals_def
  by (wp mapM_x_wp[OF _ subset_refl] set_thread_state_globals_equiv
         set_simple_ko_globals_equiv hoare_vcg_all_lift get_object_inv dxo_wp_weak
      | wpc | simp | wp (once) hoare_drop_imps)+

lemma cancel_all_signals_globals_equiv:
  "\<lbrace>globals_equiv st and valid_arch_state\<rbrace>
   cancel_all_signals epptr
   \<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
  by (fastforce intro: hoare_strengthen_post[OF cancel_all_signals_globals_equiv'])


context Finalise_IF_1 begin

lemma unbind_notification_globals_equiv:
  "\<lbrace>globals_equiv st and valid_arch_state\<rbrace>
   unbind_notification t
   \<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
  unfolding unbind_notification_def
  by (wpsimp wp: gbn_wp set_bound_notification_globals_equiv set_notification_globals_equiv)

lemma unbind_maybe_notification_globals_equiv:
  "\<lbrace>globals_equiv st and valid_arch_state\<rbrace>
   unbind_maybe_notification a
   \<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
  unfolding unbind_maybe_notification_def
  by (wpsimp wp: gbn_wp set_bound_notification_globals_equiv
                 set_notification_globals_equiv get_simple_ko_wp)

lemma fast_finalise_globals_equiv:
  "\<lbrace>globals_equiv st and valid_arch_state\<rbrace>
   fast_finalise cap final
   \<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
  apply (cases cap)
  by (wpsimp wp: cancel_all_ipc_globals_equiv cancel_all_signals_globals_equiv
                    unbind_maybe_notification_globals_equiv
              simp: when_def split_del: if_split)+

crunch globals_equiv[wp]: deleted_irq_handler "globals_equiv st"

lemma empty_slot_globals_equiv:
  "\<lbrace>globals_equiv st and valid_arch_state\<rbrace> empty_slot s b \<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
  unfolding empty_slot_def post_cap_deletion_def
  by (wpsimp wp: set_cap_globals_equiv'' set_original_globals_equiv hoare_vcg_if_lift2
                 set_cdt_globals_equiv dxo_wp_weak hoare_drop_imps hoare_vcg_all_lift)

crunch globals_equiv: cap_delete_one "globals_equiv st"
  (wp: set_cap_globals_equiv'' hoare_drop_imps simp: crunch_simps unless_def)

(*FIXME: Lots of this stuff should be in arch *)
crunch globals_equiv[wp]: deleting_irq_handler "globals_equiv st"

crunch globals_equiv[wp]: cancel_ipc "globals_equiv st"
  (wp: mapM_x_wp select_inv hoare_drop_imps hoare_vcg_if_lift2 simp: unless_def)

lemma suspend_globals_equiv[ wp]:
  "\<lbrace>globals_equiv st and (\<lambda>s. t \<noteq> idle_thread s) and valid_arch_state\<rbrace>
   suspend t
   \<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
  unfolding suspend_def update_restart_pc_def
  apply (wp tcb_sched_action_extended.globals_equiv dxo_wp_weak)
       apply simp
      apply (wp set_thread_state_globals_equiv)
     apply wp+
    apply clarsimp
    apply (rule hoare_vcg_conj_lift)
     prefer 2
     apply (rule hoare_drop_imps)
     apply wp+
    apply (rule hoare_drop_imps)
    apply wp+
  apply auto
  done

crunches unbind_notification
  for valid_arch_state[wp]: valid_arch_state

lemma finalise_cap_globals_equiv:
  "\<lbrace>globals_equiv st and invs and valid_cap cap
                     and (\<lambda>s. \<forall>p. cap = ThreadCap p \<longrightarrow> p \<noteq> idle_thread s)\<rbrace>
   finalise_cap cap b
   \<lbrace>\<lambda> _. globals_equiv st\<rbrace>"
  apply (induct cap; simp)
  by (wp cancel_all_ipc_globals_equiv cancel_all_ipc_valid_global_objs
         cancel_all_signals_globals_equiv cancel_all_signals_valid_global_objs
         arch_finalise_cap_globals_equiv unbind_maybe_notification_globals_equiv
         unbind_notification_globals_equiv liftM_wp when_def
      | clarsimp simp: valid_cap_def | intro impI conjI)+

end

end