theory SINVAR_SecGwExt
imports "../TopoS_Helper"
begin

subsection {* SecurityInvariant SecurityGatewayExtended*}
text {* Like SecurityGateway but SecurityGatewayIN and AccessibleMember are accessible from outside world *}

datatype secgw_member = SecurityGateway | SecurityGatewayIN | DomainMember  | AccessibleMember | Unassigned

definition default_node_properties :: "secgw_member"
  where  "default_node_properties \<equiv> Unassigned"

fun allowed_secgw_flow :: "secgw_member \<Rightarrow> secgw_member \<Rightarrow> bool" where
  "allowed_secgw_flow SecurityGateway _ = True" |
  "allowed_secgw_flow SecurityGatewayIN _ = True" |
  "allowed_secgw_flow DomainMember DomainMember = False" |
  "allowed_secgw_flow DomainMember _ = True" |
  "allowed_secgw_flow AccessibleMember DomainMember = False" |
  "allowed_secgw_flow AccessibleMember _ = True" |
  "allowed_secgw_flow Unassigned Unassigned = True" |
  "allowed_secgw_flow Unassigned SecurityGatewayIN = True" |
  "allowed_secgw_flow Unassigned AccessibleMember = True" |
  "allowed_secgw_flow Unassigned _ = False"

fun sinvar :: "'v graph \<Rightarrow> ('v \<Rightarrow> secgw_member) \<Rightarrow> bool" where
  "sinvar G nP = (\<forall> (e1,e2) \<in> edges G. e1 \<noteq> e2 \<longrightarrow> allowed_secgw_flow (nP e1) (nP e2))"

fun verify_globals :: "'v graph \<Rightarrow> ('v \<Rightarrow> secgw_member) \<Rightarrow> 'b \<Rightarrow> bool" where
  "verify_globals _ _ _ = True"

definition receiver_violation :: "bool" where "receiver_violation = False"

subsubsection {*Preliminaries*}

subsubsection{*ENF*}
  lemma SecurityGateway_ENFnr: "SecurityInvariant_withOffendingFlows.sinvar_all_edges_normal_form_not_refl sinvar allowed_secgw_flow"
    by(simp add: SecurityInvariant_withOffendingFlows.sinvar_all_edges_normal_form_not_refl_def)
  lemma Unassigned_botdefault: "\<forall> e1 e2. e2 \<noteq> Unassigned \<longrightarrow> \<not> allowed_secgw_flow e1 e2 \<longrightarrow> \<not> allowed_secgw_flow Unassigned e2"
    apply(rule allI)+
    apply(case_tac e2)
        apply(simp_all)
     apply(case_tac e1)
          apply(simp_all)
    apply(case_tac e1)
        apply(simp_all)
    done
  lemma Unassigned_not_to_Member: "\<not> allowed_secgw_flow Unassigned DomainMember"
    by(simp)
  lemma All_to_Unassigned: "\<forall> e1. allowed_secgw_flow e1 Unassigned"
    by (rule allI, case_tac e1, simp_all)

  definition SecurityGatewayExtended_offending_set:: "'v graph \<Rightarrow> ('v \<Rightarrow> secgw_member) \<Rightarrow> ('v \<times> 'v) set set" where
  "SecurityGatewayExtended_offending_set G nP = (if sinvar G nP then
      {}
     else
      { {e \<in> edges G. case e of (e1,e2) \<Rightarrow> e1 \<noteq> e2 \<and> \<not> allowed_secgw_flow (nP e1) (nP e2)} })"
  lemma SecurityGatewayExtended_offending_set: "SecurityInvariant_withOffendingFlows.set_offending_flows sinvar = SecurityGatewayExtended_offending_set"
    apply(simp only: fun_eq_iff ENFnr_offending_set[OF SecurityGateway_ENFnr] SecurityGatewayExtended_offending_set_def)
    apply(rule allI)+
    apply(rename_tac G nP)
    apply(auto)
  done

