(*  Title:       Refutational Inference Systems
    Author:      Jasmin Blanchette <j.c.blanchette at vu.nl>, 2014, 2017
    Author:      Dmitriy Traytel <traytel at inf.ethz.ch>, 2014
    Author:      Anders Schlichtkrull <andschl at dtu.dk>, 2017
    Maintainer:  Anders Schlichtkrull <andschl at dtu.dk>
*)

section \<open>Refutational Inference Systems\<close>

theory Inference_System
  imports Herbrand_Interpretation
begin

text \<open>
This theory gathers results from Section 2.4 (``Refutational Theorem Proving''), 3 (``Standard
Resolution''), and 4.2 (``Counterexample-Reducing Inference Systems'') of Bachmair and Ganzinger's
chapter.
\<close>

subsection \<open>Preliminaries\<close>

text \<open>
Inferences have one distinguished main premise, any number of side premises, and a conclusion.
\<close>

datatype 'a inference =
  Infer (side_prems_of: "'a clause multiset") (main_prem_of: "'a clause") (concl_of: "'a clause")

abbreviation prems_of :: "'a inference \<Rightarrow> 'a clause multiset" where
  "prems_of \<gamma> \<equiv> side_prems_of \<gamma> + {#main_prem_of \<gamma>#}"

abbreviation concls_of :: "'a inference set \<Rightarrow> 'a clause set" where
  "concls_of \<Gamma> \<equiv> concl_of ` \<Gamma>"

(* FIXME: make an abbreviation *)
definition infer_from :: "'a clause set \<Rightarrow> 'a inference \<Rightarrow> bool" where
  "infer_from CC \<gamma> \<longleftrightarrow> set_mset (prems_of \<gamma>) \<subseteq> CC"

locale inference_system =
  fixes \<Gamma> :: "'a inference set"
begin

definition inferences_from :: "'a clause set \<Rightarrow> 'a inference set" where
  "inferences_from CC = {\<gamma>. \<gamma> \<in> \<Gamma> \<and> infer_from CC \<gamma>}"

definition inferences_between :: "'a clause set \<Rightarrow> 'a clause \<Rightarrow> 'a inference set" where
  "inferences_between CC C = {\<gamma>. \<gamma> \<in> \<Gamma> \<and> infer_from (CC \<union> {C}) \<gamma> \<and> C \<in># prems_of \<gamma>}"

lemma inferences_from_mono: "CC \<subseteq> DD \<Longrightarrow> inferences_from CC \<subseteq> inferences_from DD"
  unfolding inferences_from_def infer_from_def by fast

definition saturated :: "'a clause set \<Rightarrow> bool" where
  "saturated N \<longleftrightarrow> concls_of (inferences_from N) \<subseteq> N"

lemma saturatedD:
  assumes
    satur: "saturated N" and
    inf: "Infer CC D E \<in> \<Gamma>" and
    cc_subs_n: "set_mset CC \<subseteq> N" and
    d_in_n: "D \<in> N"
  shows "E \<in> N"
proof -
  have "Infer CC D E \<in> inferences_from N"
    unfolding inferences_from_def infer_from_def using inf cc_subs_n d_in_n by simp
  then have "E \<in> concls_of (inferences_from N)"
    unfolding image_iff by (metis inference.sel(3))
  then show "E \<in> N"
    using satur unfolding saturated_def by blast
qed

end

text \<open>
Satisfiability preservation is a weaker requirement than soundness.
\<close>

locale sat_preserving_inference_system = inference_system +
  assumes \<Gamma>_sat_preserving: "satisfiable N \<Longrightarrow> satisfiable (N \<union> concls_of (inferences_from N))"

locale sound_inference_system = inference_system +
  assumes \<Gamma>_sound: "Infer CC D E \<in> \<Gamma> \<Longrightarrow> I \<Turnstile>m CC \<Longrightarrow> I \<Turnstile> D \<Longrightarrow> I \<Turnstile> E"
begin

lemma \<Gamma>_sat_preserving:
  assumes sat_n: "satisfiable N"
  shows "satisfiable (N \<union> concls_of (inferences_from N))"
proof -
  obtain I where i: "I \<Turnstile>s N"
    using sat_n by blast
  then have "\<And>CC D E. Infer CC D E \<in> \<Gamma> \<Longrightarrow> set_mset CC \<subseteq> N \<Longrightarrow> D \<in> N \<Longrightarrow> I \<Turnstile> E"
    using \<Gamma>_sound unfolding true_clss_def true_cls_mset_def by (simp add: subset_eq)
  then have "\<And>\<gamma>. \<gamma> \<in> \<Gamma> \<Longrightarrow> infer_from N \<gamma> \<Longrightarrow> I \<Turnstile> concl_of \<gamma>"
    unfolding infer_from_def by (case_tac \<gamma>) clarsimp
  then have "I \<Turnstile>s concls_of (inferences_from N)"
    unfolding inferences_from_def image_def true_clss_def infer_from_def by blast
  then have "I \<Turnstile>s N \<union> concls_of (inferences_from N)"
    using i by simp
  then show ?thesis
    by blast
qed

sublocale sat_preserving_inference_system
  by unfold_locales (erule \<Gamma>_sat_preserving)

end

locale reductive_inference_system = inference_system \<Gamma> for \<Gamma> :: "('a :: wellorder) inference set" +
  assumes \<Gamma>_reductive: "\<gamma> \<in> \<Gamma> \<Longrightarrow> concl_of \<gamma> < main_prem_of \<gamma>"

subsection \<open>Refutational Completeness\<close>

text \<open>
Refutational completeness can be established once and for all for counterexample-reducing inference
systems. The material formalized here draws from both the general framework of Section 4.2 and the
concrete instances of Section 3.
\<close>

locale counterex_reducing_inference_system =
  inference_system \<Gamma> for \<Gamma> :: "('a :: wellorder) inference set" +
  fixes I_of :: "'a clause set \<Rightarrow> 'a interp"
  assumes \<Gamma>_counterex_reducing:
    "{#} \<notin> N \<Longrightarrow> D \<in> N \<Longrightarrow> \<not> I_of N \<Turnstile> D \<Longrightarrow> (\<And>C. C \<in> N \<Longrightarrow> \<not> I_of N \<Turnstile> C \<Longrightarrow> D \<le> C) \<Longrightarrow>
     \<exists>CC E. set_mset CC \<subseteq> N \<and> I_of N \<Turnstile>m CC \<and> Infer CC D E \<in> \<Gamma> \<and> \<not> I_of N \<Turnstile> E \<and> E < D"
begin

lemma ex_min_counterex:
  fixes N :: "('a :: wellorder) clause set"
  assumes "\<not> I \<Turnstile>s N"
  shows "\<exists>C \<in> N. \<not> I \<Turnstile> C \<and> (\<forall>D \<in> N. D < C \<longrightarrow> I \<Turnstile> D)"
proof -
  obtain C where "C \<in> N" and "\<not> I \<Turnstile> C"
    using assms unfolding true_clss_def by auto
  then have c_in: "C \<in> {C \<in> N. \<not> I \<Turnstile> C}"
    by blast
  show ?thesis
    using wf_eq_minimal[THEN iffD1, rule_format, OF wf_less_multiset c_in] by blast
qed

(* Theorem 4.4 (generalizes Theorems 3.9 and 3.16) *)

theorem saturated_model:
  assumes
    satur: "saturated N" and
    ec_ni_n: "{#} \<notin> N"
  shows "I_of N \<Turnstile>s N"
proof -
  have ec_ni_n: "{#} \<notin> N"
    using ec_ni_n by auto

  {
    assume "\<not> I_of N \<Turnstile>s N"
    then obtain D where
      d_in_n: "D \<in> N" and
      d_cex: "\<not> I_of N \<Turnstile> D" and
      d_min: "\<And>C. C \<in> N \<Longrightarrow> C < D \<Longrightarrow> I_of N \<Turnstile> C"
      by (meson ex_min_counterex)
    then obtain CC E where
      cc_subs_n: "set_mset CC \<subseteq> N" and
      inf_e: "Infer CC D E \<in> \<Gamma>" and
      e_cex: "\<not> I_of N \<Turnstile> E" and
      e_lt_d: "E < D"
      using \<Gamma>_counterex_reducing[OF ec_ni_n] not_less by metis
    from cc_subs_n inf_e have "E \<in> N"
      using d_in_n satur by (blast dest: saturatedD)
    then have False
      using e_cex e_lt_d d_min not_less by blast
  }
  then show ?thesis
    by satx
qed

text \<open>
Cf. Corollary 3.10:
\<close>

corollary saturated_complete: "saturated N \<Longrightarrow> \<not> satisfiable N \<Longrightarrow> {#} \<in> N"
  using saturated_model by blast

end

subsection \<open>Compactness\<close>

text \<open>
Bachmair and Ganzinger claim that compactness follows from refutational completeness but leave the
proof to the readers' imagination. Our proof relies on an inductive definition of saturation in
terms of a base set of clauses.
\<close>

context inference_system
begin

inductive_set saturate :: "'a clause set \<Rightarrow> 'a clause set" for CC :: "'a clause set" where
  base: "C \<in> CC \<Longrightarrow> C \<in> saturate CC"
| step: "Infer CC' D E \<in> \<Gamma> \<Longrightarrow> (\<And>C'. C' \<in># CC' \<Longrightarrow> C' \<in> saturate CC) \<Longrightarrow> D \<in> saturate CC \<Longrightarrow>
    E \<in> saturate CC"

lemma saturate_mono: "C \<in> saturate CC \<Longrightarrow> CC \<subseteq> DD \<Longrightarrow> C \<in> saturate DD"
  by (induct rule: saturate.induct) (auto intro: saturate.intros)

lemma saturated_saturate[simp, intro]: "saturated (saturate N)"
  unfolding saturated_def inferences_from_def infer_from_def image_def
  by clarify (rename_tac x, case_tac x, auto elim!: saturate.step)

lemma saturate_finite: "C \<in> saturate CC \<Longrightarrow> \<exists>DD. DD \<subseteq> CC \<and> finite DD \<and> C \<in> saturate DD"
proof (induct rule: saturate.induct)
  case (base C)
  then have "{C} \<subseteq> CC" and "finite {C}" and "C \<in> saturate {C}"
    by (auto intro: saturate.intros)
  then show ?case
    by blast
