theory Tactic
imports Base
begin

chapter \<open>Tactical reasoning\<close>

text \<open>Tactical reasoning works by refining an initial claim in a
  backwards fashion, until a solved form is reached.  A @{text "goal"}
  consists of several subgoals that need to be solved in order to
  achieve the main statement; zero subgoals means that the proof may
  be finished.  A @{text "tactic"} is a refinement operation that maps
  a goal to a lazy sequence of potential successors.  A @{text
  "tactical"} is a combinator for composing tactics.\<close>

section \<open>Goals \label{sec:tactical-goals}\<close>

text \<open>
  Isabelle/Pure represents a goal as a theorem stating that the
  subgoals imply the main goal: @{text "A\<^sub>1 \<Longrightarrow> \<dots> \<Longrightarrow> A\<^sub>n \<Longrightarrow>
  C"}.  The outermost goal structure is that of a Horn Clause: i.e.\
  an iterated implication without any quantifiers\footnote{Recall that
  outermost @{text "\<And>x. \<phi>[x]"} is always represented via schematic
  variables in the body: @{text "\<phi>[?x]"}.  These variables may get
  instantiated during the course of reasoning.}.  For @{text "n = 0"}
  a goal is called ``solved''.

  The structure of each subgoal @{text "A\<^sub>i"} is that of a
  general Hereditary Harrop Formula @{text "\<And>x\<^sub>1 \<dots>
  \<And>x\<^sub>k. H\<^sub>1 \<Longrightarrow> \<dots> \<Longrightarrow> H\<^sub>m \<Longrightarrow> B"}.  Here @{text
  "x\<^sub>1, \<dots>, x\<^sub>k"} are goal parameters, i.e.\
  arbitrary-but-fixed entities of certain types, and @{text
  "H\<^sub>1, \<dots>, H\<^sub>m"} are goal hypotheses, i.e.\ facts that may
  be assumed locally.  Together, this forms the goal context of the
  conclusion @{text B} to be established.  The goal hypotheses may be
  again arbitrary Hereditary Harrop Formulas, although the level of
  nesting rarely exceeds 1--2 in practice.

  The main conclusion @{text C} is internally marked as a protected
  proposition, which is represented explicitly by the notation @{text
  "#C"} here.  This ensures that the decomposition into subgoals and
  main conclusion is well-defined for arbitrarily structured claims.

  \medskip Basic goal management is performed via the following
  Isabelle/Pure rules:

  \[
  \infer[@{text "(init)"}]{@{text "C \<Longrightarrow> #C"}}{} \qquad
  \infer[@{text "(finish)"}]{@{text "C"}}{@{text "#C"}}
  \]

  \medskip The following low-level variants admit general reasoning
  with protected propositions:

  \[
  \infer[@{text "(protect n)"}]{@{text "A\<^sub>1 \<Longrightarrow> \<dots> \<Longrightarrow> A\<^sub>n \<Longrightarrow> #C"}}{@{text "A\<^sub>1 \<Longrightarrow> \<dots> \<Longrightarrow> A\<^sub>n \<Longrightarrow> C"}}
  \]
  \[
  \infer[@{text "(conclude)"}]{@{text "A \<Longrightarrow> \<dots> \<Longrightarrow> C"}}{@{text "A \<Longrightarrow> \<dots> \<Longrightarrow> #C"}}
  \]
\<close>

text %mlref \<open>
  \begin{mldecls}
  @{index_ML Goal.init: "cterm -> thm"} \\
  @{index_ML Goal.finish: "Proof.context -> thm -> thm"} \\
  @{index_ML Goal.protect: "int -> thm -> thm"} \\
  @{index_ML Goal.conclude: "thm -> thm"} \\
  \end{mldecls}

  \begin{description}

  \item @{ML "Goal.init"}~@{text C} initializes a tactical goal from
  the well-formed proposition @{text C}.

  \item @{ML "Goal.finish"}~@{text "ctxt thm"} checks whether theorem
  @{text "thm"} is a solved goal (no subgoals), and concludes the
  result by removing the goal protection.  The context is only
  required for printing error messages.

  \item @{ML "Goal.protect"}~@{text "n thm"} protects the statement
  of theorem @{text "thm"}.  The parameter @{text n} indicates the
  number of premises to be retained.

  \item @{ML "Goal.conclude"}~@{text "thm"} removes the goal
  protection, even if there are pending subgoals.

  \end{description}
\<close>

section \<open>Tactics\label{sec:tactics}\<close>

text \<open>A @{text "tactic"} is a function @{text "goal \<rightarrow> goal\<^sup>*\<^sup>*"} that
  maps a given goal state (represented as a theorem, cf.\
  \secref{sec:tactical-goals}) to a lazy sequence of potential
  successor states.  The underlying sequence implementation is lazy
  both in head and tail, and is purely functional in \emph{not}
  supporting memoing.\footnote{The lack of memoing and the strict
  nature of ML requires some care when working with low-level
  sequence operations, to avoid duplicate or premature evaluation of
  results.  It also means that modified runtime behavior, such as
  timeout, is very hard to achieve for general tactics.}

  An \emph{empty result sequence} means that the tactic has failed: in
  a compound tactic expression other tactics might be tried instead,
  or the whole refinement step might fail outright, producing a
  toplevel error message in the end.  When implementing tactics from
  scratch, one should take care to observe the basic protocol of
  mapping regular error conditions to an empty result; only serious
  faults should emerge as exceptions.

  By enumerating \emph{multiple results}, a tactic can easily express
  the potential outcome of an internal search process.  There are also
  combinators for building proof tools that involve search
  systematically, see also \secref{sec:tacticals}.

  \medskip As explained before, a goal state essentially consists of a
  list of subgoals that imply the main goal (conclusion).  Tactics may
  operate on all subgoals or on a particularly specified subgoal, but
  must not change the main conclusion (apart from instantiating
  schematic goal variables).

  Tactics with explicit \emph{subgoal addressing} are of the form
  @{text "int \<rightarrow> tactic"} and may be applied to a particular subgoal
  (counting from 1).  If the subgoal number is out of range, the
  tactic should fail with an empty result sequence, but must not raise
  an exception!

  Operating on a particular subgoal means to replace it by an interval
  of zero or more subgoals in the same place; other subgoals must not
  be affected, apart from instantiating schematic variables ranging
  over the whole goal state.

  A common pattern of composing tactics with subgoal addressing is to
  try the first one, and then the second one only if the subgoal has
  not been solved yet.  Special care is required here to avoid bumping
  into unrelated subgoals that happen to come after the original
  subgoal.  Assuming that there is only a single initial subgoal is a
  very common error when implementing tactics!

  Tactics with internal subgoal addressing should expose the subgoal
  index as @{text "int"} argument in full generality; a hardwired
  subgoal 1 is not acceptable.

  \medskip The main well-formedness conditions for proper tactics are
  summarized as follows.

  \begin{itemize}

  \item General tactic failure is indicated by an empty result, only
  serious faults may produce an exception.

  \item The main conclusion must not be changed, apart from
  instantiating schematic variables.

  \item A tactic operates either uniformly on all subgoals, or
  specifically on a selected subgoal (without bumping into unrelated
  subgoals).

  \item Range errors in subgoal addressing produce an empty result.

  \end{itemize}

  Some of these conditions are checked by higher-level goal
  infrastructure (\secref{sec:struct-goals}); others are not checked
  explicitly, and violating them merely results in ill-behaved tactics
  experienced by the user (e.g.\ tactics that insist in being
  applicable only to singleton goals, or prevent composition via
  standard tacticals such as @{ML REPEAT}).
\<close>

text %mlref \<open>
  \begin{mldecls}
  @{index_ML_type tactic: "thm -> thm Seq.seq"} \\
  @{index_ML no_tac: tactic} \\
  @{index_ML all_tac: tactic} \\
  @{index_ML print_tac: "Proof.context -> string -> tactic"} \\[1ex]
  @{index_ML PRIMITIVE: "(thm -> thm) -> tactic"} \\[1ex]
  @{index_ML SUBGOAL: "(term * int -> tactic) -> int -> tactic"} \\
  @{index_ML CSUBGOAL: "(cterm * int -> tactic) -> int -> tactic"} \\
  @{index_ML SELECT_GOAL: "tactic -> int -> tactic"} \\
  @{index_ML PREFER_GOAL: "tactic -> int -> tactic"} \\
  \end{mldecls}

  \begin{description}

  \item Type @{ML_type tactic} represents tactics.  The
  well-formedness conditions described above need to be observed.  See
  also @{file "~~/src/Pure/General/seq.ML"} for the underlying
  implementation of lazy sequences.

  \item Type @{ML_type "int -> tactic"} represents tactics with
  explicit subgoal addressing, with well-formedness conditions as
  described above.

  \item @{ML no_tac} is a tactic that always fails, returning the
  empty sequence.

  \item @{ML all_tac} is a tactic that always succeeds, returning a
  singleton sequence with unchanged goal state.

  \item @{ML print_tac}~@{text "ctxt message"} is like @{ML all_tac}, but
  prints a message together with the goal state on the tracing
  channel.

  \item @{ML PRIMITIVE}~@{text rule} turns a primitive inference rule
  into a tactic with unique result.  Exception @{ML THM} is considered
  a regular tactic failure and produces an empty result; other
  exceptions are passed through.

  \item @{ML SUBGOAL}~@{text "(fn (subgoal, i) => tactic)"} is the
  most basic form to produce a tactic with subgoal addressing.  The
  given abstraction over the subgoal term and subgoal number allows to
  peek at the relevant information of the full goal state.  The
  subgoal range is checked as required above.

  \item @{ML CSUBGOAL} is similar to @{ML SUBGOAL}, but passes the
  subgoal as @{ML_type cterm} instead of raw @{ML_type term}.  This
  avoids expensive re-certification in situations where the subgoal is
  used directly for primitive inferences.

  \item @{ML SELECT_GOAL}~@{text "tac i"} confines a tactic to the
  specified subgoal @{text "i"}.  This rearranges subgoals and the
  main goal protection (\secref{sec:tactical-goals}), while retaining
  the syntactic context of the overall goal state (concerning
  schematic variables etc.).

  \item @{ML PREFER_GOAL}~@{text "tac i"} rearranges subgoals to put
  @{text "i"} in front.  This is similar to @{ML SELECT_GOAL}, but
  without changing the main goal protection.

  \end{description}
\<close>

subsection \<open>Resolution and assumption tactics \label{sec:resolve-assume-tac}\<close>

text \<open>\emph{Resolution} is the most basic mechanism for refining a
  subgoal using a theorem as object-level rule.
  \emph{Elim-resolution} is particularly suited for elimination rules:
  it resolves with a rule, proves its first premise by assumption, and
  finally deletes that assumption from any new subgoals.
  \emph{Destruct-resolution} is like elim-resolution, but the given
  destruction rules are first turned into canonical elimination
  format.  \emph{Forward-resolution} is like destruct-resolution, but
  without deleting the selected assumption.  The @{text "r/e/d/f"}
  naming convention is maintained for several different kinds of
  resolution rules and tactics.

  Assumption tactics close a subgoal by unifying some of its premises
  against its conclusion.

  \medskip All the tactics in this section operate on a subgoal
  designated by a positive integer.  Other subgoals might be affected
  indirectly, due to instantiation of schematic variables.

  There are various sources of non-determinism, the tactic result
  sequence enumerates all possibilities of the following choices (if
  applicable):

  \begin{enumerate}

  \item selecting one of the rules given as argument to the tactic;

  \item selecting a subgoal premise to eliminate, unifying it against
  the first premise of the rule;

  \item unifying the conclusion of the subgoal to the conclusion of
  the rule.

  \end{enumerate}

  Recall that higher-order unification may produce multiple results
  that are enumerated here.
\<close>

text %mlref \<open>
  \begin{mldecls}
  @{index_ML resolve_tac: "thm list -> int -> tactic"} \\
  @{index_ML eresolve_tac: "thm list -> int -> tactic"} \\
  @{index_ML dresolve_tac: "thm list -> int -> tactic"} \\
  @{index_ML forward_tac: "thm list -> int -> tactic"} \\
  @{index_ML biresolve_tac: "(bool * thm) list -> int -> tactic"} \\[1ex]
  @{index_ML assume_tac: "Proof.context -> int -> tactic"} \\
  @{index_ML eq_assume_tac: "int -> tactic"} \\[1ex]
  @{index_ML match_tac: "Proof.context -> thm list -> int -> tactic"} \\
  @{index_ML ematch_tac: "Proof.context -> thm list -> int -> tactic"} \\
  @{index_ML dmatch_tac: "Proof.context -> thm list -> int -> tactic"} \\
  @{index_ML bimatch_tac: "Proof.context -> (bool * thm) list -> int -> tactic"} \\
  \end{mldecls}

  \begin{description}

  \item @{ML resolve_tac}~@{text "thms i"} refines the goal state
  using the given theorems, which should normally be introduction
  rules.  The tactic resolves a rule's conclusion with subgoal @{text
  i}, replacing it by the corresponding versions of the rule's
  premises.

  \item @{ML eresolve_tac}~@{text "thms i"} performs elim-resolution
  with the given theorems, which are normally be elimination rules.

  Note that @{ML "eresolve_tac [asm_rl]"} is equivalent to @{ML
  assume_tac}, which facilitates mixing of assumption steps with
  genuine eliminations.

  \item @{ML dresolve_tac}~@{text "thms i"} performs
  destruct-resolution with the given theorems, which should normally
  be destruction rules.  This replaces an assumption by the result of
  applying one of the rules.

  \item @{ML forward_tac} is like @{ML dresolve_tac} except that the
  selected assumption is not deleted.  It applies a rule to an
  assumption, adding the result as a new assumption.

  \item @{ML biresolve_tac}~@{text "brls i"} refines the proof state
  by resolution or elim-resolution on each rule, as indicated by its
  flag.  It affects subgoal @{text "i"} of the proof state.

  For each pair @{text "(flag, rule)"}, it applies resolution if the
  flag is @{text "false"} and elim-resolution if the flag is @{text
  "true"}.  A single tactic call handles a mixture of introduction and
  elimination rules, which is useful to organize the search process
  systematically in proof tools.

  \item @{ML assume_tac}~@{text "ctxt i"} attempts to solve subgoal @{text i}
  by assumption (modulo higher-order unification).

  \item @{ML eq_assume_tac} is similar to @{ML assume_tac}, but checks
  only for immediate @{text "\<alpha>"}-convertibility instead of using
  unification.  It succeeds (with a unique next state) if one of the
  assumptions is equal to the subgoal's conclusion.  Since it does not
  instantiate variables, it cannot make other subgoals unprovable.

  \item @{ML match_tac}, @{ML ematch_tac}, @{ML dmatch_tac}, and @{ML
  bimatch_tac} are similar to @{ML resolve_tac}, @{ML eresolve_tac},
  @{ML dresolve_tac}, and @{ML biresolve_tac}, respectively, but do
  not instantiate schematic variables in the goal state.%
