(*
 * Copyright 2014, NICTA
 *
 * This software may be distributed and modified according to the terms of
 * the GNU General Public License version 2. Note that NO WARRANTY is provided.
 * See "LICENSE_GPLv2.txt" for details.
 *
 * @TAG(NICTA_GPL)
 *)

theory Syscall_IF
imports
    "PasUpdates" (*Only needed for idle thread stuff*)
    "Tcb_IF"
    "Interrupt_IF"
    "Decode_IF"

begin

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

crunch_ignore (add: OR_choice set_scheduler_action)

(* The contents of the delete_globals_equiv locale *)

lemma globals_equiv_irq_state_update[simp]:
  "globals_equiv st
            (s\<lparr>machine_state := machine_state s
                 \<lparr>irq_state := f (irq_state (machine_state s))\<rparr>\<rparr>) =
          globals_equiv st s"
  apply(auto simp: globals_equiv_def idle_equiv_def)
  done

lemma cap_revoke_globals_equiv:
  "\<lbrace>globals_equiv st and invs\<rbrace> cap_revoke slot \<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
  apply (rule hoare_strengthen_post, rule validE_valid,
    rule cap_revoke_preservation_desc_of[where Q="\<lambda>_. emptyable"])
     apply (wp cap_delete_globals_equiv preemption_point_inv | simp
        | (auto simp: emptyable_def dest: reply_slot_not_descendant)[1])+
  done

lemma tcb_context_merge[simp]:
  "arch_tcb_context_get (tcb_arch (tcb_registers_caps_merge tcb tcb'))
    = arch_tcb_context_get (tcb_arch tcb)"
  apply (simp add: tcb_registers_caps_merge_def)
  done

lemma thread_set_globals_equiv':
  "\<lbrace>globals_equiv s and valid_ko_at_arm and (\<lambda>s. tptr \<noteq> idle_thread s)\<rbrace>
     thread_set f tptr
   \<lbrace>\<lambda>_. globals_equiv s\<rbrace>"
  unfolding thread_set_def
  apply(wp set_object_globals_equiv)
  apply simp
  apply (intro impI conjI allI)
  apply(fastforce simp: valid_ko_at_arm_def obj_at_def get_tcb_def)+
  done

crunch valid_global_objs[wp]: cap_move valid_global_objs
  (wp: cap_move_ext.valid_global_objs dxo_wp_weak)

lemma invoke_cnode_globals_equiv:
  "\<lbrace>globals_equiv st and invs and valid_cnode_inv cinv\<rbrace> invoke_cnode cinv \<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
  unfolding invoke_cnode_def without_preemption_def fun_app_def
  apply(rule hoare_pre)
   apply(wp | wpc)+
          apply(wp cap_insert_globals_equiv cap_move_globals_equiv cap_revoke_globals_equiv
                   cap_delete_globals_equiv cap_swap_globals_equiv hoare_vcg_all_lift
                   cancel_badged_sends_globals_equiv
                    | wpc | wp_once hoare_drop_imps | simp add: invs_valid_global_objs)+
  apply (case_tac cinv)
  apply (clarsimp simp: invs_valid_ko_at_arm | strengthen real_cte_emptyable_strg)+
done

(* The contents of the delete_confidentiality locale *)

lemma cap_delete_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 emptyable slot and pas_refined aag
         and cdt_change_allowed' aag slot)
     (cap_delete slot)"
  unfolding cap_delete_def by (wp rec_del_CTEDeleteCall_reads_respects_f) force


(* FIXME move *)
lemma spec_gen_asm:
  "(Q \<Longrightarrow> spec_equiv_valid st D A B P f) \<Longrightarrow> spec_equiv_valid st D A B (P and K Q) f"
  apply (simp add: spec_equiv_valid_def equiv_valid_2_def)
  done

(* FIXME move *)
lemma select_ev:
  "equiv_valid_inv I A (K(S \<noteq> {} \<longrightarrow> (\<exists>x. S = {x}))) (select S)"
  apply (clarsimp simp: equiv_valid_def spec_equiv_valid_def
                   equiv_valid_2_def select_def)
  apply blast
  done

lemma next_revoke_eq:
  notes split_paired_All[simp del] split_paired_Ex[simp del]
  shows
  "equiv_for ((aag_can_read aag or aag_can_affect aag l) \<circ> fst) cdt_list rv rv'
   \<Longrightarrow> is_subject aag (fst src_slot)
   \<Longrightarrow> next_revoke_cap src_slot rv = next_revoke_cap src_slot rv'"
  apply (clarsimp simp: next_child_def equiv_for_def next_revoke_cap_def)
  done

lemma next_revoke_eq':
  "reads_equiv_f aag s t \<Longrightarrow> is_subject aag (fst src_slot)
   \<Longrightarrow> next_revoke_cap src_slot s = next_revoke_cap src_slot t"
  apply (rule next_revoke_eq)
   apply (fastforce simp: reads_equiv_f_def reads_equiv_def2 states_equiv_for_def equiv_for_def)
  apply simp
  done

lemma cap_revoke_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]
        split_paired_All[simp del] split_paired_Ex[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 K (is_subject aag (fst slot)))
     (cap_revoke slot)"
  proof (induct rule: cap_revoke.induct[where ?a1.0=s])
  case (1 slot s)
  show ?case
    apply (rule spec_gen_asm)
    apply (rule spec_equiv_valid_guard_imp)
     apply (subst cap_revoke.simps)
     apply (subst spec_equiv_valid_def2)
     apply (subst rel_sum_comb_equals[symmetric])
     apply (rule_tac R'="(=)" in spec_equiv_valid_2_inv_bindE)
        apply(rule_tac R'="equiv_for ((aag_can_read aag or aag_can_affect aag l) \<circ> fst) id"
                    in spec_equiv_valid_2_inv_bindE)
        apply (rule_tac R'="(=)" in spec_equiv_valid_2_inv_bindE)
                 apply(simp add: rel_sum_comb_equals
                            del: Inr_in_liftE_simp without_preemption_def fun_app_def)
                 apply(rule spec_equiv_valid_2_inv_by_spec_equiv_valid[OF _ refl refl refl])
                 apply(wp whenE_spec_ev)
                           apply(rule "1.hyps")
                                    apply (assumption | erule | simp)+
                          apply(wp drop_spec_ev[OF preemption_point_reads_respects_f]
                                   drop_spec_ev[OF cap_delete_reads_respects_f[where st=st]]
                                   select_ext_ev
                                   preemption_point_inv'
                                   cap_delete_pas_refined cap_delete_silc_inv[where st=st]
                                   cap_delete_only_timer_irq_inv[where st=st' and irq=irq]
                                   drop_spec_ev[OF assertE_ev] drop_spec_ev[OF liftE_ev]
                                   get_cap_wp select_wp
                                   select_ev
                                   drop_spec_ev2_inv[OF liftE_ev2]
                                   reads_respects_f[OF get_cap_rev, where st=st and aag=aag]
        | simp (no_asm) add: returnOk_def | rule next_revoke_eq'
     | (simp add: pred_conj_def, erule conjE, assumption)
     | (rule irq_state_independent_A_conjI, simp)+)+
               apply (rule_tac P="K(all_children (\<lambda>x. aag_can_read aag (fst x)) rva)"
                           and P'="K(all_children (\<lambda>x. aag_can_read aag (fst x)) rv'a)"
                            in drop_spec_ev2_inv[OF return_ev2])
               apply simp
               apply (rule_tac P="\<lambda>x. aag_can_read aag (fst x)" in all_children_descendants_equal)
               apply (frule aag_can_read_self)
               apply (simp add: equiv_for_def split del: if_split)+
             apply (wp drop_spec_ev2_inv[OF liftE_ev2] gets_evrv | simp)+
     apply (wp drop_spec_ev2_inv[OF liftE_ev2] gets_evrv
               reads_respects_f[OF get_cap_rev, where st=st and aag=aag and Q="\<top>",
                                simplified equiv_valid_def2]
           | simp)+
    apply clarsimp
    apply (frule all_children_subjectReads[simplified comp_def])
    apply clarsimp
    apply (rule conjI)
     apply (force simp: reads_equiv_f_def intro: equiv_forI
                  elim: reads_equivE affects_equivE equiv_forD)
    apply clarsimp
    apply (rule conjI, erule(1) all_children_descendants_of, force)
    apply (clarsimp simp:conj_comms)
    apply (intro conjI;
           (subst emptyable_def,
            case_tac "next_revoke_cap slot s",
            force dest: reply_slot_not_descendant
           | force elim: all_children_descendants_of[OF cdt_change_allowed_all_children, rotated 2]))
  done
qed

lemmas cap_revoke_reads_respects_f = use_spec_ev[OF cap_revoke_spec_reads_respects_f]

lemma cancel_badged_sends_reads_respects_f:
  assumes domains_distinct: "pas_domains_distinct aag"
  shows
  "reads_respects_f aag l (silc_inv aag st and pas_refined aag and invs
                           and is_subject aag \<circ> cur_thread and
                           K (is_subject aag ptr))
   (cancel_badged_sends ptr badge)"
  apply (rule equiv_valid_guard_imp)
   apply (rule reads_respects_f)
    apply (rule cancel_badged_sends_reads_respects[OF domains_distinct])
   apply (wp cancel_badged_sends_silc_inv[where st=st] | simp | elim conjE, assumption)+
  apply (simp add: invs_valid_objs invs_sym_refs)
  done

lemma rec_del_subject_cur_thread:
  "\<lbrace>is_subject aag \<circ> cur_thread\<rbrace> rec_del call \<lbrace>\<lambda>_. is_subject aag \<circ> cur_thread\<rbrace>"
  apply (rule rec_del_preservation)
  apply (simp add: comp_def | wp preemption_point_inv)+
  done


lemma cap_revoke_only_timer_irq_inv:
  "\<lbrace>only_timer_irq_inv irq (st::det_ext state)\<rbrace>
   cap_revoke slot \<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 only_timer_irq_pres[where P="\<top>"] cap_revoke_irq_masks | force simp: only_timer_irq_inv_def)+
  done

