(*<*)
theory EverythingAdequacy
imports CorrectnessOriginal Adequacy "~~/src/HOL/Library/LaTeXsugar"
begin

(*
notation (latex output) DenotationalUpd.ESem ("\<lbrakk>_\<rbrakk>\<^bsup>u\<^esup>\<^bsub>_\<^esub>"  [60,60] 60)
notation (latex output) "Denotational-PropsUpd.HSem_syn" ("\<lbrace>_\<rbrace>\<^bsup>u\<^esup>_"  [60,60] 60)
*)

translations
  "xs" <= "CONST set xs"
translations
  "a" <= "CONST atom a"
translations
  "a" <= "CONST image (CONST atom) a"

abbreviation map_of_syntax :: "'a::type \<Rightarrow> 'b::type \<Rightarrow> ('a \<times> 'b) list \<Rightarrow> bool" ("'(_, _') \<in> _")
  where "map_of_syntax x e \<Gamma> \<equiv> map_of \<Gamma> x = Some e"

abbreviation delete_syntax :: "heap \<Rightarrow> var \<Rightarrow> heap" ("_\\_")
  where "delete_syntax \<Gamma> x \<equiv> delete x \<Gamma>"

notation (latex output) domA ("\<^raw:\textrm{\textsf{dom}}> _")
notation (latex output) bn ("\<^raw:\textrm{\textsf{dom}}> _")

declare [[names_short]]
declare [[show_question_marks = false]]

(*>*)
subsection {* Main definitions and theorems *}

text {*
For your convenience, the main definitions and theorems of the present work are assembled in this section. The following
formulas are mechanically pretty-printed versions of the statements as defined resp.\ proven in Isabelle.
Free variables are all-quantified. Some type conversion functions (like @{term_type set}) are omitted.
The relations @{text \<sharp>} and @{text "\<sharp>*"} come from the Nominal package and express freshness of the
variables on the left with regard to the expressions on the right.

\input{map.tex}
*}

subsubsection {* Expressions *}

text {*
The type @{typ var} of variables is abstract and provided by the Nominal package. All we know about
it is that it is countably infinite.
Expressions of type @{typ exp} are given by the following grammar:
\begin{alignatstar}{2}
@{term e} \Coloneqq {}& @{term "Lam [x]. e"} &\quad& \text{lambda abstraction}\\
\mid {} & @{term "App e x"} && \text{application}\\
\mid {} & @{term "Var x"} && \text{variable} \\
\mid {} & @{term "Let as e"} && \text{recursive let}
\end{alignatstar}
In the introduction we pretty-print expressions to resemble the notation in \cite{launchbury} and omit
the constructor names @{term Var}, @{term App}, @{text Lam} and @{term Let}. In the actual theories, these are visible.
These expressions are, due to the machinery of the Nominal package, actually alpha-equivalency classes, so @{thm alpha_test} holds provably. This differs from Launchbury's original definition, which expects distinctly-named expressions and performs explicit alpha-renaming in the semantics.

The type @{type heap} is an abbreviation for @{typ "(var \<times> exp) list"}. These are \emph{not} alpha-equivalency classes, i.e.\ we manage the bindings in heaps explicitly.
*}

subsubsection {* The natural semantics *}

text_raw {*
\newlength{\rulelen}
\setlength{\rulelen}{\linewidth}
\newlength{\rulenamelen}
\settowidth{\rulenamelen}{~{\sc Application}}
\addtolength{\rulelen}{-\rulenamelen}
*}

text {*
Launchbury's original semantics, extended with some technical overhead related to name binding (following \cite{sestoft}),
is defined as follows:\\
%\begin{center}
\parbox[t]{\rulelen}{\centering@{thm[mode=Axiom] Launchbury.reds.Lambda}}~{\sc Lambda}\\[2ex]
\parbox[t]{\rulelen}{\centering@{thm[mode=Rule] Launchbury.reds.Application}}~{\sc Application}\\[2ex]
\parbox[t]{\rulelen}{\centering@{thm[mode=Rule] Launchbury.reds.Variable}}~{\sc Variable}\\[2ex]
\parbox[t]{\rulelen}{\centering@{thm[mode=Rule] Launchbury.reds.Let}}~{\sc Let}
%\end{center}
*}

subsubsection {* The denotational semantics *}

text {*
The value domain of the denotational semantics is the initial solution to
\[
D = [D \to D]_\bot
\]
as introduced in \cite{abramsky}. The type @{typ Value}, together with the bottom value @{term_type "\<bottom>::Value"}, the
injection @{term_type "Fn"} and the projection @{term "DUMMY \<down>Fn DUMMY"}@{text "::"}@{typeof "Fn_project"},
is constructed as a pointed chain-complete partial order from this equation by the HOLCF package.
The type of semantic environments is  @{typ "var \<Rightarrow> Value"}.

The semantics of an expression @{term_type "e :: exp"} in an environment @{term "\<rho>"}@{text "::"}@{typ "var \<Rightarrow> Value"} is
written \mbox{@{term_type "Rep_cfun (Denotational.ESem e) \<rho>"}} and defined by the following equations:
\begin{alignstar}
@{thm (lhs) Denotational.ESem_simps(1)} & = @{thm (rhs) Denotational.ESem_simps(1)} \\
@{thm (lhs) Denotational.ESem_simps(2)} & = @{thm (rhs) Denotational.ESem_simps(2)} \\
@{thm (lhs) Denotational.ESem_simps(3)} & = @{thm (rhs) Denotational.ESem_simps(3)} \\
@{thm (lhs) Denotational.ESem_simps(4)} & = @{thm (rhs) Denotational.ESem_simps(4)}.
\end{alignstar}
*}

