(*  Title:      JinjaThreads/BV/JVM_SemiType.thy
    Author:     Gerwin Klein, Andreas Lochbihler

    Based on the theory Jinja/BV/JVM_SemiType
*)

chapter \<open>Bytecode verifier\<close>

section \<open>The JVM Type System as Semilattice\<close>

theory JVM_SemiType
imports
  "../Common/SemiType"
begin

type_synonym ty\<^sub>l = "ty err list"
type_synonym ty\<^sub>s = "ty list"
type_synonym ty\<^sub>i = "ty\<^sub>s \<times> ty\<^sub>l"
type_synonym ty\<^sub>i' = "ty\<^sub>i option"
type_synonym ty\<^sub>m = "ty\<^sub>i' list"
type_synonym ty\<^sub>P = "mname \<Rightarrow> cname \<Rightarrow> ty\<^sub>m"

definition stk_esl :: "'c prog \<Rightarrow> nat \<Rightarrow> ty\<^sub>s esl"
where
  "stk_esl P mxs \<equiv> upto_esl mxs (SemiType.esl P)"

definition loc_sl :: "'c prog \<Rightarrow> nat \<Rightarrow> ty\<^sub>l sl"
where
  "loc_sl P mxl \<equiv> Listn.sl mxl (Err.sl (SemiType.esl P))"

definition sl :: "'c prog \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> ty\<^sub>i' err sl"
where
  "sl P mxs mxl \<equiv>
  Err.sl(Opt.esl(Product.esl (stk_esl P mxs) (Err.esl(loc_sl P mxl))))"

definition "states" :: "'c prog \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> ty\<^sub>i' err set"
where
  "states P mxs mxl \<equiv> fst(sl P mxs mxl)"

definition le :: "'c prog \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> ty\<^sub>i' err ord"
where
  "le P mxs mxl \<equiv> fst(snd(sl P mxs mxl))"

definition sup :: "'c prog \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> ty\<^sub>i' err binop"
where
  "sup P mxs mxl \<equiv> snd(snd(sl P mxs mxl))"

definition sup_ty_opt :: "['c prog,ty err,ty err] \<Rightarrow> bool"
  ("_ \<turnstile> _ \<le>\<^sub>\<top> _" [71,71,71] 70)
where
  "sup_ty_opt P \<equiv> Err.le (widen P)"

definition sup_state :: "['c prog,ty\<^sub>i,ty\<^sub>i] \<Rightarrow> bool"
  ("_ \<turnstile> _ \<le>\<^sub>i _" [71,71,71] 70)
where
  "sup_state P \<equiv> Product.le (Listn.le (widen P)) (Listn.le (sup_ty_opt P))"

definition sup_state_opt :: "['c prog,ty\<^sub>i',ty\<^sub>i'] \<Rightarrow> bool"
  ("_ \<turnstile> _ \<le>'' _" [71,71,71] 70)
where
  "sup_state_opt P \<equiv> Opt.le (sup_state P)"

abbreviation sup_loc :: "['c prog,ty\<^sub>l,ty\<^sub>l] \<Rightarrow> bool" ("_ \<turnstile> _ [\<le>\<^sub>\<top>] _"  [71,71,71] 70)
where "P \<turnstile> LT [\<le>\<^sub>\<top>] LT' \<equiv> list_all2 (sup_ty_opt P) LT LT'"

notation (ASCII)
  sup_ty_opt ("_ |- _ <=T _" [71,71,71] 70) and
  sup_state ("_ |- _ <=i _"  [71,71,71] 70) and
  sup_state_opt ("_ |- _ <=' _"  [71,71,71] 70) and
  sup_loc ("_ |- _ [<=T] _"  [71,71,71] 70)

subsection "Unfolding"

lemma JVM_states_unfold:
  "states P mxs mxl \<equiv> err(opt((Union {list n (types P) |n. n <= mxs}) \<times>
                                 list mxl (err(types P))))"
  apply (unfold states_def sl_def Opt.esl_def Err.sl_def
         stk_esl_def loc_sl_def Product.esl_def
         Listn.sl_def upto_esl_def SemiType.esl_def Err.esl_def)
  apply simp
  done

lemma JVM_le_unfold:
 "le P m n \<equiv>
  Err.le(Opt.le(Product.le(Listn.le(widen P))(Listn.le(Err.le(widen P)))))"
  apply (unfold le_def sl_def Opt.esl_def Err.sl_def
         stk_esl_def loc_sl_def Product.esl_def
         Listn.sl_def upto_esl_def SemiType.esl_def Err.esl_def)
  apply simp
  done

lemma sl_def2:
  "JVM_SemiType.sl P mxs mxl \<equiv>
  (states P mxs mxl, JVM_SemiType.le P mxs mxl, JVM_SemiType.sup P mxs mxl)"
 by (unfold JVM_SemiType.sup_def states_def JVM_SemiType.le_def) simp

lemma JVM_le_conv:
  "le P m n (OK t1) (OK t2) = P \<turnstile> t1 \<le>' t2"
 by (simp add: JVM_le_unfold Err.le_def lesub_def sup_state_opt_def
                sup_state_def sup_ty_opt_def)

lemma JVM_le_Err_conv:
  "le P m n = Err.le (sup_state_opt P)"
 by (unfold sup_state_opt_def sup_state_def
             sup_ty_opt_def JVM_le_unfold) simp

lemma err_le_unfold [iff]:
  "Err.le r (OK a) (OK b) = r a b"
 by (simp add: Err.le_def lesub_def)

subsection \<open>Semilattice\<close>

lemma order_sup_state_opt [intro, simp]:
  "wf_prog wf_mb P \<Longrightarrow> order (sup_state_opt P)"
 by (unfold sup_state_opt_def sup_state_def sup_ty_opt_def) blast

lemma semilat_JVM [intro?]:
  "wf_prog wf_mb P \<Longrightarrow> semilat (JVM_SemiType.sl P mxs mxl)"
  apply (unfold JVM_SemiType.sl_def stk_esl_def loc_sl_def)
  apply (blast intro: err_semilat_Product_esl err_semilat_upto_esl
                      Listn_sl err_semilat_JType_esl)
  done

lemma acc_JVM [intro]:
  "wf_prog wf_mb P \<Longrightarrow> acc (JVM_SemiType.states P mxs mxl) (JVM_SemiType.le P mxs mxl)"
by(unfold JVM_le_unfold JVM_states_unfold) blast

subsection \<open>Widening with \<open>\<top>\<close>\<close>

lemma widen_refl[iff]: "widen P t t"  by (simp add: fun_of_def)

lemma sup_ty_opt_refl [iff]: "P \<turnstile> T \<le>\<^sub>\<top> T"
  apply (unfold sup_ty_opt_def)
  apply (fold lesub_def)
  apply (rule le_err_refl)
  apply (simp add: lesub_def)
  done

lemma Err_any_conv [iff]: "P \<turnstile> Err \<le>\<^sub>\<top> T = (T = Err)"
 by (unfold sup_ty_opt_def) (rule Err_le_conv [simplified lesub_def])

lemma any_Err [iff]: "P \<turnstile> T \<le>\<^sub>\<top> Err"
 by (unfold sup_ty_opt_def) (rule le_Err [simplified lesub_def])

lemma OK_OK_conv [iff]:
  "P \<turnstile> OK T \<le>\<^sub>\<top> OK T' = P \<turnstile> T \<le> T'"
 by (simp add: sup_ty_opt_def fun_of_def)

lemma any_OK_conv [iff]:
  "P \<turnstile> X \<le>\<^sub>\<top> OK T' = (\<exists>T. X = OK T \<and> P \<turnstile> T \<le> T')"
  apply (unfold sup_ty_opt_def)
  apply (rule le_OK_conv [simplified lesub_def])
  done

lemma OK_any_conv:
 "P \<turnstile> OK T \<le>\<^sub>\<top> X = (X = Err \<or> (\<exists>T'. X = OK T' \<and> P \<turnstile> T \<le> T'))"
  apply (unfold sup_ty_opt_def)
  apply (rule OK_le_conv [simplified lesub_def])
  done

lemma sup_ty_opt_trans [intro?, trans]:
  "\<lbrakk>P \<turnstile> a \<le>\<^sub>\<top> b; P \<turnstile> b \<le>\<^sub>\<top> c\<rbrakk> \<Longrightarrow> P \<turnstile> a \<le>\<^sub>\<top> c"
 by (auto intro: widen_trans
           simp add: sup_ty_opt_def Err.le_def lesub_def fun_of_def
           split: err.splits)

subsection "Stack and Registers"

lemma stk_convert:
  "P \<turnstile> ST [\<le>] ST' = Listn.le (widen P) ST ST'"
 by (simp add: Listn.le_def lesub_def)

lemma sup_loc_refl [iff]: "P \<turnstile> LT [\<le>\<^sub>\<top>] LT"
 by (rule list_all2_refl) simp

lemmas sup_loc_Cons1 [iff] = list_all2_Cons1 [of "sup_ty_opt P"] for P

lemma sup_loc_def:
  "P \<turnstile> LT [\<le>\<^sub>\<top>] LT' \<equiv> Listn.le (sup_ty_opt P) LT LT'"
 by (simp add: Listn.le_def lesub_def)

lemma sup_loc_widens_conv [iff]:
  "P \<turnstile> map OK Ts [\<le>\<^sub>\<top>] map OK Ts' = P \<turnstile> Ts [\<le>] Ts'"
  by (simp add: list_all2_map1 list_all2_map2)

lemma sup_loc_trans [intro?, trans]:
  "\<lbrakk>P \<turnstile> a [\<le>\<^sub>\<top>] b; P \<turnstile> b [\<le>\<^sub>\<top>] c\<rbrakk> \<Longrightarrow> P \<turnstile> a [\<le>\<^sub>\<top>] c"
 by (rule list_all2_trans, rule sup_ty_opt_trans)

subsection "State Type"

lemma sup_state_conv [iff]:
  "P \<turnstile> (ST,LT) \<le>\<^sub>i (ST',LT') = (P \<turnstile> ST [\<le>] ST' \<and> P \<turnstile> LT [\<le>\<^sub>\<top>] LT')"
 by (auto simp add: sup_state_def stk_convert lesub_def Product.le_def sup_loc_def)

lemma sup_state_conv2:
  "P \<turnstile> s1 \<le>\<^sub>i s2 = (P \<turnstile> fst s1 [\<le>] fst s2 \<and> P \<turnstile> snd s1 [\<le>\<^sub>\<top>] snd s2)"
 by (cases s1, cases s2) simp

lemma sup_state_refl [iff]: "P \<turnstile> s \<le>\<^sub>i s"
by (auto simp add: sup_state_conv2 intro: list_all2_refl)

lemma sup_state_trans [intro?, trans]:
  "\<lbrakk>P \<turnstile> a \<le>\<^sub>i b; P \<turnstile> b \<le>\<^sub>i c\<rbrakk> \<Longrightarrow> P \<turnstile> a \<le>\<^sub>i c"
 by (auto intro: sup_loc_trans widens_trans simp add: sup_state_conv2)

lemma sup_state_opt_None_any [iff]:
  "P \<turnstile> None \<le>' s"
 by (simp add: sup_state_opt_def Opt.le_def)

lemma sup_state_opt_any_None [iff]:
  "P \<turnstile> s \<le>' None = (s = None)"
 by (simp add: sup_state_opt_def Opt.le_def)

lemma sup_state_opt_Some_Some [iff]:
  "P \<turnstile> Some a \<le>' Some b = P \<turnstile> a \<le>\<^sub>i b"
 by (simp add: sup_state_opt_def Opt.le_def lesub_def)

