subsection \<open>IO automata\<close>

text \<open>IO automata are defined. Since they are a particular kind of
transition systems, they inherit the notions of traces and reachability from those.
Various useful concepts and theorems are provided, including
invariants and the multi-step operator.\<close>

(*<*)
theory IO_Automaton
  imports Trivia Transition_System
begin
(*>*)

subsubsection \<open>IO automata as transition systems\<close>

text \<open>In this context, transitions are quadruples consisting of
a source state, an action (input), and output and a target state.\<close>

(* Design decision: transitions, hence traces, include the states too.
This is convenient for manipulating invariants. *)
(* transition: *)
datatype ('state,'act,'out) trans = Trans (srcOf: 'state) (actOf: 'act) (outOf: 'out) (tgtOf: 'state)

lemmas "srcOf_simps" = trans.sel(1)
lemmas "actOf_simps" = trans.sel(2)
lemmas "outOf_simps" = trans.sel(3)
lemmas "tgtOf_simps" = trans.sel(4)

locale IO_Automaton =
fixes istate :: "'state" (* initial step *)
  and step :: "'state \<Rightarrow> 'act \<Rightarrow> 'out * 'state"  (* transition function *)
begin

(* The output and effect of an action on a state: *)
definition out :: "'state \<Rightarrow> 'act \<Rightarrow> 'out" where "out s a \<equiv> fst (step s a)"
definition eff :: "'state \<Rightarrow> 'act \<Rightarrow> 'state" where "eff s a \<equiv> snd (step s a)"

fun validTrans :: "('state,'act,'out) trans \<Rightarrow> bool" where
"validTrans (Trans s a ou s') = (step s a = (ou, s'))"

lemma validTrans:
"validTrans trn =
 (step (srcOf trn) (actOf trn) = (outOf trn, tgtOf trn))"
by (cases trn) auto

sublocale Transition_System
  where istate = istate and validTrans = validTrans and srcOf = srcOf and tgtOf = tgtOf .

lemma reach_step:
  "reach s \<Longrightarrow> reach (snd (step s a))"
  using reach.Step[where trn = "Trans s a ou (snd (step s a))" for ou]
  by (cases "step s a") auto

lemma reach_PairI:
  assumes "reach s" and "step s a = (ou, s')"
  shows "reach s'"
  using assms
  by (auto intro: reach.Step[where trn = "Trans s a ou s'"])

lemma reach_step_induct[consumes 1, case_names Istate Step]:
  assumes s: "reach s"
    and istate: "P istate"
    and step: "\<And>s a. reach s \<Longrightarrow> P s \<Longrightarrow> P (snd (step s a))"
  shows "P s"
proof (use s in induction)
  case Istate
  then show ?case
    by (rule istate)
next
  case (Step s trn s')
  then obtain a ou where "trn = Trans s a ou s'"
    by (cases trn) auto
  then show ?case
    using Step step[of s a]
    by auto
qed

lemma reachFrom_step_induct[consumes 1, case_names Refl Step]:
  assumes s: "reachFrom s s'"
    and refl: "P s"
    and step: "\<And>s' a ou s''. reachFrom s s' \<Longrightarrow> P s' \<Longrightarrow> step s' a = (ou, s'') \<Longrightarrow> P s''"
  shows "P s'"
proof (use s in induction)
  case Refl
  then show ?case
    by (rule refl)
next
  case (Step s' trn s'')
  then obtain a ou where "trn = Trans s' a ou s''"
    by (cases trn) auto
  then show ?case
    using Step step[of s' a ou s'']
    by auto
qed

lemma valid_filter_no_state_change:
  "valid tr \<Longrightarrow> (\<And>trn. trn \<in>\<in> tr \<Longrightarrow> \<not>(PP trn) \<Longrightarrow> srcOf trn = tgtOf trn) \<Longrightarrow>
  \<exists>trn. trn \<in>\<in> tr \<and> PP trn \<Longrightarrow> valid (filter PP tr) \<and> srcOfTr tr = srcOfTr (filter PP tr)
  \<and> tgtOfTr tr = tgtOfTr (filter PP tr)"
proof (induct rule: valid.induct)
  case (Singl trn) then show ?case by auto
next
  case (Cons trn tr) then show ?case
   proof (cases "PP trn")
     case True note * = this show ?thesis
     proof (cases "\<exists>trn. trn \<in>\<in> tr \<and> PP trn")
       case True then show ?thesis using * Cons by fastforce
     next
       case False then show ?thesis
       proof -
        have **: "filter PP tr = []" using False by auto
        show ?thesis
        proof (cases "tr = []")
          case True then show ?thesis using Cons by simp
        next
          case False
            with Cons(3) Cons(5) ** have "srcOfTr tr = tgtOfTr tr"
            proof (induction tr)
              case (Singl a)
                have "\<not> (PP a)" using Singl(3) by auto
                then show ?case using Singl(2) by auto
            next
              case (Cons a as)
              have **: "\<not> (PP a)" using Cons(6) by auto
              then have *: "srcOf a = tgtOf a" using Cons(5) by auto
              show ?case
                proof (cases "as = []")
                  case True with * show ?thesis by simp
                next
                  case False
                    then have "srcOfTr as = tgtOfTr as"  using Cons ** by auto
                    then show ?thesis using * Cons(2) by auto
              qed
            qed
            then show ?thesis using * ** Cons False by simp
        qed
      qed
    qed
  next
    case False then show ?thesis using Cons by auto
  qed
qed

lemma validFrom_validTrans[intro]:
assumes "validTrans (Trans s a ou s')" and "validFrom s' tr"
shows "validFrom s (Trans s a ou s' # tr)"
using assms unfolding validFrom_def by auto

subsubsection \<open>State invariants\<close>

(* holds at the initial state: *)
definition holdsIstate :: "('state \<Rightarrow> bool) \<Rightarrow> bool" where
"holdsIstate \<phi> \<equiv> \<phi> istate"

(* is invariant: *)
definition invar :: "('state \<Rightarrow> bool) \<Rightarrow> bool" where
"invar \<phi> \<equiv> \<forall> s a. reach s \<and> \<phi> s \<longrightarrow> \<phi> (snd (step s a))"

lemma holdsIstate_invar:
  assumes h: "holdsIstate \<phi>" and i: "invar \<phi>" and a: "reach s"
  shows "\<phi> s"
  by (use a in \<open>induction rule: reach_step_induct\<close>)
     (use h i in \<open>auto simp: holdsIstate_def invar_def\<close>)

subsubsection \<open>Traces of actions\<close>

(* The trace given by a state and a ste of actions: *)
fun traceOf :: "'state \<Rightarrow> 'act list \<Rightarrow> ('state,'act,'out) trans trace" where
"traceOf s [] = []"
|
"traceOf s (a # al) =
 (case step s a of (ou,s1) \<Rightarrow> (Trans s a ou s1) # traceOf s1 al)"

(* Multi-step: *)
fun sstep :: "'state \<Rightarrow> 'act list \<Rightarrow> 'out list \<times> 'state" where
"sstep s [] = ([], s)"
|
"sstep s (a # al) = (case step s a of (ou,s') \<Rightarrow> (case sstep s' al of (oul, s'') \<Rightarrow> (ou # oul, s'')))"

lemma length_traceOf[simp]:
"length (traceOf s al) = length al"
by (induct al arbitrary: s) (auto split: prod.splits)

lemma traceOf_Nil[simp]:
"traceOf s al = [] \<longleftrightarrow> al = []"
by (metis length_traceOf length_0_conv)

lemma sstep_outOf_traceOf[simp]:
"sstep s al = (ou,s') \<Longrightarrow> map outOf (traceOf s al) = ou"
by (induct al arbitrary: s ou s') (auto split: prod.splits)

lemma sstep_tgtOf_traceOf[simp]:
"al \<noteq> [] \<Longrightarrow> sstep s al = (ou,s') \<Longrightarrow> tgtOf (last (traceOf s al)) = s'"
by (induct al arbitrary: s ou s') (auto split: prod.splits)

lemma srcOf_traceOf[simp]:
"al \<noteq> [] \<Longrightarrow> srcOf (hd (traceOf s al)) = s"
by (induct al arbitrary: s) (auto split: prod.splits)

lemma actOf_traceOf[simp]:
"map actOf (traceOf s al) = al"
by (induct al arbitrary: s) (auto split: prod.splits)

lemma traceOf_append:
"al \<noteq> [] \<Longrightarrow> s1 = tgtOf (last (traceOf s al)) \<Longrightarrow>
 traceOf s (al @ al1) = traceOf s al @ traceOf s1 al1"
by (induct al arbitrary: s s1 al1) (auto split: prod.splits)

lemma sstep_append:
assumes "sstep s al = (oul,s1)" and "sstep s1 al1 = (oul1,s2)"
shows "sstep s (al @ al1) = (oul @ oul1, s2)"
using assms by (induct al arbitrary: oul s s1 oul1 s2) (auto split: prod.splits)

lemma reach_sstep:
assumes "reach s" and "sstep s al = (ou,s1)"
shows "reach s1"
using assms apply(induction al arbitrary: ou s1 s)
by (auto split: prod.splits) (metis reach_PairI)

(* Alternative simp rules, from the left *)
lemma traceOf_consR[simp]:
assumes "al \<noteq> []" and "s1 = tgtOf (last (traceOf s al))" and "step s1 a = (ou,s2)"
shows "traceOf s (al ## a) = traceOf s al ## Trans s1 a ou s2"
using assms by (induct al arbitrary: s) (auto split: prod.splits)

lemma sstep_consR[simp]:
assumes "sstep s al = (oul,s1)" and "step s1 a = (ou,s2)"
shows "sstep s (al ## a) = (oul ## ou, s2)"
using assms by (induct al arbitrary: oul s s1 ou s2) (auto split: prod.splits)

lemma fst_sstep_consR:
"fst (sstep s (al ## a)) = fst (sstep s al) ## (fst (step (snd (sstep s al)) a))"
by (cases "sstep s al", cases "step (snd (sstep s al)) a") auto

lemma valid_traceOf[simp]: "al \<noteq> [] \<Longrightarrow> valid (traceOf s al)"
proof(induct al arbitrary: s)
  case (Cons a al)
  thus ?case by (cases "al = []") (auto split: prod.splits)
qed auto

lemma validFrom_traceOf[simp]: "validFrom s (traceOf s al)"
by (cases "al = []") auto

lemma validFrom_traceOf2:
  assumes "validFrom s tr"
  shows "tr = traceOf s (map actOf tr)"
  using assms
  by (induction tr arbitrary: s) (auto split: prod.splits simp: validFrom_def elim!: validTrans.elims)

lemma set_traceOf_validTrans:
assumes "trn \<in>\<in> traceOf s al"  shows "validTrans trn"
by (metis assms validFrom_traceOf validFrom_validTrans_set)

lemma traceOf_append_sstep: "traceOf s (al @ al1) = traceOf s al @ traceOf (snd (sstep s al)) al1"
by (induction al arbitrary: s al1) (auto split: prod.splits)

lemma snd_sstep_append: "snd (sstep s (al @ al1)) = snd (sstep (snd (sstep s al)) al1)"
by (cases "sstep s al", cases "sstep (snd (sstep s al)) al1") (auto simp add: sstep_append)

lemma snd_sstep_step_constant:
assumes "\<forall> a. a \<in>\<in> al \<longrightarrow> snd (step s a) = s"
shows "snd (sstep s al) = s"
using assms by (induction al) (auto split: prod.splits)

definition "const_tr tr \<equiv> \<forall>trn. trn \<in>\<in> tr \<longrightarrow> srcOf trn = tgtOf trn"

lemma const_tr_same_src_tgt:
  assumes "valid tr" "const_tr tr"
  shows "srcOfTr tr = tgtOfTr tr"
using assms unfolding const_tr_def by induction auto

lemma traceOf_snoc:
"traceOf s (al ## a) =
  traceOf s al ##
  Trans (snd (sstep s al))
        a
        (fst (step (snd (sstep s al)) a))
        (snd (step (snd (sstep s al)) a))"
by (metis (no_types, lifting) traceOf_Nil traceOf_append_sstep prod.case_eq_if traceOf.simps)

lemma traceOf_append_unfold:
"traceOf s (al1 @ al2) =
 traceOf s al1 @ traceOf (if al1 = [] then s else tgtOf (last (traceOf s al1))) al2"
using traceOf_append by (cases "al1 = []") auto

abbreviation "transOf s a \<equiv> Trans s a (fst (step s a)) (snd (step s a))"

lemma traceOf_Cons: "traceOf s (a # al) = transOf s a # traceOf (snd (step s a)) al"
by (auto split: prod.splits)

(* The notion of two actions commuting: *)
definition "commute s a1 a2
 \<equiv> snd (sstep s [a1, a2]) = snd (sstep s [a2, a1])"

(* The notion of one action absorbing another: *)
definition absorb :: "'state \<Rightarrow> 'act \<Rightarrow> 'act \<Rightarrow> bool" where
"absorb s a1 a2 \<equiv> snd (sstep s [a1, a2]) = snd (step s a2)"

lemma validFrom_commute:
  assumes "validFrom s0 (tr1 @ transOf s a # transOf (snd (step s a)) a' # tr2)"
      and "commute s a a'"
  shows "validFrom s0 (tr1 @ transOf s a' # transOf (snd (step s a')) a # tr2)"
using assms unfolding commute_def by (auto split: prod.splits simp add: validFrom_append validFrom_Cons)

lemma validFrom_absorb:
  assumes "validFrom s0 (tr1 @ transOf s a # transOf (snd (step s a)) a' # tr2)"
      and "absorb s a a'"
  shows "validFrom s0 (tr1 @ transOf s a' # tr2)"
using assms unfolding absorb_def by (auto split: prod.splits simp add: validFrom_append validFrom_Cons)

lemma validTrans_Trans_srcOf_actOf_tgtOf:
"validTrans trn \<Longrightarrow> Trans (srcOf trn) (actOf trn) (outOf trn) (tgtOf trn) = trn"
by (cases trn) auto

lemma validTrans_step_srcOf_actOf_tgtOf:
"validTrans trn \<Longrightarrow> step (srcOf trn) (actOf trn) = (outOf trn, tgtOf trn)"
by (cases trn) auto

lemma sstep_Cons:
"sstep s (a # al) = (fst (step s a) # fst (sstep (snd (step s a)) al), snd (sstep (snd (step s a)) al))"
by (auto split: prod.splits)
declare sstep.simps(2)[simp del]

lemma length_fst_sstep: "length (fst (sstep s al)) = length al"
by (induction al arbitrary: s) (auto simp: sstep_Cons)

(*<*)

end (* locale IO_Automaton *)

end

(*>*)


theory Nielson_VCGi_complete
imports Nielson_VCG Nielson_VCGi
begin

subsubsection "Completeness"

text \<open>As the improved VCG for the Nielson logic is only more liberal in the sense that
      the S annotation is only checked for "interesting" variables, if we specify the
      set of interesting variables to be all variables we basically get the same
      verification conditions as for the normal VCG.
      In that sense, we can prove the completeness of the improved VCG with the completeness
      theorem of the normal VCG.

      For that, we formulate some translation functions and in the end show completeness of the
      improved VCG:\<close>

fun transl :: "Nielson_VCG.acom \<Rightarrow> Nielson_VCGi.acom" where
  "transl SKIP = SKIP" |
  "transl (x ::= a) = (x ::= a)" |
  "transl (C\<^sub>1;; C\<^sub>2) = (transl C\<^sub>1;; transl C\<^sub>2)" |
  "transl (IF b THEN C\<^sub>1 ELSE C\<^sub>2) = (IF b THEN transl C\<^sub>1 ELSE transl C\<^sub>2)" |
  "transl ({A/B/D} CONSEQ C) = ({(A,UNIV)/(B,UNIV)/(D,UNIV)} CONSEQ transl C)" |
  "transl ({(I,S,E)} WHILE b DO C) = ({((I,UNIV),S,E,UNIV,(\<lambda>v. UNIV))} WHILE b DO transl C)"

lemma qdeps_UNIV: "qdeps (transl C) UNIV = UNIV"
  apply(induct C) apply auto done

lemma fune_UNIV: "fune (transl C) UNIV = UNIV"
  apply(induct C) apply auto done

lemma pre_transl: "Nielson_VCGi.pre (transl C) Q = Nielson_VCG.pre C Q"
  apply(induct C arbitrary: Q) by (auto)

lemma preT_transl: "Nielson_VCGi.preT (transl C) E = Nielson_VCG.preT C E"
  apply(induct C arbitrary: E) by (auto)

lemma postQ_transl: "Nielson_VCGi.postQ (transl C) = Nielson_VCG.postQ C"
  apply(induct C) by (auto)

lemma time_transl: "Nielson_VCGi.time (transl C)  = Nielson_VCG.time C"
  apply(induct C ) by(auto simp: preT_transl)

lemma vc_transl: "Nielson_VCG.vc C Q \<Longrightarrow> Nielson_VCGi.vc (transl C) Q UNIV UNIV"
proof (induct C arbitrary: Q)
next
  case (Aconseq x1 x2 x3 C)
  then show ?case apply (auto simp: pre_transl time_transl) apply presburger+ done
next
  case (Awhile A b C)
  obtain I S E where "A=(I,S,E)" using prod_cases3 by blast
  with Awhile show ?case apply (auto simp: pre_transl preT_transl time_transl postQ_transl) apply presburger+ done
qed (auto simp: qdeps_UNIV fune_UNIV pre_transl)

lemma strip_transl: "Nielson_VCGi.strip (transl C) = Nielson_VCG.strip C"
  by (induct C, auto)

lemma vc_restrict_complete:
  assumes  "\<turnstile>\<^sub>1 {P} c { e \<Down> Q}"
  shows "\<exists>C. Nielson_VCGi.strip C = c \<and> Nielson_VCGi.vc C Q UNIV UNIV
  \<and> (\<forall>l s. P l s \<longrightarrow> Nielson_VCGi.pre C Q l s \<and> Q l (Nielson_VCGi.postQ C s))
  \<and> (\<exists>k. \<forall>l s. P l s \<longrightarrow>  Nielson_VCGi.time C s \<le> k * e s)  "
  (is "\<exists>C. ?G P c Q C e")
proof -
  obtain C where C: "Nielson_VCG.strip C = c" "Nielson_VCG.vc C Q" "(\<forall>l s. P l s \<longrightarrow> Nielson_VCG.pre C Q l s \<and> Q l (Nielson_VCG.postQ C s))"
        "(\<exists>k. \<forall>l s. P l s \<longrightarrow> Nielson_VCG.time C s \<le> k * e s)" using vc_complete[OF assms] by blast
  let ?C="transl C"
  from C have "?G P c Q ?C e"
    by(auto simp: strip_transl vc_transl pre_transl postQ_transl time_transl)
  then show ?thesis ..
qed

end


\<^marker>\<open>creator Bernhard Pöttinger\<close>

chapter \<open>PIP: Example\<close>
theory Pip_Example
imports Pip_Shared Pip_Release Pip_Acquire
begin

paragraph \<open>Application of PIP operations\<close>

definition "fold_GrI_repl x \<equiv> ff.fold_GrI x"

theorem replacement':
  assumes "i = i1 + i2" "i1 \<lesssim> i1'" "i \<noteq> bot" "i1' \<noteq> bot"
    "dom_fi i1' \<inter> dom_fi i2 = {}" "outf_fi i2 = (\<lambda>_. 0) on (dom_fi i1' - dom_fi i1)"
  shows "i1 + i2  \<lesssim> i1' + i2 \<and> i1' + i2 \<noteq> bot"
  using replacement assms by blast

lemma NI_GrI_disj:
  "ff.NI g x fs m ix * ff.GrI \<eta> Fs X iX \<Longrightarrow>\<^sub>A ff.NI g x fs m ix * ff.GrI \<eta> Fs X iX * \<up>(x \<notin> X)"
  unfolding ff.NI_def ff.GrI_def ff.N_def ff.Gr_def
  apply sep_auto
  by (smt Set.set_insert assn_times_assoc assn_times_comm finite_insert mod_pure_star_dist
      prod.insert pure_false sngr_same_false)

lemma zero_lessim_fi':
  assumes "\<forall>x' \<in> -dom_fi i. outf_fi i x' = 0" "i \<noteq> bot"
  shows "0 \<lesssim> i"
  using assms
  unfolding contextual_extension_def zero_fi_def
  by auto

lemma fold_GrI_repl_rule:
  assumes "x \<notin> X" "outf_fi ix = (\<lambda>_. 0) on -dom_fi ix" "outf_fi iX x = {#}"
  shows "<ff.GrI \<eta> Fs X iX * ff.NI g x fs m ix>
   fold_GrI_repl x
   <\<lambda>_. ff.GrI (\<eta>(x := g)) (Fs(x := fs)) ({x} \<union> X) (iX + ix) * \<up>(x \<notin> X \<and> iX + ix \<noteq> bot)>"
  using assms
  unfolding fold_GrI_repl_def apply simp
  apply (rule cons_pre_rule[OF ent_frame_fwd[OF ff.peek_NI]], frame_inference+, clarsimp)
  apply (rule cons_pre_rule[OF ent_frame_fwd[OF ff.GrI_dom]], frame_inference+, clarsimp)
  using replacement'[of iX 0 iX ix, OF _ zero_lessim_fi'[of ix]] apply auto
  apply (sep_auto heap: ff.fold_GrI_rule simp: algebra_simps)
  by (rule ff.GrI_cong, simp_all add: algebra_simps)

definition alloc_node :: "int \<Rightarrow> fields ref Heap" where
"alloc_node q0 \<equiv> do {
  n \<leftarrow> ref (Fields None q0 q0 {#});
  ff.close_NI n ({#} :: int multiset);
  fold_GrI_repl n;
  return n
}"

lemma alloc_correct:
  assumes "q0 \<ge> 0" "outf_fi i = (\<lambda>_. 0) on -dom_fi i"
  shows "<ff.GrI \<eta> Fs X i>
    alloc_node q0
    <\<lambda>x. \<exists>\<^sub>Aix. ff.GrI (\<eta>(x := None))
      (\<lambda>x'. if x = x' then Fields None q0 q0 {#} else Fs x') (X \<union> {x}) (i + ix) *
      \<up>(i + ix \<noteq> bot \<and> ix = fi {x} (\<lambda>_. 0) (\<lambda>_. 0) \<and> x \<notin> dom_fi i)>"
   apply (rule cons_pre_rule[OF ent_frame_fwd[OF ff.GrI_dom]])
    apply frame_inference+
  apply clarsimp
  using assms
  unfolding alloc_node_def
  apply (sep_auto heap: ff.close_NI_rule)
   apply (rule cons_pre_rule)
    apply (rule NI_GrI_disj)
   apply (rule cons_pre_rule[OF ent_frame_fwd[OF ff.GrI_dom]])
     apply frame_inference+
   apply (sep_auto heap: ff.close_NI_rule fold_GrI_repl_rule)+
  by (rule ff.GrI_cong, auto)

definition pip_example where
"pip_example \<equiv> do {
  a \<leftarrow> alloc_node 1;
  b \<leftarrow> alloc_node 2;
  acquire a b;
  c \<leftarrow> alloc_node 3;
  acquire b c;
  release a b;
  acquire c a;

  return (a,b,c)
}"

lemma no_infl_no_outfl_plus_fg:
  assumes "finite X1" "finite X2" "X1 \<inter> X2 = {}"
  shows "fi X1 (\<lambda>_. 0) (\<lambda>_. 0) + fi X2 (\<lambda>_. 0) (\<lambda>_. 0) = fi (X1 \<union> X2) (\<lambda>_. 0) (\<lambda>_. 0)"
  apply (rule is_sum_fi_to_plus_fi)
  using assms unfolding is_sum_fi_def by auto

lemma pip_example_correct:
  shows "<ff.GrI Map.empty Fs0 {} 0 * \<up>(\<phi> 0)>
    pip_example
    <\<lambda>(a,b,c). (\<exists>\<^sub>AFs i \<eta>. ff.GrI \<eta> Fs {a,b,c} i *
               \<up>(\<eta> = Map.empty(c \<mapsto> b, a \<mapsto> c) \<and>
                 i = fi {a,b,c} (\<lambda>_. 0) (\<lambda>_. 0) \<and> \<phi> i))>"
  unfolding pip_example_def
  apply (sep_auto heap: alloc_correct acquire_correct release_correct
         simp: no_infl_no_outfl_plus_fg zero_fi_def \<phi>_def)
  by (rule ff.GrI_cong, auto simp: no_infl_no_outfl_plus_fg insert_commute)

end


theory TopoS_Helper
imports Main TopoS_Interface
  TopoS_ENF
  vertex_example_simps
begin

lemma (in SecurityInvariant_preliminaries) sinvar_valid_remove_flattened_offending_flows:
  assumes "valid_graph \<lparr>nodes = nodesG, edges = edgesG\<rparr>"
  shows "sinvar \<lparr>nodes = nodesG, edges = edgesG - \<Union> (set_offending_flows \<lparr>nodes = nodesG, edges = edgesG\<rparr> nP) \<rparr> nP"
proof -
  { fix f
    assume *: "f\<in>set_offending_flows \<lparr>nodes = nodesG, edges = edgesG\<rparr> nP"

    from * have 1: "sinvar \<lparr>nodes = nodesG, edges = edgesG - f \<rparr> nP"
      by (metis (hide_lams, mono_tags) SecurityInvariant_withOffendingFlows.valid_without_offending_flows delete_edges_simp2 graph.select_convs(1) graph.select_convs(2))
    from * have 2: "edgesG - \<Union> (set_offending_flows \<lparr>nodes = nodesG, edges = edgesG\<rparr> nP) \<subseteq> edgesG - f"
      by blast
    note 1 2
  }
  with assms show ?thesis
    by (metis (hide_lams, no_types) Diff_empty Union_empty defined_offending equals0I mono_sinvar valid_graph_remove_edges)
qed

end


(* Author: Dmitriy Traytel *)

theory M2L_Examples
imports M2L_Equivalence_Checking "~~/src/HOL/Library/Char_ord"
    "~~/src/HOL/Library/Product_Lexorder"
begin

abbreviation FALSE where "FALSE \<equiv> FExists (FLess 0 0)"
abbreviation TRUE where "TRUE \<equiv> FNot FALSE"
abbreviation All where "All \<phi> \<equiv> FNot (FExists (FNot \<phi>))"
abbreviation AL where "AL \<phi> \<equiv> FNot (FEXISTS (FNot \<phi>))"
abbreviation Imp where "Imp \<phi> \<psi> \<equiv> FOr (FNot \<phi>) \<psi>"
abbreviation Iff where "Iff \<phi> \<psi> \<equiv> FAnd (Imp \<phi> \<psi>) (Imp \<psi> \<phi>)"
abbreviation Ball where "Ball X \<phi> \<equiv> All (Imp (FIn 0 (X+1)) \<phi>)"
abbreviation Bex where "Bex X \<phi> \<equiv> FExists (FAnd (FIn 0 (X+1)) \<phi>)"

abbreviation Eq where "Eq x y \<equiv> FAnd (FNot (FLess x y)) (FNot (FLess y x))"
abbreviation SUBSET where "SUBSET X Y \<equiv> Ball X (FIn 0 (Y+1))"
abbreviation EQ where "EQ X Y \<equiv> FAnd (SUBSET X Y) (SUBSET Y X)"
abbreviation First where "First x \<equiv> FNot (FExists (FLess 0 (x+1)))"
abbreviation Last where "Last x \<equiv> FNot (FExists (FLess (x+1) 0))"
abbreviation Suc where "Suc sucx x \<equiv> FAnd (FLess x sucx) (FNot (FExists (FAnd (FLess (x+1) 0) (FLess 0 (sucx+1)))))"

definition "Thm (type :: 'a :: {enum, linorder} itself) n \<phi> = fast.check_eqv n (FNot \<phi> :: 'a formula) FALSE"
definition "Thm_slow (type :: 'a :: {enum, linorder} itself) n \<phi> = slow.check_eqv n (FNot \<phi> :: 'a formula) FALSE"
definition "Thm_dual (type :: 'a :: {enum, linorder} itself) n \<phi> = dual.check_eqv n (FNot \<phi> :: 'a formula) FALSE"

definition "M2L = (FEXISTS (All (FIn 0 1)) :: Enum.finite_1 formula)"

lemma "Thm TYPE(Enum.finite_1) 0 M2L" by eval
lemma "Thm TYPE(Enum.finite_1) 0 (FNot (All (FExists (FLess 1 0))))" by eval
lemma "Thm (TYPE(bool)) 0 (FNot (FExists (FExists (FAnd (FLess 0 1) (FLess 1 0)))))" by eval
lemma Drinker: "Thm (TYPE(bool)) 1 (FExists (Imp (FIn 0 1) (All (FIn 0 2))))" by eval
lemma "Thm (TYPE(bool)) 1 (Imp (All (FIn 0 1)) (FExists (FIn 0 1)))" by eval

(*
definition "mod_two a b c d = Iff a (Iff b (Iff c d))"
definition "at_least_two a b c d = Iff d (FOr (FAnd a b) (FOr (FAnd b c) (FAnd a c)))"

definition "ADD S A B = FEXISTS (FAnd (All (Imp (First 0) (FNot (FIn 0 1))))
  (All (FAnd (mod_two (FIn 0 (A+2)) (FIn 0 (B+2)) (FIn 0 1) (FIn 0 (S+2)))
       (Imp (FExists (FAnd (Last 0) (FLess 1 0)))
            (at_least_two (FIn 0 (A+2)) (FIn 0 (B+2)) (FIn 0 1) (All (Imp (Suc 0 1) (FIn 0 2))))))))"

definition Comm_Lemma :: "Enum.finite_1 formula" where
  "Comm_Lemma = AL (AL (FEXISTS (FAnd (ADD 0 1 2) (FEXISTS (FAnd (ADD 0 3 2) (EQ 0 1))))))"

lemma "Thm TYPE(bool) 0 (AL (AL (FEXISTS (ADD 0 1 2))))"
  by eval

lemma "Thm TYPE(Enum.finite_1) 0 Comm_Lemma"
  by eval
*)

abbreviation Globally ("\<box>_" [40] 40) where "Globally P == %n. All (Imp (FNot (FLess (n+1) 0)) (P 0))"
abbreviation Future ("\<diamondsuit>_" [40] 40) where "Future P == %n. FExists (FAnd (FNot (FLess (n+1) 0)) (P 0))"
abbreviation IMP (infixr "\<rightarrow>" 50) where "IMP P1 P2 == %n. Imp (P1 n) (P2 n)"

abbreviation "FOR xs n \<equiv> rexp_of_list FOr FALSE (map (\<lambda>x. FQ x n) xs)"

abbreviation \<Phi>0 :: "bool formula" where "\<Phi>0 \<equiv>
  (All (((\<box>(FOR [(True)])) \<rightarrow> (\<box>(FOR [(True)]))) 0))"

abbreviation \<Phi>1 :: "(bool \<times> bool) formula" where "\<Phi>1 \<equiv>
  (All (((\<box>(FOR [(True, True), (True, False)] \<rightarrow>
            FOR [(True, True), (False, True)])) \<rightarrow>
         (\<box>(FOR [(True, True), (True, False)])) \<rightarrow>
         (\<box>(FOR [(True, True), (False, True)]))) 0))"

abbreviation \<Phi>2 :: "(bool \<times> bool \<times> bool) formula" where "\<Phi>2 \<equiv>
  (All (((\<box>(FOR [(True, True, True), (True, True, False), (True, False, True), (True, False, False)] \<rightarrow>
            FOR [(True, True, True), (True, True, False), (False, True, True), (False, True, False)] \<rightarrow>
            FOR [(True, True, True), (True, False, True), (False, True, True), (False, False, True)])) \<rightarrow>
        (\<box>(FOR [(True, True, True), (True, True, False), (True, False, True), (True, False, False)])) \<rightarrow>
        (\<box>(FOR [(True, True, True), (True, True, False), (False, True, True), (False, True, False)])) \<rightarrow>
        (\<box>(FOR [(True, True, True), (True, True, False), (False, True, True), (False, True, False)]))) 0))"

definition \<Psi> :: "nat \<Rightarrow> Enum.finite_1 formula" where
  "\<Psi> n = All (((\<box>(foldr (\<lambda>i \<phi>. (\<lambda>m. FIn m (2 + i)) \<rightarrow> \<phi>) [0..<n] (\<lambda>m. FIn m (n + 2)))) \<rightarrow>
     foldr (\<lambda>i \<phi>. (\<box>(\<lambda>m. FIn m (2 + i))) \<rightarrow> \<phi>) [0..<n] (\<box>(\<lambda>m. FIn m (n + 2)))) 0)"

definition "Thm1 n = Thm (TYPE(Enum.finite_1)) (n + 1) (\<Psi> n)"
definition "Thm1_slow n = Thm_slow (TYPE(Enum.finite_1)) (n + 1) (\<Psi> n)"
definition "Thm1_dual n = Thm_dual (TYPE(Enum.finite_1)) (n + 1) (\<Psi> n)"

lemma "Thm1 0" by eval
lemma "Thm1 1" by eval
lemma "Thm1 2" by eval

lemma "Thm (TYPE(bool)) 0 \<Phi>0" by eval
lemma "Thm (TYPE(bool * bool)) 0 \<Phi>1" by eval
lemma "Thm (TYPE(bool * bool * bool)) 0 \<Phi>2" by eval

(*
export_code Thm1 Nat in SML module_name M2L_Thm1 file "M2L_Thm1.ML"
export_code Thm1_slow Nat in SML module_name M2L_Thm1_slow file "M2L_Thm1_slow.ML"
export_code Thm1_dual Nat in SML module_name M2L_Thm1_dual file "M2L_Thm1_dual.ML"

ML_file "M2L_Thm1.ML"
ML_file "M2L_Thm1_slow.ML"
ML_file "M2L_Thm1_dual.ML"

ML {* PolyML.timing true; open M2L_Thm1; thm1 (Nat 0); thm1 (Nat 1); thm1 (Nat 2); thm1 (Nat 3); *}
ML {* PolyML.timing true; open M2L_Thm1_dual; thm1_dual (Nat 0); thm1_dual (Nat 1); thm1_dual (Nat 2); thm1_dual (Nat 3); *}
ML {* PolyML.timing true; open M2L_Thm1_slow; thm1_slow (Nat 0); thm1_slow (Nat 1); thm1_slow (Nat 2); *}
*)
end


theory Ex002
imports Main
begin

lemma "A \<Longrightarrow> B \<Longrightarrow> A" by assumption

lemma "A \<Longrightarrow> B \<Longrightarrow> A"
proof -
assume A
then show A by assumption (*then = from this*)
qed

lemma "A \<longrightarrow> B \<longrightarrow> A"
proof -
{
  assume A
  {
    assume B
    from \<open>A\<close> have A by assumption (*the brackets \<open> (\open) \<close> (\close) make it possible to reference a fact without giving it a name prior*)
  }
  hence "B \<longrightarrow> A" by (rule impI) (*hence = from this have*)
}
thus ?thesis ..
qed
(*thus = from this show*)(*?thesis refers to the lemma we want to proof*)(*the two dots mean "by rule",
Isabelle often pics the right rule*)


theory BDD_not
  imports Main BDD_basic BDD_select BDD_dedup
begin

fun not :: "BDD \<Rightarrow> BDD" where
  "not Nothing = Top" |
  "not Top = Nothing" |
  "not (Select a t e) = Select a (not t) (not e)"

theorem not_inj [simp]: "(not a = not b) = (a = b)"
  apply (induction a arbitrary: b)
  apply auto
  apply (metis BDD.distinct(5) not.elims)
  apply (metis BDD.distinct(3) not.elims)
  by (smt (z3) BDD.distinct(5) BDD.inject not.cases not.simps(1) not.simps(2) not.simps(3))

theorem not_ordered [simp]: "ordered n (not a) = ordered n a"
  apply (rule iffI)
  apply (induction a arbitrary: n)
  apply simp_all
  apply (metis BDD.inject BDD.simps(5) BDD.simps(7) ordered.simps)
  apply (induction a rule: ordered.induct)
  by auto

theorem not_norm [simp]: "norm n (not a) = norm n a"
  apply (rule iffI)
  apply (induction a)
  apply (auto)
  using norm.cases apply auto[1]
  apply (rule norm_sel)
  apply auto
  apply (metis BDD.distinct(3) BDD.distinct(5) BDD.inject elim_dup_dedups elim_dup_noop norm_ord norm_widen not_ordered)
  apply (metis BDD.distinct(3) BDD.distinct(5) BDD.inject elim_dup_dedups elim_dup_noop norm_ord norm_widen not_ordered)
  apply (induction n a rule: norm.induct)
  by simp_all

theorem not_correct [simp]: "contains (not a) f \<noteq> contains a f"
  apply auto
  apply (induction a)
  apply simp_all
  using contains.cases apply blast
  apply (induction a)
  apply simp_all
  by (metis contains_sel_e contains_sel_t)

theorem not_inv [simp]: "not (not a) = a"
  apply (induction a)
  apply auto
  done

lemma all_not [simp]: "(\<forall>f. \<not>contains a f) = (\<forall>f. contains (not a) f)"
  using not_correct by blast

lemma norm_nothing: "norm n b \<Longrightarrow> (\<forall>f. ~contains b f) \<Longrightarrow> b = Nothing"
  apply (induction rule: norm.induct)
  using contains.simps apply blast
  apply (rule refl)
  by (metis BDD.distinct(5) BDD_basic.norm_top all_not norm_sel not.simps(3) not_norm)

end