text{*
The expression @{term "Denotational.EvalHeapSem_syn'' \<Gamma> \<rho>"}
maps the evaluation function over a heap, returning an environment:
\begin{alignstar}
@{thm (lhs) lookupEvalHeap'[where f = "(\<lambda> e. Denotational.ESem_syn e \<rho>)"]}
  & = @{thm (rhs) lookupEvalHeap'[where f = "(\<lambda> e. Denotational.ESem_syn e \<rho>)"]}
  && \text{if } @{thm (prem 1) lookupEvalHeap'[where f = "(\<lambda> e. Denotational.ESem_syn e \<rho>)"]} \\
@{thm (lhs) lookupEvalHeap_other[where f = "(\<lambda> e. Denotational.ESem_syn e \<rho>)"]}
  & = @{thm (rhs) lookupEvalHeap_other[where f = "(\<lambda> e. Denotational.ESem_syn e \<rho>)"]}
  && \text{if } @{thm (prem 1) lookupEvalHeap_other[where f = "(\<lambda> e. Denotational.ESem_syn e \<rho>)"]}
\end{alignstar}
*}

text {*
The semantics @{term "Rep_cfun (Denotational.HSem \<Gamma>) \<rho>"}@{text "::"}@{typ "var \<Rightarrow> Value"} of a
heap @{term "\<Gamma> :: heap"}@{text "::"}@{typ heap}
in an environment @{term "\<rho>"}@{text "::"}@{typ "var \<Rightarrow> Value"} is  defined by the recursive equation
\[ @{thm "Denotational.HSem_eq"} \]
where
\begin{alignstar}
@{thm (lhs) override_on_apply_notin} & = @{thm (rhs) override_on_apply_notin}  && \text{if } @{thm (prem 1) override_on_apply_notin} \\
@{thm (lhs) override_on_apply_in} & = @{thm (rhs) override_on_apply_in}  && \text{if } @{thm (prem 1) override_on_apply_in}.
\end{alignstar}

The semantics of the heap in the empty environment @{term "\<bottom>"} is abbreviated as @{abbrev "Denotational.HSem_bot \<Gamma>"}.
*}

subsubsection {* Correctness and Adequacy *}
text {* The statement of correctness  reads:
If @{thm (prem 1) CorrectnessOriginal.correctness(1)} and, as a side condition,
@{thm (prem 2) CorrectnessOriginal.correctness(1)} holds,
then
\[
@{thm (concl) CorrectnessOriginal.correctness(1)}.
\]
*}
(*
\]
and
\[
@{thm (concl) CorrectnessOriginal.correctness(2)}.
\]
The latter is phrased slightly different than in \cite{launchbury}, which defines a partial relation
@{text "\<le>"} on heaps, by being more explictit on what set of variables the heaps agree.
*)

text {* The statement of adequacy reads:
\[
\text{If }
@{thm (prem 1) adequacy}\text{ then }@{thm (concl) adequacy}.
\]
*}

subsection {* Differences to our previous work *}

text {*
We have previously published \cite{breitner2013} of which the present work is a continuation. They differ in scope and focus:

\subsubsection{The treatment of $\sqcup$}

In \cite{breitner2013}, the question of the precise meaning of $\sqcup$ is discussed in detail. The
original paper is not clear about whether this operator denotes the least upper bound, or the
right-sided override operator. A lemma stated in \cite{launchbury} only holds if $\sqcup$ is the least upper bound,
but with that definition, Launchbury's Theorem 2 -- the generalized correctness theorem -- is false;
a counter-example is given in \cite{breitner2013}.

We came up with an alternative operational semantics that keeps more of the
evaluation context in the judgments and allows the correctness theorem to be proved inductively
without the problematic generalization. We proved the two operational semantics equivalent and thus
obtained the (non-generalized) correctness of Launchbury's semantics.

We also showed that if one takes $\sqcup$ to be the update operator, Theorem 2 holds and the proof
goes through as it is. Furthermore, we showed that the resulting denotational semantics are
identical for expressions, and can differ only for heaps. Therefore, the question of the precise
meaning of $\sqcup$ can be considered of little importance and for the present work we soley work
with right sided updates. We also avoid the ambiguos syntax $\sqcup$ and write
@{term "DUMMY ++\<^bsub>DUMMY\<^esub> DUMMY"} instead (the index indicates on what set the function on the right
overrides the function on the left). The alternative operational semantics is not included in this work.

\subsubsection{The types of environments}

Another difference is the choice of the type for environments, which map variables to semantics values.
A naive choice is @{typ "var \<Rightarrow> Value"}, but this causes problems when defining the value semantics,
for which
\[
@{thm Denotational.ESem_simps(1)}
\]
is a defining equation. The argument on the left hand side is the representative of an equivalence class
(defined using the Nominal package), so this is only allowed if the right hand side is indeed independent
 of the actual choice of @{text "x"}. This is shown most commonly and easily if @{text x} is fresh in all the
other arguments (@{term "atom x \<sharp> \<rho>"}), and indeed the Nominal package allows us to specify this as a side
condition to the defining equation, which is what we did in \cite{breitner2013}.

But this convenience comes as a price: Such side-conditions are
only allowed if the argument has finite support (otherwise there might no variable fulfilling
@{term "atom x \<sharp> \<rho>"}). More precisely: The type of the argument must be a member of the @{class fs} typeclass
provided by the Nominal package. The type @{typ "var \<Rightarrow> Value"} cannot be made a member of this class,
as there obviously are elements that have infinite support. The fix here was to introduce a new type
 constructor, @{text "fmap"}, for partial functions with finite domain. This is fine: Only functions
with finite domain matter in our formalisation.

The introduction of @{text "fmap"} had further consequences. The main type class of the HOLCF package,
which we use to define domains and continuous functions on them, is the class @{class cpo}, of chain-complete
partial orders. With the usual ordering on partial functions, @{text "(var, Value) fmap"} cannot be
a member of this class. The fix here is to use a different ordering and only let elements be compareable
that have the same domain. In our formalisation, the domain is alway known (e.g.\ all variables
bound on some heap), so this worked out.

But not without causing yet another issue: With this ordering, @{text "(var, Value) fmap"} is a
@{class cpo}, but lacks a bottom element, i.e.\ now it is no @{class pcpo}, and HOLCF's built-in operator
@{term "\<mu> x. f x"} for expressing least fixed-points, as they occur in the semantics of heaps,
is not available. Furthermore, @{text "\<squnion>"} is not a total function, i.e.\ defined only on a subset of
all possible arguments. The solution was a rather convoluted set of theories that formalize functions that
are continuous on a specific set, fixed-points on such sets etc.

In the present work, this problems is solved in a much more elegant way. Using a small trick we defined
the semantics functions so that
\[
@{thm Denotational.ESem_simps(1)}
\]
holds unconditionally. The actual, technical definition is
\[
@{thm Denotational.ESem_simps_as_defined(1)}
\]
where the right-hand-side can be shown to be invariant of the choice of @{text x}, as
@{term "x \<notin> fv (Lam [x]. e)"}. Once the function is defined, the equality
@{thm Denotational.ESem_considers_fv'} can be proved. With that, the desired equation for
@{thm (lhs) Denotational.ESem_simps(1)} follows. The same trick is applied to the equation for
@{thm (lhs) Denotational.ESem_simps(4)}.

This allows us to use the type @{typ "var \<Rightarrow> Value"} for the semantic envionments and considerably
simplifies the formalization compared to \cite{breitner2013}.

\subsubsection{No type @{type assn}}

The nominal package provides means to define types that are alpha-equivalence classes, and we use that
to define our type @{type exp}, which contains a constructor @{term "Let binds expr"}. The desired type
of the parameter for the binding is @{typ "(var \<times> exp) list"}, but the Nominal package does not support
such nested recursion, and requires a mutual recursive definition with a custom type (@{type assn})
with constructors @{term ANil} and @{term ACons} that is isomorphic to @{typ "(var \<times> exp) list"}.
In \cite{breitner2013}, this type and conversion functions from and to @{typ "(var \<times> exp) list"}
cluttered the whole development. In the present work we improved this by defining the type with
a ``temporary'' constructor @{term_type LetA}. Afterwards we define conversions functions and
the desired constructor @{term_type Let}, and re-state all lemmas produced by the Nominal package
(such as type exhaustiveness, distinctiveness of constructors and the induction rules) with that
constructor. From that point on, the development is free of the crutch @{typ assn}.

In short, the notable changes in this work over \cite{breitner2013} are:
\begin{itemize}
\item We consider @{text "\<squnion>"} to be a right-sided update and do discuss neither the problem with
@{text "\<squnion>"} denoting the least uppper bound, nor possible solutions.
\item This, a simpler choice for the type of semantic environments and a better definition of the type for terms, considerably simplifies the
work.
\item Most importantly, this work contains a complete and formal proof of the adequacy of Launchbury's semantics.
\end{itemize}
*}

text{*
\subsection{Related work}

Lidia Sánchez-Gil, Mercedes Hidalgo-Herrero and Yolanda Ortega-Mallén have worked on formal aspects
of Launchbury's semantics as well.

They identified a step in his adequacy proof
relating the standard and the resourced denotational semantics that is not as trivial as it seems at
first and worked out a detailed pen-and-paper proof \cite{functionspaces}, where they first
construct a similarity relation @{term "DUMMY \<triangleleft>\<triangleright> DUMMY"} between the standard semantic domain
(@{type Value}) and the resourced domain (@{type CValue}) and show that the denotation semantics yield
similar results (@{thm denotational_semantics_similar}), which is one step in the adequacy proof.
We formalized this (Sections \ref{sec_ValueSimilarity} and \ref{sec_Denotational-Related}), identifying
and fixing a mistake in the paper (Lemma 2.3(3) does not hold; the problem can be fixed by applying
an extra round of take-induction in the proof of Proposition 9).

Currently, they are working on completing the adequacy proof as outlined by Launchbury, i.e.\ by going
via the alternative natural semantics given in \cite{launchbury}, which differs from the semantics
above in that the application rule works with an indirection on the heap instead of a substitution
and that the variable rule has no blackholing and no update. In \cite{indirections}, they relate
the original semantics with one where indirections have been introduced. The next step, modifying
the variable rule, is under development. Once that is done they can close the loop and have
completed Launchbury's work.

This work proves the adequacy as stated by Launchbury as well, but in contrast to his proof outline no
alternative operational semantics is introduced. The problems of indirection vs. substitution and
of blackholing is solved on the denotational side instead, which turned out to be much easier than
proving the various operational semantics to be equivalent.
 *}

(*<*)

end
(*>*)


(*  Title:       Isabelle Collections Library
    Author:      Peter Lammich <peter dot lammich at uni-muenster.de>
    Maintainer:  Peter Lammich <peter dot lammich at uni-muenster.de>
*)
(*
  Changes since submission on 2009-11-26:

  2009-12-10: OrderedMap, transfer of iterators to OrderedSet

*)
header {* \isaheader{Implementing Sets by Maps} *}
theory SetByMap
imports
  "../spec/SetSpec"
  "../spec/MapSpec"
  "SetGA"
  "MapGA"
begin
text_raw {*\label{thy:SetByMap}*}

text {*
  In this theory, we show how to implement sets
  by maps.
*}

(* TODO: We could also define some more operations directly,
  e.g. union, ball, bex, \<dots> *)

text {* Auxiliary lemma *}
lemma foldli_foldli_map_eq:
  "foldli (foldli l (\<lambda>x. True) (\<lambda>x l. l@[f x]) []) c f' \<sigma>0
    = foldli l c (f' o f) \<sigma>0"
proof -
  show ?thesis
    apply (simp add: map_by_foldl foldli_map foldli_foldl)
    done
qed

locale SetByMapDefs =
  map!: StdBasicMapDefs ops
  for ops :: "('x,unit,'s,'more) map_basic_ops_scheme"
begin
  definition "\<alpha> s \<equiv> dom (map.\<alpha> s)"
  definition "invar s \<equiv> map.invar s"
  definition empty where "empty \<equiv> map.empty"
  definition "memb x s \<equiv> map.lookup x s \<noteq> None"
  definition "ins x s \<equiv> map.update x () s"
  definition "ins_dj x s \<equiv> map.update_dj x () s"
  definition "delete x s \<equiv> map.delete x s"
  definition list_it :: "'s \<Rightarrow> ('x,'x list) set_iterator"
    where "list_it s c f \<sigma>0 \<equiv> it_to_it (map.list_it s) c (f o fst) \<sigma>0"

  local_setup {* Locale_Code.lc_decl_del @{term list_it} *}

  lemma list_it_alt: "list_it s = map_iterator_dom (map.iteratei s)"
  proof -
    have A: "\<And>f. (\<lambda>(x,_). f x) = (\<lambda>x. f (fst x))" by auto
    show ?thesis
      unfolding list_it_def[abs_def] map_iterator_dom_def
        poly_map_iteratei_defs.iteratei_def
        set_iterator_image_def set_iterator_image_filter_def
      by (auto simp: comp_def)
  qed

  lemma list_it_unfold:
    "it_to_it (list_it s) c f \<sigma>0 = map.iteratei s c (f o fst) \<sigma>0"
    unfolding list_it_def[abs_def] it_to_it_def
    unfolding poly_map_iteratei_defs.iteratei_def it_to_it_def
    by (simp add: foldli_foldli_map_eq comp_def)

  definition [icf_rec_def]: "dflt_basic_ops \<equiv> \<lparr>
    bset_op_\<alpha> = \<alpha>,
    bset_op_invar = invar,
    bset_op_empty = empty,
    bset_op_memb = memb,
    bset_op_ins = ins,
    bset_op_ins_dj = ins_dj,
    bset_op_delete = delete,
    bset_op_list_it = list_it
    \<rparr>"
  local_setup {* Locale_Code.lc_decl_del @{term dflt_basic_ops} *}

end

setup {*
  (Record_Intf.add_unf_thms_global @{thms
    SetByMapDefs.list_it_def[abs_def]
  })
*}

(*lemmas [code_unfold] = SetByMapDefs.list_it_def[abs_def]*)

locale SetByMap = SetByMapDefs ops +
  map!: StdBasicMap ops
  for ops :: "('x,unit,'s,'more) map_basic_ops_scheme"
begin
  lemma empty_impl: "set_empty \<alpha> invar empty"
    apply unfold_locales
    unfolding \<alpha>_def invar_def empty_def
    by (auto simp: map.empty_correct)

  lemma memb_impl: "set_memb \<alpha> invar memb"
    apply unfold_locales
    unfolding \<alpha>_def invar_def memb_def
    by (auto simp: map.lookup_correct)

  lemma ins_impl: "set_ins \<alpha> invar ins"
    apply unfold_locales
    unfolding \<alpha>_def invar_def ins_def
    by (auto simp: map.update_correct)

  lemma ins_dj_impl: "set_ins_dj \<alpha> invar ins_dj"
    apply unfold_locales
    unfolding \<alpha>_def invar_def ins_dj_def
    by (auto simp: map.update_dj_correct)

  lemma delete_impl: "set_delete \<alpha> invar delete"
    apply unfold_locales
    unfolding \<alpha>_def invar_def delete_def
    by (auto simp: map.delete_correct)

  lemma list_it_impl: "poly_set_iteratei \<alpha> invar list_it"
  proof
    fix s
    assume I: "invar s"
    hence I': "map.invar s" unfolding invar_def .

    have S: "\<And>f. (\<lambda>(x,_). f x) = (\<lambda>xy. f (fst xy))"
      by auto

    from map_iterator_dom_correct[OF map.iteratei_correct[OF I']]
    show "set_iterator (list_it s) (\<alpha> s)"
      unfolding \<alpha>_def list_it_alt .

    show "finite (\<alpha> s)"
      unfolding \<alpha>_def by (simp add: map.finite[OF I'])
  qed

  lemma dflt_basic_ops_impl: "StdBasicSet dflt_basic_ops"
    apply (rule StdBasicSet.intro)
    apply (simp_all add: icf_rec_unf)
    apply (rule empty_impl memb_impl ins_impl
      ins_dj_impl delete_impl
      list_it_impl[unfolded SetByMapDefs.list_it_def[abs_def]]
    )+
    done
end

locale OSetByOMapDefs = SetByMapDefs ops +
  map!: StdBasicOMapDefs ops
  for ops :: "('x::linorder,unit,'s,'more) omap_basic_ops_scheme"
begin
  definition ordered_list_it :: "'s \<Rightarrow> ('x,'x list) set_iterator"
    where "ordered_list_it s c f \<sigma>0
    \<equiv> it_to_it (map.ordered_list_it s) c (f o fst) \<sigma>0"
    (*where "list_it s c f \<sigma>0 \<equiv> it_to_it (map.list_it s) c (f o fst) \<sigma>0"*)
  local_setup {* Locale_Code.lc_decl_del @{term ordered_list_it} *}

  definition rev_list_it :: "'s \<Rightarrow> ('x,'x list) set_iterator"
    where "rev_list_it s c f \<sigma>0 \<equiv> it_to_it (map.rev_list_it s) c (f o fst) \<sigma>0"
    (*where "rev_list_it s c f \<sigma>0 \<equiv> map.rev_iterateoi s c (f o fst) \<sigma>0"*)
  local_setup {* Locale_Code.lc_decl_del @{term rev_list_it} *}

  definition [icf_rec_def]: "dflt_basic_oops \<equiv>
    set_basic_ops.extend dflt_basic_ops \<lparr>
      bset_op_ordered_list_it = ordered_list_it,
      bset_op_rev_list_it = rev_list_it
      \<rparr>"
  local_setup {* Locale_Code.lc_decl_del @{term dflt_basic_oops} *}

end

setup {*
  (Record_Intf.add_unf_thms_global @{thms
    OSetByOMapDefs.ordered_list_it_def[abs_def]
    OSetByOMapDefs.rev_list_it_def[abs_def]
  })
*}

(*lemmas [code_unfold] = OSetByOMapDefs.ordered_list_it_def[abs_def]
  OSetByOMapDefs.rev_list_it_def[abs_def]*)

locale OSetByOMap = OSetByOMapDefs ops +
  SetByMap ops + map!: StdBasicOMap ops
  for ops :: "('x::linorder,unit,'s,'more) omap_basic_ops_scheme"
begin
  lemma ordered_list_it_impl: "poly_set_iterateoi \<alpha> invar ordered_list_it"
  proof
    fix s
    assume I: "invar s"
    hence I': "map.invar s" unfolding invar_def .

    have S: "\<And>f. (\<lambda>(x,_). f x) = (\<lambda>xy. f (fst xy))"
      by auto

    have A: "\<And>s. ordered_list_it s = map_iterator_dom (map.iterateoi s)"
      unfolding ordered_list_it_def[abs_def]
        map_iterator_dom_def set_iterator_image_alt_def map.iterateoi_def
      by (simp add: S comp_def)

    from map_iterator_linord_dom_correct[OF map.iterateoi_correct[OF I']]
    show "set_iterator_linord (ordered_list_it s) (\<alpha> s)"
      unfolding \<alpha>_def A .

    show "finite (\<alpha> s)"
      unfolding \<alpha>_def by (simp add: map.finite[OF I'])
  qed

  lemma rev_list_it_impl: "poly_set_rev_iterateoi \<alpha> invar rev_list_it"
  proof
    fix s
    assume I: "invar s"
    hence I': "map.invar s" unfolding invar_def .

    have S: "\<And>f. (\<lambda>(x,_). f x) = (\<lambda>xy. f (fst xy))"
      by auto

    have A: "\<And>s. rev_list_it s = map_iterator_dom (map.rev_iterateoi s)"
      unfolding rev_list_it_def[abs_def]
        map_iterator_dom_def set_iterator_image_alt_def map.rev_iterateoi_def
      by (simp add: S comp_def)

    from map_iterator_rev_linord_dom_correct[
      OF map.rev_iterateoi_correct[OF I']]
    show "set_iterator_rev_linord (rev_list_it s) (\<alpha> s)"
      unfolding \<alpha>_def A .

    show "finite (\<alpha> s)"
      unfolding \<alpha>_def by (simp add: map.finite[OF I'])

  qed

  lemma dflt_basic_oops_impl: "StdBasicOSet dflt_basic_oops"
  proof -
    interpret aux!: StdBasicSet dflt_basic_ops by (rule dflt_basic_ops_impl)

    show ?thesis
      apply (rule StdBasicOSet.intro)
      apply (rule StdBasicSet.intro)
      apply icf_locales
      apply (simp_all add: icf_rec_unf)
      apply (rule
        ordered_list_it_impl[unfolded ordered_list_it_def[abs_def]]
        rev_list_it_impl[unfolded rev_list_it_def[abs_def]]
      )+
      done
  qed
end

sublocale SetByMap < basic: StdBasicSet "dflt_basic_ops"
  by (rule dflt_basic_ops_impl)

sublocale OSetByOMap < obasic: StdBasicOSet "dflt_basic_oops"
  by (rule dflt_basic_oops_impl)

lemma proper_it'_map2set: "proper_it' it it'
  \<Longrightarrow> proper_it' (\<lambda>s c f. it s c (f o fst)) (\<lambda>s c f. it' s c (f o fst))"
  unfolding proper_it'_def
  apply clarsimp
  apply (drule_tac x=s in spec)
  apply (erule proper_itE)
  apply (rule proper_itI)
  apply (auto simp add: foldli_map[symmetric] intro!: ext)
  done

end


(*  Title:      HOL/Auth/n_deadlock_lemma_inv__2_on_rules.thy
    Author:     Yongjian Li and Kaiqiang Duan, State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
    Copyright    2016 State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
*)

(*header{*The n_deadlock Protocol Case Study*}*)

theory n_deadlock_lemma_inv__2_on_rules imports n_deadlock_lemma_on_inv__2
begin
section{*All lemmas on causal relation between inv__2*}
lemma lemma_inv__2_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__2  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  proof -
  have c1: "(\<exists> i. i\<le>N\<and>r=n_Try  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_Crit  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_Exit  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_Idle  i)"
  apply (cut_tac b1, auto) done
    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_Try  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_TryVsinv__2) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_Crit  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_CritVsinv__2) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_Exit  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_ExitVsinv__2) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_Idle  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_IdleVsinv__2) done
    }

  ultimately show "invHoldForRule s f r (invariants N)"
  by satx
qed

end


theory flash5Bra  imports flash5Rev

  begin
lemma onInv5:

   assumes  a1:"iInv1 \<le> N" and  a2:"iInv2 \<le> N" and  a3:"iInv1~=iInv2  " and

     b1:"r \<in> rules N" and b2:"invf=inv5  iInv1  iInv2 "
   shows  "invHoldForRule' s invf r (invariants   N)"
   proof -
have c1:"ex1P N (% iRule1 .  r=NI_Local_GetX_PutX1 N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_GetX  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Replace  iRule1 )\<or>ex0P N (  r=NI_ShWb N )\<or>ex0P N (  r=PI_Local_GetX_GetX2 )\<or>ex0P N (  r=NI_Local_PutXAcksDone )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX7 N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Nak2  iRule1 )\<or>ex0P N (  r=NI_ReplaceHomeShrVld )\<or>ex1P N (% iRule1 .  r=NI_Remote_Put  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX5 N  iRule1 )\<or>ex0P N (  r=NI_Wb )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Get  iRule1 )\<or>ex0P N (  r=PI_Local_Replace )\<or>ex1P N (% iRule1 .  r=NI_ReplaceShrVld  iRule1 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Local_GetX_PutX8 N  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=NI_InvAck_2 N  iRule1 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Remote_Get_Nak2  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=PI_Remote_Replace  iRule1 )\<or>ex0P N (  r=NI_Nak_Home )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Put2  iRule1 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_InvAck_1  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX11 N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX6 N  iRule1 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Remote_Get_Put2  iRule1  iRule2 )\<or>ex0P N (  r=PI_Local_Get_Put )\<or>ex0P N (  r=PI_Local_GetX_PutX1 N )\<or>ex1P N (% iRule1 .  r=NI_InvAck_1_Home  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Remote_Get_Nak1  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Nak1  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_Nak2  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX10_home N  iRule1 )\<or>ex1P N (% iRule1 .  r=PI_Remote_Get  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_Nak3  iRule1 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Local_GetX_PutX10 N  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX2 N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Remote_Get_Put1  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Remote_PutX  iRule1 )\<or>ex1P N (% iRule1 .  r=Store  iRule1 )\<or>ex0P N (  r=NI_FAck )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX3 N  iRule1 )\<or>ex0P N (  r=PI_Local_GetX_PutX3 )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Remote_GetX_PutX  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX8_home N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Put1 N  iRule1 )\<or>ex0P N (  r=PI_Local_GetX_GetX1 )\<or>ex0P N (  r=StoreHome )\<or>ex2P N (% iRule1  iRule2 .  r=NI_Remote_GetX_Nak  iRule1  iRule2 )\<or>ex1P N (% iRule1 .  r=NI_Inv  iRule1 )\<or>ex1P N (% iRule1 .  r=PI_Remote_PutX  iRule1 )\<or>ex0P N (  r=PI_Local_GetX_PutX4 )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX4 N  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Nak  iRule1 )\<or>ex0P N (  r=PI_Local_GetX_PutX2 N )\<or>ex0P N (  r=NI_Local_Put )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_Nak1  iRule1 )\<or>ex0P N (  r=NI_Nak_Clear )\<or>ex0P N (  r=PI_Local_PutX )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Nak3  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Remote_GetX_Nak_Home  iRule1 )\<or>ex0P N (  r=PI_Local_Get_Get )\<or>ex1P N (% iRule1 .  r=NI_Local_GetX_PutX9 N  iRule1 )\<or>ex1P N (% iRule1 .  r=PI_Remote_GetX  iRule1 )\<or>ex0P N (  r=NI_ReplaceHome )\<or>ex1P N (% iRule1 .  r=NI_Remote_GetX_PutX_Home  iRule1 )\<or>ex1P N (% iRule1 .  r=NI_Local_Get_Put3  iRule1 )"

        apply(cut_tac  b1)
        apply auto
        done      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX1 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX1 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Local_GetX_PutX1 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX1VsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_GetX  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_GetX  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Local_GetX_GetX  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_GetXVsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Replace  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Replace  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Replace  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_ReplaceVsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_ShWb N )
"

         from c1 have c2:" r= NI_ShWb N "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_ShWb N ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_ShWbVsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_GetX2 )
"

         from c1 have c2:" r= PI_Local_GetX_GetX2 "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (PI_Local_GetX_GetX2 ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_GetX_GetX2VsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= NI_Local_PutXAcksDone )
"

         from c1 have c2:" r= NI_Local_PutXAcksDone "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Local_PutXAcksDone ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_Local_PutXAcksDoneVsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX7 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX7 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Local_GetX_PutX7 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX7VsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Nak2  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Nak2  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Local_Get_Nak2  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_Get_Nak2VsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_ReplaceHomeShrVld )
"

         from c1 have c2:" r= NI_ReplaceHomeShrVld "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_ReplaceHomeShrVld ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_ReplaceHomeShrVldVsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_Put  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_Put  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Remote_Put  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_PutVsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX5 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX5 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Local_GetX_PutX5 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX5VsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_Wb )
"

         from c1 have c2:" r= NI_Wb "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Wb ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_WbVsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Get  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Get  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Local_Get_Get  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_Get_GetVsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_Replace )
"

         from c1 have c2:" r= PI_Local_Replace "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (PI_Local_Replace ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_ReplaceVsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_ReplaceShrVld  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_ReplaceShrVld  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_ReplaceShrVld  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_ReplaceShrVldVsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Local_GetX_PutX8 N  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Local_GetX_PutX8 N  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Local_GetX_PutX8 N  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX8VsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_InvAck_2 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_InvAck_2 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_InvAck_2 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_InvAck_2VsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Remote_Get_Nak2  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Remote_Get_Nak2  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Remote_Get_Nak2  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_Get_Nak2VsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= PI_Remote_Replace  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= PI_Remote_Replace  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (PI_Remote_Replace  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis PI_Remote_ReplaceVsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_Nak_Home )
"

         from c1 have c2:" r= NI_Nak_Home "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Nak_Home ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_Nak_HomeVsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Put2  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Put2  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Local_Get_Put2  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_Get_Put2VsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_InvAck_1  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_InvAck_1  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_InvAck_1  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_InvAck_1VsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX11 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX11 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Local_GetX_PutX11 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX11VsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX6 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX6 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Local_GetX_PutX6 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX6VsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Remote_Get_Put2  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Remote_Get_Put2  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Remote_Get_Put2  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_Get_Put2VsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_Get_Put )
"

         from c1 have c2:" r= PI_Local_Get_Put "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (PI_Local_Get_Put ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_Get_PutVsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_PutX1 N )
"

         from c1 have c2:" r= PI_Local_GetX_PutX1 N "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (PI_Local_GetX_PutX1 N ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_GetX_PutX1VsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_InvAck_1_Home  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_InvAck_1_Home  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_InvAck_1_Home  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_InvAck_1_HomeVsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_Get_Nak1  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_Get_Nak1  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Remote_Get_Nak1  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_Get_Nak1VsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Nak1  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Nak1  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Local_Get_Nak1  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_Get_Nak1VsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_Nak2  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_Nak2  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Local_GetX_Nak2  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_Nak2VsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX10_home N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX10_home N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Local_GetX_PutX10_home N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX10_homeVsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= PI_Remote_Get  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= PI_Remote_Get  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (PI_Remote_Get  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis PI_Remote_GetVsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_Nak3  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_Nak3  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Local_GetX_Nak3  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_Nak3VsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Local_GetX_PutX10 N  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Local_GetX_PutX10 N  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Local_GetX_PutX10 N  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX10VsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX2 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX2 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Local_GetX_PutX2 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX2VsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_Get_Put1  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_Get_Put1  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Remote_Get_Put1  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_Get_Put1VsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_PutX  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_PutX  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Remote_PutX  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_PutXVsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= Store  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= Store  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (Store  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis StoreVsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_FAck )
"

         from c1 have c2:" r= NI_FAck "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_FAck ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_FAckVsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX3 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX3 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Local_GetX_PutX3 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX3VsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_PutX3 )
"

         from c1 have c2:" r= PI_Local_GetX_PutX3 "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (PI_Local_GetX_PutX3 ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_GetX_PutX3VsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Remote_GetX_PutX  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Remote_GetX_PutX  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Remote_GetX_PutX  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_GetX_PutXVsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX8_home N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX8_home N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Local_GetX_PutX8_home N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX8_homeVsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Put1 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Put1 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Local_Get_Put1 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_Get_Put1VsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_GetX1 )
"

         from c1 have c2:" r= PI_Local_GetX_GetX1 "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (PI_Local_GetX_GetX1 ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_GetX_GetX1VsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= StoreHome )
"

         from c1 have c2:" r= StoreHome "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (StoreHome ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis StoreHomeVsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex2P N (% iRule1  iRule2 .  r= NI_Remote_GetX_Nak  iRule1  iRule2 )
"

         from c1 obtain  iRule1  iRule2  where c2:"  iRule1~=iRule2    \<and>   iRule1 \<le> N \<and>   iRule2 \<le> N \<and>  r= NI_Remote_GetX_Nak  iRule1  iRule2 "
         by (auto simp add: ex2P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Remote_GetX_Nak  iRule1  iRule2 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_GetX_NakVsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Inv  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Inv  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Inv  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_InvVsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= PI_Remote_PutX  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= PI_Remote_PutX  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (PI_Remote_PutX  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis PI_Remote_PutXVsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_PutX4 )
"

         from c1 have c2:" r= PI_Local_GetX_PutX4 "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (PI_Local_GetX_PutX4 ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_GetX_PutX4VsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX4 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX4 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Local_GetX_PutX4 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX4VsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Nak  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Nak  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Nak  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_NakVsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_GetX_PutX2 N )
"

         from c1 have c2:" r= PI_Local_GetX_PutX2 N "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (PI_Local_GetX_PutX2 N ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_GetX_PutX2VsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= NI_Local_Put )
"

         from c1 have c2:" r= NI_Local_Put "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Local_Put ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_Local_PutVsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_Nak1  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_Nak1  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Local_GetX_Nak1  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_Nak1VsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_Nak_Clear )
"

         from c1 have c2:" r= NI_Nak_Clear "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Nak_Clear ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_Nak_ClearVsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex0P N (  r= PI_Local_PutX )
"

         from c1 have c2:" r= PI_Local_PutX "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (PI_Local_PutX ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_PutXVsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Nak3  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Nak3  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Local_Get_Nak3  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_Get_Nak3VsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_GetX_Nak_Home  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_GetX_Nak_Home  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Remote_GetX_Nak_Home  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_GetX_Nak_HomeVsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= PI_Local_Get_Get )
"

         from c1 have c2:" r= PI_Local_Get_Get "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (PI_Local_Get_Get ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis PI_Local_Get_GetVsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_GetX_PutX9 N  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_GetX_PutX9 N  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Local_GetX_PutX9 N  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_GetX_PutX9VsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= PI_Remote_GetX  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= PI_Remote_GetX  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (PI_Remote_GetX  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis PI_Remote_GetXVsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex0P N (  r= NI_ReplaceHome )
"

         from c1 have c2:" r= NI_ReplaceHome "
         by (auto simp add: ex0P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_ReplaceHome ) (invariants N) "
            apply(cut_tac   a1  a2  a3   b2 c2 )
            by (metis NI_ReplaceHomeVsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
	}      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Remote_GetX_PutX_Home  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Remote_GetX_PutX_Home  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Remote_GetX_PutX_Home  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Remote_GetX_PutX_HomeVsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }      moreover
        {assume c1: "ex1P N (% iRule1 .  r= NI_Local_Get_Put3  iRule1 )
"

         from c1 obtain  iRule1  where c2:"  iRule1 \<le> N \<and>  r= NI_Local_Get_Put3  iRule1 "
         by (auto simp add: ex1P_def)

         have "invHoldForRule' s (inv5  iInv1  iInv2 ) (NI_Local_Get_Put3  iRule1 ) (invariants N) "
            apply(cut_tac  c2   a1  a2  a3 )
            by (metis NI_Local_Get_Put3VsInv5 )
          then have "invHoldForRule' s invf r (invariants N) "
            by(cut_tac c2 b2, metis)
        }ultimately show "invHoldForRule' s invf r (invariants N) "
          by blast
     qed
end


(*  Title:      HOL/Auth/n_deadlock_lemma_inv__4_on_rules.thy
    Author:     Yongjian Li and Kaiqiang Duan, State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
    Copyright    2016 State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
*)

(*header{*The n_deadlock Protocol Case Study*}*)

theory n_deadlock_lemma_inv__4_on_rules imports n_deadlock_lemma_on_inv__4
begin
section{*All lemmas on causal relation between inv__4*}
lemma lemma_inv__4_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__4  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  proof -
  have c1: "(\<exists> i. i\<le>N\<and>r=n_Try  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_Crit  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_Exit  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_Idle  i)"
  apply (cut_tac b1, auto) done
    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_Try  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_TryVsinv__4) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_Crit  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_CritVsinv__4) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_Exit  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_ExitVsinv__4) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_Idle  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_IdleVsinv__4) done
    }

  ultimately show "invHoldForRule s f r (invariants N)"
  by satx
qed

end


theory SINVAR_TaintingTrusted_impl
imports SINVAR_TaintingTrusted "../TopoS_Interface_impl"
begin

subsubsection {* SecurityInvariant Tainting with Trust List Implementation *}

code_identifier code_module SINVAR_Tainting_impl => (Scala) SINVAR_Tainting

(*could we use those to make code more efficient?*)
lemma "A - B \<subseteq> C \<longleftrightarrow> (\<forall>a\<in>A. a \<in> C \<or> a \<in> B)" by blast
lemma "\<not>(A - B \<subseteq> C) \<longleftrightarrow> (\<exists>a \<in> A. a \<notin> C \<and> a \<notin> B)" by blast

fun sinvar :: "'v list_graph \<Rightarrow> ('v \<Rightarrow> SINVAR_TaintingTrusted.taints) \<Rightarrow> bool" where
  "sinvar G nP = (\<forall> (v1,v2) \<in> set (edgesL G). taints (nP v1) - untaints (nP v1) \<subseteq> taints (nP v2))"

(*Test that we have executable code, despite the abstractions*)
export_code sinvar in SML
value[code] "sinvar \<lparr> nodesL = [], edgesL =[] \<rparr> (\<lambda>_. SINVAR_TaintingTrusted.default_node_properties)"
lemma "sinvar \<lparr> nodesL = [], edgesL =[] \<rparr> (\<lambda>_. SINVAR_TaintingTrusted.default_node_properties)" by eval

definition TaintingTrusted_offending_list
  :: "'v list_graph \<Rightarrow> ('v \<Rightarrow> SINVAR_TaintingTrusted.taints) \<Rightarrow> ('v \<times> 'v) list list" where
  "TaintingTrusted_offending_list G nP = (if sinvar G nP then
    []
   else
    [ [e \<leftarrow> edgesL G. case e of (v1,v2) \<Rightarrow> \<not>(taints (nP v1) - untaints (nP v1) \<subseteq> taints (nP v2))] ])"

(*TODO: is this code somewhat efficient?*)
export_code TaintingTrusted_offending_list in SML

definition "NetModel_node_props P =
  (\<lambda> i. (case (node_properties P) i of
                  Some property \<Rightarrow> property
                | None \<Rightarrow> SINVAR_TaintingTrusted.default_node_properties))"

definition "TaintingTrusted_eval G P = (wf_list_graph G \<and>
  sinvar G (SecurityInvariant.node_props SINVAR_TaintingTrusted.default_node_properties P))"

interpretation TaintingTrusted_impl:TopoS_List_Impl
  where default_node_properties=SINVAR_TaintingTrusted.default_node_properties
  and sinvar_spec=SINVAR_TaintingTrusted.sinvar
  and sinvar_impl=sinvar
  and receiver_violation=SINVAR_TaintingTrusted.receiver_violation
  and offending_flows_impl=TaintingTrusted_offending_list
  and node_props_impl=NetModel_node_props
  and eval_impl=TaintingTrusted_eval
  apply(unfold TopoS_List_Impl_def)
  apply(rule conjI)
   apply(simp add: TopoS_TaintingTrusted)
   apply(simp add: list_graph_to_graph_def SINVAR_TaintingTrusted.sinvar_def; fail)
  apply(rule conjI)
   apply(simp add: list_graph_to_graph_def)
   apply(simp add: list_graph_to_graph_def SINVAR_TaintingTrusted.sinvar_def Taints_offending_set
                    SINVAR_TaintingTrusted.Taints_offending_set_def TaintingTrusted_offending_list_def; fail)
  apply(rule conjI)
   apply(simp only: NetModel_node_props_def)
   (*interpretation is in local context*)
   apply (metis SecurityInvariant.node_props.simps SecurityInvariant.node_props_eq_node_props_formaldef TopoS_TaintingTrusted)
  apply(simp only: TaintingTrusted_eval_def)
  apply(simp add: TopoS_eval_impl_proofrule[OF TopoS_TaintingTrusted])
  apply(simp add: list_graph_to_graph_def SINVAR_TaintingTrusted.sinvar_def; fail)
 done

subsubsection {* TaintingTrusted packing *}
  definition SINVAR_LIB_TaintingTrusted :: "('v::vertex, SINVAR_TaintingTrusted.taints) TopoS_packed" where
    "SINVAR_LIB_TaintingTrusted \<equiv>
    \<lparr> nm_name = ''TaintingTrusted'',
      nm_receiver_violation = SINVAR_TaintingTrusted.receiver_violation,
      nm_default = SINVAR_TaintingTrusted.default_node_properties,
      nm_sinvar = sinvar,
      nm_offending_flows = TaintingTrusted_offending_list,
      nm_node_props = NetModel_node_props,
      nm_eval = TaintingTrusted_eval
      \<rparr>"
  interpretation SINVAR_LIB_BLPbasic_interpretation: TopoS_modelLibrary SINVAR_LIB_TaintingTrusted
      SINVAR_TaintingTrusted.sinvar
    apply(unfold TopoS_modelLibrary_def SINVAR_LIB_TaintingTrusted_def)
    apply(rule conjI)
     apply(simp)
    apply(simp)
    by(unfold_locales)

subsubsection{* Example *}
context
begin
  private definition tainting_example :: "string list_graph" where
  "tainting_example \<equiv> \<lparr> nodesL = [''produce 1'',
                                  ''produce 2'',
                                  ''produce 3'',
                                  ''read 1 2'',
                                  ''read 3'',
                                  ''consume 1 2 3'',
                                  ''consume 3''],
              edgesL =[(''produce 1'', ''read 1 2''),
                       (''produce 2'', ''read 1 2''),
                       (''produce 3'', ''read 3''),
                       (''read 3'', ''read 1 2''),
                       (''read 1 2'', ''consume 1 2 3''),
                       (''read 3'', ''consume 3'')] \<rparr>"
  lemma "wf_list_graph tainting_example" by eval

  private definition tainting_example_props :: "string \<Rightarrow> SINVAR_TaintingTrusted.taints" where
    "tainting_example_props \<equiv> (\<lambda> n. SINVAR_TaintingTrusted.default_node_properties)
                          (''produce 1'' := TaintsUntaints {''1''} {},
                           ''produce 2'' := TaintsUntaints {''2''} {},
                           ''produce 3'' := TaintsUntaints {''3''} {},
                           ''read 1 2'' := TaintsUntaints {''3'',''foo''} {''1'',''2''},
                           ''read 3'' := TaintsUntaints {''3''} {},
                           ''consume 1 2 3'' := TaintsUntaints {''foo'',''3''} {},
                           ''consume 3'' := TaintsUntaints {''3''} {})"

  value "tainting_example_props (''consume 1 2 3'')"
  value[code] "TaintingTrusted_offending_list tainting_example tainting_example_props"
  private lemma "sinvar tainting_example tainting_example_props" by eval