next
  case (step CC' D E)
  obtain DD_of where
    "\<And>C. C \<in># CC' \<Longrightarrow> DD_of C \<subseteq> CC \<and> finite (DD_of C) \<and> C \<in> saturate (DD_of C)"
    using step(3) by metis
  then have
    "(\<Union>C \<in> set_mset CC'. DD_of C) \<subseteq> CC"
    "finite (\<Union>C \<in> set_mset CC'. DD_of C) \<and> set_mset CC' \<subseteq> saturate (\<Union>C \<in> set_mset CC'. DD_of C)"
    by (auto intro: saturate_mono)
  then obtain DD where
    d_sub: "DD \<subseteq> CC" and d_fin: "finite DD" and in_sat_d: "set_mset CC' \<subseteq> saturate DD"
    by blast
  obtain EE where
    e_sub: "EE \<subseteq> CC" and e_fin: "finite EE" and in_sat_ee: "D \<in> saturate EE"
    using step(5) by blast
  have "DD \<union> EE \<subseteq> CC"
    using d_sub e_sub step(1) by fast
  moreover have "finite (DD \<union> EE)"
    using d_fin e_fin by fast
  moreover have "E \<in> saturate (DD \<union> EE)"
    using in_sat_d in_sat_ee step.hyps(1)
    by (blast intro: inference_system.saturate.step saturate_mono)
  ultimately show ?case
    by blast
qed

end

context sound_inference_system
begin

theorem saturate_sound: "C \<in> saturate CC \<Longrightarrow> I \<Turnstile>s CC \<Longrightarrow> I \<Turnstile> C"
  by (induct rule: saturate.induct) (auto simp: true_cls_mset_def true_clss_def \<Gamma>_sound)

end

context sat_preserving_inference_system
begin

text \<open>
This result surely holds, but we have yet to prove it. The challenge is: Every time a new clause is
introduced, we also get a new interpretation (by the definition of
\<open>sat_preserving_inference_system\<close>). But the interpretation we want here is then the one that
exists "at the limit". Maybe we can use compactness to prove it.
\<close>

theorem saturate_sat_preserving: "satisfiable CC \<Longrightarrow> satisfiable (saturate CC)"
  oops

end

locale sound_counterex_reducing_inference_system =
  counterex_reducing_inference_system + sound_inference_system
begin

text \<open>
Compactness of clausal logic is stated as Theorem 3.12 for the case of unordered ground resolution.
The proof below is a generalization to any sound counterexample-reducing inference system. The
actual theorem will become available once the locale has been instantiated with a concrete inference
system.
\<close>

theorem clausal_logic_compact:
  fixes N :: "('a :: wellorder) clause set"
  shows "\<not> satisfiable N \<longleftrightarrow> (\<exists>DD \<subseteq> N. finite DD \<and> \<not> satisfiable DD)"
proof
  assume "\<not> satisfiable N"
  then have "{#} \<in> saturate N"
    using saturated_complete saturated_saturate saturate.base unfolding true_clss_def by meson
  then have "\<exists>DD \<subseteq> N. finite DD \<and> {#} \<in> saturate DD"
    using saturate_finite by fastforce
  then show "\<exists>DD \<subseteq> N. finite DD \<and> \<not> satisfiable DD"
    using saturate_sound by auto
next
  assume "\<exists>DD \<subseteq> N. finite DD \<and> \<not> satisfiable DD"
  then show "\<not> satisfiable N"
    by (blast intro: true_clss_mono)
qed

end

end


(*
    Author:      Salomon Sickert
    License:     BSD
*)

section \<open>Auxiliary Map Facts\<close>

theory Map2
  imports Main
begin

lemma map_of_tabulate:
  "map_of (map (\<lambda>x. (x, f x)) xs) x \<noteq> None \<longleftrightarrow> x \<in> set xs"
  by (induct xs) auto

lemma map_of_tabulate_simp:
  "map_of (map (\<lambda>x. (x, f x)) xs) x = (if x \<in> set xs then Some (f x) else None)"
  by (metis (mono_tags, lifting) comp_eq_dest_lhs map_of_map_restrict restrict_map_def)

lemma dom_map_update:
  "dom (m (k \<mapsto> v)) = dom m \<union> {k}"
  by simp

lemma map_equal:
  "dom m = dom m' \<Longrightarrow> (\<And>x. x \<in> dom m \<Longrightarrow> m x = m' x) \<Longrightarrow> m = m'"
  by fastforce

end


(*  Title:       Inductive definition of Hoare logic for total correctness
    Author:      Tobias Nipkow, 2001/2006
    Maintainer:  Tobias Nipkow
*)

theory HoareTotal imports Hoare Termi begin

subsection{* Hoare logic for total correctness *}

text{*
Now that we have termination, we can define
total validity, @{text"\<Turnstile>\<^sub>t"}, as partial validity and guaranteed termination:*}

definition
 hoare_tvalid :: "assn \<Rightarrow> com \<Rightarrow> assn \<Rightarrow> bool" ("\<Turnstile>\<^sub>t {(1_)}/ (_)/ {(1_)}" 50) where
  "\<Turnstile>\<^sub>t {P}c{Q} \<longleftrightarrow> \<Turnstile> {P}c{Q} \<and> (\<forall>s. P s \<longrightarrow> c\<down>s)"

text{* Proveability of Hoare triples in the proof system for total
correctness is written @{text"\<turnstile>\<^sub>t {P}c{Q}"} and defined
inductively. The rules for @{text"\<turnstile>\<^sub>t"} differ from those for
@{text"\<turnstile>"} only in the one place where nontermination can arise: the
@{term While}-rule. *}

inductive
  thoare :: "assn \<Rightarrow> com \<Rightarrow> assn \<Rightarrow> bool" ("\<turnstile>\<^sub>t ({(1_)}/ (_)/ {(1_)})" 50)
where
  Do:  "\<turnstile>\<^sub>t {\<lambda>s. (\<forall>t \<in> f s. P t) \<and> f s \<noteq> {}} Do f {P}"
| Semi: "\<lbrakk> \<turnstile>\<^sub>t {P}c{Q}; \<turnstile>\<^sub>t {Q}d{R} \<rbrakk> \<Longrightarrow> \<turnstile>\<^sub>t {P} c;d {R}"
| If: "\<lbrakk> \<turnstile>\<^sub>t {\<lambda>s. P s \<and> b s}c{Q}; \<turnstile>\<^sub>t {\<lambda>s. P s \<and> ~b s}d{Q}  \<rbrakk> \<Longrightarrow>
      \<turnstile>\<^sub>t {P} IF b THEN c ELSE d {Q}"
| While:
  "\<lbrakk>wf r;  \<forall>s'. \<turnstile>\<^sub>t {\<lambda>s. P s \<and> b s \<and> s' = s} c {\<lambda>s. P s \<and> (s,s') \<in> r}\<rbrakk>
   \<Longrightarrow> \<turnstile>\<^sub>t {P} WHILE b DO c {\<lambda>s. P s \<and> \<not>b s}"
| Conseq: "\<lbrakk> \<forall>s. P' s \<longrightarrow> P s; \<turnstile>\<^sub>t {P}c{Q}; \<forall>s. Q s \<longrightarrow> Q' s  \<rbrakk> \<Longrightarrow>
           \<turnstile>\<^sub>t {P'}c{Q'}"

| Local: "(!!s. P s \<Longrightarrow> P' s (f s)) \<Longrightarrow> \<forall>p. \<turnstile>\<^sub>t {P' p} c {Q o (g p)} \<Longrightarrow>
        \<turnstile>\<^sub>t {P} LOCAL f;c;g {Q}"

text{*\noindent The@{term While}- rule is like the one for partial
correctness but it requires additionally that with every execution of
the loop body a wellfounded relation (@{prop"wf r"}) on the state
space decreases.

The soundness theorem*}

(* Tried to use this lemma to simplify the soundness proof.
   But "\<turnstile>\<^sub>t {P}c{Q} \<Longrightarrow> (!s. P s \<longrightarrow> c\<down>s)" is not provable because too weak
lemma total_implies_partial: "\<turnstile>\<^sub>t {P} c {Q} \<Longrightarrow> \<turnstile> {P} c {Q}"
apply(erule thoare.induct)
      apply(rule hoare.intros)
        apply (clarify) apply assumption
      apply(rule hoare.intros)
      apply blast
     apply(blast intro:hoare.intros)
    apply(blast intro:hoare.intros)
   defer
   apply(blast intro:hoare.intros)
  apply(blast intro:hoare.intros)
apply(rule hoare.intros)
apply(rule hoare_relative_complete)
apply(unfold hoare_valid_def)
apply(clarify)
apply(erule allE, erule conjE)
apply(drule hoare_sound)
apply(unfold hoare_valid_def)
apply(blast)
done
*)

theorem "\<turnstile>\<^sub>t {P}c{Q}  \<Longrightarrow>  \<Turnstile>\<^sub>t {P}c{Q}"
apply(unfold hoare_tvalid_def hoare_valid_def)
apply(erule thoare.induct)
      apply blast
     apply blast
    apply clarsimp
   defer
   apply blast
 apply(rule conjI)
  apply clarify
  apply(erule allE)
  apply clarify
  apply(erule allE, erule allE, erule impE, erule asm_rl)
  apply simp
  apply(erule mp)
  apply(simp)
 apply blast
apply(rule conjI)
 apply(rule allI)
 apply(erule wf_induct)
 apply clarify
 apply(drule unfold_while[THEN iffD1])
 apply (simp split add:split_if_asm)
 apply blast
apply(rule allI)
apply(erule wf_induct)
apply clarify
apply(case_tac "b x")
 apply (blast intro: termi.WhileTrue)
apply (erule termi.WhileFalse)
done
(*>*)

text{*\noindent In the @{term While}-case we perform a
local proof by wellfounded induction over the given relation @{term r}.

The completeness proof proceeds along the same lines as the one for partial
correctness. First we have to strengthen our notion of weakest precondition
to take termination into account: *}

definition
 wpt :: "com \<Rightarrow> assn \<Rightarrow> assn" ("wp\<^sub>t") where
  "wp\<^sub>t c Q = (\<lambda>s. wp c Q s \<and> c\<down>s)"

lemmas wp_defs = wp_def wpt_def

lemma [simp]: "wp\<^sub>t (c\<^sub>1;c\<^sub>2) R = wp\<^sub>t c\<^sub>1 (wp\<^sub>t c\<^sub>2 R)"
apply(unfold wp_defs)
apply(rule ext)
apply blast
done

lemma [simp]:
 "wp\<^sub>t (IF b THEN c\<^sub>1 ELSE c\<^sub>2) Q = (\<lambda>s. wp\<^sub>t (if b s then c\<^sub>1 else c\<^sub>2) Q s)"
apply(unfold wp_defs)
apply(rule ext)
apply auto
done

lemma [simp]: "wp\<^sub>t (LOCAL f;c;g) Q = (\<lambda>s. wp\<^sub>t c (Q o (g s)) (f s))"
apply(unfold wp_defs)
apply(rule ext)
apply auto
done

inductive_cases [elim!]: "WHILE b DO c \<down> s"

lemma wp_is_pre[rule_format]: "\<turnstile>\<^sub>t {wp\<^sub>t c Q} c {Q}"
apply (induct c arbitrary: Q)
     apply simp_all
     apply(blast intro:thoare.Do thoare.Conseq)
    apply(blast intro:thoare.Semi thoare.Conseq)
   apply(blast intro:thoare.If thoare.Conseq)
  defer
 apply(fastforce intro!: thoare.Local)
apply(rename_tac b c Q)
apply(rule weaken_post)
 apply(rule_tac b=b and c=c in thoare.While)
  apply(rule_tac b=b and c=c in wf_termi)
 defer
 apply (simp add:wp_defs unfold_while)
apply(rule allI)
apply(rule strengthen_pre)
 prefer 2
 apply fast
apply(clarsimp simp add: wp_defs)
apply(blast intro:exec.intros)
done

text{*\noindent The @{term While}-case is interesting because we now have to furnish a
suitable wellfounded relation. Of course the execution of the loop
body directly yields the required relation.
The actual completeness theorem follows directly, in the same manner
as for partial correctness. *}

theorem "\<Turnstile>\<^sub>t {P}c{Q} \<Longrightarrow> \<turnstile>\<^sub>t {P}c{Q}"
apply (rule strengthen_pre[OF _ wp_is_pre])
apply(unfold hoare_tvalid_def hoare_valid_def wp_defs)
apply blast
done

end


(*    Title:              SatSolverVerification/BasicDPLL.thy
      Author:             Filip Maric
      Maintainer:         Filip Maric <filip at matf.bg.ac.yu>
*)

section\<open>BasicDPLL\<close>
theory BasicDPLL
imports SatSolverVerification
begin

text\<open>This theory formalizes the transition rule system BasicDPLL
 which is based on the classical DPLL procedure, but does not use the
 PureLiteral rule.\<close>

(******************************************************************************)
subsection\<open>Specification\<close>
(******************************************************************************)

text\<open>The state of the procedure is uniquely determined by its trail.\<close>
record State =
"getM" :: LiteralTrail

text\<open>Procedure checks the satisfiability of the formula F0 which
  does not change during the solving process. An external parameter is
  the set @{term decisionVars} which are the variables that branching
  is performed on. Usually this set contains all variables of the
  formula F0, but that does not always have to be the case.\<close>

text\<open>Now we define the transition rules of the system\<close>
definition
appliedDecide:: "State \<Rightarrow> State \<Rightarrow> Variable set \<Rightarrow> bool"
where
"appliedDecide stateA stateB decisionVars ==
  \<exists> l.
        (var l) \<in> decisionVars \<and>
        \<not> l el (elements (getM stateA)) \<and>
        \<not> opposite l el (elements (getM stateA)) \<and>

        getM stateB = getM stateA @ [(l, True)]
"
definition
applicableDecide :: "State \<Rightarrow> Variable set \<Rightarrow> bool"
where
"applicableDecide state decisionVars == \<exists> state'. appliedDecide state state' decisionVars"

definition
appliedUnitPropagate :: "State \<Rightarrow> State \<Rightarrow> Formula \<Rightarrow> bool"
where
"appliedUnitPropagate stateA stateB F0 ==
  \<exists> (uc::Clause) (ul::Literal).
       uc el F0 \<and>
       isUnitClause uc ul (elements (getM stateA)) \<and>

       getM stateB = getM stateA @ [(ul, False)]
"
definition
applicableUnitPropagate :: "State \<Rightarrow> Formula \<Rightarrow> bool"
where
"applicableUnitPropagate state F0 == \<exists> state'. appliedUnitPropagate state state' F0"

definition
appliedBacktrack :: "State \<Rightarrow> State \<Rightarrow> Formula \<Rightarrow> bool"
where
"appliedBacktrack stateA stateB F0 ==
      formulaFalse F0 (elements (getM stateA)) \<and>
      decisions (getM stateA) \<noteq> [] \<and>

      getM stateB = prefixBeforeLastDecision (getM stateA) @ [(opposite (lastDecision (getM stateA)), False)]
"
definition
applicableBacktrack :: "State \<Rightarrow> Formula \<Rightarrow> bool"
where
"applicableBacktrack state F0 ==  \<exists> state'. appliedBacktrack state state' F0"

text\<open>Solving starts with the empty trail.\<close>
definition
isInitialState :: "State \<Rightarrow> Formula \<Rightarrow> bool"
where
"isInitialState state F0 ==
      getM state = []
"
text\<open>Transitions are preformed only by using one of the three given rules.\<close>
definition
"transition stateA stateB F0 decisionVars ==
     appliedDecide        stateA stateB decisionVars \<or>
     appliedUnitPropagate stateA stateB F0  \<or>
     appliedBacktrack     stateA stateB F0
"

text\<open>Transition relation is obtained by applying transition rules
iteratively. It is defined using a reflexive-transitive closure.\<close>
definition
"transitionRelation F0 decisionVars == ({(stateA, stateB). transition stateA stateB F0 decisionVars})^*"

text\<open>Final state is one in which no rules apply\<close>
definition
isFinalState :: "State \<Rightarrow> Formula \<Rightarrow> Variable set \<Rightarrow> bool"
where
"isFinalState state F0 decisionVars == \<not> (\<exists> state'. transition state state' F0 decisionVars)"

text\<open>The following several lemmas give conditions for applicability of different rules.\<close>
lemma applicableDecideCharacterization:
  fixes stateA::State
  shows "applicableDecide stateA decisionVars =
  (\<exists> l.
        (var l) \<in> decisionVars \<and>
        \<not> l el (elements (getM stateA)) \<and>
        \<not> opposite l el (elements (getM stateA)))
  " (is "?lhs = ?rhs")
proof
  assume ?rhs
  then obtain l where
    *: "(var l) \<in> decisionVars" "\<not> l el (elements (getM stateA))" "\<not> opposite l el (elements (getM stateA))"
    unfolding applicableDecide_def
    by auto
  let ?stateB = "stateA\<lparr> getM := (getM stateA) @ [(l, True)] \<rparr>"
  from * have "appliedDecide stateA ?stateB decisionVars"
    unfolding appliedDecide_def
    by auto
  thus ?lhs
    unfolding applicableDecide_def
    by auto
next
  assume ?lhs
  then obtain stateB l
    where "(var l) \<in> decisionVars" "\<not> l el (elements (getM stateA))"
    "\<not> opposite l el (elements (getM stateA))"
    unfolding applicableDecide_def
    unfolding appliedDecide_def
    by auto
  thus ?rhs
    by auto
qed

lemma applicableUnitPropagateCharacterization:
  fixes stateA::State and F0::Formula
  shows "applicableUnitPropagate stateA F0 =
  (\<exists> (uc::Clause) (ul::Literal).
       uc el F0 \<and>
       isUnitClause uc ul (elements (getM stateA)))
  " (is "?lhs = ?rhs")
proof
  assume "?rhs"
  then obtain ul uc
    where *: "uc el F0" "isUnitClause uc ul (elements (getM stateA))"
    unfolding applicableUnitPropagate_def
    by auto
  let ?stateB = "stateA\<lparr> getM := getM stateA @ [(ul, False)] \<rparr>"
  from * have "appliedUnitPropagate stateA ?stateB F0"
    unfolding appliedUnitPropagate_def
    by auto
  thus ?lhs
    unfolding applicableUnitPropagate_def
    by auto
next
  assume ?lhs
  then obtain stateB uc ul
    where "uc el F0" "isUnitClause uc ul (elements (getM stateA))"
    unfolding applicableUnitPropagate_def
    unfolding appliedUnitPropagate_def
    by auto
  thus ?rhs
    by auto
qed

lemma applicableBacktrackCharacterization:
  fixes stateA::State
  shows "applicableBacktrack stateA F0 =
      (formulaFalse F0 (elements (getM stateA)) \<and>
       decisions (getM stateA) \<noteq> [])" (is "?lhs = ?rhs")
proof
  assume ?rhs
  hence *: "formulaFalse F0 (elements (getM stateA))" "decisions (getM stateA) \<noteq> []"
    by auto
  let ?stateB = "stateA\<lparr> getM := prefixBeforeLastDecision (getM stateA) @ [(opposite (lastDecision (getM stateA)), False)]\<rparr>"
  from * have "appliedBacktrack stateA ?stateB F0"
    unfolding appliedBacktrack_def
    by auto
  thus ?lhs
    unfolding applicableBacktrack_def
    by auto
next
  assume "?lhs"
  then obtain stateB
    where "appliedBacktrack stateA stateB F0"
    unfolding applicableBacktrack_def
    by auto
  hence
    "formulaFalse F0 (elements (getM stateA))"
    "decisions (getM stateA) \<noteq> []"
    "getM stateB = prefixBeforeLastDecision (getM stateA) @ [(opposite (lastDecision (getM stateA)), False)]"
    unfolding appliedBacktrack_def
    by auto
  thus ?rhs
    by auto
qed

text\<open>Final states are the ones where no rule is applicable.\<close>
lemma finalStateNonApplicable:
  fixes state::State
  shows "isFinalState state F0 decisionVars =
          (\<not> applicableDecide state decisionVars \<and>
           \<not> applicableUnitPropagate state F0 \<and>
           \<not> applicableBacktrack state F0)"
unfolding isFinalState_def
unfolding transition_def
unfolding applicableDecide_def
unfolding applicableUnitPropagate_def
unfolding applicableBacktrack_def
by auto

(******************************************************************************)
subsection\<open>Invariants\<close>
(******************************************************************************)
text\<open>Invariants that are relevant for the rest of correctness proof.\<close>
definition
invariantsHoldInState :: "State \<Rightarrow> Formula \<Rightarrow> Variable set \<Rightarrow> bool"
where
"invariantsHoldInState state F0 decisionVars ==
    InvariantImpliedLiterals F0 (getM state) \<and>
    InvariantVarsM (getM state) F0 decisionVars \<and>
    InvariantConsistent (getM state) \<and>
    InvariantUniq (getM state)
"

text\<open>Invariants hold in initial states.\<close>
lemma invariantsHoldInInitialState:
  fixes state :: State and F0 :: Formula
  assumes "isInitialState state F0"
  shows "invariantsHoldInState state F0 decisionVars"
using assms
by (auto simp add:
  isInitialState_def
  invariantsHoldInState_def
  InvariantImpliedLiterals_def
  InvariantVarsM_def
  InvariantConsistent_def
  InvariantUniq_def
)

text\<open>Valid transitions preserve invariants.\<close>
lemma transitionsPreserveInvariants:
  fixes stateA::State and stateB::State
  assumes "transition stateA stateB F0 decisionVars" and
  "invariantsHoldInState stateA F0 decisionVars"
  shows "invariantsHoldInState stateB F0 decisionVars"
proof-
    from \<open>invariantsHoldInState stateA F0 decisionVars\<close>
    have
      "InvariantImpliedLiterals F0 (getM stateA)" and
      "InvariantVarsM (getM stateA) F0 decisionVars" and
      "InvariantConsistent (getM stateA)" and
      "InvariantUniq (getM stateA)"
      unfolding invariantsHoldInState_def
      by auto
  {
    assume "appliedDecide stateA stateB decisionVars"
    then obtain l::Literal where
      "(var l) \<in> decisionVars"
      "\<not> literalTrue l (elements (getM stateA))"
      "\<not> literalFalse l (elements (getM stateA))"
      "getM stateB = getM stateA @ [(l, True)]"
      unfolding appliedDecide_def
      by auto

    from \<open>\<not> literalTrue l (elements (getM stateA))\<close> \<open>\<not> literalFalse l (elements (getM stateA))\<close>
    have *: "var l \<notin> vars (elements (getM stateA))"
      using variableDefinedImpliesLiteralDefined[of "l" "elements (getM stateA)"]
      by simp

    have "InvariantImpliedLiterals F0 (getM stateB)"
      using
        \<open>getM stateB = getM stateA @ [(l, True)]\<close>
        \<open>InvariantImpliedLiterals F0 (getM stateA)\<close>
        \<open>InvariantUniq (getM stateA)\<close>
        \<open>var l \<notin> vars (elements (getM stateA))\<close>
        InvariantImpliedLiteralsAfterDecide[of "F0" "getM stateA" "l" "getM stateB"]
      by simp
    moreover
    have "InvariantVarsM (getM stateB) F0 decisionVars"
      using \<open>getM stateB = getM stateA @ [(l, True)]\<close>
        \<open>InvariantVarsM (getM stateA) F0 decisionVars\<close>
        \<open>var l \<in> decisionVars\<close>
        InvariantVarsMAfterDecide[of "getM stateA" "F0" "decisionVars" "l" "getM stateB"]
      by simp
    moreover
    have "InvariantConsistent (getM stateB)"
      using \<open>getM stateB = getM stateA @ [(l, True)]\<close>
        \<open>InvariantConsistent (getM stateA)\<close>
        \<open>var l \<notin> vars (elements (getM stateA))\<close>
        InvariantConsistentAfterDecide[of "getM stateA" "l" "getM stateB"]
      by simp
    moreover
    have "InvariantUniq (getM stateB)"
      using \<open>getM stateB = getM stateA @ [(l, True)]\<close>
        \<open>InvariantUniq (getM stateA)\<close>
        \<open>var l \<notin> vars (elements (getM stateA))\<close>
        InvariantUniqAfterDecide[of "getM stateA" "l" "getM stateB"]
      by simp
    ultimately
    have ?thesis
      unfolding invariantsHoldInState_def
      by auto
  }
  moreover
  {
    assume "appliedUnitPropagate stateA stateB F0"
    then obtain uc::Clause and ul::Literal where
      "uc el F0"
      "isUnitClause uc ul (elements (getM stateA))"
      "getM stateB = getM stateA @ [(ul, False)]"
      unfolding appliedUnitPropagate_def
      by auto

    from \<open>isUnitClause uc ul (elements (getM stateA))\<close>
    have "ul el uc"
      unfolding isUnitClause_def
      by simp

    from \<open>uc el F0\<close>
    have "formulaEntailsClause F0 uc"
      by (simp add: formulaEntailsItsClauses)

    have "InvariantImpliedLiterals F0 (getM stateB)"
      using
        \<open>InvariantImpliedLiterals F0 (getM stateA)\<close>
        \<open>formulaEntailsClause F0 uc\<close>
        \<open>isUnitClause uc ul (elements (getM stateA))\<close>
        \<open>getM stateB = getM stateA @ [(ul, False)]\<close>
        InvariantImpliedLiteralsAfterUnitPropagate[of "F0" "getM stateA" "uc" "ul" "getM stateB"]
      by simp
    moreover
    from \<open>ul el uc\<close> \<open>uc el F0\<close>
    have "ul el F0"
      by (auto simp add: literalElFormulaCharacterization)
    hence "var ul \<in> vars F0 \<union> decisionVars"
      using formulaContainsItsLiteralsVariable [of "ul" "F0"]
      by auto

    have "InvariantVarsM (getM stateB) F0 decisionVars"
      using \<open>InvariantVarsM (getM stateA) F0 decisionVars\<close>
        \<open>var ul \<in> vars F0 \<union> decisionVars\<close>
        \<open>getM stateB = getM stateA @ [(ul, False)]\<close>
        InvariantVarsMAfterUnitPropagate[of "getM stateA" "F0" "decisionVars" "ul" "getM stateB"]
      by simp
    moreover
    have "InvariantConsistent (getM stateB)"
      using \<open>InvariantConsistent (getM stateA)\<close>
        \<open>isUnitClause uc ul (elements (getM stateA))\<close>
        \<open>getM stateB = getM stateA @ [(ul, False)]\<close>
        InvariantConsistentAfterUnitPropagate [of "getM stateA" "uc" "ul" "getM stateB"]
      by simp
    moreover
    have "InvariantUniq (getM stateB)"
      using \<open>InvariantUniq (getM stateA)\<close>
        \<open>isUnitClause uc ul (elements (getM stateA))\<close>
        \<open>getM stateB = getM stateA @ [(ul, False)]\<close>
        InvariantUniqAfterUnitPropagate [of "getM stateA" "uc" "ul" "getM stateB"]
      by simp
    ultimately
    have ?thesis
      unfolding invariantsHoldInState_def
      by auto
  }
  moreover
  {
    assume "appliedBacktrack stateA stateB F0"
    hence "formulaFalse F0 (elements (getM stateA))"
      "formulaFalse F0 (elements (getM stateA))"
      "decisions (getM stateA) \<noteq> []"
      "getM stateB = prefixBeforeLastDecision (getM stateA) @ [(opposite (lastDecision (getM stateA)), False)]"
      unfolding appliedBacktrack_def
      by auto

    have "InvariantImpliedLiterals F0 (getM stateB)"
      using \<open>InvariantImpliedLiterals F0 (getM stateA)\<close>
        \<open>formulaFalse F0 (elements (getM stateA))\<close>
        \<open>decisions (getM stateA) \<noteq> []\<close>
        \<open>getM stateB = prefixBeforeLastDecision (getM stateA) @ [(opposite (lastDecision (getM stateA)), False)]\<close>
        \<open>InvariantUniq (getM stateA)\<close>
        \<open>InvariantConsistent (getM stateA)\<close>
        InvariantImpliedLiteralsAfterBacktrack[of "F0" "getM stateA" "getM stateB"]
      by simp
    moreover
    have "InvariantVarsM (getM stateB) F0 decisionVars"
      using \<open>InvariantVarsM (getM stateA) F0 decisionVars\<close>
        \<open>decisions (getM stateA) \<noteq> []\<close>
        \<open>getM stateB = prefixBeforeLastDecision (getM stateA) @ [(opposite (lastDecision (getM stateA)), False)]\<close>
        InvariantVarsMAfterBacktrack[of "getM stateA" "F0" "decisionVars" "getM stateB"]
      by simp
    moreover
    have "InvariantConsistent (getM stateB)"
      using \<open>InvariantConsistent (getM stateA)\<close>
        \<open>InvariantUniq (getM stateA)\<close>
        \<open>decisions (getM stateA) \<noteq> []\<close>
        \<open>getM stateB = prefixBeforeLastDecision (getM stateA) @ [(opposite (lastDecision (getM stateA)), False)]\<close>
        InvariantConsistentAfterBacktrack[of "getM stateA" "getM stateB"]
      by simp
    moreover
    have "InvariantUniq (getM stateB)"
      using \<open>InvariantConsistent (getM stateA)\<close>
        \<open>InvariantUniq (getM stateA)\<close>
        \<open>decisions (getM stateA) \<noteq> []\<close>
        \<open>getM stateB = prefixBeforeLastDecision (getM stateA) @ [(opposite (lastDecision (getM stateA)), False)]\<close>
        InvariantUniqAfterBacktrack[of "getM stateA" "getM stateB"]
      by simp
    ultimately
    have ?thesis
      unfolding invariantsHoldInState_def
      by auto
  }
  ultimately
  show ?thesis
    using \<open>transition stateA stateB F0 decisionVars\<close>
    unfolding transition_def
    by auto
qed

text\<open>The consequence is that invariants hold in all valid runs.\<close>
lemma invariantsHoldInValidRuns:
  fixes F0 :: Formula and decisionVars :: "Variable set"
  assumes "invariantsHoldInState stateA F0 decisionVars" and
  "(stateA, stateB) \<in> transitionRelation F0 decisionVars"
  shows "invariantsHoldInState stateB F0 decisionVars"
using assms
using transitionsPreserveInvariants
using rtrancl_induct[of "stateA" "stateB"
  "{(stateA, stateB). transition stateA stateB F0 decisionVars}" "\<lambda> x. invariantsHoldInState x F0 decisionVars"]
unfolding transitionRelation_def
by auto

lemma invariantsHoldInValidRunsFromInitialState:
  fixes F0 :: Formula and decisionVars :: "Variable set"
  assumes "isInitialState state0 F0"
  and "(state0, state) \<in> transitionRelation F0 decisionVars"
  shows "invariantsHoldInState state F0 decisionVars"
proof-
  from \<open>isInitialState state0 F0\<close>
  have "invariantsHoldInState state0 F0 decisionVars"
    by (simp add:invariantsHoldInInitialState)
  with assms
  show ?thesis
    using invariantsHoldInValidRuns [of "state0"  "F0" "decisionVars" "state"]
    by simp
qed

text\<open>
 In the following text we will show that there are two kinds of states:
 \begin{enumerate}
  \item \textit{UNSAT} states where @{term "formulaFalse F0 (elements (getM state))"}
  and @{term "decisions (getM state) = []"}.
  \item \textit{SAT} states where @{term "\<not> formulaFalse F0 (elements (getM state))"}
  and @{term "vars (elements (getM state)) \<supseteq> decisionVars"}.
 \end{enumerate}

 The soundness theorems claim that if \textit{UNSAT} state is reached
 the formula is unsatisfiable and if \textit{SAT} state is reached,
 the formula is satisfiable.

 Completeness theorems claim that every final state is either
 \textit{UNSAT} or \textit{SAT}. A consequence of this and soundness
 theorems, is that if formula is unsatisfiable the solver will finish
 in an \textit{UNSAT} state, and if the formula is satisfiable the
 solver will finish in a \textit{SAT} state.\<close>

(******************************************************************************)
subsection\<open>Soundness\<close>
(******************************************************************************)

(*----------------------------------------------------------------------------*)
theorem soundnessForUNSAT:
  fixes F0 :: Formula and decisionVars :: "Variable set" and state0 :: State and state :: State
  assumes
  "isInitialState state0 F0" and
  "(state0, state) \<in> transitionRelation F0 decisionVars"

  "formulaFalse F0 (elements (getM state))"
  "decisions (getM state) = []"
  shows "\<not> satisfiable F0"
(*----------------------------------------------------------------------------*)
proof-
  from \<open>isInitialState state0 F0\<close> \<open>(state0, state) \<in> transitionRelation F0 decisionVars\<close>
  have "invariantsHoldInState state F0 decisionVars"
    using invariantsHoldInValidRunsFromInitialState
    by simp
  hence "InvariantImpliedLiterals F0 (getM state)"
    unfolding invariantsHoldInState_def
    by auto
  with \<open>formulaFalse F0 (elements (getM state))\<close>
    \<open>decisions (getM state) = []\<close>
  show ?thesis
    using unsatReport[of "F0" "getM state" "F0"]
    unfolding InvariantEquivalent_def equivalentFormulae_def
    by simp
qed

(*----------------------------------------------------------------------------*)
theorem soundnessForSAT:
  fixes F0 :: Formula and decisionVars :: "Variable set" and state0 :: State and state :: State
  assumes
  "vars F0 \<subseteq> decisionVars" and

  "isInitialState state0 F0" and
  "(state0, state) \<in> transitionRelation F0 decisionVars"

  "\<not> formulaFalse F0 (elements (getM state))"
  "vars (elements (getM state)) \<supseteq> decisionVars"

  shows
  "model (elements (getM state)) F0"
(*----------------------------------------------------------------------------*)
proof-
  from \<open>isInitialState state0 F0\<close> \<open>(state0, state) \<in> transitionRelation F0 decisionVars\<close>
  have "invariantsHoldInState state F0 decisionVars"
    using invariantsHoldInValidRunsFromInitialState
    by simp
  hence
    "InvariantConsistent (getM state)"
    unfolding invariantsHoldInState_def
    by auto
  with assms
  show ?thesis
  using satReport[of "F0" "decisionVars" "F0" "getM state"]
  unfolding InvariantEquivalent_def equivalentFormulae_def
  InvariantVarsF_def
  by auto
qed

(******************************************************************************)
subsection\<open>Termination\<close>
(******************************************************************************)
text\<open>We now define a termination ordering on the set of states based
on the @{term lexLessRestricted} trail ordering. This ordering will be central
in termination proof.\<close>

definition "terminationLess (F0::Formula) decisionVars == {((stateA::State), (stateB::State)).
  (getM stateA, getM stateB) \<in> lexLessRestricted (vars F0 \<union> decisionVars)}"

