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

theory Schedule_DR
imports Finalise_DR
begin

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

(* getActiveTCBs returns a subset of CapDL's all_active_tcbs. *)
lemma getActiveTCBs_subset:
  "\<lbrakk> getActiveTCB x s' = Some y; invs s'; valid_etcbs s' \<rbrakk> \<Longrightarrow>
   x \<in> all_active_tcbs (transform s')"
  supply option.case_cong[cong]
  apply (clarsimp simp: all_active_tcbs_def getActiveTCB_def)
  apply (clarsimp simp: transform_def transform_objects_def map_add_def domIff)
  apply (clarsimp dest!: get_tcb_SomeD split: option.splits if_split_asm)
  apply (rule context_conjI)
   apply (clarsimp simp: restrict_map_def)
   apply (frule invs_valid_idle)
   apply (clarsimp simp: valid_idle_def pred_tcb_def2 get_tcb_def)
  apply (clarsimp simp: restrict_map_def split: if_split_asm)
  apply (clarsimp simp: transform_object_def transform_tcb_def)
  apply (clarsimp simp: infer_tcb_pending_op_def)
  apply (frule(1) valid_etcbs_tcb_etcb)
  apply (case_tac "tcb_state y", auto simp: tcb_pending_op_slot_def tcb_boundntfn_slot_def)
  done

(* allActiveTCBs should be a subset of those allowed in CapDL. *)
definition
  allActiveTCBs_relation :: "cdl_object_id set \<Rightarrow> word32 set \<Rightarrow> bool"
where
  "allActiveTCBs_relation a b \<equiv> b \<subseteq> a"

(* allActiveTCBs correspond *)
lemma allActiveTCBs_corres:
  "dcorres allActiveTCBs_relation \<top> (invs and valid_etcbs) (gets all_active_tcbs) allActiveTCBs"
  apply (clarsimp simp: allActiveTCBs_def gets_def)
  apply (clarsimp simp: corres_underlying_def)
  apply (clarsimp simp: exec_get split_def return_def)
  apply (clarsimp simp: allActiveTCBs_relation_def)
  apply (auto simp: getActiveTCBs_subset)
  done

crunch idle_thread[wp]: switch_to_idle_thread "\<lambda>s. P (idle_thread s)"

lemma dcorres_arch_switch_to_idle_thread_return: "dcorres dc \<top> \<top> (return ()) arch_switch_to_idle_thread"
  apply (clarsimp simp: arch_switch_to_idle_thread_def)
  apply (rule corres_guard_imp)
    apply (rule dcorres_gets_all_param)
    apply (rule dcorres_set_vm_root)
   by simp+

lemma change_current_domain_same: "\<lbrace>(=) s\<rbrace> change_current_domain \<exists>\<lbrace>\<lambda>r. (=) s\<rbrace>"
  apply (clarsimp simp: change_current_domain_def exs_valid_def bind_def return_def gets_def modify_def put_def fst_def snd_def get_def select_def)
  apply (rule_tac x="cdl_current_domain s" in exI)
  apply clarsimp
  done

lemma switch_to_idle_thread_dcorres:
  "dcorres dc \<top> (invs and valid_etcbs) (Schedule_D.switch_to_thread None) switch_to_idle_thread"
   apply (clarsimp simp: Schedule_D.switch_to_thread_def switch_to_idle_thread_def)
   apply (rule dcorres_symb_exec_r)
   apply (rule corres_guard_imp)
      apply (rule corres_split_noop_rhs)
        apply (rule dcorres_arch_switch_to_idle_thread_return)
       apply (clarsimp simp: corres_underlying_def gets_def modify_def get_def put_def do_machine_op_def select_f_def split_def bind_def in_return)
       apply (clarsimp simp: transform_def transform_current_thread_def transform_asid_table_def)
       apply assumption
      apply (wp | simp)+
  done

(* Switching to the idle thread and switching to "None" are equivalent. *)
lemma change_current_domain_and_switch_to_idle_thread_dcorres:
  "dcorres dc \<top> (invs and valid_etcbs)
                (do _ \<leftarrow> change_current_domain;
                    Schedule_D.switch_to_thread None
                 od)
                switch_to_idle_thread"
  including no_pre
  apply (clarsimp simp: Schedule_D.switch_to_thread_def switch_to_idle_thread_def)
  apply (rule dcorres_symb_exec_r)
    apply (rule corres_guard_imp)
      apply (rule corres_symb_exec_l)
         apply (rule_tac R=\<top> in corres_split_noop_rhs)
           apply (rule dcorres_arch_switch_to_idle_thread_return)
          apply (clarsimp simp: corres_underlying_def gets_def modify_def get_def put_def do_machine_op_def select_f_def split_def bind_def in_return)
          apply (clarsimp simp: transform_def transform_current_thread_def transform_asid_table_def)
          apply assumption
         apply (wp change_current_domain_same | simp)+
  done

lemma arch_switch_to_thread_dcorres:
  "dcorres dc \<top> (invs and (\<lambda>s. idle_thread s \<noteq> t) and valid_etcbs)
     (return ())
     (arch_switch_to_thread t)"
  apply (clarsimp simp: arch_switch_to_thread_def)
  apply (rule corres_dummy_return_pl)
  apply (rule corres_guard_imp)
    apply (rule corres_split[OF dcorres_set_vm_root])
      apply simp
      apply (rule dcorres_machine_op_noop)
      apply (simp add: ARM.clearExMonitor_def, wp)[1]
      apply (wp|simp)+
  done

crunch idle_thread [wp]: arch_switch_to_thread "\<lambda>s. P (idle_thread s)"
  (simp: crunch_simps wp: crunch_wps ignore: ARM.clearExMonitor)

(*
 * Setting the current thread.
 *)
lemma switch_to_thread_corres:
  "dcorres dc \<top> (invs and (\<lambda>s. idle_thread s \<noteq> x) and valid_etcbs)
           (Schedule_D.switch_to_thread (Some x)) (Schedule_A.switch_to_thread x)"
  apply (clarsimp simp: Schedule_D.switch_to_thread_def Schedule_A.switch_to_thread_def)
  apply (rule corres_dummy_return_pl)
  apply (rule corres_symb_exec_r)
     apply (rule corres_symb_exec_r)
        apply (rule corres_guard_imp)
          apply (rule corres_split[OF arch_switch_to_thread_dcorres])
            apply simp
            apply (rule dcorres_rhs_noop_above[OF tcb_sched_action_dcorres])
              apply (rule corres_modify [where P=\<top> and P'="\<lambda>s. idle_thread s \<noteq> x"])
              apply (clarsimp simp: transform_def)
              apply (simp add: transform_current_thread_def transform_asid_table_def)
             apply (wp+)[4]
         apply simp
        apply assumption
       apply (clarsimp|wp)+
  done

lemma corrupt_intents_current_thread:
  "cdl_current_thread (corrupt_intents x p s) = cdl_current_thread s"
  by (simp add: corrupt_intents_def)

crunch cdl_cur: corrupt_frame "\<lambda>s. cdl_current_thread s = x"
  (wp: select_wp simp: corrupt_intents_current_thread)

(* Switching to the active thread has no effect. *)
lemma switch_to_thread_idempotent_corres:
  "dcorres dc (\<lambda>s. cdl_current_thread s = x) \<top> (Schedule_D.switch_to_thread x) (return ())"
  apply (clarsimp simp: Schedule_D.switch_to_thread_def)
  apply (clarsimp simp: modify_def)
  apply (clarsimp simp: corres_underlying_def)
  apply (clarsimp simp: transform_def transform_current_thread_def)
  apply (clarsimp simp: in_return)
  apply (auto simp: in_return get_def put_def split_def bind_def)[1]
  done

(* getActiveTCB on the idle thread always returns None. *)
lemma getActiveTCB_idle: "invs s \<Longrightarrow> getActiveTCB (idle_thread s) s = None"
  apply (frule invs_valid_idle)
  apply (clarsimp simp: valid_idle_def getActiveTCB_def)
  apply (clarsimp simp: pred_tcb_at_def get_tcb_def get_obj_def obj_at_def)
  done

lemma switch_to_thread_same_corres:
  "dcorres dc (\<lambda>s. x = y) (invs and (\<lambda>s. idle_thread s \<noteq> x) and valid_etcbs)
           (Schedule_D.switch_to_thread (Some y)) (Schedule_A.switch_to_thread x)"
  supply if_cong[cong]
  apply (clarsimp simp: Schedule_D.switch_to_thread_def
                        Schedule_A.switch_to_thread_def)
  apply (rule corres_dummy_return_pl)
  apply (rule corres_symb_exec_r)
     apply (rule corres_symb_exec_r)
        apply (rule corres_guard_imp)
          apply (rule corres_split[OF arch_switch_to_thread_dcorres])
            apply simp
            apply (rule dcorres_rhs_noop_above[OF tcb_sched_action_dcorres])
              apply (rule corres_modify [where P'="\<lambda>s. idle_thread s \<noteq> x"])
              apply (clarsimp simp: transform_def transform_current_thread_def transform_asid_table_def)
              apply (simp add: transform_current_thread_def transform_asid_table_def)
             apply (wp+)[4]
         apply simp
        apply assumption
       apply (clarsimp|wp)+
  done

lemma set_scheduler_action_dcorres:
   "dcorres dc \<top> \<top> (return ()) (set_scheduler_action sa)"
  by (clarsimp simp: corres_underlying_def set_scheduler_action_def modify_def get_def put_def bind_def return_def)

lemma switch_to_thread_None_dcorres_L:
   "dcorres dc (\<lambda>s. cdl_current_thread s = None) \<top>
               (do _ \<leftarrow> change_current_domain;
                   Schedule_D.switch_to_thread None
                od)
               (return ())"
  apply (auto simp: Schedule_D.switch_to_thread_def modify_def corres_underlying_def get_def put_def bind_def return_def
                    change_current_domain_def gets_def select_def transform_def)
  done

lemma switch_to_thread_None_dcorres:
  "dcorres dc \<top> (\<lambda>s. cur_thread s = idle_thread s)
                (do _ \<leftarrow> change_current_domain;
                    Schedule_D.switch_to_thread None
                 od)
               (return ())"
  apply (rule_tac Q="\<lambda>s. cdl_current_thread s = None" and Q'="\<top>" in stronger_corres_guard_imp)
    apply (rule switch_to_thread_None_dcorres_L)
   apply (clarsimp simp: transform_def transform_current_thread_def)+
  done

lemma schedule_resume_cur_thread_dcorres_L:
    "\<And>cur cur_ts. dcorres dc ((\<lambda>s. \<exists>t tcb. cdl_current_thread s = Some t \<and>
                                           (\<exists>d. s = s \<lparr>cdl_current_domain := d\<rparr>) \<and>
                                           t \<in> active_tcbs_in_domain (cdl_current_domain s) s)
                                   or (\<lambda>s. cdl_current_thread s = None)) \<top>
        Schedule_D.schedule
       (do idle_t \<leftarrow> gets idle_thread;
           assert (runnable cur_ts \<or> cur = idle_t)
         od)"
  unfolding Schedule_D.schedule_def
  apply (rule corres_either_alternate2)
   apply (rule corres_guard_imp)
     apply (rule corres_symb_exec_l_Ex)
     apply (clarsimp)
     apply (rule corres_symb_exec_l_Ex)
     apply (rule corres_symb_exec_l_Ex)
     apply (rule corres_symb_exec_l_Ex)
     apply (rule dcorres_symb_exec_r)
       apply (clarsimp simp: assert_def)
       apply (rule conjI, clarsimp)
        apply (fold dc_def)
        apply (rule switch_to_thread_idempotent_corres)
       apply (rule conjI, clarsimp)
        apply (rule switch_to_thread_idempotent_corres)
       apply (clarsimp simp: corres_underlying_def fail_def)
      apply (wp | simp)+
    apply (fastforce simp: select_def gets_def active_tcbs_in_domain_def bind_def return_def domIff
                           get_def fst_def modify_def put_def change_current_domain_def)
   apply simp
  apply (rule corres_guard_imp)
    apply (rule dcorres_symb_exec_r)
      apply (clarsimp simp: assert_def)
      apply (rule conjI, clarsimp)
       apply (rule switch_to_thread_None_dcorres_L)
      apply (rule conjI, clarsimp)
       apply (rule switch_to_thread_None_dcorres_L)
      apply (clarsimp simp: corres_underlying_def fail_def)
     apply (wp | simp | fastforce)+
  done

lemma schedule_resume_cur_thread_dcorres:
         "\<And>cur cur_ts. dcorres dc \<top> (\<lambda>s. cur = cur_thread s \<and> st_tcb_at ((=) cur_ts) cur s \<and> valid_etcbs s \<and> valid_sched s \<and> invs s \<and> scheduler_action s = resume_cur_thread)
        Schedule_D.schedule
       (do idle_t \<leftarrow> gets idle_thread;
           assert (runnable cur_ts \<or> cur = idle_t)
         od)"
  apply (rule stronger_corres_guard_imp)
    apply (rule schedule_resume_cur_thread_dcorres_L)
   apply (case_tac "cur \<noteq> idle_thread s'")
    apply (clarsimp simp: valid_sched_def valid_sched_action_def is_activatable_def invs_def valid_state_def
                          pred_tcb_at_def obj_at_def ct_in_cur_domain_def in_cur_domain_def)
    apply (frule(1) valid_etcbs_tcb_etcb)
    apply (auto simp: transform_def transform_current_thread_def all_active_tcbs_def transform_objects_def active_tcbs_in_domain_def etcb_at_def tcb_boundntfn_slot_def tcb_pending_op_slot_def
                          map_add_def restrict_map_def option_map_def transform_object_def transform_tcb_def valid_idle_def st_tcb_def2 get_tcb_def
                          transform_cnode_contents_def infer_tcb_pending_op_def transform_cap_def domIff st_tcb_at_kh_def obj_at_def only_idle_def
                    split: option.splits if_split Structures_A.kernel_object.splits Structures_A.thread_state.splits)[1]
     (* cur = idle_thread s' *)
   apply (subgoal_tac "cdl_current_thread s = None")
    apply (clarsimp simp: transform_def transform_current_thread_def)+
  done

lemma schedule_switch_thread_helper:
            "\<lbrakk> valid_etcbs s;
               valid_sched s;
               invs s;
               scheduler_action s = switch_thread t
             \<rbrakk>
             \<Longrightarrow> t \<in> active_tcbs_in_domain (cur_domain s) (transform s)"
  apply (clarsimp simp: valid_sched_def valid_sched_action_def weak_valid_sched_action_def is_activatable_def invs_def
                        valid_state_def pred_tcb_at_def obj_at_def switch_in_cur_domain_def in_cur_domain_def only_idle_def)
  apply (frule(1) valid_etcbs_tcb_etcb)
  apply (clarsimp simp: valid_idle_def pred_tcb_at_def)
  apply (drule_tac s="idle_thread s" in sym)
  apply (auto simp: transform_def transform_current_thread_def all_active_tcbs_def transform_objects_def active_tcbs_in_domain_def etcb_at_def
                        map_add_def restrict_map_def option_map_def transform_object_def transform_tcb_def valid_idle_def pred_tcb_at_def get_tcb_def tcb_pending_op_slot_def tcb_boundntfn_slot_def
                        transform_cnode_contents_def infer_tcb_pending_op_def transform_cap_def domIff st_tcb_at_kh_def obj_at_def only_idle_def
                  split: option.splits if_split Structures_A.kernel_object.splits Structures_A.thread_state.splits)
  done

lemma schedule_choose_new_thread_helper:
            "\<lbrakk> ready_queues s (cur_domain s) prio \<noteq> [];
               t = hd (ready_queues s (cur_domain s) prio);
               valid_sched_except_blocked s;
               invs s;
               scheduler_action s = choose_new_thread
             \<rbrakk>
             \<Longrightarrow> (\<exists>y. cdl_objects (transform s) t = Some y) \<and> t \<in> active_tcbs_in_domain (cur_domain s) (transform s)"
  apply (clarsimp simp: valid_sched_def valid_sched_action_def is_activatable_def invs_def
                        valid_state_def pred_tcb_at_def obj_at_def DetSchedInvs_AI.valid_queues_def
                        max_non_empty_queue_def only_idle_def)
  apply (erule_tac x="cur_domain s" in allE)
  apply (erule_tac x="prio" in allE)
  apply clarsimp
  apply (erule_tac x="hd (ready_queues s (cur_domain s) prio)" in ballE)
  apply (clarsimp simp: valid_idle_def pred_tcb_at_def)
  apply (drule_tac s="idle_thread s" in sym)
  apply (auto simp: transform_def transform_current_thread_def all_active_tcbs_def transform_objects_def active_tcbs_in_domain_def etcb_at_def
                       is_etcb_at_def
                        map_add_def restrict_map_def option_map_def transform_object_def transform_tcb_def valid_idle_def st_tcb_def2 get_tcb_def
                        transform_cnode_contents_def infer_tcb_pending_op_def transform_cap_def domIff st_tcb_at_kh_def obj_at_def only_idle_def tcb_pending_op_slot_def tcb_boundntfn_slot_def
                  split: option.splits if_split Structures_A.kernel_object.splits Structures_A.thread_state.splits)
  done

lemma idle_thread_not_in_queue:
  "\<lbrakk> valid_idle s; DetSchedInvs_AI.valid_queues s; ready_queues s d p \<noteq> [] \<rbrakk> \<Longrightarrow> idle_thread s \<noteq> hd (ready_queues s d p)"
  apply (clarsimp simp: valid_idle_def DetSchedInvs_AI.valid_queues_def pred_tcb_at_def obj_at_def)
  apply (erule_tac x="d" in allE)
  apply (erule_tac x="p" in allE)
  apply clarsimp
  apply (erule_tac x="idle_thread s" in ballE)
   apply clarsimp
  apply (frule hd_in_set)
  apply clarsimp
  done

lemma change_current_domain_dcorres: "dcorres dc \<top> \<top> change_current_domain next_domain"
  by (auto simp: corres_underlying_def change_current_domain_def next_domain_def bind_def return_def modify_def Let_def put_def select_def
                    get_def transform_def trans_state_def transform_objects_def transform_cdt_def transform_current_thread_def
                    transform_asid_table_def)

lemma max_set_not_empty:
  "\<And>x::'a::{linorder,finite}. f x \<noteq> [] \<Longrightarrow> f (Max {x. f x \<noteq> []}) \<noteq> []"
  apply (rule_tac S="{x. f x \<noteq> []}" in Max_prop)
   apply auto
  done

lemma next_domain_valid_sched_except_blocked[wp]:
  "\<lbrace> valid_sched_except_blocked and (\<lambda>s. scheduler_action s  = choose_new_thread)\<rbrace> next_domain \<lbrace> \<lambda>_. valid_sched_except_blocked \<rbrace>"
  apply (simp add: next_domain_def Let_def)
  apply (wp, simp add: valid_sched_def valid_sched_action_2_def ct_not_in_q_2_def)
  done

lemma schedule_def_2:
  "Schedule_D.schedule \<equiv> do
     change_current_domain;
     (do
       next_domain \<leftarrow> gets cdl_current_domain;
       threads     \<leftarrow> gets (active_tcbs_in_domain next_domain);
       next_thread \<leftarrow> select threads;
       Schedule_D.switch_to_thread (Some next_thread)
     od \<sqinter> Schedule_D.switch_to_thread None)
   od"
  unfolding Schedule_D.schedule_def
  apply (subst alternative_bind_distrib_2, simp)
  done

lemma schedule_choose_new_thread_dcorres:
  "dcorres dc \<top>
        (\<lambda>s. valid_etcbs s \<and> valid_sched_except_blocked s \<and> invs s \<and> scheduler_action s = choose_new_thread)
        Schedule_D.schedule
        schedule_choose_new_thread"
  unfolding schedule_choose_new_thread_def guarded_switch_to_def bind_assoc
            choose_thread_def max_non_empty_queue_def
  supply if_cong[cong]
  apply (rule dcorres_symb_exec_r, rename_tac dom_t)
    apply (case_tac "dom_t \<noteq> 0")
     apply (clarsimp)
     apply (rule dcorres_symb_exec_r, rename_tac cur_dom)
       apply (rule dcorres_symb_exec_r, rename_tac rq)
         apply (rule dcorres_rhs_noop_below_True[OF set_scheduler_action_dcorres])
         (* No threads in ready_queues *)
         apply (rule corres_guard_imp)
           apply (rule corres_if_rhs)
            apply (clarsimp simp: Schedule_D.schedule_def)
            apply (rule corres_alternate2)
            apply (rule change_current_domain_and_switch_to_idle_thread_dcorres)
           (* Threads in ready_queues *)
           apply (simp only: Schedule_D.schedule_def)
           apply (rule corres_alternate1)
           apply (rule dcorres_symb_exec_r)
             apply (rule dcorres_symb_exec_r)
               apply (rule_tac P'="\<lambda>s. ready_queues s (cur_domain s) = rq \<and> valid_etcbs s \<and> valid_sched_except_blocked s \<and> invs s \<and> scheduler_action s = choose_new_thread"
                               in stronger_corres_guard_imp)
                 apply (rule corres_symb_exec_l_Ex)
                 apply (clarsimp)
                 apply (rule corres_symb_exec_l_Ex)
                 apply (rule corres_symb_exec_l_Ex)
                 apply (rule corres_symb_exec_l_Ex)
                 apply (rule switch_to_thread_same_corres)
                apply clarsimp
                apply (frule_tac prio="(Max {prio. ready_queues s' (cur_domain s') prio \<noteq> []})" in schedule_choose_new_thread_helper,simp,simp,simp,simp,simp)
                apply (clarsimp simp: valid_sched_def DetSchedInvs_AI.valid_queues_def max_non_empty_queue_def)
                apply (auto simp: select_def gets_def get_def bind_def return_def active_tcbs_in_domain_def
                        invs_def valid_state_def valid_objs_def change_current_domain_def
                    Schedule_D.switch_to_thread_def modify_def put_def
                    option_map_def restrict_map_def map_add_def get_tcb_def
                    transform_def transform_current_thread_def cur_tcb_def tcb_at_def)[1]
               apply (clarsimp simp: invs_def valid_state_def valid_sched_def max_non_empty_queue_def)
               apply (frule_tac p="Max {prio. ready_queues s' (cur_domain s') prio \<noteq> []}" in idle_thread_not_in_queue,simp,simp)
               apply (clarsimp)
              apply (wp hoare_drop_imp| simp | clarsimp simp: valid_sched_def)+
          apply (frule max_set_not_empty, fastforce)
         apply (wp hoare_drop_imp| simp)+
    (* dom_t = 0 *)
    apply (simp only: schedule_def_2)
    apply (rule corres_guard_imp)
      apply (rule_tac P=\<top> and P'=\<top> and R="\<lambda>_. \<top>" and R'="\<lambda>_ s. valid_etcbs s \<and> valid_sched_except_blocked s \<and> invs s \<and> scheduler_action s = choose_new_thread"
              in corres_split)
         apply (rule change_current_domain_dcorres)
        apply (clarsimp)
        apply (rule dcorres_symb_exec_r)
          apply (rule dcorres_symb_exec_r, rename_tac rq)
            apply (fold dc_def, rule dcorres_rhs_noop_below_True[OF set_scheduler_action_dcorres])
            apply (rule corres_guard_imp)
              apply (rule corres_if_rhs)
               (* No threads in ready queues *)
               apply (rule corres_alternate2)
               apply (rule switch_to_idle_thread_dcorres)
              (* threads in ready queues *)
              apply (rule corres_alternate1)
              apply (rule dcorres_symb_exec_r)
                apply (rule dcorres_symb_exec_r)
                  apply (rule_tac P'="\<lambda>s. ready_queues s (cur_domain s) = rq \<and> valid_etcbs s \<and> valid_sched_except_blocked s \<and> invs s \<and> scheduler_action s = choose_new_thread"
                         in stronger_corres_guard_imp)
                    apply (rule corres_symb_exec_l_Ex)
                    apply (rule corres_symb_exec_l_Ex)
                    apply (rule corres_symb_exec_l_Ex)
                    apply (rule switch_to_thread_same_corres)
                   apply clarsimp
                   apply (frule_tac prio="(Max {prio. ready_queues s' (cur_domain s') prio \<noteq> []})" in schedule_choose_new_thread_helper,simp,simp,simp,simp,simp)
                   apply (clarsimp simp: invs_def valid_state_def valid_sched_def)
                   apply (auto simp: select_def gets_def get_def bind_def return_def active_tcbs_in_domain_def
                       invs_def valid_state_def valid_objs_def change_current_domain_def
                       Schedule_D.switch_to_thread_def modify_def put_def
                       option_map_def restrict_map_def map_add_def get_tcb_def
                       transform_def transform_current_thread_def cur_tcb_def tcb_at_def)[1]
                  apply (clarsimp simp: invs_def valid_state_def valid_sched_def max_non_empty_queue_def)
                  apply (frule_tac p="Max {prio. ready_queues s' (cur_domain s') prio \<noteq> []}" in idle_thread_not_in_queue,simp,simp)
                  apply (clarsimp)
                 apply (wp hoare_drop_imp | clarsimp)+
             apply (frule max_set_not_empty, fastforce)
            apply (wp hoare_drop_imp | clarsimp)+
            apply simp
           apply (wp | clarsimp)+
       unfolding dc_def
       apply (wp next_domain_valid_etcbs | simp)+
    apply (wp tcb_sched_action_transform | clarsimp simp: valid_sched_def)+
  done

lemma schedule_choose_new_thread_dcorres_fragment:
  "\<And>cur_ts cur. dcorres dc \<top>
        (\<lambda>s. cur = cur_thread s \<and> st_tcb_at ((=) cur_ts) cur s \<and> valid_etcbs s \<and> valid_sched s \<and> invs s \<and> scheduler_action s = choose_new_thread)
        Schedule_D.schedule
        (do y \<leftarrow> when (runnable cur_ts) (tcb_sched_action tcb_sched_enqueue cur);
            schedule_choose_new_thread
         od)"
  apply (rule dcorres_symb_exec_r)
    apply (rule corres_guard_imp)
      apply (rule schedule_choose_new_thread_dcorres)
     apply (wp tcb_sched_action_transform| simp add: valid_sched_def st_tcb_at_def obj_at_def not_cur_thread_def| clarsimp simp: transform_def)+
  done

lemma dcorres_If_both:
  "\<lbrakk> dcorres r P P' h m ;
     dcorres r P Q' h n \<rbrakk>
  \<Longrightarrow> dcorres r P (\<lambda>s. if b then P' s else Q' s) h (if b then m else n)"
  by (case_tac b; simp)

lemma set_scheduler_action_transform:
  "\<lbrace>\<lambda>ps. transform ps = cs\<rbrace> set_scheduler_action a \<lbrace>\<lambda>r s. transform s = cs\<rbrace>"
  by (clarsimp simp: set_scheduler_action_def etcb_at_def| wp )+

crunch valid_idle_etcb[wp]: set_scheduler_action valid_idle_etcb

(* RHS copy-pasted from schedule_dcorres switch_thread case *)
lemma schedule_switch_thread_dcorres:
      "dcorres dc \<top>
        (\<lambda>s. cur = cur_thread s \<and> st_tcb_at ((=) cur_ts) cur s \<and> valid_etcbs s \<and> valid_sched s
             \<and> invs s \<and> scheduler_action s = switch_thread target)
        Schedule_D.schedule
        (do y <- when (runnable cur_ts) (tcb_sched_action tcb_sched_enqueue cur);
            it <- gets idle_thread;
            target_prio <- ethread_get tcb_priority target;
            ct_prio <- ethread_get_when (cur \<noteq> it) tcb_priority cur;
            fastfail <- schedule_switch_thread_fastfail cur it ct_prio target_prio;
            cur_dom <- gets cur_domain;
            highest <- gets (is_highest_prio cur_dom target_prio);
            if fastfail \<and> \<not> highest then do y <- tcb_sched_action tcb_sched_enqueue target;
                                            y <- set_scheduler_action choose_new_thread;
                                            schedule_choose_new_thread
                                         od
            else if runnable cur_ts \<and> ct_prio = target_prio
                 then do y <- tcb_sched_action tcb_sched_append target;
                         y <- set_scheduler_action choose_new_thread;
                         schedule_choose_new_thread
                      od
                 else do y <- guarded_switch_to target;
                         set_scheduler_action resume_cur_thread
                      od
         od)" (is "dcorres _ _ (\<lambda>s. ?PRE s) _ _")
  supply ethread_get_wp[wp del]
  apply (rule dcorres_symb_exec_r)
    apply (rule dcorres_symb_exec_r)
      apply (rule dcorres_symb_exec_r)
        apply (rule dcorres_symb_exec_r)
          apply (rule dcorres_symb_exec_r)
            apply (rule dcorres_symb_exec_r)
              apply (rule dcorres_symb_exec_r)
                apply (rule dcorres_If_both)
                 apply (rule dcorres_symb_exec_r)
                   apply (rule dcorres_symb_exec_r)
                     apply simp
                     apply (rule schedule_choose_new_thread_dcorres)
                    apply (wp set_scheduler_action_transform tcb_sched_action_transform)+
                apply (rule dcorres_If_both)
                 apply (rule dcorres_symb_exec_r)
                   apply (rule dcorres_symb_exec_r)
                     apply simp
                     apply (rule schedule_choose_new_thread_dcorres)
                    apply (wp set_scheduler_action_transform tcb_sched_action_transform)+
                apply (simp add: Schedule_D.schedule_def guarded_switch_to_def bind_assoc)
                apply (rule corres_alternate1)
                apply (rule_tac P=\<top> and P'="?PRE" in stronger_corres_guard_imp)
                  apply (rule dcorres_symb_exec_r)
                    apply (rule dcorres_symb_exec_r)
                      apply (rule dcorres_rhs_noop_below_True[OF set_scheduler_action_dcorres])
                      apply (rule corres_symb_exec_l_Ex)
                      apply (rule corres_symb_exec_l_Ex)
                      apply (rule corres_symb_exec_l_Ex)
                      apply (rule corres_symb_exec_l_Ex)
                      apply (rule switch_to_thread_same_corres)
                     apply (wpsimp wp: gts_wp hoare_drop_imp)+
                 apply (frule schedule_switch_thread_helper, simp,simp,simp)
                 apply (fastforce simp: select_def gets_def get_def bind_def return_def
                                        active_tcbs_in_domain_def invs_def valid_state_def
                                        valid_objs_def change_current_domain_def
                                        Schedule_D.switch_to_thread_def modify_def put_def
                                        option_map_def restrict_map_def map_add_def get_tcb_def
                                        transform_def transform_current_thread_def cur_tcb_def
                                        tcb_at_def)
                apply (clarsimp)
                apply (frule invs_valid_idle)
                apply (fastforce simp: pred_tcb_at_def obj_at_def valid_idle_def valid_sched_def
                                       valid_sched_action_def weak_valid_sched_action_def)
               apply (wp tcb_sched_action_transform
                         hoare_drop_imp[where f="ethread_get tcb_priority x" for x]
                         hoare_drop_imp[where f="ethread_get_when b tcb_priority t" for b t]
                         hoare_drop_imp[where f="gets cur_domain"]
                      | clarsimp simp add: schedule_switch_thread_fastfail_def
                                 split del: if_split
                      | split if_split)+
   apply (fastforce elim: st_tcb_weakenE
                    simp: valid_sched_def valid_blocked_def valid_blocked_except_def
                          not_cur_thread_def valid_sched_action_def weak_valid_sched_action_def)
  apply (wp tcb_sched_action_transform, clarsimp)
  done

(*
 * The schedulers correspond.
 *
 * Most of the difficulties in this proof arise from needing to dance
 * around differences in switching to the idle thread: The CapDL spec
 * switches to "None", while the abstract spec switches to an actual
 * thread.
 *)

lemma schedule_dcorres:
  "dcorres dc \<top> (invs and valid_sched and valid_etcbs) Schedule_D.schedule Schedule_A.schedule"
  supply if_cong[cong]
  apply (clarsimp simp: Schedule_A.schedule_def)
  apply (rule dcorres_symb_exec_r)
    apply (rename_tac cur)
    apply (rule dcorres_symb_exec_r)
      apply (rename_tac cur_ts)
      apply (rule dcorres_symb_exec_r)
        apply (rename_tac "sa", case_tac "sa")
          (* sa = resume_cur_thread *)
          apply clarsimp
          apply (rule schedule_resume_cur_thread_dcorres)
         (* sa = switch_thread *)
         apply clarsimp
         apply (rule schedule_switch_thread_dcorres)
        (* sa = choose_new_thread *)
        apply clarsimp
        apply (rule schedule_choose_new_thread_dcorres_fragment)
       apply (wp gts_st_tcb | simp )+
  done

(*
 * The next few lemmas show that updating the register NextIP in the
 * tcb context of a thread does affect the state translation to capDL
 *)
lemma get_tcb_message_info_nextPC [simp]:
  "get_tcb_message_info (tcb_arch_update (tcb_context_update (\<lambda>ctx. ctx(NextIP := pc))) tcb) =
   get_tcb_message_info tcb"
  by (simp add: get_tcb_message_info_def
                arch_tcb_context_get_def
                msg_info_register_def
                ARM.msgInfoRegister_def)

lemma map_msg_registers_nextPC [simp]:
  "map ((tcb_context tcb)(NextIP := pc)) msg_registers =
   map (tcb_context tcb) msg_registers"
  by (simp add: msg_registers_def ARM.msgRegisters_def
                upto_enum_red fromEnum_def toEnum_def enum_register)

lemma get_ipc_buffer_words_nextPC [simp]:
  "get_ipc_buffer_words m (tcb_arch_update (tcb_context_update (\<lambda>ctx. ctx(NextIP := pc))) tcb) =
   get_ipc_buffer_words m tcb"
  by (rule ext) (simp add: get_ipc_buffer_words_def)

lemma get_tcb_mrs_nextPC [simp]:
  "get_tcb_mrs m (tcb_arch_update (tcb_context_update (\<lambda>ctx. ctx(NextIP := pc))) tcb) =
   get_tcb_mrs m tcb"
  by (simp add: get_tcb_mrs_def Let_def arch_tcb_context_get_def)

lemma transform_tcb_NextIP:
  "transform_tcb m t (tcb_arch_update (tcb_context_update (\<lambda>ctx. ctx(NextIP:= pc))) tcb)
  = transform_tcb m t tcb"
  by (auto simp add: transform_tcb_def transform_full_intent_def Let_def
                     cap_register_def ARM.capRegister_def
                     arch_tcb_context_get_def)

(*
 * setNextPC in the tcb context is not observable on the capDL level.
 *)
lemma as_user_setNextPC_corres:
  "dcorres dc \<top> \<top> (return x) (as_user t (setNextPC pc))"
  supply option.case_cong[cong]
  apply (clarsimp simp: corres_underlying_def gets_the_def
                   as_user_def setNextPC_def get_tcb_def
                   setRegister_def simpler_modify_def
                   select_f_def return_def in_monad
                   set_object_def get_object_def
                  split: option.splits Structures_A.kernel_object.splits)
  apply (subst tcb_context_update_aux)
  apply (simp add: transform_def transform_current_thread_def)
  apply (clarsimp simp: transform_objects_update_kheap_same_caps
                        transform_tcb_NextIP transform_objects_update_same
                        arch_tcb_update_aux3)
  done

crunch transform_inv[wp]: set_thread_state_ext "\<lambda>s. transform s = cs"

lemma dcorres_dummy_set_thread_state_runnable:
  "dcorres dc \<top>
  (not_idle_thread ptr and st_tcb_at (\<lambda>t. (infer_tcb_pending_op ptr t) = (infer_tcb_pending_op ptr st)) ptr)
  (return ())
  (set_thread_state ptr st)"
  supply option.case_cong[cong] if_cong[cong]
  apply (rule wp_to_dcorres)
  apply (clarsimp simp:set_thread_state_def not_idle_thread_def set_object_def get_object_def | wp)+
  apply (clarsimp simp:transform_def transform_current_thread_def st_tcb_at_def obj_at_def
       | rule ext)+
  apply (clarsimp simp:transform_objects_def not_idle_thread_def dest!:get_tcb_SomeD)
  apply (case_tac "x = ptr")
   apply (clarsimp simp:transform_tcb_def)
  apply (clarsimp simp:restrict_map_def Map.map_add_def)
  done

(*
 * Activating threads is not observable on the capDL level.
 *)
lemma activate_thread_corres:
  "dcorres dc \<top> (ct_in_state activatable and invs and valid_etcbs)
  (do t \<leftarrow> gets cdl_current_thread;
      case t of Some thread \<Rightarrow> do
       restart \<leftarrow> has_restart_cap thread;
       when restart $  KHeap_D.set_cap (thread,tcb_pending_op_slot) RunningCap
      od | None \<Rightarrow> return ()
  od)
  activate_thread"
  apply (simp add: activate_thread_def has_restart_cap_def gets_def bind_assoc)
  apply (rule dcorres_absorb_get_r)
  apply (rule dcorres_absorb_get_l)
  apply (simp add:get_thread_state_def bind_assoc thread_get_def)
  apply (rule dcorres_absorb_gets_the)
  apply (case_tac "cdl_current_thread (transform s'a) = None")
   apply (clarsimp simp: ct_in_state_def pred_tcb_at_def obj_at_def
     cdl_current_thread transform_current_thread_def valid_idle_def
     arch_activate_idle_thread_def
     split : if_splits dest!:get_tcb_SomeD invs_valid_idle)
  apply clarsimp
  apply (subgoal_tac "not_idle_thread (cur_thread s'b) s'b")
   prefer 2
   apply (clarsimp simp:transform_def transform_current_thread_def)
   apply (clarsimp simp:not_idle_thread_def)+
  apply (frule(1) valid_etcbs_get_tcb_get_etcb, clarsimp)
  apply (frule opt_object_tcb)
    apply simp
   apply simp
  apply (clarsimp simp:transform_tcb_def gets_def gets_the_def has_restart_cap_def
    get_thread_def bind_assoc cdl_current_thread transform_current_thread_def)
  apply (rule dcorres_absorb_get_l)
  apply (simp add:assert_opt_def when_def)
  apply (case_tac  "tcb_state obj'")
         apply (clarsimp simp:infer_tcb_pending_op_def tcb_pending_op_slot_def tcb_boundntfn_slot_def
           when_def pred_tcb_at_def ct_in_state_def obj_at_def
           dest!:get_tcb_SomeD)+
       apply (rule corres_guard_imp)
         apply (rule dcorres_symb_exec_r)
           apply (rule dcorres_symb_exec_r)
             apply (rule set_thread_state_corres[unfolded tcb_pending_op_slot_def])
            apply simp
            apply (wpsimp wp: dcorres_to_wp[OF as_user_setNextPC_corres,simplified])+
       apply (simp add:invs_mdb pred_tcb_at_def obj_at_def invs_valid_idle
         generates_pending_def not_idle_thread_def)
      apply (clarsimp simp:infer_tcb_pending_op_def arch_activate_idle_thread_def
             when_def pred_tcb_at_def ct_in_state_def obj_at_def tcb_pending_op_slot_def tcb_boundntfn_slot_def
             dest!:get_tcb_SomeD)+
  done

end

end


section \<open>Static backward slice\<close>

theory Slice imports SCDObservable Distance begin

context SDG begin

subsection \<open>Preliminary definitions on the parameter nodes for defining
  sliced call and return edges\<close>

fun csppa :: "'node \<Rightarrow> 'node SDG_node set \<Rightarrow> nat \<Rightarrow>
  ((('var \<rightharpoonup> 'val) \<Rightarrow> 'val option) list) \<Rightarrow> ((('var \<rightharpoonup> 'val) \<Rightarrow> 'val option) list)"
  where "csppa m S x [] = []"
  | "csppa m S x (f#fs) =
     (if Formal_in(m,x) \<notin> S then Map.empty else f)#csppa m S (Suc x) fs"

definition cspp :: "'node \<Rightarrow> 'node SDG_node set \<Rightarrow>
  ((('var \<rightharpoonup> 'val) \<Rightarrow> 'val option) list) \<Rightarrow> ((('var \<rightharpoonup> 'val) \<Rightarrow> 'val option) list)"
  where "cspp m S fs \<equiv> csppa m S 0 fs"

lemma [simp]: "length (cspp m S fs) = length fs"
by(simp add:cspp_def)

lemma csppa_Formal_in_notin_slice:
  "\<lbrakk>x < length fs; Formal_in(m,x + i) \<notin> S\<rbrakk>
  \<Longrightarrow> (csppa m S i fs)!x = Map.empty"
by(induct fs arbitrary:i x,auto simp:nth_Cons')

lemma csppa_Formal_in_in_slice:
  "\<lbrakk>x < length fs; Formal_in(m,x + i) \<in> S\<rbrakk>
  \<Longrightarrow> (csppa m S i fs)!x = fs!x"
by(induct fs arbitrary:i x,auto simp:nth_Cons')

definition map_merge :: "('var \<rightharpoonup> 'val) \<Rightarrow> ('var \<rightharpoonup> 'val) \<Rightarrow> (nat \<Rightarrow> bool) \<Rightarrow>
                         'var list \<Rightarrow> ('var \<rightharpoonup> 'val)"
where "map_merge f g Q xs \<equiv> (\<lambda>V. if (\<exists>i. i < length xs \<and> xs!i = V \<and> Q i) then g V
                                 else f V)"

definition rspp :: "'node \<Rightarrow> 'node SDG_node set \<Rightarrow> 'var list \<Rightarrow>
  ('var \<rightharpoonup> 'val) \<Rightarrow> ('var \<rightharpoonup> 'val) \<Rightarrow> ('var \<rightharpoonup> 'val)"
where "rspp m S xs f g \<equiv> map_merge f (Map.empty(ParamDefs m [:=] map g xs))
  (\<lambda>i. Actual_out(m,i) \<in> S) (ParamDefs m)"

lemma rspp_Actual_out_in_slice:
  assumes "x < length (ParamDefs (targetnode a))" and "valid_edge a"
  and "length (ParamDefs (targetnode a)) = length xs"
  and "Actual_out (targetnode a,x) \<in> S"
  shows "(rspp (targetnode a) S xs f g) ((ParamDefs (targetnode a))!x) = g(xs!x)"
proof -
  from \<open>valid_edge a\<close> have "distinct(ParamDefs (targetnode a))"
    by(rule distinct_ParamDefs)
  from \<open>x < length (ParamDefs (targetnode a))\<close>
    \<open>length (ParamDefs (targetnode a)) = length xs\<close>
    \<open>distinct(ParamDefs (targetnode a))\<close>
  have "(Map.empty(ParamDefs (targetnode a) [:=] map g xs))
    ((ParamDefs (targetnode a))!x) = (map g xs)!x"
    by(fastforce intro:fun_upds_nth)
  with \<open>Actual_out(targetnode a,x) \<in> S\<close> \<open>x < length (ParamDefs (targetnode a))\<close>
    \<open>length (ParamDefs (targetnode a)) = length xs\<close> show ?thesis
    by(fastforce simp:rspp_def map_merge_def)
qed

lemma rspp_Actual_out_notin_slice:
  assumes "x < length (ParamDefs (targetnode a))" and "valid_edge a"
  and "length (ParamDefs (targetnode a)) = length xs"
  and "Actual_out((targetnode a),x) \<notin> S"
  shows "(rspp (targetnode a) S xs f g) ((ParamDefs (targetnode a))!x) =
  f((ParamDefs (targetnode a))!x)"
proof -
  from \<open>valid_edge a\<close> have "distinct(ParamDefs (targetnode a))"
    by(rule distinct_ParamDefs)
  from \<open>x < length (ParamDefs (targetnode a))\<close>
    \<open>length (ParamDefs (targetnode a)) = length xs\<close>
    \<open>distinct(ParamDefs (targetnode a))\<close>
  have "(Map.empty(ParamDefs (targetnode a) [:=] map g xs))
    ((ParamDefs (targetnode a))!x) = (map g xs)!x"
    by(fastforce intro:fun_upds_nth)
  with \<open>Actual_out((targetnode a),x) \<notin> S\<close> \<open>distinct(ParamDefs (targetnode a))\<close>
    \<open>x < length (ParamDefs (targetnode a))\<close>
  show ?thesis by(fastforce simp:rspp_def map_merge_def nth_eq_iff_index_eq)
qed

subsection \<open>Defining the sliced edge kinds\<close>

primrec slice_kind_aux :: "'node \<Rightarrow> 'node \<Rightarrow> 'node SDG_node set \<Rightarrow>
  ('var,'val,'ret,'pname) edge_kind \<Rightarrow> ('var,'val,'ret,'pname) edge_kind"
where "slice_kind_aux m m' S \<Up>f = (if m \<in> \<lfloor>S\<rfloor>\<^bsub>CFG\<^esub> then \<Up>f else \<Up>id)"
  | "slice_kind_aux m m' S (Q)\<^sub>\<surd> = (if m \<in> \<lfloor>S\<rfloor>\<^bsub>CFG\<^esub> then (Q)\<^sub>\<surd> else
  (if obs_intra m \<lfloor>S\<rfloor>\<^bsub>CFG\<^esub> = {} then
    (let mex = (THE mex. method_exit mex \<and> get_proc m = get_proc mex) in
    (if (\<exists>x. distance m' mex x \<and> distance m mex (x + 1) \<and>
        (m' = (SOME mx'. \<exists>a'. m = sourcenode a' \<and>
                              distance (targetnode a') mex x \<and>
                              valid_edge a' \<and> intra_kind(kind a') \<and>
                              targetnode a' = mx')))
          then (\<lambda>cf. True)\<^sub>\<surd> else (\<lambda>cf. False)\<^sub>\<surd>))
     else (let mx = THE mx. mx \<in> obs_intra m \<lfloor>S\<rfloor>\<^bsub>CFG\<^esub> in
       (if (\<exists>x. distance m' mx x \<and> distance m mx (x + 1) \<and>
            (m' = (SOME mx'. \<exists>a'. m = sourcenode a' \<and>
                                  distance (targetnode a') mx x \<and>
                                  valid_edge a' \<and> intra_kind(kind a') \<and>
                                  targetnode a' = mx')))
          then (\<lambda>cf. True)\<^sub>\<surd> else (\<lambda>cf. False)\<^sub>\<surd>))))"
  | "slice_kind_aux m m' S (Q:r\<hookrightarrow>\<^bsub>p\<^esub>fs) = (if m \<in> \<lfloor>S\<rfloor>\<^bsub>CFG\<^esub> then (Q:r\<hookrightarrow>\<^bsub>p\<^esub>(cspp m' S fs))
                           else ((\<lambda>cf. False):r\<hookrightarrow>\<^bsub>p\<^esub>fs))"
  | "slice_kind_aux m m' S (Q\<hookleftarrow>\<^bsub>p\<^esub>f) = (if m \<in> \<lfloor>S\<rfloor>\<^bsub>CFG\<^esub> then
      (let outs = THE outs. \<exists>ins. (p,ins,outs) \<in> set procs in
         (Q\<hookleftarrow>\<^bsub>p\<^esub>(\<lambda>cf cf'. rspp m' S outs cf' cf)))
    else ((\<lambda>cf. True)\<hookleftarrow>\<^bsub>p\<^esub>(\<lambda>cf cf'. cf')))"

definition slice_kind :: "'node SDG_node set \<Rightarrow> 'edge \<Rightarrow>
  ('var,'val,'ret,'pname) edge_kind"
  where "slice_kind S a \<equiv>
  slice_kind_aux (sourcenode a) (targetnode a) (HRB_slice S) (kind a)"

definition slice_kinds :: "'node SDG_node set \<Rightarrow> 'edge list \<Rightarrow>
  ('var,'val,'ret,'pname) edge_kind list"
  where "slice_kinds S as \<equiv> map (slice_kind S) as"

lemma slice_intra_kind_in_slice:
  "\<lbrakk>sourcenode a \<in> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>; intra_kind (kind a)\<rbrakk>
  \<Longrightarrow> slice_kind S a = kind a"
by(fastforce simp:intra_kind_def slice_kind_def)

lemma slice_kind_Upd:
  "\<lbrakk>sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>; kind a = \<Up>f\<rbrakk> \<Longrightarrow> slice_kind S a = \<Up>id"
by(simp add:slice_kind_def)

lemma slice_kind_Pred_empty_obs_nearer_SOME:
  assumes "sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>" and "kind a = (Q)\<^sub>\<surd>"
  and "obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub> = {}"
  and "method_exit mex" and "get_proc (sourcenode a) = get_proc mex"
  and "distance (targetnode a) mex x" and "distance (sourcenode a) mex (x + 1)"
  and "targetnode a = (SOME n'. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                     distance (targetnode a') mex x \<and>
                                     valid_edge a' \<and> intra_kind(kind a') \<and>
                                     targetnode a' = n')"
  shows "slice_kind S a = (\<lambda>s. True)\<^sub>\<surd>"
proof -
  from \<open>method_exit mex\<close> \<open>get_proc (sourcenode a) = get_proc mex\<close>
  have "mex = (THE mex. method_exit mex \<and> get_proc (sourcenode a) = get_proc mex)"
    by(auto intro!:the_equality[THEN sym] intro:method_exit_unique)
  with \<open>sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>\<close> \<open>kind a = (Q)\<^sub>\<surd>\<close>
    \<open>obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub> = {}\<close>
  have "slice_kind S a =
    (if (\<exists>x. distance (targetnode a) mex x \<and> distance (sourcenode a) mex (x + 1) \<and>
    (targetnode a = (SOME mx'. \<exists>a'. sourcenode a = sourcenode a' \<and>
    distance (targetnode a') mex x \<and> valid_edge a' \<and> intra_kind(kind a') \<and>
    targetnode a' = mx'))) then (\<lambda>cf. True)\<^sub>\<surd> else (\<lambda>cf. False)\<^sub>\<surd>)"
    by(simp add:slice_kind_def Let_def)
  with \<open>distance (targetnode a) mex x\<close> \<open>distance (sourcenode a) mex (x + 1)\<close>
    \<open>targetnode a = (SOME n'. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                     distance (targetnode a') mex x \<and>
                                     valid_edge a' \<and> intra_kind(kind a') \<and>
                                     targetnode a' = n')\<close>
  show ?thesis by fastforce
qed

lemma slice_kind_Pred_empty_obs_nearer_not_SOME:
  assumes "sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>" and "kind a = (Q)\<^sub>\<surd>"
  and "obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub> = {}"
  and "method_exit mex" and "get_proc (sourcenode a) = get_proc mex"
  and "distance (targetnode a) mex x" and "distance (sourcenode a) mex (x + 1)"
  and "targetnode a \<noteq> (SOME n'. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                     distance (targetnode a') mex x \<and>
                                     valid_edge a' \<and> intra_kind(kind a') \<and>
                                     targetnode a' = n')"
  shows "slice_kind S a = (\<lambda>s. False)\<^sub>\<surd>"
proof -
  from \<open>method_exit mex\<close> \<open>get_proc (sourcenode a) = get_proc mex\<close>
  have "mex = (THE mex. method_exit mex \<and> get_proc (sourcenode a) = get_proc mex)"
    by(auto intro!:the_equality[THEN sym] intro:method_exit_unique)
  with \<open>sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>\<close> \<open>kind a = (Q)\<^sub>\<surd>\<close>
    \<open>obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub> = {}\<close>
  have "slice_kind S a =
    (if (\<exists>x. distance (targetnode a) mex x \<and> distance (sourcenode a) mex (x + 1) \<and>
    (targetnode a = (SOME mx'. \<exists>a'. sourcenode a = sourcenode a' \<and>
    distance (targetnode a') mex x \<and> valid_edge a' \<and> intra_kind(kind a') \<and>
    targetnode a' = mx'))) then (\<lambda>cf. True)\<^sub>\<surd> else (\<lambda>cf. False)\<^sub>\<surd>)"
    by(simp add:slice_kind_def Let_def)
  with \<open>distance (targetnode a) mex x\<close> \<open>distance (sourcenode a) mex (x + 1)\<close>
    \<open>targetnode a \<noteq> (SOME n'. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                     distance (targetnode a') mex x \<and>
                                     valid_edge a' \<and> intra_kind(kind a') \<and>
                                     targetnode a' = n')\<close>
  show ?thesis by(auto dest:distance_det)
qed

lemma slice_kind_Pred_empty_obs_not_nearer:
  assumes "sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>" and "kind a = (Q)\<^sub>\<surd>"
  and "obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub> = {}"
  and "method_exit mex" and "get_proc (sourcenode a) = get_proc mex"
  and dist:"distance (sourcenode a) mex (x + 1)" "\<not> distance (targetnode a) mex x"
  shows "slice_kind S a = (\<lambda>s. False)\<^sub>\<surd>"
proof -
  from \<open>method_exit mex\<close> \<open>get_proc (sourcenode a) = get_proc mex\<close>
  have "mex = (THE mex. method_exit mex \<and> get_proc (sourcenode a) = get_proc mex)"
    by(auto intro!:the_equality[THEN sym] intro:method_exit_unique)
  moreover
  from dist have "\<not> (\<exists>x. distance (targetnode a) mex x \<and>
                            distance (sourcenode a) mex (x + 1))"
    by(fastforce dest:distance_det)
  ultimately show ?thesis using assms by(auto simp:slice_kind_def Let_def)
qed

lemma slice_kind_Pred_obs_nearer_SOME:
  assumes "sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>" and "kind a = (Q)\<^sub>\<surd>"
  and "m \<in> obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>"
  and "distance (targetnode a) m x" "distance (sourcenode a) m (x + 1)"
  and "targetnode a = (SOME n'. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                     distance (targetnode a') m x \<and>
                                     valid_edge a' \<and> intra_kind(kind a') \<and>
                                     targetnode a' = n')"
  shows "slice_kind S a = (\<lambda>s. True)\<^sub>\<surd>"
