(*
 * Copyright 2014, NICTA
 *
 * This software may be distributed and modified according to the terms of
 * the BSD 2-Clause license. Note that NO WARRANTY is provided.
 * See "LICENSE_BSD2.txt" for details.
 *
 * @TAG(NICTA_BSD)
 *)

theory Memset
imports "../../AutoCorres"
begin

install_C_file "memset.c"

autocorres [
  heap_abs_syntax,
  no_heap_abs=memset,
  no_signed_word_abs=memset,
  unsigned_word_abs=memset] "memset.c"

lemma c_guard_word8_ptr [simp]:
     "c_guard (x :: word8 ptr) = (x \<noteq> NULL)"
  apply (clarsimp simp: c_guard_def ptr_aligned_def c_null_guard_def)
  apply (metis Ptr_ptr_val first_in_intvl intvl_Suc not_less_eq ptr_val.ptr_val_def)
  done

lemma to_bytes_word8 [simp]: "to_bytes (a :: word8) x = [a]"
  by (clarsimp simp: to_bytes_def typ_info_word word_rsplit_same)

lemma heap_update_list_id [simp]:
    "heap_update_list x [] = (\<lambda>x. x)"
  apply (rule ext)
  apply simp
  done

lemma heap_update_heap_update_list:
   "\<lbrakk> ptr_val p = q + (of_nat (length l)); Suc (length l) < addr_card \<rbrakk> \<Longrightarrow>
      heap_update (p :: word8 ptr) v (heap_update_list q l s) = (heap_update_list q (l @ [v]) s)"
  apply (rule ext)
  apply (clarsimp simp: heap_update_def unat_of_nat
    addr_card word_bits_def fun_upd_def)
  apply (subst heap_update_list_value, clarsimp simp: addr_card)
  apply safe
   apply (subst if_P)
    apply (fastforce intro: intvlI)
   apply (clarsimp simp: unat_of_nat word_bits_def)
  apply (subst (1 2)  heap_update_list_value,
    simp add: addr_card,
    simp add: addr_card)
  apply (case_tac "x \<in> {q..+length l}")
   apply (subst if_P, simp)
   apply (subst if_P)
    apply clarsimp
    apply (metis (full_types) intvlD intvlI less_SucI)
   apply (subst nth_append, clarsimp)
   apply (metis (hide_lams, no_types) add_diff_cancel2 intvlD le_unat_uoi less_or_eq_imp_le not_le)
  apply clarsimp
  apply (metis intvlD intvlI less_antisym)
  done

lemma (in memset) memset:
  "\<forall>s\<^sub>0. \<lbrace> \<lambda>s. s = s\<^sub>0 \<and> n < addr_card \<and> 0 \<notin> {ptr_val p ..+ n} \<rbrace>
      memset' p c n
      \<lbrace> \<lambda>rv s. s = t_hrs_'_update (hrs_mem_update (
          heap_update_list (ptr_val p) (replicate n (scast c)))) s\<^sub>0 \<rbrace>!"