text\<open>We want to show that every valid transition decreases a state
  with respect to the constructed termination ordering. Therefore, we
  show that $Decide$, $UnitPropagate$ and $Backtrack$ rule decrease the
  trail with respect to the restricted trail ordering. Invariants
  ensure that trails are indeed @{term uniq}, @{term consistent} and with
  finite variable sets.\<close>
lemma trailIsDecreasedByDeciedUnitPropagateAndBacktrack:
  fixes stateA::State and stateB::State
  assumes "invariantsHoldInState stateA F0 decisionVars" and
  "appliedDecide stateA stateB decisionVars \<or> appliedUnitPropagate stateA stateB F0 \<or> appliedBacktrack stateA stateB F0"
  shows "(getM stateB, getM stateA) \<in> lexLessRestricted (vars F0 \<union> decisionVars)"
proof-
  from \<open>appliedDecide stateA stateB decisionVars \<or> appliedUnitPropagate stateA stateB F0 \<or> appliedBacktrack stateA stateB F0\<close>
    \<open>invariantsHoldInState stateA F0 decisionVars\<close>
  have "invariantsHoldInState stateB F0 decisionVars"
      using transitionsPreserveInvariants
      unfolding transition_def
      by auto
    from \<open>invariantsHoldInState stateA F0 decisionVars\<close>
    have *: "uniq (elements (getM stateA))" "consistent (elements (getM stateA))" "vars (elements (getM stateA)) \<subseteq> vars F0 \<union> decisionVars"
      unfolding invariantsHoldInState_def
      unfolding InvariantVarsM_def
      unfolding InvariantConsistent_def
      unfolding InvariantUniq_def
      by auto
    from \<open>invariantsHoldInState stateB F0 decisionVars\<close>
    have **: "uniq (elements (getM stateB))" "consistent (elements (getM stateB))" "vars (elements (getM stateB)) \<subseteq> vars F0 \<union> decisionVars"
      unfolding invariantsHoldInState_def
      unfolding InvariantVarsM_def
      unfolding InvariantConsistent_def
      unfolding InvariantUniq_def
      by auto
  {
    assume "appliedDecide stateA stateB decisionVars"
    hence "(getM stateB, getM stateA) \<in> lexLess"
      unfolding appliedDecide_def
      by (auto simp add:lexLessAppend)
    with * **
    have "((getM stateB), (getM stateA)) \<in> lexLessRestricted (vars F0 \<union> decisionVars)"
      unfolding lexLessRestricted_def
      by auto
  }
  moreover
  {
    assume "appliedUnitPropagate stateA stateB F0"
    hence "(getM stateB, getM stateA) \<in> lexLess"
      unfolding appliedUnitPropagate_def
      by (auto simp add:lexLessAppend)
    with * **
    have "(getM stateB, getM stateA) \<in> lexLessRestricted (vars F0 \<union> decisionVars)"
      unfolding lexLessRestricted_def
      by auto
  }
  moreover
  {
    assume "appliedBacktrack stateA stateB F0"
    hence
      "formulaFalse F0 (elements (getM stateA))"
      "decisions (getM stateA) \<noteq> []"
      "getM stateB = prefixBeforeLastDecision (getM stateA) @ [(opposite (lastDecision (getM stateA)), False)]"
      unfolding appliedBacktrack_def
      by auto
    hence "(getM stateB, getM stateA) \<in> lexLess"
      using \<open>decisions (getM stateA) \<noteq> []\<close>
        \<open>getM stateB = prefixBeforeLastDecision (getM stateA) @ [(opposite (lastDecision (getM stateA)), False)]\<close>
      by (simp add:lexLessBacktrack)
    with * **
    have "(getM stateB, getM stateA) \<in> lexLessRestricted (vars F0 \<union> decisionVars)"
      unfolding lexLessRestricted_def
      by auto
  }
  ultimately
  show ?thesis
    using assms
    by auto