lemma sup_state_opt_any_Some:
  "P \<turnstile> (Some s) \<le>' X = (\<exists>s'. X = Some s' \<and> P \<turnstile> s \<le>\<^sub>i s')"
 by (simp add: sup_state_opt_def Opt.le_def lesub_def)

lemma sup_state_opt_refl [iff]: "P \<turnstile> s \<le>' s"
 by (simp add: sup_state_opt_def Opt.le_def lesub_def)

lemma sup_state_opt_trans [intro?, trans]:
  "\<lbrakk>P \<turnstile> a \<le>' b; P \<turnstile> b \<le>' c\<rbrakk> \<Longrightarrow> P \<turnstile> a \<le>' c"
  apply (unfold sup_state_opt_def Opt.le_def lesub_def)
  apply (simp del: split_paired_All)
  apply (rule sup_state_trans, assumption+)
  done

end


section\<open>FLPSystem\<close>

text \<open>
  \file{FLPSystem} extends \file{AsynchronousSystem} with concepts of consensus
  and decisions. It develops a concept of non-uniformity regarding pending
  decision possibilities, where non-uniform configurations can always
  reach other non-uniform ones.
\<close>

theory FLPSystem
imports AsynchronousSystem ListUtilities
begin

subsection\<open>Locale for the FLP consensus setting\<close>

locale flpSystem =
  asynchronousSystem trans sends start
    for trans :: "'p::finite \<Rightarrow> 's \<Rightarrow> 'v messageValue \<Rightarrow>'s"
    and sends :: "'p \<Rightarrow> 's \<Rightarrow> 'v messageValue \<Rightarrow> ('p, 'v) message multiset"
    and start :: "'p \<Rightarrow> 's" +
assumes minimalProcs: "card Proc \<ge> 2"
    and finiteSends: "finite {v. v \<in># (sends p s m)}"
    and noInSends: " <p2, inM v> \<notin># sends p s m"
begin

subsection\<open>Decidedness and uniformity of configurations\<close>

abbreviation vDecided ::
  "bool \<Rightarrow> ('p, 'v, 's) configuration \<Rightarrow> bool"
where
  "vDecided v cfg \<equiv> (<\<bottom>, outM v> \<in># msgs cfg)"

abbreviation decided ::
  "('p, 'v, 's) configuration \<Rightarrow> bool"
where
  "decided cfg \<equiv> (\<exists>v . vDecided v cfg)"

definition pSilDecVal ::
  "bool \<Rightarrow> 'p \<Rightarrow> ('p, 'v, 's) configuration \<Rightarrow> bool"