lemma invoke_cnode_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 pas_refined aag and einvs
   and simple_sched_action
   and valid_cnode_inv ci and (\<lambda>s. is_subject aag (cur_thread s))
   and cnode_inv_auth_derivations ci
   and authorised_cnode_inv aag ci) (invoke_cnode ci)"
  unfolding invoke_cnode_def
  apply(rule equiv_valid_guard_imp)
  apply(wpc
       | wp reads_respects_f[OF cap_insert_reads_respects] cap_insert_silc_inv
            reads_respects_f[OF cap_move_reads_respects] cap_move_silc_inv
            cap_revoke_reads_respects_f cap_delete_reads_respects_f
            reads_respects_f[OF cap_swap_reads_respects] cap_swap_silc_inv
            cap_move_cte_wp_at_other reads_respects_f[OF get_cap_rev] get_cap_auth_wp
            cancel_badged_sends_reads_respects_f
       | simp add:when_def split del: if_split
       | elim conjE, assumption)+
  apply (clarsimp simp: cnode_inv_auth_derivations_def authorised_cnode_inv_def)
  apply (auto intro: real_cte_emptyable_strg[rule_format]
               simp: silc_inv_def reads_equiv_f_def requiv_cur_thread_eq
                     aag_cap_auth_recycle_EndpointCap
                     cte_wp_at_weak_derived_ReplyCap caps_of_state_cteD)
  done

lemma cap_swap_reads_respects_g:
  "reads_respects_g aag l (\<lambda>s. is_subject aag (fst slot1) \<and>
                          is_subject aag (fst slot2) \<and> valid_global_objs s)
  (cap_swap cap1 slot1 cap2 slot2)"
  apply(fastforce intro: equiv_valid_guard_imp[OF reads_respects_g] cap_swap_reads_respects doesnt_touch_globalsI cap_swap_globals_equiv)
  done

lemma cap_insert_reads_respects_g:
  "reads_respects_g aag l (\<lambda>s. is_subject aag (fst src_slot) \<and>
                          is_subject aag (fst dest_slot) \<and> valid_global_objs s)
  (cap_insert new_cap src_slot dest_slot)"
  apply(fastforce intro: equiv_valid_guard_imp[OF reads_respects_g] cap_insert_reads_respects doesnt_touch_globalsI cap_insert_globals_equiv)
  done

lemma cap_move_reads_respects_g:
  "reads_respects_g aag l (\<lambda>s. is_subject aag (fst src_slot) \<and>
                          is_subject aag (fst dest_slot) \<and> valid_global_objs s)
  (cap_move new_cap src_slot dest_slot)"
  apply(fastforce intro: equiv_valid_guard_imp[OF reads_respects_g] cap_move_reads_respects doesnt_touch_globalsI cap_move_globals_equiv)
  done

lemma get_cap_reads_respects_g:
  "reads_respects_g aag l (K (is_subject aag (fst cap))) (get_cap cap)"
using equiv_valid_guard_imp[OF reads_respects_g]
  apply(rule_tac Q1="\<top>" in equiv_valid_guard_imp[OF reads_respects_g])
    apply(wp get_cap_rev doesnt_touch_globalsI | simp)+
    done

lemma invoke_cnode_reads_respects_f_g:
  assumes domains_distinct: "pas_domains_distinct aag"
  shows
  "reads_respects_f_g aag l
  (silc_inv aag st and only_timer_irq_inv irq st' and pas_refined aag and einvs
   and simple_sched_action
   and valid_cnode_inv ci and (\<lambda>s. is_subject aag (cur_thread s))
   and cnode_inv_auth_derivations ci
   and authorised_cnode_inv aag ci) (invoke_cnode ci)"
  apply (rule equiv_valid_guard_imp)
   apply (rule reads_respects_f_g)
    apply (rule invoke_cnode_reads_respects_f[where st=st, OF domains_distinct])
   apply (rule doesnt_touch_globalsI)
   apply (wp invoke_cnode_globals_equiv)
   apply force+
  done


lemma arch_perform_invocation_reads_respects_g:
  assumes domains_distinct: "pas_domains_distinct aag"
  shows
  "reads_respects_g aag l (ct_active and K (authorised_arch_inv aag ai)
              and is_subject aag \<circ> cur_thread and pas_refined aag and invs
              and authorised_for_globals_arch_inv ai and valid_arch_inv ai)
    (arch_perform_invocation ai)"
  apply (rule equiv_valid_guard_imp)
   apply (rule reads_respects_g)
    apply (rule arch_perform_invocation_reads_respects[OF domains_distinct])
   apply (rule doesnt_touch_globalsI)
   apply (wp arch_perform_invocation_globals_equiv)
   apply (simp add: invs_valid_vs_lookup invs_def valid_state_def valid_pspace_def)+
  done

definition authorised_for_globals_inv :: "invocation \<Rightarrow> ('z::state_ext) state \<Rightarrow> bool" where
  "authorised_for_globals_inv oper \<equiv> \<lambda>s. case oper of InvokeArchObject ai \<Rightarrow> authorised_for_globals_arch_inv ai s | _ \<Rightarrow> True"