qed

text\<open>Now we can show that every rule application decreases a state
with respect to the constructed termination ordering.\<close>
lemma stateIsDecreasedByValidTransitions:
  fixes stateA::State and stateB::State
  assumes "invariantsHoldInState stateA F0 decisionVars" and "transition stateA stateB F0 decisionVars"
  shows "(stateB, stateA) \<in> terminationLess F0 decisionVars"
proof-
  from \<open>transition stateA stateB F0 decisionVars\<close>
  have "appliedDecide stateA stateB decisionVars \<or> appliedUnitPropagate stateA stateB F0 \<or> appliedBacktrack stateA stateB F0"
    unfolding transition_def
    by simp
  with \<open>invariantsHoldInState stateA F0 decisionVars\<close>
  have "(getM stateB, getM stateA) \<in> lexLessRestricted (vars F0 \<union> decisionVars)"
    using trailIsDecreasedByDeciedUnitPropagateAndBacktrack
    by simp
  thus ?thesis
    unfolding terminationLess_def
    by simp
qed

text\<open>The minimal states with respect to the termination ordering are
  final i.e., no further transition rules are applicable.\<close>
definition
"isMinimalState stateMin F0 decisionVars == (\<forall> state::State. (state, stateMin) \<notin> terminationLess F0 decisionVars)"

lemma minimalStatesAreFinal:
  fixes stateA::State
  assumes "invariantsHoldInState state F0 decisionVars" and "isMinimalState state F0 decisionVars"
  shows "isFinalState state F0 decisionVars"
proof-
  {
    assume "\<not> ?thesis"
    then obtain state'::State
      where "transition state state' F0 decisionVars"
      unfolding isFinalState_def
      by auto
    with \<open>invariantsHoldInState state F0 decisionVars\<close>
    have "(state', state) \<in> terminationLess F0 decisionVars"
      using stateIsDecreasedByValidTransitions[of "state" "F0" "decisionVars" "state'"]
      unfolding transition_def
      by auto
    with \<open>isMinimalState state F0 decisionVars\<close>
    have False
      unfolding isMinimalState_def
      by auto
  }
  thus ?thesis
    by auto
qed

text\<open>The following key lemma shows that the termination ordering is well founded.\<close>
lemma wfTerminationLess:
  fixes decisionVars :: "Variable set" and F0 :: "Formula"
  assumes "finite decisionVars"
  shows "wf (terminationLess F0 decisionVars)"
unfolding wf_eq_minimal
proof-
  show "\<forall>Q state. state \<in> Q \<longrightarrow> (\<exists>stateMin\<in>Q. \<forall>state'. (state', stateMin) \<in> terminationLess F0 decisionVars \<longrightarrow> state' \<notin> Q)"
  proof-
    {
      fix Q :: "State set" and state :: State
      assume "state \<in> Q"
      let ?Q1 = "{M::LiteralTrail. \<exists> state. state \<in> Q \<and> (getM state) = M}"
      from \<open>state \<in> Q\<close>
      have "getM state \<in> ?Q1"
        by auto
      from \<open>finite decisionVars\<close>
      have "finite (vars F0 \<union> decisionVars)"
        using finiteVarsFormula[of "F0"]
        by simp
      hence "wf (lexLessRestricted (vars F0 \<union> decisionVars))"
      using  wfLexLessRestricted[of "vars F0 \<union> decisionVars"]
      by simp
    with \<open>getM state \<in> ?Q1\<close>
      obtain Mmin where "Mmin \<in> ?Q1" "\<forall>M'. (M', Mmin) \<in> lexLessRestricted (vars F0 \<union> decisionVars) \<longrightarrow> M' \<notin> ?Q1"
        unfolding wf_eq_minimal
        apply (erule_tac x="?Q1" in allE)
        apply (erule_tac x="getM state" in allE)
        by auto
      from \<open>Mmin \<in> ?Q1\<close> obtain stateMin
        where "stateMin \<in> Q" "(getM stateMin) = Mmin"
        by auto
      have "\<forall>state'. (state', stateMin) \<in> terminationLess F0 decisionVars \<longrightarrow> state' \<notin> Q"
      proof
        fix state'
        show "(state', stateMin) \<in> terminationLess F0 decisionVars \<longrightarrow> state' \<notin> Q"
        proof
          assume "(state', stateMin) \<in> terminationLess F0 decisionVars"
          hence "(getM state', getM stateMin) \<in> lexLessRestricted (vars F0 \<union> decisionVars)"
            unfolding terminationLess_def
            by auto
          from \<open>\<forall>M'. (M', Mmin) \<in> lexLessRestricted (vars F0 \<union> decisionVars) \<longrightarrow> M' \<notin> ?Q1\<close>
            \<open>(getM state', getM stateMin) \<in> lexLessRestricted (vars F0 \<union> decisionVars)\<close> \<open>getM stateMin = Mmin\<close>
          have "getM state' \<notin> ?Q1"
            by simp
          with \<open>getM stateMin = Mmin\<close>
          show "state' \<notin> Q"
            by auto
        qed
      qed
      with \<open>stateMin \<in> Q\<close>
      have "\<exists> stateMin \<in> Q. (\<forall>state'. (state', stateMin) \<in> terminationLess F0 decisionVars \<longrightarrow> state' \<notin> Q)"
        by auto
    }
    thus ?thesis
      by auto
  qed
qed

text\<open>Using the termination ordering we show that the transition
relation is well founded on states reachable from initial state.\<close>
(*----------------------------------------------------------------------------*)
theorem wfTransitionRelation:
  fixes decisionVars :: "Variable set" and F0 :: "Formula" and state0 :: "State"
  assumes "finite decisionVars" and "isInitialState state0 F0"
  shows "wf {(stateB, stateA).
             (state0, stateA) \<in> transitionRelation F0 decisionVars \<and> (transition stateA stateB F0 decisionVars)}"
(*----------------------------------------------------------------------------*)
proof-
  let ?rel = "{(stateB, stateA).
                  (state0, stateA) \<in> transitionRelation F0 decisionVars \<and> (transition stateA stateB F0 decisionVars)}"
  let ?rel'= "terminationLess F0 decisionVars"

  have "\<forall>x y. (x, y) \<in> ?rel \<longrightarrow> (x, y) \<in> ?rel'"
  proof-
    {
      fix stateA::State and stateB::State
      assume "(stateB, stateA) \<in> ?rel"
      hence "(stateB, stateA) \<in> ?rel'"
        using \<open>isInitialState state0 F0\<close>
        using invariantsHoldInValidRunsFromInitialState[of "state0" "F0" "stateA" "decisionVars"]
        using stateIsDecreasedByValidTransitions[of "stateA" "F0" "decisionVars" "stateB"]
        by simp
    }
    thus ?thesis
      by simp
  qed
  moreover
  have "wf ?rel'"
    using \<open>finite decisionVars\<close>
    by (rule wfTerminationLess)
  ultimately
  show ?thesis
    using wellFoundedEmbed[of "?rel" "?rel'"]
    by simp
qed

text\<open>We will now give two corollaries of the previous theorem. First
  is a weak termination result that shows that there is a terminating
  run from every intial state to the final one.\<close>
corollary
  fixes decisionVars :: "Variable set" and F0 :: "Formula" and state0 :: "State"
  assumes "finite decisionVars" and "isInitialState state0 F0"
  shows "\<exists> state. (state0, state) \<in> transitionRelation F0 decisionVars \<and> isFinalState state F0 decisionVars"
proof-
  {
    assume "\<not> ?thesis"
    let ?Q = "{state. (state0, state) \<in> transitionRelation F0 decisionVars}"
    let ?rel = "{(stateB, stateA). (state0, stateA) \<in> transitionRelation F0 decisionVars \<and>
                         transition stateA stateB F0 decisionVars}"
    have "state0 \<in> ?Q"
      unfolding transitionRelation_def
      by simp
    hence "\<exists> state. state \<in> ?Q"
      by auto

    from assms
    have "wf ?rel"
      using wfTransitionRelation[of "decisionVars" "state0" "F0"]
      by auto
    hence "\<forall> Q. (\<exists> x. x \<in> Q) \<longrightarrow> (\<exists> stateMin \<in> Q. \<forall> state. (state, stateMin) \<in> ?rel \<longrightarrow> state \<notin> Q)"
      unfolding wf_eq_minimal
      by simp
    hence " (\<exists> x. x \<in> ?Q) \<longrightarrow> (\<exists> stateMin \<in> ?Q. \<forall> state. (state, stateMin) \<in> ?rel \<longrightarrow> state \<notin> ?Q)"
      by rule
    with \<open>\<exists> state. state \<in> ?Q\<close>
    have "\<exists> stateMin \<in> ?Q. \<forall> state. (state, stateMin) \<in> ?rel \<longrightarrow> state \<notin> ?Q"
      by simp
    then obtain stateMin
      where "stateMin \<in> ?Q" and "\<forall> state. (state, stateMin) \<in> ?rel \<longrightarrow> state \<notin> ?Q"
      by auto

    from \<open>stateMin \<in> ?Q\<close>
    have "(state0, stateMin) \<in> transitionRelation F0 decisionVars"
      by simp
    with \<open>\<not> ?thesis\<close>
    have "\<not> isFinalState stateMin F0 decisionVars"
      by simp
    then obtain state'::State
      where "transition stateMin state' F0 decisionVars"
      unfolding isFinalState_def
      by auto
    have "(state', stateMin) \<in> ?rel"
      using \<open>(state0, stateMin) \<in> transitionRelation F0 decisionVars\<close>
            \<open>transition stateMin state' F0 decisionVars\<close>
      by simp
    with \<open>\<forall> state. (state, stateMin) \<in> ?rel \<longrightarrow> state \<notin> ?Q\<close>
    have "state' \<notin> ?Q"
      by force
    moreover
    from \<open>(state0, stateMin) \<in> transitionRelation F0 decisionVars\<close> \<open>transition stateMin state' F0 decisionVars\<close>
    have "state' \<in> ?Q"
      unfolding transitionRelation_def
      using rtrancl_into_rtrancl[of "state0" "stateMin" "{(stateA, stateB). transition stateA stateB F0 decisionVars}" "state'"]
      by simp
    ultimately
    have False
      by simp
  }
  thus ?thesis
    by auto
