theory Incredible_Completeness
imports Natural_Deduction Incredible_Deduction Build_Incredible_Tree
begin

text \<open>
This theory takes the tree produced in @{theory Build_Incredible_Tree}, globalizes it using
@{term globalize}, and then builds the incredible proof graph out of it.
\<close>

type_synonym 'form vertex = "('form \<times> nat list)"
type_synonym ('form, 'var) edge'' = "('form vertex, 'form, 'var) edge'"

locale Solved_Task =
  Abstract_Task  freshenLC renameLCs lconsts closed subst subst_lconsts subst_renameLCs anyP antecedent consequent rules assumptions conclusions
   for freshenLC :: "nat \<Rightarrow> 'var \<Rightarrow> 'var"
    and renameLCs :: "('var \<Rightarrow> 'var) \<Rightarrow> 'form \<Rightarrow> 'form"
    and lconsts :: "'form \<Rightarrow> 'var set"
    and closed :: "'form \<Rightarrow> bool"
    and subst :: "'subst \<Rightarrow> 'form \<Rightarrow> 'form"
    and subst_lconsts :: "'subst \<Rightarrow> 'var set"
    and subst_renameLCs :: "('var \<Rightarrow> 'var) \<Rightarrow> ('subst \<Rightarrow> 'subst)"
    and anyP :: "'form"
    and antecedent :: "'rule \<Rightarrow> ('form, 'var) antecedent list"
    and consequent :: "'rule \<Rightarrow> 'form list"
    and rules :: "'rule stream"
    and assumptions :: "'form list"
    and conclusions :: "'form list" +
  assumes solved: solved
begin

text \<open>Let us get our hand on concrete trees.\<close>

definition ts :: "'form \<Rightarrow> (('form entailment) \<times> ('rule \<times> 'form) NatRule) tree" where
  "ts c = (SOME t. snd (fst (root t)) = c \<and> fst (fst (root t)) |\<subseteq>| ass_forms \<and> wf t \<and> tfinite t)"

lemma
  assumes "c |\<in>| conc_forms"
  shows ts_conc: "snd (fst (root (ts c))) = c"
  and   ts_context: "fst (fst (root (ts c))) |\<subseteq>| ass_forms"
  and   ts_wf: "wf (ts c)"
  and   ts_finite[simp]: "tfinite (ts c)"
  unfolding atomize_conj conj_assoc ts_def
  apply (rule someI_ex)
  using solved assms
  by (force simp add: solved_def)

abbreviation it' where
  "it' c \<equiv> globalize [fidx conc_forms c, 0] (freshenLC v_away) (to_it (ts c))"

definition vertices :: "'form vertex fset"  where
  "vertices = Abs_fset (Union ( set (map (\<lambda> c. insert (c, []) ((\<lambda> p. (c, 0 # p)) ` (it_paths (it' c))))  conclusions)))"

lemma mem_vertices: "v |\<in>| vertices \<longleftrightarrow>  (fst v \<in> set conclusions \<and> (snd v = [] \<or> snd v \<in> (op # 0) ` it_paths (it' (fst v))))"
  unfolding vertices_def fmember.rep_eq ffUnion.rep_eq
  by (cases v)(auto simp add: Abs_fset_inverse Bex_def )