end

(*TODO: fails. why?*)
export_code SINVAR_LIB_TaintingTrusted in Scala
export_code SINVAR_LIB_TaintingTrusted in SML

hide_const (open) NetModel_node_props TaintingTrusted_offending_list TaintingTrusted_eval

hide_const (open) sinvar

end


theory CoCallImplTTree
imports TTreeAnalysisSig "Env-Set-Cpo" CoCallAritySig "CoCallGraph-TTree"
begin

context CoCallArity
begin
  definition Texp :: "exp \<Rightarrow> Arity \<rightarrow> var ttree"
    where "Texp e = (\<Lambda> a. ccTTree (edom (Aexp e \<cdot>a)) (ccExp e\<cdot>a))"

  lemma Texp_simp: "Texp e\<cdot>a = ccTTree (edom (Aexp e \<cdot>a)) (ccExp e\<cdot>a)"
    unfolding Texp_def
    by simp

  sublocale TTreeAnalysis Texp.
end

end


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

theory WP
imports
  "~~/src/HOL/Main"
  "~~/src/HOL/Eisbach/Eisbach_Tools"
  "../../Apply_Debug"
begin

definition
  triple_judgement :: "('a \<Rightarrow> bool) \<Rightarrow> 'b \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> bool"
where
 "triple_judgement pre body property = (\<forall>s. pre s \<longrightarrow> property s body)"