\footnote{Strictly speaking, matching means to treat the unknowns in the goal
  state as constants, but these tactics merely discard unifiers that would
  update the goal state. In rare situations (where the conclusion and
  goal state have flexible terms at the same position), the tactic
  will fail even though an acceptable unifier exists.}
  These tactics were written for a specific application within the classical reasoner.

  Flexible subgoals are not updated at will, but are left alone.
  \end{description}
\<close>

subsection \<open>Explicit instantiation within a subgoal context\<close>

text \<open>The main resolution tactics (\secref{sec:resolve-assume-tac})
  use higher-order unification, which works well in many practical
  situations despite its daunting theoretical properties.
  Nonetheless, there are important problem classes where unguided
  higher-order unification is not so useful.  This typically involves
  rules like universal elimination, existential introduction, or
  equational substitution.  Here the unification problem involves
  fully flexible @{text "?P ?x"} schemes, which are hard to manage
  without further hints.

  By providing a (small) rigid term for @{text "?x"} explicitly, the
  remaining unification problem is to assign a (large) term to @{text
  "?P"}, according to the shape of the given subgoal.  This is
  sufficiently well-behaved in most practical situations.

  \medskip Isabelle provides separate versions of the standard @{text
  "r/e/d/f"} resolution tactics that allow to provide explicit
  instantiations of unknowns of the given rule, wrt.\ terms that refer
  to the implicit context of the selected subgoal.

  An instantiation consists of a list of pairs of the form @{text
  "(?x, t)"}, where @{text ?x} is a schematic variable occurring in
  the given rule, and @{text t} is a term from the current proof
  context, augmented by the local goal parameters of the selected
  subgoal; cf.\ the @{text "focus"} operation described in
  \secref{sec:variables}.

  Entering the syntactic context of a subgoal is a brittle operation,
  because its exact form is somewhat accidental, and the choice of
  bound variable names depends on the presence of other local and
  global names.  Explicit renaming of subgoal parameters prior to
  explicit instantiation might help to achieve a bit more robustness.

  Type instantiations may be given as well, via pairs like @{text
  "(?'a, \<tau>)"}.  Type instantiations are distinguished from term
  instantiations by the syntactic form of the schematic variable.
  Types are instantiated before terms are.  Since term instantiation
  already performs simple type-inference, so explicit type
  instantiations are seldom necessary.
\<close>

text %mlref \<open>
  \begin{mldecls}
  @{index_ML res_inst_tac: "Proof.context -> (indexname * string) list -> thm -> int -> tactic"} \\
  @{index_ML eres_inst_tac: "Proof.context -> (indexname * string) list -> thm -> int -> tactic"} \\
  @{index_ML dres_inst_tac: "Proof.context -> (indexname * string) list -> thm -> int -> tactic"} \\
  @{index_ML forw_inst_tac: "Proof.context -> (indexname * string) list -> thm -> int -> tactic"} \\
  @{index_ML subgoal_tac: "Proof.context -> string -> int -> tactic"} \\
  @{index_ML thin_tac: "Proof.context -> string -> int -> tactic"} \\
  @{index_ML rename_tac: "string list -> int -> tactic"} \\
  \end{mldecls}

  \begin{description}

  \item @{ML res_inst_tac}~@{text "ctxt insts thm i"} instantiates the
  rule @{text thm} with the instantiations @{text insts}, as described
  above, and then performs resolution on subgoal @{text i}.

  \item @{ML eres_inst_tac} is like @{ML res_inst_tac}, but performs
  elim-resolution.

  \item @{ML dres_inst_tac} is like @{ML res_inst_tac}, but performs
  destruct-resolution.

  \item @{ML forw_inst_tac} is like @{ML dres_inst_tac} except that
  the selected assumption is not deleted.

  \item @{ML subgoal_tac}~@{text "ctxt \<phi> i"} adds the proposition
  @{text "\<phi>"} as local premise to subgoal @{text "i"}, and poses the
  same as a new subgoal @{text "i + 1"} (in the original context).

  \item @{ML thin_tac}~@{text "ctxt \<phi> i"} deletes the specified
  premise from subgoal @{text i}.  Note that @{text \<phi>} may contain
  schematic variables, to abbreviate the intended proposition; the
  first matching subgoal premise will be deleted.  Removing useless
  premises from a subgoal increases its readability and can make
  search tactics run faster.

  \item @{ML rename_tac}~@{text "names i"} renames the innermost
  parameters of subgoal @{text i} according to the provided @{text
  names} (which need to be distinct identifiers).

  \end{description}

  For historical reasons, the above instantiation tactics take
  unparsed string arguments, which makes them hard to use in general
  ML code.  The slightly more advanced @{ML Subgoal.FOCUS} combinator
  of \secref{sec:struct-goals} allows to refer to internal goal
  structure with explicit context management.
\<close>

subsection \<open>Rearranging goal states\<close>

text \<open>In rare situations there is a need to rearrange goal states:
  either the overall collection of subgoals, or the local structure of
  a subgoal.  Various administrative tactics allow to operate on the
  concrete presentation these conceptual sets of formulae.\<close>

text %mlref \<open>
  \begin{mldecls}
  @{index_ML rotate_tac: "int -> int -> tactic"} \\
  @{index_ML distinct_subgoals_tac: tactic} \\
  @{index_ML flexflex_tac: "Proof.context -> tactic"} \\
  \end{mldecls}

  \begin{description}

  \item @{ML rotate_tac}~@{text "n i"} rotates the premises of subgoal
  @{text i} by @{text n} positions: from right to left if @{text n} is
  positive, and from left to right if @{text n} is negative.

  \item @{ML distinct_subgoals_tac} removes duplicate subgoals from a
  proof state.  This is potentially inefficient.

  \item @{ML flexflex_tac} removes all flex-flex pairs from the proof
  state by applying the trivial unifier.  This drastic step loses
  information.  It is already part of the Isar infrastructure for
  facts resulting from goals, and rarely needs to be invoked manually.

  Flex-flex constraints arise from difficult cases of higher-order
  unification.  To prevent this, use @{ML res_inst_tac} to instantiate
  some variables in a rule.  Normally flex-flex constraints can be
  ignored; they often disappear as unknowns get instantiated.

  \end{description}
\<close>

subsection \<open>Raw composition: resolution without lifting\<close>

text \<open>
  Raw composition of two rules means resolving them without prior
  lifting or renaming of unknowns.  This low-level operation, which
  underlies the resolution tactics, may occasionally be useful for
  special effects.  Schematic variables are not renamed by default, so
  beware of clashes!
\<close>