interpretation SecurityGatewayExtended: SecurityInvariant_ACS
where default_node_properties = default_node_properties
and sinvar = sinvar
and verify_globals = verify_globals
where "SecurityInvariant_withOffendingFlows.set_offending_flows sinvar = SecurityGatewayExtended_offending_set"
  unfolding default_node_properties_def
  apply unfold_locales
    apply(rule ballI)
    apply (rule SecurityInvariant_withOffendingFlows.ENFnr_fsts_weakrefl_instance[OF SecurityGateway_ENFnr Unassigned_botdefault All_to_Unassigned])[1]
     apply(simp)
    apply(simp)
   apply(erule default_uniqueness_by_counterexample_ACS)
   apply (simp add: SecurityInvariant_withOffendingFlows.set_offending_flows_def
      SecurityInvariant_withOffendingFlows.is_offending_flows_min_set_def
      SecurityInvariant_withOffendingFlows.is_offending_flows_def)
   apply (simp add:graph_ops)
   apply (simp split: split_split_asm split_split)
   apply(rule_tac x="\<lparr> nodes={vertex_1,vertex_2}, edges = {(vertex_1,vertex_2)} \<rparr>" in exI, simp)
   apply(rule conjI)
    apply(simp add: valid_graph_def)
   apply(case_tac otherbot, simp_all)
      apply(rename_tac secgwcase)
      apply(rule_tac x="(\<lambda> x. Unassigned)(vertex_1 := Unassigned, vertex_2 := DomainMember)" in exI, simp)
      apply(rule_tac x="{(vertex_1,vertex_2)}" in exI, simp)
     apply(rename_tac secgwINcase)
     apply(rule_tac x="(\<lambda> x. Unassigned)(vertex_1 := Unassigned, vertex_2 := DomainMember)" in exI, simp)
     apply(rule_tac x="vertex_1" in exI, simp)
     apply(rule_tac x="{(vertex_1,vertex_2)}" in exI, simp)
    apply(rename_tac membercase)
    apply(rule_tac x="(\<lambda> x. Unassigned)(vertex_1 := Unassigned, vertex_2 := SecurityGateway)" in exI, simp)
    apply(rule_tac x="vertex_1" in exI, simp)
    apply(rule_tac x="{(vertex_1,vertex_2)}" in exI, simp)
   apply(rule_tac x="(\<lambda> x. Unassigned)(vertex_1 := Unassigned, vertex_2 := SecurityGateway)" in exI, simp)
   apply(rule_tac x="vertex_1" in exI, simp)
   apply(rule_tac x="{(vertex_1,vertex_2)}" in exI, simp)

  apply(fact SecurityGatewayExtended_offending_set)
 done

  lemma TopoS_SecurityGatewayExtended: "SecurityInvariant sinvar default_node_properties receiver_violation"
  unfolding receiver_violation_def by unfold_locales

hide_const (open) sinvar verify_globals receiver_violation

end


header{*The Needham-Schroeder Public-Key Protocol against Dolev-Yao --- with Gets event, hence with Reception rule*}

theory NS_Public_Bad imports Public begin