lemma prefixeq_vertices: "(c,is) |\<in>| vertices \<Longrightarrow> prefixeq is' is \<Longrightarrow> (c, is') |\<in>| vertices"
  by (cases is') (auto simp add: mem_vertices intro!: imageI elim: it_paths_prefixeq)

lemma none_vertices[simp]: "(c, []) |\<in>| vertices \<longleftrightarrow> c \<in> set conclusions"
  by (simp add: mem_vertices)

lemma some_vertices[simp]: "(c, i#is) |\<in>| vertices \<longleftrightarrow> c \<in> set conclusions \<and> i = 0 \<and> is \<in> it_paths (it' c)"
  by (auto simp add: mem_vertices)

lemma vertices_cases[consumes 1, case_names None Some]:
  assumes "v |\<in>| vertices"
  obtains c where "c \<in> set conclusions" and "v = (c, [])"
      |   c "is" where "c \<in> set conclusions" and "is \<in> it_paths (it' c)" and "v = (c, 0#is)"
using assms by (cases v; rename_tac "is"; case_tac "is"; auto)

lemma vertices_induct[consumes 1, case_names None Some]:
  assumes "v |\<in>| vertices"
  assumes "\<And> c. c \<in> set conclusions \<Longrightarrow> P (c, [])"
  assumes "\<And> c is . c \<in> set conclusions \<Longrightarrow> is \<in> it_paths (it' c) \<Longrightarrow> P (c, 0#is)"
  shows "P v"
using assms by (cases v; rename_tac "is"; case_tac "is"; auto)

fun nodeOf :: "'form vertex \<Rightarrow> ('form, 'rule) graph_node" where
  "nodeOf (pf, []) = Conclusion pf"
| "nodeOf (pf, i#is) = iNodeOf (tree_at (it' pf) is)"

fun inst where
  "inst (c,[]) = empty_subst"
 |"inst (c, i#is) = iSubst (tree_at (it' c) is)"

lemma terminal_is_nil[simp]: "v |\<in>| vertices \<Longrightarrow> outPorts (nodeOf v) = {||} \<longleftrightarrow> snd v = []"
 by (induction v rule: nodeOf.induct)
    (auto elim: iNodeOf_outPorts[rotated] iwf_it)

sublocale Vertex_Graph nodes inPorts outPorts vertices nodeOf.

definition edge_from :: "'form \<Rightarrow> nat list => ('form vertex \<times> ('form,'var) out_port)" where
  "edge_from c is = ((c, 0 # is),  Reg (iOutPort (tree_at (it' c) is)))"

lemma fst_edge_from[simp]: "fst (edge_from c is) = (c, 0 # is)"
  by (simp add: edge_from_def)

fun in_port_at :: "('form \<times> nat list) \<Rightarrow> nat \<Rightarrow> ('form,'var) in_port" where
    "in_port_at (c, [])  _  = plain_ant c"
  | "in_port_at (c, _#is) i = inPorts' (iNodeOf (tree_at (it' c) is)) ! i"

definition edge_to :: "'form \<Rightarrow> nat list => ('form vertex \<times> ('form,'var) in_port)"  where
 "edge_to c is =
    (case rev is of   []   \<Rightarrow> ((c, []),           in_port_at (c, []) 0)
                    | i#is \<Rightarrow> ((c, 0 # (rev is)), in_port_at (c, (0#rev is)) i))"

lemma edge_to_Nil[simp]: "edge_to c [] = ((c, []), plain_ant c)"
  by (simp add: edge_to_def)

lemma edge_to_Snoc[simp]: "edge_to c (is@[i]) = ((c, 0 # is), in_port_at ((c, 0 # is)) i)"
  by (simp add: edge_to_def)

definition edge_at :: "'form \<Rightarrow> nat list => ('form, 'var) edge''"  where
   "edge_at c is = (edge_from c is, edge_to c is)"

lemma fst_edge_at[simp]: "fst (edge_at c is) = edge_from c is" by (simp add: edge_at_def)
lemma snd_edge_at[simp]: "snd (edge_at c is) = edge_to c is" by (simp add: edge_at_def)

lemma hyps_exist':
  assumes "c \<in> set conclusions"
  assumes "is \<in> it_paths (it' c)"
  assumes "tree_at (it' c) is = (HNode i s ants)"
  shows "subst s (freshen i anyP) \<in> hyps_along (it' c) is"
proof-
  from assms(1)
  have "plain_iwf (it' c) (fst (root (ts c)))" by (rule iwf_it)
  moreover
  note assms(2,3)
  moreover
  have "fst (fst (root (ts c))) |\<subseteq>| ass_forms"
    by (simp add: assms(1) ts_context)
  ultimately
  show ?thesis by (rule iwf_hyps_exist)
qed

definition hyp_edge_to :: "'form \<Rightarrow> nat list => ('form vertex \<times> ('form,'var) in_port)" where
  "hyp_edge_to c is = ((c, 0 # is),  plain_ant anyP)"

(* TODO: Replace n and s by "subst s (freshen n anyP)" *)
definition hyp_edge_from :: "'form \<Rightarrow> nat list => nat \<Rightarrow> 'subst \<Rightarrow> ('form vertex \<times> ('form,'var) out_port)" where
  "hyp_edge_from c is n s =
    ((c, 0 # hyp_port_path_for (it' c) is (subst s (freshen n anyP))),
     hyp_port_h_for (it' c) is (subst s (freshen n anyP)))"

definition hyp_edge_at  :: "'form \<Rightarrow> nat list => nat \<Rightarrow> 'subst \<Rightarrow> ('form, 'var) edge''" where
  "hyp_edge_at c is n s = (hyp_edge_from c is n s, hyp_edge_to c is)"

lemma fst_hyp_edge_at[simp]:
  "fst (hyp_edge_at c is n s) = hyp_edge_from c is n s" by (simp add:hyp_edge_at_def)
lemma snd_hyp_edge_at[simp]:
  "snd (hyp_edge_at c is n s) = hyp_edge_to c is" by (simp add:hyp_edge_at_def)

inductive_set edges where
  regular_edge: "c \<in> set conclusions \<Longrightarrow> is \<in> it_paths (it' c) \<Longrightarrow> edge_at c is \<in> edges"
  | hyp_edge: "c \<in> set conclusions \<Longrightarrow> is \<in> it_paths (it' c) \<Longrightarrow> tree_at (it' c) is = HNode n s ants \<Longrightarrow> hyp_edge_at c is n s \<in> edges"

sublocale Pre_Port_Graph nodes inPorts outPorts vertices nodeOf edges.

lemma edge_from_valid_out_port:
  assumes "p \<in> it_paths (it' c)"
  assumes "c \<in> set conclusions"
  shows "valid_out_port (edge_from c p)"
using assms
by (auto simp add: edge_from_def intro: iwf_outPort iwf_it)

lemma edge_to_valid_in_port:
  assumes "p \<in> it_paths (it' c)"
  assumes "c \<in> set conclusions"
  shows "valid_in_port (edge_to c p)"
  using assms
  apply (auto simp add: edge_to_def inPorts_fset_of split: list.split elim!: it_paths_SnocE)
  apply (rule nth_mem)
  apply (drule (1) iwf_length_inPorts[OF iwf_it])
  apply auto
  done

lemma hyp_edge_from_valid_out_port:
  assumes "is \<in> it_paths (it' c)"
  assumes "c \<in> set conclusions"
  assumes "tree_at (it' c) is = HNode n s ants"
  shows "valid_out_port (hyp_edge_from c is n s)"
using assms
by(auto simp add: hyp_edge_from_def intro: hyp_port_outPort it_paths_prefix hyp_port_prefix  hyps_exist')

lemma hyp_edge_to_valid_in_port:
  assumes "is \<in> it_paths (it' c)"
  assumes "c \<in> set conclusions"
  assumes "tree_at (it' c) is = HNode n s ants"
  shows "valid_in_port (hyp_edge_to c is)"
using assms by (auto simp add: hyp_edge_to_def)

inductive scope' :: "'form vertex \<Rightarrow> ('form,'var) in_port \<Rightarrow> 'form \<times> nat list \<Rightarrow> bool" where
  "c \<in> set conclusions \<Longrightarrow>
   is' \<in> (op # 0) ` it_paths (it' c) \<Longrightarrow>
   prefixeq (is@[i]) is' \<Longrightarrow>
   ip = in_port_at (c,is) i \<Longrightarrow>
   scope' (c, is) ip (c, is')"

inductive_simps scope_simp: "scope' v i v'"
inductive_cases scope_cases: "scope' v i v'"

lemma scope_valid:
  "scope' v i v' \<Longrightarrow> v' |\<in>| vertices"
by (auto elim: scope_cases)

lemma scope_valid_inport:
  "v' |\<in>| vertices \<Longrightarrow> scope' v ip  v' \<longleftrightarrow> (\<exists> i. fst v = fst v' \<and> prefixeq (snd v@[i]) (snd v') \<and> ip = in_port_at v i)"
by (cases v; cases v')  (auto simp add: scope'.simps mem_vertices)

definition terminal_path_from :: "'form \<Rightarrow> nat list => ('form, 'var) edge'' list" where
   "terminal_path_from c is = map (edge_at c) (rev (inits is))"

lemma terminal_path_from_Nil[simp]:
  "terminal_path_from c [] = [edge_at c []]"
  by (simp add: terminal_path_from_def)

lemma terminal_path_from_Snoc[simp]:
  "terminal_path_from c (is @ [i]) = edge_at  c (is@[i]) # terminal_path_from c is"
  by (simp add: terminal_path_from_def)

lemma path_terminal_path_from:
  "c \<in> set conclusions \<Longrightarrow>
  is \<in> it_paths (it' c) \<Longrightarrow>
  path (c, 0 # is) (c, []) (terminal_path_from c is)"
by (induction "is" rule: rev_induct)
   (auto simp add: path_cons_simp intro!: regular_edge elim: it_paths_SnocE)

lemma edge_step:
  assumes "(((a, b), ba), ((aa, bb), bc)) \<in> edges"
  obtains
    i where "a = aa" and "b = bb@[i]" and "bc = in_port_at (aa,bb) i"  and "hyps (nodeOf (a, b)) ba = None"
  | i where "a = aa" and "prefixeq (b@[i]) bb" and "hyps (nodeOf (a, b)) ba = Some (in_port_at (a,b) i)"
using assms
proof(cases rule: edges.cases[consumes 1, case_names Reg Hyp])
  case (Reg c "is")
  then obtain i where  "a = aa" and "b = bb@[i]" and "bc = in_port_at (aa,bb) i"  and "hyps (nodeOf (a, b)) ba = None"
    by (auto elim!: edges.cases simp add: edge_at_def edge_from_def edge_to_def split: list.split list.split_asm)
  thus thesis by (rule that)
next
  case (Hyp c "is" n s)
  let ?i = "hyp_port_i_for (it' c) is (subst s (freshen n anyP))"
  from Hyp have "a = aa" and "prefixeq (b@[?i]) bb" and
    "hyps (nodeOf (a, b)) ba = Some (in_port_at (a,b) ?i)"
  by (auto simp add: edge_at_def edge_from_def edge_to_def hyp_edge_at_def hyp_edge_to_def hyp_edge_from_def
      intro: hyp_port_prefixeq hyps_exist' hyp_port_hyps)
  thus thesis by (rule that)
qed

lemma path_has_prefixes:
  assumes "path v v' pth"
  assumes "snd v' = []"
  assumes "prefixeq (is' @ [i]) (snd v)"
  shows "((fst v, is'), (in_port_at (fst v, is') i)) \<in> snd ` set pth"
  using assms
  by (induction rule: path.induct)(auto elim!: edge_step dest: prefixeq_snocD)

lemma in_scope: "valid_in_port (v', p') \<Longrightarrow> v \<in> scope (v', p') \<longleftrightarrow> scope' v' p' v"
proof
  assume "v \<in> scope (v', p')"
  hence "v |\<in>| vertices" and "\<And> pth t.  path v t pth \<Longrightarrow> terminal_vertex t \<Longrightarrow> (v', p') \<in> snd ` set pth"
    by (auto simp add: scope.simps)
  from this
  show "scope' v' p' v"
  proof (induction  rule: vertices_induct)
    case (None c)
    from None(2)[of "(c, [])" "[]", simplified, OF None(1)]
    have False.
    thus "scope' v' p' (c, [])"..
  next
    case (Some c "is")

    from `c \<in> set conclusions` `is \<in> it_paths (it' c)`
    have "path (c, 0#is) (c, []) (terminal_path_from c is)"
      by (rule path_terminal_path_from)
    moreover
    from `c \<in> set conclusions`
    have "terminal_vertex (c, [])" by simp
    ultimately
    have "(v', p') \<in> snd ` set (terminal_path_from c is)"
      by (rule Some(3))
    hence "(v',p') \<in> set (map (edge_to c) (inits is))"
      unfolding terminal_path_from_def by auto
    then obtain is' where "prefixeq is' is" and "(v',p') = edge_to c is'"
      by auto
    show "scope' v' p' (c, 0#is)"
    proof(cases "is'" rule: rev_cases)
      case Nil
      with `(v',p') = edge_to c is'`
      have "v' = (c, [])" and "p' = plain_ant c"
        by (auto simp add: edge_to_def)
      with `c \<in> set conclusions` `is \<in> it_paths (it' c)`
      show ?thesis  by (auto intro!: scope'.intros)
    next
      case (snoc is'' i)
      with `(v',p') = edge_to c is'`
      have "v' = (c, 0 # is'')" and "p' = in_port_at v' i"
        by (auto simp add: edge_to_def)
      with `c \<in> set conclusions` `is \<in> it_paths (it' c)` `prefixeq is' is`[unfolded snoc]
      show ?thesis
        by (auto intro!: scope'.intros)
    qed
  qed
next
  assume "valid_in_port (v', p')"
  assume "scope' v' p' v"
  then obtain c is' i "is" where
    "v' = (c, is')" and "v = (c, is)" and "c \<in> set conclusions" and
    "p' = in_port_at v' i" and
    "is \<in> op # 0 ` it_paths (it' c)" and  "prefixeq (is' @ [i]) is"
    by (auto simp add: scope'.simps)

  from `scope' v' p' v`
  have "(c, is) |\<in>| vertices" unfolding `v = _` by (rule scope_valid)
  hence "(c, is) \<in> scope ((c, is'), p')"
  proof(rule scope.intros)
    fix pth t
    assume "path (c,is) t pth"

    assume "terminal_vertex t"
    hence "snd t = []" by auto

    from path_has_prefixes[OF `path (c,is) t pth` `snd t = []`, simplified, OF `prefixeq (is' @ [i]) is`]
    show "((c, is'), p') \<in> snd ` set pth" unfolding `p' = _ ` `v' = _ `.
  qed
  thus "v \<in> scope (v', p')" using `v =_` `v' = _` by simp
qed

sublocale Port_Graph nodes inPorts outPorts vertices nodeOf edges
proof
  show "nodeOf ` fset vertices \<subseteq> sset nodes"
    apply (auto simp add: fmember.rep_eq[symmetric] mem_vertices)
    apply (auto simp add: stream.set_map dest: iNodeOf_tree_at[OF iwf_it])
    done
  next

  have "\<forall> e \<in> edges. valid_out_port (fst e) \<and> valid_in_port (snd e)"
    by (auto elim!: edges.cases simp add: edge_at_def
        dest: edge_from_valid_out_port edge_to_valid_in_port
        dest: hyp_edge_from_valid_out_port hyp_edge_to_valid_in_port)

  thus "\<forall>(ps1, ps2)\<in>edges. valid_out_port ps1 \<and> valid_in_port ps2" by auto
qed

sublocale Scoped_Graph nodes inPorts outPorts vertices nodeOf edges hyps..

lemma hyps_free_path_length:
  assumes "path v v' pth"
  assumes "hyps_free pth"
  shows "length pth + length (snd v') = length (snd v)"
using assms by induction (auto elim!: edge_step )

fun vidx :: "'form vertex \<Rightarrow> nat" where
   "vidx (c, [])   = isidx [fidx conc_forms c]"
  |"vidx (c, _#is) = iAnnot (tree_at (it' c) is)"

lemma my_vidx_inj: "inj_on vidx (fset vertices)"
  by (rule inj_onI)
     (auto simp add:  mem_vertices[unfolded fmember.rep_eq] iAnnot_globalize simp del: iAnnot.simps)

lemma vidx_not_v_away[simp]: "v |\<in>| vertices \<Longrightarrow> vidx v \<noteq> v_away"
  by (cases v rule:vidx.cases) (auto simp add: iAnnot_globalize  simp del: iAnnot.simps)

sublocale Instantiation inPorts outPorts nodeOf hyps  nodes edges vertices labelsIn labelsOut freshenLC renameLCs lconsts closed subst subst_lconsts subst_renameLCs anyP vidx inst
proof
  show "inj_on vidx (fset vertices)" by (rule my_vidx_inj)
qed

sublocale  Well_Scoped_Graph nodes inPorts outPorts vertices nodeOf edges hyps
proof
  fix v\<^sub>1 p\<^sub>1 v\<^sub>2 p\<^sub>2 p'
  assume assms: "((v\<^sub>1, p\<^sub>1), (v\<^sub>2, p\<^sub>2)) \<in> edges" "hyps (nodeOf v\<^sub>1) p\<^sub>1 = Some p'"
  from assms(1) hyps_correct[OF assms(2)]
  have "valid_out_port (v\<^sub>1, p\<^sub>1)" and "valid_in_port (v\<^sub>2, p\<^sub>2)" and "valid_in_port (v\<^sub>1, p')" and "v\<^sub>2 |\<in>| vertices"
    using valid_edges by auto

  from assms
  have "\<exists> i. fst v\<^sub>1 = fst v\<^sub>2 \<and> prefixeq (snd v\<^sub>1@[i]) (snd v\<^sub>2) \<and> p' = in_port_at v\<^sub>1 i"
    by (cases v\<^sub>1; cases v\<^sub>2; auto elim!: edge_step)
  hence "scope' v\<^sub>1 p' v\<^sub>2"
    unfolding scope_valid_inport[OF `v\<^sub>2 |\<in>| vertices`].
  hence "v\<^sub>2 \<in> scope (v\<^sub>1, p')"
    unfolding in_scope[OF `valid_in_port (v\<^sub>1, p')`].
  thus "(v\<^sub>2, p\<^sub>2) = (v\<^sub>1, p') \<or> v\<^sub>2 \<in> scope (v\<^sub>1, p')" ..
qed

sublocale Acyclic_Graph nodes inPorts outPorts vertices nodeOf edges hyps
proof
  fix v pth
  assume "path v v pth" and "hyps_free pth"
  from hyps_free_path_length[OF this]
  show "pth = []" by simp
qed

sublocale Saturated_Graph nodes inPorts outPorts vertices nodeOf edges
proof
  fix v p
  assume "valid_in_port (v, p)"
  thus "\<exists>e\<in>edges. snd e = (v, p)"
  proof(induction v)
    fix c cis
    assume "valid_in_port ((c, cis), p)"
    hence "c \<in> set conclusions" by (auto simp add: mem_vertices)

    show "\<exists>e\<in>edges. snd e = ((c, cis), p)"
    proof(cases cis)
      case Nil
      with `valid_in_port ((c, cis), p)`
      have [simp]: "p = plain_ant c" by simp

      have "[] \<in> it_paths (it' c)" by simp
      with `c \<in> set conclusions`
      have "edge_at c [] \<in> edges" by (rule regular_edge)
      moreover
      have "snd (edge_at c []) = ((c, []), plain_ant c)"
        by (simp add: edge_to_def)
      ultimately
      show ?thesis by (auto simp add: Nil simp del: snd_edge_at)
    next
      case (Cons c' "is")
      with `valid_in_port ((c, cis), p)`
      have [simp]: "c' = 0" and "is \<in> it_paths (it' c)"
        and "p |\<in>| inPorts (iNodeOf (tree_at (it' c) is))" by auto

      from this(3) obtain i where
        "i < length (inPorts' (iNodeOf (tree_at (it' c) is)))" and
        "p = inPorts' (iNodeOf (tree_at (it' c) is)) ! i"
          by (auto simp add: inPorts_fset_of in_set_conv_nth)

      show ?thesis
      proof (cases "tree_at (it' c) is")
        case [simp]: (RNode r ants)
        show ?thesis
        proof(cases r)
          case I
          hence "\<not> isHNode (tree_at (it' c) is)" by simp
          from iwf_length_inPorts_not_HNode[OF iwf_it[OF `c \<in> set conclusions`]  `is \<in> it_paths (it' c)` this]
               `i < length (inPorts' (iNodeOf (tree_at (it' c) is)))`
          have "i < length (children (tree_at (it' c) is))" by simp
          with `is \<in> it_paths (it' c)`
          have "is@[i] \<in> it_paths (it' c)" by (rule it_path_SnocI)
          from `c \<in> set conclusions` this
          have "edge_at c (is@[i]) \<in> edges" by (rule regular_edge)
          moreover
          have "snd (edge_at c (is@[i])) = ((c, 0 # is),  inPorts' (iNodeOf (tree_at (it' c) is)) ! i)"
            by (simp add: edge_to_def)
          ultimately
          show ?thesis by (auto simp add: Cons `p = _` simp del: snd_edge_at)
        next
          case (H n s)
          hence "tree_at (it' c) is = HNode n s ants" by simp
          from `c \<in> set conclusions` `is \<in> it_paths (it' c)`  this
          have "hyp_edge_at c is n s \<in> edges"..
          moreover
          from H `p |\<in>| inPorts (iNodeOf (tree_at (it' c) is))`
          have [simp]: "p = plain_ant anyP" by simp

          have "snd (hyp_edge_at c is n s) = ((c, 0 # is), p)"
            by (simp add: hyp_edge_to_def)
          ultimately
          show ?thesis by (auto simp add: Cons simp del: snd_hyp_edge_at)
        qed
      qed
     qed
   qed
qed

sublocale Pruned_Port_Graph nodes inPorts outPorts vertices nodeOf edges
proof
  fix v
  assume "v |\<in>| vertices"
  thus "\<exists>pth v'. path v v' pth \<and> terminal_vertex v'"
  proof(induct rule: vertices_induct)
    case (None c)
    hence "terminal_vertex (c,[])" by simp
    with path.intros(1)
    show ?case by blast
  next
    case (Some c "is")
    hence "path (c, 0 # is) (c, []) (terminal_path_from c is)"
      by (rule path_terminal_path_from)
    moreover
    have "terminal_vertex (c,[])" using Some(1) by simp
    ultimately
    show ?case by blast
  qed
qed

sublocale Well_Shaped_Graph  nodes inPorts outPorts vertices nodeOf edges hyps..

sublocale sol:Solution inPorts outPorts nodeOf hyps nodes vertices  labelsIn labelsOut freshenLC renameLCs lconsts closed subst subst_lconsts subst_renameLCs anyP vidx inst edges
proof
  fix v\<^sub>1 p\<^sub>1 v\<^sub>2 p\<^sub>2
  assume "((v\<^sub>1, p\<^sub>1), (v\<^sub>2, p\<^sub>2)) \<in> edges"
  thus "labelAtOut v\<^sub>1 p\<^sub>1 = labelAtIn v\<^sub>2 p\<^sub>2"
  proof(cases rule:edges.cases)
    case (regular_edge c "is")

    from `((v\<^sub>1, p\<^sub>1), v\<^sub>2, p\<^sub>2) = edge_at c is`
    have "(v\<^sub>1,p\<^sub>1) = edge_from c is" using fst_edge_at by (metis fst_conv)
    hence [simp]: "v\<^sub>1 = (c, 0 # is)" by (simp add: edge_from_def)

    show ?thesis
    proof(cases "is" rule:rev_cases)
      case Nil
      let "?t'" = "it' c"
      have "labelAtOut v\<^sub>1 p\<^sub>1 = subst (iSubst ?t') (freshen (vidx v\<^sub>1) (iOutPort ?t'))"
        using regular_edge Nil by (simp add: labelAtOut_def edge_at_def edge_from_def)
      also have "vidx v\<^sub>1 = iAnnot ?t'" by (simp add:  Nil)
      also have "subst (iSubst ?t') (freshen (iAnnot ?t') (iOutPort ?t')) = snd (fst (root (ts c)))"
        unfolding iwf_subst_freshen_outPort[OF iwf_it[OF `c \<in> set conclusions`]]..
      also have "\<dots> = c" using `c \<in> set conclusions` by (simp add: ts_conc)
      also have "\<dots> = labelAtIn v\<^sub>2 p\<^sub>2"
        using  `c \<in> set conclusions`  regular_edge Nil
        by (simp add: labelAtIn_def edge_at_def freshen_closed conclusions_closed closed_no_lconsts)
      finally show ?thesis.
    next
      case (snoc is' i)
      let "?t1" = "tree_at (it' c) (is'@[i])"
      let "?t2" = "tree_at (it' c) is'"
      have "labelAtOut v\<^sub>1 p\<^sub>1 = subst (iSubst ?t1) (freshen (vidx v\<^sub>1) (iOutPort ?t1))"
        using regular_edge snoc by (simp add: labelAtOut_def edge_at_def edge_from_def)
      also have "vidx v\<^sub>1 = iAnnot ?t1" using snoc regular_edge(3) by simp
      also have "subst (iSubst ?t1) (freshen (iAnnot ?t1) (iOutPort ?t1))
          = subst (iSubst ?t2) (freshen (iAnnot ?t2) (a_conc (inPorts' (iNodeOf ?t2) ! i)))"
        by (rule iwf_edge_match[OF iwf_it[OF `c \<in> set conclusions`] `is \<in> it_paths (it' c)`[unfolded snoc]])
      also have "iAnnot ?t2 = vidx (c, 0 # is')" by simp
      also have "subst (iSubst ?t2) (freshen (vidx (c, 0 # is')) (a_conc (inPorts' (iNodeOf ?t2) ! i))) = labelAtIn v\<^sub>2 p\<^sub>2"
        using regular_edge snoc by (simp add: labelAtIn_def edge_at_def)
      finally show ?thesis.
  qed
  next
    case (hyp_edge c "is" n s ants)
    let ?f = "subst s (freshen n anyP)"
    let ?h = "hyp_port_h_for (it' c) is ?f"
    let ?his = "hyp_port_path_for (it' c) is ?f"
    let "?t1" = "tree_at (it' c) ?his"
    let "?t2" = "tree_at (it' c) is"

    from `c \<in> set conclusions` `is \<in> it_paths (it' c)` `tree_at (it' c) is = HNode n s ants`
    have "?f \<in> hyps_along (it' c) is"
      by (rule hyps_exist')

    from `((v\<^sub>1, p\<^sub>1), v\<^sub>2, p\<^sub>2) = hyp_edge_at c is n s`
    have "(v\<^sub>1,p\<^sub>1) = hyp_edge_from c is n s" using fst_hyp_edge_at by (metis fst_conv)
    hence [simp]: "v\<^sub>1 = (c, 0 # ?his)" by (simp add: hyp_edge_from_def)

    have "labelAtOut v\<^sub>1 p\<^sub>1 = subst (iSubst ?t1) (freshen (vidx v\<^sub>1) (labelsOut (iNodeOf ?t1) ?h))"
      using hyp_edge by (simp add: hyp_edge_at_def hyp_edge_from_def labelAtOut_def)
    also have "vidx v\<^sub>1 = iAnnot ?t1" by simp
    also have "subst (iSubst ?t1) (freshen (iAnnot ?t1) (labelsOut (iNodeOf ?t1) ?h)) = ?f" using `?f \<in> hyps_along (it' c) is` by (rule local.hyp_port_eq[symmetric])
    also have "\<dots> = subst (iSubst ?t2) (freshen (iAnnot ?t2) anyP)"  using hyp_edge by simp
    also have "subst (iSubst ?t2) (freshen (iAnnot ?t2) anyP) = labelAtIn v\<^sub>2 p\<^sub>2"
        using hyp_edge by (simp add: labelAtIn_def  hyp_edge_at_def hyp_edge_to_def)
    finally show ?thesis.
  qed
qed

lemma node_disjoint_fresh_vars:
  assumes "n \<in> sset nodes"
  assumes "i < length (inPorts' n)"
  assumes "i' < length (inPorts' n)"
  shows "a_fresh (inPorts' n ! i) \<inter> a_fresh (inPorts' n ! i') = {} \<or> i = i'"
  using assms no_multiple_local_consts
  by (fastforce simp add: nodes_def stream.set_map)

sublocale Well_Scoped_Instantiation  freshenLC renameLCs lconsts closed subst subst_lconsts subst_renameLCs anyP inPorts outPorts nodeOf hyps  nodes vertices labelsIn labelsOut vidx inst edges local_vars
proof
  fix v p var v'
  assume "valid_in_port (v, p)"
  hence "v |\<in>| vertices" by simp

  obtain c "is" where "v = (c,is)"  by (cases v, auto)

  from `valid_in_port (v, p)` `v= _`
  have "(c,is) |\<in>| vertices"  and "p |\<in>| inPorts (nodeOf (c, is))"  by simp_all
  hence "c \<in> set conclusions" by (simp add: mem_vertices)

  from `p |\<in>| _` obtain i where
    "i < length (inPorts' (nodeOf (c, is)))" and
    "p = inPorts' (nodeOf (c, is)) ! i" by (auto simp add: inPorts_fset_of in_set_conv_nth)
  hence "p = in_port_at (c, is) i" by (cases "is") auto

  assume "v' |\<in>| vertices"
  then obtain c' is' where "v' = (c',is')" by (cases v', auto)

  assume "var \<in> local_vars (nodeOf v) p"
  hence "var \<in> a_fresh p" by simp

  assume "freshenLC (vidx v) var \<in> subst_lconsts (inst v')"
  then obtain is'' where "is' = 0#is''" and "is'' \<in> it_paths (it' c')"
    using `v' |\<in>| vertices`
    by (cases is') (auto simp add: `v'=_`)

  note `freshenLC (vidx v) var \<in> subst_lconsts (inst v')`
  also
  have "subst_lconsts (inst v') = subst_lconsts (iSubst (tree_at (it' c') is''))"
    by (simp add: `v'=_` `is'=_`)
  also
  from `is'' \<in> it_paths (it' c')`
  have "\<dots> \<subseteq> fresh_at_path (it' c') is'' \<union> range (freshenLC v_away)"
    by (rule globalize_local_consts)
  finally
  have "freshenLC (vidx v) var \<in> fresh_at_path (it' c') is''"
    using `v |\<in>| vertices` by auto
  then obtain is''' where "prefixeq is''' is''"  and "freshenLC (vidx v) var \<in> fresh_at (it' c') is'''"
    unfolding fresh_at_path_def by auto
  then obtain i' is'''' where "prefixeq (is''''@[i']) is''"
      and "freshenLC (vidx v) var \<in> fresh_at (it' c') (is''''@[i'])"
    using append_butlast_last_id[where xs = is''', symmetric]
    apply (cases "is''' = []")
    apply (auto simp del: fresh_at_snoc append_butlast_last_id)
    apply metis
    done

  from  `is'' \<in> it_paths (it' c')` `prefixeq (is''''@[i']) is''`
  have "(is''''@[i']) \<in> it_paths (it' c')" by (rule it_paths_prefixeq)
  hence "is'''' \<in> it_paths (it' c')" using append_prefixeqD it_paths_prefixeq by blast

  from this `freshenLC (vidx v) var \<in> fresh_at (it' c') (is''''@[i'])`
  have "c = c' \<and> is = 0 # is'''' \<and> var \<in> a_fresh (inPorts' (iNodeOf (tree_at (it' c') is'''')) ! i')"
    unfolding fresh_at_def' using `v |\<in>| vertices`  `v' |\<in>| vertices`
    apply (cases "is")
    apply (auto split: if_splits simp add:  iAnnot_globalize it_paths_butlast `v=_` `v'=_` `is'=_` simp del: iAnnot.simps)
    done
  hence "c' = c" and "is = 0 # is''''" and "var \<in> a_fresh (inPorts' (iNodeOf (tree_at (it' c') is'''')) ! i')" by simp_all

  from `(is''''@[i']) \<in> it_paths (it' c')`
  have "i' < length (inPorts' (nodeOf (c, is)))"
    using iwf_length_inPorts[OF iwf_it[OF `c \<in> set conclusions`]]
    by (auto elim!: it_paths_SnocE simp add: `is=_` `c' = _` order.strict_trans2)

  have "nodeOf (c, is) \<in> sset nodes"
    unfolding `is = _` `c' = _` nodeOf.simps
    by (rule iNodeOf_tree_at[OF iwf_it[OF `c \<in> set conclusions`]  `is'''' \<in> it_paths (it' c')`[unfolded `c' = _`]])

  from `var \<in> a_fresh (inPorts' (iNodeOf (tree_at (it' c') is'''')) ! i')`
       `var \<in> a_fresh p` `p = inPorts' (nodeOf (c, is)) ! i`
       node_disjoint_fresh_vars[OF
          `nodeOf (c, is) \<in> sset nodes`
          `i < length (inPorts' (nodeOf (c, is)))` `i' < length (inPorts' (nodeOf (c, is)))`]
  have "i' = i" by (auto simp add: `is=_` `c'=c`)

  from  `prefixeq (is''''@[i']) is''`
  have "prefixeq (is @ [i']) is'" by (simp add: `is'=_` `is=_`)

  from `c \<in> set conclusions`  `is'' \<in> it_paths (it' c')` `prefixeq (is @ [i']) is'`
      `p = in_port_at (c, is) i`
  have "scope' v p v'"
  unfolding `v=_` `v'=_` `c' = _` `is' = _`  `i'=_` by (auto intro: scope'.intros)
  thus "v' \<in> scope (v, p)" using `valid_in_port (v, p)` by (simp add: in_scope)
qed

sublocale Scoped_Proof_Graph freshenLC renameLCs lconsts closed subst subst_lconsts subst_renameLCs anyP  inPorts outPorts nodeOf hyps nodes vertices labelsIn labelsOut vidx inst edges local_vars..

(* interpretation of @{term Tasked_Proof_Graph} has to be named to avoid name clashes in @{term Abstract_Task}. *)
sublocale tpg:Tasked_Proof_Graph freshenLC renameLCs lconsts closed subst subst_lconsts subst_renameLCs anyP antecedent consequent rules assumptions conclusions
  vertices nodeOf edges vidx inst
proof
  show "set (map Conclusion conclusions) \<subseteq> nodeOf ` fset vertices"
  proof-
  {
    fix c
    assume "c \<in> set conclusions"
    hence "(c, []) |\<in>| vertices" by simp
    hence "nodeOf (c, []) \<in> nodeOf ` fset vertices"
      unfolding fmember.rep_eq by (rule imageI)
    hence "Conclusion c \<in> nodeOf ` fset vertices"  by simp
  } thus ?thesis by auto
  qed
qed

end

end


section \<open>Implementation of Nondeterministic Generalized Büchi Automata\<close>

theory NGBA_Implement
imports
  "NGBA_Refine"
  "../../Basic/Implement"
begin

  consts i_ngba_scheme :: "interface \<Rightarrow> interface \<Rightarrow> interface"

  context
  begin

    interpretation autoref_syn by this

    lemma ngba_scheme_itype[autoref_itype]:
      "ngba ::\<^sub>i \<langle>L\<rangle>\<^sub>i i_set \<rightarrow>\<^sub>i \<langle>S\<rangle>\<^sub>i i_set \<rightarrow>\<^sub>i (L \<rightarrow>\<^sub>i S \<rightarrow>\<^sub>i \<langle>S\<rangle>\<^sub>i i_set) \<rightarrow>\<^sub>i \<langle>\<langle>S\<rangle>\<^sub>i i_set\<rangle>\<^sub>i i_list \<rightarrow>\<^sub>i
        \<langle>L, S\<rangle>\<^sub>i i_ngba_scheme"
      "alphabet ::\<^sub>i \<langle>L, S\<rangle>\<^sub>i i_ngba_scheme \<rightarrow>\<^sub>i \<langle>L\<rangle>\<^sub>i i_set"
      "initial ::\<^sub>i \<langle>L, S\<rangle>\<^sub>i i_ngba_scheme \<rightarrow>\<^sub>i \<langle>S\<rangle>\<^sub>i i_set"
      "transition ::\<^sub>i \<langle>L, S\<rangle>\<^sub>i i_ngba_scheme \<rightarrow>\<^sub>i L \<rightarrow>\<^sub>i S \<rightarrow>\<^sub>i \<langle>S\<rangle>\<^sub>i i_set"
      "accepting ::\<^sub>i \<langle>L, S\<rangle>\<^sub>i i_ngba_scheme \<rightarrow>\<^sub>i \<langle>\<langle>S\<rangle>\<^sub>i i_set\<rangle>\<^sub>i i_list"
      by auto

  end

  datatype ('label, 'state) ngbai = ngbai
    (alphabeti: "'label list")
    (initiali: "'state list")
    (transitioni: "'label \<Rightarrow> 'state \<Rightarrow> 'state list")
    (acceptingi: "('state \<Rightarrow> bool) list")

  definition ngbai_rel :: "('label\<^sub>1 \<times> 'label\<^sub>2) set \<Rightarrow> ('state\<^sub>1 \<times> 'state\<^sub>2) set \<Rightarrow>
    (('label\<^sub>1, 'state\<^sub>1) ngbai \<times> ('label\<^sub>2, 'state\<^sub>2) ngbai) set" where
    [to_relAPP]: "ngbai_rel L S \<equiv> {(A\<^sub>1, A\<^sub>2).
      (alphabeti A\<^sub>1, alphabeti A\<^sub>2) \<in> \<langle>L\<rangle> list_rel \<and>
      (initiali A\<^sub>1, initiali A\<^sub>2) \<in> \<langle>S\<rangle> list_rel \<and>
      (transitioni A\<^sub>1, transitioni A\<^sub>2) \<in> L \<rightarrow> S \<rightarrow> \<langle>S\<rangle> list_rel \<and>
      (acceptingi A\<^sub>1, acceptingi A\<^sub>2) \<in> \<langle>S \<rightarrow> bool_rel\<rangle> list_rel}"

  lemma ngbai_param[param]:
    "(ngbai, ngbai) \<in> \<langle>L\<rangle> list_rel \<rightarrow> \<langle>S\<rangle> list_rel \<rightarrow> (L \<rightarrow> S \<rightarrow> \<langle>S\<rangle> list_rel) \<rightarrow>
      \<langle>S \<rightarrow> bool_rel\<rangle> list_rel \<rightarrow> \<langle>L, S\<rangle> ngbai_rel"
    "(alphabeti, alphabeti) \<in> \<langle>L, S\<rangle> ngbai_rel \<rightarrow> \<langle>L\<rangle> list_rel"
    "(initiali, initiali) \<in> \<langle>L, S\<rangle> ngbai_rel \<rightarrow> \<langle>S\<rangle> list_rel"
    "(transitioni, transitioni) \<in> \<langle>L, S\<rangle> ngbai_rel \<rightarrow> L \<rightarrow> S \<rightarrow> \<langle>S\<rangle> list_rel"
    "(acceptingi, acceptingi) \<in> \<langle>L, S\<rangle> ngbai_rel \<rightarrow> \<langle>S \<rightarrow> bool_rel\<rangle> list_rel"
    unfolding ngbai_rel_def fun_rel_def by auto

  definition ngbai_ngba_rel :: "('label\<^sub>1 \<times> 'label\<^sub>2) set \<Rightarrow> ('state\<^sub>1 \<times> 'state\<^sub>2) set \<Rightarrow>
    (('label\<^sub>1, 'state\<^sub>1) ngbai \<times> ('label\<^sub>2, 'state\<^sub>2) ngba) set" where
    [to_relAPP]: "ngbai_ngba_rel L S \<equiv> {(A\<^sub>1, A\<^sub>2).
      (alphabeti A\<^sub>1, alphabet A\<^sub>2) \<in> \<langle>L\<rangle> list_set_rel \<and>
      (initiali A\<^sub>1, initial A\<^sub>2) \<in> \<langle>S\<rangle> list_set_rel \<and>
      (transitioni A\<^sub>1, transition A\<^sub>2) \<in> L \<rightarrow> S \<rightarrow> \<langle>S\<rangle> list_set_rel \<and>
      (acceptingi A\<^sub>1, accepting A\<^sub>2) \<in> \<langle>S \<rightarrow> bool_rel\<rangle> list_rel}"

  lemmas [autoref_rel_intf] = REL_INTFI[of ngbai_ngba_rel i_ngba_scheme]

  lemma ngbai_ngba_param[param, autoref_rules]:
    "(ngbai, ngba) \<in> \<langle>L\<rangle> list_set_rel \<rightarrow> \<langle>S\<rangle> list_set_rel \<rightarrow> (L \<rightarrow> S \<rightarrow> \<langle>S\<rangle> list_set_rel) \<rightarrow>
      \<langle>S \<rightarrow> bool_rel\<rangle> list_rel \<rightarrow> \<langle>L, S\<rangle> ngbai_ngba_rel"
    "(alphabeti, alphabet) \<in> \<langle>L, S\<rangle> ngbai_ngba_rel \<rightarrow> \<langle>L\<rangle> list_set_rel"
    "(initiali, initial) \<in> \<langle>L, S\<rangle> ngbai_ngba_rel \<rightarrow> \<langle>S\<rangle> list_set_rel"
    "(transitioni, transition) \<in> \<langle>L, S\<rangle> ngbai_ngba_rel \<rightarrow> L \<rightarrow> S \<rightarrow> \<langle>S\<rangle> list_set_rel"
    "(acceptingi, accepting) \<in> \<langle>L, S\<rangle> ngbai_ngba_rel \<rightarrow> \<langle>S \<rightarrow> bool_rel\<rangle> list_rel"
    unfolding ngbai_ngba_rel_def fun_rel_def by auto

  definition ngbai_ngba :: "('label, 'state) ngbai \<Rightarrow> ('label, 'state) ngba" where
    "ngbai_ngba A \<equiv> ngba (set (alphabeti A)) (set (initiali A)) (\<lambda> a p. set (transitioni A a p)) (acceptingi A)"
  definition ngbai_invar :: "('label, 'state) ngbai \<Rightarrow> bool" where
    "ngbai_invar A \<equiv> distinct (alphabeti A) \<and> distinct (initiali A) \<and> (\<forall> a p. distinct (transitioni A a p))"

  lemma ngbai_ngba_id_param[param]: "(ngbai_ngba, id) \<in> \<langle>L, S\<rangle> ngbai_ngba_rel \<rightarrow> \<langle>L, S\<rangle> ngba_rel"
  proof
    fix Ai A
    assume 1: "(Ai, A) \<in> \<langle>L, S\<rangle> ngbai_ngba_rel"
    have 2: "ngbai_ngba Ai = ngba (set (alphabeti Ai)) (set (initiali Ai))
      (\<lambda> a p. set (transitioni Ai a p)) (acceptingi Ai)" unfolding ngbai_ngba_def by rule
    have 3: "id A = ngba (id (alphabet A)) (id (initial A))
      (\<lambda> a p. id (transition A a p)) (accepting A)" by simp
    show "(ngbai_ngba Ai, id A) \<in> \<langle>L, S\<rangle> ngba_rel" unfolding 2 3 using 1 by parametricity
  qed

  lemma ngbai_ngba_br: "\<langle>Id, Id\<rangle> ngbai_ngba_rel = br ngbai_ngba ngbai_invar"
  proof safe
    show "(A, B) \<in> \<langle>Id, Id\<rangle> ngbai_ngba_rel" if "(A, B) \<in> br ngbai_ngba ngbai_invar"
      for A and B :: "('a, 'b) ngba"
      using that unfolding ngbai_ngba_rel_def ngbai_ngba_def ngbai_invar_def
      by (auto simp: in_br_conv list_set_rel_def)
    show "(A, B) \<in> br ngbai_ngba ngbai_invar" if "(A, B) \<in> \<langle>Id, Id\<rangle> ngbai_ngba_rel"
      for A and B :: "('a, 'b) ngba"
    proof -
      have 1: "(ngbai_ngba A, id B) \<in> \<langle>Id, Id\<rangle> ngba_rel" using that by parametricity
      have 2: "ngbai_invar A"
        using ngbai_ngba_param(2 - 5)[param_fo, OF that]
        by (auto simp: in_br_conv list_set_rel_def ngbai_invar_def)
      show ?thesis using 1 2 unfolding in_br_conv by auto
    qed
  qed

end


theory CFGExit imports CFG begin

subsection \<open>Adds an exit node to the abstract CFG\<close>

locale CFGExit = CFG sourcenode targetnode kind valid_edge Entry
    get_proc get_return_edges procs Main
  for sourcenode :: "'edge \<Rightarrow> 'node" and targetnode :: "'edge \<Rightarrow> 'node"
  and kind :: "'edge \<Rightarrow> ('var,'val,'ret,'pname) edge_kind"
  and valid_edge :: "'edge \<Rightarrow> bool"
  and Entry :: "'node" ("'('_Entry'_')")  and get_proc :: "'node \<Rightarrow> 'pname"
  and get_return_edges :: "'edge \<Rightarrow> 'edge set"
  and procs :: "('pname \<times> 'var list \<times> 'var list) list" and Main :: "'pname" +
  fixes Exit::"'node"  ("'('_Exit'_')")
  assumes Exit_source [dest]: "\<lbrakk>valid_edge a; sourcenode a = (_Exit_)\<rbrakk> \<Longrightarrow> False"
  and get_proc_Exit:"get_proc (_Exit_) = Main"
  and Exit_no_return_target:
    "\<lbrakk>valid_edge a; kind a = Q\<hookleftarrow>\<^bsub>p\<^esub>f; targetnode a = (_Exit_)\<rbrakk> \<Longrightarrow> False"
  and Entry_Exit_edge: "\<exists>a. valid_edge a \<and> sourcenode a = (_Entry_) \<and>
    targetnode a = (_Exit_) \<and> kind a = (\<lambda>s. False)\<^sub>\<surd>"

begin

lemma Entry_noteq_Exit [dest]:
  assumes eq:"(_Entry_) = (_Exit_)" shows "False"
proof -
  from Entry_Exit_edge obtain a where "sourcenode a = (_Entry_)"
    and "valid_edge a" by blast
  with eq show False by simp(erule Exit_source)
qed

lemma Exit_noteq_Entry [dest]:"(_Exit_) = (_Entry_) \<Longrightarrow> False"
  by(rule Entry_noteq_Exit[OF sym],simp)

lemma [simp]: "valid_node (_Exit_)"
proof -
  from Entry_Exit_edge obtain a where "targetnode a = (_Exit_)"
    and "valid_edge a" by blast
  thus ?thesis by(fastforce simp:valid_node_def)
qed

subsubsection \<open>Definition of \<open>method_exit\<close>\<close>

definition method_exit :: "'node \<Rightarrow> bool"
  where "method_exit n \<equiv> n = (_Exit_) \<or>
  (\<exists>a Q p f. n = sourcenode a \<and> valid_edge a \<and> kind a = Q\<hookleftarrow>\<^bsub>p\<^esub>f)"

lemma method_exit_cases:
  "\<lbrakk>method_exit n; n = (_Exit_) \<Longrightarrow> P;
    \<And>a Q f p. \<lbrakk>n = sourcenode a; valid_edge a; kind a = Q\<hookleftarrow>\<^bsub>p\<^esub>f\<rbrakk> \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
by(fastforce simp:method_exit_def)

lemma method_exit_inner_path:
  assumes "method_exit n" and "n -as\<rightarrow>\<^sub>\<iota>* n'" shows "as = []"
  using \<open>method_exit n\<close>
proof(rule method_exit_cases)
  assume "n = (_Exit_)"
  show ?thesis
  proof(cases as)
    case (Cons a' as')
    with \<open>n -as\<rightarrow>\<^sub>\<iota>* n'\<close> have "n = sourcenode a'" and "valid_edge a'"
      by(auto elim:path_split_Cons simp:intra_path_def)
    with \<open>n = (_Exit_)\<close> have "sourcenode a' = (_Exit_)" by simp
    with \<open>valid_edge a'\<close> have False by(rule Exit_source)
    thus ?thesis by simp
  qed simp
next
  fix a Q f p
  assume "n = sourcenode a" and "valid_edge a" and "kind a = Q\<hookleftarrow>\<^bsub>p\<^esub>f"
  show ?thesis
  proof(cases as)
    case (Cons a' as')
    with \<open>n -as\<rightarrow>\<^sub>\<iota>* n'\<close> have "n = sourcenode a'" and "valid_edge a'"
      and "intra_kind (kind a')"
      by(auto elim:path_split_Cons simp:intra_path_def)
    from \<open>valid_edge a\<close> \<open>kind a = Q\<hookleftarrow>\<^bsub>p\<^esub>f\<close> \<open>valid_edge a'\<close> \<open>n = sourcenode a\<close>
      \<open>n = sourcenode a'\<close> \<open>intra_kind (kind a')\<close>
    have False by(fastforce dest:return_edges_only simp:intra_kind_def)
    thus ?thesis by simp
  qed simp
qed

subsubsection \<open>Definition of \<open>inner_node\<close>\<close>

definition inner_node :: "'node \<Rightarrow> bool"
  where inner_node_def:
  "inner_node n \<equiv> valid_node n \<and> n \<noteq> (_Entry_) \<and> n \<noteq> (_Exit_)"

lemma inner_is_valid:
  "inner_node n \<Longrightarrow> valid_node n"
by(simp add:inner_node_def valid_node_def)

lemma [dest]:
  "inner_node (_Entry_) \<Longrightarrow> False"
by(simp add:inner_node_def)

lemma [dest]:
  "inner_node (_Exit_) \<Longrightarrow> False"
by(simp add:inner_node_def)

lemma [simp]:"\<lbrakk>valid_edge a; targetnode a \<noteq> (_Exit_)\<rbrakk>
  \<Longrightarrow> inner_node (targetnode a)"
  by(simp add:inner_node_def,rule ccontr,simp,erule Entry_target)

lemma [simp]:"\<lbrakk>valid_edge a; sourcenode a \<noteq> (_Entry_)\<rbrakk>
  \<Longrightarrow> inner_node (sourcenode a)"
  by(simp add:inner_node_def,rule ccontr,simp,erule Exit_source)

lemma valid_node_cases [consumes 1, case_names "Entry" "Exit" "inner"]:
  "\<lbrakk>valid_node n; n = (_Entry_) \<Longrightarrow> Q; n = (_Exit_) \<Longrightarrow> Q;
    inner_node n \<Longrightarrow> Q\<rbrakk> \<Longrightarrow> Q"
apply(auto simp:valid_node_def)
 apply(case_tac "sourcenode a = (_Entry_)") apply auto
apply(case_tac "targetnode a = (_Exit_)") apply auto
done

subsubsection \<open>Lemmas on paths with \<open>(_Exit_)\<close>\<close>

lemma path_Exit_source:
  "\<lbrakk>n -as\<rightarrow>* n'; n = (_Exit_)\<rbrakk> \<Longrightarrow> n' = (_Exit_) \<and> as = []"
proof(induct rule:path.induct)
  case (Cons_path n'' as n' a n)
  from \<open>n = (_Exit_)\<close> \<open>sourcenode a = n\<close> \<open>valid_edge a\<close> have False
    by -(rule Exit_source,simp_all)
  thus ?case by simp
qed simp

lemma [dest]:"(_Exit_) -as\<rightarrow>* n' \<Longrightarrow> n' = (_Exit_) \<and> as = []"
  by(fastforce elim!:path_Exit_source)

lemma Exit_no_sourcenode[dest]:
  assumes isin:"(_Exit_) \<in> set (sourcenodes as)" and path:"n -as\<rightarrow>* n'"
  shows False
proof -
  from isin obtain ns' ns'' where "sourcenodes as = ns'@(_Exit_)#ns''"
    by(auto dest:split_list simp:sourcenodes_def)
  then obtain as' as'' a where "as = as'@a#as''"
    and source:"sourcenode a = (_Exit_)"
    by(fastforce elim:map_append_append_maps simp:sourcenodes_def)
  with path have "valid_edge a" by(fastforce dest:path_split)
  with source show ?thesis by -(erule Exit_source)
qed

lemma vpa_no_slpa:
  "\<lbrakk>valid_path_aux cs as; n -as\<rightarrow>* n'; valid_call_list cs n; cs \<noteq> [];
    \<forall>xs ys. as = xs@ys \<longrightarrow> (\<not> same_level_path_aux cs xs \<or> upd_cs cs xs \<noteq> [])\<rbrakk>
  \<Longrightarrow> \<exists>a Q r fs. valid_edge a \<and> kind a = Q:r\<hookrightarrow>\<^bsub>get_proc n'\<^esub>fs"
proof(induct arbitrary:n rule:vpa_induct)
  case (vpa_empty cs)
  from \<open>valid_call_list cs n\<close> \<open>cs \<noteq> []\<close> obtain Q r fs where "valid_edge (hd cs)"
    and "kind (hd cs) = Q:r\<hookrightarrow>\<^bsub>get_proc n\<^esub>fs"
    apply(unfold valid_call_list_def)
    apply(drule hd_Cons_tl[THEN sym])
    apply(erule_tac x="[]" in allE)
    apply(erule_tac x="hd cs" in allE)
    by auto
  from \<open>n -[]\<rightarrow>* n'\<close> have "n = n'" by fastforce
  with \<open>valid_edge (hd cs)\<close> \<open>kind (hd cs) = Q:r\<hookrightarrow>\<^bsub>get_proc n\<^esub>fs\<close> show ?case by blast
next
  case (vpa_intra cs a as)
  note IH = \<open>\<And>n. \<lbrakk>n -as\<rightarrow>* n'; valid_call_list cs n; cs \<noteq> [];
    \<forall>xs ys. as = xs@ys \<longrightarrow> \<not> same_level_path_aux cs xs \<or> upd_cs cs xs \<noteq> []\<rbrakk>
    \<Longrightarrow> \<exists>a' Q' r' fs'. valid_edge a' \<and> kind a' = Q':r'\<hookrightarrow>\<^bsub>get_proc n'\<^esub>fs'\<close>
  note all = \<open>\<forall>xs ys. a#as = xs@ys
    \<longrightarrow> \<not> same_level_path_aux cs xs \<or> upd_cs cs xs \<noteq> []\<close>
  from \<open>n -a#as\<rightarrow>* n'\<close> have "sourcenode a = n" and "valid_edge a"
    and "targetnode a -as\<rightarrow>* n'"
    by(auto intro:path_split_Cons)
  from \<open>valid_call_list cs n\<close> \<open>cs \<noteq> []\<close> obtain Q r fs where "valid_edge (hd cs)"
    and "kind (hd cs) = Q:r\<hookrightarrow>\<^bsub>get_proc n\<^esub>fs"
    apply(unfold valid_call_list_def)
    apply(drule hd_Cons_tl[THEN sym])
    apply(erule_tac x="[]" in allE)
    apply(erule_tac x="hd cs" in allE)
    by auto
  from \<open>valid_edge a\<close> \<open>intra_kind (kind a)\<close>
  have "get_proc (sourcenode a) = get_proc (targetnode a)" by(rule get_proc_intra)
  with \<open>kind (hd cs) = Q:r\<hookrightarrow>\<^bsub>get_proc n\<^esub>fs\<close> \<open>sourcenode a = n\<close>
  have "kind (hd cs) = Q:r\<hookrightarrow>\<^bsub>get_proc (targetnode a)\<^esub>fs" by simp
  from \<open>valid_call_list cs n\<close> \<open>sourcenode a = n\<close>
    \<open>get_proc (sourcenode a) = get_proc (targetnode a)\<close>
  have "valid_call_list cs (targetnode a)"
    apply(clarsimp simp:valid_call_list_def)
    apply(erule_tac x="cs'" in allE)
    apply(erule_tac x="c" in allE)
    by(auto split:list.split)
  from all \<open>intra_kind (kind a)\<close>
  have "\<forall>xs ys. as = xs@ys \<longrightarrow> \<not> same_level_path_aux cs xs \<or> upd_cs cs xs \<noteq> []"
    apply clarsimp apply(erule_tac x="a#xs" in allE)
    by(auto simp:intra_kind_def)
  from IH[OF \<open>targetnode a -as\<rightarrow>* n'\<close> \<open>valid_call_list cs (targetnode a)\<close>
    \<open>cs \<noteq> []\<close> this] show ?case .
next
  case (vpa_Call cs a as Q r p fs)
  note IH = \<open>\<And>n. \<lbrakk>n -as\<rightarrow>* n'; valid_call_list (a#cs) n; a#cs \<noteq> [];
    \<forall>xs ys. as = xs@ys \<longrightarrow> \<not> same_level_path_aux (a#cs) xs \<or> upd_cs (a#cs) xs \<noteq> []\<rbrakk>
    \<Longrightarrow> \<exists>a' Q' r' fs'. valid_edge a' \<and> kind a' = Q':r'\<hookrightarrow>\<^bsub>get_proc n'\<^esub>fs'\<close>
  note all = \<open>\<forall>xs ys.
    a#as = xs@ys \<longrightarrow> \<not> same_level_path_aux cs xs \<or> upd_cs cs xs \<noteq> []\<close>
  from \<open>n -a#as\<rightarrow>* n'\<close> have "sourcenode a = n" and "valid_edge a"
    and "targetnode a -as\<rightarrow>* n'"
    by(auto intro:path_split_Cons)
  from \<open>valid_edge a\<close> \<open>kind a = Q:r\<hookrightarrow>\<^bsub>p\<^esub>fs\<close> have "get_proc (targetnode a) = p"
    by(rule get_proc_call)
  with \<open>kind a = Q:r\<hookrightarrow>\<^bsub>p\<^esub>fs\<close> have "kind a = Q:r\<hookrightarrow>\<^bsub>get_proc (targetnode a)\<^esub>fs" by simp
  with \<open>valid_call_list cs n\<close> \<open>valid_edge a\<close> \<open>sourcenode a = n\<close>
  have "valid_call_list (a#cs) (targetnode a)"
    apply(clarsimp simp:valid_call_list_def)
    apply(case_tac cs') apply auto
    apply(erule_tac x="list" in allE)
    apply(erule_tac x="c" in allE)
    by(auto split:list.split simp:sourcenodes_def)
  from all \<open>kind a = Q:r\<hookrightarrow>\<^bsub>p\<^esub>fs\<close>
  have "\<forall>xs ys. as = xs@ys
    \<longrightarrow> \<not> same_level_path_aux (a#cs) xs \<or> upd_cs (a#cs) xs \<noteq> []"
    apply clarsimp apply(erule_tac x="a#xs" in allE)
    by auto
  from IH[OF \<open>targetnode a -as\<rightarrow>* n'\<close> \<open>valid_call_list (a#cs) (targetnode a)\<close>
    _ this] show ?case by simp
next
  case (vpa_ReturnEmpty cs a as Q p fx)
  from \<open>cs \<noteq> []\<close> \<open>cs = []\<close> have False by simp
  thus ?case by simp
next
  case (vpa_ReturnCons cs a as Q p f c' cs')
  note IH = \<open>\<And>n. \<lbrakk>n -as\<rightarrow>* n'; valid_call_list cs' n; cs' \<noteq> [];
    \<forall>xs ys. as = xs@ys \<longrightarrow> \<not> same_level_path_aux cs' xs \<or> upd_cs cs' xs \<noteq> []\<rbrakk>
    \<Longrightarrow> \<exists>a' Q' r' fs'. valid_edge a' \<and> kind a' = Q':r'\<hookrightarrow>\<^bsub>get_proc n'\<^esub>fs'\<close>
  note all = \<open>\<forall>xs ys. a#as = xs@ys
    \<longrightarrow> \<not> same_level_path_aux cs xs \<or> upd_cs cs xs \<noteq> []\<close>
  from \<open>n -a#as\<rightarrow>* n'\<close> have "sourcenode a = n" and "valid_edge a"
    and "targetnode a -as\<rightarrow>* n'"
    by(auto intro:path_split_Cons)
  from \<open>valid_call_list cs n\<close> \<open>cs = c'#cs'\<close> have "valid_edge c'"
    apply(clarsimp simp:valid_call_list_def)
    apply(erule_tac x="[]" in allE)
    by auto
  show ?case
  proof(cases "cs' = []")
    case True
    with all \<open>cs = c'#cs'\<close> \<open>kind a = Q\<hookleftarrow>\<^bsub>p\<^esub>f\<close> \<open>a \<in> get_return_edges c'\<close> have False
      by(erule_tac x="[a]" in allE,fastforce)
    thus ?thesis by simp
  next
    case False
    with \<open>valid_call_list cs n\<close> \<open>cs = c'#cs'\<close>
    have "valid_call_list cs' (sourcenode c')"
      apply(clarsimp simp:valid_call_list_def)
      apply(hypsubst_thin)
      apply(erule_tac x="c'#cs'" in allE)
      apply(auto simp:sourcenodes_def)
       apply(case_tac cs') apply auto
      apply(case_tac list) apply(auto simp:sourcenodes_def)
      done
    from \<open>valid_edge c'\<close> \<open>a \<in> get_return_edges c'\<close>
    have "get_proc (sourcenode c') = get_proc (targetnode a)"
      by(rule get_proc_get_return_edge)
    with \<open>valid_call_list cs' (sourcenode c')\<close>
    have "valid_call_list cs' (targetnode a)"
      apply(clarsimp simp:valid_call_list_def)
      apply(hypsubst_thin)
    apply(erule_tac x="cs'" in allE)
    apply(erule_tac x="c" in allE)
    by(auto split:list.split)
    from all \<open>kind a = Q\<hookleftarrow>\<^bsub>p\<^esub>f\<close> \<open>cs = c'#cs'\<close> \<open>a \<in> get_return_edges c'\<close>
    have "\<forall>xs ys. as = xs@ys \<longrightarrow> \<not> same_level_path_aux cs' xs \<or> upd_cs cs' xs \<noteq> []"
      apply clarsimp apply(erule_tac x="a#xs" in allE)
      by auto
    from IH[OF \<open>targetnode a -as\<rightarrow>* n'\<close> \<open>valid_call_list cs' (targetnode a)\<close>
      False this] show ?thesis .
  qed
qed

lemma valid_Exit_path_cases:
  assumes "n -as\<rightarrow>\<^sub>\<surd>* (_Exit_)" and "as \<noteq> []"
  shows "(\<exists>a' as'. as = a'#as' \<and> intra_kind(kind a')) \<or>
         (\<exists>a' as' Q p f. as = a'#as' \<and> kind a' = Q\<hookleftarrow>\<^bsub>p\<^esub>f) \<or>
         (\<exists>as' as'' n'. as = as'@as'' \<and> as' \<noteq> [] \<and> n -as'\<rightarrow>\<^bsub>sl\<^esub>* n')"
proof -
  from \<open>as \<noteq> []\<close> obtain a' as' where "as = a'#as'" by(cases as) auto
  thus ?thesis
  proof(cases "kind a'" rule:edge_kind_cases)
    case Intra with \<open>as = a'#as'\<close> show ?thesis by simp
  next
    case Return with \<open>as = a'#as'\<close> show ?thesis by simp
  next
    case (Call Q r p f)
    from \<open>n -as\<rightarrow>\<^sub>\<surd>* (_Exit_)\<close> have "n -as\<rightarrow>* (_Exit_)" and "valid_path_aux [] as"
      by(simp_all add:vp_def valid_path_def)
    from \<open>n -as\<rightarrow>* (_Exit_)\<close> \<open>as = a'#as'\<close>
    have "sourcenode a' = n" and "valid_edge a'" and "targetnode a' -as'\<rightarrow>* (_Exit_)"
      by(auto intro:path_split_Cons)
    from \<open>valid_path_aux [] as\<close> \<open>as = a'#as'\<close> Call
    have "valid_path_aux [a'] as'" by simp
    from \<open>valid_edge a'\<close> Call
    have "valid_call_list [a'] (targetnode a')"
      apply(clarsimp simp:valid_call_list_def)
      apply(case_tac cs')
      by(auto intro:get_proc_call[THEN sym])
    show ?thesis
    proof(cases "\<forall>xs ys. as' = xs@ys \<longrightarrow>
        (\<not> same_level_path_aux [a'] xs \<or> upd_cs [a'] xs \<noteq> [])")
      case True
      with \<open>valid_path_aux [a'] as'\<close> \<open>targetnode a' -as'\<rightarrow>* (_Exit_)\<close>
        \<open>valid_call_list [a'] (targetnode a')\<close>
      obtain ax Qx rx fsx where "valid_edge ax" and "kind ax = Qx:rx\<hookrightarrow>\<^bsub>get_proc (_Exit_)\<^esub>fsx"
        by(fastforce dest!:vpa_no_slpa)
      hence False by(fastforce intro:Main_no_call_target simp:get_proc_Exit)
      thus ?thesis by simp
    next
      case False
      then obtain xs ys where "as' = xs@ys" and "same_level_path_aux [a'] xs"
        and "upd_cs [a'] xs = []" by auto
      with Call have "same_level_path (a'#xs)" by(simp add:same_level_path_def)
      from \<open>upd_cs [a'] xs = []\<close> have "xs \<noteq> []" by auto
      with \<open>targetnode a' -as'\<rightarrow>* (_Exit_)\<close> \<open>as' = xs@ys\<close>
      have "targetnode a' -xs\<rightarrow>* last(targetnodes xs)"
        apply(cases xs rule:rev_cases)
        by(auto intro:path_Append path_split path_edge simp:targetnodes_def)
      with \<open>sourcenode a' = n\<close> \<open>valid_edge a'\<close> \<open>same_level_path (a'#xs)\<close>
      have "n -a'#xs\<rightarrow>\<^bsub>sl\<^esub>* last(targetnodes xs)"
        by(fastforce intro:Cons_path simp:slp_def)
      with \<open>as = a'#as'\<close> \<open>as' = xs@ys\<close> Call
      have "\<exists>as' as'' n'. as = as'@as'' \<and> as' \<noteq> [] \<and> n -as'\<rightarrow>\<^bsub>sl\<^esub>* n'"
        by(rule_tac x="a'#xs" in exI) auto
      thus ?thesis by simp
    qed
  qed
qed

lemma valid_Exit_path_descending_path:
  assumes "n -as\<rightarrow>\<^sub>\<surd>* (_Exit_)"
  obtains as' where "n -as'\<rightarrow>\<^sub>\<surd>* (_Exit_)"
  and "set(sourcenodes as') \<subseteq> set(sourcenodes as)"
  and "\<forall>a' \<in> set as'. intra_kind(kind a') \<or> (\<exists>Q f p. kind a' = Q\<hookleftarrow>\<^bsub>p\<^esub>f)"
proof(atomize_elim)
  from \<open>n -as\<rightarrow>\<^sub>\<surd>* (_Exit_)\<close>
  show "\<exists>as'. n -as'\<rightarrow>\<^sub>\<surd>* (_Exit_) \<and> set(sourcenodes as') \<subseteq> set(sourcenodes as)\<and>
              (\<forall>a' \<in> set as'. intra_kind(kind a') \<or> (\<exists>Q f p. kind a' = Q\<hookleftarrow>\<^bsub>p\<^esub>f))"
  proof(induct as arbitrary:n rule:length_induct)
    fix as n
    assume IH:"\<forall>as''. length as'' < length as \<longrightarrow>
      (\<forall>n'. n' -as''\<rightarrow>\<^sub>\<surd>* (_Exit_) \<longrightarrow>
       (\<exists>as'. n' -as'\<rightarrow>\<^sub>\<surd>* (_Exit_) \<and> set (sourcenodes as') \<subseteq> set (sourcenodes as'') \<and>
              (\<forall>a'\<in>set as'. intra_kind (kind a') \<or> (\<exists>Q f p. kind a' = Q\<hookleftarrow>\<^bsub>p\<^esub>f))))"
      and "n -as\<rightarrow>\<^sub>\<surd>* (_Exit_)"
    show "\<exists>as'. n -as'\<rightarrow>\<^sub>\<surd>* (_Exit_) \<and> set(sourcenodes as') \<subseteq> set(sourcenodes as)\<and>
              (\<forall>a' \<in> set as'. intra_kind(kind a') \<or> (\<exists>Q f p. kind a' = Q\<hookleftarrow>\<^bsub>p\<^esub>f))"
    proof(cases "as = []")
      case True
      with \<open>n -as\<rightarrow>\<^sub>\<surd>* (_Exit_)\<close> show ?thesis by(fastforce simp:sourcenodes_def vp_def)
    next
      case False
      with \<open>n -as\<rightarrow>\<^sub>\<surd>* (_Exit_)\<close>
      have "((\<exists>a' as'. as = a'#as' \<and> intra_kind(kind a')) \<or>
         (\<exists>a' as' Q p f. as = a'#as' \<and> kind a' = Q\<hookleftarrow>\<^bsub>p\<^esub>f)) \<or>
         (\<exists>as' as'' n'. as = as'@as'' \<and> as' \<noteq> [] \<and> n -as'\<rightarrow>\<^bsub>sl\<^esub>* n')"
        by(auto dest!:valid_Exit_path_cases)
      thus ?thesis apply -
      proof(erule disjE)+
        assume "\<exists>a' as'. as = a'#as' \<and> intra_kind(kind a')"
        then obtain a' as' where "as = a'#as'" and "intra_kind(kind a')" by blast
        from \<open>n -as\<rightarrow>\<^sub>\<surd>* (_Exit_)\<close> \<open>as = a'#as'\<close>
        have "sourcenode a' = n" and "valid_edge a'"
          and "targetnode a' -as'\<rightarrow>\<^sub>\<surd>* (_Exit_)"
          by(auto intro:vp_split_Cons)
        from \<open>valid_edge a'\<close> \<open>intra_kind(kind a')\<close>
        have "sourcenode a' -[a']\<rightarrow>\<^bsub>sl\<^esub>* targetnode a'"
          by(fastforce intro:path_edge intras_same_level_path simp:slp_def)
        from IH \<open>targetnode a' -as'\<rightarrow>\<^sub>\<surd>* (_Exit_)\<close> \<open>as = a'#as'\<close>
        obtain xs where "targetnode a' -xs\<rightarrow>\<^sub>\<surd>* (_Exit_)"
          and "set (sourcenodes xs) \<subseteq> set (sourcenodes as')"
          and "\<forall>a'\<in>set xs. intra_kind (kind a') \<or> (\<exists>Q f p. kind a' = Q\<hookleftarrow>\<^bsub>p\<^esub>f)"
          apply(erule_tac x="as'" in allE) by auto
        from \<open>sourcenode a' -[a']\<rightarrow>\<^bsub>sl\<^esub>* targetnode a'\<close> \<open>targetnode a' -xs\<rightarrow>\<^sub>\<surd>* (_Exit_)\<close>
        have "sourcenode a' -[a']@xs\<rightarrow>\<^sub>\<surd>* (_Exit_)" by(rule slp_vp_Append)
        with \<open>sourcenode a' = n\<close> have "n -a'#xs\<rightarrow>\<^sub>\<surd>* (_Exit_)" by simp
        moreover
        from \<open>set (sourcenodes xs) \<subseteq> set (sourcenodes as')\<close> \<open>as = a'#as'\<close>
        have "set (sourcenodes (a'#xs)) \<subseteq> set (sourcenodes as)"
          by(auto simp:sourcenodes_def)
        moreover
        from \<open>\<forall>a'\<in>set xs. intra_kind (kind a') \<or> (\<exists>Q f p. kind a' = Q\<hookleftarrow>\<^bsub>p\<^esub>f)\<close>
          \<open>intra_kind(kind a')\<close>
        have "\<forall>a'\<in>set (a'#xs). intra_kind (kind a') \<or> (\<exists>Q f p. kind a' = Q\<hookleftarrow>\<^bsub>p\<^esub>f)"
          by fastforce
        ultimately show ?thesis by blast
      next
        assume "\<exists>a' as' Q p f. as = a'#as' \<and> kind a' = Q\<hookleftarrow>\<^bsub>p\<^esub>f"
        then obtain a' as' Q p f where "as = a'#as'" and "kind a' = Q\<hookleftarrow>\<^bsub>p\<^esub>f" by blast
        from \<open>n -as\<rightarrow>\<^sub>\<surd>* (_Exit_)\<close> \<open>as = a'#as'\<close>
        have "sourcenode a' = n" and "valid_edge a'"
          and "targetnode a' -as'\<rightarrow>\<^sub>\<surd>* (_Exit_)"
          by(auto intro:vp_split_Cons)
        from IH \<open>targetnode a' -as'\<rightarrow>\<^sub>\<surd>* (_Exit_)\<close> \<open>as = a'#as'\<close>
        obtain xs where "targetnode a' -xs\<rightarrow>\<^sub>\<surd>* (_Exit_)"
          and "set (sourcenodes xs) \<subseteq> set (sourcenodes as')"
          and "\<forall>a'\<in>set xs. intra_kind (kind a') \<or> (\<exists>Q f p. kind a' = Q\<hookleftarrow>\<^bsub>p\<^esub>f)"
          apply(erule_tac x="as'" in allE) by auto
        from \<open>sourcenode a' = n\<close> \<open>valid_edge a'\<close> \<open>kind a' = Q\<hookleftarrow>\<^bsub>p\<^esub>f\<close>
          \<open>targetnode a' -xs\<rightarrow>\<^sub>\<surd>* (_Exit_)\<close>
        have "n -a'#xs\<rightarrow>\<^sub>\<surd>* (_Exit_)"
          by(fastforce intro:Cons_path simp:vp_def valid_path_def)
        moreover
        from \<open>set (sourcenodes xs) \<subseteq> set (sourcenodes as')\<close> \<open>as = a'#as'\<close>
        have "set (sourcenodes (a'#xs)) \<subseteq> set (sourcenodes as)"
          by(auto simp:sourcenodes_def)
        moreover
        from \<open>\<forall>a'\<in>set xs. intra_kind (kind a') \<or> (\<exists>Q f p. kind a' = Q\<hookleftarrow>\<^bsub>p\<^esub>f)\<close>
          \<open>kind a' = Q\<hookleftarrow>\<^bsub>p\<^esub>f\<close>
        have "\<forall>a'\<in>set (a'#xs). intra_kind (kind a') \<or> (\<exists>Q f p. kind a' = Q\<hookleftarrow>\<^bsub>p\<^esub>f)"
          by fastforce
        ultimately show ?thesis by blast
      next
        assume "\<exists>as' as'' n'. as = as'@as'' \<and> as' \<noteq> [] \<and> n -as'\<rightarrow>\<^bsub>sl\<^esub>* n'"
        then obtain as' as'' n' where "as = as'@as''" and "as' \<noteq> []"
          and "n -as'\<rightarrow>\<^bsub>sl\<^esub>* n'" by blast
        from \<open>n -as\<rightarrow>\<^sub>\<surd>* (_Exit_)\<close> \<open>as = as'@as''\<close> \<open>as' \<noteq> []\<close>
        have "last(targetnodes as') -as''\<rightarrow>\<^sub>\<surd>* (_Exit_)"
          by(cases as' rule:rev_cases,auto intro:vp_split simp:targetnodes_def)
        from \<open>n -as'\<rightarrow>\<^bsub>sl\<^esub>* n'\<close> \<open>as' \<noteq> []\<close> have "last(targetnodes as') = n'"
          by(fastforce intro:path_targetnode simp:slp_def)
        from \<open>as = as'@as''\<close> \<open>as' \<noteq> []\<close> have "length as'' < length as" by simp
        with IH \<open>last(targetnodes as') -as''\<rightarrow>\<^sub>\<surd>* (_Exit_)\<close>
          \<open>last(targetnodes as') = n'\<close>
        obtain xs where "n' -xs\<rightarrow>\<^sub>\<surd>* (_Exit_)"
          and "set (sourcenodes xs) \<subseteq> set (sourcenodes as'')"
          and "\<forall>a'\<in>set xs. intra_kind (kind a') \<or> (\<exists>Q f p. kind a' = Q\<hookleftarrow>\<^bsub>p\<^esub>f)"
          apply(erule_tac x="as''" in allE) by auto
        from \<open>n -as'\<rightarrow>\<^bsub>sl\<^esub>* n'\<close> obtain ys where "n -ys\<rightarrow>\<^sub>\<iota>* n'"
          and "set(sourcenodes ys) \<subseteq> set(sourcenodes as')"
          by(erule same_level_path_inner_path)
        from \<open>n -ys\<rightarrow>\<^sub>\<iota>* n'\<close> \<open>n' -xs\<rightarrow>\<^sub>\<surd>* (_Exit_)\<close> have "n -ys@xs\<rightarrow>\<^sub>\<surd>* (_Exit_)"
          by(fastforce intro:slp_vp_Append intra_path_slp)
        moreover
        from \<open>set (sourcenodes xs) \<subseteq> set (sourcenodes as'')\<close>
          \<open>set(sourcenodes ys) \<subseteq> set(sourcenodes as')\<close> \<open>as = as'@as''\<close>
        have "set (sourcenodes (ys@xs)) \<subseteq> set(sourcenodes as)"
          by(auto simp:sourcenodes_def)
        moreover
        from \<open>\<forall>a'\<in>set xs. intra_kind (kind a') \<or> (\<exists>Q f p. kind a' = Q\<hookleftarrow>\<^bsub>p\<^esub>f)\<close>
          \<open>n -ys\<rightarrow>\<^sub>\<iota>* n'\<close>
        have "\<forall>a'\<in>set (ys@xs). intra_kind (kind a') \<or> (\<exists>Q f p. kind a' = Q\<hookleftarrow>\<^bsub>p\<^esub>f)"
          by(fastforce simp:intra_path_def)
        ultimately show ?thesis by blast
      qed
    qed
  qed
qed

lemma valid_Exit_path_intra_path:
  assumes "n -as\<rightarrow>\<^sub>\<surd>* (_Exit_)"
  obtains as' pex where "n -as'\<rightarrow>\<^sub>\<iota>* pex" and "method_exit pex"
  and "set(sourcenodes as') \<subseteq> set(sourcenodes as)"
proof(atomize_elim)
  from \<open>n -as\<rightarrow>\<^sub>\<surd>* (_Exit_)\<close>
  obtain as' where "n -as'\<rightarrow>\<^sub>\<surd>* (_Exit_)"
    and "set(sourcenodes as') \<subseteq> set(sourcenodes as)"
    and all:"\<forall>a' \<in> set as'. intra_kind(kind a') \<or> (\<exists>Q f p. kind a' = Q\<hookleftarrow>\<^bsub>p\<^esub>f)"
    by(erule valid_Exit_path_descending_path)
  show "\<exists>as' pex. n -as'\<rightarrow>\<^sub>\<iota>* pex \<and> method_exit pex \<and>
                  set(sourcenodes as') \<subseteq> set(sourcenodes as)"
  proof(cases "\<exists>a' \<in> set as'. \<exists>Q f p. kind a' = Q\<hookleftarrow>\<^bsub>p\<^esub>f")
    case True
    then obtain asx ax asx' where [simp]:"as' = asx@ax#asx'"
      and "\<exists>Q f p. kind ax = Q\<hookleftarrow>\<^bsub>p\<^esub>f" and "\<forall>a' \<in> set asx. \<not> (\<exists>Q f p. kind a' = Q\<hookleftarrow>\<^bsub>p\<^esub>f)"
      by(erule split_list_first_propE)
    with all have "\<forall>a' \<in> set asx. intra_kind(kind a')" by auto
    from \<open>n -as'\<rightarrow>\<^sub>\<surd>* (_Exit_)\<close> have "n -asx\<rightarrow>* sourcenode ax"
      and "valid_edge ax" by(auto elim:path_split simp:vp_def)
    from \<open>n -asx\<rightarrow>* sourcenode ax\<close> \<open>\<forall>a' \<in> set asx. intra_kind(kind a')\<close>
    have "n -asx\<rightarrow>\<^sub>\<iota>* sourcenode ax" by(simp add:intra_path_def)
    moreover
    from \<open>valid_edge ax\<close> \<open>\<exists>Q f p. kind ax = Q\<hookleftarrow>\<^bsub>p\<^esub>f\<close>
    have "method_exit (sourcenode ax)" by(fastforce simp:method_exit_def)
    moreover
    from \<open>set(sourcenodes as') \<subseteq> set(sourcenodes as)\<close>
    have "set(sourcenodes asx) \<subseteq> set(sourcenodes as)" by(simp add:sourcenodes_def)
    ultimately show ?thesis by blast
  next
    case False
    with all \<open>n -as'\<rightarrow>\<^sub>\<surd>* (_Exit_)\<close> have "n -as'\<rightarrow>\<^sub>\<iota>* (_Exit_)"
      by(fastforce simp:vp_def intra_path_def)
    moreover have "method_exit (_Exit_)" by(simp add:method_exit_def)
    ultimately show ?thesis using \<open>set(sourcenodes as') \<subseteq> set(sourcenodes as)\<close>
      by blast
  qed
qed

end

end