proof -
  from \<open>m \<in> obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>\<close>
  have "m = (THE m. m \<in> obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>)"
    by(rule obs_intra_the_element[THEN sym])
  with assms show ?thesis by(auto simp:slice_kind_def Let_def)
qed

lemma slice_kind_Pred_obs_nearer_not_SOME:
  assumes "sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>" and "kind a = (Q)\<^sub>\<surd>"
  and "m \<in> obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>"
  and "distance (targetnode a) m x" "distance (sourcenode a) m (x + 1)"
  and "targetnode a \<noteq> (SOME nx'. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                      distance (targetnode a') m x \<and>
                                      valid_edge a' \<and> intra_kind(kind a') \<and>
                                      targetnode a' = nx')"
  shows "slice_kind S a = (\<lambda>s. False)\<^sub>\<surd>"
proof -
  from \<open>m \<in> obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>\<close>
  have "m = (THE m. m \<in> obs_intra (sourcenode a) (\<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>))"
    by(rule obs_intra_the_element[THEN sym])
  with assms show ?thesis by(auto dest:distance_det simp:slice_kind_def Let_def)
qed

lemma slice_kind_Pred_obs_not_nearer:
  assumes "sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>" and "kind a = (Q)\<^sub>\<surd>"
  and in_obs:"m \<in> obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>"
  and dist:"distance (sourcenode a) m (x + 1)"
           "\<not> distance (targetnode a) m x"
  shows "slice_kind S a = (\<lambda>s. False)\<^sub>\<surd>"