qed

text\<open>Now we prove the final strong termination result which states
that there cannot be infinite chains of transitions. If there is an
infinite transition chain that starts from an initial state, its
elements would for a set that would contain initial state and for
every element of that set there would be another element of that set
that is directly reachable from it. We show that no such set exists.\<close>
corollary noInfiniteTransitionChains:
  fixes F0::Formula and decisionVars::"Variable set"
  assumes "finite decisionVars"
  shows "\<not> (\<exists> Q::(State set). \<exists> state0 \<in> Q. isInitialState state0 F0 \<and>
                              (\<forall> state \<in> Q. (\<exists> state' \<in> Q. transition state state' F0 decisionVars))
            )"
proof-
  {
  assume "\<not> ?thesis"
  then obtain Q::"State set" and state0::"State"
    where "isInitialState state0 F0" "state0 \<in> Q"
          "\<forall> state \<in> Q. (\<exists> state' \<in> Q. transition state state' F0 decisionVars)"
    by auto
  let ?rel = "{(stateB, stateA). (state0, stateA) \<in> transitionRelation F0 decisionVars \<and>
                         transition stateA stateB F0 decisionVars}"
  from \<open>finite decisionVars\<close> \<open>isInitialState state0 F0\<close>
  have "wf ?rel"
    using wfTransitionRelation
    by simp
  hence wfmin: "\<forall>Q x. x \<in> Q \<longrightarrow>
         (\<exists>z\<in>Q. \<forall>y. (y, z) \<in> ?rel \<longrightarrow> y \<notin> Q)"
    unfolding wf_eq_minimal
    by simp
  let ?Q = "{state \<in> Q. (state0, state) \<in> transitionRelation F0 decisionVars}"
  from \<open>state0 \<in> Q\<close>
  have "state0 \<in> ?Q"
    unfolding transitionRelation_def
    by simp
  with wfmin
  obtain stateMin::State
    where "stateMin \<in> ?Q" and "\<forall>y. (y, stateMin) \<in> ?rel \<longrightarrow> y \<notin> ?Q"
    apply (erule_tac x="?Q" in allE)
    by auto

  from \<open>stateMin \<in> ?Q\<close>
  have "stateMin \<in> Q" "(state0, stateMin) \<in> transitionRelation F0 decisionVars"
    by auto
  with \<open>\<forall> state \<in> Q. (\<exists> state' \<in> Q. transition state state' F0 decisionVars)\<close>
  obtain state'::State
    where "state' \<in> Q" "transition stateMin state' F0 decisionVars"
    by auto

  with \<open>(state0, stateMin) \<in> transitionRelation F0 decisionVars\<close>
  have "(state', stateMin) \<in> ?rel"
    by simp
  with \<open>\<forall>y. (y, stateMin) \<in> ?rel \<longrightarrow> y \<notin> ?Q\<close>
  have "state' \<notin> ?Q"
    by force

  from \<open>state' \<in> Q\<close> \<open>(state0, stateMin) \<in> transitionRelation F0 decisionVars\<close>
    \<open>transition stateMin state' F0 decisionVars\<close>
  have "state' \<in> ?Q"
    unfolding transitionRelation_def
    using rtrancl_into_rtrancl[of "state0" "stateMin" "{(stateA, stateB). transition stateA stateB F0 decisionVars}" "state'"]
    by simp
  with \<open>state' \<notin> ?Q\<close>
  have False
    by simp
  }
  thus ?thesis
    by force
qed

(******************************************************************************)
subsection\<open>Completeness\<close>
(******************************************************************************)
text\<open>In this section we will first show that each final state is
either \textit{SAT} or \textit{UNSAT} state.\<close>

lemma finalNonConflictState:
  fixes state::State and FO :: Formula
  assumes
  "\<not> applicableDecide state decisionVars"
  shows "vars (elements (getM state)) \<supseteq> decisionVars"
proof
  fix x :: Variable
  let ?l = "Pos x"
  assume "x \<in> decisionVars"
  hence "var ?l = x" and "var ?l \<in> decisionVars" and "var (opposite ?l) \<in> decisionVars"
    by auto
  with \<open>\<not> applicableDecide state decisionVars\<close>
  have "literalTrue ?l (elements (getM state)) \<or> literalFalse ?l (elements (getM state))"
    unfolding applicableDecideCharacterization
    by force
  with \<open>var ?l = x\<close>
  show "x \<in> vars (elements (getM state))"
    using valuationContainsItsLiteralsVariable[of "?l" "elements (getM state)"]
    using valuationContainsItsLiteralsVariable[of "opposite ?l" "elements (getM state)"]
    by auto
qed

lemma finalConflictingState:
  fixes state :: State
  assumes
  "\<not> applicableBacktrack state F0" and
  "formulaFalse F0 (elements (getM state))"
  shows
  "decisions (getM state) = []"
using assms
using applicableBacktrackCharacterization
by auto

lemma finalStateCharacterizationLemma:
  fixes state :: State
  assumes
  "\<not> applicableDecide state decisionVars"  and
  "\<not> applicableBacktrack state F0"
  shows
  "(\<not> formulaFalse F0 (elements (getM state)) \<and> vars (elements (getM state)) \<supseteq> decisionVars) \<or>
   (formulaFalse F0 (elements (getM state)) \<and> decisions (getM state) = [])"
proof (cases "formulaFalse F0 (elements (getM state))")
  case True
  hence "decisions (getM state) = []"
    using assms
    using finalConflictingState
    by auto
  with True
  show ?thesis
    by simp
next
  case False
  hence  "vars (elements (getM state)) \<supseteq> decisionVars"
    using assms
    using finalNonConflictState
    by auto
  with False
  show ?thesis
    by simp
qed

(*----------------------------------------------------------------------------*)
theorem finalStateCharacterization:
  fixes F0 :: Formula and decisionVars :: "Variable set" and state0 :: State and state :: State
  assumes
  "isInitialState state0 F0" and
  "(state0, state) \<in> transitionRelation F0 decisionVars" and
  "isFinalState state F0 decisionVars"
  shows
  "(\<not> formulaFalse F0 (elements (getM state)) \<and> vars (elements (getM state)) \<supseteq> decisionVars) \<or>
   (formulaFalse F0 (elements (getM state)) \<and> decisions (getM state) = [])"
(*----------------------------------------------------------------------------*)
proof-
  from \<open>isFinalState state F0 decisionVars\<close>
  have **:
    "\<not> applicableBacktrack state F0"
    "\<not> applicableDecide state decisionVars"
    unfolding finalStateNonApplicable
    by auto

  thus ?thesis
    using finalStateCharacterizationLemma[of "state" "decisionVars"]
    by simp
qed

text\<open>Completeness theorems are easy consequences of this characterization and
 soundness.\<close>
(*----------------------------------------------------------------------------*)
theorem completenessForSAT:
  fixes F0 :: Formula and decisionVars :: "Variable set" and state0 :: State and state :: State
  assumes
  "satisfiable F0" and

  "isInitialState state0 F0" and
  "(state0, state) \<in> transitionRelation F0 decisionVars" and
  "isFinalState state F0 decisionVars"

  shows "\<not> formulaFalse F0 (elements (getM state)) \<and> vars (elements (getM state)) \<supseteq> decisionVars"
(*----------------------------------------------------------------------------*)
proof-
  from assms
  have *: "(\<not> formulaFalse F0 (elements (getM state)) \<and> vars (elements (getM state)) \<supseteq> decisionVars) \<or>
    (formulaFalse F0 (elements (getM state)) \<and> decisions (getM state) = [])"
    using finalStateCharacterization[of "state0" "F0" "state" "decisionVars"]
    by auto
  {
    assume "formulaFalse F0 (elements (getM state))"
    with *
    have "formulaFalse F0 (elements (getM state))" "decisions (getM state) = []"
      by auto
    with assms
      have "\<not> satisfiable F0"
      using soundnessForUNSAT
      by simp
    with \<open>satisfiable F0\<close>
    have False
      by simp
  }
  with * show ?thesis
    by auto
qed

(*----------------------------------------------------------------------------*)
theorem completenessForUNSAT:
  fixes F0 :: Formula and decisionVars :: "Variable set" and state0 :: State and state :: State
  assumes
  "vars F0 \<subseteq> decisionVars" and
  "\<not> satisfiable F0" and

  "isInitialState state0 F0" and
  "(state0, state) \<in> transitionRelation F0 decisionVars" and
  "isFinalState state F0 decisionVars"

  shows
  "formulaFalse F0 (elements (getM state)) \<and> decisions (getM state) = []"
(*----------------------------------------------------------------------------*)
proof-
  from assms
  have *:
  "(\<not> formulaFalse F0 (elements (getM state)) \<and> vars (elements (getM state)) \<supseteq> decisionVars) \<or>
   (formulaFalse F0 (elements (getM state))  \<and> decisions (getM state) = [])"
    using finalStateCharacterization[of "state0" "F0" "state" "decisionVars"]
    by auto
  {
    assume "\<not> formulaFalse F0 (elements (getM state))"
    with *
    have "\<not> formulaFalse F0 (elements (getM state))" "vars (elements (getM state)) \<supseteq> decisionVars"
      by auto
    with assms
    have "satisfiable F0"
      using soundnessForSAT[of "F0" "decisionVars" "state0" "state"]
      unfolding satisfiable_def
      by auto
    with \<open>\<not> satisfiable F0\<close>
    have False
      by simp
  }
  with * show ?thesis
    by auto
qed

(*----------------------------------------------------------------------------*)
theorem partialCorrectness:
  fixes F0 :: Formula and decisionVars :: "Variable set" and state0 :: State and state :: State
  assumes
  "vars F0 \<subseteq> decisionVars" and

  "isInitialState state0 F0" and
  "(state0, state) \<in> transitionRelation F0 decisionVars" and
  "isFinalState state F0 decisionVars"

  shows
  "satisfiable F0 = (\<not> formulaFalse F0 (elements (getM state)))"
(*----------------------------------------------------------------------------*)
using assms
using completenessForUNSAT[of "F0" "decisionVars" "state0" "state"]
using completenessForSAT[of "F0" "state0" "state" "decisionVars"]
by auto

end


(* Author: Tobias Nipkow. Peter Lammich. *)

section "Hoare Logic"

theory Hoare imports Big_Step begin

subsection "Hoare Logic for Partial Correctness"

type_synonym assn = "state \<Rightarrow> bool"

definition
hoare_valid :: "assn \<Rightarrow> com \<Rightarrow> assn \<Rightarrow> bool" ("\<Turnstile> {(1_)}/ (_)/ {(1_)}" 50) where
"\<Turnstile> {P}c{Q} = (\<forall>s t. P s \<and> (c,s) \<Rightarrow> t  \<longrightarrow>  Q t)"

lemma hoare_validI:
  assumes "\<And>s t. \<lbrakk> P s; (c,s) \<Rightarrow> t \<rbrakk> \<Longrightarrow> Q t"
  shows "\<Turnstile> {P}c{Q}"
  using assms by (auto simp: hoare_valid_def)

lemma conseq_rule:
  assumes "\<And>s. P s \<Longrightarrow> P' s"
  assumes "\<Turnstile> {P'} c {Q'}"
  assumes "\<And>s. Q' s \<Longrightarrow> Q s"
  shows "\<Turnstile> {P} c {Q}"
  using assms by (auto simp: hoare_valid_def)

(* One-sided versions of the consequence rule *)
lemma conseq_pre_rule:
  assumes "\<Turnstile> {P'} c {Q}"
  assumes "\<And>s. P s \<Longrightarrow> P' s"
  shows "\<Turnstile> {P} c {Q}"
  using assms using conseq_rule by blast

lemma conseq_post_rule:
  assumes "\<And>s. Q s \<Longrightarrow> Q' s"
  assumes "\<Turnstile> {P} c {Q}"
  shows "\<Turnstile> {P} c {Q'}"
  using assms using conseq_rule by blast

lemma skip_rule: "\<Turnstile> {P} SKIP {P}"
  by (auto simp: hoare_valid_def)

lemma assign_rule: "\<Turnstile> {\<lambda>s. P(s(x := aval a s))} x::=a {P}"
  by (auto simp: hoare_valid_def)

lemma basic_seq_rule:
  assumes "\<Turnstile> {P} c\<^sub>1 {Q}" "\<Turnstile> {Q} c\<^sub>2 {R}"
  shows "\<Turnstile> {P} c\<^sub>1;;c\<^sub>2 {R}"
  using assms by (auto simp: hoare_valid_def)

lemma if_rule:
  assumes "\<Turnstile> {\<lambda>s. P s \<and> bval b s} c\<^sub>1 {Q}" "\<Turnstile> {\<lambda>s. P s \<and> \<not> bval b s} c\<^sub>2 {Q}"
  shows "\<Turnstile> {P} IF b THEN c\<^sub>1 ELSE c\<^sub>2 {Q}"
  using assms by (auto simp: hoare_valid_def)

lemma basic_while_rule:
  assumes "\<Turnstile> {\<lambda>s. P s \<and> bval b s} c {P}"
  shows "\<Turnstile> {P} WHILE b DO c {\<lambda>s. P s \<and> \<not> bval b s}"