inductive_set ns_public :: "event list set"
  where
         (*Initial trace is empty*)
   Nil:  "[] \<in> ns_public"

         (*The spy MAY say anything he CAN say.  We do not expect him to
           invent new nonces here, but he can also use NS1.  Common to
           all similar protocols.*)
 | Fake: "\<lbrakk>evsf \<in> ns_public;  X \<in> synth (analz (knows Spy evsf))\<rbrakk>
          \<Longrightarrow> Says Spy B X  # evsf \<in> ns_public"

         (*A message that is sent may be received*)
 | Reception: "\<lbrakk>evsr \<in> ns_public; Says A B X \<in> set evsr\<rbrakk>
                \<Longrightarrow> Gets B X # evsr \<in> ns_public"

         (*Alice initiates a protocol run, sending a nonce to Bob*)
 | NS1:  "\<lbrakk>evs1 \<in> ns_public;  Nonce NA \<notin> used evs1\<rbrakk>
          \<Longrightarrow> Says A B (Crypt (pubEK B) \<lbrace>Nonce NA, Agent A\<rbrace>)
                # evs1  \<in>  ns_public"

         (*Bob responds to Alice's message with a further nonce*)
 | NS2:  "\<lbrakk>evs2 \<in> ns_public;  Nonce NB \<notin> used evs2;
           Gets B (Crypt (pubEK B) \<lbrace>Nonce NA, Agent A\<rbrace>) \<in> set evs2\<rbrakk>
          \<Longrightarrow> Says B A (Crypt (pubEK A) \<lbrace>Nonce NA, Nonce NB\<rbrace>)
                # evs2  \<in>  ns_public"

         (*Alice proves her existence by sending NB back to Bob.*)
 | NS3:  "\<lbrakk>evs3 \<in> ns_public;
           Says A  B (Crypt (pubEK B) \<lbrace>Nonce NA, Agent A\<rbrace>) \<in> set evs3;
           Gets A (Crypt (pubEK A) \<lbrace>Nonce NA, Nonce NB\<rbrace>) \<in> set evs3\<rbrakk>
          \<Longrightarrow> Says A B (Crypt (pubEK B) (Nonce NB)) # evs3 \<in> ns_public"

declare knows_Spy_partsEs [elim] thm knows_Spy_partsEs
declare analz_into_parts [dest]
declare Fake_parts_insert_in_Un [dest]

(*A "possibility property": there are traces that reach the end*)
lemma "\<exists>NB. \<exists>evs \<in> ns_public. Says A B (Crypt (pubEK B) (Nonce NB)) \<in> set evs"
apply (intro exI bexI)
apply (rule_tac [2] ns_public.Nil [THEN ns_public.NS1, THEN ns_public.Reception,
                                   THEN ns_public.NS2, THEN ns_public.Reception,
                                   THEN ns_public.NS3])
by possibility

text{*Lemmas about reception invariant: if a message is received it certainly
was sent*}
lemma Gets_imp_Says :
     "\<lbrakk> Gets B X \<in> set evs; evs \<in> ns_public \<rbrakk> \<Longrightarrow> \<exists>A. Says A B X \<in> set evs"
apply (erule rev_mp)
apply (erule ns_public.induct)
apply auto
done

lemma Gets_imp_knows_Spy:
     "\<lbrakk> Gets B X \<in> set evs; evs \<in> ns_public \<rbrakk>  \<Longrightarrow> X \<in> knows Spy evs"
apply (blast dest!: Gets_imp_Says Says_imp_knows_Spy)
done

lemma Gets_imp_knows_Spy_parts[dest]:
    "\<lbrakk> Gets B X \<in> set evs; evs \<in> ns_public \<rbrakk>  \<Longrightarrow> X \<in> parts (knows Spy evs)"
apply (blast dest: Gets_imp_knows_Spy [THEN parts.Inj])
done

(**** Inductive proofs about ns_public ****)

(** Theorems of the form X \<notin> parts (knows Spy evs) imply that NOBODY
    sends messages containing X! **)

(*Spy never sees another agent's private key! (unless it's bad at start)*)
lemma Spy_see_priEK [simp]:
      "evs \<in> ns_public \<Longrightarrow> (Key (priEK A) \<in> parts (knows Spy evs)) = (A \<in> bad)"
by (erule ns_public.induct, auto)

lemma Spy_analz_priEK [simp]:
      "evs \<in> ns_public \<Longrightarrow> (Key (priEK A) \<in> analz (knows Spy evs)) = (A \<in> bad)"
by auto

(*** Authenticity properties obtained from NS2 ***)

(*It is impossible to re-use a nonce in both NS1 and NS2, provided the nonce
  is secret.  (Honest users generate fresh nonces.)*)