definition authorised_invocation_extra where
  "authorised_invocation_extra aag invo \<equiv> case invo of InvokeTCB ti \<Rightarrow> authorised_tcb_inv_extra aag ti | _ \<Rightarrow> True"

(* FIXME: MOVE *)
lemma reads_respects_f_g':
  "\<lbrakk>reads_respects_g aag l P f; \<lbrace>silc_inv aag st and Q\<rbrace> f \<lbrace>\<lambda>_. silc_inv aag st\<rbrace>\<rbrakk> \<Longrightarrow>
   reads_respects_f_g aag l (silc_inv aag st and P and Q) f"
  apply(clarsimp simp: equiv_valid_def2 equiv_valid_2_def reads_equiv_f_g_def reads_equiv_g_def)
  apply(rule conjI, fastforce)
  apply(rule conjI, fastforce)
  apply(rule conjI, fastforce)
  apply(subst conj_commute, rule conjI, fastforce)
  apply(rule silc_dom_equiv_trans)
   apply(rule silc_dom_equiv_sym)
   apply(rule silc_inv_silc_dom_equiv)
   apply(erule (1) use_valid, simp)
  apply(rule silc_inv_silc_dom_equiv)
  apply(erule (1) use_valid, simp)
  done

lemma invoke_domain_reads_respects_f_g:
  "reads_respects_f_g aag l \<bottom> (invoke_domain thread domain)"
by (clarsimp simp: equiv_valid_def spec_equiv_valid_def equiv_valid_2_def)

lemma perform_invocation_reads_respects_f_g:
  assumes domains_distinct[wp]: "pas_domains_distinct aag"
  shows
  "reads_respects_f_g aag l (
          silc_inv aag st
          and only_timer_irq_inv irq st'
          and pas_refined aag
          and pas_cur_domain aag
          and einvs and schact_is_rct and
          valid_invocation oper and ct_active
          and authorised_invocation aag oper
          and is_subject aag \<circ> cur_thread
          and authorised_for_globals_inv oper
          and K (authorised_invocation_extra aag oper))
    (perform_invocation blocking calling oper)"
proof (cases oper)
case InvokeUntyped
  then show ?thesis
    apply simp
    apply (rule equiv_valid_guard_imp)
     apply (wpc
            | simp
            | wp reads_respects_f_g'[OF invoke_untyped_reads_respects_g]
                 invoke_untyped_silc_inv
           )+
    by (simp add: authorised_invocation_def)
next
  case InvokeEndpoint
  then show ?thesis
    apply simp
    apply (rule equiv_valid_guard_imp)
     apply (wpc
            | simp
            | wp reads_respects_f_g'[OF send_ipc_reads_respects_g]
                 send_ipc_silc_inv
           )+
    by (fastforce intro: read_reply_thread_read_thread_rev[OF reads_lrefl]
                  simp: authorised_invocation_def reads_equiv_f_g_def)
next
  case InvokeNotification
  then show ?thesis
    apply simp
    apply (rule equiv_valid_guard_imp)
     apply (wpc
            | simp
            | wp reads_respects_f_g'[OF send_signal_reads_respects_g, where Q="\<top>"]
           )+
    by (fastforce simp: authorised_invocation_def valid_sched_def)
next
  case InvokeReply
  then show ?thesis
    apply simp
    apply (rule equiv_valid_guard_imp)
     apply (wpc
            | simp
            | wp do_reply_transfer_reads_respects_f_g
           )+
    by (fastforce intro: read_reply_thread_read_thread_rev[OF reads_lrefl] emptyable_cte_wp_atD
                  simp: reads_equiv_f_g_def authorised_invocation_def is_cap_simps
                  dest: emptyable_cte_wp_atD)
next
  case InvokeTCB
  then show ?thesis
    apply simp
    apply (rule equiv_valid_guard_imp)
     apply (wpc
            | simp
            | wp invoke_tcb_reads_respects_f_g
           )+
    by (fastforce simp: authorised_invocation_def authorised_invocation_extra_def)
next
  case InvokeDomain
  then show ?thesis
    apply simp
    apply (rule equiv_valid_guard_imp)
     apply (wpc
            | simp
            | wp invoke_domain_reads_respects_f_g
           )+
    by (simp add: authorised_invocation_def)
next
  case InvokeCNode
  then show ?thesis
    apply simp
    apply (rule equiv_valid_guard_imp)
     apply (wpc
            | simp
            | wp invoke_cnode_reads_respects_f_g
           )+
    by (fastforce simp: authorised_invocation_def)
next
  case InvokeIRQControl
  then show ?thesis
    apply simp
    apply (rule equiv_valid_guard_imp)
     apply (wpc
            | simp
            | wp reads_respects_f_g'[OF invoke_irq_control_reads_respects_g]
                 invoke_irq_control_silc_inv
           )+
    by (simp add: invs_def valid_state_def
                  authorised_invocation_def valid_arch_state_ko_at_arm)
next
  case InvokeIRQHandler
  then show ?thesis
    apply simp
    apply (rule equiv_valid_guard_imp)
     apply (wpc
            | simp
            | wp invoke_irq_handler_reads_respects_f_g
           )+
    by (fastforce simp: authorised_invocation_def)
next
  case InvokeArchObject
  then show ?thesis
    apply simp
    apply (rule equiv_valid_guard_imp)
     apply (wpc
            | simp
            | wp reads_respects_f_g'[OF arch_perform_invocation_reads_respects_g]
                 arch_perform_invocation_silc_inv
           )+
    by (fastforce simp: authorised_invocation_def authorised_for_globals_inv_def)
qed

crunch valid_ko_at_arm[wp]: reply_from_kernel "valid_ko_at_arm" (simp: crunch_simps)

lemma syscall_reads_respects_f_g:
  assumes reads_res_m_fault:
    "reads_respects_f_g aag l P m_fault"
  assumes reads_res_m_error:
    "\<And> v. reads_respects_f_g aag l (Q'' v) (m_error v)"
  assumes reads_res_h_fault:
    "\<And> v. reads_respects_f_g aag l (Q' v) (h_fault v)"
  assumes reads_res_m_finalise:
    "\<And> v. reads_respects_f_g aag l (R'' v) (m_finalise v)"
  assumes reads_res_h_error:
    "\<And> v. reads_respects_f_g aag l (R' v) (h_error v)"
  assumes m_fault_hoare:
    "\<lbrace> P \<rbrace> m_fault \<lbrace> case_sum Q' Q'' \<rbrace>"
  assumes m_error_hoare:
    "\<And> v. \<lbrace> Q'' v \<rbrace> m_error v \<lbrace> case_sum R' R'' \<rbrace>"
  shows "reads_respects_f_g aag l P (Syscall_A.syscall m_fault h_fault m_error h_error m_finalise)"
  unfolding Syscall_A.syscall_def without_preemption_def fun_app_def
  apply (wp assms equiv_valid_guard_imp[OF liftE_bindE_ev]
       | rule hoare_strengthen_post[OF m_error_hoare]
       | rule hoare_strengthen_post[OF m_fault_hoare]
       | wpc
       | fastforce)+
  done