proof (rule hoare_validI)
  fix s t
  assume "(WHILE b DO c, s) \<Rightarrow> t" "P s"
  then show "P t \<and> \<not> bval b t"
  proof (induction "WHILE b DO c" s t rule: big_step_induct)
    case (WhileFalse s)
    then show ?case by simp
  next
    case (WhileTrue s\<^sub>1 s\<^sub>2 s\<^sub>3)
    note IH = \<open>P s\<^sub>2 \<Longrightarrow> P s\<^sub>3 \<and> \<not> bval b s\<^sub>3\<close>

    from \<open>P s\<^sub>1\<close> \<open>bval b s\<^sub>1\<close> \<open>(c, s\<^sub>1) \<Rightarrow> s\<^sub>2\<close> \<open>\<Turnstile> {\<lambda>s. P s \<and> bval b s} c {P}\<close> have "P s\<^sub>2"
      unfolding hoare_valid_def by auto
    with IH show "P s\<^sub>3 \<and> \<not> bval b s\<^sub>3" .
  qed
qed

text \<open>We swap the premises of the sequence rule, as our
  verification condition generator will work on sequences
  from right to left.\<close>
lemma seq_rule:
  assumes "\<Turnstile> {Q} c\<^sub>2 {R}" "\<Turnstile> {P} c\<^sub>1 {Q}"
  shows "\<Turnstile> {P} c\<^sub>1;;c\<^sub>2 {R}"
  using basic_seq_rule assms by blast

text \<open>We combine the while-rule with a consequence rule, to
  make it more usable in verification condition generation\<close>

(* Explicit backwards derivation *)
lemma while_rule:
  assumes "\<Turnstile> {R} c {P}"
  assumes "\<And>s. \<lbrakk>P s; bval b s\<rbrakk> \<Longrightarrow> R s"
  assumes "\<And>s. \<lbrakk>P s; \<not>bval b s\<rbrakk> \<Longrightarrow> Q s"
  shows "\<Turnstile> {P} WHILE b DO c {Q}"
  apply (rule conseq_post_rule[where Q="\<lambda>s. P s \<and> \<not>bval b s"])
  apply (rule assms(3); simp)
  apply (rule basic_while_rule)
  apply (rule conseq_pre_rule)
  apply (rule assms(1))
  apply (rule assms(2); auto)
  done

(* Automatic proof *)
lemma
  assumes "\<Turnstile> {R} c {P}"
  assumes "\<And>s. \<lbrakk>P s; bval b s\<rbrakk> \<Longrightarrow> R s"
  assumes "\<And>s. \<lbrakk>P s; \<not>bval b s\<rbrakk> \<Longrightarrow> Q s"
  shows "\<Turnstile> {P} WHILE b DO c {Q}"
  using conseq_pre_rule conseq_post_rule basic_while_rule
  by (smt assms)

end


(*  Title:       OInvariants.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke
*)

section "Open reachability and invariance"

theory OInvariants
imports Invariants
begin

subsection "Open reachability"