proof -
  from in_obs have the:"m = (THE m. m \<in> obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>)"
    by(rule obs_intra_the_element[THEN sym])
  from dist have "\<not> (\<exists>x. distance (targetnode a) m x \<and>
                            distance (sourcenode a) m (x + 1))"
    by(fastforce dest:distance_det)
  with \<open>sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>\<close> \<open>kind a = (Q)\<^sub>\<surd>\<close> in_obs the show ?thesis
    by(auto simp:slice_kind_def Let_def)
qed

lemma kind_Predicate_notin_slice_slice_kind_Predicate:
  assumes "sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>" and "valid_edge a" and "kind a = (Q)\<^sub>\<surd>"
  obtains Q' where "slice_kind S a = (Q')\<^sub>\<surd>" and "Q' = (\<lambda>s. False) \<or> Q' = (\<lambda>s. True)"
proof(atomize_elim)
  show "\<exists>Q'. slice_kind S a = (Q')\<^sub>\<surd> \<and> (Q' = (\<lambda>s. False) \<or> Q' = (\<lambda>s. True))"
  proof(cases "obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub> = {}")
    case True
    from \<open>valid_edge a\<close> have "valid_node (sourcenode a)" by simp
    then obtain as where "sourcenode a -as\<rightarrow>\<^sub>\<surd>* (_Exit_)" by(fastforce dest:Exit_path)
    then obtain as' mex where "sourcenode a -as'\<rightarrow>\<^sub>\<iota>* mex" and "method_exit mex"
      by -(erule valid_Exit_path_intra_path)
    from \<open>sourcenode a -as'\<rightarrow>\<^sub>\<iota>* mex\<close> have "get_proc (sourcenode a) = get_proc mex"
      by(rule intra_path_get_procs)
    show ?thesis
    proof(cases "\<exists>x. distance (targetnode a) mex x \<and>
        distance (sourcenode a) mex (x + 1)")
      case True
      then obtain x where "distance (targetnode a) mex x"
        and "distance (sourcenode a) mex (x + 1)" by blast
      show ?thesis
      proof(cases "targetnode a = (SOME n'. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                                 distance (targetnode a') mex x \<and>
                                                 valid_edge a' \<and> intra_kind(kind a') \<and>
                                                 targetnode a' = n')")
        case True
        with \<open>sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>\<close> \<open>kind a = (Q)\<^sub>\<surd>\<close>
          \<open>obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub> = {}\<close>
          \<open>method_exit mex\<close> \<open>get_proc (sourcenode a) = get_proc mex\<close>
          \<open>distance (targetnode a) mex x\<close> \<open>distance (sourcenode a) mex (x + 1)\<close>
        have "slice_kind S a = (\<lambda>s. True)\<^sub>\<surd>"
          by(rule slice_kind_Pred_empty_obs_nearer_SOME)
        thus ?thesis by simp
      next
        case False
        with \<open>sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>\<close> \<open>kind a = (Q)\<^sub>\<surd>\<close>
          \<open>obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub> = {}\<close>
          \<open>method_exit mex\<close> \<open>get_proc (sourcenode a) = get_proc mex\<close>
          \<open>distance (targetnode a) mex x\<close> \<open>distance (sourcenode a) mex (x + 1)\<close>
        have "slice_kind S a = (\<lambda>s. False)\<^sub>\<surd>"
          by(rule slice_kind_Pred_empty_obs_nearer_not_SOME)
        thus ?thesis by simp
      qed
    next
      case False
      from \<open>method_exit mex\<close> \<open>get_proc (sourcenode a) = get_proc mex\<close>
      have "mex = (THE mex. method_exit mex \<and> get_proc (sourcenode a) = get_proc mex)"
        by(auto intro!:the_equality[THEN sym] intro:method_exit_unique)
      with \<open>sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>\<close> \<open>kind a = (Q)\<^sub>\<surd>\<close>
        \<open>obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub> = {}\<close> False
      have "slice_kind S a = (\<lambda>s. False)\<^sub>\<surd>"
        by(auto simp:slice_kind_def Let_def)
      thus ?thesis by simp
    qed
  next
    case False
    then obtain m where "m \<in> obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>" by blast
    show ?thesis
    proof(cases "\<exists>x. distance (targetnode a) m x \<and>
        distance (sourcenode a) m (x + 1)")
      case True
      then obtain x where "distance (targetnode a) m x"
        and "distance (sourcenode a) m (x + 1)" by blast
      show ?thesis
      proof(cases "targetnode a = (SOME n'. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                                 distance (targetnode a') m x \<and>
                                                 valid_edge a' \<and> intra_kind(kind a') \<and>
                                                 targetnode a' = n')")
        case True
        with \<open>sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>\<close> \<open>kind a = (Q)\<^sub>\<surd>\<close>
          \<open>m \<in> obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>\<close>
          \<open>distance (targetnode a) m x\<close> \<open>distance (sourcenode a) m (x + 1)\<close>
        have "slice_kind S a = (\<lambda>s. True)\<^sub>\<surd>"
          by(rule slice_kind_Pred_obs_nearer_SOME)
        thus ?thesis by simp
      next
        case False
        with \<open>sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>\<close> \<open>kind a = (Q)\<^sub>\<surd>\<close>
          \<open>m \<in> obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>\<close>
          \<open>distance (targetnode a) m x\<close> \<open>distance (sourcenode a) m (x + 1)\<close>
        have "slice_kind S a = (\<lambda>s. False)\<^sub>\<surd>"
          by(rule slice_kind_Pred_obs_nearer_not_SOME)
        thus ?thesis by simp
      qed
    next
      case False
      from \<open>m \<in> obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>\<close>
      have "m = (THE m. m \<in> obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>)"
        by(rule obs_intra_the_element[THEN sym])
      with \<open>sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>\<close> \<open>kind a = (Q)\<^sub>\<surd>\<close> False
        \<open>m \<in> obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>\<close>
      have "slice_kind S a = (\<lambda>s. False)\<^sub>\<surd>"
        by(auto simp:slice_kind_def Let_def)
      thus ?thesis by simp
    qed
  qed