where
  "pSilDecVal v p c \<equiv>
    (\<exists> c'::('p, 'v, 's) configuration . (withoutQReachable c {p} c')
    \<and> vDecided v c')"

definition pSilentDecisionValues ::
  "'p \<Rightarrow> ('p, 'v, 's) configuration \<Rightarrow> bool set" ("val[_,_]")
where
  pSilentDecisionValues_def[simp]:"val[p, c] \<equiv> {v. pSilDecVal v p c}"

definition vUniform ::
  "bool \<Rightarrow> ('p, 'v, 's) configuration \<Rightarrow> bool"
where
  "vUniform v c \<equiv> (\<forall>p. val[p,c] = {v})"

abbreviation nonUniform ::
  "('p, 'v, 's) configuration \<Rightarrow> bool"
where
  "nonUniform c \<equiv>
    \<not>(vUniform False c) \<and>
    \<not>(vUniform True c)"

subsection\<open>Agreement, validity, termination\<close>

text\<open>
  Völzer defines consensus in terms of the classical notions
  of agreement, validity, and termination. The proof then mostly applies a
  weakened notion of termination, which we refer to as ,,pseudo termination''.
\<close>

definition agreement ::
  "('p, 'v, 's) configuration \<Rightarrow> bool"
where
  "agreement c \<equiv>
    (\<forall>v1. (<\<bottom>, outM v1> \<in># msgs c)
      \<longrightarrow> (\<forall>v2. (<\<bottom>, outM v2> \<in># msgs c)
        \<longleftrightarrow> v2 = v1))"

definition agreementInit ::
  "('p, 'v, 's) configuration \<Rightarrow> ('p, 'v, 's) configuration \<Rightarrow> bool"
where
  "agreementInit i c \<equiv>
    initial i \<and> reachable i c \<longrightarrow>
      (\<forall>v1. (<\<bottom>, outM v1> \<in># msgs c)
        \<longrightarrow> (\<forall>v2. (<\<bottom>, outM v2> \<in># msgs c)
          \<longleftrightarrow> v2 = v1))"

definition validity ::
  "('p, 'v, 's) configuration \<Rightarrow> ('p, 'v, 's) configuration \<Rightarrow> bool"
where
  "validity i c \<equiv>
    initial i \<and> reachable i c \<longrightarrow>
      (\<forall>v. (<\<bottom>, outM v> \<in># msgs c)
        \<longrightarrow> (\<exists>p. (<p, inM v> \<in># msgs i)))"

text\<open>
  The termination concept which is implied by the concept of "pseudo-consensus"
  in the paper.
\<close>
definition terminationPseudo ::
  "nat \<Rightarrow> ('p, 'v, 's) configuration \<Rightarrow> 'p set \<Rightarrow> bool"
where
  "terminationPseudo t c Q \<equiv> ((initReachable c \<and> card Q + t \<ge> card Proc)
    \<longrightarrow> (\<exists>c'. qReachable c Q c' \<and> decided c'))"

subsection \<open>Propositions about decisions\<close>

text\<open>
  For every process \var{p} and every configuration that is reachable from an
  initial configuration (i.e. \isb{initReachable} \var{c}) we have
  $\var{val(p,c)} \neq \emptyset$.

  This follows directly from the definition of \var{val} and the definition of
  \isb{terminationPseudo}, which has to be assumed to ensure that there is a
  reachable configuration that is decided.

  \voelzer{Proposition 2(a)}
\<close>
lemma DecisionValuesExist:
assumes
  Termination: "\<And>cc Q . terminationPseudo 1 cc Q" and
  Reachable: "initReachable c"
shows
  "val[p,c] \<noteq> {}"
proof -
  from Termination
    have "(initReachable c \<and> card Proc \<le> card (UNIV - {p}) + 1)
      \<longrightarrow> (\<exists>c'. qReachable c (UNIV-{p}) c' \<and> (\<exists>v. <\<bottom>, outM v> \<in># msgs c' ))"
    unfolding terminationPseudo_def by simp
  with Reachable minimalProcs finite_UNIV
    have "\<exists>c'. qReachable c (UNIV - {p}) c' \<and> (\<exists>v.  <\<bottom>, outM v> \<in># msgs c')"
    unfolding terminationPseudo_def initReachable_def by simp
  thus ?thesis  using Reachable by (auto simp add:pSilDecVal_def)
qed

text\<open>
  The lemma \isb{DecidedImpliesUniform} proves that every \isb{vDecided}
  configuration \var{c} is also \isb{vUniform}. Völzer claims that this
  follows directly from the definitions of \isb{vDecided} and \isb{vUniform}.
  But this is not quite enough: One must also assume \isb{terminationPseudo}
  and \isb{agreement} for all reachable configurations.

  \voelzer{Proposition 2(b)}
\<close>
lemma DecidedImpliesUniform:
assumes
  Reachable:"initReachable c" and
  AllAgree: "\<forall> cfg . reachable c cfg \<longrightarrow> agreement cfg" and
  Termination: "\<And>cc Q . terminationPseudo 1 cc Q" and
  VDec: "vDecided v c"
shows
  "vUniform v c"
  using AllAgree VDec unfolding agreement_def vUniform_def pSilDecVal_def pSilentDecisionValues_def
proof -
  assume
    Agree: "\<forall>cfg. reachable c cfg \<longrightarrow>
      (\<forall>v1. <\<bottom>, outM v1> \<in># msgs cfg
      \<longrightarrow> (\<forall>v2. (<\<bottom>, outM v2> \<in># msgs cfg ) = (v2 = v1)))" and
    vDec: "<\<bottom>, outM v> \<in># msgs c"
  show
    "(\<forall>p. {v. \<exists>c'. qReachable c (Proc - {p}) c' \<and>
      <\<bottom>, outM v> \<in>#  msgs c'} = {v})"
  proof clarify
    fix p
    have "val[p,c] \<noteq> {}" using Termination DecisionValuesExist vDec Reachable by blast
    hence NotEmpty: "{v. \<exists>c'. qReachable c (UNIV - {p}) c'
      \<and> initReachable c' \<and>  (<\<bottom>, outM v>) \<in># msgs c'} \<noteq> {}"
      using pSilDecVal_def Reachable asynchronousSystem.InitQ vDec by blast
    have U: "\<forall> u . u \<in> {v. \<exists>c'. qReachable c (UNIV - {p}) c'
      \<and>  <\<bottom>, outM v> \<in># msgs c'} \<longrightarrow> (u = v)"
    proof clarify
      fix u c'
      assume "qReachable c (UNIV - {p}) c'"
      hence Reach: "reachable c c'" using QReachImplReach by simp
      from VDec have Msg: "<\<bottom>, outM v> \<in># msgs c" by simp
      from Reach NoOutMessageLoss have
        "count (msgs c) <\<bottom>, outM v> \<le> count (msgs c') <\<bottom>, outM v>" by simp
      with Msg have VMsg: " <\<bottom>, outM v> \<in># msgs c'"
        using NoOutMessageLoss Reach by (metis count_eq_zero_iff le_zero_eq)
      assume " <\<bottom>, outM u> \<in># msgs c'"
      with Agree VMsg Reach show "u = v" by simp
    qed
    thus " {v. \<exists>c'. qReachable c (UNIV - {p}) c' \<and>
       <\<bottom>, outM v> \<in># msgs c'} = {v}" using NotEmpty U by blast
  qed
qed

corollary NonUniformImpliesNotDecided:
assumes
  "\<forall> cfg . reachable c cfg \<longrightarrow> agreement cfg"
  "\<And>cc Q . terminationPseudo 1 cc Q"
  "nonUniform c"
  "vDecided v c"
  "initReachable c"
shows
  "False" by (metis (full_types) assms flpSystem.DecidedImpliesUniform flpSystem_axioms)

text\<open>
  All three parts of Völzer's Proposition 3 consider a single step from an
  arbitrary \isb{initReachable} configuration \var{c} with a message
  $\var{msg}$ to a succeeding configuration \var{c'}.
\<close>

text\<open>
  The silent decision values of a process which is not active in a step only
  decrease or stay the same.

  This follows directly from the definitions and the transitivity of the
  reachability properties \isb{reachable} and \isb{qReachable}.

  \voelzer{Proposition 3(a)}
\<close>
lemma InactiveProcessSilentDecisionValuesDecrease:
assumes
  "p \<noteq> q" and
  "c \<turnstile> msg \<mapsto> c'" and
  "isReceiverOf p msg" and
  "initReachable c"
shows
  "val[q,c'] \<subseteq> val[q,c]"
proof(auto simp add: pSilDecVal_def assms(4))
  fix x cfg'
  assume
    Msg: "<\<bottom>, outM x> \<in># msgs cfg' " and
    Cfg': "qReachable c' (Proc - {q}) cfg'"
  have "initReachable c'"
    using assms initReachable_def reachable.simps
    by blast
  hence Init: "initReachable cfg'"
    using Cfg' initReachable_def QReachImplReach[of c' "(Proc - {q})" cfg']
    ReachableTrans by blast
  have "p \<in> Proc - {q}"
    using assms by blast
  hence "qReachable c (Proc - {q}) c'"
    using assms qReachable.simps by metis
  hence "qReachable c (Proc - {q}) cfg'"
    using Cfg' QReachableTrans
    by blast
  with Msg Init show
    "\<exists>c'a. qReachable c (Proc - {q}) c'a \<and>  <\<bottom>, outM x> \<in># msgs c'a" by blast
qed

text\<open>
  ...while the silent decision values of the process which is active in
  a step may only increase or stay the same.

  This follows as stated in \cite{Voelzer} from the \emph{diamond property}
  for a reachable configuration and a single step, i.e. \isb{DiamondTwo},
  and in addition from the fact that output messages cannot get lost, i.e.
  \isb{NoOutMessageLoss}.

  \voelzer{Proposition 3(b)}
\<close>
lemma ActiveProcessSilentDecisionValuesIncrease:
assumes
  "p = q" and
  "c \<turnstile> msg \<mapsto> c'" and
  "isReceiverOf p msg" and
  "initReachable c"
shows "val[q,c] \<subseteq> val[q,c']"
proof (auto simp add: pSilDecVal_def assms(4))
  fix x cv
  assume Cv: "qReachable c (Proc - {q}) cv"
    "<\<bottom>, outM x> \<in># msgs cv"
  have "\<exists>c'a. (cv \<turnstile> msg \<mapsto> c'a) \<and> qReachable c' (Proc - {q}) c'a"
    using DiamondTwo Cv(1) assms  by blast
  then obtain c'' where C'': "(cv \<turnstile> msg \<mapsto> c'')"
    "qReachable c' (Proc - {q}) c''" by auto
  with Cv(2) initReachable_def reachable.simps
  have Init: "initReachable c''" by (meson Cv(1) QReachImplReach ReachableTrans assms(4))
  have "reachable cv c''" using C''(1) reachable.intros by blast
  hence "count (msgs cv) <\<bottom>, outM x> \<le> count (msgs c'') <\<bottom>, outM x>" using NoOutMessageLoss  by simp
  hence "<\<bottom>, outM x> \<in># msgs c'' " using Cv(2) by (metis count_greater_eq_one_iff order_trans)
  thus "\<exists>c'a. qReachable c' (Proc - {q}) c'a \<and> <\<bottom>, outM x> \<in># msgs c'a"
    using C''(2) Init by blast
qed

text\<open>
  As a result from the previous two propositions, the silent decision values
  of a process cannot go from {0} to {1} or vice versa in a step.

  This is a slightly more generic version of Proposition 3 (c) from
  \cite{Voelzer} since it is proven for both values, while Völzer is only
  interested in the situation starting with $\var{val(q,c) = \{0\}}$.

  \voelzer{Proposition 3(c)}
\<close>

subsection\<open>Towards a proof of FLP\<close>

lemma inM_all_eq_imp_uniform:
  fixes i w
  assumes init:"initial i"
    and Validity: "\<And> i c . validity i c"
    and inM:"\<And> v . (\<exists>p. (<p, inM v> \<in># msgs i)) \<Longrightarrow> v = w"
    and Termination: "\<And>cc Q . terminationPseudo 1 cc Q"
  shows "vUniform w i"
proof -
  have 1:"v = w" if "qReachable i (Proc - {p}) c'" and "vDecided v c'" for p c' v
    using that by (metis QReachImplReach Validity init inM validity_def)
  moreover
  have "\<exists> c' . qReachable i (Proc - {p}) c' \<and> vDecided w c'" for p
  proof -
    have "val[p,i] \<noteq> {}"
      using DecisionValuesExist Termination asynchronousSystem.InitialIsInitReachable local.init by blast
    then obtain c' u where 2:"qReachable i (Proc - {p}) c' \<and> vDecided u c'"
      using pSilDecVal_def by auto
    hence "u = w" using 1 by blast
    thus ?thesis using 2 by blast
  qed
  ultimately show "vUniform w i" unfolding vUniform_def pSilDecVal_def pSilentDecisionValues_def by auto
qed

lemma frozen_state_invisible:
  assumes
    "withoutQReachable c Q d"
    and "\<And> p . states c' p = states c p"
    and "\<And> p m . \<lbrakk>p \<notin> Q; isReceiverOf p m\<rbrakk> \<Longrightarrow> (count (msgs c') m) = (count (msgs c) m)"
    and "\<And> v . count (msgs c') <\<bottom>,outM v> = (count (msgs c) <\<bottom>,outM v>)"
  shows "\<exists> d' . withoutQReachable c' Q d' \<and> (\<forall> p . states d' p = states d p)
    \<and> (\<forall> p m . p \<notin> Q \<and> isReceiverOf p m \<longrightarrow> (count (msgs d') m) = (count (msgs d) m))
    \<and> (\<forall> v . count (msgs d') <\<bottom>,outM v> = (count (msgs d) <\<bottom>,outM v>))"
  using assms
proof (induct c "Proc-Q" d rule:qReachable.induct)
  case (InitQ c1)
  then show ?case using qReachable.InitQ by blast
next
  case (StepQ c1 d1 m d2)
  obtain d1' where 1:"qReachable c' (Proc - Q) d1'" and 2:"\<And> p . states d1' p = states d1 p"
    and 3:"\<And> p m . \<lbrakk>p \<notin> Q; isReceiverOf p m\<rbrakk> \<Longrightarrow> (count (msgs d1') m) = (count (msgs d1) m)"
      and 4:"\<And> v . count (msgs d1') <\<bottom>,outM v> = (count (msgs d1) <\<bottom>,outM v>)"
    using StepQ.hyps(2) StepQ.prems by auto
  obtain p where 5:"p \<notin> Q" and 6:"isReceiverOf p m" using StepQ.hyps(4) by blast

  define d2' where "d2' \<equiv> \<lparr>states = (states d1')(p := states d2 p),
    msgs = (msgs d2 - (msgs d1 - {#m#})) + (msgs d1' - {#m#})\<rparr>"

  have f1:"\<And> p . states d2' p = states d2 p"
    unfolding d2'_def using 2 6 \<open>d1 \<turnstile> m \<mapsto> d2\<close>
    by (metis UniqueReceiverOf asynchronousSystem.NoReceivingNoChange fun_upd_apply select_convs(1))

  define delta where "delta \<equiv> msgs d2 - (msgs d1 - {#m#})"
  have msgs':"msgs d2' = delta + (msgs d1' - {#m#})"
    using 2 \<open>d1 \<turnstile> m \<mapsto> d2\<close> by (simp add:d2'_def delta_def; cases m; simp)
  have msgs:"msgs d2 = delta + (msgs d1 - {#m#})" using \<open>d1 \<turnstile> m \<mapsto> d2\<close>
    by ((simp add:delta_def)) (metis NoMessageLossStep subset_eq_diff_conv subset_mset.diff_add)
  have f2:"(count (msgs d2') m2) = (count (msgs d2) m2)" if "p2 \<notin> Q" and "isReceiverOf p2 m2" for p2 m2
  proof -
    have "(count (msgs d1') m2) = (count (msgs d1) m2)" using "3" that by blast
    with msgs msgs' show ?thesis by simp
  qed
  have f3:"count (msgs d2') <\<bottom>,outM v> = (count (msgs d2) <\<bottom>,outM v>)" for v
    unfolding d2'_def using 4 msgs by auto

  have f4:"qReachable c' (Proc - Q) d2'"
  proof -
    have "d1' \<turnstile> m \<mapsto> d2'" using \<open>d1 \<turnstile> m \<mapsto> d2\<close> 2 3 6
       by (cases m; simp_all add:d2'_def enabled_def) (metis 5 6 count_eq_zero_iff)+
    thus ?thesis using \<open>qReachable c' (Proc - Q) d1'\<close> 6 qReachable.StepQ 5 by blast
  qed

  from f1 f2 f3 f4 show ?case by blast
qed

text\<open>
  There is an \isb{initial} configuration that is \isb{nonUniform} under
  the assumption of \isb{validity}, \isb{agreement} and \isb{terminationPseudo}.

  The lemma is used in the proof of the main theorem to construct the
  \isb{non\-Uni\-form} and \isb{initial} configuration that leads to the
  final contradiction.

  \voelzer{Lemma 1}
\<close>
lemma InitialNonUniformCfg:
assumes
  Termination: "\<And>cc Q . terminationPseudo 1 cc Q" and
  Validity: "\<forall> i c . validity i c" and
  Agreement: "\<forall> i c . agreementInit i c"
shows
  "\<exists> cfg . initial cfg \<and> nonUniform cfg"
proof-
  define n where "n \<equiv> card Proc"
  text \<open>We order the processes using a bijection to @{term "{0..<n}"}.\<close>
  obtain f where f_bij:"bij_betw f Proc {0..<n}"
    using ex_bij_betw_finite_nat n_def finite_UNIV by blast

  text \<open>We define a family of configurations as in \voelzer{Lemma 1}.\<close>
  define initMsgs :: "nat \<Rightarrow> (('p, 'v) message) multiset"
    where "initMsgs \<equiv>  (\<lambda> i . mset_set {m . \<exists> p . m = <p, inM (f p < i)>})"
  define initCfg :: "nat \<Rightarrow> ('p, 'v, 's) configuration" where
    "initCfg \<equiv> \<lambda> i . \<lparr> states = start, msgs = initMsgs i \<rparr>"
  have count_initMsgs[simp]:"count (initMsgs i) m = (if (\<exists> p . m = <p, inM f p < i>) then 1 else 0)" for i m
  proof -
    have finite_initMsgs_set:
      "finite {m . \<exists> p . m = <p, inM (f p < i)>}" (is "finite ?S") for i
    proof -
      have "?S = (\<lambda> p . <p, inM (f p < i)>) ` UNIV" by (simp add: full_SetCompr_eq)
      thus ?thesis by simp
    qed
    thus ?thesis
      using count_mset_set(1)[OF finite_initMsgs_set] count_mset_set(3) initMsgs_def by auto
  qed
  hence in_initMsgs[iff]:"m \<in># initMsgs i \<longleftrightarrow> (\<exists> p . m = <p, inM f p < i>)" for m i
    by (metis count_eq_zero_iff zero_neq_one)

  text \<open>All the configurations in the family are initial.\<close>
  have InitInitial: "initial c" if 1:"c \<in> initCfg ` {0..m}" for c m
    using that unfolding initial_def initCfg_def
    by (cases c, auto simp add: split:if_splits message.splits)

  text \<open>Now we obtain an index j where the configuration j is uniform,
    but not the configuration @{term "j+1"}\<close>
  define P::"nat \<Rightarrow> bool" where "P \<equiv> \<lambda> i . vUniform False (initCfg i)"
  obtain j where "j\<in>{0..<(n+1)}" and "P j" and "\<not> (P (j+1))"
  proof -
    have "P 0"
    proof -
      have "\<And> v . (\<exists>p. (<p, inM v> \<in># msgs (initCfg 0))) \<Longrightarrow> v = False"
        unfolding initCfg_def by (auto split!:message.splits if_splits)
      moreover from InitInitial have "initial (initCfg 0)"
        by (simp add: finite_UNIV finite_UNIV_card_ge_0 n_def)
      ultimately show ?thesis using inM_all_eq_imp_uniform Validity Termination P_def
        by blast
    qed
    have "\<not> P (n+1)"
    proof -
      have "\<And> v . (\<exists>p. (<p, inM v> \<in># msgs (initCfg (n+1)))) \<Longrightarrow> v = True"
        unfolding initCfg_def n_def by (auto split!:message.splits if_splits)
          (metis atLeastLessThan_iff bij_betw_imp_surj_on f_bij less_SucI n_def rangeI)
      moreover from InitInitial have "initial (initCfg (n+1))"
        by (meson atLeastAtMost_iff image_iff le0 order_refl)
      ultimately have "vUniform True (initCfg (n+1))" using inM_all_eq_imp_uniform Validity Termination
        by blast
      thus ?thesis unfolding P_def vUniform_def by auto
    qed
    from \<open>P 0\<close> and \<open>\<not> (P (n+1))\<close> show ?thesis using that NatPredicateTippingPoint by moura
  qed

  text \<open>Now we show that the configuration @{term "j+1"} is non-uniform.\<close>
  consider (a) "vUniform True (initCfg (j+1))" | (b) "nonUniform (initCfg (j+1))"
    using \<open>\<not> (P (j+1))\<close> P_def by blast
  thus ?thesis
  proof (cases)
    case a
    text \<open>We obtain an execution where False is decided, leading to a contradiction.\<close>
    define pj where "pj \<equiv> (inv f) j"
    obtain c where "qReachable (initCfg (j+1)) (Proc-{pj}) c" and "vDecided False c"
    proof -
      obtain cj where 1:"withoutQReachable (initCfg j) {pj} cj" and "vDecided False cj"
        using \<open>P j\<close> that unfolding P_def vUniform_def pSilDecVal_def pSilentDecisionValues_def by auto
      have 2:"\<And> p . states (initCfg j) p = states (initCfg (j+1)) p"
        unfolding initCfg_def by auto
      have 3:"count (msgs (initCfg j)) m = (count (msgs (initCfg (j+1))) m)"
        if "p \<notin> {pj}" and "isReceiverOf p m" for p m using that f_bij unfolding initCfg_def pj_def
        by auto (metis UNIV_I bij_betw_def inv_into_f_f less_antisym)+
      have 4:"count (msgs (initCfg (j+1))) <\<bottom>,outM v> = (count (msgs (initCfg j)) <\<bottom>,outM v>)" for v
        using initCfg_def by auto
      obtain cSucJ where "withoutQReachable (initCfg (j+1)) {pj} cSucJ"
        and "\<And> v . count (msgs cSucJ) <\<bottom>,outM v> = (count (msgs cj) <\<bottom>,outM v>)"
        using frozen_state_invisible[OF 1] 2 3 4 by simp blast
      have "vDecided False cSucJ" using \<open>vDecided False cj\<close>
          \<open>\<And> v . count (msgs cSucJ) <\<bottom>,outM v> = (count (msgs cj) <\<bottom>,outM v>)\<close>
        by (metis count_eq_zero_iff)
      show ?thesis using that \<open>vDecided False cSucJ\<close> \<open>withoutQReachable (initCfg (j+1)) {pj} cSucJ\<close>
        by blast
    qed
    with a have False unfolding vUniform_def pSilDecVal_def pSilentDecisionValues_def
      by blast
    thus ?thesis by auto
  next
    case b
    then show ?thesis using InitInitial atLeastAtMost_iff by blast
  qed
qed

lemma bool_set_cases:
  obtains "bs = {}" | "bs = {True}" | "bs = {False}" | "bs = {True,False}"
  by (cases "bs = {}"; cases "bs = {True}"; cases "bs = {False}"; cases "bs = {True,False}")
    (auto, (metis (full_types))+)

text\<open>
  Völzer's Lemma 2 proves that for every process $p$ in the consensus setting
  \isb{nonUniform} configurations can reach a configuration where the silent
  decision values of $p$ are True and False. This is key to the construction of
  non-deciding executions.

  \voelzer{Lemma 2}
\<close>
lemma NonUniformCanReachSilentBivalence:
assumes
  Init: "initReachable c" and
  NonUni: "nonUniform c" and
  PseudoTermination: "\<And>cc Q . terminationPseudo 1 cc Q" and
  Agree: "\<And> cfg . reachable c cfg \<longrightarrow> agreement cfg"
shows
   "\<exists> c' . reachable c c' \<and> val[p,c'] = {True, False}"
proof(cases "val[p,c] = {True, False}")
  case True
  have "reachable c c" using reachable.simps by metis
  thus ?thesis using True by blast
next
  case False

  text \<open>Since the configuration is non-uniform, we obtain p with @{term "val[p,c] = {b}"}
    and q with @{term "(\<not>b) \<in> val[q,c]"}\<close>
  have 2:"val[q,c] \<noteq> {}" for q
    using DecisionValuesExist Init PseudoTermination by blast
  obtain b where  "val[p,c] = {b}" using 2 False
    by (cases "val[p,c]" rule:bool_set_cases; auto)
  obtain q where "(\<not> b) \<in> val[q,c]"
  proof -
    obtain p2 where 4:"val[p2,c] \<noteq> {b}" using False that \<open>nonUniform c\<close>
      by (simp add:pSilDecVal_def vUniform_def) (metis (mono_tags, lifting))
    moreover
    have "val[p2,c] \<noteq> {}" using 2 by auto
    ultimately show ?thesis
      using that by (cases "val[p2,c]" rule:bool_set_cases; auto)
  qed

  text \<open>Then we reach a configuration @{term cNotB} in which @{term "val[p,cNotB]={\<not>b}"} by letting
    the system run without q and reach a @{term "\<not>b"} decision.\<close>
  obtain cNotB where "vDecided (\<not> b) cNotB" and "withoutQReachable c {q} cNotB"
    using \<open>(\<not> b) \<in> val[q,c]\<close> pSilDecVal_def by auto
  hence "val[p,cNotB] = {\<not> b}"
    by (meson Agree DecidedImpliesUniform Init PseudoTermination ReachableTrans asynchronousSystem.QReachImplReach initReachable_def vUniform_def)

  text \<open>We obtain two configuration @{term "cB"} and @{term cNotB'}, on the way to @{term "cNotB"}
    where the set of silent decision values of p changes to include @{term "\<not>b"} or is @{term "{True,False}"} already.\<close>
  obtain cB cNotB' m q' where "val[p,cB] = {b} \<or> val[p,cB] = {True,False}" and "(\<not>b) \<in> val[p,cNotB']" and
    "cB \<turnstile> m \<mapsto> cNotB'" and "isReceiverOf q' m" and "withoutQReachable c {q} cB"
    using \<open>withoutQReachable c {q} cNotB\<close> \<open>val[p,cNotB] = {\<not> b}\<close> \<open>val[p,c] = {b}\<close> \<open>initReachable c\<close>
  proof (induct c "Proc - {q}" cNotB rule:qReachable.induct)
    case (InitQ c1)
    then show ?case by simp
  next
    case (StepQ c1 c2 msg c3)
    then show ?case
    proof (cases "val[p,c2] = {\<not> b}")
      case True
      text \<open>Immediate by induction hypothesis.\<close>
      then show ?thesis
        using StepQ.hyps(2) StepQ.prems(1) StepQ.prems(3) StepQ.prems(4) by blast
    next
      case False
      have "val[p,c2] \<noteq> {}"
        by (meson DecisionValuesExist PseudoTermination ReachableTrans StepQ.hyps(1) StepQ.prems(4) asynchronousSystem.QReachImplReach initReachable_def)
      with False have "val[p,c2] = {b} \<or> val[p,c2] = {True,False}"
        by (cases "val[p,c2]" rule:bool_set_cases) auto
      then show ?thesis
        by (metis StepQ.hyps(1) StepQ.hyps(3) StepQ.hyps(4) StepQ.prems(1) StepQ.prems(2) singletonI)
    qed
  qed

  text \<open>Trivial facts\<close>
  have "initReachable cB"
    using \<open>withoutQReachable c {q} cB\<close> \<open>initReachable c\<close>  QReachImplReach ReachableTrans initReachable_def
    by blast
  have "reachable c cNotB'" using \<open>cB \<turnstile> m \<mapsto> cNotB'\<close> \<open>withoutQReachable c {q} cB\<close>
    using QReachImplReach reachable.step by blast

  text \<open>Now either  @{term "val[p,cB] = {True,False}"} or, using @{thm SilentDecisionValueNotInverting},
    @{term "val[p,cNotB'] = {True,False}"}\<close>
  consider "val[p,cB] = {True,False}" | "val[p,cNotB'] = {True,False}"
  proof -
    have "val[p,cNotB'] = {True,False}" if "val[p,cB] \<noteq> {True,False}"
    proof -
      from that and \<open>val[p,cB] = {b} \<or> val[p,cB] = {True,False}\<close>
      have "val[p,cB] = {b}"
        by linarith
      have "val[p,cNotB'] \<noteq> {\<not>b}"
        using  SilentDecisionValueNotInverting[OF \<open>val[p,cB] = {b}\<close> \<open>cB \<turnstile> m \<mapsto> cNotB'\<close> \<open>isReceiverOf q' m\<close>
            \<open>initReachable cB\<close>] by simp
      with \<open>(\<not>b) \<in> val[p,cNotB']\<close> and 2
      show "val[p,cNotB'] = {True,False}" by fastforce
    qed
    thus ?thesis using that by blast
  qed

  text \<open>And in both cases we have found our @{term c'}\<close>
  hence "\<exists> c' . reachable c c' \<and> val[p,c'] = {True, False}"
    using \<open>reachable c cNotB'\<close> \<open>withoutQReachable c {q} cB\<close> by (meson QReachImplReach)
  with False 2 show ?thesis by auto
qed

end

end


(*  Title:      Term_Abstraction.thy
    Author:     Andreas Viktor Hess, DTU
    Author:     Sebastian A. Mödersheim, DTU
    Author:     Achim D. Brucker, University of Exeter
    Author:     Anders Schlichtkrull, DTU
    SPDX-License-Identifier: BSD-3-Clause
*)

section\<open>Term Abstraction\<close>
theory Term_Abstraction
  imports Transactions
begin

subsection \<open>Definitions\<close>
fun to_abs ("\<alpha>\<^sub>0") where
  "\<alpha>\<^sub>0 [] _ = {}"
| "\<alpha>\<^sub>0 ((Fun (Val m) [],Fun (Set s) S)#D) n =
    (if m = n then insert s (\<alpha>\<^sub>0 D n) else \<alpha>\<^sub>0 D n)"
| "\<alpha>\<^sub>0 (_#D) n = \<alpha>\<^sub>0 D n"

fun abs_apply_term (infixl "\<cdot>\<^sub>\<alpha>" 67) where
  "Var x \<cdot>\<^sub>\<alpha> \<alpha> = Var x"
| "Fun (Val n) T \<cdot>\<^sub>\<alpha> \<alpha> = Fun (Abs (\<alpha> n)) (map (\<lambda>t. t \<cdot>\<^sub>\<alpha> \<alpha>) T)"
| "Fun f T \<cdot>\<^sub>\<alpha> \<alpha> = Fun f (map (\<lambda>t. t \<cdot>\<^sub>\<alpha> \<alpha>) T)"

definition abs_apply_list (infixl "\<cdot>\<^sub>\<alpha>\<^sub>l\<^sub>i\<^sub>s\<^sub>t" 67) where
  "M \<cdot>\<^sub>\<alpha>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<alpha> \<equiv> map (\<lambda>t. t \<cdot>\<^sub>\<alpha> \<alpha>) M"

definition abs_apply_terms (infixl "\<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t" 67) where
  "M \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha> \<equiv> (\<lambda>t. t \<cdot>\<^sub>\<alpha> \<alpha>) ` M"

definition abs_apply_pairs (infixl "\<cdot>\<^sub>\<alpha>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s" 67) where
  "F \<cdot>\<^sub>\<alpha>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<alpha> \<equiv> map (\<lambda>(s,t). (s \<cdot>\<^sub>\<alpha> \<alpha>, t \<cdot>\<^sub>\<alpha> \<alpha>)) F"

definition abs_apply_strand_step (infixl "\<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>t\<^sub>p" 67) where
  "s \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>t\<^sub>p \<alpha> \<equiv> (case s of
    (l,send\<langle>ts\<rangle>) \<Rightarrow> (l,send\<langle>ts \<cdot>\<^sub>\<alpha>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<alpha>\<rangle>)
  | (l,receive\<langle>ts\<rangle>) \<Rightarrow> (l,receive\<langle>ts \<cdot>\<^sub>\<alpha>\<^sub>l\<^sub>i\<^sub>s\<^sub>t \<alpha>\<rangle>)
  | (l,\<langle>ac: t \<doteq> t'\<rangle>) \<Rightarrow> (l,\<langle>ac: (t \<cdot>\<^sub>\<alpha> \<alpha>) \<doteq> (t' \<cdot>\<^sub>\<alpha> \<alpha>)\<rangle>)
  | (l,insert\<langle>t,t'\<rangle>) \<Rightarrow> (l,insert\<langle>t \<cdot>\<^sub>\<alpha> \<alpha>,t' \<cdot>\<^sub>\<alpha> \<alpha>\<rangle>)
  | (l,delete\<langle>t,t'\<rangle>) \<Rightarrow> (l,delete\<langle>t \<cdot>\<^sub>\<alpha> \<alpha>,t' \<cdot>\<^sub>\<alpha> \<alpha>\<rangle>)
  | (l,\<langle>ac: t \<in> t'\<rangle>) \<Rightarrow> (l,\<langle>ac: (t \<cdot>\<^sub>\<alpha> \<alpha>) \<in> (t' \<cdot>\<^sub>\<alpha> \<alpha>)\<rangle>)
  | (l,\<forall>X\<langle>\<or>\<noteq>: F \<or>\<notin>: F'\<rangle>) \<Rightarrow> (l,\<forall>X\<langle>\<or>\<noteq>: (F \<cdot>\<^sub>\<alpha>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<alpha>) \<or>\<notin>: (F' \<cdot>\<^sub>\<alpha>\<^sub>p\<^sub>a\<^sub>i\<^sub>r\<^sub>s \<alpha>)\<rangle>))"

definition abs_apply_strand (infixl "\<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>t" 67) where
  "S \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>t \<alpha> \<equiv> map (\<lambda>x. x \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>t\<^sub>p \<alpha>) S"

subsection \<open>Lemmata\<close>
lemma to_abs_alt_def:
  "\<alpha>\<^sub>0 D n = {s. \<exists>S. (Fun (Val n) [], Fun (Set s) S) \<in> set D}"
by (induct D n rule: to_abs.induct) auto

lemma abs_term_apply_const[simp]:
  "is_Val f \<Longrightarrow> Fun f [] \<cdot>\<^sub>\<alpha> a = Fun (Abs (a (the_Val f))) []"
  "\<not>is_Val f \<Longrightarrow> Fun f [] \<cdot>\<^sub>\<alpha> a = Fun f []"
by (cases f; auto)+

lemma abs_fv: "fv (t \<cdot>\<^sub>\<alpha> a) = fv t"
by (induct t a rule: abs_apply_term.induct) auto

lemma abs_eq_if_no_Val:
  assumes "\<forall>f \<in> funs_term t. \<not>is_Val f"
  shows "t \<cdot>\<^sub>\<alpha> a = t \<cdot>\<^sub>\<alpha> b"
using assms
proof (induction t)
  case (Fun f T) thus ?case by (cases f) simp_all
qed simp

lemma abs_set_empty[simp]: "{} \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha> = {}"
unfolding abs_apply_terms_def by simp

lemma abs_set_union: "(A \<union> B) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a = (A \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a) \<union> (B \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a)"
unfolding abs_apply_terms_def
by auto

lemma abs_subterms: "subterms (t \<cdot>\<^sub>\<alpha> \<alpha>) = subterms t \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t \<alpha>"
proof (induction t)
  case (Fun f T) thus ?case by (cases f) (auto simp add: abs_apply_terms_def)
qed (simp add: abs_apply_terms_def)

lemma abs_subterms_in: "s \<in> subterms t \<Longrightarrow> s \<cdot>\<^sub>\<alpha> a \<in> subterms (t \<cdot>\<^sub>\<alpha> a)"
proof (induction t)
  case (Fun f T) thus ?case by (cases f) auto
qed simp

lemma abs_ik_append: "(ik\<^sub>s\<^sub>s\<^sub>t (A@B) \<cdot>\<^sub>s\<^sub>e\<^sub>t I) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a = (ik\<^sub>s\<^sub>s\<^sub>t A \<cdot>\<^sub>s\<^sub>e\<^sub>t I) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a \<union> (ik\<^sub>s\<^sub>s\<^sub>t B \<cdot>\<^sub>s\<^sub>e\<^sub>t I) \<cdot>\<^sub>\<alpha>\<^sub>s\<^sub>e\<^sub>t a"
unfolding abs_apply_terms_def ik\<^sub>s\<^sub>s\<^sub>t_def
by fastforce

lemma to_abs_in:
  assumes "(Fun (Val n) [], Fun (Set s) []) \<in> set D"
  shows "s \<in> \<alpha>\<^sub>0 D n"
using assms by (induct rule: to_abs.induct) auto

lemma to_abs_empty_iff_notin_db:
  "Fun (Val n) [] \<cdot>\<^sub>\<alpha> \<alpha>\<^sub>0 D = Fun (Abs {}) [] \<longleftrightarrow> (\<nexists>s S. (Fun (Val n) [], Fun (Set s) S) \<in> set D)"
by (simp add: to_abs_alt_def)

lemma to_abs_list_insert:
  assumes "Fun (Val n) [] \<noteq> t"
  shows "\<alpha>\<^sub>0 D n = \<alpha>\<^sub>0 (List.insert (t,s) D) n"
using assms to_abs_alt_def[of D n] to_abs_alt_def[of "List.insert (t,s) D" n]
by auto

lemma to_abs_list_insert':
  "insert s (\<alpha>\<^sub>0 D n) = \<alpha>\<^sub>0 (List.insert (Fun (Val n) [], Fun (Set s) S) D) n"
using to_abs_alt_def[of D n]
      to_abs_alt_def[of "List.insert (Fun (Val n) [], Fun (Set s) S) D" n]
by auto

lemma to_abs_list_remove_all:
  assumes "Fun (Val n) [] \<noteq> t"
  shows "\<alpha>\<^sub>0 D n = \<alpha>\<^sub>0 (List.removeAll (t,s) D) n"
using assms to_abs_alt_def[of D n] to_abs_alt_def[of "List.removeAll (t,s) D" n]
by auto

lemma to_abs_list_remove_all':
  "\<alpha>\<^sub>0 D n - {s} = \<alpha>\<^sub>0 (filter (\<lambda>d. \<nexists>S. d = (Fun (Val n) [], Fun (Set s) S)) D) n"
using to_abs_alt_def[of D n]
      to_abs_alt_def[of "filter (\<lambda>d. \<nexists>S. d = (Fun (Val n) [], Fun (Set s) S)) D" n]
by auto

lemma to_abs_db\<^sub>s\<^sub>s\<^sub>t_append:
  assumes "\<forall>u s. insert\<langle>u, s\<rangle> \<in> set B \<longrightarrow> Fun (Val n) [] \<noteq> u \<cdot> \<I>"
    and "\<forall>u s. delete\<langle>u, s\<rangle> \<in> set B \<longrightarrow> Fun (Val n) [] \<noteq> u \<cdot> \<I>"
  shows "\<alpha>\<^sub>0 (db'\<^sub>s\<^sub>s\<^sub>t A \<I> D) n = \<alpha>\<^sub>0 (db'\<^sub>s\<^sub>s\<^sub>t (A@B) \<I> D) n"
using assms
proof (induction B rule: List.rev_induct)
  case (snoc b B)
  hence IH: "\<alpha>\<^sub>0 (db'\<^sub>s\<^sub>s\<^sub>t A \<I> D) n = \<alpha>\<^sub>0 (db'\<^sub>s\<^sub>s\<^sub>t (A@B) \<I> D) n" by auto
  have *: "\<forall>u s. b = insert\<langle>u,s\<rangle> \<longrightarrow> Fun (Val n) [] \<noteq> u \<cdot> \<I>"
          "\<forall>u s. b = delete\<langle>u,s\<rangle> \<longrightarrow> Fun (Val n) [] \<noteq> u \<cdot> \<I>"
    using snoc.prems by simp_all
  show ?case
  proof (cases b)
    case (Insert u s)
    hence **: "db'\<^sub>s\<^sub>s\<^sub>t (A@B@[b]) \<I> D = List.insert (u \<cdot> \<I>,s \<cdot> \<I>) (db'\<^sub>s\<^sub>s\<^sub>t (A@B) \<I> D)"
      using db\<^sub>s\<^sub>s\<^sub>t_append[of "A@B" "[b]"] by simp
    have "Fun (Val n) [] \<noteq> u \<cdot> \<I>" using *(1) Insert by auto
    thus ?thesis using IH ** to_abs_list_insert by metis
  next
    case (Delete u s)
    hence **: "db'\<^sub>s\<^sub>s\<^sub>t (A@B@[b]) \<I> D = List.removeAll (u \<cdot> \<I>,s \<cdot> \<I>) (db'\<^sub>s\<^sub>s\<^sub>t (A@B) \<I> D)"
      using db\<^sub>s\<^sub>s\<^sub>t_append[of "A@B" "[b]"] by simp
    have "Fun (Val n) [] \<noteq> u \<cdot> \<I>" using *(2) Delete by auto
    thus ?thesis using IH ** to_abs_list_remove_all by metis
  qed (simp_all add: db\<^sub>s\<^sub>s\<^sub>t_no_upd_append[of "[b]" "A@B"] IH)
qed simp

lemma to_abs_neq_imp_db_update:
  assumes "\<alpha>\<^sub>0 (db\<^sub>s\<^sub>s\<^sub>t A I) n \<noteq> \<alpha>\<^sub>0 (db\<^sub>s\<^sub>s\<^sub>t (A@B) I) n"
  shows "\<exists>u s. u \<cdot> I = Fun (Val n) [] \<and> (insert\<langle>u,s\<rangle> \<in> set B \<or> delete\<langle>u,s\<rangle> \<in> set B)"
proof -
  { fix D have ?thesis when "\<alpha>\<^sub>0 D n \<noteq> \<alpha>\<^sub>0 (db'\<^sub>s\<^sub>s\<^sub>t B I D) n" using that
    proof (induction B I D rule: db'\<^sub>s\<^sub>s\<^sub>t.induct)
      case 2 thus ?case
        by (metis db'\<^sub>s\<^sub>s\<^sub>t.simps(2) list.set_intros(1,2) subst_apply_pair_pair to_abs_list_insert)
    next
      case 3 thus ?case
        by (metis db'\<^sub>s\<^sub>s\<^sub>t.simps(3) list.set_intros(1,2) subst_apply_pair_pair to_abs_list_remove_all)
    qed simp_all
  } thus ?thesis using assms by (metis db\<^sub>s\<^sub>s\<^sub>t_append db\<^sub>s\<^sub>s\<^sub>t_def)
qed

lemma abs_term_subst_eq:
  fixes \<delta> \<theta>::"(('a,'b,'c,'d) prot_fun, ('e,'f prot_atom) term \<times> nat) subst"
  assumes "\<forall>x \<in> fv t. \<delta> x \<cdot>\<^sub>\<alpha> a = \<theta> x \<cdot>\<^sub>\<alpha> b"
    and "\<nexists>n T. Fun (Val n) T \<in> subterms t"
  shows "t \<cdot> \<delta> \<cdot>\<^sub>\<alpha> a = t \<cdot> \<theta> \<cdot>\<^sub>\<alpha> b"
using assms
proof (induction t)
  case (Fun f T) thus ?case
  proof (cases f)
    case (Val n)
    hence False using Fun.prems(2) by blast
    thus ?thesis by metis
  qed auto
qed simp

lemma abs_term_subst_eq':
  fixes \<delta> \<theta>::"(('a,'b,'c,'d) prot_fun, ('e,'f prot_atom) term \<times> nat) subst"
  assumes "\<forall>x \<in> fv t. \<delta> x \<cdot>\<^sub>\<alpha> a = \<theta> x"
    and "\<nexists>n T. Fun (Val n) T \<in> subterms t"
  shows "t \<cdot> \<delta> \<cdot>\<^sub>\<alpha> a = t \<cdot> \<theta>"
using assms
proof (induction t)
  case (Fun f T) thus ?case
  proof (cases f)
    case (Val n)
    hence False using Fun.prems(2) by blast
    thus ?thesis by metis
  qed auto
qed simp

lemma abs_val_in_funs_term:
  assumes "f \<in> funs_term t" "is_Val f"
  shows "Abs (\<alpha> (the_Val f)) \<in> funs_term (t \<cdot>\<^sub>\<alpha> \<alpha>)"
using assms by (induct t \<alpha> rule: abs_apply_term.induct) auto

end


theory proofGeneration
  imports TTC_Solvers

begin

(*
Please, follow the instructions to uncomment lemmas for testing the three solvers
defined in the file TTC_Solvers.thy
WARNING: The automatically generated file "Proof.txt" will be generated in the directory
that your Isabelle IDE uses, that could be the Isabelle2018 home.
*)

(* Test the basic solver in TTC_Solvers proving (uncommenting) the following lemma *)

(*
lemma runningExample_proof: "S @ [\<circle>(\<diamond>(V ''a''))] \<turnstile> F"
  apply solver
  done
*)

(* Test the solver that generates the big-step proof,
proving (uncommenting) the following lemma *)

(*
lemma runningExample_bigStep_proof_generation: "S @ [\<circle>(\<diamond>(V ''a''))] \<turnstile> F"
(* Generates a file Proof.txt, with the big-step proof *)
  apply solver_print_Big_Step
  done
*)

(* Uncomment the following proof (in the paper), or cut-and-paste the one in Proof.txt,
   to check the generated big-step proof*)
(*
lemma runningExample_bigStep_proof: "S @ [\<circle>(\<diamond>(V ''a''))] \<turnstile> F"
apply (rule TTC_Interchange, simp add: S_def TR_def T1_def T2_def T3_def T4_def Init_def) (*1*)
apply one_step_solver                                                                     (*2*)
apply (all \<open>rule TTC_Next_State\<close>; simp)                                                   (*3*)
apply (fold T1_def T2_def T3_def T4_def)                                                  (*4*)
apply (simp add: T1_def T2_def T3_def T4_def Init_def)                                    (*5*)
apply one_step_solver                                                                     (*6*)
apply (all \<open>rule TTC_Next_State\<close>; simp)                                                   (*7*)
apply (fold T1_def T2_def T3_def T4_def)                                                  (*8*)
apply (simp add: T1_def T2_def T3_def T4_def Init_def)                                    (*9*)
apply one_step_solver                                                                     (*10*)
apply (all \<open>rule TTC_Next_State\<close>; simp)                                                   (*11*)
apply (simp add: T1_def T2_def T3_def T4_def Init_def)                                    (*12*)
apply one_step_solver                                                                     (*13*)
apply (all \<open>rule TTC_Next_State\<close>; simp)                                                   (*14*)
apply (fold T1_def T2_def T3_def T4_def)                                                  (*15*)
apply (simp add: T1_def T2_def T3_def T4_def Init_def)                                    (*16*)
apply one_step_solver                                                                     (*17*)
  done
*)

(* Test the solver that generates the small-step proof,
proving (uncommenting) the following lemma *)

(*
lemma runningExample_smallStep_proof_generation: "S @ [\<circle>(\<diamond>(V ''a''))] \<turnstile> F"
(* Generates a file Proof.txt, with the bellow small-step proof.
   WARNING: If you have in Proof.txt a previously generate proof,
            the new one is appended to it. Our recommendation is
            to remove the previous file.*)
apply solver_print_Small_Step
    done
*)

(* Uncomment the following, or cut-and-paste the generated Proof.txt,
to check the generated small-step proof*)

(*
  apply (rule TTC_Interchange, simp add: S_def TR_def T1_def T2_def T3_def T4_def Init_def)
(* step *)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_Alw; simp)
apply (rule TTC_Imp; simp)
apply (rule TTC_Alw; simp)
apply (rule TTC_Imp; simp)
apply (rule TTC_Alw; simp)
apply (rule TTC_Imp; simp)
apply (rule TTC_Alw; simp)
apply (rule TTC_Imp; simp)
apply (rule_tac phi = "(V ''a'')" in TTC_Ctd1; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
defer
apply (rule TTC_Or; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_Alw; simp)
apply (rule TTC_Imp; simp)
apply (rule_tac phi = "(V ''a'')" in TTC_Ctd1; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
defer
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_Alw; simp)
apply (rule TTC_Imp; simp)
apply (rule_tac phi = "(V ''a'')" in TTC_Ctd1; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule_tac phi = "\<circle>(V ''c'')" in TTC_Ctd1; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_Alw; simp)
apply (rule TTC_Imp; simp)
apply (rule TTC_Alw; simp)
apply (rule TTC_Imp; simp)
apply (rule_tac phi = "(V ''a'')" in TTC_Ctd1; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
defer
apply (rule TTC_Or; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_Alw; simp)
apply (rule TTC_Imp; simp)
apply (rule_tac phi = "(V ''a'')" in TTC_Ctd1; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
defer
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule_tac phi = "\<circle>(V ''b'')" in TTC_Ctd1; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_Alw; simp)
apply (rule TTC_Imp; simp)
apply (rule TTC_Alw; simp)
apply (rule TTC_Imp; simp)
apply (rule TTC_Alw; simp)
apply (rule TTC_Imp; simp)
apply (rule_tac phi = "(V ''a'')" in TTC_Ctd1; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule_tac phi = "\<circle>(V ''a'')" in TTC_Ctd1; simp)
apply (rule TTC_Or; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule_tac phi = "\<circle>(V ''a'')" in TTC_Ctd1; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule_tac phi = "\<circle>(V ''a'')" in TTC_Ctd1; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule_tac phi = "\<circle>(V ''a'')" in TTC_Ctd1; simp)
apply (tactic {* distinct_subgoals_tac *})
apply (all \<open>rule TTC_Next_State\<close>; simp)
apply (fold T1_def T2_def T3_def T4_def)
apply (simp add: T1_def T2_def T3_def T4_def)
(* step *)
apply (rule TTC_Evt_Plus; simp)
apply (rule_tac phi = "(V ''a'')" in TTC_Ctd1; simp)
apply (rule TTC_Alw; simp)
apply (rule TTC_Imp; simp)
apply (rule TTC_Alw; simp)
apply (rule TTC_Imp; simp)
apply (rule TTC_Alw; simp)
apply (rule TTC_Imp; simp)
apply (rule_tac phi = "(V ''b'')" in TTC_Ctd1; simp)
apply (rule TTC_Or; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_Alw; simp)
apply (rule TTC_Imp; simp)
defer
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
defer
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_Alw; simp)
apply (rule TTC_Imp; simp)
defer
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule_tac phi = "\<circle>(V ''c'')" in TTC_Ctd1; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_Alw; simp)
apply (rule TTC_Imp; simp)
apply (rule_tac phi = "(V ''b'')" in TTC_Ctd1; simp)
apply (rule TTC_Or; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_Alw; simp)
apply (rule TTC_Imp; simp)
defer
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
defer
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule_tac phi = "\<circle>(V ''b'')" in TTC_Ctd1; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_Alw; simp)
apply (rule TTC_Imp; simp)
apply (rule TTC_Alw; simp)
apply (rule TTC_Imp; simp)
apply (rule_tac phi = "(V ''b'')" in TTC_Ctd1; simp)
apply (rule TTC_Or; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule_tac phi = "\<circle>(V ''a'')" in TTC_Ctd1; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule_tac phi = "\<circle>(V ''a'')" in TTC_Ctd1; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule_tac phi = "\<circle>(V ''a'')" in TTC_Ctd1; simp)
apply (tactic {* distinct_subgoals_tac *})
apply (all \<open>rule TTC_Next_State\<close>; simp)
apply (fold T1_def T2_def T3_def T4_def)
apply (simp add: T1_def T2_def T3_def T4_def)
(* step *)
apply (rule TTC_U_Sel; simp)
apply (rule_tac phi = "(V ''a'')" in TTC_Ctd1; simp)
apply (rule TTC_Or; simp)
apply (rule TTC_Or; simp)
apply (rule TTC_Or; simp)
apply (rule_tac phi = "(V ''b'')" in TTC_Ctd1; simp)
apply (rule_tac phi = "(V ''a'')" in TTC_Ctd1; simp)
apply (rule_tac phi = "(V ''c'')" in TTC_Ctd1; simp)
apply (rule_tac phi = "(V ''d'')" in TTC_Ctd1; simp)
apply (tactic {* distinct_subgoals_tac *})
apply (all \<open>rule TTC_Next_State\<close>; simp)
apply (simp add: T1_def T2_def T3_def T4_def)
(* step *)
apply (rule TTC_U_Sel; simp)
apply (rule_tac phi = "(V ''a'')" in TTC_Ctd1; simp)
apply (rule TTC_Or; simp)
apply (rule TTC_Or; simp)
apply (rule TTC_Or; simp)
apply (rule TTC_Alw; simp)
apply (rule TTC_Imp; simp)
apply (rule TTC_Alw; simp)
apply (rule TTC_Imp; simp)
apply (rule_tac phi = "(V ''c'')" in TTC_Ctd1; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_Alw; simp)
apply (rule TTC_Imp; simp)
apply (rule TTC_Alw; simp)
apply (rule TTC_Imp; simp)
defer
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
defer
apply (rule TTC_Or; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_Alw; simp)
apply (rule TTC_Imp; simp)
defer
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
defer
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule_tac phi = "\<circle>(V ''b'')" in TTC_Ctd1; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_Alw; simp)
apply (rule TTC_Imp; simp)
apply (rule_tac phi = "(V ''c'')" in TTC_Ctd1; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule_tac phi = "\<circle>(V ''a'')" in TTC_Ctd1; simp)
apply (rule_tac phi = "(V ''a'')" in TTC_Ctd1; simp)
apply (rule TTC_Alw; simp)
apply (rule TTC_Imp; simp)
apply (rule TTC_Alw; simp)
apply (rule TTC_Imp; simp)
apply (rule_tac phi = "(V ''c'')" in TTC_Ctd1; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_Alw; simp)
apply (rule TTC_Imp; simp)
apply (rule TTC_Alw; simp)
apply (rule TTC_Imp; simp)
defer
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
defer
apply (rule TTC_Or; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_Alw; simp)
apply (rule TTC_Imp; simp)
defer
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
defer
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule_tac phi = "\<circle>(V ''b'')" in TTC_Ctd1; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_Alw; simp)
apply (rule TTC_Imp; simp)
apply (rule_tac phi = "(V ''c'')" in TTC_Ctd1; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule TTC_And; simp)
apply (rule_tac phi = "\<circle>(V ''a'')" in TTC_Ctd1; simp)
apply (rule_tac phi = "(V ''d'')" in TTC_Ctd1; simp)
apply (tactic {* distinct_subgoals_tac *})
apply (all \<open>rule TTC_Next_State\<close>; simp)
apply (fold T1_def T2_def T3_def T4_def)
apply (simp add: T1_def T2_def T3_def T4_def)
(* step *)
apply (rule TTC_U_Sel; simp)
apply (rule_tac phi = "(V ''a'')" in TTC_Ctd1; simp)
apply (rule TTC_And; simp)
apply (rule TTC_Or; simp)
apply (rule TTC_Or; simp)
apply (rule TTC_Or; simp)
apply (rule TTC_Or; simp)
apply (rule TTC_Or; simp)
apply (rule TTC_Or; simp)
apply (rule_tac phi = "(V ''b'')" in TTC_Ctd1; simp)
apply (rule_tac phi = "(V ''a'')" in TTC_Ctd1; simp)
apply (rule_tac phi = "(V ''a'')" in TTC_Ctd1; simp)
apply (rule_tac phi = "(V ''c'')" in TTC_Ctd1; simp)
apply (rule TTC_Or; simp)
apply (rule TTC_Or; simp)
apply (rule_tac phi = "(V ''b'')" in TTC_Ctd1; simp)
apply (rule_tac phi = "(V ''a'')" in TTC_Ctd1; simp)
apply (rule_tac phi = "(V ''c'')" in TTC_Ctd1; simp)
apply (rule_tac phi = "(V ''d'')" in TTC_Ctd1; simp)
apply (rule_tac phi = "(V ''d'')" in TTC_Ctd1; simp)
apply (tactic {* distinct_subgoals_tac *})
  done
*)

end


(*
    Author:      René Thiemann
    License:     LGPL
*)
section \<open>Show for Complex Numbers\<close>

text \<open>We print complex numbers as real and imaginary parts. Note that by transitivity, this theory
  demands that an implementations for \textit{show-real} is available, e.g., by using
  one of the theories \textit{Show-Real-Impl} or \textit{../Algebraic-Numbers/Show-Real-...}.\<close>
theory Show_Complex
imports
  HOL.Complex
  Show_Real
begin

definition "show_complex x = (
  let r = Re x; i = Im x in
  if (i = 0) then show_real r else if
  r = 0 then show_real i @ ''i'' else
  ''('' @ show_real r @ ''+'' @ show_real i @ ''i)'')"

definition showsp_complex :: "complex showsp"
where
  "showsp_complex p x y =
    (show_complex x @ y)"

lemma show_law_complex [show_law_intros]:
  "show_law showsp_complex r"
  by (rule show_lawI) (simp add: showsp_complex_def show_law_simps)

lemma showsp_complex_append [show_law_simps]:
  "showsp_complex p r (x @ y) = showsp_complex p r x @ y"
  by (intro show_lawD show_law_intros)

local_setup \<open>
  Show_Generator.register_foreign_showsp @{typ complex} @{term "showsp_complex"} @{thm show_law_complex}
\<close>

derive "show" complex
end


theory Short_Theory_12_11
  imports "HOL-IMP.BExp" "HOL-IMP.Star"
begin

datatype
  com = SKIP
  | Do "state \<Rightarrow> state"       ("DO _" [61] 61)
  | Seq    com  com         ("_;;/ _"  [60, 61] 60)
  | If     bexp com com     ("(IF _/ THEN _/ ELSE _)"  [0, 60, 61] 61)
  | While  bexp com         ("(WHILE _/ DO _)"  [0, 61] 61)

inductive big_step :: "com \<times> state \<Rightarrow> state \<Rightarrow> bool" (infix "\<Rightarrow>" 55) where
    Skip: "(SKIP, s) \<Rightarrow> s" |
    Do: "(DO f, s) \<Rightarrow> f s" |
    Seq: "\<lbrakk> (c\<^sub>1, s\<^sub>1) \<Rightarrow> s\<^sub>2;  (c\<^sub>2, s\<^sub>2) \<Rightarrow> s\<^sub>3 \<rbrakk> \<Longrightarrow> (c\<^sub>1;;c\<^sub>2, s\<^sub>1) \<Rightarrow> s\<^sub>3" |
    IfTrue: "\<lbrakk> bval b s;  (c\<^sub>1, s) \<Rightarrow> s' \<rbrakk> \<Longrightarrow> (IF b THEN c\<^sub>1 ELSE c\<^sub>2, s) \<Rightarrow> s'" |
    IfFalse: "\<lbrakk> \<not>bval b s;  (c\<^sub>2, s) \<Rightarrow> s' \<rbrakk> \<Longrightarrow> (IF b THEN c\<^sub>1 ELSE c\<^sub>2, s) \<Rightarrow> s'" |
    WhileFalse: "\<not>bval b s \<Longrightarrow> (WHILE b DO c, s) \<Rightarrow> s" |
    WhileTrue: "\<lbrakk> bval b s\<^sub>1;  (c, s\<^sub>1) \<Rightarrow> s\<^sub>2;  (WHILE b DO c, s\<^sub>2) \<Rightarrow> s\<^sub>3 \<rbrakk>
      \<Longrightarrow> (WHILE b DO c, s\<^sub>1) \<Rightarrow> s\<^sub>3"
lemmas big_step_induct = big_step.induct[split_format(complete)]
declare big_step.intros [intro]

lemma BS_SkipE[elim!]: "\<lbrakk>(SKIP, s) \<Rightarrow> t; t = s \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
  by (cases rule: big_step.cases) auto
lemma BS_DoE[elim!]: "\<lbrakk>(DO f, s) \<Rightarrow> t; t = f s \<Longrightarrow> P\<rbrakk> \<Longrightarrow> P"
  by (cases rule: big_step.cases) auto
lemma BS_SeqE[elim!]: "\<lbrakk>(c\<^sub>1;; c\<^sub>2, s\<^sub>1) \<Rightarrow> s\<^sub>3;
 \<And>s\<^sub>2. \<lbrakk>(c\<^sub>1, s\<^sub>1) \<Rightarrow> s\<^sub>2; (c\<^sub>2, s\<^sub>2) \<Rightarrow> s\<^sub>3\<rbrakk> \<Longrightarrow> P\<rbrakk>
\<Longrightarrow> P"
  by (cases rule: big_step.cases) auto
lemma BS_IfE[elim!]: "\<lbrakk>
  (IF b THEN c\<^sub>1 ELSE c\<^sub>2, s) \<Rightarrow> t;
  \<lbrakk>bval b s; (c\<^sub>1, s) \<Rightarrow> t\<rbrakk> \<Longrightarrow> P;
  \<lbrakk>\<not> bval b s; (c\<^sub>2, s) \<Rightarrow> t\<rbrakk> \<Longrightarrow> P
\<rbrakk> \<Longrightarrow> P"
  by (cases rule: big_step.cases) auto
lemma BS_WhileE[elim]: "\<lbrakk>
  (WHILE b DO c, s) \<Rightarrow> t;
  \<lbrakk>\<not> bval b t; s = t\<rbrakk> \<Longrightarrow> P;
  \<And>s\<^sub>2. \<lbrakk>bval b s; (c, s) \<Rightarrow> s\<^sub>2; (WHILE b DO c, s\<^sub>2) \<Rightarrow> t\<rbrakk> \<Longrightarrow> P
\<rbrakk> \<Longrightarrow> P"
  by (cases rule: big_step.cases) auto
abbreviation
  equiv_c :: "com \<Rightarrow> com \<Rightarrow> bool" (infix "\<sim>" 50) where
  "c \<sim> c' \<equiv> (\<forall>s t. (c,s) \<Rightarrow> t  =  (c',s) \<Rightarrow> t)"
lemma unfold_while:
  "(WHILE b DO c) \<sim> (IF b THEN c;; WHILE b DO c ELSE SKIP)" (is "?w \<sim> ?iw")
proof -
  \<comment> \<open>to show the equivalence, we look at the derivation tree for\<close>
  \<comment> \<open>each side and from that construct a derivation tree for the other side\<close>
  have "(?iw, s) \<Rightarrow> t" if assm: "(?w, s) \<Rightarrow> t" for s t
  proof -
    from assm show ?thesis
    proof cases \<comment> \<open>rule inversion on \<open>(?w, s) \<Rightarrow> t\<close>\<close>
      case WhileFalse
      thus ?thesis by blast
    next
      case WhileTrue
      from \<open>bval b s\<close> \<open>(?w, s) \<Rightarrow> t\<close> obtain s' where
        "(c, s) \<Rightarrow> s'" and "(?w, s') \<Rightarrow> t" by auto
      \<comment> \<open>now we can build a derivation tree for the \<^text>\<open>IF\<close>\<close>
      \<comment> \<open>first, the body of the True-branch:\<close>
      hence "(c;; ?w, s) \<Rightarrow> t" by (rule Seq)
      \<comment> \<open>then the whole \<^text>\<open>IF\<close>\<close>
      with \<open>bval b s\<close> show ?thesis by (rule IfTrue)
    qed
  qed
  moreover
  \<comment> \<open>now the other direction:\<close>
  have "(?w, s) \<Rightarrow> t" if assm: "(?iw, s) \<Rightarrow> t" for s t
  proof -
    from assm show ?thesis
    proof cases \<comment> \<open>rule inversion on \<open>(?iw, s) \<Rightarrow> t\<close>\<close>
      case IfFalse
      hence "s = t" using \<open>(?iw, s) \<Rightarrow> t\<close> by blast
      thus ?thesis using \<open>\<not>bval b s\<close> by blast
    next
      case IfTrue
      \<comment> \<open>and for this, only the Seq-rule is applicable:\<close>
      from \<open>(c;; ?w, s) \<Rightarrow> t\<close> obtain s' where
        "(c, s) \<Rightarrow> s'" and "(?w, s') \<Rightarrow> t" by auto
      \<comment> \<open>with this information, we can build a derivation tree for \<^text>\<open>WHILE\<close>\<close>
      with \<open>bval b s\<close> show ?thesis by (rule WhileTrue)
    qed
  qed
  ultimately
  show ?thesis by blast
qed

section "Hoare Logic"

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)"

abbreviation state_subst :: "state \<Rightarrow> aexp \<Rightarrow> vname \<Rightarrow> state"
  ("_[_'/_]" [1000,0,0] 999)
  where "s[a/x] == s(x := aval a s)"

inductive
  hoare :: "assn \<Rightarrow> com \<Rightarrow> assn \<Rightarrow> bool" ("\<turnstile> ({(1_)}/ (_)/ {(1_)})" 50)
where
Skip: "\<turnstile> {P} SKIP {P}"  |
Do:  "\<turnstile> {\<lambda>s. P (f s)} DO f {P}"  |
Seq: "\<lbrakk> \<turnstile> {P} c\<^sub>1 {Q};  \<turnstile> {Q} c\<^sub>2 {R} \<rbrakk>
      \<Longrightarrow> \<turnstile> {P} c\<^sub>1;;c\<^sub>2 {R}"  |
If: "\<lbrakk> \<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} \<rbrakk>
     \<Longrightarrow> \<turnstile> {P} IF b THEN c\<^sub>1 ELSE c\<^sub>2 {Q}"  |
While: "\<turnstile> {\<lambda>s. P s \<and> bval b s} c {P} \<Longrightarrow>
        \<turnstile> {P} WHILE b DO c {\<lambda>s. P s \<and> \<not> bval b s}"  |
conseq: "\<lbrakk> \<forall>s. P' s \<longrightarrow> P s;  \<turnstile> {P} c {Q};  \<forall>s. Q s \<longrightarrow> Q' s \<rbrakk>
        \<Longrightarrow> \<turnstile> {P'} c {Q'}"
lemmas [simp] = hoare.Skip hoare.Do hoare.Seq If
lemmas [intro!] = hoare.Skip hoare.Do hoare.Seq hoare.If

lemma Do': "\<forall>s. P s \<longrightarrow> Q(f s) \<Longrightarrow> \<turnstile> {P} DO f {Q}"
  by (simp add: strengthen_pre [OF _ Do])

lemma While':
  assumes "\<turnstile> {\<lambda>s. P s \<and> bval b s} c {P}" and "\<forall>s. P s \<and> \<not> bval b s \<longrightarrow> Q s"
  shows "\<turnstile> {P} WHILE b DO c {Q}"
  by(rule weaken_post [OF While [OF assms(1)] assms(2)])

lemma hoare_sound: "\<turnstile> {P}c{Q}  \<Longrightarrow>  \<Turnstile> {P}c{Q}"
proof(induction rule: hoare.induct)
  case (While P b c)
  have "(WHILE b DO c,s) \<Rightarrow> t  \<Longrightarrow>  P s  \<Longrightarrow>  P t \<and> \<not> bval b t" for s t
  proof(induction "WHILE b DO c" s t rule: big_step_induct)
    case WhileFalse thus ?case by blast
  next
    case WhileTrue thus ?case
      using While.IH unfolding hoare_valid_def by blast
  qed
  thus ?case unfolding hoare_valid_def by blast
qed (auto simp: hoare_valid_def)

definition wp :: "com \<Rightarrow> assn \<Rightarrow> assn" where
"wp c Q = (\<lambda>s. \<forall>t. (c,s) \<Rightarrow> t  \<longrightarrow>  Q t)"

lemma wp_SKIP[simp]: "wp SKIP Q = Q"
  by (rule ext) (auto simp: wp_def)

lemma wp_Do[simp]: "wp (DO f) Q = (\<lambda>s. Q (f s))"
  by (rule ext) (auto simp: wp_def)

lemma wp_Seq[simp]: "wp (c\<^sub>1;;c\<^sub>2) Q = wp c\<^sub>1 (wp c\<^sub>2 Q)"
  by (rule ext) (auto simp: wp_def)

lemma wp_If[simp]:
  "wp (IF b THEN c\<^sub>1 ELSE c\<^sub>2) Q =
  (\<lambda>s. if bval b s then wp c\<^sub>1 Q s else wp c\<^sub>2 Q s)"
  by (rule ext) (auto simp: wp_def)

lemma wp_While_If:
  "wp (WHILE b DO c) Q s =
  wp (IF b THEN c;;WHILE b DO c ELSE SKIP) Q s"
unfolding wp_def by (metis unfold_while)

lemma wp_While_True[simp]: "bval b s \<Longrightarrow>
  wp (WHILE b DO c) Q s = wp (c;; WHILE b DO c) Q s"
by(simp add: wp_While_If)

lemma wp_While_False[simp]: "\<not> bval b s \<Longrightarrow> wp (WHILE b DO c) Q s = Q s"
  by(simp add: wp_While_If)
lemma wp_is_pre: "\<turnstile> {wp c Q} c {Q}"
proof(induction c arbitrary: Q)
  case If thus ?case by(auto intro: conseq)
next
  case (While b c)
  let ?w = "WHILE b DO c"
  show "\<turnstile> {wp ?w Q} ?w {Q}"
  proof(rule While')
    show "\<turnstile> {\<lambda>s. wp ?w Q s \<and> bval b s} c {wp ?w Q}"
    proof(rule strengthen_pre[OF _ While.IH])
      show "\<forall>s. wp ?w Q s \<and> bval b s \<longrightarrow> wp c (wp ?w Q) s" by auto
    qed
    show "\<forall>s. wp ?w Q s \<and> \<not> bval b s \<longrightarrow> Q s" by auto
  qed
qed auto
lemma hoare_complete: assumes "\<Turnstile> {P}c{Q}" shows "\<turnstile> {P}c{Q}"
proof(rule strengthen_pre)
  show "\<forall>s. P s \<longrightarrow> wp c Q s" using assms
    by (auto simp: hoare_valid_def wp_def)
  show "\<turnstile> {wp c Q} c {Q}" by(rule wp_is_pre)
qed
corollary hoare_sound_complete: "\<turnstile> {P}c{Q} \<longleftrightarrow> \<Turnstile> {P}c{Q}"
by (metis hoare_complete hoare_sound)

end


(*  Title:      ZF/Constructible/MetaExists.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
*)

section\<open>The meta-existential quantifier\<close>

theory MetaExists imports Main begin

text\<open>Allows quantification over any term.  Used to quantify over classes.
Yields a proposition rather than a FOL formula.\<close>

definition
  ex :: "(('a::{}) \<Rightarrow> prop) \<Rightarrow> prop"  (binder "\<Or>" 0) where
  "ex(P) == (\<And>Q. (\<And>x. PROP P(x) \<Longrightarrow> PROP Q) \<Longrightarrow> PROP Q)"

lemma meta_exI: "PROP P(x) ==> (\<Or>x. PROP P(x))"
proof (unfold ex_def)
  assume P: "PROP P(x)"
  fix Q
  assume PQ: "\<And>x. PROP P(x) \<Longrightarrow> PROP Q"
  from P show "PROP Q" by (rule PQ)
qed

lemma meta_exE: "[|\<Or>x. PROP P(x);  \<And>x. PROP P(x) ==> PROP R |] ==> PROP R"
proof (unfold ex_def)
  assume QPQ: "\<And>Q. (\<And>x. PROP P(x) \<Longrightarrow> PROP Q) \<Longrightarrow> PROP Q"
  assume PR: "\<And>x. PROP P(x) \<Longrightarrow> PROP R"
  from PR show "PROP R" by (rule QPQ)
qed

end


theory  Correspondence_theory2  imports DDLE
begin  (*System F *)
lemma limited_corresponds_to_Dstar:
 "(\<forall>\<phi>. (\<exists>x. (\<phi>)x) \<longrightarrow> (\<exists>x. opt<\<phi>>x)) \<longleftrightarrow> (\<forall>\<Phi> \<Psi>. \<lfloor>\<diamond>\<Phi> \<^bold>\<rightarrow> (\<circle><\<Psi>|\<Phi>>  \<^bold>\<rightarrow> \<^bold>\<not>\<circle><\<^bold>\<not>\<Psi>|\<Phi>>)\<rfloor>)"
  unfolding ddecond_def ddediomond_def ddeimp_def ddeneg_def ddevalid_def  sledgehammer
  by auto

(*System G  *)
lemma limited_trans_corresponds_to_SP_Dstar_1:
 "((\<forall>\<phi>. (\<exists>x. (\<phi>)x) \<longrightarrow> (\<exists>x. opt<\<phi>>x)) \<and> (\<forall>x y z. (x r y \<and> y r z) \<longrightarrow> x r z))
  \<longrightarrow>
  ((\<forall>\<Phi> \<Psi> \<chi>.\<lfloor>(\<^bold>\<not>\<circle><\<^bold>\<not>\<Psi>|\<Phi>> \<^bold>\<and> \<circle><\<Psi>\<^bold>\<rightarrow>\<chi>|\<Phi>>) \<^bold>\<rightarrow> \<circle><\<chi>|\<Phi>\<^bold>\<and>\<Psi>>\<rfloor>) \<and> (\<forall>\<Phi> \<Psi>.\<lfloor>\<diamond>\<Phi> \<^bold>\<rightarrow> (\<circle><\<Psi>|\<Phi>> \<^bold>\<rightarrow> \<^bold>\<not>\<circle><\<^bold>\<not>\<Psi>|\<Phi>>)\<rfloor>))"
  unfolding ddecond_def ddediomond_def ddeimp_def ddeneg_def ddeand_def ddevalid_def ddeopt_def
  sledgehammer by smt   (* this direction is provable *)

lemma limited_trans_corresponds_to_SP_Dstar_2: (* this is still too hard for the ATPs *)
 "((\<forall>\<Phi> \<Psi> \<chi>.\<lfloor>(\<^bold>\<not>\<circle><\<^bold>\<not>\<Psi>|\<Phi>> \<^bold>\<and> \<circle><\<Psi>\<^bold>\<rightarrow>\<chi>|\<Phi>>) \<^bold>\<rightarrow> \<circle><\<chi>|\<Phi>\<^bold>\<and>\<Psi>>\<rfloor>) \<and> (\<forall>\<Phi> \<Psi>.\<lfloor>\<diamond>\<Phi> \<^bold>\<rightarrow> (\<circle><\<Psi>|\<Phi>> \<^bold>\<rightarrow> \<^bold>\<not>\<circle><\<^bold>\<not>\<Psi>|\<Phi>>)\<rfloor>))
  \<longrightarrow>
  ((\<forall>\<phi>. (\<exists>x. (\<phi>)x) \<longrightarrow> (\<exists>x. opt<\<phi>>x)) \<and> (\<forall>x y z. (x r y \<and> y r z) \<longrightarrow> x r z))"
  unfolding ddecond_def ddediomond_def ddeimp_def ddeneg_def ddeand_def ddevalid_def ddeopt_def
  oops

lemma limited_trans_corresponds_to_SP_Dstar_2a: (* splitting the conjunct, limitednedd is easy for the ATPs*)
 "((\<forall>\<Phi> \<Psi> \<chi>.\<lfloor>(\<^bold>\<not>\<circle><\<^bold>\<not>\<Psi>|\<Phi>> \<^bold>\<and> \<circle><\<Psi>\<^bold>\<rightarrow>\<chi>|\<Phi>>) \<^bold>\<rightarrow> \<circle><\<chi>|\<Phi>\<^bold>\<and>\<Psi>>\<rfloor>) \<and> (\<forall>\<Phi> \<Psi>.\<lfloor>\<diamond>\<Phi> \<^bold>\<rightarrow> (\<circle><\<Psi>|\<Phi>> \<^bold>\<rightarrow> \<^bold>\<not>\<circle><\<^bold>\<not>\<Psi>|\<Phi>>)\<rfloor>))
  \<longrightarrow>
  (\<forall>\<phi>. (\<exists>x. (\<phi>)x) \<longrightarrow> (\<exists>x. opt<\<phi>>x))"
  unfolding ddecond_def ddediomond_def ddeimp_def ddeneg_def ddeand_def ddevalid_def ddeopt_def
  sledgehammer by auto
(*
(\<forall>\<Phi> \<Psi>.\<lfloor>\<diamond>\<Phi> \<^bold>\<rightarrow> (\<circle><\<Psi>|\<Phi>> \<^bold>\<rightarrow> \<^bold>\<not>\<circle><\<^bold>\<not>\<Psi>|\<Phi>>)\<rfloor>
*)
lemma limited_trans_corresponds_to_SP_Dstar_2b: (* splitting the conjunct, transitivity is too hard for the ATPs*)
 "(\<forall>x y z. ((\<forall>\<Phi> \<Psi> \<chi>.\<lfloor>(\<^bold>\<not>\<circle><\<^bold>\<not>\<Psi>|\<Phi>> \<^bold>\<and> \<circle><\<Psi>\<^bold>\<rightarrow>\<chi>|\<Phi>>) \<^bold>\<rightarrow> \<circle><\<chi>|\<Phi>\<^bold>\<and>\<Psi>>\<rfloor>) \<and> (\<forall>\<Phi> \<Psi>.\<lfloor>\<diamond>\<Phi> \<^bold>\<rightarrow>(\<circle><\<Psi>|\<Phi>> \<^bold>\<rightarrow> \<^bold>\<not>\<circle><\<^bold>\<not>\<Psi>|\<Phi>>)\<rfloor>)\<and> (x r y \<and> y r z))
  \<longrightarrow>
  (x r z))"
  unfolding ddecond_def ddediomond_def ddeimp_def ddeneg_def ddeand_def ddevalid_def sledgehammer
(*
  sledgehammer () nitpick nunchaku
  sledgehammer [timeout=600, remote_leo2 remote_leo3 remote_satallax] ()
   by smt
*)

  (* this direction unfortunately not yet, but we also do not get a countermodel; proof might be to hard *)

(*** end of header part ***)

end