definition
  postcondition :: "('r \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> ('r \<times> 's) set)
            \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> bool"
where
 "postcondition P f = (\<lambda>a b. \<forall>(rv, s) \<in> f a b. P rv s)"

definition
  postconditions :: "('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b \<Rightarrow> bool)"
where
 "postconditions P Q = (\<lambda>a b. P a b \<and> Q a b)"

lemma conj_TrueI: "P \<Longrightarrow> True \<and> P" by simp
lemma conj_TrueI2: "P \<Longrightarrow> P \<and> True" by simp

ML_file "WP-method.ML"

declare [[wp_warn_unused = false]]

setup WeakestPre.setup

method_setup wp = {* WeakestPre.apply_rules_args false *}
  "applies weakest precondition rules"

method_setup wp_once = {* WeakestPre.apply_once_args false *}
  "applies one weakest precondition rule"

method_setup wp_trace = {* WeakestPre.apply_rules_args true *}
  "applies weakest precondition rules with tracing"

method_setup wp_once_trace = {* WeakestPre.apply_once_args true *}
  "applies one weakest precondition rule with tracing"

end


theory CRA_Obs
imports Par_Obs Conj_Obs Seq_Obs
begin

locale seq_par = seq: test_seq + par: par_elem +
  constrains seq :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" and par :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" and to_env :: "'a \<Rightarrow> 'a"