qed

lemma slice_kind_Call:
  "\<lbrakk>sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>; kind a = Q:r\<hookrightarrow>\<^bsub>p\<^esub>fs\<rbrakk>
  \<Longrightarrow> slice_kind S a = (\<lambda>cf. False):r\<hookrightarrow>\<^bsub>p\<^esub>fs"
by(simp add:slice_kind_def)

lemma slice_kind_Call_in_slice:
  "\<lbrakk>sourcenode a \<in> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>; kind a = Q:r\<hookrightarrow>\<^bsub>p\<^esub>fs\<rbrakk>
  \<Longrightarrow> slice_kind S a = Q:r\<hookrightarrow>\<^bsub>p\<^esub>(cspp (targetnode a) (HRB_slice S) fs)"
by(simp add:slice_kind_def)

lemma slice_kind_Call_in_slice_Formal_in_not:
  assumes "sourcenode a \<in> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>" and "kind a = Q:r\<hookrightarrow>\<^bsub>p\<^esub>fs"
  and "\<forall>x < length fs. Formal_in(targetnode a,x) \<notin> HRB_slice S"
  shows "slice_kind S a = Q:r\<hookrightarrow>\<^bsub>p\<^esub>replicate (length fs) Map.empty"
proof -
  from \<open>sourcenode a \<in> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>\<close> \<open>kind a = Q:r\<hookrightarrow>\<^bsub>p\<^esub>fs\<close>
  have "slice_kind S a = Q:r\<hookrightarrow>\<^bsub>p\<^esub>(cspp (targetnode a) (HRB_slice S) fs)"
    by(simp add:slice_kind_def)
  from \<open>\<forall>x < length fs. Formal_in(targetnode a,x) \<notin> HRB_slice S\<close>
  have "cspp (targetnode a) (HRB_slice S) fs = replicate (length fs) Map.empty"
    by(fastforce intro:nth_equalityI csppa_Formal_in_notin_slice simp:cspp_def)
  with \<open>slice_kind S a = Q:r\<hookrightarrow>\<^bsub>p\<^esub>(cspp (targetnode a) (HRB_slice S) fs)\<close>
  show ?thesis by simp