text \<open>
  By convention, the states of an open automaton are pairs. The first component is considered
  to be the global state and the second is the local state.

  A state is `open reachable' under @{term S} and @{term U} if it is the initial state, or it
  is the destination of a transition---where the global components satisfy @{term S}---from an
  open reachable state, or it is the destination of an interleaved environment step where the
  global components satisfy @{term U}.
\<close>

inductive_set oreachable
  :: "('g \<times> 'l, 'a) automaton
      \<Rightarrow> ('g \<Rightarrow> 'g \<Rightarrow> 'a \<Rightarrow> bool)
      \<Rightarrow> ('g \<Rightarrow> 'g \<Rightarrow> bool)
      \<Rightarrow> ('g \<times> 'l) set"
  for A  :: "('g \<times> 'l, 'a) automaton"
  and S  :: "'g \<Rightarrow> 'g \<Rightarrow> 'a \<Rightarrow> bool"
  and U  :: "'g \<Rightarrow> 'g \<Rightarrow> bool"
where
    oreachable_init: "s \<in> init A \<Longrightarrow> s \<in> oreachable A S U"
  | oreachable_local: "\<lbrakk> s \<in> oreachable A S U; (s, a, s') \<in> trans A; S (fst s) (fst s') a \<rbrakk>
                        \<Longrightarrow> s' \<in> oreachable A S U"
  | oreachable_other: "\<lbrakk> s \<in> oreachable A S U; U (fst s) \<sigma>' \<rbrakk>
                        \<Longrightarrow> (\<sigma>', snd s) \<in> oreachable A S U"

lemma oreachable_local' [elim]:
  assumes "(\<sigma>, p) \<in> oreachable A S U"
      and "((\<sigma>, p), a, (\<sigma>', p')) \<in> trans A"
      and "S \<sigma> \<sigma>' a"
    shows "(\<sigma>', p') \<in> oreachable A S U"
  using assms by (metis fst_conv oreachable.oreachable_local)

lemma oreachable_other' [elim]:
  assumes "(\<sigma>, p) \<in> oreachable A S U"
      and "U \<sigma> \<sigma>'"
    shows "(\<sigma>', p) \<in> oreachable A S U"
  proof -
    from \<open>U \<sigma> \<sigma>'\<close> have "U (fst (\<sigma>, p)) \<sigma>'" by simp
    with \<open>(\<sigma>, p) \<in> oreachable A S U\<close> have "(\<sigma>', snd (\<sigma>, p)) \<in> oreachable A S U"
      by (rule oreachable_other)
    thus "(\<sigma>', p) \<in> oreachable A S U" by simp
  qed

lemma oreachable_pair_induct [consumes, case_names init other local]:
  assumes "(\<sigma>, p) \<in> oreachable A S U"
      and "\<And>\<sigma> p. (\<sigma>, p) \<in> init A \<Longrightarrow> P \<sigma> p"
      and "(\<And>\<sigma> p \<sigma>'. \<lbrakk> (\<sigma>, p) \<in> oreachable A S U; P \<sigma> p; U \<sigma> \<sigma>' \<rbrakk> \<Longrightarrow> P \<sigma>' p)"
      and "(\<And>\<sigma> p \<sigma>' p' a. \<lbrakk> (\<sigma>, p) \<in> oreachable A S U; P \<sigma> p;
                            ((\<sigma>, p), a, (\<sigma>', p')) \<in> trans A; S \<sigma> \<sigma>' a \<rbrakk> \<Longrightarrow> P \<sigma>' p')"
    shows "P \<sigma> p"
  using assms (1) proof (induction "(\<sigma>, p)" arbitrary: \<sigma> p)
    fix \<sigma> p
    assume "(\<sigma>, p) \<in> init A"
    with assms(2) show "P \<sigma> p" .
  next
    fix s \<sigma>'
    assume "s \<in> oreachable A S U"
       and "U (fst s) \<sigma>'"
       and IH: "\<And>\<sigma> p. s = (\<sigma>, p) \<Longrightarrow> P \<sigma> p"
    from this(1) obtain \<sigma> p where "s = (\<sigma>, p)"
                              and "(\<sigma>, p) \<in> oreachable A S U"
      by (metis surjective_pairing)
    note this(2)
    moreover from IH and \<open>s = (\<sigma>, p)\<close> have "P \<sigma> p" .
    moreover from \<open>U (fst s) \<sigma>'\<close> and \<open>s = (\<sigma>, p)\<close> have "U \<sigma> \<sigma>'" by simp
    ultimately have "P \<sigma>' p" by (rule assms(3))
    with \<open>s = (\<sigma>, p)\<close> show "P \<sigma>' (snd s)" by simp
  next
    fix s a \<sigma>' p'
    assume "s \<in> oreachable A S U"
       and tr: "(s, a, (\<sigma>', p')) \<in> trans A"
       and "S (fst s) (fst (\<sigma>', p')) a"
       and IH: "\<And>\<sigma> p. s = (\<sigma>, p) \<Longrightarrow> P \<sigma> p"
    from this(1) obtain \<sigma> p where "s = (\<sigma>, p)"
                              and "(\<sigma>, p) \<in> oreachable A S U"
      by (metis surjective_pairing)
    note this(2)
    moreover from IH \<open>s = (\<sigma>, p)\<close> have "P \<sigma> p" .
    moreover from tr and \<open>s = (\<sigma>, p)\<close> have "((\<sigma>, p), a, (\<sigma>', p')) \<in> trans A" by simp
    moreover from \<open>S (fst s) (fst (\<sigma>', p')) a\<close> and \<open>s = (\<sigma>, p)\<close> have "S \<sigma> \<sigma>' a" by simp
    ultimately show "P \<sigma>' p'" by (rule assms(4))
  qed

lemma oreachable_weakenE [elim]:
  assumes "s \<in> oreachable A PS PU"
      and PSQS: "\<And>s s' a. PS s s' a \<Longrightarrow> QS s s' a"
      and PUQU: "\<And>s s'.   PU s s'   \<Longrightarrow> QU s s'"
    shows "s \<in> oreachable A QS QU"
  using assms(1)
  proof (induction)
    fix s assume "s \<in> init A"
    thus "s \<in> oreachable A QS QU" ..
  next
    fix s a s'
    assume "s \<in> oreachable A QS QU"
       and "(s, a, s') \<in> trans A"
       and "PS (fst s) (fst s') a"
    from \<open>PS (fst s) (fst s') a\<close> have "QS (fst s) (fst s') a" by (rule PSQS)
    with \<open>s \<in> oreachable A QS QU\<close> and \<open>(s, a, s') \<in> trans A\<close> show "s' \<in> oreachable A QS QU" ..
  next
    fix s g'
    assume "s \<in> oreachable A QS QU"
       and "PU (fst s) g'"
    from \<open>PU (fst s) g'\<close> have "QU (fst s) g'" by (rule PUQU)
    with \<open>s \<in> oreachable A QS QU\<close> show "(g', snd s) \<in> oreachable A QS QU" ..
  qed

definition
  act :: "('a \<Rightarrow> bool) \<Rightarrow> 's \<Rightarrow> 's \<Rightarrow> 'a \<Rightarrow> bool"
where
  "act I \<equiv> (\<lambda>_ _. I)"

lemma act_simp [iff]: "act I s s' a = I a"
  unfolding act_def ..

lemma reachable_in_oreachable [elim]:
    fixes s
  assumes "s \<in> reachable A I"
    shows "s \<in> oreachable A (act I) U"
  unfolding act_def using assms proof induction
    fix s
    assume "s \<in> init A"
    thus "s \<in> oreachable A (\<lambda>_ _. I) U" ..
  next
    fix s a s'
    assume "s \<in> oreachable A (\<lambda>_ _. I) U"
       and "(s, a, s') \<in> trans A"
       and "I a"
    thus "s' \<in> oreachable A (\<lambda>_ _. I) U"
      by (rule oreachable_local)
  qed

subsection "Open Invariance"

definition oinvariant
  :: "('g \<times> 'l, 'a) automaton
      \<Rightarrow> ('g \<Rightarrow> 'g \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> ('g \<Rightarrow> 'g \<Rightarrow> bool)
      \<Rightarrow> (('g \<times> 'l) \<Rightarrow> bool) \<Rightarrow> bool"
  ("_ \<Turnstile> (1'((1_),/ (1_) \<rightarrow>')/ _)" [100, 0, 0, 9] 8)
where
  "(A \<Turnstile> (S, U \<rightarrow>) P) = (\<forall>s\<in>oreachable A S U. P s)"

lemma oinvariantI [intro]:
    fixes T TI S U P
  assumes init: "\<And>s. s \<in> init A \<Longrightarrow> P s"
      and other: "\<And>g g' l.
                  \<lbrakk> (g, l) \<in> oreachable A S U; P (g, l); U g g' \<rbrakk> \<Longrightarrow> P (g', l)"
      and local: "\<And>s a s'.
                  \<lbrakk> s \<in> oreachable A S U; P s; (s, a, s') \<in> trans A; S (fst s) (fst s') a \<rbrakk> \<Longrightarrow> P s'"
    shows "A \<Turnstile> (S, U \<rightarrow>) P"
  unfolding oinvariant_def
  proof
       fix s
    assume "s \<in> oreachable A S U"
      thus "P s"
    proof induction
      fix s assume "s \<in> init A"
      thus "P s" by (rule init)
    next
      fix s a s'
      assume "s \<in> oreachable A S U"
         and "P s"
         and "(s, a, s') \<in> trans A"
         and "S (fst s) (fst s') a"
        thus "P s'" by (rule local)
     next
       fix s g'
       assume "s \<in> oreachable A S U"
          and "P s"
          and "U (fst s) g'"
         thus "P (g', snd s)"
           by - (rule other [where g="fst s"], simp_all)
    qed
  qed

lemma oinvariant_oreachableI:
  assumes "\<And>\<sigma> s. (\<sigma>, s)\<in>oreachable A S U \<Longrightarrow> P (\<sigma>, s)"
  shows "A \<Turnstile> (S, U \<rightarrow>) P"
  using assms unfolding oinvariant_def by auto

lemma oinvariant_pairI [intro]:
  assumes init: "\<And>\<sigma> p. (\<sigma>, p) \<in> init A \<Longrightarrow> P (\<sigma>, p)"
      and local: "\<And>\<sigma> p \<sigma>' p' a.
                   \<lbrakk> (\<sigma>, p) \<in> oreachable A S U; P (\<sigma>, p); ((\<sigma>, p), a, (\<sigma>', p')) \<in> trans A;
                     S \<sigma> \<sigma>' a \<rbrakk> \<Longrightarrow> P (\<sigma>', p')"
      and other: "\<And>\<sigma> \<sigma>' p.
                  \<lbrakk> (\<sigma>, p) \<in> oreachable A S U; P (\<sigma>, p); U \<sigma> \<sigma>' \<rbrakk> \<Longrightarrow> P (\<sigma>', p)"
    shows "A \<Turnstile> (S, U \<rightarrow>) P"
  by (rule oinvariantI)
     (clarsimp | erule init | erule(3) local | erule(2) other)+

lemma oinvariantD [dest]:
  assumes "A \<Turnstile> (S, U \<rightarrow>) P"
      and "s \<in> oreachable A S U"
    shows "P s"
  using assms unfolding oinvariant_def
  by clarsimp

lemma oinvariant_initD [dest, elim]:
  assumes invP: "A \<Turnstile> (S, U \<rightarrow>) P"
      and init: "s \<in> init A"
    shows "P s"
  proof -
    from init have "s \<in> oreachable A S U" ..
    with invP show ?thesis ..
  qed

lemma oinvariant_weakenE [elim!]:
  assumes invP: "A \<Turnstile> (PS, PU \<rightarrow>) P"
      and PQ:   "\<And>s. P s \<Longrightarrow> Q s"
      and QSPS: "\<And>s s' a. QS s s' a \<Longrightarrow> PS s s' a"
      and QUPU: "\<And>s s'.   QU s s'   \<Longrightarrow> PU s s'"
    shows       "A \<Turnstile> (QS, QU \<rightarrow>) Q"
  proof
    fix s
    assume "s \<in> init A"
    with invP have "P s" ..
    thus "Q s" by (rule PQ)
  next
    fix \<sigma> p \<sigma>' p' a
    assume "(\<sigma>, p) \<in> oreachable A QS QU"
       and "((\<sigma>, p), a, (\<sigma>', p')) \<in> trans A"
       and "QS \<sigma> \<sigma>' a"
    from this(3) have "PS \<sigma> \<sigma>' a" by (rule QSPS)
    from \<open>(\<sigma>, p) \<in> oreachable A QS QU\<close> and QSPS QUPU have "(\<sigma>, p) \<in> oreachable A PS PU" ..
    hence "(\<sigma>', p') \<in> oreachable A PS PU" using \<open>((\<sigma>, p), a, (\<sigma>', p')) \<in> trans A\<close> and \<open>PS \<sigma> \<sigma>' a\<close> ..
    with invP have "P (\<sigma>', p')" ..
    thus "Q (\<sigma>', p')" by (rule PQ)
  next
    fix \<sigma> \<sigma>' p
    assume "(\<sigma>, p) \<in> oreachable A QS QU"
       and "Q (\<sigma>, p)"
       and "QU \<sigma> \<sigma>'"
    from \<open>QU \<sigma> \<sigma>'\<close> have "PU \<sigma> \<sigma>'" by (rule QUPU)
    from \<open>(\<sigma>, p) \<in> oreachable A QS QU\<close> and QSPS QUPU have "(\<sigma>, p) \<in> oreachable A PS PU" ..
    hence "(\<sigma>', p) \<in> oreachable A PS PU" using \<open>PU \<sigma> \<sigma>'\<close> ..
    with invP have "P (\<sigma>', p)" ..
    thus "Q (\<sigma>', p)" by (rule PQ)
  qed

lemma oinvariant_weakenD [dest]:
  assumes "A \<Turnstile> (S', U' \<rightarrow>) P"
      and "(\<sigma>, p) \<in> oreachable A S U"
      and weakenS: "\<And>s s' a. S s s' a \<Longrightarrow> S' s s' a"
      and weakenU: "\<And>s s'. U s s' \<Longrightarrow> U' s s'"
    shows "P (\<sigma>, p)"
  proof -
    from \<open>(\<sigma>, p) \<in> oreachable A S U\<close> have "(\<sigma>, p) \<in> oreachable A S' U'"
      by (rule oreachable_weakenE)
         (erule weakenS, erule weakenU)
    with \<open>A \<Turnstile> (S', U' \<rightarrow>) P\<close> show "P (\<sigma>, p)" ..
  qed

lemma close_open_invariant:
  assumes oinv: "A \<Turnstile> (act I, U \<rightarrow>) P"
    shows "A \<TTurnstile> (I \<rightarrow>) P"
  proof
    fix s
    assume "s \<in> init A"
    with oinv show "P s" ..
  next
    fix \<xi> p \<xi>' p' a
    assume sr: "(\<xi>, p) \<in> reachable A I"
       and step: "((\<xi>, p), a, (\<xi>', p')) \<in> trans A"
       and "I a"
    hence "(\<xi>', p') \<in> reachable A I" ..
    hence "(\<xi>', p') \<in> oreachable A (act I) U" ..
    with oinv show "P (\<xi>', p')" ..
  qed

definition local_steps :: "((('i \<Rightarrow> 's1) \<times> 'l1) \<times> 'a \<times> ('i \<Rightarrow> 's2) \<times> 'l2) set \<Rightarrow> 'i set \<Rightarrow> bool"
where "local_steps T J \<equiv>
   (\<forall>\<sigma> \<zeta> s a \<sigma>' s'. ((\<sigma>, s), a, (\<sigma>', s')) \<in> T \<and> (\<forall>j\<in>J. \<zeta> j = \<sigma> j)
   \<longrightarrow> (\<exists>\<zeta>'. (\<forall>j\<in>J. \<zeta>' j = \<sigma>' j) \<and> ((\<zeta>, s), a, (\<zeta>', s')) \<in> T))"

lemma local_stepsI [intro!]:
  assumes "\<And>\<sigma> \<zeta> s a \<sigma>' \<zeta>' s'. \<lbrakk> ((\<sigma>, s), a, (\<sigma>', s')) \<in> T; \<forall>j\<in>J. \<zeta> j = \<sigma> j \<rbrakk>
                               \<Longrightarrow> (\<exists>\<zeta>'. (\<forall>j\<in>J. \<zeta>' j = \<sigma>' j) \<and> ((\<zeta>, s), a, (\<zeta>', s')) \<in> T)"
    shows "local_steps T J"
  unfolding local_steps_def using assms by clarsimp

lemma local_stepsE [elim, dest]:
  assumes "local_steps T J"
      and "((\<sigma>, s), a, (\<sigma>', s')) \<in> T"
      and "\<forall>j\<in>J. \<zeta> j = \<sigma> j"
    shows "\<exists>\<zeta>'. (\<forall>j\<in>J. \<zeta>' j = \<sigma>' j) \<and> ((\<zeta>, s), a, (\<zeta>', s')) \<in> T"
  using assms unfolding local_steps_def by blast

definition other_steps :: "(('i \<Rightarrow> 's) \<Rightarrow> ('i \<Rightarrow> 's) \<Rightarrow> bool) \<Rightarrow> 'i set \<Rightarrow> bool"
where "other_steps U J \<equiv> \<forall>\<sigma> \<sigma>'. U \<sigma> \<sigma>' \<longrightarrow> (\<forall>j\<in>J. \<sigma>' j = \<sigma> j)"

lemma other_stepsI [intro!]:
  assumes "\<And>\<sigma> \<sigma>' j. \<lbrakk> U \<sigma> \<sigma>'; j \<in> J \<rbrakk> \<Longrightarrow> \<sigma>' j = \<sigma> j"
    shows "other_steps U J"
  using assms unfolding other_steps_def by simp

lemma other_stepsE [elim]:
  assumes "other_steps U J"
      and "U \<sigma> \<sigma>'"
    shows "\<forall>j\<in>J. \<sigma>' j = \<sigma> j"
  using assms unfolding other_steps_def by simp

definition subreachable
where "subreachable A U J \<equiv> \<forall>I. \<forall>s \<in> oreachable A (\<lambda>s s'. I) U.
                                  (\<exists>\<sigma>. (\<forall>j\<in>J. \<sigma> j = (fst s) j) \<and> (\<sigma>, snd s) \<in> reachable A I)"

lemma subreachableI [intro]:
  assumes "local_steps (trans A) J"
      and "other_steps U J"
    shows "subreachable A U J"
  unfolding subreachable_def
  proof (rule, rule)
    fix I s
    assume "s \<in> oreachable A (\<lambda>s s'. I) U"
    thus "(\<exists>\<sigma>. (\<forall>j\<in>J. \<sigma> j = (fst s) j) \<and> (\<sigma>, snd s) \<in> reachable A I)"
    proof induction
      fix s
      assume "s \<in> init A"
      hence "(fst s, snd s) \<in> reachable A I"
        by simp (rule reachable_init)
      moreover have "\<forall>j\<in>J. (fst s) j = (fst s) j"
        by simp
      ultimately show "\<exists>\<sigma>. (\<forall>j\<in>J. \<sigma> j = (fst s) j) \<and> (\<sigma>, snd s) \<in> reachable A I"
        by auto
    next
      fix s a s'
      assume "\<exists>\<sigma>. (\<forall>j\<in>J. \<sigma> j = (fst s) j) \<and> (\<sigma>, snd s) \<in> reachable A I"
         and "(s, a, s') \<in> trans A"
         and "I a"
      then obtain \<zeta> where "\<forall>j\<in>J. \<zeta> j = (fst s) j"
                      and "(\<zeta>, snd s) \<in> reachable A I" by auto

      from \<open>(s, a, s') \<in> trans A\<close> have "((fst s, snd s), a, (fst s', snd s')) \<in> trans A"
        by simp
      with \<open>local_steps (trans A) J\<close> obtain \<zeta>' where "\<forall>j\<in>J. \<zeta>' j = (fst s') j"
                                                 and "((\<zeta>, snd s), a, (\<zeta>', snd s')) \<in> trans A"
        using \<open>\<forall>j\<in>J. \<zeta> j = (fst s) j\<close> by - (drule(2) local_stepsE, clarsimp)
      from \<open>(\<zeta>, snd s) \<in> reachable A I\<close>
       and \<open>((\<zeta>, snd s), a, (\<zeta>', snd s')) \<in> trans A\<close>
       and \<open>I a\<close>
       have "(\<zeta>', snd s') \<in> reachable A I" ..

      with \<open>\<forall>j\<in>J. \<zeta>' j = (fst s') j\<close>
        show "\<exists>\<sigma>. (\<forall>j\<in>J. \<sigma> j = (fst s') j) \<and> (\<sigma>, snd s') \<in> reachable A I" by auto
    next
      fix s \<sigma>'
      assume "\<exists>\<sigma>. (\<forall>j\<in>J. \<sigma> j = (fst s) j) \<and> (\<sigma>, snd s) \<in> reachable A I"
         and "U (fst s) \<sigma>'"
      then obtain \<sigma> where "\<forall>j\<in>J. \<sigma> j = (fst s) j"
                      and "(\<sigma>, snd s) \<in> reachable A I" by auto
      from \<open>other_steps U J\<close> and \<open>U (fst s) \<sigma>'\<close> have "\<forall>j\<in>J. \<sigma>' j = (fst s) j"
        by - (erule(1) other_stepsE)
      with \<open>\<forall>j\<in>J. \<sigma> j = (fst s) j\<close> have "\<forall>j\<in>J. \<sigma> j = \<sigma>' j"
        by clarsimp
      with \<open>(\<sigma>, snd s) \<in> reachable A I\<close>
       show "\<exists>\<sigma>. (\<forall>j\<in>J. \<sigma> j = fst (\<sigma>', snd s) j) \<and> (\<sigma>, snd (\<sigma>', snd s)) \<in> reachable A I"
         by auto
    qed
  qed

lemma subreachableE [elim]:
  assumes "subreachable A U J"
      and "s \<in> oreachable A (\<lambda>s s'. I) U"
    shows "\<exists>\<sigma>. (\<forall>j\<in>J. \<sigma> j = (fst s) j) \<and> (\<sigma>, snd s) \<in> reachable A I"
  using assms unfolding subreachable_def by simp

lemma subreachableE_pair [elim]:
  assumes "subreachable A U J"
      and "(\<sigma>, s) \<in> oreachable A (\<lambda>s s'. I) U"
    shows "\<exists>\<zeta>. (\<forall>j\<in>J. \<zeta> j = \<sigma> j) \<and> (\<zeta>, s) \<in> reachable A I"
  using assms unfolding subreachable_def by (metis fst_conv snd_conv)

lemma subreachable_otherE [elim]:
  assumes "subreachable A U J"
      and "(\<sigma>, l) \<in> oreachable A (\<lambda>s s'. I) U"
      and "U \<sigma> \<sigma>'"
    shows "\<exists>\<zeta>'. (\<forall>j\<in>J. \<zeta>' j = \<sigma>' j) \<and> (\<zeta>', l) \<in> reachable A I"
  proof -
    from \<open>(\<sigma>, l) \<in> oreachable A (\<lambda>s s'. I) U\<close> and \<open>U \<sigma> \<sigma>'\<close>
      have "(\<sigma>', l) \<in> oreachable A (\<lambda>s s'. I) U"
      by - (rule oreachable_other')
    with \<open>subreachable A U J\<close> show ?thesis
      by auto
  qed

lemma oinvariant_anyact:
  assumes "A \<Turnstile> (act TT, U \<rightarrow>) P"
    shows "A \<Turnstile> (S, U \<rightarrow>) P"
  using assms by rule auto

definition
  ostep_invariant
  :: "('g \<times> 'l, 'a) automaton
      \<Rightarrow> ('g \<Rightarrow> 'g \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> ('g \<Rightarrow> 'g \<Rightarrow> bool)
      \<Rightarrow> (('g \<times> 'l, 'a) transition \<Rightarrow> bool) \<Rightarrow> bool"
  ("_ \<Turnstile>\<^sub>A (1'((1_),/ (1_) \<rightarrow>')/ _)" [100, 0, 0, 9] 8)
where
  "(A \<Turnstile>\<^sub>A (S, U \<rightarrow>) P) =
     (\<forall>s\<in>oreachable A S U. (\<forall>a s'. (s, a, s') \<in> trans A \<and> S (fst s) (fst s') a \<longrightarrow> P (s, a, s')))"

lemma ostep_invariant_def':
  "(A \<Turnstile>\<^sub>A (S, U \<rightarrow>) P) = (\<forall>s\<in>oreachable A S U.
                           (\<forall>a s'. (s, a, s') \<in> trans A \<and> S (fst s) (fst s') a \<longrightarrow> P (s, a, s')))"
  unfolding ostep_invariant_def by auto

lemma ostep_invariantI [intro]:
  assumes *: "\<And>\<sigma> s a \<sigma>' s'. \<lbrakk> (\<sigma>, s)\<in>oreachable A S U; ((\<sigma>, s), a, (\<sigma>', s')) \<in> trans A; S \<sigma> \<sigma>' a \<rbrakk>
                             \<Longrightarrow> P ((\<sigma>, s), a, (\<sigma>', s'))"
    shows "A \<Turnstile>\<^sub>A (S, U \<rightarrow>) P"
  unfolding ostep_invariant_def
  using assms by auto

lemma ostep_invariantD [dest]:
  assumes "A \<Turnstile>\<^sub>A (S, U \<rightarrow>) P"
      and "(\<sigma>, s)\<in>oreachable A S U"
      and "((\<sigma>, s), a, (\<sigma>', s')) \<in> trans A"
      and "S \<sigma> \<sigma>' a"
    shows "P ((\<sigma>, s), a, (\<sigma>', s'))"
  using assms unfolding ostep_invariant_def' by clarsimp

lemma ostep_invariantE [elim]:
  assumes "A \<Turnstile>\<^sub>A (S, U \<rightarrow>) P"
      and "(\<sigma>, s)\<in>oreachable A S U"
      and "((\<sigma>, s), a, (\<sigma>', s')) \<in> trans A"
      and "S \<sigma> \<sigma>' a"
      and "P ((\<sigma>, s), a, (\<sigma>', s')) \<Longrightarrow> Q"
    shows "Q"
  using assms by auto

lemma ostep_invariant_weakenE [elim!]:
  assumes invP: "A \<Turnstile>\<^sub>A (PS, PU \<rightarrow>) P"
      and PQ:   "\<And>t. P t \<Longrightarrow> Q t"
      and QSPS: "\<And>\<sigma> \<sigma>' a. QS \<sigma> \<sigma>' a \<Longrightarrow> PS \<sigma> \<sigma>' a"
      and QUPU: "\<And>\<sigma> \<sigma>'.   QU \<sigma> \<sigma>'   \<Longrightarrow> PU \<sigma> \<sigma>'"
    shows       "A \<Turnstile>\<^sub>A (QS, QU \<rightarrow>) Q"
  proof
    fix \<sigma> s \<sigma>' s' a
    assume "(\<sigma>, s) \<in> oreachable A QS QU"
       and "((\<sigma>, s), a, (\<sigma>', s')) \<in> trans A"
       and "QS \<sigma> \<sigma>' a"
    from \<open>QS \<sigma> \<sigma>' a\<close> have "PS \<sigma> \<sigma>' a" by (rule QSPS)
    from \<open>(\<sigma>, s) \<in> oreachable A QS QU\<close> have "(\<sigma>, s) \<in> oreachable A PS PU" using QSPS QUPU ..
    with invP have "P ((\<sigma>, s), a, (\<sigma>', s'))" using \<open>((\<sigma>, s), a, (\<sigma>', s')) \<in> trans A\<close> \<open>PS \<sigma> \<sigma>' a\<close> ..
    thus "Q ((\<sigma>, s), a, (\<sigma>', s'))" by (rule PQ)
  qed

lemma ostep_invariant_weaken_with_invariantE [elim]:
  assumes pinv: "A \<Turnstile> (S, U \<rightarrow>) P"
      and qinv: "A \<Turnstile>\<^sub>A (S, U \<rightarrow>) Q"
      and wr: "\<And>\<sigma> s a \<sigma>' s'. \<lbrakk> P (\<sigma>, s); P (\<sigma>', s'); Q ((\<sigma>, s), a, (\<sigma>', s')); S \<sigma> \<sigma>' a \<rbrakk>
                              \<Longrightarrow> R ((\<sigma>, s), a, (\<sigma>', s'))"
    shows "A \<Turnstile>\<^sub>A (S, U \<rightarrow>) R"
  proof
    fix \<sigma> s a \<sigma>' s'
    assume sr: "(\<sigma>, s) \<in> oreachable A S U"
       and tr: "((\<sigma>, s), a, (\<sigma>', s')) \<in> trans A"
       and "S \<sigma> \<sigma>' a"
    hence "(\<sigma>', s') \<in> oreachable A S U" ..
    with pinv have "P (\<sigma>', s')" ..
    from pinv and sr have "P (\<sigma>, s)" ..
    from qinv sr tr \<open>S \<sigma> \<sigma>' a\<close> have "Q ((\<sigma>, s), a, (\<sigma>', s'))" ..
    with \<open>P (\<sigma>, s)\<close> and \<open>P (\<sigma>', s')\<close> show "R ((\<sigma>, s), a, (\<sigma>', s'))" using \<open>S \<sigma> \<sigma>' a\<close> by (rule wr)
  qed

lemma ostep_to_invariantI:
  assumes sinv: "A \<Turnstile>\<^sub>A (S, U \<rightarrow>) Q"
      and init: "\<And>\<sigma> s. (\<sigma>, s) \<in> init A \<Longrightarrow> P (\<sigma>, s)"
      and local: "\<And>\<sigma> s \<sigma>' s' a.
                    \<lbrakk> (\<sigma>, s) \<in> oreachable A S U;
                      P (\<sigma>, s);
                      Q ((\<sigma>, s), a, (\<sigma>', s'));
                      S \<sigma> \<sigma>' a \<rbrakk> \<Longrightarrow> P (\<sigma>', s')"
      and other: "\<And>\<sigma> \<sigma>' s. \<lbrakk> (\<sigma>, s) \<in> oreachable A S U; U \<sigma> \<sigma>'; P (\<sigma>, s) \<rbrakk> \<Longrightarrow> P (\<sigma>', s)"
    shows "A \<Turnstile> (S, U \<rightarrow>) P"
  proof
    fix \<sigma> s assume "(\<sigma>, s) \<in> init A" thus "P (\<sigma>, s)" by (rule init)
  next
    fix \<sigma> s \<sigma>' s' a
    assume "(\<sigma>, s) \<in> oreachable A S U"
       and "P (\<sigma>, s)"
       and "((\<sigma>, s), a, (\<sigma>', s')) \<in> trans A"
       and "S \<sigma> \<sigma>' a"
      show "P (\<sigma>', s')"
    proof -
      from sinv and \<open>(\<sigma>, s)\<in>oreachable A S U\<close> and \<open>((\<sigma>, s), a, (\<sigma>', s')) \<in> trans A\<close> and \<open>S \<sigma> \<sigma>' a\<close>
        have "Q ((\<sigma>, s), a, (\<sigma>', s'))" ..
      with \<open>(\<sigma>, s)\<in>oreachable A S U\<close> and \<open>P (\<sigma>, s)\<close> show "P (\<sigma>', s')"
        using \<open>S \<sigma> \<sigma>' a\<close> by (rule local)
    qed
  next
    fix \<sigma> \<sigma>' l
    assume "(\<sigma>, l) \<in> oreachable A S U"
       and "U \<sigma> \<sigma>'"
       and "P (\<sigma>, l)"
      thus "P (\<sigma>', l)" by (rule other)
  qed

lemma open_closed_step_invariant:
  assumes "A \<TTurnstile>\<^sub>A (I \<rightarrow>) P"
      and "local_steps (trans A) J"
      and "other_steps U J"
      and localp: "\<And>\<sigma> \<zeta> a \<sigma>' \<zeta>' s s'.
                   \<lbrakk> \<forall>j\<in>J. \<sigma> j = \<zeta> j; \<forall>j\<in>J. \<sigma>' j = \<zeta>' j; P ((\<sigma>, s), a, (\<sigma>', s')) \<rbrakk>
                   \<Longrightarrow> P ((\<zeta>, s), a, (\<zeta>', s'))"
    shows "A \<Turnstile>\<^sub>A (act I, U \<rightarrow>) P"
  proof
    fix \<sigma> s a \<sigma>' s'
    assume or: "(\<sigma>, s) \<in> oreachable A (act I) U"
       and tr: "((\<sigma>, s), a, (\<sigma>', s')) \<in> trans A"
       and "act I \<sigma> \<sigma>' a"
    from \<open>act I \<sigma> \<sigma>' a\<close> have "I a" ..
    from \<open>local_steps (trans A) J\<close> and \<open>other_steps U J\<close> have "subreachable A U J" ..
    then obtain \<zeta> where "\<forall>j\<in>J. \<zeta> j = \<sigma> j"
                    and "(\<zeta>, s) \<in> reachable A I"
      using or unfolding act_def
        by (auto dest!: subreachableE_pair)

     from \<open>local_steps (trans A) J\<close> and tr and \<open>\<forall>j\<in>J. \<zeta> j = \<sigma> j\<close>
       obtain \<zeta>' where "\<forall>j\<in>J. \<zeta>' j = \<sigma>' j"
                   and "((\<zeta>, s), a, (\<zeta>', s')) \<in> trans A"
       by auto

    from \<open>A \<TTurnstile>\<^sub>A (I \<rightarrow>) P\<close> and \<open>(\<zeta>, s) \<in> reachable A I\<close>
                          and \<open>((\<zeta>, s), a, (\<zeta>', s')) \<in> trans A\<close>
                          and \<open>I a\<close>
      have "P ((\<zeta>, s), a, (\<zeta>', s'))" ..
    with \<open>\<forall>j\<in>J. \<zeta> j = \<sigma> j\<close> and \<open>\<forall>j\<in>J. \<zeta>' j = \<sigma>' j\<close> show "P ((\<sigma>, s), a, (\<sigma>', s'))"
      by (rule localp)
  qed

lemma oinvariant_step_anyact:
  assumes "p \<Turnstile>\<^sub>A (act TT, U \<rightarrow>) P"
    shows "p \<Turnstile>\<^sub>A (S, U \<rightarrow>) P"
  using assms by rule auto

subsection "Standard assumption predicates "

text \<open>otherwith\<close>

definition otherwith :: "('s \<Rightarrow> 's \<Rightarrow> bool)
                          \<Rightarrow> 'i set
                          \<Rightarrow> (('i \<Rightarrow> 's) \<Rightarrow> 'a \<Rightarrow> bool)
                          \<Rightarrow> ('i \<Rightarrow> 's) \<Rightarrow> ('i \<Rightarrow> 's) \<Rightarrow> 'a \<Rightarrow> bool"
where "otherwith Q I P \<sigma> \<sigma>' a \<equiv> (\<forall>i. i\<notin>I \<longrightarrow> Q (\<sigma> i) (\<sigma>' i)) \<and> P \<sigma> a"

lemma otherwithI [intro]:
  assumes other: "\<And>j. j\<notin>I \<Longrightarrow> Q (\<sigma> j) (\<sigma>' j)"
      and sync:  "P \<sigma> a"
    shows "otherwith Q I P \<sigma> \<sigma>' a"
  unfolding otherwith_def using assms by simp

lemma otherwithE [elim]:
  assumes "otherwith Q I P \<sigma> \<sigma>' a"
      and "\<lbrakk> P \<sigma> a; \<forall>j. j\<notin>I \<longrightarrow> Q (\<sigma> j) (\<sigma>' j) \<rbrakk> \<Longrightarrow> R \<sigma> \<sigma>' a"
    shows "R \<sigma> \<sigma>' a"
  using assms unfolding otherwith_def by simp

lemma otherwith_actionD [dest]:
  assumes "otherwith Q I P \<sigma> \<sigma>' a"
    shows "P \<sigma> a"
  using assms by auto

lemma otherwith_syncD [dest]:
  assumes "otherwith Q I P \<sigma> \<sigma>' a"
    shows "\<forall>j. j\<notin>I \<longrightarrow> Q (\<sigma> j) (\<sigma>' j)"
  using assms by auto

lemma otherwithEI [elim]:
  assumes "otherwith P I PO \<sigma> \<sigma>' a"
      and "\<And>\<sigma> a. PO \<sigma> a \<Longrightarrow> QO \<sigma> a"
    shows "otherwith P I QO \<sigma> \<sigma>' a"
  using assms(1) unfolding otherwith_def
  by (clarsimp elim!: assms(2))

lemma all_but:
  assumes "\<And>\<xi>. S \<xi> \<xi>"
      and "\<sigma>' i = \<sigma> i"
      and "\<forall>j. j \<noteq> i \<longrightarrow> S (\<sigma> j) (\<sigma>' j)"
    shows "\<forall>j. S (\<sigma> j) (\<sigma>' j)"
  using assms by metis

lemma all_but_eq [dest]:
  assumes "\<sigma>' i = \<sigma> i"
      and "\<forall>j. j \<noteq> i \<longrightarrow> \<sigma> j = \<sigma>' j"
    shows "\<sigma> = \<sigma>'"
  using assms by - (rule ext, metis)

text \<open>other\<close>

definition other :: "('s \<Rightarrow> 's \<Rightarrow> bool) \<Rightarrow> 'i set \<Rightarrow> ('i \<Rightarrow> 's) \<Rightarrow> ('i \<Rightarrow> 's) \<Rightarrow> bool"
where "other P I \<sigma> \<sigma>' \<equiv> \<forall>i. if i\<in>I then \<sigma>' i = \<sigma> i else P (\<sigma> i) (\<sigma>' i)"

lemma otherI [intro]:
  assumes local: "\<And>i. i\<in>I \<Longrightarrow> \<sigma>' i = \<sigma> i"
      and other: "\<And>j. j\<notin>I \<Longrightarrow> P (\<sigma> j) (\<sigma>' j)"
    shows "other P I \<sigma> \<sigma>'"
  using assms unfolding other_def by clarsimp

lemma otherE [elim]:
  assumes "other P I \<sigma> \<sigma>'"
      and "\<lbrakk> \<forall>i\<in>I. \<sigma>' i = \<sigma> i; \<forall>j. j\<notin>I \<longrightarrow> P (\<sigma> j) (\<sigma>' j) \<rbrakk> \<Longrightarrow> R \<sigma> \<sigma>'"
    shows "R \<sigma> \<sigma>'"
  using assms unfolding other_def by simp

lemma other_localD [dest]:
  "other P {i} \<sigma> \<sigma>' \<Longrightarrow> \<sigma>' i = \<sigma> i"
  by auto

lemma other_otherD [dest]:
  "other P {i} \<sigma> \<sigma>' \<Longrightarrow> \<forall>j. j\<noteq>i \<longrightarrow> P (\<sigma> j) (\<sigma>' j)"
  by auto

lemma other_bothE [elim]:
  assumes "other P {i} \<sigma> \<sigma>'"
  obtains "\<sigma>' i = \<sigma> i" and "\<forall>j. j\<noteq>i \<longrightarrow> P (\<sigma> j) (\<sigma>' j)"
  using assms by auto

lemma weaken_local [elim]:
  assumes "other P I \<sigma> \<sigma>'"
      and PQ: "\<And>\<xi> \<xi>'. P \<xi> \<xi>' \<Longrightarrow> Q \<xi> \<xi>'"
    shows "other Q I \<sigma> \<sigma>'"
  using assms unfolding other_def by auto

definition global :: "((nat \<Rightarrow> 's) \<Rightarrow> bool) \<Rightarrow> (nat \<Rightarrow> 's) \<times> 'local \<Rightarrow> bool"
where "global P \<equiv> (\<lambda>(\<sigma>, _). P \<sigma>)"

lemma globalsimp [simp]: "global P s = P (fst s)"
  unfolding global_def by (simp split: prod.split)

definition globala :: "((nat \<Rightarrow> 's, 'action) transition \<Rightarrow> bool)
                       \<Rightarrow> ((nat \<Rightarrow> 's) \<times> 'local, 'action) transition \<Rightarrow> bool"
where "globala P \<equiv> (\<lambda>((\<sigma>, _), a, (\<sigma>', _)). P (\<sigma>, a, \<sigma>'))"

lemma globalasimp [simp]: "globala P s = P (fst (fst s), fst (snd s), fst (snd (snd s)))"
  unfolding globala_def by (simp split: prod.split)

end