locale seq_par_elem = seq_par + exchange_semigroup_ordered seq par  +
 constrains bot :: "'a :: preorder_bot"
 assumes nil_par_nil_weak: "\<And>x. test x \<parallel> test x \<ge> test x" and
          skip_ref_nil: "\<And>x. to_env (first x) \<ge> first x" and
         seq_subunits: "\<And>a b. (to_env a ; to_env b) \<le> to_env (a ; b) "

context seq_par_elem begin

lemma exchange_test': "\<And>t . test t ; (a \<parallel> b) \<le> (test t ; a) \<parallel> (test t ; b)"
  apply (rule order_trans[rotated], rule exchange)
  by (rule seq.mono_f, rule nil_par_nil_weak, clarsimp)

lemma nil_le_skip: "seq.dnil \<le> par.dunit"
  apply (clarsimp simp: less_eq_downset_def seq.dnil_def sup_downset_def)
  apply (transfer; clarsimp, intro conjI; clarsimp simp: down_image_iff)
   apply (rule_tac x = "last y" in exI)
   apply (erule order_trans)
  using skip_ref_nil
   apply (metis image_iff rangeI seq.first_last)
  using skip_ref_nil
  using dual_order.trans by blast

sublocale exchange_semigroup_ordered seq par ..

lemma le_bot_le_any[elim!]: "x \<le> \<bottom> \<Longrightarrow> x \<le> (y :: 'a :: preorder_bot)"
  by (meson dual_order.trans preorder_bot_class.bot_least)