qed

lemma slice_kind_Call_in_slice_Formal_in_also:
  assumes "sourcenode a \<in> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>" and "kind a = Q:r\<hookrightarrow>\<^bsub>p\<^esub>fs"
  and "\<forall>x < length fs. Formal_in(targetnode a,x) \<in> HRB_slice S"
  shows "slice_kind S a = Q:r\<hookrightarrow>\<^bsub>p\<^esub>fs"
proof -
  from \<open>sourcenode a \<in> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>\<close> \<open>kind a = Q:r\<hookrightarrow>\<^bsub>p\<^esub>fs\<close>
  have "slice_kind S a = Q:r\<hookrightarrow>\<^bsub>p\<^esub>(cspp (targetnode a) (HRB_slice S) fs)"
    by(simp add:slice_kind_def)
  from \<open>\<forall>x < length fs. Formal_in(targetnode a,x) \<in> HRB_slice S\<close>
  have "cspp (targetnode a) (HRB_slice S) fs = fs"
    by(fastforce intro:nth_equalityI csppa_Formal_in_in_slice simp:cspp_def)
  with \<open>slice_kind S a = Q:r\<hookrightarrow>\<^bsub>p\<^esub>(cspp (targetnode a) (HRB_slice S) fs)\<close>
  show ?thesis by simp