proof -
  {
     fix s0
     have "\<lbrace> \<lambda>s. s = s0 \<and> n < addr_card \<and> 0 \<notin> {ptr_val p ..+ n} \<rbrace>
                memset' p c n
          \<lbrace> \<lambda>rv s. s = t_hrs_'_update (hrs_mem_update
              (heap_update_list (ptr_val p) (replicate n (scast c)))) s0 \<rbrace>!"
      apply (rule validNF_assume_pre)
      apply (unfold memset'_def)
      apply (subst whileLoop_add_inv [where M="\<lambda>((d', n'), _). n'"
                and I="\<lambda>(d', n') s.
                   n' \<le> n \<and>
                   (n' \<le> n \<longrightarrow> d' = ptr_coerce p +\<^sub>p int (n - n')) \<and>
                   (n' \<le> n \<longrightarrow> s = t_hrs_'_update
                  (hrs_mem_update (heap_update_list (ptr_val p) (replicate (n - n') (scast c)))) s0)"])
      apply wp
        apply (clarsimp simp:)
        apply (intro conjI impI)
           apply arith
          apply (clarsimp simp: ptr_add_def)
         apply (rule globals.fold_congs, simp, simp)
         apply (clarsimp simp: hrs_mem_update_def)
         apply (subst heap_update_heap_update_list)
           apply (clarsimp simp: ptr_add_def)
          apply (clarsimp)
          apply arith
         apply (metis diff_Suc_diff_eq2 diff_diff_left minus_nat.diff_0 replicate_Suc_append)
        apply (clarsimp simp: ptr_add_def)
        apply (metis (hide_lams, no_types) add_less_cancel_right add.left_neutral intvl_inter_le le0 le_add_diff_inverse of_nat_diff semiring_1_class.of_nat_0)
       apply clarsimp
      apply (clarsimp simp: hrs_mem_update_def)
      done
  }

  thus ?thesis
    by simp
qed

lemma word_rsplit_sword_0 [simplified, simp]:
  "word_rsplit (0 :: addr_bitsize signed word) = replicate (size_of TYPE(addr)) (0 :: word8)"
  apply (simp add: word_rsplit_def bin_rsplit_def Let_def)
  done

lemma word_rsplit_word_0 [simplified, simp]:
  "word_rsplit (0 :: addr_bitsize word) = replicate (size_of TYPE(addr)) (0 :: word8)"
  apply (simp add: word_rsplit_def bin_rsplit_def Let_def)
  done

lemma heap_update_zero_node [simplified]:
  "heap_update_list p (replicate (size_of TYPE(node_C)) 0) = heap_update (Ptr p) (node_C NULL 0)"
  apply (rule ext)
  apply (clarsimp simp: heap_update_def to_bytes_def)
  apply (subst packed_type_access_ti, simp)
  apply (clarsimp simp: access_ti\<^sub>0_def)
  apply (clarsimp simp: to_bytes_def to_bytes_p_def node_C_tag_def node_C_typ_tag)
  apply (subst final_pad_def)
  apply (clarsimp simp: typ_info_word size_td_lt_ti_typ_pad_combine Let_def padup_def)
  apply (clarsimp simp: ti_typ_pad_combine_def)
  apply (clarsimp simp: ti_typ_combine_def empty_typ_info_def typ_info_ptr typ_info_word)
  done

lemma (in memset) is_valid_node_C_non_NULL [simp]:
  "is_valid_node_C (lift_global_heap s) p \<Longrightarrow> 0 \<notin> {ptr_val p ..+ size_of TYPE(node_C)}"
  by (auto simp: lift_global_heap_def c_guard_def c_null_guard_def dest: simple_lift_c_guard)

lemma (in memset) zero_node:
  "\<forall>s\<^sub>0. \<lbrace> \<lambda>s. is_valid_node_C s p \<and> s = s\<^sub>0\<rbrace> zero_node' p \<lbrace> \<lambda>rv s. s = s\<^sub>0[p := (node_C NULL 0) ] \<rbrace>! "
  apply (clarsimp simp: zero_node'_def)
  apply (wp add: memset [THEN validNF_make_schematic_post, simplified])
  apply (fastforce dest: simple_lift_c_guard is_valid_node_C_non_NULL
                   simp: addr_card lift_global_heap_def heap_update_zero_node
                         memset.update_node_def typ_simple_heap_simps fun_upd_def)
  done

end


header {* \isaheader{Static backward slice} *}

theory Slice imports SCDObservable Distance begin

context SDG begin

subsection {* Preliminary definitions on the parameter nodes for defining
  sliced call and return edges *}

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 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 = 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 (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 `valid_edge a` have "distinct(ParamDefs (targetnode a))"
    by(rule distinct_ParamDefs)
  from `x < length (ParamDefs (targetnode a))`
    `length (ParamDefs (targetnode a)) = length xs`
    `distinct(ParamDefs (targetnode a))`
  have "(empty(ParamDefs (targetnode a) [:=] map g xs))
    ((ParamDefs (targetnode a))!x) = (map g xs)!x"
    by(fastforce intro:fun_upds_nth)
  with `Actual_out(targetnode a,x) \<in> S` `x < length (ParamDefs (targetnode a))`
    `length (ParamDefs (targetnode a)) = length xs` 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 `valid_edge a` have "distinct(ParamDefs (targetnode a))"
    by(rule distinct_ParamDefs)
  from `x < length (ParamDefs (targetnode a))`
    `length (ParamDefs (targetnode a)) = length xs`
    `distinct(ParamDefs (targetnode a))`
  have "(empty(ParamDefs (targetnode a) [:=] map g xs))
    ((ParamDefs (targetnode a))!x) = (map g xs)!x"
    by(fastforce intro:fun_upds_nth)
  with `Actual_out((targetnode a),x) \<notin> S` `distinct(ParamDefs (targetnode a))`
    `x < length (ParamDefs (targetnode a))`
  show ?thesis by(fastforce simp:rspp_def map_merge_def nth_eq_iff_index_eq)
qed

subsection {* Defining the sliced edge kinds *}

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 `method_exit mex` `get_proc (sourcenode a) = get_proc mex`
  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 `sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>` `kind a = (Q)\<^sub>\<surd>`
    `obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub> = {}`
  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 `distance (targetnode a) mex x` `distance (sourcenode a) mex (x + 1)`
    `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')`
  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 `method_exit mex` `get_proc (sourcenode a) = get_proc mex`
  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 `sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>` `kind a = (Q)\<^sub>\<surd>`
    `obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub> = {}`
  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 `distance (targetnode a) mex x` `distance (sourcenode a) mex (x + 1)`
    `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')`
  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 `method_exit mex` `get_proc (sourcenode a) = get_proc mex`
  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 `m \<in> obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>`
  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 `m \<in> obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>`
  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 `sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>` `kind a = (Q)\<^sub>\<surd>` 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 `valid_edge a` 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 `sourcenode a -as'\<rightarrow>\<^sub>\<iota>* mex` 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 `sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>` `kind a = (Q)\<^sub>\<surd>`
          `obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub> = {}`
          `method_exit mex` `get_proc (sourcenode a) = get_proc mex`
          `distance (targetnode a) mex x` `distance (sourcenode a) mex (x + 1)`
        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 `sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>` `kind a = (Q)\<^sub>\<surd>`
          `obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub> = {}`
          `method_exit mex` `get_proc (sourcenode a) = get_proc mex`
          `distance (targetnode a) mex x` `distance (sourcenode a) mex (x + 1)`
        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 `method_exit mex` `get_proc (sourcenode a) = get_proc mex`
      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 `sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>` `kind a = (Q)\<^sub>\<surd>`
        `obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub> = {}` 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 `sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>` `kind a = (Q)\<^sub>\<surd>`
          `m \<in> obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>`
          `distance (targetnode a) m x` `distance (sourcenode a) m (x + 1)`
        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 `sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>` `kind a = (Q)\<^sub>\<surd>`
          `m \<in> obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>`
          `distance (targetnode a) m x` `distance (sourcenode a) m (x + 1)`
        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 `m \<in> obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>`
      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 `sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>` `kind a = (Q)\<^sub>\<surd>` False
        `m \<in> obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>`
      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) empty"
proof -
  from `sourcenode a \<in> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>` `kind a = Q:r\<hookrightarrow>\<^bsub>p\<^esub>fs`
  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 `\<forall>x < length fs. Formal_in(targetnode a,x) \<notin> HRB_slice S`
  have "cspp (targetnode a) (HRB_slice S) fs = replicate (length fs) empty"
    by(fastforce intro:nth_equalityI csppa_Formal_in_notin_slice simp:cspp_def)
  with `slice_kind S a = Q:r\<hookrightarrow>\<^bsub>p\<^esub>(cspp (targetnode a) (HRB_slice S) fs)`
  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 `sourcenode a \<in> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>` `kind a = Q:r\<hookrightarrow>\<^bsub>p\<^esub>fs`
  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 `\<forall>x < length fs. Formal_in(targetnode a,x) \<in> HRB_slice S`
  have "cspp (targetnode a) (HRB_slice S) fs = fs"
    by(fastforce intro:nth_equalityI csppa_Formal_in_in_slice simp:cspp_def)
  with `slice_kind S a = Q:r\<hookrightarrow>\<^bsub>p\<^esub>(cspp (targetnode a) (HRB_slice S) fs)`
  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 `valid_edge a'` `kind a' = Q:r\<hookrightarrow>\<^bsub>p\<^esub>fs` obtain a''
    where "a'' \<in> get_return_edges a'"
    by(fastforce dest:get_return_edge_call)
  with `valid_edge a'` 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 `valid_edge a'` `kind a' = Q:r\<hookrightarrow>\<^bsub>p\<^esub>fs`
  have "\<exists>!a''. valid_edge a'' \<and> sourcenode a'' = sourcenode a' \<and>
    intra_kind(kind a'')"
    by(rule call_only_one_intra_edge)
  with `valid_edge a` `sourcenode a' = sourcenode a` `intra_kind (kind a)`
  have all:"\<forall>a''. valid_edge a'' \<and> sourcenode a'' = sourcenode a' \<and>
    intra_kind(kind a'') \<longrightarrow> a'' = a" by fastforce
  with `valid_edge ax` `sourcenode ax = sourcenode a'` `kind ax = (\<lambda>cf. False)\<^sub>\<surd>`
  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 `valid_edge a` 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 `sourcenode a-as\<rightarrow>\<^sub>\<iota>* pex` have "get_proc (sourcenode a) = get_proc pex"
      by(rule intra_path_get_procs)
    from `sourcenode a-as\<rightarrow>\<^sub>\<iota>* pex` obtain x where "distance (sourcenode a) pex x"
      and "x \<le> length as" by(erule every_path_distance)
    from `method_exit pex` have "sourcenode a \<noteq> pex"
    proof(rule method_exit_cases)
      assume "pex = (_Exit_)"
      show ?thesis
      proof
        assume "sourcenode a = pex"
        with `pex = (_Exit_)` have "sourcenode a = (_Exit_)" by simp
        with `valid_edge a` 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 `valid_edge a` `intra_kind (kind a)` `pex = sourcenode ax`
      show ?thesis by(fastforce simp:intra_kind_def)
    qed
    have "x \<noteq> 0"
    proof
      assume "x = 0"
      with `distance (sourcenode a) pex x` have "sourcenode a = pex"
        by(fastforce elim:distance.cases simp:intra_path_def)
      with `sourcenode a \<noteq> pex` show False by simp
    qed
    with `distance (sourcenode a) pex x` 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 `valid_edge ax'` `sourcenode a = sourcenode ax'` `intra_kind(kind ax')`
      `sourcenode a' = sourcenode a` all
    have [simp]:"ax' = a" by fastforce
    from `sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>` `kind ax = (\<lambda>cf. False)\<^sub>\<surd>`
      True `method_exit pex` `get_proc (sourcenode a) = get_proc pex` `x \<noteq> 0`
      `distance (targetnode ax') pex (x - 1)` `distance (sourcenode a) pex x` 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 `sourcenode a-as\<rightarrow>\<^sub>\<iota>* m` obtain x where "distance (sourcenode a) m x"
      and "x \<le> length as" by(erule every_path_distance)
    from `sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>` `m \<in> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>`
    have "sourcenode a \<noteq> m" by fastforce
    have "x \<noteq> 0"
    proof
      assume "x = 0"
      with `distance (sourcenode a) m x` have "sourcenode a = m"
        by(fastforce elim:distance.cases simp:intra_path_def)
      with `sourcenode a \<noteq> m` show False by simp
    qed
    with `distance (sourcenode a) m x` 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 `valid_edge ax'` `sourcenode a = sourcenode ax'` `intra_kind(kind ax')`
      `sourcenode a' = sourcenode a` all
    have [simp]:"ax' = a" by fastforce
    from `sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>` `kind ax = (\<lambda>cf. False)\<^sub>\<surd>`
      `m \<in> obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>` `x \<noteq> 0`
      `distance (targetnode ax') m (x - 1)` `distance (sourcenode a) m x` 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 `valid_edge a` 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 `valid_edge a` 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 {* The sliced graph of a deterministic CFG is still deterministic *}

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 `valid_edge a` `intra_kind(kind a)` `distance (targetnode a) mex x`
      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 `slice_kind S a = (\<lambda>s. True)\<^sub>\<surd>` `kind a = (Q)\<^sub>\<surd>` 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 `kind a' = (Q')\<^sub>\<surd>` `sourcenode a = sourcenode a'` 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 `sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>` `slice_kind S a = (\<lambda>s. True)\<^sub>\<surd>`
        `kind a = (Q)\<^sub>\<surd>`
      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:split_if_asm)
      from `valid_edge a` `intra_kind (kind a)` `distance (targetnode a) mex x`
      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 `sourcenode a = sourcenode a'` `valid_edge a` `valid_edge a'`
          `intra_kind(kind a)` `intra_kind(kind a')` `distance (targetnode a) mex x`
        have "a = a'" by fastforce
        with `targetnode a \<noteq> targetnode a'` show False by simp
      qed
      with `sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>` True `kind a' = (Q')\<^sub>\<surd>`
        `sourcenode a = sourcenode a'` mex dist
      show ?thesis by(auto dest:distance_det
        simp:slice_kind_def Let_def fun_eq_iff split:split_if_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 `sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>`
        `obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub> \<noteq> {}`
        `slice_kind S a = (\<lambda>s. True)\<^sub>\<surd>` `kind a = (Q)\<^sub>\<surd>`
      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:split_if_asm)
      show ?thesis
      proof(cases "distance (targetnode a') m x")
        case False
        with `sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>` `kind a' = (Q')\<^sub>\<surd>`
          `m \<in> obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>`
          `distance (targetnode a) m x` `distance (sourcenode a) m (x + 1)`
          `sourcenode a = sourcenode a'` show ?thesis
          by(fastforce intro:slice_kind_Pred_obs_not_nearer)
      next
        case True
        from `valid_edge a` `intra_kind(kind a)` `distance (targetnode a) m x`
          `distance (sourcenode a) m (x + 1)`
        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 `sourcenode a = sourcenode a'`
            `valid_edge a` `valid_edge a'` `intra_kind(kind a)` `intra_kind(kind a')`
            `distance (targetnode a) m x` `distance (sourcenode a) m (x + 1)`
          have "a = a'" by auto
          with `targetnode a \<noteq> targetnode a'` show False by simp
        qed
        with `sourcenode a \<notin> \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>`
          `kind a' = (Q')\<^sub>\<surd>` `m \<in> obs_intra (sourcenode a) \<lfloor>HRB_slice S\<rfloor>\<^bsub>CFG\<^esub>`
          `distance (targetnode a) m x` `distance (sourcenode a) m (x + 1)`
          True `sourcenode a = sourcenode a'` 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 `kind a = (Q)\<^sub>\<surd>` have "slice_kind S a = (Q)\<^sub>\<surd>"
      by(simp add:slice_kind_def Let_def)
    from True `kind a' = (Q')\<^sub>\<surd>` `sourcenode a = sourcenode a'`
    have "slice_kind S a' = (Q')\<^sub>\<surd>"
      by(simp add:slice_kind_def Let_def)
    with `slice_kind S a = (Q)\<^sub>\<surd>` det show ?thesis by blast
  next
    case False
    with `kind a = (Q)\<^sub>\<surd>`
    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 `sourcenode a = sourcenode a'` `targetnode a \<noteq> targetnode a'`
        `valid_edge a` `valid_edge a'` `intra_kind (kind a)` `intra_kind (kind a')`
      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 `kind a' = (Q')\<^sub>\<surd>` `sourcenode a = sourcenode a'`
      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


section \<open>Postdomination\<close>

theory Postdomination imports CFGExit begin

subsection \<open>Standard Postdomination\<close>

locale Postdomination = CFGExit sourcenode targetnode kind valid_edge Entry Exit
  for sourcenode :: "'edge \<Rightarrow> 'node" and targetnode :: "'edge \<Rightarrow> 'node"
  and kind :: "'edge \<Rightarrow> 'state edge_kind" and valid_edge :: "'edge \<Rightarrow> bool"
  and Entry :: "'node" ("'('_Entry'_')") and Exit :: "'node" ("'('_Exit'_')") +
  assumes Entry_path:"valid_node n \<Longrightarrow> \<exists>as. (_Entry_) -as\<rightarrow>* n"
  and Exit_path:"valid_node n \<Longrightarrow> \<exists>as. n -as\<rightarrow>* (_Exit_)"

begin

definition postdominate :: "'node \<Rightarrow> 'node \<Rightarrow> bool" ("_ postdominates _" [51,0])
where postdominate_def:"n' postdominates n \<equiv>
    (valid_node n \<and> valid_node n' \<and>
    ((\<forall>as. n -as\<rightarrow>* (_Exit_) \<longrightarrow> n' \<in> set (sourcenodes as))))"

lemma postdominate_implies_path:
  assumes "n' postdominates n" obtains as where "n -as\<rightarrow>* n'"
proof(atomize_elim)
  from \<open>n' postdominates n\<close> have "valid_node n"
    and all:"\<forall>as. n -as\<rightarrow>* (_Exit_) \<longrightarrow> n' \<in> set(sourcenodes as)"
    by(auto simp:postdominate_def)
  from \<open>valid_node n\<close> obtain as where "n -as\<rightarrow>* (_Exit_)" by(auto dest:Exit_path)
  with all have "n' \<in> set(sourcenodes as)" by simp
  then obtain ns ns' where "sourcenodes as = ns@n'#ns'" by(auto dest:split_list)
  then obtain as' a as'' where "sourcenodes as' = ns"
    and "sourcenode a = n'" and "as = as'@a#as''"
    by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
  from \<open>n -as\<rightarrow>* (_Exit_)\<close> \<open>as = as'@a#as''\<close> have "n -as'\<rightarrow>* sourcenode a"
    by(fastforce dest:path_split)
  with \<open>sourcenode a = n'\<close> show "\<exists>as. n -as\<rightarrow>* n'" by blast
qed

lemma postdominate_refl:
  assumes valid:"valid_node n" and notExit:"n \<noteq> (_Exit_)"
  shows "n postdominates n"
using valid
proof(induct rule:valid_node_cases)
  case Entry
  { fix as assume path:"(_Entry_) -as\<rightarrow>* (_Exit_)"
    hence notempty:"as \<noteq> []"
      apply - apply(erule path.cases)
      by (drule sym,simp,drule Exit_noteq_Entry,auto)
    with path have "hd (sourcenodes as) = (_Entry_)"
      by(fastforce intro:path_sourcenode)
    with notempty have "(_Entry_) \<in> set (sourcenodes as)"
      by(fastforce intro:hd_in_set simp:sourcenodes_def) }
  with Entry show ?thesis by(simp add:postdominate_def)
next
  case Exit
  with notExit have False by simp
  thus ?thesis by simp
next
  case inner
  show ?thesis
  proof(cases "\<exists>as. n -as\<rightarrow>* (_Exit_)")
    case True
    { fix as' assume path':"n -as'\<rightarrow>* (_Exit_)"
      with inner have notempty:"as' \<noteq> []"
        by(cases as',auto elim!:path.cases simp:inner_node_def)
      with path' inner have hd:"hd (sourcenodes as') = n"
        by -(rule path_sourcenode)
      from notempty have "sourcenodes as' \<noteq> []" by(simp add:sourcenodes_def)
      with hd[THEN sym] have "n \<in> set (sourcenodes as')" by simp }
    hence "\<forall>as. n -as\<rightarrow>* (_Exit_) \<longrightarrow> n \<in> set (sourcenodes as)" by simp
    with True inner show ?thesis by(simp add:postdominate_def inner_is_valid)
  next
    case False
    with inner show ?thesis by(simp add:postdominate_def inner_is_valid)
  qed
qed

lemma postdominate_trans:
  assumes pd1:"n'' postdominates n" and pd2:"n' postdominates n''"
  shows "n' postdominates n"
proof -
  from pd1 pd2 have valid:"valid_node n" and valid':"valid_node n'"
    by(simp_all add:postdominate_def)
  { fix as assume path:"n -as\<rightarrow>* (_Exit_)"
    with pd1 have "n'' \<in> set (sourcenodes as)" by(simp add:postdominate_def)
    then obtain ns' ns'' where "sourcenodes as = ns'@n''#ns''"
      by(auto dest:split_list)
    then obtain as' as'' a
      where as'':"sourcenodes as'' = ns''" and as:"as=as'@a#as''"
      and source:"sourcenode a = n''"
      by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
    from as path have "n -as'@a#as''\<rightarrow>* (_Exit_)" by simp
    with source have path':"n'' -a#as''\<rightarrow>* (_Exit_)"
      by(fastforce dest:path_split_second)
    with pd2 have "n' \<in> set(sourcenodes (a#as''))"
      by(auto simp:postdominate_def)
    with as have "n' \<in> set(sourcenodes as)" by(auto simp:sourcenodes_def) }
  with valid valid' show ?thesis by(simp add:postdominate_def)
qed

lemma postdominate_antisym:
  assumes pd1:"n' postdominates n" and pd2:"n postdominates n'"
  shows "n = n'"
proof -
  from pd1 have valid:"valid_node n" and valid':"valid_node n'"
    by(auto simp:postdominate_def)
  from valid obtain as where path1:"n -as\<rightarrow>* (_Exit_)" by(fastforce dest:Exit_path)
  from valid' obtain as' where path2:"n' -as'\<rightarrow>* (_Exit_)" by(fastforce dest:Exit_path)
  from pd1 path1 have "\<exists>nx \<in> set(sourcenodes as). nx = n'"
    by(simp add:postdominate_def)
  then obtain ns ns' where sources:"sourcenodes as = ns@n'#ns'"
    and all:"\<forall>nx \<in> set ns'. nx \<noteq> n'"
    by(fastforce elim!: rightmost_element_property)
  from sources obtain asx a asx' where ns':"ns' = sourcenodes asx'"
    and as:"as = asx@a#asx'" and source:"sourcenode a = n'"
    by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
  from path1 as have "n -asx@a#asx'\<rightarrow>* (_Exit_)" by simp
  with source have "n' -a#asx'\<rightarrow>* (_Exit_)" by(fastforce dest:path_split_second)
  with pd2 have "n \<in> set(sourcenodes (a#asx'))" by(simp add:postdominate_def)
  with source have "n = n' \<or> n \<in> set(sourcenodes asx')" by(simp add:sourcenodes_def)
  thus ?thesis
  proof
    assume "n = n'" thus ?thesis .
  next
    assume "n \<in> set(sourcenodes asx')"
    then obtain nsx' nsx'' where "sourcenodes asx' = nsx'@n#nsx''"
      by(auto dest:split_list)
    then obtain asi asi' a' where asx':"asx' = asi@a'#asi'"
      and source':"sourcenode a' = n"
      by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
    with path1 as have "n -(asx@a#asi)@a'#asi'\<rightarrow>* (_Exit_)" by simp
    with source' have "n -a'#asi'\<rightarrow>* (_Exit_)" by(fastforce dest:path_split_second)
    with pd1 have "n' \<in> set(sourcenodes (a'#asi'))" by(auto simp:postdominate_def)
    with source' have "n' = n \<or> n' \<in> set(sourcenodes asi')"
      by(simp add:sourcenodes_def)
    thus ?thesis
    proof
      assume "n' = n" thus ?thesis by(rule sym)
    next
      assume "n' \<in> set(sourcenodes asi')"
      with asx' ns' have "n' \<in> set ns'" by(simp add:sourcenodes_def)
      with all have False by blast
      thus ?thesis by simp
    qed
  qed
qed

lemma postdominate_path_branch:
  assumes "n -as\<rightarrow>* n''" and "n' postdominates n''" and "\<not> n' postdominates n"
  obtains a as' as'' where "as = as'@a#as''" and "valid_edge a"
  and "\<not> n' postdominates (sourcenode a)" and "n' postdominates (targetnode a)"
proof(atomize_elim)
  from assms
  show "\<exists>as' a as''. as = as'@a#as'' \<and> valid_edge a \<and>
    \<not> n' postdominates (sourcenode a) \<and> n' postdominates (targetnode a)"
  proof(induct rule:path.induct)
    case (Cons_path n'' as nx a n)
    note IH = \<open>\<lbrakk>n' postdominates nx; \<not> n' postdominates n''\<rbrakk>
      \<Longrightarrow> \<exists>as' a as''. as = as'@a#as'' \<and> valid_edge a \<and>
        \<not> n' postdominates sourcenode a \<and> n' postdominates targetnode a\<close>
    show ?case
    proof(cases "n' postdominates n''")
      case True
      with \<open>\<not> n' postdominates n\<close> \<open>sourcenode a = n\<close> \<open>targetnode a = n''\<close>
        \<open>valid_edge a\<close>
      show ?thesis by blast
    next
      case False
      from IH[OF \<open>n' postdominates nx\<close> this] show ?thesis
        by clarsimp(rule_tac x="a#as'" in exI,clarsimp)
    qed
  qed simp
qed

lemma Exit_no_postdominator:
  "(_Exit_) postdominates n \<Longrightarrow> False"
by(fastforce dest:Exit_path simp:postdominate_def)

lemma postdominate_path_targetnode:
  assumes "n' postdominates n" and "n -as\<rightarrow>* n''" and "n' \<notin> set(sourcenodes as)"
  shows "n' postdominates n''"
proof -
  from \<open>n' postdominates n\<close> have "valid_node n" and "valid_node n'"
    and all:"\<forall>as''. n -as''\<rightarrow>* (_Exit_) \<longrightarrow> n' \<in> set(sourcenodes as'')"
    by(simp_all add:postdominate_def)
  from \<open>n -as\<rightarrow>* n''\<close> have "valid_node n''" by(fastforce dest:path_valid_node)
  have "\<forall>as''. n'' -as''\<rightarrow>* (_Exit_) \<longrightarrow> n' \<in> set(sourcenodes as'')"
  proof(rule ccontr)
    assume "\<not> (\<forall>as''. n'' -as''\<rightarrow>* (_Exit_) \<longrightarrow> n' \<in> set (sourcenodes as''))"
    then obtain as'' where "n'' -as''\<rightarrow>* (_Exit_)"
      and "n' \<notin> set (sourcenodes as'')" by blast
    from \<open>n -as\<rightarrow>* n''\<close> \<open>n'' -as''\<rightarrow>* (_Exit_)\<close> have "n -as@as''\<rightarrow>* (_Exit_)"
      by(rule path_Append)
    with \<open>n' \<notin> set(sourcenodes as)\<close> \<open>n' \<notin> set (sourcenodes as'')\<close>
    have "n' \<notin> set (sourcenodes (as@as''))"
      by(simp add:sourcenodes_def)
    with \<open>n -as@as''\<rightarrow>* (_Exit_)\<close> \<open>n' postdominates n\<close> show False
      by(simp add:postdominate_def)
  qed
  with \<open>valid_node n'\<close> \<open>valid_node n''\<close> show ?thesis by(simp add:postdominate_def)
qed

lemma not_postdominate_source_not_postdominate_target:
  assumes "\<not> n postdominates (sourcenode a)" and "valid_node n" and "valid_edge a"
  obtains ax where "sourcenode a = sourcenode ax" and "valid_edge ax"
  and "\<not> n postdominates targetnode ax"
proof(atomize_elim)
  show "\<exists>ax. sourcenode a = sourcenode ax \<and> valid_edge ax \<and>
    \<not> n postdominates targetnode ax"
  proof -
    from assms obtain asx
      where "sourcenode a -asx\<rightarrow>* (_Exit_)"
      and "n \<notin> set(sourcenodes asx)" by(auto simp:postdominate_def)
    from \<open>sourcenode a -asx\<rightarrow>* (_Exit_)\<close> \<open>valid_edge a\<close>
    obtain ax asx' where [simp]:"asx = ax#asx'"
      apply - apply(erule path.cases)
      apply(drule_tac s="(_Exit_)" in sym)
      apply simp
      apply(drule Exit_source)
      by simp_all
    with \<open>sourcenode a -asx\<rightarrow>* (_Exit_)\<close> have "sourcenode a -[]@ax#asx'\<rightarrow>* (_Exit_)"
      by simp
    hence "valid_edge ax" and "sourcenode a = sourcenode ax"
      and "targetnode ax -asx'\<rightarrow>* (_Exit_)"
      by(fastforce dest:path_split)+
    with \<open>n \<notin> set(sourcenodes asx)\<close> have "\<not> n postdominates targetnode ax"
      by(fastforce simp:postdominate_def sourcenodes_def)
    with \<open>sourcenode a = sourcenode ax\<close> \<open>valid_edge ax\<close> show ?thesis by blast
  qed
qed

lemma inner_node_Entry_edge:
  assumes "inner_node n"
  obtains a where "valid_edge a" and "inner_node (targetnode a)"
  and "sourcenode a = (_Entry_)"
proof(atomize_elim)
  from \<open>inner_node n\<close> have "valid_node n" by(rule inner_is_valid)
  then obtain as where "(_Entry_) -as\<rightarrow>* n" by(fastforce dest:Entry_path)
  show "\<exists>a. valid_edge a \<and> inner_node (targetnode a) \<and> sourcenode a = (_Entry_)"
  proof(cases "as = []")
    case True
    with \<open>inner_node n\<close> \<open>(_Entry_) -as\<rightarrow>* n\<close> have False
      by(fastforce simp:inner_node_def)
    thus ?thesis by simp
  next
    case False
    with \<open>(_Entry_) -as\<rightarrow>* n\<close> obtain a' as' where "as = a'#as'"
      and "(_Entry_) = sourcenode a'" and "valid_edge a'"
      and "targetnode a' -as'\<rightarrow>* n"
      by -(erule path_split_Cons)
    from \<open>valid_edge a'\<close> have "valid_node (targetnode a')" by simp
    thus ?thesis
    proof(cases "targetnode a'" rule:valid_node_cases)
      case Entry
      from \<open>valid_edge a'\<close> this have False by(rule Entry_target)
      thus ?thesis by simp
    next
      case Exit
      with \<open>targetnode a' -as'\<rightarrow>* n\<close> \<open>inner_node n\<close>
      have False by simp (drule path_Exit_source,auto simp:inner_node_def)
      thus ?thesis by simp
    next
      case inner
      with \<open>valid_edge a'\<close> \<open>(_Entry_) = sourcenode a'\<close> show ?thesis by simp blast
    qed
  qed
qed

lemma inner_node_Exit_edge:
  assumes "inner_node n"
  obtains a where "valid_edge a" and "inner_node (sourcenode a)"
  and "targetnode a = (_Exit_)"
proof(atomize_elim)
  from \<open>inner_node n\<close> have "valid_node n" by(rule inner_is_valid)
  then obtain as where "n -as\<rightarrow>* (_Exit_)" by(fastforce dest:Exit_path)
  show "\<exists>a. valid_edge a \<and> inner_node (sourcenode a) \<and> targetnode a = (_Exit_)"
  proof(cases "as = []")
    case True
    with \<open>inner_node n\<close> \<open>n -as\<rightarrow>* (_Exit_)\<close> have False by fastforce
    thus ?thesis by simp
  next
    case False
    with \<open>n -as\<rightarrow>* (_Exit_)\<close> obtain a' as' where "as = as'@[a']"
      and "n -as'\<rightarrow>* sourcenode a'" and "valid_edge a'"
      and "(_Exit_) = targetnode a'" by -(erule path_split_snoc)
    from \<open>valid_edge a'\<close> have "valid_node (sourcenode a')" by simp
    thus ?thesis
    proof(cases "sourcenode a'" rule:valid_node_cases)
      case Entry
      with \<open>n -as'\<rightarrow>* sourcenode a'\<close> \<open>inner_node n\<close>
      have False by simp (drule path_Entry_target,auto simp:inner_node_def)
      thus ?thesis by simp
    next
      case Exit
      from \<open>valid_edge a'\<close> this have False by(rule Exit_source)
      thus ?thesis by simp
    next
      case inner
      with \<open>valid_edge a'\<close> \<open>(_Exit_) = targetnode a'\<close> show ?thesis by simp blast
    qed
  qed
qed

end

subsection \<open>Strong Postdomination\<close>

locale StrongPostdomination =
  Postdomination sourcenode targetnode kind valid_edge Entry Exit
  for sourcenode :: "'edge \<Rightarrow> 'node" and targetnode :: "'edge \<Rightarrow> 'node"
  and kind :: "'edge \<Rightarrow> 'state edge_kind" and valid_edge :: "'edge \<Rightarrow> bool"
  and Entry :: "'node" ("'('_Entry'_')") and Exit :: "'node" ("'('_Exit'_')") +
  assumes successor_set_finite: "valid_node n \<Longrightarrow>
  finite {n'. \<exists>a'. valid_edge a' \<and> sourcenode a' = n \<and> targetnode a' = n'}"

begin

definition  strong_postdominate :: "'node \<Rightarrow> 'node \<Rightarrow> bool"
("_ strongly-postdominates _" [51,0])
where strong_postdominate_def:"n' strongly-postdominates n \<equiv>
  (n' postdominates n \<and>
  (\<exists>k \<ge> 1. \<forall>as nx. n -as\<rightarrow>* nx \<and>
                    length as \<ge> k \<longrightarrow> n' \<in> set(sourcenodes as)))"

lemma strong_postdominate_prop_smaller_path:
  assumes all:"\<forall>as nx. n -as\<rightarrow>* nx \<and> length as \<ge> k \<longrightarrow> n' \<in> set(sourcenodes as)"
  and "n -as\<rightarrow>* n''" and "length as \<ge> k"
  obtains as' as'' where "n -as'\<rightarrow>* n'" and "length as' < k" and "n' -as''\<rightarrow>* n''"
  and "as = as'@as''"
proof(atomize_elim)
  show "\<exists>as' as''. n -as'\<rightarrow>* n' \<and> length as' < k \<and> n' -as''\<rightarrow>* n'' \<and> as = as'@as''"
  proof(rule ccontr)
    assume "\<not> (\<exists>as' as''. n -as'\<rightarrow>* n' \<and> length as' < k \<and> n' -as''\<rightarrow>* n'' \<and>
                          as = as'@as'')"
    hence all':"\<forall>as' as''. n -as'\<rightarrow>* n' \<and> n' -as''\<rightarrow>* n'' \<and> as = as'@as''
      \<longrightarrow> length as' \<ge> k" by fastforce
    from all \<open>n -as\<rightarrow>* n''\<close> \<open>length as \<ge> k\<close> have "\<exists>nx \<in> set(sourcenodes as). nx = n'"
      by fastforce
    then obtain ns ns' where "sourcenodes as = ns@n'#ns'"
      and "\<forall>nx \<in> set ns. nx \<noteq> n'"
      by(fastforce elim!:split_list_first_propE)
    then obtain asx a asx' where [simp]:"ns = sourcenodes asx"
      and [simp]:"as = asx@a#asx'" and "sourcenode a = n'"
      by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
    from \<open>n -as\<rightarrow>* n''\<close> have "n -asx@a#asx'\<rightarrow>* n''" by simp
    with \<open>sourcenode a = n'\<close> have "n -asx\<rightarrow>* n'" and "valid_edge a"
      and "targetnode a -asx'\<rightarrow>* n''" by(fastforce dest:path_split)+
    with \<open>sourcenode a = n'\<close> have "n' -a#asx'\<rightarrow>* n''" by(fastforce intro:Cons_path)
    with \<open>n -asx\<rightarrow>* n'\<close> all' have "length asx \<ge> k" by simp
    with \<open>n -asx\<rightarrow>* n'\<close> all have "n' \<in> set(sourcenodes asx)" by fastforce
    with \<open>\<forall>nx \<in> set ns. nx \<noteq> n'\<close> show False by fastforce
  qed
qed

lemma strong_postdominate_refl:
  assumes "valid_node n" and "n \<noteq> (_Exit_)"
  shows "n strongly-postdominates n"
proof -
  from assms have "n postdominates n" by(rule postdominate_refl)
  { fix as nx assume "n -as\<rightarrow>* nx" and "length as \<ge> 1"
    then obtain a' as' where [simp]:"as = a'#as'" by(cases as) auto
    with \<open>n -as\<rightarrow>* nx\<close> have "n -[]@a'#as'\<rightarrow>* nx" by simp
    hence "n = sourcenode a'" by(fastforce dest:path_split)
    hence "n \<in> set(sourcenodes as)" by(simp add:sourcenodes_def) }
  hence "\<forall>as nx. n -as\<rightarrow>* nx \<and> length as \<ge> 1 \<longrightarrow> n \<in> set(sourcenodes as)"
    by auto
  hence "\<exists>k \<ge> 1. \<forall>as nx. n -as\<rightarrow>* nx \<and> length as \<ge> k \<longrightarrow> n \<in> set(sourcenodes as)"
    by blast
  with \<open>n postdominates n\<close> show ?thesis by(simp add:strong_postdominate_def)
qed

lemma strong_postdominate_trans:
  assumes "n'' strongly-postdominates n" and "n' strongly-postdominates n''"
  shows "n' strongly-postdominates n"
proof -
  from \<open>n'' strongly-postdominates n\<close> have "n'' postdominates n"
    and paths1:"\<exists>k \<ge> 1. \<forall>as nx. n -as\<rightarrow>* nx \<and> length as \<ge> k
             \<longrightarrow> n'' \<in> set(sourcenodes as)"
    by(auto simp only:strong_postdominate_def)
  from paths1 obtain k1
    where all1:"\<forall>as nx. n -as\<rightarrow>* nx \<and> length as \<ge> k1 \<longrightarrow> n'' \<in> set(sourcenodes as)"
    and "k1 \<ge> 1" by blast
  from \<open>n' strongly-postdominates n''\<close> have "n' postdominates n''"
    and paths2:"\<exists>k \<ge> 1. \<forall>as nx. n'' -as\<rightarrow>* nx \<and> length as \<ge> k
             \<longrightarrow> n' \<in> set(sourcenodes as)"
    by(auto simp only:strong_postdominate_def)
  from paths2 obtain k2
    where all2:"\<forall>as nx. n'' -as\<rightarrow>* nx \<and> length as \<ge> k2 \<longrightarrow> n' \<in> set(sourcenodes as)"
    and "k2 \<ge> 1" by blast
  from \<open>n'' postdominates n\<close> \<open>n' postdominates n''\<close>
  have "n' postdominates n" by(rule postdominate_trans)
  { fix as nx assume "n -as\<rightarrow>* nx" and "length as \<ge> k1 + k2"
    hence "length as \<ge> k1" by fastforce
    with \<open>n -as\<rightarrow>* nx\<close> all1 obtain asx asx' where "n -asx\<rightarrow>* n''"
      and "length asx < k1" and "n'' -asx'\<rightarrow>* nx"
      and [simp]:"as = asx@asx'" by -(erule strong_postdominate_prop_smaller_path)
    with \<open>length as \<ge> k1 + k2\<close> have "length asx' \<ge> k2" by fastforce
    with \<open>n'' -asx'\<rightarrow>* nx\<close> all2 have "n' \<in> set(sourcenodes asx')" by fastforce
    hence "n' \<in> set(sourcenodes as)" by(simp add:sourcenodes_def) }
  with \<open>k1 \<ge> 1\<close> \<open>k2 \<ge> 1\<close> have "\<exists>k \<ge> 1. \<forall>as nx. n -as\<rightarrow>* nx \<and> length as \<ge> k
             \<longrightarrow> n' \<in> set(sourcenodes as)"
    by(rule_tac x="k1 + k2" in exI,auto)
  with \<open>n' postdominates n\<close> show ?thesis by(simp add:strong_postdominate_def)
qed

lemma strong_postdominate_antisym:
  "\<lbrakk>n' strongly-postdominates n; n strongly-postdominates n'\<rbrakk> \<Longrightarrow> n = n'"
by(fastforce intro:postdominate_antisym simp:strong_postdominate_def)

lemma strong_postdominate_path_branch:
  assumes "n -as\<rightarrow>* n''" and "n' strongly-postdominates n''"
  and "\<not> n' strongly-postdominates n"
  obtains a as' as'' where "as = as'@a#as''" and "valid_edge a"
  and "\<not> n' strongly-postdominates (sourcenode a)"
  and "n' strongly-postdominates (targetnode a)"
proof(atomize_elim)
  from assms
  show "\<exists>as' a as''. as = as'@a#as'' \<and> valid_edge a \<and>
    \<not> n' strongly-postdominates (sourcenode a) \<and>
      n' strongly-postdominates (targetnode a)"
  proof(induct rule:path.induct)
    case (Cons_path n'' as nx a n)
    note IH = \<open>\<lbrakk>n' strongly-postdominates nx; \<not> n' strongly-postdominates n''\<rbrakk>
      \<Longrightarrow> \<exists>as' a as''. as = as'@a#as'' \<and> valid_edge a \<and>
        \<not> n' strongly-postdominates sourcenode a \<and>
          n' strongly-postdominates targetnode a\<close>
    show ?case
    proof(cases "n' strongly-postdominates n''")
      case True
      with \<open>\<not> n' strongly-postdominates n\<close> \<open>sourcenode a = n\<close> \<open>targetnode a = n''\<close>
        \<open>valid_edge a\<close>
      show ?thesis by blast
    next
      case False
      from IH[OF \<open>n' strongly-postdominates nx\<close> this] show ?thesis
        by clarsimp(rule_tac x="a#as'" in exI,clarsimp)
    qed
  qed simp
qed

lemma Exit_no_strong_postdominator:
  "\<lbrakk>(_Exit_) strongly-postdominates n; n -as\<rightarrow>* (_Exit_)\<rbrakk> \<Longrightarrow> False"
by(fastforce intro:Exit_no_postdominator path_valid_node simp:strong_postdominate_def)

lemma strong_postdominate_path_targetnode:
  assumes "n' strongly-postdominates n" and "n -as\<rightarrow>* n''"
  and "n' \<notin> set(sourcenodes as)"
  shows "n' strongly-postdominates n''"
proof -
  from \<open>n' strongly-postdominates n\<close> have "n' postdominates n"
    and "\<exists>k \<ge> 1. \<forall>as nx. n -as\<rightarrow>* nx \<and> length as \<ge> k
             \<longrightarrow> n' \<in> set(sourcenodes as)"
    by(auto simp only:strong_postdominate_def)
  then obtain k where "k \<ge> 1"
    and paths:"\<forall>as nx. n -as\<rightarrow>* nx \<and> length as \<ge> k
                         \<longrightarrow> n' \<in> set(sourcenodes as)" by auto
  from \<open>n' postdominates n\<close> \<open>n -as\<rightarrow>* n''\<close> \<open>n' \<notin> set(sourcenodes as)\<close>
  have "n' postdominates n''"
    by(rule postdominate_path_targetnode)
  { fix as' nx assume "n'' -as'\<rightarrow>* nx" and "length as' \<ge> k"
    with \<open>n -as\<rightarrow>* n''\<close> have "n -as@as'\<rightarrow>* nx" and "length (as@as') \<ge> k"
      by(auto intro:path_Append)
    with paths have "n' \<in> set(sourcenodes (as@as'))" by fastforce
    with \<open>n' \<notin> set(sourcenodes as)\<close> have "n' \<in> set(sourcenodes as')"
      by(fastforce simp:sourcenodes_def) }
  with \<open>k \<ge> 1\<close> have "\<exists>k \<ge> 1. \<forall>as' nx. n'' -as'\<rightarrow>* nx \<and> length as' \<ge> k
             \<longrightarrow> n' \<in> set(sourcenodes as')" by auto
  with \<open>n' postdominates n''\<close> show ?thesis by(simp add:strong_postdominate_def)
qed

lemma not_strong_postdominate_successor_set:
  assumes "\<not> n strongly-postdominates (sourcenode a)" and "valid_node n"
  and "valid_edge a"
  and all:"\<forall>nx \<in> N. \<exists>a'. valid_edge a' \<and> sourcenode a' = sourcenode a \<and>
    targetnode a' = nx \<and> n strongly-postdominates nx"
  obtains a' where "valid_edge a'" and "sourcenode a' =  sourcenode a"
  and "targetnode a' \<notin> N"
proof(atomize_elim)
  show "\<exists>a'. valid_edge a' \<and> sourcenode a' =  sourcenode a \<and> targetnode a' \<notin> N"
  proof(cases "n postdominates (sourcenode a)")
    case False
    with \<open>valid_edge a\<close> \<open>valid_node n\<close>
    obtain a' where [simp]:"sourcenode a = sourcenode a'"
      and "valid_edge a'" and "\<not> n postdominates targetnode a'"
      by -(erule not_postdominate_source_not_postdominate_target)
    with all have "targetnode a' \<notin> N" by(auto simp:strong_postdominate_def)
    with \<open>valid_edge a'\<close> show ?thesis by simp blast
  next
    case True
    let ?M = "{n'. \<exists>a'. valid_edge a' \<and> sourcenode a' =  sourcenode a \<and>
                         targetnode a' = n'}"
    let ?M' = "{n'. \<exists>a'. valid_edge a' \<and> sourcenode a' =  sourcenode a \<and>
                          targetnode a' = n' \<and> n strongly-postdominates n'}"
    let ?N' = "(\<lambda>n'. SOME i. i \<ge> 1 \<and>
      (\<forall>as nx. n' -as\<rightarrow>* nx \<and> length as \<ge> i
                                \<longrightarrow> n \<in> set(sourcenodes as))) ` N"
    obtain k where [simp]:"k = Max ?N'" by simp
    have eq:"{x \<in> ?M. (\<lambda>n'. n strongly-postdominates n') x} = ?M'" by auto
    from \<open>valid_edge a\<close> have "finite ?M" by(simp add:successor_set_finite)
    hence "finite {x \<in> ?M. (\<lambda>n'. n strongly-postdominates n') x}" by fastforce
    with eq have "finite ?M'" by simp
    from all have "N \<subseteq> ?M'" by auto
    with \<open>finite ?M'\<close> have "finite N" by(auto intro:finite_subset)
    hence "finite ?N'" by fastforce
    show ?thesis
    proof(rule ccontr)
      assume "\<not> (\<exists>a'. valid_edge a' \<and> sourcenode a' = sourcenode a \<and>
                      targetnode a' \<notin> N)"
      hence allImp:"\<forall>a'. valid_edge a' \<and> sourcenode a' = sourcenode a
                         \<longrightarrow> targetnode a' \<in> N" by blast
      from True \<open>\<not> n strongly-postdominates (sourcenode a)\<close>
      have allPaths:"\<forall>k \<ge> 1. \<exists>as nx. sourcenode a -as\<rightarrow>* nx \<and> length as \<ge> k
        \<and> n \<notin> set(sourcenodes as)" by(auto simp:strong_postdominate_def)
      then obtain as nx where "sourcenode a -as\<rightarrow>* nx"
        and "length as \<ge> k + 1" and "n \<notin> set(sourcenodes as)"
        by (erule_tac x="k + 1" in allE) auto
      then obtain ax as' where [simp]:"as = ax#as'" and "valid_edge ax"
        and "sourcenode ax = sourcenode a" and "targetnode ax -as'\<rightarrow>* nx"
        by -(erule path.cases,auto)
      with allImp have "targetnode ax \<in> N" by fastforce
      with all have "n strongly-postdominates (targetnode ax)"
        by auto
      then obtain k' where k':"k' = (SOME i. i \<ge> 1 \<and>
        (\<forall>as nx. targetnode ax -as\<rightarrow>* nx \<and> length as \<ge> i
                 \<longrightarrow> n \<in> set(sourcenodes as)))" by simp
      with \<open>n strongly-postdominates (targetnode ax)\<close>
      have "k' \<ge> 1 \<and> (\<forall>as nx. targetnode ax -as\<rightarrow>* nx \<and> length as \<ge> k'
        \<longrightarrow> n \<in> set(sourcenodes as))"
        by(auto elim!:someI_ex simp:strong_postdominate_def)
      hence "k' \<ge> 1"
        and spdAll:"\<forall>as nx. targetnode ax -as\<rightarrow>* nx \<and> length as \<ge> k'
        \<longrightarrow> n \<in> set(sourcenodes as)"
        by simp_all
      from \<open>targetnode ax \<in> N\<close> k' have "k' \<in> ?N'" by blast
      with \<open>targetnode ax \<in> N\<close> have "?N' \<noteq> {}" by auto
      with \<open>k' \<in> ?N'\<close> have "k' \<le> Max ?N'" using \<open>finite ?N'\<close> by(fastforce intro:Max_ge)
      hence "k' \<le> k" by simp
      with \<open>targetnode ax -as'\<rightarrow>* nx\<close> \<open>length as \<ge> k + 1\<close> spdAll
      have "n \<in> set(sourcenodes as')"
        by fastforce
      with \<open>n \<notin> set(sourcenodes as)\<close> show False by(simp add:sourcenodes_def)
    qed
  qed
qed

lemma not_strong_postdominate_predecessor_successor:
  assumes "\<not> n strongly-postdominates (sourcenode a)"
  and "valid_node n" and "valid_edge a"
  obtains a' where "valid_edge a'" and "sourcenode a' = sourcenode a"
  and "\<not> n strongly-postdominates (targetnode a')"
proof(atomize_elim)
  show "\<exists>a'. valid_edge a' \<and> sourcenode a' = sourcenode a \<and>
             \<not> n strongly-postdominates (targetnode a')"
  proof(rule ccontr)
    assume "\<not> (\<exists>a'. valid_edge a' \<and> sourcenode a' = sourcenode a \<and>
            \<not> n strongly-postdominates targetnode a')"
    hence all:"\<forall>a'. valid_edge a' \<and> sourcenode a' = sourcenode a \<longrightarrow>
                    n strongly-postdominates (targetnode a')" by auto
    let ?N = "{n'. \<exists>a'. sourcenode a' =  sourcenode a \<and> valid_edge a' \<and>
                        targetnode a' = n'}"
    from all have "\<forall>nx \<in> ?N. \<exists>a'. valid_edge a' \<and> sourcenode a' = sourcenode a \<and>
      targetnode a' = nx \<and> n strongly-postdominates nx"
      by auto
    with assms obtain a' where "valid_edge a'"
      and "sourcenode a' =  sourcenode a" and "targetnode a' \<notin> ?N"
      by(erule not_strong_postdominate_successor_set)
    thus False by auto
  qed
qed

end

end


header  {* Syntax tree helpers *}

theory CPSUtils
imports CPSScheme
begin

text {*
This theory defines the sets @{text "lambdas p"}, @{text "calls p"}, @{text "calls p"}, @{text "vars p"}, @{text "labels p"} and @{text "prims p"} as the subexpressions of the program @{text "p"}. Finiteness is shown for each of these sets, and some rules about how these sets relate. All these rules are proven more or less the same ways, which is very inelegant due to the nesting of the type and the shape of the derived induction rule.

It would be much nicer to start with these rules and define the set inductively. Unfortunately, that approach would make it very hard to show the finiteness of the sets in question.
*}

fun lambdas :: "lambda \<Rightarrow> lambda set"
and lambdasC :: "call \<Rightarrow> lambda set"
and lambdasV :: "val \<Rightarrow> lambda set"
where "lambdas  (Lambda l vs c) = ({Lambda l vs c} \<union> lambdasC c)"
    | "lambdasC (App l d ds) = lambdasV d \<union> (UNION (set ds) lambdasV)"
    | "lambdasC (Let l binds c') = (UNION (set binds) (\<lambda>(_,l). lambdas l)
                                    \<union> lambdasC c')"
    | "lambdasV (L l) = lambdas l"
    | "lambdasV _     = {}"

fun calls :: "lambda \<Rightarrow> call set"
and callsC :: "call \<Rightarrow> call set"
and callsV :: "val \<Rightarrow> call set"
where "calls  (Lambda l vs c) = callsC c"
    | "callsC (App l d ds) = {App l d ds} \<union> callsV d \<union> (UNION (set ds) callsV)"
    | "callsC (Let l binds c') = {Let l binds c'}
                                    \<union> (UNION (set binds) (\<lambda>(_,l). calls l)
                                    \<union> callsC c')"
    | "callsV (L l) = calls l"
    | "callsV _     = {}"

lemma finite_lambdas[simp]: "finite (lambdas l)" and "finite (lambdasC c)" "finite (lambdasV v)"
by (induct rule: lambdas_lambdasC_lambdasV.induct, auto)

lemma finite_calls[simp]: "finite (calls l)" and "finite (callsC c)" "finite (callsV v)"
by (induct rule: calls_callsC_callsV.induct, auto)

fun vars :: "lambda \<Rightarrow> var set"
and varsC :: "call \<Rightarrow> var set"
and varsV :: "val \<Rightarrow> var set"
where "vars (Lambda _ vs c) = set vs \<union> varsC c"
    | "varsC (App _ a as) = varsV a \<union> UNION (set as) varsV"
    | "varsC (Let _ binds c') = UNION (set binds) (\<lambda>(v,l). {v} \<union> vars l) \<union> varsC c'"
    | "varsV (L l) = vars l"
    | "varsV (R _ v) = {v}"
    | "varsV _  = {}"

fun label :: "lambda + call \<Rightarrow> label"
where "label (Inl (Lambda l _ _)) = l"
    | "label (Inr (App l _ _)) = l"
    | "label (Inr (Let l _ _)) = l"

fun labels :: "lambda \<Rightarrow> label set"
and labelsC :: "call \<Rightarrow> label set"
and labelsV :: "val \<Rightarrow> label set"
where "labels (Lambda l vs c) = {l} \<union> labelsC c"
    | "labelsC (App l a as) = {l} \<union> labelsV a \<union> UNION (set as) labelsV"
    | "labelsC (Let l binds c') = {l} \<union> UNION (set binds) (\<lambda>(v,l). labels l) \<union> labelsC c'"
    | "labelsV (L l) = labels l"
    | "labelsV (R l _) = {l}"
    | "labelsV _  = {}"

lemma finite_labels[simp]: "finite (labels l)" and "finite (labelsC c)" "finite (labelsV v)"
by (induct rule: labels_labelsC_labelsV.induct, auto)

fun prims :: "lambda \<Rightarrow> prim set"
and primsC :: "call \<Rightarrow> prim set"
and primsV :: "val \<Rightarrow> prim set"
where "prims (Lambda _ vs c) = primsC c"
    | "primsC (App _ a as) = primsV a \<union> UNION (set as) primsV"
    | "primsC (Let _ binds c') = UNION (set binds) (\<lambda>(_,l). prims l) \<union> primsC c'"
    | "primsV (L l) = prims l"
    | "primsV (R l v) = {}"
    | "primsV (P prim) = {prim}"
    | "primsV (C l v) = {}"

lemma finite_prims[simp]: "finite (prims l)" and "finite (primsC c)" "finite (primsV v)"
by (induct rule: labels_labelsC_labelsV.induct, auto)

fun vals :: "lambda \<Rightarrow> val set"
and valsC :: "call \<Rightarrow> val set"
and valsV :: "val \<Rightarrow> val set"
where "vals (Lambda _ vs c) = valsC c"
    | "valsC (App _ a as) = valsV a \<union> UNION (set as) valsV"
    | "valsC (Let _ binds c') = UNION (set binds) (\<lambda>(_,l). vals l) \<union> valsC c'"
    | "valsV (L l) = {L l} \<union> vals l"
    | "valsV (R l v) = {R l v}"
    | "valsV (P prim) = {P prim}"
    | "valsV (C l v) = {C l v}"

lemma
  fixes list2 :: "(var \<times> lambda) list" and t :: "var\<times>lambda"
  shows lambdas1: "Lambda l vs c \<in> lambdas x \<Longrightarrow> c \<in> calls x"
  and "Lambda l vs c \<in> lambdasC y \<Longrightarrow> c \<in> callsC y"
  and "Lambda l vs c \<in> lambdasV z \<Longrightarrow> c \<in> callsV z"
  and "\<forall>z\<in> set list. Lambda l vs c \<in> lambdasV z \<longrightarrow> c \<in> callsV z"
  and "\<forall>x\<in> set list2. Lambda l vs c \<in> lambdas (snd x) \<longrightarrow> c \<in> calls (snd x)"
  and "Lambda l vs c \<in> lambdas (snd t) \<Longrightarrow> c \<in> calls (snd t)"
apply (induct rule:mutual_lambda_call_var_inducts)
apply auto
apply (case_tac c, auto)[1]
apply (rule_tac x="((a, b), ba)" in bexI, auto)
done

lemma
  shows lambdas2: "Lambda l vs c \<in> lambdas x \<Longrightarrow> l \<in> labels x"
  and "Lambda l vs c \<in> lambdasC y \<Longrightarrow> l \<in> labelsC y"
  and "Lambda l vs c \<in> lambdasV z \<Longrightarrow> l \<in> labelsV z"
  and "\<forall>z\<in> set list. Lambda l vs c \<in> lambdasV z \<longrightarrow> l \<in> labelsV z"
  and "\<forall>x\<in> set (list2 :: (var \<times> lambda) list) . Lambda l vs c \<in> lambdas (snd x) \<longrightarrow> l \<in> labels (snd x)"
  and "Lambda l vs c \<in> lambdas (snd (t:: var\<times>lambda)) \<Longrightarrow> l \<in> labels (snd t)"
apply (induct rule:mutual_lambda_call_var_inducts)
apply auto
apply (rule_tac x="((a, b), ba)" in bexI, auto)
done

lemma
  shows lambdas3: "Lambda l vs c \<in> lambdas x \<Longrightarrow> set vs \<subseteq> vars x"
  and "Lambda l vs c \<in> lambdasC y \<Longrightarrow> set vs \<subseteq> varsC y"
  and "Lambda l vs c \<in> lambdasV z \<Longrightarrow> set vs \<subseteq> varsV z"
  and "\<forall>z\<in> set list. Lambda l vs c \<in> lambdasV z \<longrightarrow> set vs \<subseteq> varsV z"
  and "\<forall>x\<in> set (list2 :: (var \<times> lambda) list) . Lambda l vs c \<in> lambdas (snd x) \<longrightarrow> set vs \<subseteq> vars (snd x)"
  and "Lambda l vs c \<in> lambdas (snd (t:: var\<times>lambda)) \<Longrightarrow> set vs \<subseteq> vars (snd t)"
apply (induct x and y and z and list and list2 and t rule:mutual_lambda_call_var_inducts)
apply auto
apply (erule_tac x="((aa, ba), bb)" in ballE)
apply (rule_tac x="((aa, ba), bb)" in bexI, auto)
done

lemma
  shows app1: "App l d ds \<in> calls x \<Longrightarrow> d \<in> vals x"
  and "App l d ds \<in> callsC y \<Longrightarrow> d \<in> valsC y"
  and "App l d ds \<in> callsV z \<Longrightarrow> d \<in> valsV z"
  and "\<forall>z\<in> set list. App l d ds \<in> callsV z \<longrightarrow> d \<in> valsV z"
  and "\<forall>x\<in> set (list2 :: (var \<times> lambda) list) . App l d ds \<in> calls (snd x) \<longrightarrow> d \<in> vals (snd x)"
  and "App l d ds \<in> calls (snd (t:: var\<times>lambda)) \<Longrightarrow> d \<in> vals (snd t)"
apply (induct x and y and z and list and list2 and t rule:mutual_lambda_call_var_inducts)
apply auto
apply (case_tac d, auto)
apply (erule_tac x="((a, b), ba)" in ballE)
apply (rule_tac x="((a, b), ba)" in bexI, auto)
done

lemma
  shows app2: "App l d ds \<in> calls x \<Longrightarrow> set ds \<subseteq> vals x"
  and "App l d ds \<in> callsC y \<Longrightarrow> set ds \<subseteq> valsC y"
  and "App l d ds \<in> callsV z \<Longrightarrow> set ds \<subseteq> valsV z"
  and "\<forall>z\<in> set list. App l d ds \<in> callsV z \<longrightarrow> set ds \<subseteq> valsV z"
  and "\<forall>x\<in> set (list2 :: (var \<times> lambda) list) . App l d ds \<in> calls (snd x) \<longrightarrow> set ds \<subseteq> vals (snd x)"
  and "App l d ds \<in> calls (snd (t:: var\<times>lambda)) \<Longrightarrow> set ds \<subseteq> vals (snd t)"
apply (induct  x and y and z and list and list2 and t rule:mutual_lambda_call_var_inducts)
apply auto
apply (case_tac x, auto)
apply (erule_tac x="((a, b), ba)" in ballE)
apply (rule_tac x="((a, b), ba)" in bexI, auto)
done

lemma
  shows let1: "Let l binds c' \<in> calls x \<Longrightarrow> l \<in> labels x"
  and "Let l binds c' \<in> callsC y \<Longrightarrow> l \<in> labelsC y"
  and "Let l binds c' \<in> callsV z \<Longrightarrow> l \<in> labelsV z"
  and "\<forall>z\<in> set list. Let l binds c' \<in> callsV z \<longrightarrow> l \<in> labelsV z"
  and "\<forall>x\<in> set (list2 :: (var \<times> lambda) list) . Let l binds c' \<in> calls (snd x) \<longrightarrow> l \<in> labels (snd x)"
  and "Let l binds c' \<in> calls (snd (t:: var\<times>lambda)) \<Longrightarrow> l \<in> labels (snd t)"
apply (induct x and y and z and list and list2 and t rule:mutual_lambda_call_var_inducts)
apply auto
apply (erule_tac x="((a, b), ba)" in ballE)
apply (rule_tac x="((a, b), ba)" in bexI, auto)
done

lemma
  shows let2: "Let l binds c' \<in> calls x \<Longrightarrow> c' \<in> calls x"
  and "Let l binds c' \<in> callsC y \<Longrightarrow> c' \<in> callsC y"
  and "Let l binds c' \<in> callsV z \<Longrightarrow> c' \<in> callsV z"
  and "\<forall>z\<in> set list. Let l binds c' \<in> callsV z \<longrightarrow> c' \<in> callsV z"
  and "\<forall>x\<in> set (list2 :: (var \<times> lambda) list) . Let l binds c' \<in> calls (snd x) \<longrightarrow> c' \<in> calls (snd x)"
  and "Let l binds c' \<in> calls (snd (t:: var\<times>lambda)) \<Longrightarrow> c' \<in> calls (snd t)"
apply (induct x and y and z and list and list2 and t rule:mutual_lambda_call_var_inducts)
apply auto
apply (case_tac c', auto)
apply (erule_tac x="((a, b), ba)" in ballE)
apply (rule_tac x="((a, b), ba)" in bexI, auto)
done

lemma
  shows let3: "Let l binds c' \<in> calls x \<Longrightarrow> fst ` set binds \<subseteq> vars x"
  and "Let l binds c' \<in> callsC y \<Longrightarrow> fst ` set binds \<subseteq> varsC y"
  and "Let l binds c' \<in> callsV z \<Longrightarrow> fst ` set binds \<subseteq> varsV z"
  and "\<forall>z\<in> set list. Let l binds c' \<in> callsV z \<longrightarrow> fst ` set binds \<subseteq> varsV z"
  and "\<forall>x\<in> set (list2 :: (var \<times> lambda) list) . Let l binds c' \<in> calls (snd x) \<longrightarrow> fst ` set binds \<subseteq> vars (snd x)"
  and "Let l binds c' \<in> calls (snd (t:: var\<times>lambda)) \<Longrightarrow> fst ` set binds \<subseteq> vars (snd t)"
apply (induct x and y and z and list and list2 and t rule:mutual_lambda_call_var_inducts)
apply auto
apply (erule_tac x="((ab, bc), bd)" in ballE)
apply (rule_tac x="((ab, bc), bd)" in bexI, auto)
done

lemma
  shows let4: "Let l binds c' \<in> calls x \<Longrightarrow> snd ` set binds \<subseteq> lambdas x"
  and "Let l binds c' \<in> callsC y \<Longrightarrow> snd ` set binds \<subseteq> lambdasC y"
  and "Let l binds c' \<in> callsV z \<Longrightarrow> snd ` set binds \<subseteq> lambdasV z"
  and "\<forall>z\<in> set list. Let l binds c' \<in> callsV z \<longrightarrow> snd ` set binds \<subseteq> lambdasV z"
  and "\<forall>x\<in> set (list2 :: (var \<times> lambda) list) . Let l binds c' \<in> calls (snd x) \<longrightarrow> snd ` set binds \<subseteq> lambdas (snd x)"
  and "Let l binds c' \<in> calls (snd (t:: var\<times>lambda)) \<Longrightarrow> snd ` set binds \<subseteq> lambdas (snd t)"
apply (induct x and y and z and list and list2 and t rule:mutual_lambda_call_var_inducts)
apply auto
apply (rule_tac x="((a, b), ba)" in bexI, auto)
apply (case_tac ba, auto)
apply (erule_tac x="((aa, bb), bc)" in ballE)
apply (rule_tac x="((aa, bb), bc)" in bexI, auto)
done

lemma
shows vals1: "P prim \<in> vals p \<Longrightarrow> prim \<in> prims p"
  and "P prim \<in> valsC y \<Longrightarrow> prim \<in> primsC y"
  and "P prim \<in> valsV z \<Longrightarrow> prim \<in> primsV z"
  and "\<forall>z\<in> set list. P prim \<in> valsV z \<longrightarrow> prim \<in> primsV z"
  and "\<forall>x\<in> set (list2 :: (var \<times> lambda) list) . P prim \<in> vals (snd x) \<longrightarrow> prim \<in> prims (snd x)"
  and "P prim \<in> vals (snd (t:: var\<times>lambda)) \<Longrightarrow> prim \<in> prims (snd t)"
apply (induct rule:mutual_lambda_call_var_inducts)
apply auto
apply (erule_tac x="((a, b), ba)" in ballE)
apply (rule_tac x="((a, b), ba)" in bexI, auto)
done

lemma
shows vals2: "R l var \<in> vals p \<Longrightarrow> var \<in> vars p"
  and "R l var \<in> valsC y \<Longrightarrow> var \<in> varsC y"
  and "R l var \<in> valsV z \<Longrightarrow> var \<in> varsV z"
  and "\<forall>z\<in> set list. R l var \<in> valsV z \<longrightarrow> var \<in> varsV z"
  and "\<forall>x\<in> set (list2 :: (var \<times> lambda) list) . R l var \<in> vals (snd x) \<longrightarrow> var \<in> vars (snd x)"
  and "R l var \<in> vals (snd (t:: var\<times>lambda)) \<Longrightarrow> var \<in> vars (snd t)"
apply (induct rule:mutual_lambda_call_var_inducts)
apply auto
apply (erule_tac x="((a, b), ba)" in ballE)
apply (rule_tac x="((a, b), ba)" in bexI, auto)
done

lemma
shows vals3: "L l \<in> vals p \<Longrightarrow> l \<in> lambdas p"
  and "L l \<in> valsC y \<Longrightarrow> l \<in> lambdasC y"
  and "L l \<in> valsV z \<Longrightarrow> l \<in> lambdasV z"
  and "\<forall>z\<in> set list. L l \<in> valsV z \<longrightarrow> l \<in> lambdasV z"
  and "\<forall>x\<in> set (list2 :: (var \<times> lambda) list) . L l \<in> vals (snd x) \<longrightarrow> l \<in> lambdas (snd x)"
  and "L l \<in> vals (snd (t:: var\<times>lambda)) \<Longrightarrow> l \<in> lambdas (snd t)"
apply (induct rule:mutual_lambda_call_var_inducts)
apply auto
apply (erule_tac x="((a, b), ba)" in ballE)
apply (rule_tac x="((a, b), ba)" in bexI, auto)
apply (case_tac l, auto)
done

definition nList :: "'a set => nat => 'a list set"
where "nList A n \<equiv> {l. set l \<le> A \<and> length l = n}"

definition NList :: "'a set => nat set => 'a list set"
where "NList A N \<equiv> \<Union> n \<in> N. nList A n"

lemma finite_Nlist[intro]:
  "\<lbrakk> finite A; finite N \<rbrakk> \<Longrightarrow> finite (NList A N)"
unfolding NList_def using assms by auto

definition call_list_lengths
  where "call_list_lengths p = {0,1,2,3} \<union> (\<lambda>c. case c of (App _ _ ds) \<Rightarrow> length ds | _ \<Rightarrow> 0) ` calls p"

lemma finite_call_list_lengths[simp]: "finite (call_list_lengths p)"
  unfolding call_list_lengths_def by auto

end