text %mlref \<open>
  \begin{mldecls}
  @{index_ML compose_tac: "Proof.context -> (bool * thm * int) -> int -> tactic"} \\
  @{index_ML Drule.compose: "thm * int * thm -> thm"} \\
  @{index_ML_op COMP: "thm * thm -> thm"} \\
  \end{mldecls}

  \begin{description}

  \item @{ML compose_tac}~@{text "ctxt (flag, rule, m) i"} refines subgoal
  @{text "i"} using @{text "rule"}, without lifting.  The @{text
  "rule"} is taken to have the form @{text "\<psi>\<^sub>1 \<Longrightarrow> \<dots> \<psi>\<^sub>m \<Longrightarrow> \<psi>"}, where
  @{text "\<psi>"} need not be atomic; thus @{text "m"} determines the
  number of new subgoals.  If @{text "flag"} is @{text "true"} then it
  performs elim-resolution --- it solves the first premise of @{text
  "rule"} by assumption and deletes that assumption.

  \item @{ML Drule.compose}~@{text "(thm\<^sub>1, i, thm\<^sub>2)"} uses @{text "thm\<^sub>1"},
  regarded as an atomic formula, to solve premise @{text "i"} of
  @{text "thm\<^sub>2"}.  Let @{text "thm\<^sub>1"} and @{text "thm\<^sub>2"} be @{text
  "\<psi>"} and @{text "\<phi>\<^sub>1 \<Longrightarrow> \<dots> \<phi>\<^sub>n \<Longrightarrow> \<phi>"}.  The unique @{text "s"} that
  unifies @{text "\<psi>"} and @{text "\<phi>\<^sub>i"} yields the theorem @{text "(\<phi>\<^sub>1 \<Longrightarrow>
  \<dots> \<phi>\<^sub>i\<^sub>-\<^sub>1 \<Longrightarrow> \<phi>\<^sub>i\<^sub>+\<^sub>1 \<Longrightarrow> \<dots> \<phi>\<^sub>n \<Longrightarrow> \<phi>)s"}.  Multiple results are considered as
  error (exception @{ML THM}).

  \item @{text "thm\<^sub>1 COMP thm\<^sub>2"} is the same as @{text "Drule.compose
  (thm\<^sub>1, 1, thm\<^sub>2)"}.

  \end{description}

  \begin{warn}
  These low-level operations are stepping outside the structure
  imposed by regular rule resolution.  Used without understanding of
  the consequences, they may produce results that cause problems with
  standard rules and tactics later on.
  \end{warn}
\<close>

section \<open>Tacticals \label{sec:tacticals}\<close>

text \<open>A \emph{tactical} is a functional combinator for building up
  complex tactics from simpler ones.  Common tacticals perform
  sequential composition, disjunctive choice, iteration, or goal
  addressing.  Various search strategies may be expressed via
  tacticals.
\<close>

subsection \<open>Combining tactics\<close>

text \<open>Sequential composition and alternative choices are the most
  basic ways to combine tactics, similarly to ``@{verbatim ","}'' and
  ``@{verbatim "|"}'' in Isar method notation.  This corresponds to
  @{ML_op "THEN"} and @{ML_op "ORELSE"} in ML, but there are further
  possibilities for fine-tuning alternation of tactics such as @{ML_op
  "APPEND"}.  Further details become visible in ML due to explicit
  subgoal addressing.
\<close>

text %mlref \<open>
  \begin{mldecls}
  @{index_ML_op "THEN": "tactic * tactic -> tactic"} \\
  @{index_ML_op "ORELSE": "tactic * tactic -> tactic"} \\
  @{index_ML_op "APPEND": "tactic * tactic -> tactic"} \\
  @{index_ML "EVERY": "tactic list -> tactic"} \\
  @{index_ML "FIRST": "tactic list -> tactic"} \\[0.5ex]

  @{index_ML_op "THEN'": "('a -> tactic) * ('a -> tactic) -> 'a -> tactic"} \\
  @{index_ML_op "ORELSE'": "('a -> tactic) * ('a -> tactic) -> 'a -> tactic"} \\
  @{index_ML_op "APPEND'": "('a -> tactic) * ('a -> tactic) -> 'a -> tactic"} \\
  @{index_ML "EVERY'": "('a -> tactic) list -> 'a -> tactic"} \\
  @{index_ML "FIRST'": "('a -> tactic) list -> 'a -> tactic"} \\
  \end{mldecls}

  \begin{description}

  \item @{text "tac\<^sub>1"}~@{ML_op THEN}~@{text "tac\<^sub>2"} is the sequential
  composition of @{text "tac\<^sub>1"} and @{text "tac\<^sub>2"}.  Applied to a goal
  state, it returns all states reachable in two steps by applying
  @{text "tac\<^sub>1"} followed by @{text "tac\<^sub>2"}.  First, it applies @{text
  "tac\<^sub>1"} to the goal state, getting a sequence of possible next
  states; then, it applies @{text "tac\<^sub>2"} to each of these and
  concatenates the results to produce again one flat sequence of
  states.

  \item @{text "tac\<^sub>1"}~@{ML_op ORELSE}~@{text "tac\<^sub>2"} makes a choice
  between @{text "tac\<^sub>1"} and @{text "tac\<^sub>2"}.  Applied to a state, it
  tries @{text "tac\<^sub>1"} and returns the result if non-empty; if @{text
  "tac\<^sub>1"} fails then it uses @{text "tac\<^sub>2"}.  This is a deterministic
  choice: if @{text "tac\<^sub>1"} succeeds then @{text "tac\<^sub>2"} is excluded
  from the result.

  \item @{text "tac\<^sub>1"}~@{ML_op APPEND}~@{text "tac\<^sub>2"} concatenates the
  possible results of @{text "tac\<^sub>1"} and @{text "tac\<^sub>2"}.  Unlike
  @{ML_op "ORELSE"} there is \emph{no commitment} to either tactic, so
  @{ML_op "APPEND"} helps to avoid incompleteness during search, at
  the cost of potential inefficiencies.

  \item @{ML EVERY}~@{text "[tac\<^sub>1, \<dots>, tac\<^sub>n]"} abbreviates @{text
  "tac\<^sub>1"}~@{ML_op THEN}~@{text "\<dots>"}~@{ML_op THEN}~@{text "tac\<^sub>n"}.
  Note that @{ML "EVERY []"} is the same as @{ML all_tac}: it always
  succeeds.

  \item @{ML FIRST}~@{text "[tac\<^sub>1, \<dots>, tac\<^sub>n]"} abbreviates @{text
  "tac\<^sub>1"}~@{ML_op ORELSE}~@{text "\<dots>"}~@{ML_op "ORELSE"}~@{text
  "tac\<^sub>n"}.  Note that @{ML "FIRST []"} is the same as @{ML no_tac}: it
  always fails.

  \item @{ML_op "THEN'"} is the lifted version of @{ML_op "THEN"}, for
  tactics with explicit subgoal addressing.  So @{text
  "(tac\<^sub>1"}~@{ML_op THEN'}~@{text "tac\<^sub>2) i"} is the same as @{text
  "(tac\<^sub>1 i"}~@{ML_op THEN}~@{text "tac\<^sub>2 i)"}.

  The other primed tacticals work analogously.

  \end{description}
\<close>

subsection \<open>Repetition tacticals\<close>

text \<open>These tacticals provide further control over repetition of
  tactics, beyond the stylized forms of ``@{verbatim "?"}''  and
  ``@{verbatim "+"}'' in Isar method expressions.\<close>

text %mlref \<open>
  \begin{mldecls}
  @{index_ML "TRY": "tactic -> tactic"} \\
  @{index_ML "REPEAT": "tactic -> tactic"} \\
  @{index_ML "REPEAT1": "tactic -> tactic"} \\
  @{index_ML "REPEAT_DETERM": "tactic -> tactic"} \\
  @{index_ML "REPEAT_DETERM_N": "int -> tactic -> tactic"} \\
  \end{mldecls}

  \begin{description}

  \item @{ML TRY}~@{text "tac"} applies @{text "tac"} to the goal
  state and returns the resulting sequence, if non-empty; otherwise it
  returns the original state.  Thus, it applies @{text "tac"} at most
  once.

  Note that for tactics with subgoal addressing, the combinator can be
  applied via functional composition: @{ML "TRY"}~@{ML_op o}~@{text
  "tac"}.  There is no need for @{verbatim TRY'}.

  \item @{ML REPEAT}~@{text "tac"} applies @{text "tac"} to the goal
  state and, recursively, to each element of the resulting sequence.
  The resulting sequence consists of those states that make @{text
  "tac"} fail.  Thus, it applies @{text "tac"} as many times as
  possible (including zero times), and allows backtracking over each
  invocation of @{text "tac"}.  @{ML REPEAT} is more general than @{ML
  REPEAT_DETERM}, but requires more space.

  \item @{ML REPEAT1}~@{text "tac"} is like @{ML REPEAT}~@{text "tac"}
  but it always applies @{text "tac"} at least once, failing if this
  is impossible.

  \item @{ML REPEAT_DETERM}~@{text "tac"} applies @{text "tac"} to the
  goal state and, recursively, to the head of the resulting sequence.
  It returns the first state to make @{text "tac"} fail.  It is
  deterministic, discarding alternative outcomes.

  \item @{ML REPEAT_DETERM_N}~@{text "n tac"} is like @{ML
  REPEAT_DETERM}~@{text "tac"} but the number of repetitions is bound
  by @{text "n"} (where @{ML "~1"} means @{text "\<infinity>"}).

  \end{description}
\<close>

text %mlex \<open>The basic tactics and tacticals considered above follow
  some algebraic laws:

  \begin{itemize}

  \item @{ML all_tac} is the identity element of the tactical @{ML_op
  "THEN"}.

  \item @{ML no_tac} is the identity element of @{ML_op "ORELSE"} and
  @{ML_op "APPEND"}.  Also, it is a zero element for @{ML_op "THEN"},
  which means that @{text "tac"}~@{ML_op THEN}~@{ML no_tac} is
  equivalent to @{ML no_tac}.

  \item @{ML TRY} and @{ML REPEAT} can be expressed as (recursive)
  functions over more basic combinators (ignoring some internal
  implementation tricks):

  \end{itemize}
\<close>

ML \<open>
  fun TRY tac = tac ORELSE all_tac;
  fun REPEAT tac st = ((tac THEN REPEAT tac) ORELSE all_tac) st;
\<close>

text \<open>If @{text "tac"} can return multiple outcomes then so can @{ML
  REPEAT}~@{text "tac"}.  @{ML REPEAT} uses @{ML_op "ORELSE"} and not
  @{ML_op "APPEND"}, it applies @{text "tac"} as many times as
  possible in each outcome.

  \begin{warn}
  Note the explicit abstraction over the goal state in the ML
  definition of @{ML REPEAT}.  Recursive tacticals must be coded in
  this awkward fashion to avoid infinite recursion of eager functional
  evaluation in Standard ML.  The following attempt would make @{ML
  REPEAT}~@{text "tac"} loop:
  \end{warn}
\<close>

ML \<open>
  (*BAD -- does not terminate!*)
  fun REPEAT tac = (tac THEN REPEAT tac) ORELSE all_tac;
\<close>

subsection \<open>Applying tactics to subgoal ranges\<close>

text \<open>Tactics with explicit subgoal addressing
  @{ML_type "int -> tactic"} can be used together with tacticals that
  act like ``subgoal quantifiers'': guided by success of the body
  tactic a certain range of subgoals is covered.  Thus the body tactic
  is applied to \emph{all} subgoals, \emph{some} subgoal etc.

  Suppose that the goal state has @{text "n \<ge> 0"} subgoals.  Many of
  these tacticals address subgoal ranges counting downwards from
  @{text "n"} towards @{text "1"}.  This has the fortunate effect that
  newly emerging subgoals are concatenated in the result, without
  interfering each other.  Nonetheless, there might be situations
  where a different order is desired.\<close>

text %mlref \<open>
  \begin{mldecls}
  @{index_ML ALLGOALS: "(int -> tactic) -> tactic"} \\
  @{index_ML SOMEGOAL: "(int -> tactic) -> tactic"} \\
  @{index_ML FIRSTGOAL: "(int -> tactic) -> tactic"} \\
  @{index_ML HEADGOAL: "(int -> tactic) -> tactic"} \\
  @{index_ML REPEAT_SOME: "(int -> tactic) -> tactic"} \\
  @{index_ML REPEAT_FIRST: "(int -> tactic) -> tactic"} \\
  @{index_ML RANGE: "(int -> tactic) list -> int -> tactic"} \\
  \end{mldecls}

  \begin{description}

  \item @{ML ALLGOALS}~@{text "tac"} is equivalent to @{text "tac
  n"}~@{ML_op THEN}~@{text "\<dots>"}~@{ML_op THEN}~@{text "tac 1"}.  It
  applies the @{text tac} to all the subgoals, counting downwards.

  \item @{ML SOMEGOAL}~@{text "tac"} is equivalent to @{text "tac
  n"}~@{ML_op ORELSE}~@{text "\<dots>"}~@{ML_op ORELSE}~@{text "tac 1"}.  It
  applies @{text "tac"} to one subgoal, counting downwards.

  \item @{ML FIRSTGOAL}~@{text "tac"} is equivalent to @{text "tac
  1"}~@{ML_op ORELSE}~@{text "\<dots>"}~@{ML_op ORELSE}~@{text "tac n"}.  It
  applies @{text "tac"} to one subgoal, counting upwards.

  \item @{ML HEADGOAL}~@{text "tac"} is equivalent to @{text "tac 1"}.
  It applies @{text "tac"} unconditionally to the first subgoal.

  \item @{ML REPEAT_SOME}~@{text "tac"} applies @{text "tac"} once or
  more to a subgoal, counting downwards.

  \item @{ML REPEAT_FIRST}~@{text "tac"} applies @{text "tac"} once or
  more to a subgoal, counting upwards.

  \item @{ML RANGE}~@{text "[tac\<^sub>1, \<dots>, tac\<^sub>k] i"} is equivalent to
  @{text "tac\<^sub>k (i + k - 1)"}~@{ML_op THEN}~@{text "\<dots>"}~@{ML_op
  THEN}~@{text "tac\<^sub>1 i"}.  It applies the given list of tactics to the
  corresponding range of subgoals, counting downwards.

  \end{description}
\<close>

subsection \<open>Control and search tacticals\<close>

text \<open>A predicate on theorems @{ML_type "thm -> bool"} can test
  whether a goal state enjoys some desirable property --- such as
  having no subgoals.  Tactics that search for satisfactory goal
  states are easy to express.  The main search procedures,
  depth-first, breadth-first and best-first, are provided as
  tacticals.  They generate the search tree by repeatedly applying a
  given tactic.\<close>

text %mlref ""

subsubsection \<open>Filtering a tactic's results\<close>

text \<open>
  \begin{mldecls}
  @{index_ML FILTER: "(thm -> bool) -> tactic -> tactic"} \\
  @{index_ML CHANGED: "tactic -> tactic"} \\
  \end{mldecls}

  \begin{description}

  \item @{ML FILTER}~@{text "sat tac"} applies @{text "tac"} to the
  goal state and returns a sequence consisting of those result goal
  states that are satisfactory in the sense of @{text "sat"}.

  \item @{ML CHANGED}~@{text "tac"} applies @{text "tac"} to the goal
  state and returns precisely those states that differ from the
  original state (according to @{ML Thm.eq_thm}).  Thus @{ML
  CHANGED}~@{text "tac"} always has some effect on the state.

  \end{description}
\<close>

subsubsection \<open>Depth-first search\<close>

text \<open>
  \begin{mldecls}
  @{index_ML DEPTH_FIRST: "(thm -> bool) -> tactic -> tactic"} \\
  @{index_ML DEPTH_SOLVE: "tactic -> tactic"} \\
  @{index_ML DEPTH_SOLVE_1: "tactic -> tactic"} \\
  \end{mldecls}

  \begin{description}

  \item @{ML DEPTH_FIRST}~@{text "sat tac"} returns the goal state if
  @{text "sat"} returns true.  Otherwise it applies @{text "tac"},
  then recursively searches from each element of the resulting
  sequence.  The code uses a stack for efficiency, in effect applying
  @{text "tac"}~@{ML_op THEN}~@{ML DEPTH_FIRST}~@{text "sat tac"} to
  the state.

  \item @{ML DEPTH_SOLVE}@{text "tac"} uses @{ML DEPTH_FIRST} to
  search for states having no subgoals.

  \item @{ML DEPTH_SOLVE_1}~@{text "tac"} uses @{ML DEPTH_FIRST} to
  search for states having fewer subgoals than the given state.  Thus,
  it insists upon solving at least one subgoal.

  \end{description}
\<close>

subsubsection \<open>Other search strategies\<close>

text \<open>
  \begin{mldecls}
  @{index_ML BREADTH_FIRST: "(thm -> bool) -> tactic -> tactic"} \\
  @{index_ML BEST_FIRST: "(thm -> bool) * (thm -> int) -> tactic -> tactic"} \\
  @{index_ML THEN_BEST_FIRST: "tactic -> (thm -> bool) * (thm -> int) -> tactic -> tactic"} \\
  \end{mldecls}

  These search strategies will find a solution if one exists.
  However, they do not enumerate all solutions; they terminate after
  the first satisfactory result from @{text "tac"}.

  \begin{description}

  \item @{ML BREADTH_FIRST}~@{text "sat tac"} uses breadth-first
  search to find states for which @{text "sat"} is true.  For most
  applications, it is too slow.

  \item @{ML BEST_FIRST}~@{text "(sat, dist) tac"} does a heuristic
  search, using @{text "dist"} to estimate the distance from a
  satisfactory state (in the sense of @{text "sat"}).  It maintains a
  list of states ordered by distance.  It applies @{text "tac"} to the
  head of this list; if the result contains any satisfactory states,
  then it returns them.  Otherwise, @{ML BEST_FIRST} adds the new
  states to the list, and continues.

  The distance function is typically @{ML size_of_thm}, which computes
  the size of the state.  The smaller the state, the fewer and simpler
  subgoals it has.

  \item @{ML THEN_BEST_FIRST}~@{text "tac\<^sub>0 (sat, dist) tac"} is like
  @{ML BEST_FIRST}, except that the priority queue initially contains
  the result of applying @{text "tac\<^sub>0"} to the goal state.  This
  tactical permits separate tactics for starting the search and
  continuing the search.

  \end{description}
\<close>

subsubsection \<open>Auxiliary tacticals for searching\<close>

text \<open>
  \begin{mldecls}
  @{index_ML COND: "(thm -> bool) -> tactic -> tactic -> tactic"} \\
  @{index_ML IF_UNSOLVED: "tactic -> tactic"} \\
  @{index_ML SOLVE: "tactic -> tactic"} \\
  @{index_ML DETERM: "tactic -> tactic"} \\
  \end{mldecls}

  \begin{description}

  \item @{ML COND}~@{text "sat tac\<^sub>1 tac\<^sub>2"} applies @{text "tac\<^sub>1"} to
  the goal state if it satisfies predicate @{text "sat"}, and applies
  @{text "tac\<^sub>2"}.  It is a conditional tactical in that only one of
  @{text "tac\<^sub>1"} and @{text "tac\<^sub>2"} is applied to a goal state.
  However, both @{text "tac\<^sub>1"} and @{text "tac\<^sub>2"} are evaluated
  because ML uses eager evaluation.

  \item @{ML IF_UNSOLVED}~@{text "tac"} applies @{text "tac"} to the
  goal state if it has any subgoals, and simply returns the goal state
  otherwise.  Many common tactics, such as @{ML resolve_tac}, fail if
  applied to a goal state that has no subgoals.

  \item @{ML SOLVE}~@{text "tac"} applies @{text "tac"} to the goal
  state and then fails iff there are subgoals left.

  \item @{ML DETERM}~@{text "tac"} applies @{text "tac"} to the goal
  state and returns the head of the resulting sequence.  @{ML DETERM}
  limits the search space by making its argument deterministic.

  \end{description}
\<close>

subsubsection \<open>Predicates and functions useful for searching\<close>

text \<open>
  \begin{mldecls}
  @{index_ML has_fewer_prems: "int -> thm -> bool"} \\
  @{index_ML Thm.eq_thm: "thm * thm -> bool"} \\
  @{index_ML Thm.eq_thm_prop: "thm * thm -> bool"} \\
  @{index_ML size_of_thm: "thm -> int"} \\
  \end{mldecls}

  \begin{description}

  \item @{ML has_fewer_prems}~@{text "n thm"} reports whether @{text
  "thm"} has fewer than @{text "n"} premises.

  \item @{ML Thm.eq_thm}~@{text "(thm\<^sub>1, thm\<^sub>2)"} reports whether @{text
  "thm\<^sub>1"} and @{text "thm\<^sub>2"} are equal.  Both theorems must have the
  same conclusions, the same set of hypotheses, and the same set of sort
  hypotheses.  Names of bound variables are ignored as usual.

  \item @{ML Thm.eq_thm_prop}~@{text "(thm\<^sub>1, thm\<^sub>2)"} reports whether
  the propositions of @{text "thm\<^sub>1"} and @{text "thm\<^sub>2"} are equal.
  Names of bound variables are ignored.

  \item @{ML size_of_thm}~@{text "thm"} computes the size of @{text
  "thm"}, namely the number of variables, constants and abstractions
  in its conclusion.  It may serve as a distance function for
  @{ML BEST_FIRST}.

  \end{description}
\<close>

end


theory OpSem_ProofRules
imports Main OpSemSyntax_Def
begin

lemmas defs [simp] =  Rd_def Let_def Wr_def Upd_def st_rd_def val_rd_def

lemma read_pres_d_obs [simp]:
  assumes "wfs \<sigma>"
    and "[x =\<^sub>t u] \<sigma>"
  shows "[x =\<^sub>t u] (st_rd(Rd y t' b \<sigma>))"
 apply simp
  using assms(1) assms(2) ext_d_obs_rd_pres3 by blast

lemma read_pres_wfs [simp]:
  assumes "wfs \<sigma>"
  shows "wfs (st_rd(Rd x t b \<sigma>))"
  by (simp add: assms read_pres_wfs)

lemma write_pres_wfs [simp]:
  assumes "wfs \<sigma>"
  shows "wfs (Wr x v t b \<sigma>)"
  by (simp add: assms write_pres_wfs)

lemma update_pres_wfs [simp]:
  assumes "wfs \<sigma>"
  shows "wfs (st_rd(Upd x u t \<sigma>))"
  by (simp add: assms update_pres_wfs)

lemma ext_d_obs_d_obs [simp]:
  assumes "wfs \<sigma>"
      and "[x =\<^sub>t v] \<sigma>"
    shows"[x =\<^sub>t u] (Wr x u t b \<sigma>)"
  using assms
  apply simp
  using assms(1) assms(2) ext_d_obs_d_obs by blast

lemma ext_upd_d_obs_d_obs [simp]:
  assumes "wfs \<sigma>"
      and "[x =\<^sub>t v] \<sigma>"
    shows"[x =\<^sub>t u] (st_rd(Upd x u t \<sigma>))"
  apply simp
  using assms ext_upd_d_obs_d_obs by blast

lemma d_obs_read_value [simp]:
  assumes "wfs \<sigma>"
    and "[x =\<^sub>t u] \<sigma>"
  shows "val_rd(Rd x t False \<sigma>) = u"
  apply simp
  using assms(1) assms(2) d_obs_value by auto

lemma d_obs_diff_false [simp]:
  assumes  "[x =\<^sub>t u] \<sigma>"
and "[x =\<^sub>t' v] \<sigma>"
and "u \<noteq> v"
shows "False"
  using assms
  by (simp add: d_obs_def d_obs_t_def)

lemma OG_14 [simp]:
  assumes "wfs \<sigma>"
  and "[x =\<^sub>t u] \<sigma>"
  and "[x =\<^sub>t' v] \<sigma>"
   and "t \<noteq> t'"
  and "v \<noteq> u"
shows "[x =\<^sub>t u] (Wr x u t' False \<sigma>)"
  apply simp
  using OpSemExtProof.d_obs_diff_false assms(1) assms(2) assms(3) assms(5) by blast

lemma ext_write_other_pres_d_obs [simp]:
  assumes "wfs \<sigma>"
      and "[x =\<^sub>t u] \<sigma>"
      and "y \<noteq> x"
    shows"[x =\<^sub>t u] (Wr y v t' b \<sigma>)"
  by (simp add: assms(1) assms(2) assms(3) ext_write_other_pres_d_obs)

lemma not_p_obs_other_pres_not_p_obs [simp]:
  assumes "wfs \<sigma>"
      and "\<not>[x \<approx>\<^sub>t u] \<sigma>"
      and "y \<noteq> x"
    shows "\<not>[x \<approx>\<^sub>t u] (Wr y v t' b \<sigma>)"
  by (simp add: assms(1) assms(2) assms(3) not_p_obs_other_pres_not_p_obs)

lemma not_p_obs_write_pres_c_obs_diff_var [simp]:
  assumes "wfs \<sigma>"
  and "\<not>[x \<approx>\<^sub>t u] \<sigma>"
   and "t \<noteq> t'"
  and "x \<noteq> y"
  shows "[x = u]\<lparr>y =\<^sub>t v\<rparr> (Wr y z t' b \<sigma>)"
  by (simp add: assms(1) assms(2) assms(3) assms(4) not_p_obs_write_pres_c_obs_diff_var)

lemma ext_c_obs_intro [simp]:
  assumes "wfs \<sigma>"
  and "[y =\<^sub>t v] \<sigma>"
  and "\<not>[x \<approx>\<^sub>t' u] \<sigma>"
  and "x \<noteq> y"
  and "t \<noteq> t'"
  shows "[x = u]\<lparr>y =\<^sub>t' v\<rparr> (Wr x u t True \<sigma>)"
  by (simp add: assms(1) assms(2) assms(3) assms(4) assms(5) ext_c_obs_intro)

lemma c_obs_read_pres [simp]:
  assumes "wfs \<sigma>"
  and "[x = u]\<lparr>y =\<^sub>t v\<rparr> \<sigma>"
  shows "[x = u]\<lparr>y =\<^sub>t v\<rparr> (st_rd(Rd x t b \<sigma>))"
  by (simp add: assms(1) assms(2) c_obs_read_pres)

lemma c_obs_read_d_obs [simp]:
  assumes "wfs \<sigma>"
      and "[x = u]\<lparr>y =\<^sub>t v\<rparr> \<sigma>"
      and "val_rd(Rd x t True \<sigma>) = u"
    shows "[y =\<^sub>t v] (st_rd(Rd x t True \<sigma>))"
  using assms
  apply simp
  by (simp add: c_obs_read_d_obs)

lemma p_obs_write_2 [simp]:
  assumes "wfs \<sigma>"
  shows "[x \<approx>\<^sub>t u] (Wr x u t b \<sigma>)"
  using assms by simp

lemma not_p_obs_read [simp]:
  assumes "wfs \<sigma>"
and "\<not>[x \<approx>\<^sub>t u] \<sigma>"
shows "\<not>[x \<approx>\<^sub>t u] (st_rd(Rd y t b \<sigma>))"
  by (simp add: assms(1) assms(2)  not_p_obs_read)

lemma d_obs_diff_c_obs [simp]:
  assumes "[x =\<^sub>t z] \<sigma>"
    and "wfs \<sigma>"
  and "z \<noteq> u"
shows "[x = u]\<lparr>y =\<^sub>t v\<rparr> \<sigma>"
  using assms
  using d_obs_p_obs_agree not_p_obs_implies_c_obs by blast

lemma d_obs_not_p_obs [simp]:
  assumes "wfs \<sigma>"
and "[x =\<^sub>t z] \<sigma>"
  and "z \<noteq> u"
  shows "\<not>[x \<approx>\<^sub>t u] \<sigma>"
  using assms(1) assms(2) assms(3) d_obs_p_obs_agree by auto

lemma init_rd_pres [simp]:
  assumes "wfs \<sigma>"
  and " [init x u] \<sigma>"
    shows "[init x u]  (st_rd(Rd y t b \<sigma>))"
  by (simp add: assms(1) assms(2)  init_rd_pres)

lemma init_wr_pres [simp]:
  assumes "wfs \<sigma>"
  and " [init x u] \<sigma>"
    shows "[init x u] (Wr y v t b \<sigma>)"
    by (simp add: assms(1) assms(2)  init_wr_pres)

lemma init_upd_pres [simp]:
  assumes "wfs \<sigma>"
  and " [init x u] \<sigma>"
    shows "[init x u]  (st_rd(Upd y v t \<sigma>))"
  by (simp add: assms(1) assms(2) init_upd_pres)

lemma covered_wr_diif_var_pres [simp]:
  assumes "wfs \<sigma>"
  and "cvd[x, u] \<sigma>"
  and "x \<noteq> y"
  shows "cvd[x, u] (Wr y v t b \<sigma>)"
  by (simp add: assms(1) assms(2) assms(3)  covered_wr_diif_var_pres)

lemma c_obs_pres_write_diff_var_ext [simp]:
  assumes "wfs \<sigma>"
      and "[x = u]\<lparr>y =\<^sub>t v\<rparr> \<sigma>"
      and "x \<noteq> z"
      and "y \<noteq> z"
    shows "[x = u]\<lparr>y =\<^sub>t v\<rparr> (Wr z v t b \<sigma>)"
  by (simp add: assms(1) assms(2) assms(3) assms(4) c_obs_pres_write_diff_var_ext)

lemma covered_update_pres_ext [simp]:
  assumes "cvd[x, u] \<sigma>"
  and "wfs \<sigma>"
shows "cvd[x, v] (st_rd(Upd x v t \<sigma>))"
  apply simp
  using assms(1) assms(2) ext_cvd_update_cvd by auto

lemma update_diff_var_pres_dobs_ext [simp]:
  assumes "[x =\<^sub>t u] \<sigma>"
  and "wfs \<sigma>"
  and "y \<noteq> x"
shows "[x =\<^sub>t u] (st_rd(Upd y v t' \<sigma>))"
  by (simp add: assms(1) assms(2) assms(3) update_diff_var_pres_dobs_ext)

lemma ext_cvd_update_d_obs [simp]:
  assumes "wfs \<sigma>"
      and "[x = u]\<lparr>y =\<^sub>t v\<rparr> \<sigma>"
      and "cvd[x, u] \<sigma>"
      and "x \<noteq> y"
    shows "[y =\<^sub>t v] (st_rd(Upd x m t \<sigma>))"
  apply simp
  using assms(1) assms(2) assms(3) assms(4) ext_cvd_update_d_obs by blast

lemma ext_cvd_up_dobs [simp]:
  assumes  "cvd[x, u] \<sigma>"
    and "wfs \<sigma>"
    shows "[x =\<^sub>t v] (st_rd(Upd x v t \<sigma>))"
  apply simp
  using assms(1) assms(2) ext_cvd_up_dobs by blast

lemma ext_cvd_rd_pres [simp]:
     assumes  "cvd[x, u] \<sigma>"
    and "wfs \<sigma>"
    shows "cvd[x, u]  (st_rd(Rd y t b \<sigma>))"
  by (simp add: assms(1) assms(2)  ext_cvd_rd_pres)

lemma ext_c_obs_Up_intro [simp]:
  assumes  "wfs \<sigma>"
  and  "[y =\<^sub>t v] \<sigma>"
  and  " \<not> [x \<approx>\<^sub>t' u] \<sigma>"
  and  "x \<noteq> y"
  and "t' \<noteq> t"
shows "[x = u]\<lparr>y =\<^sub>t' v\<rparr> (st_rd(Upd x u t \<sigma>))"
  apply simp
  by (simp add: assms(1) assms(2) assms(3) assms(4) assms(5) ext_c_obs_Up_intro)

lemma ext_c_obs_rdx_pres [simp]:
  assumes  "wfs \<sigma>"
  and  "[x = u]\<lparr>y =\<^sub>t' v\<rparr> \<sigma>"
  and  "y \<noteq> x"
  and "t \<noteq> t'"
shows "[x = u]\<lparr>y =\<^sub>t' v\<rparr> (st_rd(Rd z t b \<sigma>))"
  by (simp add: assms(1) assms(2) assms(3) assms(4)  ext_c_obs_rdx_pres)

lemma ext_p_obs_contradiction [simp]:
  assumes "wfs \<sigma>"
and "\<not>[x \<approx>\<^sub>t u] \<sigma>"
and "x \<noteq> y"
and "[x \<approx>\<^sub>t u] (st_rd(Rd y t' b \<sigma>))"
shows "False"
  using assms apply simp
  using ext_p_obs_contradiction by blast

lemma ext_d_obs_rd_pres [simp]:
  assumes "wfs \<sigma>"
and "[x =\<^sub>t u] \<sigma>"
shows "[x =\<^sub>t u] (st_rd(Rd y t' b \<sigma>))"
  apply simp
  using assms(1) assms(2) ext_d_obs_rd_pres3 by auto

lemma ext_p_obs_rd_pres [simp]:
  assumes "wfs \<sigma>"
and "[x \<approx>\<^sub>t u] \<sigma>"
and " getVW \<sigma> t' y = w"
and "t \<noteq> t'"
shows "[x \<approx>\<^sub>t u] (st_rd(Rd y t' b \<sigma>))"
  using assms
  apply simp
  apply(unfold p_obs_def read_trans_def)
  apply(unfold rev_app_def Let_def update_thrView_def)
  apply(simp add: value_def)
  apply(case_tac "syncing \<sigma> w b")
   apply simp
   apply(unfold visible_writes_def writes_on_def, simp)
  by simp

lemma p_obs_contradiction [simp]:
  assumes "wfs \<sigma>"
  and "\<not> [x \<approx>\<^sub>t v] \<sigma>"
  and  "[x \<approx>\<^sub>t v] (st_rd(Rd y t' b \<sigma>))"
  shows "False"
  using assms
  apply simp
  apply(unfold p_obs_def read_trans_def)
  apply(unfold rev_app_def Let_def update_thrView_def)
  apply(simp add: value_def)
  using assms(2) assms(3) p_obs_contradiction by fastforce

lemma amo_intro:
  assumes "wfs \<sigma>"
    and "[\<zero>\<^sub>x u]\<^sub>i \<sigma>"
    and "getVWNC \<sigma> t x = w"
    and "getTS \<sigma> w = ts'"
    and "u \<noteq> i"
  shows "[\<one>\<^sub>x u] (write_trans t b w u \<sigma> ts')"
  using assms
  apply(simp add: no_val_def amo_def p_vorder_def value_def init_val_def)
  apply(simp add: write_trans_def rev_app_def update_mods_def update_wa_def update_modView_def update_thrView_def)
  apply(intro allI impI)
  apply(simp add: mo_def)
  apply(intro conjI impI allI)
    apply (subgoal_tac "var w = x")
     apply simp
     apply(elim conjE exE)
     apply(unfold writes_on_def)
 apply simp
     apply blast
    apply simp
  apply simp
   apply auto[1]
  apply simp
  by blast

lemma amo_intro_n [simp]:
  assumes "wfs \<sigma>"
    and "[\<zero>\<^sub>x u]\<^sub>i \<sigma>"
    and "u \<noteq> i"
  shows "[\<one>\<^sub>x u] (Wr x u t b \<sigma>)"
  apply simp
  using amo_intro assms(1) assms(2) assms(3) by auto

lemma amo_wr_pres :
  assumes "wfs \<sigma>"
    and "[\<one>\<^sub>x u] \<sigma>"
    and "w = getVWNC \<sigma> t x "
    and "ts' = getTS \<sigma> w"
    and "u \<noteq> v"
  shows "[\<one>\<^sub>x u] (write_trans t b w v \<sigma> ts')"
  using assms
  apply(simp add: no_val_def amo_def p_vorder_def value_def init_val_def)
  apply(intro allI impI)
  apply(simp add: mo_def)
  apply(simp add: write_trans_def rev_app_def update_mods_def update_wa_def update_modView_def update_thrView_def)
     apply(unfold writes_on_def)
  apply simp
  by (smt write_record.select_convs(1))

lemma amo_wr_pres_n [simp] :
  assumes "wfs \<sigma>"
    and "[\<one>\<^sub>x u] \<sigma>"
    and "u \<noteq> v"
  shows "[\<one>\<^sub>x u] (Wr x v t b \<sigma>)"
  apply simp
  by (simp add: amo_wr_pres assms(1) assms(2) assms(3))

lemma no_val_contradition:
  assumes "wfs \<sigma>"
and "[init x i] \<sigma>"
and "\<not>[\<zero>\<^sub>x u]\<^sub>i \<sigma>"
and "u \<noteq> i"
and "getVWNC \<sigma> t x = w"
and "getTS \<sigma> w = ts'"
and "[\<zero>\<^sub>x u]\<^sub>i (write_trans t b w v \<sigma> ts')"
shows "False"
  using assms
  apply(simp add: no_val_def p_vorder_def value_def mo_def init_val_def)
  apply(elim conjE exE impE)
  apply(subgoal_tac "var w = x")
  apply simp
   apply(elim disjE conjE)
    apply (metis  getVWNC_in_writes_on getTS_w_greater_tst_w order.asym w_in_writes_on_var w_not_in_writes_on)
  apply(simp add: write_trans_def rev_app_def update_mods_def update_wa_def update_modView_def update_thrView_def)
   apply(case_tac "bb = ts'")
  apply simp
  apply (meson w_not_in_writes_on)
   apply simp
   apply (smt w_not_in_writes_on)
  by (meson getVWNC_in_writes_on writes_on_var)

lemma no_val_contradition_n [simp]:
  assumes "wfs \<sigma>"
and "[init x i] \<sigma>"
and "\<not>[\<zero>\<^sub>x u]\<^sub>i \<sigma>"
and "u \<noteq> i"
and "[\<zero>\<^sub>x u]\<^sub>i (Wr x v t b \<sigma>)"
shows "False"
  using assms
  apply simp
  using no_val_contradition by blast

lemma no_val_contradition_auto [simp]:
  assumes "wfs \<sigma>"
and "[init x i] \<sigma>"
and "\<not>[\<zero>\<^sub>x u]\<^sub>i \<sigma>"
and "u \<noteq> i"
and "w = getVWNC \<sigma> t x "
and "ts' = getTS \<sigma> w "
and "[\<zero>\<^sub>x u]\<^sub>i (Wr x j t b \<sigma>)"
shows "[x  =\<^sub>t' z] (Wr x j t b \<sigma>)"
  using assms
  apply simp
  using no_val_contradition by blast

lemma no_val_contradiction2:
assumes "wfs \<sigma>"
and "[\<zero>\<^sub>x  u]\<^sub>i \<sigma>"
and "w = getVWNC \<sigma> t x"
and "ts'=  getTS \<sigma> w"
and "[\<zero>\<^sub>x u]\<^sub>i (write_trans t b w u \<sigma> ts')"
shows "False"
  using assms
  apply (simp add: no_val_def p_vorder_def mo_def value_def init_val_def)
  apply(simp add: write_trans_def rev_app_def update_mods_def update_wa_def update_modView_def update_thrView_def)
  apply (unfold writes_on_def, simp)
  apply(subgoal_tac "var w = x")
   apply simp
   apply(elim conjE exE)
   apply(case_tac "ba = ts'")
  apply simp
  apply (metis w_in_writes_on_var w_not_in_writes_on wfs_def)
   apply simp
   defer
   apply (simp add: getVWNC_var)
proof -
fix ba :: rat and baa :: rat
assume a1: "ts' = getTS \<sigma> (getVWNC \<sigma> t x)"
  assume a2: "w = getVWNC \<sigma> t x"
  assume a3: "\<forall>ba. (ba = getTS \<sigma> (getVWNC \<sigma> t x) \<longrightarrow> (\<forall>ba. val (if ba = getTS \<sigma> (getVWNC \<sigma> t x) then \<lparr>val = u, is_releasing = b\<rparr> else mods \<sigma> (x, ba)) = u \<longrightarrow> u = i \<longrightarrow> (x, ba) \<in> surrey_state.writes \<sigma> \<longrightarrow> \<not> getTS \<sigma> (getVWNC \<sigma> t x) < ba)) \<and> ((x, ba) \<in> surrey_state.writes \<sigma> \<longrightarrow> (\<forall>bb. val (if bb = getTS \<sigma> (getVWNC \<sigma> t x) then \<lparr>val = u, is_releasing = b\<rparr> else mods \<sigma> (x, bb)) = u \<longrightarrow> val (if ba = getTS \<sigma> (getVWNC \<sigma> t x) then \<lparr>val = u, is_releasing = b\<rparr> else mods \<sigma> (x, ba)) = i \<longrightarrow> (bb = getTS \<sigma> (getVWNC \<sigma> t x) \<longrightarrow> \<not> ba < getTS \<sigma> (getVWNC \<sigma> t x)) \<and> ((x, bb) \<in> surrey_state.writes \<sigma> \<longrightarrow> \<not> ba < bb)))"
  assume a4: "val (if baa = getTS \<sigma> (getVWNC \<sigma> t x) then \<lparr>val = u, is_releasing = b\<rparr> else mods \<sigma> (x, baa)) = i"
  assume a5: "\<forall>b. (b = getTS \<sigma> (getVWNC \<sigma> t x) \<longrightarrow> baa \<noteq> getTS \<sigma> (getVWNC \<sigma> t x) \<longrightarrow> baa < getTS \<sigma> (getVWNC \<sigma> t x)) \<and> ((x, b) \<in> surrey_state.writes \<sigma> \<longrightarrow> baa \<noteq> b \<longrightarrow> baa < b)"
  assume a6: "baa = getTS \<sigma> (getVWNC \<sigma> t x) \<or> (x, baa) \<in> surrey_state.writes \<sigma>"
  assume a7: "ba \<noteq> getTS \<sigma> (getVWNC \<sigma> t x)"
  assume a8: "(x, ba) \<in> surrey_state.writes \<sigma>"
  assume a9: "val (mods \<sigma> (x, ba)) = i"
  obtain bb :: bool where
    f10: "(\<not> bb) = (\<forall>X2. X2 \<noteq> ts' \<or> val (if X2 = ts' then \<lparr>val = u, is_releasing = b\<rparr> else mods \<sigma> (x, X2)) \<noteq> u)"
    by moura
have f11: "getTS \<sigma> w = ts'"
  using a2 a1 by meson
  obtain bba :: bool where
    f12: "(\<not> bba) = (\<forall>X1. (\<not> X1 < ts' \<or> (x, X1) \<notin> surrey_state.writes \<sigma>) \<or> val (if X1 = ts' then \<lparr>val = u, is_releasing = b\<rparr> else mods \<sigma> (x, X1)) \<noteq> i)"
    by moura
  then have f13: "\<not> bba \<or> \<not> bb"
    using f11 f10 a3 a2 by blast
  have f14: "val (if baa = ts' then \<lparr>val = u, is_releasing = b\<rparr> else mods \<sigma> (x, baa)) = i"
    using f11 a4 a2 by meson
  have "\<not> bba"
    using f13 f10 by simp
  then have f15: "ts' = baa"
    using f14 f12 f11 a6 a5 a2 by (metis (no_types))
  obtain bbb :: bool where
    f16: "(\<not> bbb) = (\<forall>X1. ((\<not> ts' < X1 \<or> (x, X1) \<notin> surrey_state.writes \<sigma>) \<or> i \<noteq> u) \<or> val (if X1 = ts' then \<lparr>val = u, is_releasing = b\<rparr> else mods \<sigma> (x, X1)) \<noteq> u)"
    by moura
then have "\<not> bbb"
using f11 a3 a2 by meson
  then show ?thesis
    using f16 f15 f14 f11 a9 a8 a7 a5 a2 by auto
qed

lemma no_val_contradition_auto2 [simp]:
assumes "wfs \<sigma>"
and "[\<zero>\<^sub>x  u]\<^sub>i \<sigma>"
and "w = getVWNC \<sigma> t x"
and "ts'=  getTS \<sigma> w"
and "[\<zero>\<^sub>x u]\<^sub>i (Wr x u t b \<sigma>)"
shows "[x  =\<^sub>t' z]  (Wr x u t b \<sigma>)"
  using assms
  apply simp
  using no_val_contradiction2 by blast

lemma amo_wr_pres_diff_var:
  assumes "wfs \<sigma>"
    and "[\<one>\<^sub>x u] \<sigma>"
    and "w = getVWNC \<sigma> t y "
    and "ts' = getTS \<sigma> w"
    and "y \<noteq> x"
  shows "[\<one>\<^sub>x u] (write_trans t b w v \<sigma> ts')"
  using assms
  apply(simp add: amo_def p_vorder_def value_def mo_def)
  apply(intro allI impI)
  apply(simp add: write_trans_def rev_app_def update_mods_def update_wa_def update_modView_def update_thrView_def)
  apply(unfold writes_on_def, simp)
  apply(subgoal_tac "var w = y", simp)
   apply blast
  using getVWNC_var by blast

lemma amo_wr_pres_diff_var_n [simp]:
  assumes "wfs \<sigma>"
    and "[\<one>\<^sub>x u] \<sigma>"
    and "y \<noteq> x"
  shows "[\<one>\<^sub>x u] (Wr y v t b \<sigma>)"
  apply simp
  using amo_wr_pres_diff_var assms(1) assms(2) assms(3) by auto

lemma amo_rd_pres [simp]:
  assumes "wfs \<sigma>"
    and "[\<one>\<^sub>x u] \<sigma>"
  shows "[\<one>\<^sub>x u] (st_rd(Rd y t b \<sigma>))"
  using assms
  by(simp add: amo_def p_vorder_def value_def)

lemma w_is: "wfs \<sigma> \<Longrightarrow> tst w = ts \<Longrightarrow> var w = x \<Longrightarrow> w = (x, ts)"
  using prod.exhaust_sel by blast

lemma enc_intro:
  assumes "wfs \<sigma>"
and "w = getVW \<sigma> t x"
and "value \<sigma> w = u"
shows "[en x u]\<^sub>t (read_trans t b w \<sigma>)"
  using assms
  apply (simp add: enc_t_def enc_def value_def)
  apply(subgoal_tac "var w  = x")
   defer
  using getVW_var apply blast
  apply(subgoal_tac "tst w =  tst (getVW \<sigma> t x)")
   defer
   apply clarsimp
    apply(subgoal_tac "w = (x, tst (getVW \<sigma> t x))")
   defer
    using w_is apply blast
  apply(rule_tac x = x in exI)
  apply(rule_tac x = "tst w" in exI)
    apply(intro conjI)
   using getVW_in_writes_on apply auto[1]
  apply(simp add: read_trans_def  rev_app_def update_mods_def update_wa_def update_modView_def update_thrView_def)
     apply (simp add: ts_oride_def)
    by simp

lemma enc_intro_n [simp]:
  assumes "wfs \<sigma>"
and " (val_rd(Rd x t b \<sigma>)) = u"
shows "[en x u]\<^sub>t (st_rd(Rd x t b \<sigma>))"
  apply simp
  using assms(1) assms(2) enc_intro by auto

lemma enc_c_obs_intro:
  assumes "wfs \<sigma>"
and "w = getVW \<sigma> t y"
and "[y = u]\<lparr>x =\<^sub>t v\<rparr> \<sigma>"
and "value \<sigma> w = u"
and "x \<noteq> y"
shows "[en x v]\<^sub>t (read_trans t True w \<sigma>)"
  using assms
  apply(simp add: c_obs_def enc_def enc_t_def value_def)
proof -
  assume a1: "w = getVW \<sigma> t y"
assume a2: "wfs \<sigma>"
  assume a3: "\<forall>w\<in>visible_writes \<sigma> t y. val (mods \<sigma> w) = u \<longrightarrow> d_obs \<sigma> (modView \<sigma> w) x v \<and> releasing \<sigma> w"
  assume a4: "val (mods \<sigma> (getVW \<sigma> t y)) = u"
  then have "\<exists>n. [x =\<^sub>t n] (read_trans t True w \<sigma>)"
    using a2 a1 OpSemExtProof.c_obs_read_d_obs assms(3) value_def by blast
  then show "\<exists>n r. (n, r) \<in> writes_on \<sigma> x \<and> r \<le> tst (thrView (read_trans t True (getVW \<sigma> t y) \<sigma>) t x) \<and> val (mods \<sigma> (n, r)) = v"
    using a4 a3 a2 a1 by (metis (no_types) d_obs_def d_obs_t_def getVW_in_vw lastWr_read_pres last_write_write_on old.prod.exhaust order_refl snd_conv value_def)
qed

lemma enc_c_obs_intro_n [simp]:
  assumes "wfs \<sigma>"
and "[y = u]\<lparr>x =\<^sub>t v\<rparr> \<sigma>"
and " (val_rd(Rd y t True \<sigma>)) = u"
and "x \<noteq> y"
shows "[en x v]\<^sub>t (st_rd(Rd y t True \<sigma>))"
  apply simp
  using assms(1) assms(2) assms(3) assms(4) enc_c_obs_intro by auto

lemma no_val_read_pres :
  assumes "wfs \<sigma>"
  and "[\<zero>\<^sub>x u]\<^sub>i \<sigma>"
  and "w = getVW \<sigma> t y"
shows "[\<zero>\<^sub>x u]\<^sub>i (read_trans t b w \<sigma>)"
  using assms
  apply(simp add: no_val_def p_vorder_def init_val_def mo_def value_def)
  done

lemma no_val_read_pres_n [simp] :
  assumes "wfs \<sigma>"
  and "[\<zero>\<^sub>x u]\<^sub>i \<sigma>"
  shows "[\<zero>\<^sub>x u]\<^sub>i (st_rd(Rd y t b \<sigma>))"
  apply simp
  by (simp add: assms(1) assms(2) no_val_read_pres)

lemma no_val_write_pres [simp]:
  assumes "wfs \<sigma>"
  and "[\<zero>\<^sub>x u]\<^sub>i \<sigma>"
  and "v \<noteq> u"
and "w = getVWNC \<sigma> t y"
and "ts' = getTS \<sigma> w"
 shows "[\<zero>\<^sub>x u]\<^sub>i (write_trans t b w v \<sigma> ts')"
  using assms
  apply(simp add: no_val_def p_vorder_def init_val_def mo_def value_def)
  apply(elim conjE exE, intro conjI)
   apply(rule_tac x = a in exI)
   apply(rule_tac x = ba in exI)
   apply(intro conjI)
  apply(case_tac "x = y")
      apply simp
     apply(unfold writes_on_def)

     apply(simp add: write_trans_def rev_app_def update_mods_def update_wa_def update_modView_def update_thrView_def)
     apply blast
     apply(simp add: write_trans_def rev_app_def update_mods_def update_wa_def update_modView_def update_thrView_def)
    apply (metis dual_order.strict_trans getVWNC_in_visible_writes getTS_w_greater_tst_w subsetD visible_writes_in_writes w_is)
     apply(simp add: write_trans_def rev_app_def update_mods_def update_wa_def update_modView_def update_thrView_def)

   apply (metis getVWNC_var w_in_writes_on_var w_not_in_writes_on wfs_def)
  apply(intro allI impI)
     apply(simp add: write_trans_def rev_app_def update_mods_def update_wa_def update_modView_def update_thrView_def)
  by (smt write_record.select_convs(1))

lemma no_val_write_pres_n [simp]:
  assumes "wfs \<sigma>"
      and "[\<zero>\<^sub>x u]\<^sub>i \<sigma>"
      and "v \<noteq> u"
  shows "[\<zero>\<^sub>x u]\<^sub>i (Wr y v t b \<sigma>)"
  apply simp
  by (simp add: assms(1) assms(2) assms(3))

lemma dvorder_intro:
  assumes "wfs \<sigma>"
and "[init x i] \<sigma>"
    and "[\<one>\<^sub>x u] \<sigma>"
    and "[en x u]\<^sub>t \<sigma>"
    and "[\<zero>\<^sub>x v]\<^sub>i \<sigma>"
and "[x =\<^sub>t u] \<sigma>"
and "w = getVWNC \<sigma> t x"
and "ts' = getTS \<sigma> w"
and "v \<noteq> u"
and "i \<noteq> u"
and "i \<noteq> v"
shows "[u \<hookrightarrow>\<^sub>x v] (write_trans t b w v \<sigma> ts')"
  using assms
    apply(subgoal_tac "var w = x")
   defer
   apply (simp add: getVWNC_var)
  apply(simp add: no_val_def init_val_def enc_t_def enc_def amo_def d_vorder_def p_vorder_def mo_def d_obs_t_def)
  apply(simp add: d_obs_def)
  apply(intro conjI allI impI)
    apply (metis w_in_writes_on_var)
  apply(elim conjE disjE)
      apply simp
  apply(simp add: value_def)
    apply(simp add: value_def)
     apply(simp add: write_trans_def rev_app_def update_mods_def update_wa_def update_modView_def update_thrView_def)
    apply(subgoal_tac "a = x")
     apply simp
  apply(case_tac "ba = getTS \<sigma> (getVWNC \<sigma> t x)")
      apply simp
  apply simp
     apply (metis dual_order.trans getVWNC_lastWr getTS_w_greater_tst_w last_write_max2 less_eq_rat_def not_less_iff_gr_or_eq)
  apply (meson w_in_writes_on_var)
   apply(simp add: value_def)
     apply(simp add: write_trans_def rev_app_def update_mods_def update_wa_def update_modView_def update_thrView_def)
  apply(case_tac "a = x \<and>
               ba = getTS \<sigma> (getVWNC \<sigma> t x)", simp)
  apply(case_tac "aa = x \<and>
               baa = getTS \<sigma> (getVWNC \<sigma> t x)", simp)
    apply (metis getVWNC_lastWr getts_greater_than last_write_max2)
  apply simp
   apply (metis w_in_writes_on_var w_is)
  apply (simp add: value_def)
  apply(rule_tac x = x in exI)
  apply simp
       apply(simp add: write_trans_def rev_app_def update_mods_def update_wa_def update_modView_def update_thrView_def)
  by (metis getVWNC_in_writes_on getVWNC_lastWr getts_greater_than w_is)

lemma dvorder_intro_n [simp]:
  assumes "wfs \<sigma>"
and "[init x i] \<sigma>"
    and "[\<one>\<^sub>x u] \<sigma>"
    and "[en x u]\<^sub>t \<sigma>"
    and "[\<zero>\<^sub>x v]\<^sub>i \<sigma>"
and "[x =\<^sub>t u] \<sigma>"
and "v \<noteq> u"
and "i \<noteq> u"
and "i \<noteq> v"
shows "[u \<hookrightarrow>\<^sub>x v] (Wr x v t b \<sigma>)"
  apply simp
  using assms(1) assms(2) assms(3) assms(4) assms(5) assms(6) assms(7) assms(8) assms(9) dvorder_intro by auto

lemma pvorder_intro:
  assumes "wfs \<sigma>"
    and "[en x u]\<^sub>t \<sigma>"
and "w = getVW \<sigma> t x"
and "value \<sigma> w \<noteq> u"
shows "[u \<leadsto>\<^sub>x (value \<sigma> w)] (read_trans t b w \<sigma>)"
  using assms
  apply(simp add: enc_t_def enc_def p_vorder_def  mo_def)
  apply (subgoal_tac "var w = x")
  defer
  using getVW_var apply blast
  apply(elim exE conjE)
  apply (subgoal_tac "a = x")
  defer

  using w_in_writes_on_var apply blast
  apply simp
  apply(rule_tac x = x in exI)
  apply(rule_tac x = "ba" in exI)
  apply(intro conjI)

  apply blast
  apply(rule_tac x = "tst w" in exI)
  apply(simp add: value_def)
  apply(intro conjI)

  using getVW_in_writes_on w_is apply fastforce

  using w_is apply fastforce
  apply(simp add: getVW_def obsW_def visible_writes_def)
  by (smt assms(3) dual_order.antisym dual_order.trans getVW_in_vw mem_Collect_eq not_le_imp_less prod.collapse val_rd_def visible_writes_def writes_on_var)

lemma pvorder_intro_n [simp]:
  assumes "wfs \<sigma>"
    and "[en x u]\<^sub>t \<sigma>"
and "(val_rd(Rd x t b \<sigma>)) \<noteq> u"
shows "[u \<leadsto>\<^sub>x (val_rd(Rd x t b \<sigma>))](st_rd(Rd x t b \<sigma>))"
  using assms
  apply simp
  using pvorder_intro by blast

lemma no_val_contradiction:
  assumes "wfs \<sigma>"
and "[\<zero>\<^sub>x u]\<^sub>i \<sigma>"
and "w = getVWNC \<sigma> t x"
and "ts' = getTS \<sigma> w"
and "[\<zero>\<^sub>x u]\<^sub>i (write_trans t b w u \<sigma> ts')"
shows "False"
  using assms
  apply(simp add: no_val_def p_vorder_def init_val_def value_def mo_def)
  apply(elim conjE exE)
  apply(unfold writes_on_def)
 apply(simp add: write_trans_def rev_app_def update_mods_def update_wa_def update_modView_def update_thrView_def)
  apply(subgoal_tac "var w = x", simp)
   apply(case_tac "ba = ts'")
    apply simp
   apply(case_tac "baa = ts'")
  apply simp
     apply (metis w_in_writes_on_var w_not_in_writes_on wfs_def)
    apply force
   apply(case_tac "baa = ts'")
  apply simp
    apply force
   apply simp
  apply(elim conjE)
   defer
  apply (simp add: getVWNC_var)
proof -
fix a :: nat and aa :: nat and ba :: rat and baa :: rat
  assume a1: "ts' = getTS \<sigma> (getVWNC \<sigma> t x)"
  assume "w = getVWNC \<sigma> t x"
  assume a2: "\<forall>ba. (ba = getTS \<sigma> (getVWNC \<sigma> t x) \<longrightarrow> (\<forall>ba. val (if ba = getTS \<sigma> (getVWNC \<sigma> t x) then \<lparr>val = u, is_releasing = b\<rparr> else mods \<sigma> (x, ba)) = u \<longrightarrow> u = i \<longrightarrow> (x, ba) \<in> surrey_state.writes \<sigma> \<longrightarrow> \<not> getTS \<sigma> (getVWNC \<sigma> t x) < ba)) \<and> ((x, ba) \<in> surrey_state.writes \<sigma> \<longrightarrow> (\<forall>bb. val (if bb = getTS \<sigma> (getVWNC \<sigma> t x) then \<lparr>val = u, is_releasing = b\<rparr> else mods \<sigma> (x, bb)) = u \<longrightarrow> val (if ba = getTS \<sigma> (getVWNC \<sigma> t x) then \<lparr>val = u, is_releasing = b\<rparr> else mods \<sigma> (x, ba)) = i \<longrightarrow> (bb = getTS \<sigma> (getVWNC \<sigma> t x) \<longrightarrow> \<not> ba < getTS \<sigma> (getVWNC \<sigma> t x)) \<and> ((x, bb) \<in> surrey_state.writes \<sigma> \<longrightarrow> \<not> ba < bb)))"
  assume a3: "\<forall>b. (b = getTS \<sigma> (getVWNC \<sigma> t x) \<longrightarrow> baa < getTS \<sigma> (getVWNC \<sigma> t x)) \<and> ((x, b) \<in> surrey_state.writes \<sigma> \<longrightarrow> baa \<noteq> b \<longrightarrow> baa < b)"
  assume a4: "(aa, baa) \<in> surrey_state.writes \<sigma>"
  assume a5: "aa = x"
  assume a6: "val (mods \<sigma> (x, baa)) = i"
  assume a7: "baa \<noteq> getTS \<sigma> (getVWNC \<sigma> t x)"
  obtain bb :: bool where
    "(\<not> bb) = (\<forall>X2. X2 \<noteq> ts' \<or> val (if X2 = ts' then \<lparr>val = u, is_releasing = b\<rparr> else mods \<sigma> (x, X2)) \<noteq> u)"
    by moura
  then show ?thesis
using a7 a6 a5 a4 a3 a2 a1 by fastforce
qed

lemma no_val_contradiction_n [simp]:
  assumes "wfs \<sigma>"
and "[\<zero>\<^sub>x u]\<^sub>i \<sigma>"
and "[\<zero>\<^sub>x u]\<^sub>i (Wr x u t b \<sigma>)"
shows "False"
  using assms apply simp
  using no_val_contradiction2 by blast

lemma no_val_d_vorder_contradiction [simp]:
  assumes "wfs \<sigma>"
  and "[\<zero>\<^sub>x u]\<^sub>i \<sigma>"
  and "[u \<hookrightarrow>\<^sub>x  v] \<sigma>"
  and "u \<noteq> v"
  and "i\<noteq>u"
  and " i\<noteq>v"
  shows "False"
  using assms
  apply(simp add: no_val_def d_vorder_def p_vorder_def init_val_def value_def)
  apply(elim conjE)
  by metis

lemma no_val_d_vorder_contradiction_auto [simp]:
  assumes "wfs \<sigma>"
  and "[\<zero>\<^sub>x u]\<^sub>i \<sigma>"
  and "[u \<hookrightarrow>\<^sub>x  v] \<sigma>"
  and "u \<noteq> v"
  and "i\<noteq>u"
  and " i\<noteq>v"
shows "[u \<hookrightarrow>\<^sub>x v] (Wr y z t b \<sigma>)"
  apply simp
  using assms(1) assms(2) assms(3) assms(4) assms(5) assms(6) no_val_d_vorder_contradiction by blast

lemma d_vorder_wr_diff_var_pres:
  assumes "wfs \<sigma>"
and "w = getVWNC \<sigma> t y"
and "ts' = getTS \<sigma> w"
and "[u \<hookrightarrow>\<^sub>x  v] \<sigma>"
and "x \<noteq> y"
shows "[u \<hookrightarrow>\<^sub>x  v] (write_trans t b w z \<sigma> ts')"
  using assms
  apply(simp add: d_vorder_def p_vorder_def value_def)
  apply(intro conjI allI impI, elim conjE)
   apply(unfold mo_def)
   apply(intro conjI)
    apply (metis writes_on_var)
   apply(subgoal_tac "a = x")
   apply(subgoal_tac "aa = x")
     apply(unfold writes_on_def)
  apply(simp add: write_trans_def rev_app_def update_mods_def update_wa_def update_modView_def update_thrView_def)
  apply (simp add: getVWNC_var)
  using w_in_writes_on_var writes_on_def apply blast
  using w_in_writes_on_var writes_on_def apply blast
  apply(simp add: write_trans_def rev_app_def update_mods_def update_wa_def update_modView_def update_thrView_def)
  by (simp add: getVWNC_var)

lemma d_vorder_wr_diff_var_pres_n [simp]:
  assumes "wfs \<sigma>"
and "w = getVWNC \<sigma> t y"
and "ts' = getTS \<sigma> w"
and "[u \<hookrightarrow>\<^sub>x  v] \<sigma>"
and "x \<noteq> y"
shows "[u \<hookrightarrow>\<^sub>x  v] (Wr y z t b \<sigma>)"
  by (simp add: assms(1) assms(4) assms(5) d_vorder_wr_diff_var_pres)

lemma enc_wr_prs:
  assumes "wfs \<sigma>"
    and "[en x u]\<^sub>t \<sigma>"
    and "w = getVWNC \<sigma> t' y"
    and "ts = getTS \<sigma> w"
  shows "[en x u]\<^sub>t (write_trans t' b w v \<sigma> ts)"
  using assms
  apply(simp add: enc_t_def enc_def value_def)
  apply(elim exE conjE)
   apply(rule_tac x = a in exI)
  apply(rule_tac x = ba in exI)
  apply(intro conjI)
    apply simp
  apply(case_tac "t \<noteq> t'")
   apply simp
   apply simp
  apply(simp add: getVWNC_def getTS_def vws_def vfs_def)
   apply(intro impI)
  apply (smt assms(3) assms(4) dual_order.trans getVWNC_in_visible_writes getVWNC_var getTS_w_greater_tst_w less_imp_le mem_Collect_eq visible_writes_def)
  apply(simp add: getVWNC_def getTS_def vws_def vfs_def)
  apply(case_tac "t \<noteq> t'")
   apply(case_tac "x = y")
    apply simp
  apply(simp add: write_trans_def rev_app_def update_mods_def update_wa_def update_modView_def update_thrView_def)
    apply (metis assms(3) assms(4) w_in_writes_on_var w_not_in_writes_on)
  apply(simp add: write_trans_def rev_app_def update_mods_def update_wa_def update_modView_def update_thrView_def)
   apply (metis assms(3) getVWNC_var w_in_writes_on_var)
  apply(simp add: write_trans_def rev_app_def update_mods_def update_wa_def update_modView_def update_thrView_def)
  by (metis assms(1) assms(3) assms(4) getVWNC_in_writes_on w_in_writes_on_var w_not_in_writes_on  writes_on_var)

lemma enc_wr_prs_n [simp]:
  assumes "wfs \<sigma>"
    and "[en x u]\<^sub>t \<sigma>"
  shows "[en x u]\<^sub>t (Wr y v t' b \<sigma>)"
  apply simp
  by (simp add: assms(1) assms(2) enc_wr_prs)

lemma enc_rd_prs:
  assumes "wfs \<sigma>"
    and "[en x u]\<^sub>t \<sigma>"
    and "getVW \<sigma> t' y = w"
  shows "[en x u]\<^sub>t (read_trans t' b w \<sigma>)"
  using assms
  apply(simp add: enc_t_def enc_def value_def)
  apply(elim exE conjE)
   apply(rule_tac x = a in exI)
  apply(rule_tac x = ba in exI)
  apply(intro conjI)
    apply simp
   defer
   apply simp
  apply(case_tac "t \<noteq> t'")
   apply simp
  apply simp
  apply (case_tac "\<not>syncing \<sigma> w b")
   apply simp
   apply(intro impI)
   apply(simp add: getVW_def obsW_def)
  apply (smt assms(3) dual_order.trans getVW_in_vw getVW_var mem_Collect_eq visible_writes_def)
  apply simp
  apply(simp add: getVW_def obsW_def ts_oride_def)

  by (smt assms(3) dual_order.trans getVW_in_vw getVW_var mem_Collect_eq visible_writes_def)

lemma enc_rd_prs_n [simp]:
  assumes "wfs \<sigma>"
    and "[en x u]\<^sub>t \<sigma>"
  shows "[en x u]\<^sub>t (st_rd(Rd y t' b \<sigma>))"
  apply simp
  by (simp add: assms(1) assms(2) enc_rd_prs)

lemma no_val_rd_contradiction [simp]:
  "wfs \<sigma> \<Longrightarrow>  \<not>[\<zero>\<^sub>x  u]\<^sub>i \<sigma> \<Longrightarrow> [\<zero>\<^sub>x  u]\<^sub>i (st_rd(Rd y t b \<sigma>)) \<Longrightarrow> False"
  apply(simp add: no_val_def init_val_def p_vorder_def value_def)
  by blast

lemma p_vorder_wr_pres:
  assumes "wfs \<sigma>"
and "[u \<leadsto>\<^sub>x v] \<sigma>"
and "w = getVWNC \<sigma> t y"
and "ts' = getTS \<sigma> w"
shows "[u \<leadsto>\<^sub>x v] (write_trans t b w z \<sigma> ts')"
  using assms
  apply(simp add: p_vorder_def mo_def value_def)
  apply(elim exE conjE)
    apply(simp add: write_trans_def rev_app_def update_wa_def update_modView_def update_thrView_def update_mods_def)
   apply(rule_tac x = a in exI)
  apply(rule_tac x = ba in exI)
  apply (intro conjI)

  apply (metis getVWNC_var w_in_writes_on_var w_not_in_writes_on)
  apply(unfold writes_on_def)
  apply simp
  by (metis getVWNC_var w_in_writes_on_var w_not_in_writes_on wfs_def)

lemma p_vorder_wr_pres_n [simp]:
  assumes "wfs \<sigma>"
and "[u \<leadsto>\<^sub>x v] \<sigma>"
shows "[u \<leadsto>\<^sub>x v] (Wr y z t b \<sigma>)"
  apply simp
  by (simp add: assms(1) assms(2) p_vorder_wr_pres)

lemma p_vorder_rd_pres [simp]:
  assumes "wfs \<sigma>"
and "[u \<leadsto>\<^sub>x v] \<sigma>"
shows "[u \<leadsto>\<^sub>x v] (st_rd(Rd y t b \<sigma>))"
  using assms
  by(simp add: p_vorder_def mo_def value_def)

lemma d_vorder_rd_prs [simp]:
  assumes "wfs \<sigma>"
and "[u \<hookrightarrow>\<^sub>x v] \<sigma>"
shows "[u \<hookrightarrow>\<^sub>x v]  (st_rd(Rd y t b \<sigma>))"
  using assms
  apply(simp add: d_vorder_def p_vorder_def value_def)
  done

lemma dorder_porder_contradiction [simp]:
  assumes "wfs \<sigma>"
  and "u \<noteq> v"
  and " [u \<hookrightarrow>\<^sub>x v] \<sigma>"
  and " [v \<leadsto>\<^sub>x u] \<sigma> "
  shows "False"
  using assms
  apply (simp add: init_val_def amo_def p_vorder_def d_vorder_def)
  apply(unfold  mo_def)
  by (meson not_less_iff_gr_or_eq)

lemma p_obs_contradiction_auto [simp]:
  assumes "wfs \<sigma>"
and "\<not>[x \<approx>\<^sub>t u] \<sigma>"
and "w = getVW \<sigma> t' x"
and "[x \<approx>\<^sub>t u]  (st_rd(Rd x t' b \<sigma>))"
shows "False"
  using assms
  apply simp
  using OpSemExtProof.p_obs_contradiction by blast

lemma wr_enc_intro [simp]:
  assumes "wfs \<sigma>"
shows "[en x u]\<^sub>t (Wr x u t b \<sigma>)"
  using assms
  apply(simp add: enc_t_def enc_def)
    apply(simp add: write_trans_def rev_app_def update_wa_def update_modView_def update_thrView_def update_mods_def value_def)
  apply(intro conjI impI)
   apply blast
  by (metis  getVWNC_var)

lemma p_vorder_contradiction [simp]:
  assumes "wfs \<sigma>"
and "[\<one>\<^sub>x u] \<sigma>"
and "[\<one>\<^sub>x v] \<sigma>"
and "[u \<leadsto>\<^sub>x v] \<sigma>"
and "[v \<leadsto>\<^sub>x  u] \<sigma>"
shows " False"
  using assms
  apply(simp add: amo_def p_vorder_def value_def mo_def)
  by (metis dual_order.asym less_linear w_in_writes_on_var)

lemma not_pobs_contradiction [simp]:
  assumes "wfs \<sigma>"
and "\<not>[x \<approx>\<^sub>t u] \<sigma>"
and "val_rd (Rd x t b \<sigma>) = u"
shows "False"
  using assms
  by (simp add: not_p_obs_value)

end


(*
    Author:      Norbert Schirmer
    Maintainer:  Norbert Schirmer, norbert.schirmer at web de
    License:     LGPL
*)

(*  Title:      XVcgEx.thy
    Author:     Norbert Schirmer, TU Muenchen

Copyright (C) 2006-2008 Norbert Schirmer
Some rights reserved, TU Muenchen

This library is free software; you can redistribute it and/or modify
it under the terms of the GNU Lesser General Public License as
published by the Free Software Foundation; either version 2.1 of the
License, or (at your option) any later version.

This library is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
USA
*)

section "Examples for Parallel Assignments"

theory XVcgEx
imports "../XVcg"

begin

record "globals" =
  "G_'"::"nat"
  "H_'"::"nat"

record 'g vars = "'g state" +
  A_' :: nat
  B_' :: nat
  C_' :: nat
  I_' :: nat
  M_' :: nat
  N_' :: nat
  R_' :: nat
  S_' :: nat
  Arr_' :: "nat list"
  Abr_':: string

term "BASIC
         \<acute>A :== x,
         \<acute>B :== y
      END"

term "BASIC
         \<acute>G :== \<acute>H,
         \<acute>H :== \<acute>G
      END"

term "BASIC
        LET (x,y) = (\<acute>A,b);
            z = \<acute>B
        IN \<acute>A :== x,
           \<acute>G :== \<acute>A + y + z
      END"

lemma "\<Gamma>\<turnstile> \<lbrace>\<acute>A = 0\<rbrace>
      \<lbrace>\<acute>A < 0\<rbrace> \<longmapsto> BASIC
       LET (a,b,c) = foo \<acute>A
       IN
            \<acute>A :== a,
            \<acute>B :== b,
            \<acute>C :== c
      END
      \<lbrace>\<acute>A = x \<and> \<acute>B = y \<and> \<acute>C = c\<rbrace>"
apply vcg
oops

lemma "\<Gamma>\<turnstile> \<lbrace>\<acute>A = 0\<rbrace>
      \<lbrace>\<acute>A < 0\<rbrace> \<longmapsto> BASIC
       LET (a,b,c) = foo \<acute>A
       IN
            \<acute>A :== a,
            \<acute>G :== b + \<acute>B,
            \<acute>H :== c
      END
      \<lbrace>\<acute>A = x \<and> \<acute>G = y \<and> \<acute>H = c\<rbrace>"
apply vcg
oops

definition foo:: "nat \<Rightarrow> (nat \<times> nat \<times> nat)"
  where "foo n = (n,n+1,n+2)"

lemma "\<Gamma>\<turnstile> \<lbrace>\<acute>A = 0\<rbrace>
      \<lbrace>\<acute>A < 0\<rbrace> \<longmapsto> BASIC
       LET (a,b,c) = foo \<acute>A
       IN
            \<acute>A :== a,
            \<acute>G :== b + \<acute>B,
            \<acute>H :== c
      END
      \<lbrace>\<acute>A = x \<and> \<acute>G = y \<and> \<acute>H = c\<rbrace>"
apply (vcg add: foo_def snd_conv fst_conv)
oops

end


theory "ConstantStorage"

imports
   "InstructionAux" "../../ProgramInAvl"

begin

declare stack_1_1_op_def [simp del]
declare jump_def [simp del]
(*
declare cut_memory.simps [simp del]
*)

theorem lemma_stack_2_1_op :
"stack_2_1_op v c f = InstructionContinue nv \<Longrightarrow>
 vctx_storage v = vctx_storage nv"
apply(auto)
apply(cases "vctx_stack v")
apply(auto)
apply(cases "tl (vctx_stack v)")
apply(auto split:option.split)
done

theorem lemma_stack_3_1_op :
"stack_3_1_op v c f = InstructionContinue nv \<Longrightarrow>
 vctx_storage v = vctx_storage nv"
apply(auto)
apply(cases "vctx_stack v")
apply(auto)
apply(cases "tl (vctx_stack v)")
apply(simp)
apply(cases "tl (tl (vctx_stack v))")
apply(simp)
apply(auto)
done

theorem lemma_stack_1_1_op :
"stack_1_1_op v c f = InstructionContinue nv \<Longrightarrow>
 vctx_storage v = vctx_storage nv"
apply(auto simp:stack_1_1_op_def)
apply(cases "vctx_stack v")
apply(auto split:option.split)
done

theorem lemma_jump [simp] :
"jump v c = InstructionContinue nv \<Longrightarrow>
 vctx_storage v = vctx_storage nv"
apply(auto simp:jump_def)
apply(cases "vctx_stack v")
apply(auto)
apply(cases "program_content (cctx_program c)
                   (uint (hd (vctx_stack v)))")
apply auto
apply(cases "get_some (program_content (cctx_program c)
                   (uint (hd (vctx_stack v))))")
apply auto
apply(cases "get_pc (program_content (cctx_program c)
                   (uint (hd (vctx_stack v))))")
apply auto
done

theorem lemma_jump_foo [simp] :
"jump (v\<lparr>vctx_stack := a # lista\<rparr>) c = InstructionContinue nv \<Longrightarrow>
 vctx_storage v = vctx_storage nv"
apply(auto simp:jump_def)
apply(cases "program_content (cctx_program c)
                   (uint a)")
apply auto
apply(cases "get_some (program_content (cctx_program c)
                   (uint a))")
apply auto
apply(cases "get_pc (program_content (cctx_program c)
                   (uint a))")
apply auto
done

theorem no_modify_storage_aux :
  "inst \<noteq> Storage SSTORE \<Longrightarrow>
   instruction_aux v c inst = InstructionContinue nv \<Longrightarrow>
   vctx_storage v = vctx_storage nv"
apply(cases inst)
apply(auto simp:instruction_aux_def)
apply(cases "get_bits (Some inst)",
   auto simp:lemma_stack_2_1_op lemma_stack_3_1_op lemma_stack_1_1_op)
apply(cases "get_sarith (Some inst)",
   auto simp:lemma_stack_2_1_op lemma_stack_3_1_op lemma_stack_1_1_op)
apply(cases "get_arith (Some inst)",
   auto simp:lemma_stack_2_1_op lemma_stack_3_1_op lemma_stack_1_1_op)

apply(auto simp:sha3_def)
apply(cases "vctx_stack v")
apply(auto)
apply(cases "tl (vctx_stack v)")
apply(auto split:option.split)
apply(cases "get_info (Some inst)")
apply(auto simp:lemma_stack_2_1_op lemma_stack_3_1_op lemma_stack_1_1_op)
apply(cases "index (vctx_stack v) (nat (uint (get_dup (Some inst))))")
apply(auto split:option.split)
apply(cases "get_memory (Some inst)")
apply(auto)
apply(cases "vctx_stack v")
apply(auto split:option.split)
apply(cases "vctx_stack v")
apply(auto)
apply(cases "tl (vctx_stack v)")
apply(auto split:option.split)
apply(cases "vctx_stack v")
apply(auto)
apply(cases "tl (vctx_stack v)")
apply(auto split:option.split)
apply(cases "vctx_stack v")
apply(auto)
apply(cases "tl (vctx_stack v)")
apply(auto)
apply(cases "tl (tl (vctx_stack v))")
apply(auto split:option.split)
apply(cases "vctx_stack v")
apply(auto)
apply(cases "tl (vctx_stack v)")
apply(auto)
apply(cases "tl (tl (vctx_stack v))")
apply(auto split:option.split)
apply(cases "vctx_stack v")
apply(auto)
apply(cases "tl (vctx_stack v)")
apply(auto)
apply(cases "tl (tl (vctx_stack v))")
apply(auto)
apply(cases "tl (tl (tl (vctx_stack v)))")
apply(auto split:option.split)
apply(cases "get_storage (Some inst)")
apply(auto simp:lemma_stack_2_1_op lemma_stack_3_1_op lemma_stack_1_1_op)
apply(cases "get_pc (Some inst)")
apply(auto)
apply(cases "vctx_stack v")
apply(auto)
apply(cases "tl (vctx_stack v)")
apply(auto simp:strict_if_def split:option.split)
apply(cases "hd (tl (vctx_stack v)) = 0")
apply(auto simp:blockedInstructionContinue_def split:option.split)

apply(cases "get_stack inst")
apply(auto simp:lemma_stack_2_1_op lemma_stack_3_1_op lemma_stack_1_1_op)
apply(cases "vctx_stack v")
apply(auto split:option.split)
apply(cases "index (vctx_stack v)
              (nat (uint (get_swap (Some inst))))")
apply(auto split:option.split)
apply(cases "index (vctx_stack v) (Suc (nat (uint (get_swap (Some inst)))))")
apply(auto split:option.split)
apply(cases "index (vctx_stack v) 0")
apply(auto split:option.split)
apply(cases "get_log (Some inst)")
apply(auto)
apply(cases "get_misc (Some inst)")
apply(auto)
apply(cases "vctx_stack v")
apply(auto)
apply(cases "tl (vctx_stack v)")
apply(auto)
apply(cases "tl (tl (vctx_stack v))")
apply(auto)
apply(cases "vctx_balance v (cctx_this c) < hd (vctx_stack v)")
apply(auto)

apply(cases "vctx_stack v")
apply(simp)
apply(cases "tl (vctx_stack v)")
apply(simp)
apply(cases "tl (tl (vctx_stack v))")
apply(simp)
apply(cases "tl (tl (tl (vctx_stack v)))")
apply(simp)
apply(cases "tl (tl (tl (tl (vctx_stack v))))")
apply(simp)
apply(cases "tl (tl (tl (tl (tl (vctx_stack v)))))")
apply(simp)
apply(cases "tl (tl (tl (tl (tl (tl (vctx_stack v))))))")
apply(auto)
apply(cases "vctx_balance v (cctx_this c) <
    hd (tl (tl (vctx_stack v)))")
apply(auto)
apply(cases "vctx_stack v")
apply(auto)
apply(cases "tl (vctx_stack v)")
apply(auto)
apply(cases "tl (tl (vctx_stack v))")
apply(auto)
apply(cases "tl (tl (tl (vctx_stack v)))")
apply(auto)
apply(cases "tl (tl (tl (tl (vctx_stack v))))")
apply(auto)
apply(cases "tl (tl (tl (tl (tl (vctx_stack v)))))")
apply(auto)
apply(cases "tl (tl (tl (tl (tl (tl (vctx_stack v))))))")
apply(auto)
apply(cases "vctx_balance v (cctx_this c) <
    hd (tl (tl (vctx_stack v)))")
apply(auto)
apply(cases "vctx_stack v")
apply(auto)
apply(cases "tl (vctx_stack v)")
apply(auto)
apply(cases "tl (tl (vctx_stack v))")
apply(auto)
apply(cases "tl (tl (tl (vctx_stack v)))")
apply(auto)
apply(cases "tl (tl (tl (tl (vctx_stack v))))")
apply(auto)
apply(cases "tl (tl (tl (tl (tl (vctx_stack v)))))")
apply(auto)
apply(cases "vctx_balance v (cctx_this c) <
    vctx_value_sent v")
apply(auto)
apply(cases "vctx_stack v")
apply(auto)
apply(cases "tl (vctx_stack v)")
apply(auto)
apply(cases "vctx_stack v")
apply(auto)
done

lemma lemma_subtract :
  "subtract_gas x (InstructionContinue v) = InstructionContinue nv \<Longrightarrow>
   vctx_storage v = vctx_storage nv"
apply auto
done

theorem no_modify_storage :
  "inst \<noteq> Storage SSTORE \<Longrightarrow>
   instruction_sem v c inst = InstructionContinue nv \<Longrightarrow>
   vctx_storage v = vctx_storage nv"
apply(subst (asm) inst_gas)
apply(cases "instruction_aux v c inst")
defer
apply(simp)
apply(simp)
  by (metis lemma_subtract no_modify_storage_aux)

end


(*  Title:      WhileGraphSSA.thy
    Author:     Denis Lohner, Sebastian Ullrich
*)

subsubsection {* Instantiation for a Simple While Language *}

theory WhileGraphSSA imports
SingleInstruction_CFG
"$AFP/Slicing/While/AdditionalLemmas"
"~~/src/HOL/Library/List_lexord"
"~~/src/HOL/Library/Char_ord"
begin

instantiation w_node :: ord
begin

fun less_eq_w_node where
  "(_Entry_) \<le> x = True"
| "(_ n _) \<le> x = (case x of
     (_Entry_) \<Rightarrow> False
   | (_ m _) \<Rightarrow> n \<le> m
   | (_Exit_) \<Rightarrow> True)"
| "(_Exit_) \<le> x = (x = (_Exit_))"

fun less_w_node where
  "(_Entry_) < x = (x \<noteq> (_Entry_))"
| "(_ n _) < x = (case x of
     (_Entry_) \<Rightarrow> False
   | (_ m _) \<Rightarrow> n < m
   | (_Exit_) \<Rightarrow> True)"
| "(_Exit_) < x = False"

instance ..
end

instance w_node :: linorder proof
  fix x y z :: w_node

  show "x \<le> x" by (cases x) auto
  show "x \<le> y \<or> y \<le> x" by (cases x) (cases y, auto)+
  show "x < y \<longleftrightarrow> x \<le> y \<and> \<not> y \<le> x" by (cases x) (cases y, auto)+

  assume "x \<le> y" and "y \<le> z"
  thus "x \<le> z" by (cases x, cases y, cases z) auto

  assume "x \<le> y" and "y \<le> x"
  thus "x = y" by (cases x) (cases y, auto)+
qed

declare Defs.simps [simp del]
declare Uses.simps [simp del]
declare Let_def [simp]

declare finite_valid_nodes [simp, intro!]

lemma finite_valid_edge [simp, intro!]: "finite (Collect (valid_edge c))"
  unfolding valid_edge_def [abs_def]
apply (rule inj_on_finite [where f="\<lambda>(f,d,t). (f,t)" and B="Collect (valid_node c) \<times> Collect (valid_node c)"])
  apply (rule inj_onI)
  apply (auto intro: WCFG_edge_det)[1]
 apply (force simp: valid_node_def valid_edge_def)[1]
by auto

lemma uses_expr_finite: "finite (rhs_aux e)"
  by (induction e) auto

lemma uses_cmd_finite: "finite (rhs c)"
  by (induction c) (auto intro: uses_expr_finite)

lemma defs_cmd_finite: "finite (lhs c)"
  by (induction c) auto

lemma finite_labels': "finite {(l,c). labels prog l c}"
proof -
  have "{l. \<exists>c. labels prog l c} = fst ` {(l,c). labels prog l c}"
    by auto
  with finite_labels [of prog] labels_det [of prog] show ?thesis
    by (auto 4 4 intro: inj_onI dest: finite_imageD)
qed

lemma finite_Uses [simp, intro!]: "finite (Uses c n)"
  unfolding Uses.simps
apply clarsimp
apply (rule_tac B="\<Union>(rhs ` snd ` {(l,c'). labels c l c'})" in finite_subset)
 apply fastforce
apply (rule finite_Union)
 apply (rule finite_imageI)+
 apply (rule finite_labels')
by (clarsimp simp: uses_cmd_finite)

definition "while_cfg_\<alpha>e c = Collect (valid_edge c)"
definition "while_cfg_\<alpha>n c = sorted_list_of_set (Collect (valid_node c))"
definition "while_cfg_predecessors c t = (SOME ls. distinct ls \<and> set ls = {sourcenode e| e. valid_edge c e \<and> targetnode e = t})"
definition "while_cfg_Entry c = (_Entry_)"
definition "while_cfg_defs c = (Defs c)((_Entry_) := {v. \<exists>n. v \<in> Uses c n})"
definition "while_cfg_uses c = Uses c"

abbreviation "while_cfg_inEdges c t \<equiv> map (\<lambda>f. (f,(),t)) (while_cfg_predecessors c t)"

lemmas while_cfg_defs = while_cfg_\<alpha>e_def while_cfg_\<alpha>n_def
  while_cfg_predecessors_def
  while_cfg_Entry_def while_cfg_defs_def
  while_cfg_uses_def

interpretation while: graph_path "while_cfg_\<alpha>n c" "while_cfg_predecessors c"
  for c :: cmd
apply unfold_locales
apply (simp_all add: while_cfg_defs graph_path_base.\<alpha>e_def)[5]
    apply (rule finite_subset [OF _ finite_imageI [OF finite_valid_edge [of "c"], where h="\<lambda>(f,d,t). (f,(),t)"]])
    apply clarsimp
    using sorted_list_of_set [of "{n. \<exists>a. valid_edge c (n, a, m)}" for m]
    apply (erule_tac x=m in meta_allE)
    apply (erule meta_impE)
     apply (rule finite_subset [OF _ finite_valid_nodes [of "c"]])
     apply (fastforce simp: valid_node_def)
    apply (case_tac "n \<in> {n. \<exists>a. valid_edge c (n, a, m)}")
     prefer 2
     apply clarsimp
     apply (subgoal_tac "n \<notin> set (SOME ls. distinct ls \<and> set ls = {n. \<exists>a. valid_edge c (n, a, m)})")
      apply simp
     apply (rule_tac a="sorted_list_of_set {n. \<exists>a. valid_edge c (n, a, m)}" in someI2)
      using sorted_list_of_set [of "{n. \<exists>a. valid_edge c (n, a, m)}" for m]
      apply (erule_tac x=m in meta_allE)
      apply (erule meta_impE)
       apply (rule finite_subset [OF _ finite_valid_nodes [of "c"]])
       apply (fastforce simp: valid_node_def)
      apply simp
     apply fastforce
    apply (fastforce intro: rev_image_eqI)
   apply clarsimp
   apply (case_tac "n \<in> {n. \<exists>a. valid_edge c (n, a, m)}")
    prefer 2
    apply clarsimp
    apply (subgoal_tac "n \<notin> set (SOME ls. distinct ls \<and> set ls = {n. \<exists>a. valid_edge c (n, a, m)})")
     apply simp
    apply (rule_tac a="sorted_list_of_set {n. \<exists>a. valid_edge c (n, a, m)}" in someI2)
     using sorted_list_of_set [of "{n. \<exists>a. valid_edge c (n, a, m)}" for m]
     apply (erule_tac x=m in meta_allE)
     apply (erule meta_impE)
      apply (rule finite_subset [OF _ finite_valid_nodes [of "c"]])
      apply (fastforce simp: valid_node_def)
     apply simp
    apply fastforce
   apply (fastforce simp: valid_node_def)
  apply clarsimp
  apply (case_tac "n \<in> {n. \<exists>a. valid_edge c (n, a, m)}")
   prefer 2
   apply clarsimp
   apply (subgoal_tac "n \<notin> set (SOME ls. distinct ls \<and> set ls = {n. \<exists>a. valid_edge c (n, a, m)})")
    apply simp
   apply (rule_tac a="sorted_list_of_set {n. \<exists>a. valid_edge c (n, a, m)}" in someI2)
    using sorted_list_of_set [of "{n. \<exists>a. valid_edge c (n, a, m)}" for m]
    apply (erule_tac x=m in meta_allE)
    apply (erule meta_impE)
     apply (rule finite_subset [OF _ finite_valid_nodes [of "c"]])
     apply (fastforce simp: valid_node_def)
    apply simp
   apply fastforce
  apply (fastforce simp: valid_node_def)
 apply (rule set_iterator_I)
   prefer 3 apply (simp add: foldri_def)
  apply simp
 apply simp
apply (clarsimp simp: Graph_path.pred_def graph_path_base_base.inEdges_def)
apply (subgoal_tac "{(v', w). (v', (), v) \<in> graph_path_base.\<alpha>e (while_cfg_predecessors c)}
  = set (map (\<lambda>m. (m, ())) (while_cfg_predecessors c v))")
 apply (simp only:)
 apply (rule set_iterator_foldri_correct)
 apply (clarsimp simp: while_cfg_predecessors_def distinct_map)
 using sorted_list_of_set [of "{n. \<exists>a. valid_edge c (n, a, v)}" for v]
 apply (erule_tac x=v in meta_allE)
 apply (erule meta_impE)
  apply (rule finite_subset [OF _ finite_valid_nodes [of "c"]])
  apply (fastforce simp: valid_node_def)
 apply (rule someI2 [where a="sorted_list_of_set {n. \<exists>a. valid_edge c (n, a, v)}" for v])
  apply fastforce
 apply simp
by (auto simp: graph_path_base.\<alpha>e_def)

definition "gen_while_cfg c \<equiv> \<lparr>
  gen_\<alpha>n = while_cfg_\<alpha>n c,
  gen_predecessors = while_cfg_predecessors c,
  gen_Entry = while_cfg_Entry c,
  gen_defs = while_cfg_defs c,
  gen_uses = while_cfg_uses c
\<rparr>"

lemma  while_path_graph_pathD: "While_CFG.path c n es m \<Longrightarrow> while.path2 c n (n#map targetnode es) m"
  unfolding while.path2_def
apply (induction n es m rule: While_CFG.path.induct)
 apply clarsimp
 apply (rule while.path.intros)
 apply (auto 4 4 simp: while_cfg_defs valid_node_def While_CFG.valid_node_def)[1]
apply clarsimp
apply (rule while.path.intros)
 apply assumption
apply clarsimp
apply (subst while_cfg_predecessors_def)
apply (rename_tac n ed m)
apply (rule_tac a="sorted_list_of_set {sourcenode e |e. valid_edge c e \<and> targetnode e = m}" in someI2)
 using sorted_list_of_set [of "{sourcenode e |e. valid_edge c e \<and> targetnode e = m}" for m]
 apply (erule_tac x=m in meta_allE)
 apply (erule meta_impE)
  apply (rule finite_subset [OF _ finite_valid_nodes [of "c"]])
  apply (clarsimp simp: valid_node_def)
  apply (rule_tac x=x in exI)
  apply (rule_tac x=a in exI)
  apply (rule_tac x=m in exI)
  apply simp
 apply simp
apply clarsimp
by (rule exI)

lemma Uses_Entry [simp]: "Uses c (_Entry_) = {}"
  unfolding Uses.simps by auto

lemma in_Uses_valid_node: "V \<in> Uses c n \<Longrightarrow> valid_node c n"
  by (auto dest!: label_less_num_inner_nodes less_num_nodes_edge
    simp: Uses.simps valid_node_def valid_edge_def)

interpretation while_SI_CFG_wf:
  SingleInstruction_CFG_wf "while_cfg_\<alpha>n cmd" "while_cfg_predecessors cmd" "while_cfg_Entry cmd" "while_cfg_defs cmd" "while_cfg_uses cmd"
  for cmd
apply unfold_locales
       apply (clarsimp simp: while_cfg_defs)
       using WCFG_intros(1) valid_edge_def valid_node_def apply auto[1]
      apply (clarsimp simp: while_cfg_defs)
      apply (subgoal_tac "{n. \<exists>a. valid_edge (cmd) (n, a, (_Entry_))} = {}")
       apply auto[1]
      apply auto[1]
     apply (subst(asm) while_cfg_\<alpha>n_def)
     apply simp
     apply (drule valid_node_Entry_path)
     apply clarsimp
     apply (drule while_path_graph_pathD)
     apply (auto simp: while_cfg_Entry_def)[1]
    apply (clarsimp simp: while_cfg_defs)
   apply (subgoal_tac "{v. \<exists>n. v \<in> Uses (cmd) n} = (\<Union>n \<in> Collect (valid_node (cmd)). Uses (cmd) n)")
    apply simp
   apply (auto dest: in_Uses_valid_node)[1]
  apply (auto dest!: label_less_num_inner_nodes less_num_nodes_edge
    simp: Uses.simps valid_node_def valid_edge_def while_cfg_defs)[1]
 apply (clarsimp simp: while_cfg_defs)
apply (clarsimp simp: SSA_CFG.CFG_wf_axioms_def CFG_base.defAss'_def)
apply (rule_tac x="(_Entry_)" in bexI)
 apply (auto simp: while_cfg_defs)[1]
apply (cut_tac xs=ns in hd_in_butlast)
 apply (erule while.path2_cases)
  apply (auto simp: while_cfg_Entry_def while_cfg_uses_def dest: while.path2_not_Nil3 "while.path2_hd")
done

lift_definition si_while_cfg_wf :: "cmd \<Rightarrow> (w_node, vname) si_cfg_wf"
  is gen_while_cfg
  unfolding gen_while_cfg_def
  by simp unfold_locales

definition "build_ssa cmd = gen_ssa_wf_notriv_substAll (gen_ssa_cfg_wf (si_wf_disj_cfg_wf (si_while_cfg_wf cmd)))"

end