qed

lemma slice_kind_Call_intra_notin_slice:
  assumes "sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>" and "valid_edge a"
  and "intra_kind (kind a)" and "valid_edge a'" and "kind a' = Q:r\<hookrightarrow>\<^bsub>p\<^esub>fs"
  and "sourcenode a' = sourcenode a"
  shows "slice_kind S a = (\<lambda>s. True)\<^sub>\<surd>"
proof -
  from \<open>valid_edge a'\<close> \<open>kind a' = Q:r\<hookrightarrow>\<^bsub>p\<^esub>fs\<close> obtain a''
    where "a'' \<in> get_return_edges a'"
    by(fastforce dest:get_return_edge_call)
  with \<open>valid_edge a'\<close> obtain ax where "valid_edge ax"
    and "sourcenode ax = sourcenode a'" and " targetnode ax = targetnode a''"
    and "kind ax = (\<lambda>cf. False)\<^sub>\<surd>"
    by(fastforce dest:call_return_node_edge)
  from \<open>valid_edge a'\<close> \<open>kind a' = Q:r\<hookrightarrow>\<^bsub>p\<^esub>fs\<close>
  have "\<exists>!a''. valid_edge a'' \<and> sourcenode a'' = sourcenode a' \<and>
    intra_kind(kind a'')"
    by(rule call_only_one_intra_edge)
  with \<open>valid_edge a\<close> \<open>sourcenode a' = sourcenode a\<close> \<open>intra_kind (kind a)\<close>
  have all:"\<forall>a''. valid_edge a'' \<and> sourcenode a'' = sourcenode a' \<and>
    intra_kind(kind a'') \<longrightarrow> a'' = a" by fastforce
  with \<open>valid_edge ax\<close> \<open>sourcenode ax = sourcenode a'\<close> \<open>kind ax = (\<lambda>cf. False)\<^sub>\<surd>\<close>
  have [simp]:"ax = a" by(fastforce simp:intra_kind_def)
  show ?thesis
  proof(cases "obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub> = {}")
    case True
    from \<open>valid_edge a\<close> have "valid_node (sourcenode a)" by simp
    then obtain asx where "sourcenode a -asx\<rightarrow>\<^sub>\<surd>* (_Exit_)" by(fastforce dest:Exit_path)
    then obtain as pex where "sourcenode a-as\<rightarrow>\<^sub>\<iota>* pex" and "method_exit pex"
      by -(erule valid_Exit_path_intra_path)
    from \<open>sourcenode a-as\<rightarrow>\<^sub>\<iota>* pex\<close> have "get_proc (sourcenode a) = get_proc pex"
      by(rule intra_path_get_procs)
    from \<open>sourcenode a-as\<rightarrow>\<^sub>\<iota>* pex\<close> obtain x where "distance (sourcenode a) pex x"
      and "x \<le> length as" by(erule every_path_distance)
    from \<open>method_exit pex\<close> have "sourcenode a \<noteq> pex"
    proof(rule method_exit_cases)
      assume "pex = (_Exit_)"
      show ?thesis
      proof
        assume "sourcenode a = pex"
        with \<open>pex = (_Exit_)\<close> have "sourcenode a = (_Exit_)" by simp
        with \<open>valid_edge a\<close> show False by(rule Exit_source)
      qed
    next
      fix ax Qx px fx
      assume "pex = sourcenode ax" and "valid_edge ax" and "kind ax = Qx\<hookleftarrow>\<^bsub>px\<^esub>fx"
      hence "\<forall>a'. valid_edge a' \<and> sourcenode a' = sourcenode ax \<longrightarrow>
        (\<exists>Qx' fx'. kind a' = Qx'\<hookleftarrow>\<^bsub>px\<^esub>fx')" by -(rule return_edges_only)
      with \<open>valid_edge a\<close> \<open>intra_kind (kind a)\<close> \<open>pex = sourcenode ax\<close>
      show ?thesis by(fastforce simp:intra_kind_def)
    qed
    have "x \<noteq> 0"
    proof
      assume "x = 0"
      with \<open>distance (sourcenode a) pex x\<close> have "sourcenode a = pex"
        by(fastforce elim:distance.cases simp:intra_path_def)
      with \<open>sourcenode a \<noteq> pex\<close> show False by simp
    qed
    with \<open>distance (sourcenode a) pex x\<close> obtain ax' where "valid_edge ax'"
      and "sourcenode a = sourcenode ax'" and "intra_kind(kind ax')"
      and "distance (targetnode ax') pex (x - 1)"
      and Some:"targetnode ax' = (SOME nx. \<exists>a'. sourcenode ax' = sourcenode a' \<and>
                                          distance (targetnode a') pex (x - 1) \<and>
                                          valid_edge a' \<and> intra_kind(kind a') \<and>
                                          targetnode a' = nx)"
      by(erule distance_successor_distance)
    from \<open>valid_edge ax'\<close> \<open>sourcenode a = sourcenode ax'\<close> \<open>intra_kind(kind ax')\<close>
      \<open>sourcenode a' = sourcenode a\<close> all
    have [simp]:"ax' = a" by fastforce
    from \<open>sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>\<close> \<open>kind ax = (\<lambda>cf. False)\<^sub>\<surd>\<close>
      True \<open>method_exit pex\<close> \<open>get_proc (sourcenode a) = get_proc pex\<close> \<open>x \<noteq> 0\<close>
      \<open>distance (targetnode ax') pex (x - 1)\<close> \<open>distance (sourcenode a) pex x\<close> Some
    show ?thesis by(fastforce elim:slice_kind_Pred_empty_obs_nearer_SOME)
  next
    case False
    then obtain m where "m \<in> obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>" by fastforce
    then obtain as where "sourcenode a-as\<rightarrow>\<^sub>\<iota>* m" and "m \<in> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>"
      by -(erule obs_intraE)
    from \<open>sourcenode a-as\<rightarrow>\<^sub>\<iota>* m\<close> obtain x where "distance (sourcenode a) m x"
      and "x \<le> length as" by(erule every_path_distance)
    from \<open>sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>\<close> \<open>m \<in> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>\<close>
    have "sourcenode a \<noteq> m" by fastforce
    have "x \<noteq> 0"
    proof
      assume "x = 0"
      with \<open>distance (sourcenode a) m x\<close> have "sourcenode a = m"
        by(fastforce elim:distance.cases simp:intra_path_def)
      with \<open>sourcenode a \<noteq> m\<close> show False by simp
    qed
    with \<open>distance (sourcenode a) m x\<close> obtain ax' where "valid_edge ax'"
      and "sourcenode a = sourcenode ax'" and "intra_kind(kind ax')"
      and "distance (targetnode ax') m (x - 1)"
      and Some:"targetnode ax' = (SOME nx. \<exists>a'. sourcenode ax' = sourcenode a' \<and>
                                          distance (targetnode a') m (x - 1) \<and>
                                          valid_edge a' \<and> intra_kind(kind a') \<and>
                                          targetnode a' = nx)"
      by(erule distance_successor_distance)
    from \<open>valid_edge ax'\<close> \<open>sourcenode a = sourcenode ax'\<close> \<open>intra_kind(kind ax')\<close>
      \<open>sourcenode a' = sourcenode a\<close> all
    have [simp]:"ax' = a" by fastforce
    from \<open>sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>\<close> \<open>kind ax = (\<lambda>cf. False)\<^sub>\<surd>\<close>
      \<open>m \<in> obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>\<close> \<open>x \<noteq> 0\<close>
      \<open>distance (targetnode ax') m (x - 1)\<close> \<open>distance (sourcenode a) m x\<close> Some
    show ?thesis by(fastforce elim:slice_kind_Pred_obs_nearer_SOME)
  qed
qed

lemma slice_kind_Return:
  "\<lbrakk>sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>; kind a = Q\<hookleftarrow>\<^bsub>p\<^esub>f\<rbrakk>
  \<Longrightarrow> slice_kind S a = (\<lambda>cf. True)\<hookleftarrow>\<^bsub>p\<^esub>(\<lambda>cf cf'. cf')"
by(simp add:slice_kind_def)

lemma slice_kind_Return_in_slice:
  "\<lbrakk>sourcenode a \<in> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>; valid_edge a; kind a = Q\<hookleftarrow>\<^bsub>p\<^esub>f;
   (p,ins,outs) \<in> set procs\<rbrakk>
  \<Longrightarrow> slice_kind S a = Q\<hookleftarrow>\<^bsub>p\<^esub>(\<lambda>cf cf'. rspp (targetnode a) (HRB_slice S) outs cf' cf)"
by(simp add:slice_kind_def,unfold formal_out_THE,simp)

lemma length_transfer_kind_slice_kind:
  assumes "valid_edge a" and "length s\<^sub>1 = length s\<^sub>2"
  and "transfer (kind a) s\<^sub>1 = s\<^sub>1'" and "transfer (slice_kind S a) s\<^sub>2 = s\<^sub>2'"
  shows "length s\<^sub>1' = length s\<^sub>2'"
proof(cases "kind a" rule:edge_kind_cases)
  case Intra
  show ?thesis
  proof(cases "sourcenode a \<in> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>")
    case True
    with Intra assms show ?thesis
      by(cases s\<^sub>1)(cases s\<^sub>2,auto dest:slice_intra_kind_in_slice simp:intra_kind_def)+
  next
    case False
    with Intra assms show ?thesis
      by(cases s\<^sub>1)(cases s\<^sub>2,auto dest:slice_kind_Upd
        elim:kind_Predicate_notin_slice_slice_kind_Predicate simp:intra_kind_def)+
  qed
next
  case (Call Q r p fs)
  show ?thesis
  proof(cases "sourcenode a \<in> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>")
    case True
    with Call assms show ?thesis
      by(cases s\<^sub>1)(cases s\<^sub>2,auto dest:slice_kind_Call_in_slice)+
  next
    case False
    with Call assms show ?thesis
      by(cases s\<^sub>1)(cases s\<^sub>2,auto dest:slice_kind_Call)+
  qed
next
  case (Return Q p f)
  show ?thesis
  proof(cases "sourcenode a \<in> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>")
    case True
    from Return \<open>valid_edge a\<close> obtain a' Q' r fs
      where "valid_edge a'" and "kind a' = Q':r\<hookrightarrow>\<^bsub>p\<^esub>fs"
      by -(drule return_needs_call,auto)
    then obtain ins outs where "(p,ins,outs) \<in> set procs"
      by(fastforce dest!:callee_in_procs)
    with True \<open>valid_edge a\<close> Return assms show ?thesis
      by(cases s\<^sub>1)(cases s\<^sub>2,auto dest:slice_kind_Return_in_slice split:list.split)+
  next
    case False
    with Return assms show ?thesis
      by(cases s\<^sub>1)(cases s\<^sub>2,auto dest:slice_kind_Return split:list.split)+
  qed
qed

subsection \<open>The sliced graph of a deterministic CFG is still deterministic\<close>

lemma only_one_SOME_edge:
  assumes "valid_edge a" and "intra_kind(kind a)" and "distance (targetnode a) mex x"
  shows "\<exists>!a'. sourcenode a = sourcenode a' \<and> distance (targetnode a') mex x \<and>
               valid_edge a' \<and> intra_kind(kind a') \<and>
               targetnode a' = (SOME n'. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                              distance (targetnode a') mex x \<and>
                                              valid_edge a' \<and> intra_kind(kind a') \<and>
                                              targetnode a' = n')"
proof(rule ex_ex1I)
  show "\<exists>a'. sourcenode a = sourcenode a' \<and> distance (targetnode a') mex x \<and>
             valid_edge a' \<and> intra_kind(kind a') \<and>
             targetnode a' = (SOME n'. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                            distance (targetnode a') mex x \<and>
                                            valid_edge a' \<and> intra_kind(kind a') \<and>
                                            targetnode a' = n')"
  proof -
    have "(\<exists>a'. sourcenode a = sourcenode a' \<and> distance (targetnode a') mex x \<and>
                valid_edge a' \<and> intra_kind(kind a') \<and>
                targetnode a' = (SOME n'. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                               distance (targetnode a') mex x \<and>
                                               valid_edge a' \<and> intra_kind(kind a') \<and>
                                               targetnode a' = n')) =
      (\<exists>n'. \<exists>a'. sourcenode a = sourcenode a' \<and> distance (targetnode a') mex x \<and>
                 valid_edge a' \<and> intra_kind(kind a') \<and> targetnode a' = n')"
      apply(unfold some_eq_ex[of "\<lambda>n'. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                            distance (targetnode a') mex x \<and>
                                            valid_edge a' \<and> intra_kind(kind a') \<and>
                                            targetnode a' = n'"])
      by simp
    also have "\<dots>"
      using \<open>valid_edge a\<close> \<open>intra_kind(kind a)\<close> \<open>distance (targetnode a) mex x\<close>
      by blast
    finally show ?thesis .
  qed
next
  fix a' ax
  assume "sourcenode a = sourcenode a' \<and> distance (targetnode a') mex x \<and>
    valid_edge a' \<and> intra_kind(kind a') \<and>
    targetnode a' = (SOME n'. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                   distance (targetnode a') mex x \<and>
                                   valid_edge a' \<and> intra_kind(kind a') \<and>
                                   targetnode a' = n')"
    and "sourcenode a = sourcenode ax \<and> distance (targetnode ax) mex x \<and>
    valid_edge ax \<and> intra_kind(kind ax) \<and>
    targetnode ax = (SOME n'. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                   distance (targetnode a') mex x \<and>
                                   valid_edge a' \<and> intra_kind(kind a') \<and>
                                   targetnode a' = n')"
  thus "a' = ax" by(fastforce intro!:edge_det)