(*FIXME: move *)
lemma syscall_requiv_f_g: "
  \<lbrakk>reads_respects_f_g aag l P m_fault;
 \<And>v. reads_respects_f_g aag l (R' v) (h_error v);
 \<And>v. reads_respects_f_g aag l (R'' v)
      (m_finalise v);

 \<And>v. reads_respects_f_g aag l (Q'' v) (m_error v);
 \<And>v. reads_respects_f_g aag l (Q' v) (h_fault v);

  \<And>v. \<lbrace>Q''' v\<rbrace> m_error v \<lbrace>R''\<rbrace>,\<lbrace>R'\<rbrace>;
 \<lbrace>P\<rbrace> m_fault \<lbrace>\<lambda>rv. Q'' rv and Q''' rv\<rbrace>,\<lbrace>Q'\<rbrace> \<rbrakk>
\<Longrightarrow> reads_respects_f_g aag l P
    (syscall m_fault h_fault m_error h_error m_finalise)"
  apply (rule syscall_reads_respects_f_g[where Q''="\<lambda>rv. Q'' rv and Q''' rv"])
  apply (unfold validE_def)
  apply (assumption)+
  apply (rule equiv_valid_guard_imp, assumption, simp)
  apply assumption+
  apply (rule hoare_strengthen_post)
  apply assumption
  apply (case_tac r)
  apply simp
  apply simp
  apply (rule hoare_strengthen_post, rule hoare_pre)
    apply assumption
   apply simp
  apply (case_tac r)
  apply simp+
done


(*FIXME: Move to base*)
lemma requiv_g_cur_thread_eq: "reads_equiv_g aag s t \<Longrightarrow> (cur_thread s) = (cur_thread t)"
  apply (frule reads_equiv_gD)
  apply (clarsimp simp add: requiv_cur_thread_eq)
done

(*Weird hack. Not sure why this is necessary. Something is getting
instantiated too early*)
lemma lookup_cap_and_slot_reads_respects_g':
  "
  reads_equiv_valid_g_inv (affects_equiv aag l) aag (pas_refined aag and K (is_subject aag param_a2) and P)
     (lookup_cap_and_slot param_a2 param_b3)"
  apply (rule equiv_valid_guard_imp)
  apply (rule lookup_cap_and_slot_reads_respects_g)
  apply simp
done

lemma sts_authorised_for_globals_inv: "\<lbrace>authorised_for_globals_inv oper\<rbrace> set_thread_state d f \<lbrace>\<lambda>r. authorised_for_globals_inv oper\<rbrace>"
  unfolding authorised_for_globals_inv_def
            authorised_for_globals_arch_inv_def
            authorised_for_globals_page_table_inv_def
            authorised_for_globals_page_inv_def
  apply (case_tac oper)
           apply (wp | simp)+
  apply (rename_tac arch_invocation)
  apply (case_tac arch_invocation)
      apply simp
      apply (rename_tac page_table_invocation)
      apply (case_tac page_table_invocation)
       apply wpsimp+
    apply (rename_tac page_invocation)
    apply (case_tac page_invocation)
        apply (simp | wp hoare_ex_wp)+
  done

lemma authorised_for_globals_triv:
  "\<forall> x y. f x \<noteq> InvokeArchObject y \<Longrightarrow>
  \<lbrace> \<top> \<rbrace> m \<lbrace> authorised_for_globals_inv \<circ> f \<rbrace>,-"
  apply(clarsimp simp: validE_R_def validE_def valid_def authorised_for_globals_inv_def split: invocation.splits sum.splits)
  done

lemma decode_invocation_authorised_globals_inv:
  "\<lbrace>cte_wp_at (diminished cap) slot and invs and
    (\<lambda>s. \<forall>x\<in>set excaps.
           cte_wp_at (diminished (fst x)) (snd x) s)\<rbrace>
    decode_invocation info_label args ptr slot cap excaps
   \<lbrace>\<lambda>rv. authorised_for_globals_inv rv\<rbrace>, -"
  unfolding decode_invocation_def
  apply (rule hoare_pre)
  apply wpc
             apply((wp authorised_for_globals_triv | wpc | simp add: uncurry_def)+)[11]
   apply (simp add: authorised_for_globals_inv_def)
   apply wp
   apply (unfold comp_def)
   apply simp
   apply (wp decode_arch_invocation_authorised_for_globals)
  apply (intro impI conjI allI | clarsimp simp add: authorised_for_globals_inv_def)+
  apply (erule_tac x="(a, aa, b)" in ballE)
  apply simp+
done

lemma set_thread_state_reads_respects_g:
  assumes domains_distinct: "pas_domains_distinct aag"
  shows
  "reads_respects_g aag l (is_subject aag \<circ> cur_thread and valid_ko_at_arm)
    (set_thread_state ref ts)"
  apply (rule equiv_valid_guard_imp)
   apply (rule reads_respects_g)
    apply (rule set_thread_state_reads_respects[OF domains_distinct])
   apply (rule doesnt_touch_globalsI)
   apply (rule set_thread_state_globals_equiv)
  apply simp
done

lemmas get_thread_state_reads_respects_g =
          reads_respects_g_from_inv[OF get_thread_state_rev get_thread_state_inv]

lemma decode_invocation_authorised_extra:
  "\<lbrace>K (is_subject aag (fst slot))\<rbrace>
   decode_invocation info_label args ptr slot cap excaps
   \<lbrace>\<lambda> rv s. authorised_invocation_extra aag rv\<rbrace>,-"
  unfolding decode_invocation_def authorised_invocation_extra_def
  apply(rule hoare_pre)
   apply(wp decode_tcb_invocation_authorised_extra | wpc | simp add: split_def o_def uncurry_def)+
  apply auto
  done

lemma sts_schact_is_rct_runnable:
  "\<lbrace>schact_is_rct and K(runnable b)\<rbrace>
      set_thread_state a b
   \<lbrace>\<lambda>_. schact_is_rct\<rbrace>"
  apply (simp add: set_thread_state_def
                   set_scheduler_action_def)
  apply (wpsimp wp: set_object_wp)
     apply (simp add: set_thread_state_ext_def)
     apply (wp modify_wp set_scheduler_action_wp gts_wp)
    apply (wpsimp wp: set_object_wp)
   apply wp
  apply (clarsimp simp: schact_is_rct_def st_tcb_at_def obj_at_def gets_the_def gets_def)
  done

lemma set_thread_state_only_timer_irq_inv:
  "\<lbrace>only_timer_irq_inv irq (st::det_ext state)\<rbrace>
   set_thread_state ref ts \<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




lemma ct_active_not_idle': "valid_idle s \<Longrightarrow> ct_active s \<Longrightarrow> cur_thread s \<noteq> idle_thread s"
  apply (clarsimp simp: invs_def valid_idle_def ct_in_state_def
                        pred_tcb_at_def obj_at_def)
  done

lemma ct_active_not_idle: "invs s \<Longrightarrow> ct_active s \<Longrightarrow> cur_thread s \<noteq> idle_thread s"
  apply (rule ct_active_not_idle')
  apply (simp add: invs_valid_idle)+
  done

lemma handle_invocation_reads_respects_g:
  assumes domains_distinct[wp]: "pas_domains_distinct aag"
  notes gts_st_tcb[wp del] gts_st_tcb_at[wp del]
  notes get_message_info_reads_respects_g = reads_respects_g_from_inv[OF get_message_info_rev get_mi_inv]
  shows "reads_respects_f_g aag l
           (silc_inv aag st and only_timer_irq_inv irq st' and einvs and schact_is_rct and ct_active and
            pas_refined aag and pas_cur_domain aag and is_subject aag \<circ> cur_thread and
            K (\<not> pasMaySendIrqs aag))
           (handle_invocation calling blocking)"
  apply (rule gen_asm_ev)
  apply (simp add: handle_invocation_def fun_app_def split_def)
  apply (wpc | simp add: tcb_at_st_tcb_at[symmetric] split del: if_split
            | intro impI | erule conjE
            | rule doesnt_touch_globalsI |

            (wp
            syscall_requiv_f_g gts_inv
            when_ev
            reads_respects_f_g'[OF lookup_extra_caps_reads_respects_g, where Q="\<top>" and st=st]
            reads_respects_f_g'[OF lookup_ipc_buffer_reads_respects_g, where Q="\<top>" and st=st]
            reads_respects_f_g'[OF cap_fault_on_failure_rev_g, where Q="\<top>" and st=st]
            valid_validE_R[OF wp_post_taut]
            lookup_ipc_buffer_has_read_auth'

            lookup_cap_and_slot_reads_respects_g' (*Weird*)
            decode_invocation_reads_respects_f_g
            get_mrs_reads_respects_g
            handle_fault_reads_respects_g
            reads_respects_f_g'[OF set_thread_state_reads_respects_g, where st=st and Q="\<top>"]
            reads_respects_f_g'[OF get_thread_state_reads_respects_g, where st=st and Q="\<top>"]
            reads_respects_f_g'[OF reads_respects_g[OF reply_from_kernel_reads_respects], where st=st and Q="\<top>"]
            get_thread_state_reads_respects_g
            perform_invocation_reads_respects_f_g
            set_thread_state_pas_refined
            sts_first_restart
            set_thread_state_ct_st
            lookup_extra_caps_authorised
            lookup_extra_caps_auth

            handle_fault_globals_equiv
            set_thread_state_globals_equiv
            reply_from_kernel_globals_equiv)+ | (rule hoare_drop_imps)
        )+

               apply (rule_tac Q'="\<lambda>r s. silc_inv aag st s \<and> invs s \<and> is_subject aag rv \<and> is_subject aag (cur_thread s) \<and> rv \<noteq> idle_thread s" in hoare_post_imp_R)
                apply (wp pinv_invs perform_invocation_silc_inv)
               apply (simp add: invs_def valid_state_def valid_pspace_def valid_arch_state_ko_at_arm)
              apply(wp reads_respects_f_g'[OF set_thread_state_reads_respects_g[OF domains_distinct], where Q="\<top>" and st=st] | simp)+

             apply (simp add: o_def|
                    wp when_ev
                       set_thread_state_only_timer_irq_inv[where st=st']
                       set_thread_state_reads_respects_g
                       set_thread_state_globals_equiv
                       sts_Restart_invs
                       set_thread_state_pas_refined
                       set_thread_state_ct_st
                       set_thread_state_runnable_valid_sched
                       sts_authorised_for_globals_inv
                       sts_schact_is_rct_runnable
                       decode_invocation_reads_respects_f_g
                       reads_respects_f_g'[OF get_mrs_reads_respects_g, where Q="\<top>" and st=st]
                       reads_respects_f_g'[OF handle_fault_reads_respects_g]
                       decode_invocation_authorised
                       decode_invocation_authorised_globals_inv
                       decode_invocation_authorised_extra
                       lec_valid_fault
                       lookup_extra_caps_authorised
                       lookup_extra_caps_auth
                       lookup_ipc_buffer_has_read_auth'
                       lookup_cap_and_slot_valid_fault3
                       lookup_cap_and_slot_authorised
                       lookup_cap_and_slot_cur_auth
                       reads_respects_f_g'[OF reads_respects_g[OF as_user_reads_respects], where Q="\<top>" and st=st] as_user_silc_inv
                       as_user_globals_equiv
                       user_getreg_inv
                       reads_respects_f_g'[OF get_message_info_reads_respects_g, where Q="\<top>" and st=st]
                       get_mi_inv
                       get_mi_length
                       get_mi_length'
              | rule doesnt_touch_globalsI
              | (clarify,assumption)
              | wp_once hoare_drop_imps
          )+
  apply (rule conjI)
   apply (clarsimp simp: requiv_g_cur_thread_eq simp: reads_equiv_f_g_conj)
  apply (clarsimp simp: getRegister_def invs_sym_refs invs_def valid_state_def valid_arch_state_ko_at_arm valid_pspace_vo valid_pspace_distinct)
  apply (rule context_conjI)
   apply (simp add: ct_active_not_idle')
  apply (clarsimp simp: valid_pspace_def ct_in_state_def)
  apply (rule conjI)
   apply(fastforce intro: reads_lrefl)
  apply(rule conjI, fastforce)+
  apply (simp add: conj_comms)
  apply (rule conjI)
   apply (clarsimp elim!: schact_is_rct_simple)
  apply (rule conjI)
   apply (rule st_tcb_ex_cap)
     apply simp+
   apply (case_tac "sta",clarsimp+)
  apply (force simp: only_timer_irq_inv_def runnable_eq_active)
  done

lemma delete_caller_cap_reads_respects_f:
  assumes domains_distinct: "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 (x, tcb_cnode_index 3)))) (delete_caller_cap x)"
  unfolding delete_caller_cap_def
  apply (rule cap_delete_one_reads_respects_f[OF domains_distinct])
  done

lemma delete_caller_cap_globals_equiv:
  "\<lbrace>globals_equiv st and valid_ko_at_arm\<rbrace> delete_caller_cap x \<lbrace>\<lambda>r. globals_equiv st\<rbrace>"
  unfolding delete_caller_cap_def
  apply (wp cap_delete_one_globals_equiv)
  done



lemma lookup_cap_cap_fault:
  "\<lbrace>invs\<rbrace> lookup_cap c b -, \<lbrace>\<lambda>f s. valid_fault (CapFault x y f)\<rbrace>"
  apply (simp add: lookup_cap_def)
  apply wp
    apply (case_tac xa)
    apply (simp add: validE_E_def)
    apply (wp)
   apply (fold validE_E_def)
   apply (wp lookup_slot_for_thread_cap_fault)
  apply assumption
  done

term "equiv_valid_inv (reads_equiv_f aag) (affects_equiv aag l) P f"

lemma cap_fault_on_failure_ev':
  "equiv_valid_inv (reads_equiv_f aag) A P f \<Longrightarrow>
       equiv_valid_inv (reads_equiv_f aag) A P (cap_fault_on_failure cptr rp f)"
  unfolding cap_fault_on_failure_def handleE'_def
  apply(wp | wpc | simp add: o_def)+
  done

lemma delete_caller_cap_valid_ep_cap[wp]:  "\<lbrace>(\<lambda>s. s \<turnstile> (EndpointCap a b c))\<rbrace> delete_caller_cap t \<lbrace>\<lambda>rv s. s \<turnstile> EndpointCap a b c\<rbrace>"
  apply (clarsimp simp: delete_caller_cap_def valid_cap_def)
  apply (rule hoare_pre)
   apply wp
  apply clarsimp
  done


lemma handle_recv_reads_respects_f:
  fixes st aag
  assumes domains_distinct[wp]: "pas_domains_distinct aag"
  notes mywp =
            domains_distinct
            cap_fault_on_failure_ev'
            receive_ipc_silc_inv[where st=st]
            reads_respects_f[OF receive_ipc_reads_respects, where st=st]
            delete_caller_cap_reads_respects_f[where st=st]
            delete_caller_cap_silc_inv[where st=st]
            reads_respects_f_inv[OF receive_signal_reads_respects receive_signal_silc_inv,
                                 where st=st]
            reads_respects_f[OF lookup_slot_for_thread_rev, where st=st and Q=\<top>]
            reads_respects_f_inv[OF get_cap_rev get_cap_inv, where st=st]
            get_cap_auth_wp[where aag=aag]
            reads_respects_f[OF get_simple_ko_reads_respects, where st=st and Q=\<top>]
            lookup_slot_for_thread_authorised
            get_simple_ko_wp
  shows
  "reads_respects_f aag l (silc_inv aag st and einvs and ct_active and
        pas_refined aag and pas_cur_domain aag and is_subject aag \<circ> cur_thread)
   (handle_recv is_blocking)"
  apply (simp add: handle_recv_def Let_def lookup_cap_def split_def)

  apply (wp mywp | wpc | assumption | simp | clarsimp
        | strengthen aag_can_read_self[where x ="fst(fst y)" for y])+
         apply (rule_tac Q'="\<lambda>r s. silc_inv aag st s \<and> einvs s \<and> pas_refined aag s \<and>
                                   tcb_at rv s \<and> pas_cur_domain aag s \<and>
                                   cte_wp_at \<top> (fst r) s \<and>
                                   is_subject aag rv \<and> is_subject aag (cur_thread s) \<and>
                                   is_subject aag (fst (fst r))"
                       in hoare_post_imp_R)
          apply ((wp lookup_slot_for_thread_authorised lookup_slot_cte_at_wp | simp)+)[1]
        apply (clarsimp simp: silc_inv_not_subject[symmetric] invs_mdb invs_valid_objs)
        subgoal by (auto intro: caps_of_state_valid reads_ep
                          simp: aag_cap_auth_def cap_auth_conferred_def cap_rights_to_auth_def)
        apply(wp reads_respects_f[OF handle_fault_reads_respects,where st=st])
        apply (wpsimp wp: get_simple_ko_wp get_cap_wp)+
        apply(rule VSpaceEntries_AI.hoare_vcg_all_liftE)
           apply (rule_tac Q="\<lambda>r s. silc_inv aag st s \<and> einvs s \<and> pas_refined aag s \<and>
                                     tcb_at rv s \<and> pas_cur_domain aag s \<and>
                                     is_subject aag rv \<and> is_subject aag (cur_thread s) \<and>
                                     is_subject aag (fst (fst r))"
                        and E=E and F=E for E in hoare_post_impErr)
              apply (wp lookup_slot_for_thread_authorised lookup_slot_for_thread_cap_fault)
         apply ((fastforce simp add:valid_fault_def)+)[3]
      apply (wp reads_respects_f[OF as_user_reads_respects,where st=st and Q=\<top>])
      apply simp
     apply (wp as_user_silc_inv[where st=st] | simp)+
  by (fastforce simp: det_getRegister invs_valid_objs tcb_at_invs)

lemma handle_recv_globals_equiv:
  "\<lbrace>globals_equiv (st :: det_state) and invs and ct_active\<rbrace>
     handle_recv is_blocking
   \<lbrace>\<lambda>r. globals_equiv st\<rbrace>"
  unfolding handle_recv_def
  apply (wp handle_fault_globals_equiv get_simple_ko_wp
        | wpc | simp add: Let_def)+
      apply (rule_tac Q="\<lambda>r s. invs s \<and> globals_equiv st s" and
                      E = "\<lambda>r s. valid_fault (CapFault (of_bl ep_cptr) True r)"
                   in hoare_post_impErr)
        apply (rule hoare_vcg_E_elim)
         apply (wp lookup_cap_cap_fault receive_ipc_globals_equiv
                   receive_signal_globals_equiv delete_caller_cap_invs
                   delete_caller_cap_globals_equiv
                | wpc
                | simp add: Let_def invs_imps invs_valid_idle valid_fault_def
                | rule_tac Q="\<lambda>rv s. invs s \<and> thread \<noteq> idle_thread s \<and> globals_equiv st s"
                           in hoare_strengthen_post,
                  wp,
                  clarsimp simp: invs_valid_objs invs_valid_global_objs invs_arch_state
                                 invs_distinct)+
     apply (rule_tac Q'="\<lambda>r s. invs s \<and> globals_equiv st s \<and> thread \<noteq> idle_thread s \<and>
                               tcb_at thread s \<and> cur_thread s = thread"
                  in hoare_post_imp_R)
      apply (wp as_user_globals_equiv | simp add: invs_imps valid_fault_def)+
    apply (wp delete_caller_cap_invs delete_caller_cap_globals_equiv
          | simp add: invs_imps invs_valid_idle ct_active_not_idle)+
  done

lemma handle_recv_reads_respects_f_g:
  assumes domains_distinct: "pas_domains_distinct aag"
  shows
  "reads_respects_f_g aag l (silc_inv aag st and einvs and ct_active and
        pas_refined aag and pas_cur_domain aag and is_subject aag \<circ> cur_thread)
     (handle_recv is_blocking)"
  apply (rule equiv_valid_guard_imp)
  apply (rule reads_respects_f_g)
  apply (wp handle_recv_reads_respects_f[where st=st, OF domains_distinct])
  apply (rule doesnt_touch_globalsI)
  apply (wp handle_recv_globals_equiv)
  apply simp+
  done


lemma dmo_return_reads_respects:
  "reads_respects aag l \<top> (do_machine_op (return ()))"
  apply (rule use_spec_ev)
  apply (rule do_machine_op_spec_reads_respects; wp)
  done

lemma dmo_return_globals_equiv:
  "\<lbrace>globals_equiv st\<rbrace> do_machine_op (return ()) \<lbrace>\<lambda>r .globals_equiv st\<rbrace>"
  by simp

lemma get_irq_slot_reads_respects':
  "reads_respects aag l (K(aag_can_read_label aag (pasIRQAbs 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)
  done


lemma get_irq_slot_can_read_from_slot:
  "\<lbrace>K(aag_can_read_label aag (pasIRQAbs aag irq)) and pas_refined aag\<rbrace>
     get_irq_slot irq
   \<lbrace>\<lambda>r. K(aag_can_read_label aag (pasObjectAbs aag (fst r)))\<rbrace>"
  unfolding get_irq_slot_def
  apply (wp gets_wp)
  apply (simp add: pas_refined_def policy_wellformed_def irq_map_wellformed_aux_def)
  done

lemma get_irq_state_rev':
  "reads_equiv_valid_inv A aag (K (aag_can_read_label aag (pasIRQAbs aag irq))) (get_irq_state irq)"
  unfolding get_irq_state_def
  apply(rule equiv_valid_guard_imp[OF gets_ev])
  apply(fastforce simp: reads_equiv_def2
                  elim: states_equiv_forE_interrupt_states
                 intro: aag_can_read_irq_self)
  done

lemma equiv_valid_vacuous:
  "equiv_valid_inv I A \<bottom> f"
  apply(clarsimp simp: equiv_valid_def2 equiv_valid_2_def)
  done

declare gts_st_tcb_at[wp del]

lemma handle_interrupt_globals_equiv:
  "\<lbrace>globals_equiv (st :: det_ext state) and invs\<rbrace> handle_interrupt irq \<lbrace>\<lambda>r. globals_equiv st\<rbrace>"
  unfolding handle_interrupt_def
  apply (rule hoare_if)
  apply (wp dmo_maskInterrupt_globals_equiv
            dmo_return_globals_equiv
            send_signal_globals_equiv
            dmo_ackInterrupt
            hoare_vcg_if_lift2
            hoare_drop_imps
            dxo_wp_weak
            Retype_IF.dmo_mol_globals_equiv
            no_fail_bind
            bind_known_operation_eq
            dmo_mol_globals_equiv
        | wpc
        | simp add: dmo_bind_valid
                    ackInterrupt_def
                    resetTimer_def
                    handle_reserved_irq_def
                    invs_imps invs_valid_idle)+

  done

end

axiomatization dmo_reads_respects where
  dmo_getDFSR_reads_respects: "reads_respects aag l \<top> (do_machine_op ARM.getDFSR)" and
  dmo_getFAR_reads_respects: "reads_respects aag l \<top> (do_machine_op ARM.getFAR)" and
  dmo_getIFSR_reads_respects: "reads_respects aag l \<top> (do_machine_op ARM.getIFSR)"

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

lemma handle_vm_fault_reads_respects:
  "reads_respects aag l (K(is_subject aag thread)) (handle_vm_fault thread vmfault_type)"
  apply (cases vmfault_type)
  apply (wp dmo_getDFSR_reads_respects dmo_getFAR_reads_respects
            dmo_getIFSR_reads_respects as_user_reads_respects
         | simp add: getRestartPC_def getRegister_def)+
  done

lemma handle_hypervisor_fault_reads_respects:
  "reads_respects aag l \<top> (handle_hypervisor_fault thread hypfault_type)"
  by (cases hypfault_type; wpsimp)

lemma handle_vm_fault_globals_equiv:
  "\<lbrace>globals_equiv st and valid_ko_at_arm and (\<lambda>s. thread \<noteq> idle_thread s)\<rbrace>
     handle_vm_fault thread vmfault_type
   \<lbrace>\<lambda>r. globals_equiv st\<rbrace>"
  apply (cases vmfault_type)
   apply (wp dmo_no_mem_globals_equiv | simp add: getDFSR_def getFAR_def getIFSR_def)+
  done

lemma handle_hypervisor_fault_globals_equiv:
  "\<lbrace>globals_equiv st\<rbrace> handle_hypervisor_fault thread hypfault_type \<lbrace>\<lambda>r. globals_equiv st\<rbrace>"
  by (cases hypfault_type; wpsimp)

lemma handle_vm_fault_reads_respects_g:
  "reads_respects_g aag l (K(is_subject aag thread) and (valid_ko_at_arm
                           and (\<lambda>s. thread \<noteq> idle_thread s)))
     (handle_vm_fault thread vmfault_type)"
  apply (rule reads_respects_g)
   apply (rule handle_vm_fault_reads_respects)
  apply (rule doesnt_touch_globalsI)
  apply (wp handle_vm_fault_globals_equiv)
  apply simp
  done

lemma handle_hypervisor_fault_reads_respects_g:
  "reads_respects_g aag l \<top> (handle_hypervisor_fault thread hyp)"
  apply (rule reads_respects_g[where P="\<top>" and Q="\<top>", simplified])
   apply (rule handle_hypervisor_fault_reads_respects)
  apply (rule doesnt_touch_globalsI)
  apply (wp handle_hypervisor_fault_globals_equiv)
  apply simp
  done

lemma irq_state_indepedent_top[simp, intro!]:
  "irq_state_independent (\<lambda>s. True)"
  apply(simp add: irq_state_independent_def)
  done

lemma handle_yield_reads_respects:
  assumes domains_distinct: "pas_domains_distinct aag"
  shows
  "reads_respects aag l (pas_refined aag) handle_yield"
  apply (simp add: handle_yield_def | wp domains_distinct tcb_sched_action_reads_respects)+
  apply (simp add: reads_equiv_def)
  done

crunch silc_inv[wp]: handle_yield "silc_inv aag st"

crunch globals_equiv[wp]: handle_yield "globals_equiv st" (wp: dxo_wp_weak ignore: reschedule_required)

lemma equiv_valid_hoist_guard:
  assumes a: "Q \<Longrightarrow> equiv_valid_inv I A P f"
  assumes b: "\<And> s. P s \<Longrightarrow> Q"
  shows "equiv_valid_inv I A P f"
  using assms apply(fastforce simp: equiv_valid_def2 equiv_valid_2_def)
  done

(* we explicitly exclude the case where ev is Interrupt since this is a scheduler action *)
lemma handle_event_reads_respects_f_g:
  assumes domains_distinct[wp]: "pas_domains_distinct aag"
  shows
  "reads_respects_f_g aag l (silc_inv aag st and only_timer_irq_inv irq st' and einvs
         and schact_is_rct and domain_sep_inv (pasMaySendIrqs aag) st'
         and (\<lambda>s. ev \<noteq> Interrupt \<and> (ct_active s)) and pas_refined aag and pas_cur_domain aag
         and is_subject aag \<circ> cur_thread and K (\<not> pasMaySendIrqs aag))
     (handle_event ev)"
  apply(rule gen_asm_ev)
  apply(rule_tac Q="ev \<noteq> Interrupt" in equiv_valid_hoist_guard)
   prefer 2
   apply fastforce
  apply (case_tac ev; simp)
    apply (rename_tac syscall)
    apply (case_tac syscall, simp_all add: handle_send_def handle_call_def)
          apply ((wp handle_invocation_reads_respects_g[simplified]
                  handle_recv_reads_respects_f_g[where st=st]
                  handle_reply_valid_sched
                  reads_respects_f_g[OF reads_respects_f[where st=st and aag=aag and Q=\<top>,
                                                         OF handle_yield_reads_respects]
                                        doesnt_touch_globalsI]
                  handle_reply_reads_respects_g handle_reply_silc_inv[where st=st]
                | simp add: invs_imps | rule equiv_valid_guard_imp | force)+)[8]
     apply ((wp reads_respects_f_g'[OF handle_fault_reads_respects_g, where st=st]
               | simp add: reads_equiv_f_g_conj
            | clarsimp simp: invs_imps requiv_g_cur_thread_eq schact_is_rct_simple
            | wpc | intro impI conjI allI)+)[3]
       apply (rule equiv_valid_guard_imp)
        apply ((wp reads_respects_f_g'[OF handle_vm_fault_reads_respects_g, where Q="\<top>" and st=st]
                   handle_vm_fault_silc_inv
               | simp)+)[1]
        prefer 2
        apply ((wp reads_respects_f_g'[OF handle_fault_reads_respects_g, where st=st] | simp)+)[1]
       prefer 2
       apply (simp add: validE_E_def)
       apply (rule_tac E="\<lambda>r s. invs s \<and> is_subject aag rv \<and> is_subject aag (cur_thread s)
                              \<and> valid_fault r \<and> pas_refined aag s \<and> pas_cur_domain aag s
                              \<and> silc_inv aag st s \<and> rv \<noteq> idle_thread s"
                   and Q="\<top>\<top>"
                    in hoare_post_impErr)
         apply (rule hoare_vcg_E_conj)
          apply (wp hv_invs handle_vm_fault_silc_inv)+
       apply (simp add: invs_imps invs_mdb invs_valid_idle)+
       apply wp+
   apply (clarsimp simp: requiv_g_cur_thread_eq reads_equiv_f_g_conj ct_active_not_idle)
  apply (wp reads_respects_f_g'[OF handle_fault_reads_respects_g, where st=st]
          | simp add: reads_equiv_f_g_conj
          | clarsimp simp: invs_imps requiv_g_cur_thread_eq schact_is_rct_simple
          | wpc | intro impI conjI allI)+
       apply (rule equiv_valid_guard_imp)
        apply ((wp reads_respects_f_g'[OF handle_hypervisor_fault_reads_respects_g,
                                       where Q="\<top>" and st=st]
                   handle_hypervisor_fault_silc_inv
               | simp)+)[1]
       prefer 2
       apply ((wp reads_respects_f_g'[OF handle_fault_reads_respects_g, where st=st] | simp)+)[1]
      apply (simp add: validE_E_def)
     apply (wp hv_invs handle_vm_fault_silc_inv)+
  apply (simp add: invs_imps invs_mdb invs_valid_idle)+
  apply (clarsimp simp: requiv_g_cur_thread_eq reads_equiv_f_g_conj ct_active_not_idle)
  done

lemma as_user_reads_respects_g:
  "reads_respects_g aag k (valid_ko_at_arm and (\<lambda>s. thread \<noteq> idle_thread s)
                           and K (det f \<and> is_subject aag thread))
     (as_user thread f)"
  apply (rule equiv_valid_guard_imp)
   apply (rule reads_respects_g)
    apply (rule as_user_reads_respects)
   apply (rule doesnt_touch_globalsI)
   apply (wp as_user_globals_equiv)
   apply simp+
  done

lemma setNextPC_det :
  "det (setNextPC rva)"
  apply (auto simp: det_def setNextPC_def setRegister_def modify_def get_def put_def bind_def)
  done


lemma get_thread_state_reads_respects':
  "reads_respects aag l (K(aag_can_read_label aag (pasObjectAbs aag thread))) (get_thread_state thread)"
  unfolding get_thread_state_def thread_get_def
  apply (wp | simp)+
  apply clarify
  apply (rule requiv_get_tcb_eq')
  apply simp+
  done

lemma activate_thread_reads_respects:
  assumes domains_distinct[wp]: "pas_domains_distinct aag"
  shows
  "reads_respects aag l (cur_tcb and (\<lambda>s. aag_can_read_label aag (pasObjectAbs aag (cur_thread s))))
     activate_thread"
  apply (simp add: activate_thread_def)
  apply (wp set_thread_state_runnable_reads_respects
            get_thread_state_reads_respects'
         | wpc
         | simp add: arch_activate_idle_thread_def
  )+
               apply (unfold as_user_def)
               apply (wp set_object_reads_respects
                         get_thread_state_reads_respects'
                      | simp add: setNextPC_def setRegister_def
                                  select_f_returns getRestartPC_def
                                  getRegister_def arch_activate_idle_thread_def
                                  tcb_at_st_tcb_at[symmetric] cur_tcb_def
                      | clarify
                      | rule hoare_drop_imps conjI
                             requiv_cur_thread_eq requiv_get_tcb_eq'
                      | clarsimp simp: st_tcb_at_def obj_at_def is_tcb_def
                      | simp split: Structures_A.kernel_object.split_asm)+
  done

lemma activate_thread_globals_equiv:
  "\<lbrace>globals_equiv st and valid_ko_at_arm and valid_idle\<rbrace>
     activate_thread
   \<lbrace>\<lambda> r. globals_equiv st\<rbrace>"
  unfolding activate_thread_def
  by (wp set_thread_state_globals_equiv gts_wp
     | wpc
     | clarsimp simp add: arch_activate_idle_thread_def valid_idle_def pred_tcb_at_def obj_at_def
     | rule hoare_vcg_conj_lift)+

lemma activate_thread_reads_respects_g:
  assumes domains_distinct: "pas_domains_distinct aag"
  shows
  "reads_respects_g aag l (invs and (\<lambda>s. aag_can_read_label aag (pasObjectAbs aag (cur_thread s))))
     activate_thread"
  apply (rule equiv_valid_guard_imp)
   apply (rule reads_respects_g)
    apply (rule activate_thread_reads_respects[OF domains_distinct])
   apply (rule doesnt_touch_globalsI)
   apply (rule hoare_pre)
   apply (rule activate_thread_globals_equiv)
   apply (simp add: invs_imps invs_valid_idle)+
  done

(*Globals equiv for top level events*)
lemma set_thread_state_ct_st':
  "\<lbrace>\<lambda>s. thread = cur_thread s \<and> P st\<rbrace> set_thread_state thread st \<lbrace>\<lambda>rv. ct_in_state P\<rbrace>"
  apply (rule hoare_pre)
   apply (rule set_thread_state_ct_st)
  apply simp
  done

crunch globals_equiv[wp]: invoke_domain "globals_equiv st"
  (wp: dxo_wp_weak ignore: reschedule_required set_domain)

lemma perform_invocation_globals_equiv:
  "\<lbrace>invs and ct_active and valid_invocation oper and globals_equiv (st :: det_ext state) and
    authorised_for_globals_inv oper \<rbrace>
    perform_invocation blocking calling oper
   \<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
  apply (cases oper;
         (rule hoare_pre,
          (wp invoke_untyped_globals_equiv
              send_ipc_globals_equiv
              send_signal_globals_equiv
              do_reply_transfer_globals_equiv
              invoke_tcb_globals_equiv
              invoke_cnode_globals_equiv
              invoke_irq_control_globals_equiv
              invoke_irq_handler_globals_equiv
              arch_perform_invocation_globals_equiv
          | wpc | simp)+;
          auto simp: invs_imps authorised_for_globals_inv_def))
  done

lemma handle_invocation_globals_equiv:
  "\<lbrace>invs and ct_active and globals_equiv st\<rbrace>
      handle_invocation calling blocking
   \<lbrace>\<lambda>_. globals_equiv (st::det_ext state)\<rbrace>"
  apply (simp add: handle_invocation_def ts_Restart_case_helper split_def
                   liftE_liftM_liftME liftME_def bindE_assoc)
  apply (wp syscall_valid handle_fault_globals_equiv
            reply_from_kernel_globals_equiv set_thread_state_globals_equiv
            hoare_vcg_all_lift
       | simp split del: if_split
       | wp_once hoare_drop_imps)+
        apply (rule_tac Q="\<lambda>r. invs and globals_equiv st and (\<lambda>s. thread \<noteq> idle_thread s)"
                    and E="\<lambda>_. globals_equiv st"
                     in hoare_post_impErr)
          apply (wp pinv_invs perform_invocation_globals_equiv
                    set_thread_state_ct_st' set_thread_state_globals_equiv
                    sts_authorised_for_globals_inv
                    decode_invocation_authorised_globals_inv
                | simp add: crunch_simps invs_imps)+
  apply (auto intro: st_tcb_ex_cap simp: ct_active_not_idle ct_in_state_def)
  done

lemma handle_fault_globals_equiv':
  "\<lbrace>invs and globals_equiv st and K(valid_fault ex)\<rbrace>
  handle_fault thread ex \<lbrace>\<lambda>_. globals_equiv st\<rbrace>"
  apply (rule hoare_pre)
   apply (rule handle_fault_globals_equiv)
  apply (simp add: invs_imps invs_valid_idle)
  done

lemma handle_event_globals_equiv:
  "\<lbrace>invs and (\<lambda>s. ev \<noteq> Interrupt \<longrightarrow> ct_active s) and globals_equiv st\<rbrace>
     handle_event ev
   \<lbrace>\<lambda>_. globals_equiv (st::det_ext state)\<rbrace>"
  apply (case_tac ev)
      apply (rule hoare_pre)
       apply (wp handle_invocation_globals_equiv
                 hoare_weaken_pre[OF receive_ipc_globals_equiv,
                       where P="globals_equiv st and invs" and st1=st]
                 hoare_weaken_pre[OF receive_signal_globals_equiv,
                       where P="globals_equiv st and invs" and s1=st]
                 handle_fault_globals_equiv'
                 handle_recv_globals_equiv
                 handle_reply_globals_equiv
                 handle_interrupt_globals_equiv
                 handle_vm_fault_globals_equiv
                 handle_hypervisor_fault_globals_equiv
             | wpc
             | simp add: handle_send_def handle_call_def Let_def
             | wp_once hoare_drop_imps
             | clarsimp simp: invs_imps invs_valid_idle ct_active_not_idle)+
  done

end

end