(*Unicity for NS1: nonce NA identifies agents A and B*)
lemma unique_NA:
     "\<lbrakk>Crypt(pubEK B)  \<lbrace>Nonce NA, Agent A \<rbrace> \<in> parts(knows Spy evs);
       Crypt(pubEK B') \<lbrace>Nonce NA, Agent A'\<rbrace> \<in> parts(knows Spy evs);
       Nonce NA \<notin> analz (knows Spy evs); evs \<in> ns_public\<rbrakk>
      \<Longrightarrow> A=A' \<and> B=B'"
apply (erule rev_mp, erule rev_mp, erule rev_mp)
apply (erule ns_public.induct, simp_all)
(*Fake, NS1*)
apply (blast intro!: analz_insertI)+
done

(*Secrecy: Spy does not see the nonce sent in msg NS1 if A and B are secure
  The major premise "Says A B ..." makes it a dest-rule, so we use
  (erule rev_mp) rather than rule_format. *)
theorem Spy_not_see_NA:
      "\<lbrakk>Says A B (Crypt(pubEK B) \<lbrace>Nonce NA, Agent A\<rbrace>) \<in> set evs;
        A \<notin> bad;  B \<notin> bad;  evs \<in> ns_public\<rbrakk>
       \<Longrightarrow> Nonce NA \<notin> analz (knows Spy evs)"
apply (erule rev_mp)
apply (erule ns_public.induct, simp_all, spy_analz)
apply (blast dest: unique_NA intro: no_nonce_NS1_NS2)+
done

(*Authentication for A: if she receives message 2 and has used NA
  to start a run, then B has sent message 2.*)
lemma A_trusts_NS2_lemma [rule_format]:
   "\<lbrakk>A \<notin> bad;  B \<notin> bad;  evs \<in> ns_public\<rbrakk>
    \<Longrightarrow> Crypt (pubEK A) \<lbrace>Nonce NA, Nonce NB\<rbrace> \<in> parts (knows Spy evs) \<longrightarrow>
        Says A B (Crypt(pubEK B) \<lbrace>Nonce NA, Agent A\<rbrace>) \<in> set evs \<longrightarrow>
        Says B A (Crypt(pubEK A) \<lbrace>Nonce NA, Nonce NB\<rbrace>) \<in> set evs"
apply (erule ns_public.induct)
apply (auto dest: Spy_not_see_NA unique_NA)
done

theorem A_trusts_NS2:
     "\<lbrakk>Says A  B (Crypt(pubEK B) \<lbrace>Nonce NA, Agent A\<rbrace>) \<in> set evs;
       Gets A (Crypt(pubEK A) \<lbrace>Nonce NA, Nonce NB\<rbrace>) \<in> set evs;
       A \<notin> bad;  B \<notin> bad;  evs \<in> ns_public\<rbrakk>
      \<Longrightarrow> Says B A (Crypt(pubEK A) \<lbrace>Nonce NA, Nonce NB\<rbrace>) \<in> set evs"
by (blast intro: A_trusts_NS2_lemma)

(*If the encrypted message appears then it originated with Alice in NS1*)
lemma B_trusts_NS1 [rule_format]:
     "evs \<in> ns_public
      \<Longrightarrow> Crypt (pubEK B) \<lbrace>Nonce NA, Agent A\<rbrace> \<in> parts (knows Spy evs) \<longrightarrow>
          Nonce NA \<notin> analz (knows Spy evs) \<longrightarrow>
          Says A B (Crypt (pubEK B) \<lbrace>Nonce NA, Agent A\<rbrace>) \<in> set evs"
apply (erule ns_public.induct, simp_all)
(*Fake*)
apply (blast intro!: analz_insertI)
done

(*** Authenticity properties obtained from NS2 ***)

(*Unicity for NS2: nonce NB identifies nonce NA and agent A
  [proof closely follows that for unique_NA] *)
lemma unique_NB [dest]:
     "\<lbrakk>Crypt(pubEK A)  \<lbrace>Nonce NA, Nonce NB\<rbrace> \<in> parts(knows Spy evs);
       Crypt(pubEK A') \<lbrace>Nonce NA', Nonce NB\<rbrace> \<in> parts(knows Spy evs);
       Nonce NB \<notin> analz (knows Spy evs); evs \<in> ns_public\<rbrakk>
     \<Longrightarrow> A=A' \<and> NA=NA'"
apply (erule rev_mp, erule rev_mp, erule rev_mp)
apply (erule ns_public.induct, simp_all)
(*Fake, NS2*)
apply (blast intro!: analz_insertI)+
done

(*NB remains secret PROVIDED Alice never responds with round 3*)
theorem Spy_not_see_NB [dest]:
     "\<lbrakk>Says B A (Crypt (pubEK A) \<lbrace>Nonce NA, Nonce NB\<rbrace>) \<in> set evs;
       \<forall>C. Says A C (Crypt (pubEK C) (Nonce NB)) \<notin> set evs;
       A \<notin> bad;  B \<notin> bad;  evs \<in> ns_public\<rbrakk>
     \<Longrightarrow> Nonce NB \<notin> analz (knows Spy evs)"
apply (erule rev_mp, erule rev_mp)
apply (erule ns_public.induct, simp_all, spy_analz)
apply (simp_all add: all_conj_distrib) (*speeds up the next step*)
apply (blast intro: no_nonce_NS1_NS2)+
done

(*Authentication for B: if he receives message 3 and has used NB
  in message 2, then A has sent message 3--to somebody....*)

lemma B_trusts_NS3_lemma [rule_format]:
     "\<lbrakk>A \<notin> bad;  B \<notin> bad;  evs \<in> ns_public\<rbrakk>
      \<Longrightarrow> Crypt (pubEK B) (Nonce NB) \<in> parts (knows Spy evs) \<longrightarrow>
          Says B A  (Crypt (pubEK A) \<lbrace>Nonce NA, Nonce NB\<rbrace>) \<in> set evs \<longrightarrow>
          (\<exists>C. Says A C (Crypt (pubEK C) (Nonce NB)) \<in> set evs)"
apply (erule ns_public.induct, auto)
by (blast intro: no_nonce_NS1_NS2)+

theorem B_trusts_NS3:
     "\<lbrakk>Says B A  (Crypt (pubEK A) \<lbrace>Nonce NA, Nonce NB\<rbrace>) \<in> set evs;
       Gets B (Crypt (pubEK B) (Nonce NB)) \<in> set evs;
       A \<notin> bad;  B \<notin> bad;  evs \<in> ns_public\<rbrakk>
      \<Longrightarrow> \<exists>C. Says A C (Crypt (pubEK C) (Nonce NB)) \<in> set evs"
by (blast intro: B_trusts_NS3_lemma)

(*Can we strengthen the secrecy theorem Spy_not_see_NB?  NO*)
lemma "\<lbrakk>A \<notin> bad;  B \<notin> bad;  evs \<in> ns_public\<rbrakk>
       \<Longrightarrow> Says B A (Crypt (pubEK A) \<lbrace>Nonce NA, Nonce NB\<rbrace>) \<in> set evs
           \<longrightarrow> Nonce NB \<notin> analz (knows Spy evs)"
apply (erule ns_public.induct, simp_all, spy_analz)
(*NS1: by freshness*)
apply blast
(*NS2: by freshness and unicity of NB*)
apply (blast intro: no_nonce_NS1_NS2)
(*NS3: unicity of NB identifies A and NA, but not B*)
apply clarify
apply (frule_tac A' = A in
       Says_imp_knows_Spy [THEN parts.Inj, THEN unique_NB], auto)
apply (rename_tac evs3 B' C)
txt{*This is the attack!
@{subgoals[display,indent=0,margin=65]}
*}
oops

end


(*  Title:      CTT/ex/Synthesis.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Copyright   1991  University of Cambridge
*)

section "Synthesis examples, using a crude form of narrowing"

theory Synthesis
imports "../Arith"
begin

text "discovery of predecessor function"
schematic_lemma "?a : SUM pred:?A . Eq(N, pred`0, 0)
                  *  (PROD n:N. Eq(N, pred ` succ(n), n))"
apply intr
apply eqintr
apply (rule_tac [3] reduction_rls)
apply (rule_tac [5] comp_rls)
apply rew
done

text "the function fst as an element of a function type"
schematic_lemma [folded basic_defs]:
  "A type \<Longrightarrow> ?a: SUM f:?B . PROD i:A. PROD j:A. Eq(A, f ` <i,j>, i)"
apply intr
apply eqintr
apply (rule_tac [2] reduction_rls)
apply (rule_tac [4] comp_rls)
apply typechk
txt "now put in A everywhere"
apply assumption+
done

text "An interesting use of the eliminator, when"
(*The early implementation of unification caused non-rigid path in occur check
  See following example.*)
schematic_lemma "?a : PROD i:N. Eq(?A, ?b(inl(i)), <0    ,   i>)
                   * Eq(?A, ?b(inr(i)), <succ(0), i>)"
apply intr
apply eqintr
apply (rule comp_rls)
apply rew
done

(*Here we allow the type to depend on i.
 This prevents the cycle in the first unification (no longer needed).
 Requires flex-flex to preserve the dependence.
 Simpler still: make ?A into a constant type N*N.*)
schematic_lemma "?a : PROD i:N. Eq(?A(i), ?b(inl(i)), <0   ,   i>)
                  *  Eq(?A(i), ?b(inr(i)), <succ(0),i>)"
oops

text "A tricky combination of when and split"
(*Now handled easily, but caused great problems once*)
schematic_lemma [folded basic_defs]:
  "?a : PROD i:N. PROD j:N. Eq(?A, ?b(inl(<i,j>)), i)
                           *  Eq(?A, ?b(inr(<i,j>)), j)"
apply intr
apply eqintr
apply (rule PlusC_inl [THEN trans_elem])
apply (rule_tac [4] comp_rls)
apply (rule_tac [7] reduction_rls)
apply (rule_tac [10] comp_rls)
apply typechk
done

(*similar but allows the type to depend on i and j*)
schematic_lemma "?a : PROD i:N. PROD j:N. Eq(?A(i,j), ?b(inl(<i,j>)), i)
                          *   Eq(?A(i,j), ?b(inr(<i,j>)), j)"
oops

(*similar but specifying the type N simplifies the unification problems*)
schematic_lemma "?a : PROD i:N. PROD j:N. Eq(N, ?b(inl(<i,j>)), i)
                          *   Eq(N, ?b(inr(<i,j>)), j)"
oops

text "Deriving the addition operator"
schematic_lemma [folded arith_defs]:
  "?c : PROD n:N. Eq(N, ?f(0,n), n)
                  *  (PROD m:N. Eq(N, ?f(succ(m), n), succ(?f(m,n))))"
apply intr
apply eqintr
apply (rule comp_rls)
apply rew
done

text "The addition function -- using explicit lambdas"
schematic_lemma [folded arith_defs]:
  "?c : SUM plus : ?A .
         PROD x:N. Eq(N, plus`0`x, x)
                *  (PROD y:N. Eq(N, plus`succ(y)`x, succ(plus`y`x)))"
apply intr
apply eqintr
apply (tactic "resolve_tac [TSimp.split_eqn] 3")
apply (tactic "SELECT_GOAL (rew_tac @{context} []) 4")
apply (tactic "resolve_tac [TSimp.split_eqn] 3")
apply (tactic "SELECT_GOAL (rew_tac @{context} []) 4")
apply (rule_tac [3] p = "y" in NC_succ)
  (**  by (resolve_tac comp_rls 3);  caused excessive branching  **)
apply rew
done

end


theory IHT_Tree
  imports
    "../SepLogicTime/SLTC_Main"
    "HOL-Library.Tree"
begin

section \<open>Abstract tree\<close>

setup \<open>add_resolve_prfstep @{thm tree.distinct(2)}\<close>
setup \<open>add_forward_prfstep (equiv_forward_th (@{thm tree.simps(1)}))\<close>
setup \<open>fold add_rewrite_rule @{thms tree.sel}\<close>
setup \<open>add_forward_prfstep_cond @{thm tree.collapse} [with_cond "?tree \<noteq> Node ?l ?v ?r"]\<close>
setup \<open>add_var_induct_rule @{thm tree.induct}\<close>
setup \<open>fold add_rewrite_rule @{thms tree.case}\<close>

section \<open>Tree nodes\<close>

datatype 'a node =
  Node (lsub: "'a node ref option") (val: 'a) (rsub: "'a node ref option")
setup \<open>fold add_rewrite_rule @{thms node.sel}\<close>
setup \<open>add_forward_prfstep (equiv_forward_th @{thm node.simps(1)})\<close>

fun node_encode :: "'a::heap node \<Rightarrow> nat" where
  "node_encode (Node l v r) = to_nat (l, v, r)"

instance node :: (heap) heap
  apply (rule heap_class.intro)
  apply (rule countable_classI [of "node_encode"])
  apply (case_tac x, simp_all, case_tac y, simp_all)
  ..

fun btree :: "'a::heap tree \<Rightarrow> 'a node ref option \<Rightarrow> assn" where
  "btree Leaf p = \<up>(p = None)"
| "btree \<langle>lt, v, rt\<rangle> (Some p) = (\<exists>\<^sub>Alp rp. p \<mapsto>\<^sub>r Node lp v rp * btree lt lp * btree rt rp)"
| "btree \<langle>lt, v, rt\<rangle> None = false"
setup \<open>fold add_rewrite_ent_rule @{thms btree.simps}\<close>

lemma btree_Leaf [forward_ent]: "btree Leaf p \<Longrightarrow>\<^sub>A \<up>(p = None)" by auto2

lemma btree_not_Leaf [forward_ent]:
  "btree \<langle>lt, v, rt\<rangle> p \<Longrightarrow>\<^sub>A (\<exists>\<^sub>Alp rp. the p \<mapsto>\<^sub>r Node lp v rp * btree lt lp * btree rt rp * \<up>(p \<noteq> None))"
@proof @case "p = None" @qed

lemma btree_none: "emp \<Longrightarrow>\<^sub>A btree tree.Leaf None" by auto2

lemma btree_constr_ent:
  "p \<mapsto>\<^sub>r Node lp v rp * btree lt lp * btree rt rp \<Longrightarrow>\<^sub>A btree (tree.Node lt v rt) (Some p)" by auto2

setup \<open>fold add_entail_matcher [@{thm btree_none}, @{thm btree_constr_ent}]\<close>
setup \<open>fold del_prfstep_thm @{thms btree.simps}\<close>

type_synonym 'a ptree = "'a node ref option"

section \<open>Basic operations\<close>

definition tree_empty :: "'a ptree Heap" where
  "tree_empty = return None"

lemma tree_empty_rule [hoare_triple]:
  "<$1> tree_empty <btree Leaf>" by auto2

definition tree_is_empty :: "'a ptree \<Rightarrow> bool Heap" where
  "tree_is_empty b = return (b = None)"

lemma tree_is_empty_rule [hoare_triple]:
  "<btree t b * $1>
   tree_is_empty b
   <\<lambda>r. btree t b * \<up>(r \<longleftrightarrow> t = Leaf)>" by auto2

definition tree_constr :: "'a::heap \<Rightarrow> 'a ptree Heap" where
  "tree_constr v = do { p \<leftarrow> ref (Node None v None); return (Some p) }"

lemma tree_constr_rule [hoare_triple]:
  "<$2> tree_constr v <btree \<langle>Leaf, v, Leaf\<rangle>>" by auto2

definition rotate_l :: "'a::heap ptree \<Rightarrow> 'a ptree Heap" where
  "rotate_l p = (case p of
    None \<Rightarrow> raise ''Empty ptree''
  | Some pp \<Rightarrow> do {
     t \<leftarrow> !pp;
     (case rsub t of
        None \<Rightarrow> raise ''Empty rsub''
      | Some rp \<Rightarrow> do {
         rt \<leftarrow> !rp;
         pp := Node (lsub t) (val t) (lsub rt);
         rp := Node p (val rt) (rsub rt);
         return (rsub t) })})"

lemma rotate_l_rule [hoare_triple]:
  "<btree \<langle>a, v, \<langle>b, w, c\<rangle>\<rangle> p * $5>
   rotate_l p
   <btree \<langle>\<langle>a, v, b\<rangle>, w, c\<rangle>>" by auto2

definition rotate_r :: "'a::heap ptree \<Rightarrow> 'a ptree Heap" where
  "rotate_r p = (case p of
    None \<Rightarrow> raise ''Empty ptree''
  | Some pp \<Rightarrow> do {
     t \<leftarrow> !pp;
     (case lsub t of
        None \<Rightarrow> raise ''Empty lsub''
      | Some lp \<Rightarrow> do {
         lt \<leftarrow> !lp;
         pp := Node (rsub lt) (val t) (rsub t);
         lp := Node (lsub lt) (val lt) p;
         return (lsub t) })})"

lemma rotate_r_rule [hoare_triple]:
  "<btree \<langle>\<langle>a, v, b\<rangle>, w, c\<rangle> p * $5>
   rotate_r p
   <btree \<langle>a, v, \<langle>b, w, c\<rangle>\<rangle>>" by auto2

end


header {* \isaheader{Postdomination} *}

theory Postdomination imports CFGExit begin

subsection {* Standard Postdomination *}

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 `n' postdominates n` have "valid_node n"
    and all:"\<forall>as. n -as\<rightarrow>* (_Exit_) \<longrightarrow> n' \<in> set(sourcenodes as)"
    by(auto simp:postdominate_def)
  from `valid_node n` 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 `n -as\<rightarrow>* (_Exit_)` `as = as'@a#as''` have "n -as'\<rightarrow>* sourcenode a"
    by(fastforce dest:path_split)
  with `sourcenode a = n'` 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 = `\<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`
    show ?case
    proof(cases "n' postdominates n''")
      case True
      with `\<not> n' postdominates n` `sourcenode a = n` `targetnode a = n''`
        `valid_edge a`
      show ?thesis by blast
    next
      case False
      from IH[OF `n' postdominates nx` 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 `n' postdominates n` 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 `n -as\<rightarrow>* n''` 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 `n -as\<rightarrow>* n''` `n'' -as''\<rightarrow>* (_Exit_)` have "n -as@as''\<rightarrow>* (_Exit_)"
      by(rule path_Append)
    with `n' \<notin> set(sourcenodes as)` `n' \<notin> set (sourcenodes as'')`
    have "n' \<notin> set (sourcenodes (as@as''))"
      by(simp add:sourcenodes_def)
    with `n -as@as''\<rightarrow>* (_Exit_)` `n' postdominates n` show False
      by(simp add:postdominate_def)
  qed
  with `valid_node n'` `valid_node n''` 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 `sourcenode a -asx\<rightarrow>* (_Exit_)` `valid_edge a`
    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 `sourcenode a -asx\<rightarrow>* (_Exit_)` 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 `n \<notin> set(sourcenodes asx)` have "\<not> n postdominates targetnode ax"
      by(fastforce simp:postdominate_def sourcenodes_def)
    with `sourcenode a = sourcenode ax` `valid_edge ax` 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 `inner_node n` 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 `inner_node n` `(_Entry_) -as\<rightarrow>* n` have False
      by(fastforce simp:inner_node_def)
    thus ?thesis by simp
  next
    case False
    with `(_Entry_) -as\<rightarrow>* n` 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 `valid_edge a'` have "valid_node (targetnode a')" by simp
    thus ?thesis
    proof(cases "targetnode a'" rule:valid_node_cases)
      case Entry
      from `valid_edge a'` this have False by(rule Entry_target)
      thus ?thesis by simp
    next
      case Exit
      with `targetnode a' -as'\<rightarrow>* n` `inner_node n`
      have False by simp (drule path_Exit_source,auto simp:inner_node_def)
      thus ?thesis by simp
    next
      case inner
      with `valid_edge a'` `(_Entry_) = sourcenode a'` 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 `inner_node n` 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 `inner_node n` `n -as\<rightarrow>* (_Exit_)` have False by fastforce
    thus ?thesis by simp
  next
    case False
    with `n -as\<rightarrow>* (_Exit_)` 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 `valid_edge a'` have "valid_node (sourcenode a')" by simp
    thus ?thesis
    proof(cases "sourcenode a'" rule:valid_node_cases)
      case Entry
      with `n -as'\<rightarrow>* sourcenode a'` `inner_node n`
      have False by simp (drule path_Entry_target,auto simp:inner_node_def)
      thus ?thesis by simp
    next
      case Exit
      from `valid_edge a'` this have False by(rule Exit_source)
      thus ?thesis by simp
    next
      case inner
      with `valid_edge a'` `(_Exit_) = targetnode a'` show ?thesis by simp blast
    qed
  qed
qed

end

subsection {* Strong Postdomination *}

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 `n -as\<rightarrow>* n''` `length as \<ge> k` 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 `n -as\<rightarrow>* n''` have "n -asx@a#asx'\<rightarrow>* n''" by simp
    with `sourcenode a = n'` have "n -asx\<rightarrow>* n'" and "valid_edge a"
      and "targetnode a -asx'\<rightarrow>* n''" by(fastforce dest:path_split)+
    with `sourcenode a = n'` have "n' -a#asx'\<rightarrow>* n''" by(fastforce intro:Cons_path)
    with `n -asx\<rightarrow>* n'` all' have "length asx \<ge> k" by simp
    with `n -asx\<rightarrow>* n'` all have "n' \<in> set(sourcenodes asx)" by fastforce
    with `\<forall>nx \<in> set ns. nx \<noteq> n'` 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 `n -as\<rightarrow>* nx` 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 `n postdominates n` 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 `n'' strongly-postdominates n` 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 `n' strongly-postdominates n''` 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 `n'' postdominates n` `n' postdominates n''`
  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 `n -as\<rightarrow>* nx` 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 `length as \<ge> k1 + k2` have "length asx' \<ge> k2" by fastforce
    with `n'' -asx'\<rightarrow>* nx` all2 have "n' \<in> set(sourcenodes asx')" by fastforce
    hence "n' \<in> set(sourcenodes as)" by(simp add:sourcenodes_def) }
  with `k1 \<ge> 1` `k2 \<ge> 1` 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 `n' postdominates n` 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 = `\<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`
    show ?case
    proof(cases "n' strongly-postdominates n''")
      case True
      with `\<not> n' strongly-postdominates n` `sourcenode a = n` `targetnode a = n''`
        `valid_edge a`
      show ?thesis by blast
    next
      case False
      from IH[OF `n' strongly-postdominates nx` 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 `n' strongly-postdominates n` 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 `n' postdominates n` `n -as\<rightarrow>* n''` `n' \<notin> set(sourcenodes as)`
  have "n' postdominates n''"
    by(rule postdominate_path_targetnode)
  { fix as' nx assume "n'' -as'\<rightarrow>* nx" and "length as' \<ge> k"
    with `n -as\<rightarrow>* n''` 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 `n' \<notin> set(sourcenodes as)` have "n' \<in> set(sourcenodes as')"
      by(fastforce simp:sourcenodes_def) }
  with `k \<ge> 1` 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 `n' postdominates n''` 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 `valid_edge a` `valid_node n`
    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 `valid_edge a'` 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 `valid_edge a` 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 `finite ?M'` 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 `\<not> n strongly-postdominates (sourcenode a)`
      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 `n strongly-postdominates (targetnode ax)`
      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 `targetnode ax \<in> N` k' have "k' \<in> ?N'" by blast
      moreover
      from this `targetnode ax \<in> N` have "?N' \<noteq> {}" by auto
      ultimately have "k' \<le> Max ?N'" using `finite ?N'` by(fastforce intro:Max_ge)
      hence "k' \<le> k" by simp
      with `targetnode ax -as'\<rightarrow>* nx` `length as \<ge> k + 1` spdAll
      have "n \<in> set(sourcenodes as')"
        by fastforce
      with `n \<notin> set(sourcenodes as)` 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