qed

lemma slice_kind_only_one_True_edge:
  assumes "sourcenode a = sourcenode a'" and "targetnode a \<noteq> targetnode a'"
  and "valid_edge a" and "valid_edge a'" and "intra_kind (kind a)"
  and "intra_kind (kind a')" and "slice_kind S a = (\<lambda>s. True)\<^sub>\<surd>"
  shows "slice_kind S a' = (\<lambda>s. False)\<^sub>\<surd>"
proof -
  from assms obtain Q Q' where "kind a = (Q)\<^sub>\<surd>"
    and "kind a' = (Q')\<^sub>\<surd>" and det:"\<forall>s. (Q s \<longrightarrow> \<not> Q' s) \<and> (Q' s \<longrightarrow> \<not> Q s)"
    by(auto dest:deterministic)
  show ?thesis
  proof(cases "sourcenode a \<in> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>")
    case True
    with \<open>slice_kind S a = (\<lambda>s. True)\<^sub>\<surd>\<close> \<open>kind a = (Q)\<^sub>\<surd>\<close> have "Q = (\<lambda>s. True)"
      by(simp add:slice_kind_def Let_def)
    with det have "Q' = (\<lambda>s. False)" by(simp add:fun_eq_iff)
    with True \<open>kind a' = (Q')\<^sub>\<surd>\<close> \<open>sourcenode a = sourcenode a'\<close> show ?thesis
      by(simp add:slice_kind_def Let_def)
  next
    case False
    hence "sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>" by simp
    thus ?thesis
    proof(cases "obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub> = {}")
      case True
      with \<open>sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>\<close> \<open>slice_kind S a = (\<lambda>s. True)\<^sub>\<surd>\<close>
        \<open>kind a = (Q)\<^sub>\<surd>\<close>
      obtain mex x where mex:"mex = (THE mex. method_exit mex \<and>
        get_proc (sourcenode a) = get_proc mex)"
        and dist:"distance (targetnode a) mex x" "distance (sourcenode a) mex (x + 1)"
        and target:"targetnode a = (SOME n'. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                                 distance (targetnode a') mex x \<and>
                                                 valid_edge a' \<and> intra_kind(kind a') \<and>
                                                 targetnode a' = n')"
        by(auto simp:slice_kind_def Let_def fun_eq_iff split:if_split_asm)
      from \<open>valid_edge a\<close> \<open>intra_kind (kind a)\<close> \<open>distance (targetnode a) mex x\<close>
      have ex1:"\<exists>!a'. sourcenode a = sourcenode a' \<and> distance (targetnode a') mex x \<and>
        valid_edge a' \<and> intra_kind(kind a') \<and>
        targetnode a' = (SOME n'. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                       distance (targetnode a') mex x \<and>
                                       valid_edge a' \<and> intra_kind(kind a') \<and>
                                       targetnode a' = n')"
        by(rule only_one_SOME_edge)
      have "targetnode a' \<noteq> (SOME n'. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                           distance (targetnode a') mex x \<and>
                                           valid_edge a' \<and> intra_kind(kind a') \<and>
                                           targetnode a' = n')"
      proof(rule ccontr)
        assume "\<not> targetnode a' \<noteq> (SOME n'. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                                 distance (targetnode a') mex x \<and>
                                                 valid_edge a' \<and> intra_kind(kind a') \<and>
                                                 targetnode a' = n')"
        hence "targetnode a' = (SOME n'. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                              distance (targetnode a') mex x \<and>
                                              valid_edge a' \<and> intra_kind(kind a') \<and>
                                              targetnode a' = n')"
          by simp
        with ex1 target \<open>sourcenode a = sourcenode a'\<close> \<open>valid_edge a\<close> \<open>valid_edge a'\<close>
          \<open>intra_kind(kind a)\<close> \<open>intra_kind(kind a')\<close> \<open>distance (targetnode a) mex x\<close>
        have "a = a'" by fastforce
        with \<open>targetnode a \<noteq> targetnode a'\<close> show False by simp
      qed
      with \<open>sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>\<close> True \<open>kind a' = (Q')\<^sub>\<surd>\<close>
        \<open>sourcenode a = sourcenode a'\<close> mex dist
      show ?thesis by(auto dest:distance_det
        simp:slice_kind_def Let_def fun_eq_iff split:if_split_asm)
    next
      case False
      hence "obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub> \<noteq> {}" .
      then obtain m where "m \<in> obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>" by auto
      hence "m = (THE m. m \<in> obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>)"
        by(auto dest:obs_intra_the_element)
      with \<open>sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>\<close>
        \<open>obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub> \<noteq> {}\<close>
        \<open>slice_kind S a = (\<lambda>s. True)\<^sub>\<surd>\<close> \<open>kind a = (Q)\<^sub>\<surd>\<close>
      obtain x x' where "distance (targetnode a) m x"
        "distance (sourcenode a) m (x + 1)"
        and target:"targetnode a = (SOME n'. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                                 distance (targetnode a') m x \<and>
                                                 valid_edge a' \<and> intra_kind(kind a') \<and>
                                                 targetnode a' = n')"
        by(auto simp:slice_kind_def Let_def fun_eq_iff split:if_split_asm)
      show ?thesis
      proof(cases "distance (targetnode a') m x")
        case False
        with \<open>sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>\<close> \<open>kind a' = (Q')\<^sub>\<surd>\<close>
          \<open>m \<in> obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>\<close>
          \<open>distance (targetnode a) m x\<close> \<open>distance (sourcenode a) m (x + 1)\<close>
          \<open>sourcenode a = sourcenode a'\<close> show ?thesis
          by(fastforce intro:slice_kind_Pred_obs_not_nearer)
      next
        case True
        from \<open>valid_edge a\<close> \<open>intra_kind(kind a)\<close> \<open>distance (targetnode a) m x\<close>
          \<open>distance (sourcenode a) m (x + 1)\<close>
        have ex1:"\<exists>!a'. sourcenode a = sourcenode a' \<and>
               distance (targetnode a') m x \<and> valid_edge a' \<and> intra_kind(kind a') \<and>
               targetnode a' = (SOME nx. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                              distance (targetnode a') m x \<and>
                                              valid_edge a' \<and> intra_kind(kind a') \<and>
                                              targetnode a' = nx)"
          by -(rule only_one_SOME_dist_edge)
        have "targetnode a' \<noteq> (SOME n'. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                               distance (targetnode a') m x \<and>
                                               valid_edge a' \<and> intra_kind(kind a') \<and>
                                               targetnode a' = n')"
        proof(rule ccontr)
          assume "\<not> targetnode a' \<noteq> (SOME n'. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                                 distance (targetnode a') m x \<and>
                                                 valid_edge a' \<and> intra_kind(kind a') \<and>
                                                 targetnode a' = n')"
          hence "targetnode a' = (SOME n'. \<exists>a'. sourcenode a = sourcenode a' \<and>
                                                distance (targetnode a') m x \<and>
                                                valid_edge a' \<and> intra_kind(kind a') \<and>
                                                targetnode a' = n')"
            by simp
          with ex1 target \<open>sourcenode a = sourcenode a'\<close>
            \<open>valid_edge a\<close> \<open>valid_edge a'\<close> \<open>intra_kind(kind a)\<close> \<open>intra_kind(kind a')\<close>
            \<open>distance (targetnode a) m x\<close> \<open>distance (sourcenode a) m (x + 1)\<close>
          have "a = a'" by auto
          with \<open>targetnode a \<noteq> targetnode a'\<close> show False by simp
        qed
        with \<open>sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>\<close>
          \<open>kind a' = (Q')\<^sub>\<surd>\<close> \<open>m \<in> obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>\<close>
          \<open>distance (targetnode a) m x\<close> \<open>distance (sourcenode a) m (x + 1)\<close>
          True \<open>sourcenode a = sourcenode a'\<close> show ?thesis
          by(fastforce intro:slice_kind_Pred_obs_nearer_not_SOME)
      qed
    qed
  qed