lemma test_to_env: "test x \<le> to_env (test x)"
  by (metis seq.test_is_first skip_ref_nil)

lemma bot_test[simp]:"\<bottom> \<parallel> test x \<le> \<bottom>"
  using test_to_env
  by (meson dual_order.trans par.down_unit par.mono_f preorder_bot_class.bot_least)

lemma test_bot[simp]: "test x \<parallel> \<bottom>  \<le> \<bottom>"
  by (simp add: par.commute)

sublocale seq_par: sequential_parallel seq.convolute seq.dnil par.convolute par.dunit
  apply (standard; clarsimp?)
     apply (clarsimp simp: less_eq_downset_def seq.nil_dnil[symmetric]
                           sup_downset_def seq.conv_test_pre.nil_def, transfer)

     apply (clarsimp simp: less_eq_downset_def seq.dnil_def sup_downset_def, transfer)
  apply (intro conjI; clarsimp)
      apply (clarsimp simp: down_sup_distrib down_union_distrib in_down_iff down_image_iff Bex_def)
     apply (meson dual_order.refl nil_par_nil_weak order_trans)
    apply (clarsimp simp: less_eq_downset_def seq.nil_dnil[symmetric] sup_downset_def
                          seq.conv_test_pre.nil_def, transfer, clarsimp, intro conjI)
     apply (clarsimp simp: down_image_iff)
  apply (meson dual_order.trans test_to_env)
    apply (clarsimp simp: downset_set_def in_down_iff)

   apply (clarsimp simp: less_eq_downset_def seq.nil_dnil[symmetric] sup_downset_def
           seq.conv_test_pre.nil_def, transfer, clarsimp simp: down_sup_distrib downset_set_def' )
  apply (meson order_trans in_down_iff seq.mono_f seq_subunits)

  by (rule exchange_convolute.exchange)

lemma le_test_par: "x \<le> test xa \<parallel> test xb \<Longrightarrow> \<not> x \<le> \<bottom> \<Longrightarrow>  x \<ge> test xa"
  by (meson dual_order.refl dual_order.trans par.down_unit par.mono_f seq.test_atom test_to_env)

lemma le_bot_par: "x \<le> \<bottom> \<parallel> y \<Longrightarrow> x \<le> y"
  by (metis (no_types, opaque_lifting) dual_order.refl dual_order.trans par.commute
              par.down_unit par.mono_f preorder_bot_class.bot_least)

(* lemma le_first_test: "x \<le> (test t ; a) \<parallel> (test t' ; b) \<Longrightarrow> first x \<le> test t \<or> first x \<le> test t'"
  oops
  by (meson first_par order.trans seq.first_le seq.first_test_seq) *)

lemma in_Down_iff: "a \<in> \<Down> S \<longleftrightarrow> (\<exists>x\<in>S. a \<le> x)"
  by (clarsimp simp: downset_set_def)

lemma mono_on_helper: "(mono_on UNIV f) \<Longrightarrow>  (\<Union>a\<in>\<Down> S. f a) = (\<Union>a\<in>S. f a) "
  apply (safe)
   apply (clarsimp simp: in_Down_iff)
   apply (meson in_mono monotoneD)
  using in_Down_iff by auto

lemma rewrite_sup_helper': "mono_on UNIV f  \<Longrightarrow> (\<Union>a\<in>\<Down> S. \<Union>b\<in>S'. \<Union>c\<in>S''. \<down> (f a b c)) = (\<Union>a\<in>S. \<Union>b\<in>S'. \<Union>c\<in>S'' . \<down> (f a b c))"
  apply (intro set_eqI iffI; clarsimp simp: in_down_iff)
   apply (smt (verit) downset_set_def le_fun_def mem_Collect_eq monotoneD order_trans)
  using downset_set_def by blast

lemma rewrite_sup_helper'': "mono_on UNIV f  \<Longrightarrow> (\<Union>a\<in>\<down> a. \<Union>b\<in>S'. \<Union>c\<in>S''. \<down> (f a b c)) = (\<Union>b\<in>S'. \<Union>c\<in>S'' . \<down> (f a b c))"
  apply (intro set_eqI iffI; clarsimp simp: in_down_iff)
   apply (smt (verit) downset_set_def le_fun_def mem_Collect_eq monotoneD order_trans)
  using in_down_iff by auto

lemma rewrite_sup_helper'''': "mono_on UNIV f \<Longrightarrow> (\<Union>a\<in>\<Down> S. \<down> (f a)) = (\<Union>a\<in> S. \<down> (f a))  "
apply (intro set_eqI iffI; clarsimp simp: in_down_iff)
   apply (smt (verit) downset_set_def le_fun_def mem_Collect_eq monotoneD order_trans)
  using in_Down_iff by auto

lemma rewrite_sup_helper''': "mono_on UNIV f  \<Longrightarrow> (\<Union>a\<in>\<down> a. \<Union>b\<in>S'. \<down> (f a b)) = (\<Union>b\<in>S'.  \<down> (f a b ))"
  apply (intro set_eqI iffI; clarsimp simp: in_down_iff)
   apply (smt (verit) downset_set_def le_fun_def mem_Collect_eq monotoneD order_trans)
  using in_down_iff by auto

lemma not_bot_testable: "\<not> x \<le> \<bottom> \<Longrightarrow> \<exists>t. first x \<le> test t"
  apply (erule contrapos_np, clarsimp)
  by (metis Diff_iff image_iff le_bot_le_any order_refl rangeI in_down_iff seq.test_nil)

lemma test_seq_eq: "\<not>(test t ; (test xa) \<le> \<bottom>) \<Longrightarrow> t = xa"
  by (meson dual_order.trans seq.le_test seq.test_atom seq.test_le seq.test_le')

lemma par_conv_test_inf: "par.convolute (seq.dtest p) (seq.dtest q) = (seq.dtest p \<sqinter> seq.dtest q) "
  apply (clarsimp simp: inf_downset_def, transfer)
     apply (case_tac "p = {}", clarsimp)
   apply (simp add: rewrite_sup'  monotoneI seq.flip.mono_f par.mono_f le_funI
                                        seq.rewrite_sup_helper rewrite_sup_helper' mono_on_helper
                                                       rewrite_sup_helper'' rewrite_sup_helper''')
  apply (safe; clarsimp simp: in_Down_iff in_down_iff)
        apply (meson bot_test dual_order.trans le_bot_le_any par.mono_f)
       apply (metis dual_order.trans le_bot_par par.commute)
  using le_bot_le_any in_down_iff apply blast
     apply (subst seq.nonempty_bot_union, fastforce)+
     apply (case_tac "q = {}", clarsimp)
  apply (safe; clarsimp simp: in_Down_iff in_down_iff)
        apply (meson le_bot_le_any ordered_semigroup.mono_f par.down_unit par.ordered_semigroup_axioms refine_trans)
       apply (meson par.mono_f refine_trans test_bot)
      apply (metis le_bot_le_any down_image_iff in_down_iff)
     apply (subst seq.nonempty_bot_union, fastforce)+
  apply (simp add: rewrite_sup' rewrite_sup monotoneI seq.flip.mono_f par.mono_f
      le_funI seq.rewrite_sup_helper rewrite_sup_helper' mono_on_helper
      rewrite_sup_helper'' rewrite_sup_helper''' rewrite_sup_helper'''')
     apply (safe; clarsimp simp: in_down_iff in_Down_iff)
    apply (smt (verit) bot_test le_bot_le_any le_test_par order_trans
                       par.commute par.down_unit par.mono_f test_to_env)

  apply (smt (verit, del_insts) order_eq_refl par.commute par.down_unit
                                 par.mono_f refine_trans test_to_env)

  by (metis (no_types, opaque_lifting) dual_order.trans nil_par_nil_weak
            preorder_bot_class.bot_least seq.test_atom seq.test_le)

lemma "\<exists>t. first c \<le> test t"
  using le_bot_le_any not_bot_testable seq.first_test by blast

lemma firstE: "(\<And>t. first c \<le> test t \<Longrightarrow> P (first c)) \<Longrightarrow> P (first c)"
  using le_bot_le_any not_bot_testable seq.first_test by blast

lemma first_le_first_iff: "first x \<le> first (c) \<longleftrightarrow> x \<le> first c ; x "
  apply (rule firstE)
  apply (subst seq.flip.unit_of_unit, assumption)
  apply (clarsimp)
  done

sublocale seq_par_test:
    sync_command_with_tests_aborting seq.convolute seq.dtest par.convolute par.dunit

  apply (standard; (clarsimp simp: par_conv_test_inf)?)
      apply (rule antisym)
  apply (rule order_trans[rotated], rule exchange_convolute.exchange, clarsimp simp: par_conv_test_inf )
  apply ( clarsimp simp: less_eq_downset_def)
      apply (transfer)
      apply (case_tac "p = {}", clarsimp simp: in_down_iff)
       apply (rule_tac x="\<bottom>" in bexI; clarsimp?)
  defer
      apply (subst seq.nonempty_bot_union, clarsimp)
       apply (subst seq.nonempty_bot_union, clarsimp)
       apply (subst seq.nonempty_bot_union, clarsimp)

      apply (simp add:rewrite_sup' rewrite_sup monotoneI
                       seq.flip.mono_f par.mono_f le_funI seq.rewrite_sup_helper
                       rewrite_sup_helper' mono_on_helper rewrite_sup_helper'' rewrite_sup_helper''')
       apply (clarsimp simp: in_down_iff)

       apply (frule seq.first_le)
      apply (subst (asm) first_le_first_iff)

       apply (drule order_trans) back
        apply (rule seq.mono_f, rule order_refl, assumption)
       apply (case_tac "test xa ; xb \<parallel> test xc ; xd \<le> \<bottom>")
        apply (meson dual_order.trans le_bot_le_any)
       apply (frule not_bot_testable, clarsimp)
       apply (frule order_trans) back
        apply (rule seq.mono_f, assumption, rule order_refl)
  apply (frule order_trans) back back back
        apply (rule exchange_test')
       apply (case_tac " test t ; (test xa) \<le> \<bottom>")
        apply (case_tac " test t ; (test xc) \<le> \<bottom>")
  thm seq.assoc
         apply (clarsimp simp: seq.assoc[symmetric])
  apply (subgoal_tac "x \<le> \<bottom>")
  using le_bot_le_any apply blast
         apply (erule order_trans) back back back
  apply (rule order_trans[OF par.mono_f], rule seq.mono_f, assumption, rule order_refl, rule seq.mono_f, assumption, rule order_refl)
         apply (metis le_bot_par par.mono_f seq.bot_annihilate_seq)
        apply (frule test_seq_eq, clarsimp)

        apply (meson in_downsetI seq.test_le')
        apply (frule test_seq_eq, clarsimp)
  apply (meson in_downsetI seq.test_le')
    apply (clarsimp simp: local.seq_par.skip_ref_nil seq.nil_dnil)
  using exchange_convolute.exchange apply force
  apply (transfer)
  apply (clarsimp)
  apply (safe; clarsimp simp: in_down_iff)
   apply (metis par.aborting par.commute)
  apply (rule_tac x="\<bottom>" in bexI; clarsimp?)
   apply (rule_tac x="\<bottom>" in bexI; clarsimp?)
  apply (rule_tac x="\<bottom>" in bexI; clarsimp?)
  by (metis dual_order.trans le_bot_le_any le_bot_par par.aborting par.mono_f seq.bot_annihilate_seq seq.mono_f)

end

lemma rewrite_sup_helper': "mono_on UNIV f  \<Longrightarrow> (\<Union>a\<in>\<Down> S. \<Union>b\<in>S'. \<Union>c\<in>S''. \<down> (f a b c)) = (\<Union>a\<in>S. \<Union>b\<in>S'. \<Union>c\<in>S'' . \<down> (f a b c))"
  apply (intro set_eqI iffI; clarsimp simp: in_down_iff)
   apply (smt (verit) downset_set_def le_fun_def mem_Collect_eq monotoneD order_trans)
  using downset_set_def by blast

lemma rewrite_sup_helper'': "mono_on UNIV f  \<Longrightarrow> (\<Union>a\<in>\<down> a. \<Union>b\<in>S'. \<Union>c\<in>S''. \<down> (f a b c)) = (\<Union>b\<in>S'. \<Union>c\<in>S'' . \<down> (f a b c))"
  apply (intro set_eqI iffI; clarsimp simp: in_down_iff)
   apply (smt (verit) downset_set_def le_fun_def mem_Collect_eq monotoneD order_trans)
  using in_down_iff by auto

lemma rewrite_sup_helper'''': "mono_on UNIV f \<Longrightarrow> (\<Union>a\<in>\<Down> S. \<down> (f a)) = (\<Union>a\<in> S. \<down> (f a))  "
apply (intro set_eqI iffI; clarsimp simp: in_down_iff)
   apply (smt (verit) downset_set_def le_fun_def mem_Collect_eq monotoneD order_trans)
  using in_Down_iff by auto

lemma rewrite_sup_helper''': "mono_on UNIV f  \<Longrightarrow> (\<Union>a\<in>\<down> a. \<Union>b\<in>S'. \<down> (f a b)) = (\<Union>b\<in>S'.  \<down> (f a b ))"
  apply (intro set_eqI iffI; clarsimp simp: in_down_iff)
   apply (smt (verit) downset_set_def le_fun_def mem_Collect_eq monotoneD order_trans)
  using in_down_iff by auto

locale conj_par = conj: conj_elem + par: par_elem +
  constrains par :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" and to_env :: "'a \<Rightarrow> 'a"

locale conj_par_elem = conj_par +
                       exchange_semigroup_ordered  par conj +
                       assumes chaos_par_magic: " \<bottom> \<ge> unit_of a \<parallel> \<bottom>" and
                        unit_of_par: "unit_of (a \<parallel> b) \<ge> unit_of a \<parallel> unit_of b"
begin

sublocale conv_conjunction_parallel: conjunction_parallel  conj.convolute conj.dunit par.convolute par.dunit
  apply (standard; clarsimp?)
    apply (clarsimp simp: less_eq_downset_def, transfer, clarsimp simp: downset_set_def in_down_iff)
    apply (meson chaos_par_magic dual_order.trans par.mono_f)
    apply (clarsimp simp: less_eq_downset_def, transfer, clarsimp simp: downset_set_def in_down_iff)
  apply (smt (verit, best) dual_order.trans par.mono_f unit_of_par)
  by (meson exchange_convolute.exchange)

end

locale conj_seq = seq: test_seq + conj: conj_elem +
  constrains conj :: "'a \<Rightarrow> 'a \<Rightarrow> 'a" and unit_of :: "'a \<Rightarrow> 'a"

locale conj_seq_elem = conj_seq  +
                       exchange_semigroup_ordered seq conj +
      assumes chaos_seq_chaos_nonaborting: "\<And>a b. unit_of (a ; b) \<ge> unit_of a ; unit_of b"
begin

sublocale conv_conjunction_sequential: conjunction_sequential conj.convolute conj.dunit seq.convolute seq.dnil
  apply (standard)
   apply (clarsimp simp: less_eq_downset_def, transfer, clarsimp simp: downset_set_def in_down_iff)
  apply (meson chaos_seq_chaos_nonaborting dual_order.trans seq.mono_f)
  by (meson exchange_convolute.exchange)

lemma le_bot_conj: "x \<le> \<bottom> \<iinter> y  \<Longrightarrow> x \<le> y"
  by (meson conj.covering dual_order.trans preorder_bot_class.bot_least)

lemma le_bot_conj': "x \<le> y \<iinter> \<bottom>  \<Longrightarrow> x \<le> y"
  by (meson conj.covering dual_order.trans preorder_bot_class.bot_least)

lemma unit_of_test: "unit_of (test x) \<le> test x"

  by (simp add: conj.unit_of_unit)

lemma test_le_unit_of: "\<exists>c. test x \<le> unit_of c"
  apply (insert conv_conjunction_sequential.chaos_ref_nil)
  apply (clarsimp simp: less_eq_downset_def seq.nil_dnil[symmetric])
  apply (clarsimp simp: seq.conv_test_pre.nil_def)
  apply (transfer)
  apply (clarsimp simp: subset_iff down_image_iff)
  apply (erule_tac x="test x" in allE)
  apply (clarsimp)
  apply (fastforce)
  done

lemma conj_bot_test[simp]: "conj \<bottom> (test x) \<le> \<bottom>"
  apply (insert test_le_unit_of[where x=x], clarsimp)
  by (meson conj.down_unit conj.mono_f dual_order.trans preorder_bot_class.bot_least)

lemma conj_bot_test'[simp]: "conj (test x) \<bottom>  \<le> \<bottom>"
  by (simp add: local.conj.commute)

lemma exchange_test': "\<And>t . test t ; (conj a  b) \<le> conj (test t ; a) (test t ; b)"
  apply (rule order_trans[rotated], rule exchange)
  by (rule seq.mono_f; clarsimp)

lemma test_conj_inf: "test t \<iinter> test t' \<le> test t "
  by (meson conj.down_unit conj.mono_f dual_order.refl dual_order.trans test_le_unit_of)

lemma "(test t)\<^sub>1 \<ge> test t"
  by (metis conj.unit_of_unit conj_bot_test dual_order.trans
       local.conj.commute preorder_bot_class.bot_least seq.test_atom unit_of_test)

sublocale conj_seq_test:
  sync_command_with_tests_aborting seq.convolute seq.dtest conj.convolute conj.dunit
  apply (standard)
       apply (rule antisym)
        apply (rule_tac y="seq.convolute (conj.convolute (seq.dtest p) (seq.dtest p)) (conj.convolute c d)" in order_trans)
         apply simp
        apply (rule order_trans, rule conv_conjunction_sequential.seq_conj_interchange)
        apply (rule order_refl)
       apply (clarsimp simp: less_eq_downset_def, transfer)
       apply (case_tac "p={}", clarsimp simp: Bex_def in_down_iff)
        apply (rule_tac x=\<bottom> in exI, clarsimp)
        defer
  apply (subst seq.nonempty_bot_union, fastforce)+
        apply (simp add: rewrite_sup' rewrite_sup monotoneI seq.flip.mono_f conj.mono_f le_funI seq.rewrite_sup_helper rewrite_sup_helper'  rewrite_sup_helper'' rewrite_sup_helper''' rewrite_sup_helper'''')
        apply (clarsimp simp: in_down_iff)
  apply (subgoal_tac "first x \<le> test xa \<or> first x \<le> test xc", elim disjE)
          apply (meson dual_order.trans seq.flip.mono_f seq.flip.unit_of_apply in_downsetI seq.test_le')
  apply (meson dual_order.trans seq.flip.mono_f seq.flip.unit_of_apply in_downsetI seq.test_le')
  using conj.covering seq.first_test apply blast
       apply (clarsimp simp: inf_downset_def, transfer)
       apply (case_tac "p={}", clarsimp simp: Bex_def in_down_iff)
        apply (simp add: rewrite_sup' rewrite_sup monotoneI seq.flip.mono_f conj.mono_f le_funI seq.rewrite_sup_helper rewrite_sup_helper'  rewrite_sup_helper'' rewrite_sup_helper''' rewrite_sup_helper'''')
        apply (safe; clarsimp simp: in_down_iff)[1]
          apply (meson conj.mono_f conj_bot_test dual_order.refl dual_order.trans)
  using conj.covering dual_order.trans apply blast
        apply (meson dual_order.trans preorder_bot_class.bot_least in_down_iff)
       apply (subst seq.nonempty_bot_union, fastforce)+
       apply (case_tac "q={}", clarsimp simp: Bex_def in_down_iff)
        apply (simp add: rewrite_sup' rewrite_sup monotoneI seq.flip.mono_f conj.mono_f le_funI seq.rewrite_sup_helper rewrite_sup_helper'  rewrite_sup_helper'' rewrite_sup_helper''' rewrite_sup_helper'''')
        apply (safe; clarsimp simp: in_down_iff in_Down_iff)[1]
  using le_bot_conj' apply blast
         apply (metis conj_bot_test dual_order.trans local.conj.commute)
       apply (subst seq.nonempty_bot_union, fastforce)+
        apply (simp add: rewrite_sup' rewrite_sup monotoneI seq.flip.mono_f conj.mono_f le_funI seq.rewrite_sup_helper rewrite_sup_helper'  rewrite_sup_helper'' rewrite_sup_helper''' rewrite_sup_helper'''')
       apply (safe; clarsimp simp: in_down_iff in_Down_iff)
         apply (meson conj.down_unit conj.mono_f dual_order.trans order_eq_refl test_le_unit_of)
        apply (metis (no_types, lifting) conj.covering conj.unit_of_unit conj_bot_test dual_order.trans local.conj.commute local.conj.idem preorder_bot_class.bot_least seq.test_atom)
       apply (metis conj.mono_f local.conj.idem)
      apply simp
  apply (simp add: conv_conjunction_sequential.chaos_ref_nil seq.nil_dnil)
  using conv_conjunction_sequential.seq_conj_interchange apply presburger
  using conj.conj_conv.conj_abort_right apply presburger
  by (metis conj.covering preorder_bot_class.bot_least refine_trans seq.aborting seq.bot_annihilate_seq seq.flip.mono_f)
end

locale cra_elem = conj_par_elem + cs: conj_seq_elem + sp: seq_par_elem
begin

sublocale conv_cra: cra cs.seq.convolute cs.seq.conv_test_pre.nil par.convolute par.dunit conj.convolute conj.dunit
  apply (standard; clarsimp?)
       apply (metis order_refl cs.seq.conv_test_pre.test_top sp.seq_par_test.test_sync_nil)
  using sp.seq_par_test.chaos_ref_nil apply force
    apply (simp add: sp.exchange_convolute.exchange)
  using cs.conv_conjunction_sequential.chaos_seq_chaos_nonaborting apply auto[1]
  using cs.conv_conjunction_sequential.seq_conj_interchange by force

sublocale cra_assert: assertions cs.seq.convolute cs.seq.dtest ..

sublocale conv_cra_test: test_commands cs.seq.convolute cs.seq.dtest par.convolute par.dunit conj.convolute conj.dunit
  apply (standard)
    apply (simp add: sp.seq_par_test.test_sync_distrib)
  using cs.conj_seq_test.test_sync_distrib apply force
  using sp.seq_par_test.test_sync_test by fastforce

end

end


section \<open>Relations between control dependences\<close>

theory ControlDependenceRelations
  imports WeakOrderDependence StandardControlDependence
begin

context StrongPostdomination begin

lemma standard_control_implies_weak_order:
  assumes "n controls\<^sub>s n'" shows "n \<longrightarrow>\<^sub>w\<^sub>o\<^sub>d n',(_Exit_)"
proof -
  from \<open>n controls\<^sub>s n'\<close> obtain as a a' as' where "as = a#as'"
    and "n' \<notin> set(sourcenodes as)" and "n -as\<rightarrow>* n'"
    and "n' postdominates (targetnode a)"
    and "valid_edge a'" and "sourcenode a' = n"
    and "\<not> n' postdominates (targetnode a')"
    by(auto simp:standard_control_dependence_def)
  from \<open>n -as\<rightarrow>* n'\<close> \<open>as = a#as'\<close> have "sourcenode a = n" by(auto elim:path.cases)
  from \<open>n -as\<rightarrow>* n'\<close> \<open>as = a#as'\<close> \<open>n' \<notin> set(sourcenodes as)\<close> have "n \<noteq> n'"
    by(induct rule:path.induct,auto simp:sourcenodes_def)
  from \<open>n -as\<rightarrow>* n'\<close> \<open>as = a#as'\<close> have "valid_edge a"
    by(auto elim:path.cases)
  from \<open>n controls\<^sub>s n'\<close> have "n' \<noteq> (_Exit_)"
    by(fastforce dest:Exit_not_standard_control_dependent)
  from \<open>n -as\<rightarrow>* n'\<close> have "(_Exit_) \<notin> set (sourcenodes as)" by fastforce
  from \<open>n -as\<rightarrow>* n'\<close> have "valid_node n" and "valid_node n'"
    by(auto dest:path_valid_node)
  with \<open>\<not> n' postdominates (targetnode a')\<close> \<open>valid_edge a'\<close>
  obtain asx where "targetnode a' -asx\<rightarrow>* (_Exit_)" and "n' \<notin> set(sourcenodes asx)"
    by(auto simp:postdominate_def)
  with \<open>valid_edge a'\<close> \<open>sourcenode a' = n\<close> have "n -a'#asx\<rightarrow>* (_Exit_)"
    by(fastforce intro:Cons_path)
  with \<open>n \<noteq> n'\<close> \<open>sourcenode a' = n\<close> \<open>n' \<notin> set(sourcenodes asx)\<close>
  have "n' \<notin> set(sourcenodes (a'#asx))" by(simp add:sourcenodes_def)
  from \<open>n' postdominates (targetnode a)\<close>
  obtain asx' where "targetnode a -asx'\<rightarrow>* n'" by(erule postdominate_implies_path)
  from \<open>n' postdominates (targetnode a)\<close>
  have "\<forall>as'. targetnode a -as'\<rightarrow>* (_Exit_) \<longrightarrow> n' \<in> set(sourcenodes as')"
    by(auto simp:postdominate_def)
  with \<open>n' \<noteq> (_Exit_)\<close> \<open>n -as\<rightarrow>* n'\<close> \<open>(_Exit_) \<notin> set (sourcenodes as)\<close>
    \<open>n -a'#asx\<rightarrow>* (_Exit_)\<close> \<open>n' \<notin> set(sourcenodes (a'#asx))\<close>
    \<open>valid_edge a\<close> \<open>sourcenode a = n\<close> \<open>targetnode a -asx'\<rightarrow>* n'\<close>
  show ?thesis by(auto simp:wod_def)
qed

end

end


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

section "32-Bit Machine Word Setup"

theory Word_Setup_32
imports Word_Enum
begin

text \<open>This theory defines standard platform-specific word size and alignment.\<close>

type_synonym machine_word_len = 32
type_synonym machine_word = "machine_word_len word"

definition word_bits :: nat
where
  "word_bits = LENGTH(machine_word_len)"

text \<open>The following two are numerals so they can be used as nats and words.\<close>
definition word_size_bits :: "'a :: numeral"
where
  "word_size_bits = 2"

definition word_size :: "'a :: numeral"
where
  "word_size = 4"

lemma word_bits_conv[code]:
  "word_bits = 32"
  unfolding word_bits_def by simp

lemma word_size_word_size_bits:
  "(word_size::nat) = 2 ^ word_size_bits"
  unfolding word_size_def word_size_bits_def by simp

lemma word_bits_word_size_conv:
  "word_bits = word_size * 8"
  unfolding word_bits_def word_size_def by simp

end