qed

lemma slice_deterministic:
  assumes "valid_edge a" and "valid_edge a'"
  and "intra_kind (kind a)" and "intra_kind (kind a')"
  and "sourcenode a = sourcenode a'" and "targetnode a \<noteq> targetnode a'"
  obtains Q Q' where "slice_kind S a = (Q)\<^sub>\<surd>" and "slice_kind S a' = (Q')\<^sub>\<surd>"
  and "\<forall>s. (Q s \<longrightarrow> \<not> Q' s) \<and> (Q' s \<longrightarrow> \<not> Q s)"
proof(atomize_elim)
  from assms obtain Q Q'
    where "kind a = (Q)\<^sub>\<surd>" and "kind a' = (Q')\<^sub>\<surd>"
    and det:"\<forall>s. (Q s \<longrightarrow> \<not> Q' s) \<and> (Q' s \<longrightarrow> \<not> Q s)"
    by(auto dest:deterministic)
  show "\<exists>Q Q'. slice_kind S a = (Q)\<^sub>\<surd> \<and> slice_kind S a' = (Q')\<^sub>\<surd> \<and>
                (\<forall>s. (Q s \<longrightarrow> \<not> Q' s) \<and> (Q' s \<longrightarrow> \<not> Q s))"
  proof(cases "sourcenode a \<in> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>")
    case True
    with \<open>kind a = (Q)\<^sub>\<surd>\<close> have "slice_kind S a = (Q)\<^sub>\<surd>"
      by(simp add:slice_kind_def Let_def)
    from True \<open>kind a' = (Q')\<^sub>\<surd>\<close> \<open>sourcenode a = sourcenode a'\<close>
    have "slice_kind S a' = (Q')\<^sub>\<surd>"
      by(simp add:slice_kind_def Let_def)
    with \<open>slice_kind S a = (Q)\<^sub>\<surd>\<close> det show ?thesis by blast
  next
    case False
    with \<open>kind a = (Q)\<^sub>\<surd>\<close>
    have "slice_kind S a = (\<lambda>s. True)\<^sub>\<surd> \<or> slice_kind S a = (\<lambda>s. False)\<^sub>\<surd>"
      by(simp add:slice_kind_def Let_def)
    thus ?thesis
    proof
      assume true:"slice_kind S a = (\<lambda>s. True)\<^sub>\<surd>"
      with \<open>sourcenode a = sourcenode a'\<close> \<open>targetnode a \<noteq> targetnode a'\<close>
        \<open>valid_edge a\<close> \<open>valid_edge a'\<close> \<open>intra_kind (kind a)\<close> \<open>intra_kind (kind a')\<close>
      have "slice_kind S a' = (\<lambda>s. False)\<^sub>\<surd>"
        by(rule slice_kind_only_one_True_edge)
      with true show ?thesis by simp
    next
      assume false:"slice_kind S a = (\<lambda>s. False)\<^sub>\<surd>"
      from False \<open>kind a' = (Q')\<^sub>\<surd>\<close> \<open>sourcenode a = sourcenode a'\<close>
      have "slice_kind S a' = (\<lambda>s. True)\<^sub>\<surd> \<or> slice_kind S a' = (\<lambda>s. False)\<^sub>\<surd>"
        by(simp add:slice_kind_def Let_def)
      with false show ?thesis by auto
    qed
  qed
qed

end

end