(*<*)
theory KBPsAlg
imports KBPsAuto DFS MapOps
begin
(*>*)

subsection{* An algorithm for automata synthesis *}

text{*

\label{sec:kbps-alg}

We now show how to construct the automaton defined by @{term
"mkAutoSim"} (\S\ref{sec:kbps-automata-synthesis-alg}) using the DFS
of \S\ref{sec:dfs}.

From here on we assume that the environment consists of only a finite
set of states:

*}

locale FiniteEnvironment =
  Environment jkbp envInit envAction envTrans envVal envObs
    for jkbp :: "('a, 'p, 'aAct) JKBP"
    and envInit :: "('s :: finite) list"
    and envAction :: "'s \<Rightarrow> 'eAct list"
    and envTrans :: "'eAct \<Rightarrow> ('a \<Rightarrow> 'aAct) \<Rightarrow> 's \<Rightarrow> 's"
    and envVal :: "'s \<Rightarrow> 'p \<Rightarrow> bool"
    and envObs :: "'a \<Rightarrow> 's \<Rightarrow> 'obs"

text_raw{*
\begin{figure}[p]
\begin{isabellebody}%
*}
locale Algorithm =
  FiniteEnvironment jkbp envInit envAction envTrans envVal envObs
+ AlgSimIncrEnvironment jkbp envInit envAction envTrans envVal jview envObs
               jviewInit jviewIncr
               simf simRels simVal simAbs simObs simInit simTrans simAction
    for jkbp :: "('a, 'p, 'aAct) JKBP"
    and envInit :: "('s :: finite) list"
    and envAction :: "'s \<Rightarrow> 'eAct list"
    and envTrans :: "'eAct \<Rightarrow> ('a \<Rightarrow> 'aAct) \<Rightarrow> 's \<Rightarrow> 's"
    and envVal :: "'s \<Rightarrow> 'p \<Rightarrow> bool"
    and jview :: "('a, 's, 'tobs) JointView"

    and envObs :: "'a \<Rightarrow> 's \<Rightarrow> 'obs"
    and jviewInit :: "('a, 'obs, 'tobs) InitialIncrJointView"
    and jviewIncr :: "('a, 'obs, 'tobs) IncrJointView"

    and simf :: "'s Trace \<Rightarrow> 'ss :: finite"
    and simRels :: "'a \<Rightarrow> 'ss Relation"
    and simVal :: "'ss \<Rightarrow> 'p \<Rightarrow> bool"

    and simAbs :: "'rep \<Rightarrow> 'ss set"

    and simObs :: "'a \<Rightarrow> 'rep \<Rightarrow> 'obs"
    and simInit :: "'a \<Rightarrow> 'obs \<Rightarrow> 'rep"
    and simTrans :: "'a \<Rightarrow> 'rep \<Rightarrow> 'rep list"
    and simAction :: "'a \<Rightarrow> 'rep \<Rightarrow> 'aAct list"

+ fixes aOps :: "('ma, 'rep, 'aAct list) MapOps"
    and tOps :: "('mt, 'rep \<times> 'obs, 'rep) MapOps"

  assumes aOps: "MapOps simAbs jkbpSEC aOps"
      and tOps: "MapOps (\<lambda>k. (simAbs (fst k), snd k)) (jkbpSEC \<times> UNIV) tOps"
text_raw{*
  \end{isabellebody}%
  \caption{The @{text "Algorithm"} locale.}
  \label{fig:kbps-alg-alg-locale}
\end{figure}
*}

text (in Algorithm) {*

The @{term "Algorithm"} locale, shown in
Figure~\ref{fig:kbps-alg-alg-locale}, also extends the @{term
"AlgSimIncrEnvironment"} locale with a pair of finite map operations:
@{term "aOps"} is used to map automata states to lists of actions, and
@{term "tOps"} handles simulated transitions. In both cases the maps
are only required to work on the abstract domain of simulated
canonical traces. Note also that the space of simulated equivalence
classes of type @{typ "'ss"} must be finite, but there is no
restriction on the representation type @{typ "'rep"}.

We develop the algorithm for a single, fixed agent, which requires us
to define a new locale @{term "AlgorithmForAgent"} that extends @{text
"Algorithm"} with an extra parameter designating the agent:

*}

locale AlgorithmForAgent =
  Algorithm jkbp envInit envAction envTrans envVal jview envObs
            jviewInit jviewIncr
            simf simRels simVal simAbs simObs simInit simTrans simAction
            aOps tOps(*<*)
    for jkbp :: "('a, 'p, 'aAct) JKBP"
    and envInit :: "('s :: finite) list"
    and envAction :: "'s \<Rightarrow> 'eAct list"
    and envTrans :: "'eAct \<Rightarrow> ('a \<Rightarrow> 'aAct) \<Rightarrow> 's \<Rightarrow> 's"
    and envVal :: "'s \<Rightarrow> 'p \<Rightarrow> bool"
    and jview :: "('a, 's, 'tobs) JointView"

    and envObs :: "'a \<Rightarrow> 's \<Rightarrow> 'obs"
    and jviewInit :: "('a, 'obs, 'tobs) InitialIncrJointView"
    and jviewIncr :: "('a, 'obs, 'tobs) IncrJointView"

    and simf :: "'s Trace \<Rightarrow> 'ss :: finite"
    and simRels :: "'a \<Rightarrow> 'ss Relation"
    and simVal :: "'ss \<Rightarrow> 'p \<Rightarrow> bool"

    and simAbs :: "'rep \<Rightarrow> 'ss set"

    and simObs :: "'a \<Rightarrow> 'rep \<Rightarrow> 'obs"
    and simInit :: "'a \<Rightarrow> 'obs \<Rightarrow> 'rep"
    and simTrans :: "'a \<Rightarrow> 'rep \<Rightarrow> 'rep list"
    and simAction :: "'a \<Rightarrow> 'rep \<Rightarrow> 'aAct list"

    and aOps :: "('ma, 'rep, 'aAct list) MapOps"
    and tOps :: "('mt, 'rep \<times> 'obs, 'rep) MapOps"
(*>*)

  -- "..."
+ fixes a :: "'a"

subsubsection{* DFS operations *}

text{*

We represent the automaton under construction using a record:

*}

record ('ma, 'mt) AlgState =
  aActs :: "'ma"
  aTrans :: "'mt"

context AlgorithmForAgent
begin

text{*

We instantiate the DFS theory with the following functions.

A node is an equivalence class of represented simulated traces.

*}

definition k_isNode :: "'rep \<Rightarrow> bool" where
  "k_isNode ec \<equiv> simAbs ec \<in> sim_equiv_class a ` jkbpC"

text{*

The successors of a node are those produced by the simulated
transition function.

*}

abbreviation k_succs :: "'rep \<Rightarrow> 'rep list" where
  "k_succs \<equiv> simTrans a"

text{*

The initial automaton has no transitions and no actions.

*}

definition k_empt :: "('ma, 'mt) AlgState" where
  "k_empt \<equiv> \<lparr> aActs = empty aOps, aTrans = empty tOps \<rparr>"

text{*

We use the domain of the action map to track the set of nodes the DFS
has visited.

*}

definition k_memb :: "'rep \<Rightarrow> ('ma, 'mt) AlgState \<Rightarrow> bool" where
  "k_memb s A \<equiv> isSome (lookup aOps (aActs A) s)"

text{*

We integrate a new equivalence class into the automaton by updating
the action and transition maps:

*}

definition actsUpdate :: "'rep \<Rightarrow> ('ma, 'mt) AlgState \<Rightarrow> 'ma" where
  "actsUpdate ec A \<equiv> update aOps ec (simAction a ec) (aActs A)"

definition transUpdate :: "'rep \<Rightarrow> 'rep \<Rightarrow> 'mt \<Rightarrow> 'mt" where
  "transUpdate ec ec' at \<equiv> update tOps (ec, simObs a ec') ec' at"

definition k_ins :: "'rep \<Rightarrow> ('ma, 'mt) AlgState \<Rightarrow> ('ma, 'mt) AlgState" where
  "k_ins ec A \<equiv> \<lparr> aActs = actsUpdate ec A,
                   aTrans = foldr (transUpdate ec) (k_succs ec) (aTrans A) \<rparr>"

text{*

The required properties are straightforward to show.

*}

(*<*)

lemma k_isNode_cong:
  "simAbs ec' = simAbs ec \<Longrightarrow> k_isNode ec' \<longleftrightarrow> k_isNode ec"
  unfolding k_isNode_def by simp

lemma alg_MapOps_empty[simp]:
  "k_isNode ec \<Longrightarrow> lookup aOps (empty aOps) ec = None"
  "k_isNode (fst k) \<Longrightarrow> lookup tOps (empty tOps) k = None"
  unfolding k_isNode_def
  using MapOps_emptyD[OF _ aOps] MapOps_emptyD[OF _ tOps] by blast+

lemma alg_aOps_lookup_update[simp]:
  "\<lbrakk> k_isNode ec; k_isNode ec' \<rbrakk> \<Longrightarrow> lookup aOps (update aOps ec e M) ec' = (if simAbs ec' = simAbs ec then Some e else lookup aOps M ec')"
  unfolding k_isNode_def
  using MapOps_lookup_updateD[OF _ _ aOps] by blast

lemma alg_tOps_lookup_update[simp]:
  "\<lbrakk> k_isNode (fst k); k_isNode (fst k') \<rbrakk> \<Longrightarrow> lookup tOps (update tOps k e M) k' = (if (simAbs (fst k'), snd k') = (simAbs (fst k), snd k) then Some e else lookup tOps M k')"
  unfolding k_isNode_def
  using MapOps_lookup_updateD[OF _ _ tOps] by blast

lemma k_succs_is_node[intro, simp]:
  assumes x: "k_isNode x"
  shows "list_all k_isNode (k_succs x)"
proof -
  from x obtain t
    where tC: "t \<in> jkbpC"
      and sx: "simAbs x = sim_equiv_class a t"
    unfolding k_isNode_def by blast
  have F: "\<And>y. y \<in> set (k_succs x) \<Longrightarrow> simAbs y \<in> simAbs ` set (k_succs x)" by simp
  show ?thesis
    using simTrans[rule_format, where a=a and t=t] tC sx
    unfolding k_isNode_def [abs_def]
    apply (auto iff: list_all_iff)
    apply (frule F)
    apply (auto)
    done
qed

lemma k_memb_empt[simp]:
  "k_isNode x \<Longrightarrow> \<not>k_memb x k_empt"
  unfolding k_memb_def k_empt_def by simp

(*>*)

subsubsection{* Algorithm invariant *}

text{*

The invariant for the automata construction is straightforward, viz
that at each step of the process the state represents an automaton
that concords with @{term "mkAutoSim"} on the visited equivalence
classes. We also need to know that the state has preserved the @{term
"MapOps"} invariants.

*}

definition k_invariant :: "('ma, 'mt) AlgState \<Rightarrow> bool" where
  "k_invariant A \<equiv>
      (\<forall>ec ec'. k_isNode ec \<and> k_isNode ec' \<and> simAbs ec' = simAbs ec
        \<longrightarrow> lookup aOps (aActs A) ec = lookup aOps (aActs A) ec')
    \<and> (\<forall>ec ec' obs. k_isNode ec \<and> k_isNode ec' \<and> simAbs ec' = simAbs ec
        \<longrightarrow> lookup tOps (aTrans A) (ec, obs) = lookup tOps (aTrans A) (ec', obs))
    \<and> (\<forall>ec. k_isNode ec \<and> k_memb ec A
        \<longrightarrow> (\<exists>acts. lookup aOps (aActs A) ec = Some acts
                   \<and> set acts = set (simAction a ec)))
    \<and> (\<forall>ec obs. k_isNode ec \<and> k_memb ec A
              \<and> obs \<in> simObs a ` set (simTrans a ec)
        \<longrightarrow> (\<exists>ec'. lookup tOps (aTrans A) (ec, obs) = Some ec'
                  \<and> simAbs ec' \<in> simAbs ` set (simTrans a ec)
                  \<and> simObs a ec' = obs))"
(*<*)

lemma k_invariantI[intro]:
  "\<lbrakk> \<And>ec ec'. \<lbrakk> k_isNode ec; k_isNode ec'; simAbs ec' = simAbs ec \<rbrakk>
       \<Longrightarrow> lookup aOps (aActs A) ec = lookup aOps (aActs A) ec';
     \<And>ec ec' obs. \<lbrakk> k_isNode ec; k_isNode ec'; simAbs ec' = simAbs ec \<rbrakk>
       \<Longrightarrow> lookup tOps (aTrans A) (ec, obs) = lookup tOps (aTrans A) (ec', obs);
     \<And>ec. \<lbrakk> k_isNode ec; k_memb ec A \<rbrakk>
       \<Longrightarrow> \<exists>acts. lookup aOps (aActs A) ec = Some acts \<and> set acts = set (simAction a ec);
     \<And>ec obs ecs'. \<lbrakk> k_isNode ec; k_memb ec A; obs \<in> simObs a ` set (simTrans a ec) \<rbrakk>
       \<Longrightarrow> \<exists>ec'. lookup tOps (aTrans A) (ec, obs) = Some ec'
               \<and> simAbs ec' \<in> simAbs ` set (simTrans a ec)
               \<and> simObs a ec' = obs \<rbrakk>
  \<Longrightarrow> k_invariant A"
  unfolding k_invariant_def by (simp (no_asm_simp))

lemma k_invariantAOD:
  "\<lbrakk> k_isNode ec; k_isNode ec'; simAbs ec' = simAbs ec; k_invariant A \<rbrakk>
     \<Longrightarrow> lookup aOps (aActs A) ec = lookup aOps (aActs A) ec'"
  unfolding k_invariant_def by blast

lemma k_invariantTOD:
  "\<lbrakk> k_isNode ec; k_isNode ec'; simAbs ec' = simAbs ec; k_invariant A \<rbrakk>
     \<Longrightarrow> lookup tOps (aTrans A) (ec, obs) = lookup tOps (aTrans A) (ec', obs)"
  unfolding k_invariant_def by blast

lemma k_invariantAD:
  "\<lbrakk> k_isNode ec; k_memb ec A; k_invariant A \<rbrakk>
     \<Longrightarrow> \<exists>acts. lookup aOps (aActs A) ec = Some acts \<and> set acts = set (simAction a ec)"
  unfolding k_invariant_def by blast

lemma k_invariantTD:
  "\<lbrakk> k_isNode ec; k_memb ec A; obs \<in> simObs a ` set (simTrans a ec); k_invariant A \<rbrakk>
     \<Longrightarrow> \<exists>ec'. lookup tOps (aTrans A) (ec, obs) = Some ec'
             \<and> simAbs ec' \<in> simAbs ` set (simTrans a ec)
             \<and> simObs a ec' = obs"
  unfolding k_invariant_def by blast

lemma k_invariant_empt[simp]:
  "k_invariant k_empt"
  apply rule
  apply auto
  apply (auto iff: k_empt_def)
  done

lemma k_invariant_step_new_aux:
  assumes X: "set X \<subseteq> set (k_succs x)"
      and x: "k_isNode x"
      and ec: "k_isNode ec"
      and ec': "simAbs ec' \<in> simAbs ` set X"
      and S: "simAbs ec = simAbs x"
  shows "\<exists>r. lookup tOps (foldr (transUpdate x) X Y) (ec, simObs a ec') = Some r
           \<and> simAbs r \<in> simAbs ` set (k_succs ec)
           \<and> simObs a r = simObs a ec'"
using X ec'
proof(induct X arbitrary: Y)
  case Nil thus ?case by simp
next
  case (Cons y ys) show ?case
  proof(cases "simAbs ec' = simAbs y")
    case False with x ec S Cons show ?thesis
      unfolding transUpdate_def
      apply clarsimp
      unfolding k_isNode_def
      apply (erule imageE)+
      apply (cut_tac a=a and t=ta and ec=x and ec'=ec in simTrans_simAbs_cong[symmetric])
      apply simp_all
      done
  next
    case True
    with Cons have F: "simAbs y \<in> simAbs ` set (k_succs x)"
      by auto
    from x obtain t
      where tC: "t \<in> jkbpC"
        and x': "simAbs x = sim_equiv_class a t"
      unfolding k_isNode_def by blast
    from F obtain t' s
      where "simAbs y = sim_equiv_class a (t' \<leadsto> s)"
        and tsC: "t' \<leadsto> s \<in> jkbpC"
        and tt': "jview a t = jview a t'"
      using simTrans[rule_format, where a=a and t=t] tC x' by auto
    with Cons.hyps[where Y=Y] Cons(2) Cons(3) True S x ec show ?thesis
      unfolding transUpdate_def
      apply auto
      apply (subst simTrans_simAbs_cong[where t=t' and ec'=x])
       apply blast

       using x' tt'
       apply auto[1]

       apply simp

       apply (rule image_eqI[where x=y])
       apply simp
       apply simp
      using simObs[rule_format, where a=a and t="t'\<leadsto>s"]
      apply simp
      done
  qed
qed

lemma k_invariant_step_new:
  assumes x: "k_isNode x"
      and ec: "k_isNode ec"
      and ec': "ec' \<in> set (k_succs ec)"
      and S: "simAbs ec = simAbs x"
  shows "\<exists>ec''. lookup tOps (aTrans (k_ins x A)) (ec, simObs a ec') = Some ec''
              \<and> simAbs ec'' \<in> simAbs ` set (k_succs ec)
              \<and> simObs a ec'' = simObs a ec'"
proof -
  from x ec'
  have ec': "simAbs ec' \<in> simAbs ` set (k_succs x)"
    unfolding k_isNode_def
    apply clarsimp
    apply (subst simTrans_simAbs_cong[OF _ _ S, symmetric])
    using S
    apply auto
    done
  thus ?thesis
    using k_invariant_step_new_aux[OF subset_refl x ec _ S, where ec'=ec']
    unfolding k_ins_def
    apply auto
    done
qed

lemma k_invariant_step_old_aux:
  assumes x: "k_isNode x"
      and ec: "k_isNode ec"
      and S: "simAbs ec \<noteq> simAbs x"
  shows "lookup tOps (foldr (transUpdate x) X Y) (ec, obs)
       = lookup tOps Y (ec, obs)"
proof(induct X)
  case (Cons z zs) with x ec S show ?case
    by (cases "lookup tOps Y (ec, obs)") (simp_all add: transUpdate_def)
qed simp

lemma k_invariant_step_old:
  assumes x: "k_isNode x"
      and ec: "k_isNode ec"
      and S: "simAbs ec \<noteq> simAbs x"
  shows "lookup tOps (aTrans (k_ins x A)) (ec, obs)
       = lookup tOps (aTrans A) (ec, obs)"
  unfolding k_ins_def
  using k_invariant_step_old_aux[OF x ec S]
  by simp

lemma k_invariant_frame:
  assumes B: "lookup tOps Y (ec, obs) = lookup tOps Y (ec', obs)"
      and x: "k_isNode x"
      and ec: "k_isNode ec"
      and ec': "k_isNode ec'"
      and S: "simAbs ec' = simAbs ec"
  shows "lookup tOps (foldr (transUpdate x) X Y) (ec, obs) = lookup tOps (foldr (transUpdate x) X Y) (ec', obs)"
  apply (induct X)
  unfolding transUpdate_def
   using B
   apply simp
  using x ec ec' S
  apply simp
  done

lemma k_invariant_step[simp]:
  assumes N: "k_isNode x"
      and I: "k_invariant A"
      and M: "\<not> k_memb x A"
  shows "k_invariant (k_ins x A)"
(*<*)
proof
  fix ec ec'
  assume ec: "k_isNode ec" and ec': "k_isNode ec'" and X: "simAbs ec' = simAbs ec"
  with N show "lookup aOps (aActs (k_ins x A)) ec = lookup aOps (aActs (k_ins x A)) ec'"
    unfolding k_ins_def actsUpdate_def
    using k_invariantAOD[OF ec ec' X I]
    apply simp
    done
next
  fix ec ec' obs
  assume ec: "k_isNode ec" and ec': "k_isNode ec'" and X: "simAbs ec' = simAbs ec"
  show "lookup tOps (aTrans (k_ins x A)) (ec, obs) = lookup tOps (aTrans (k_ins x A)) (ec', obs)"
    unfolding k_ins_def
    using k_invariant_frame[OF k_invariantTOD[OF ec ec' X I] N ec ec' X]
    apply simp
    done
next
  fix ec obs ecs'
  assume n: "k_isNode ec"
    and ec: "k_memb ec (k_ins x A)"
    and obs: "obs \<in> simObs a ` set (simTrans a ec)"
  show "\<exists>ec'. lookup tOps (aTrans (k_ins x A)) (ec, obs) = Some ec'
            \<and> simAbs ec' \<in> simAbs ` set (k_succs ec)
            \<and> simObs a ec' = obs"
  proof(cases "simAbs ec = simAbs x")
    case True with N n obs show ?thesis
      using k_invariant_step_new by auto
  next
    case False with I N n ec obs show ?thesis
      apply (simp add: k_invariant_step_old)
      apply (rule k_invariantTD)
      apply simp_all
      unfolding k_ins_def k_memb_def actsUpdate_def
      apply simp
      done
  qed
next
  fix ec
  assume n: "k_isNode ec"
     and ec: "k_memb ec (k_ins x A)"
  show "\<exists>acts. lookup aOps (aActs (k_ins x A)) ec = Some acts \<and> set acts = set (simAction a ec)"
  proof(cases "simAbs ec = simAbs x")
    case True with aOps N n show ?thesis
      unfolding k_ins_def actsUpdate_def
      apply clarsimp
      unfolding k_isNode_def
      apply clarsimp
      apply (erule jAction_simAbs_cong)
      apply auto
      done
  next
    case False with aOps N I M n ec show ?thesis
      unfolding k_ins_def actsUpdate_def
      apply simp
      apply (rule k_invariantAD)
      unfolding k_memb_def
      apply simp_all
      done
  qed
qed
(*>*)

(*>*)

text{*

Showing that the invariant holds of @{term "k_empt"} and is respected
by @{term "k_ins"} is routine.

The initial frontier is the partition of the set of initial states
under the initial observation function.

*}

definition (in Algorithm) k_frontier :: "'a \<Rightarrow> 'rep list" where
  "k_frontier a \<equiv> map (simInit a \<circ> envObs a) envInit"
(*<*)

lemma k_frontier_is_node[intro, simp]:
  "list_all k_isNode (k_frontier a)"
  unfolding k_frontier_def
  by (auto iff: simInit list_all_iff k_isNode_def jviewInit jviewIncr)
(*>*)

end (* context AlgorithmForAgent *)

text{*

We now instantiate the @{term "DFS"} locale with respect to the @{term
"AlgorithmForAgent"} locale. The instantiated lemmas are given the
mandatory prefix @{text "KBPAlg"} in the @{term "AlgorithmForAgent"}
locale.

*}

sublocale AlgorithmForAgent
        < KBPAlg!: DFS k_succs k_isNode k_invariant k_ins k_memb k_empt simAbs

(*<*)
  apply (unfold_locales)
  apply simp_all

  unfolding k_memb_def k_ins_def actsUpdate_def
  using aOps
  apply (auto iff: isSome_eq)[1]

  unfolding k_isNode_def
  apply clarsimp
  apply (erule simTrans_simAbs_cong)
  apply auto
  done
(*>*)

text_raw{*
\begin{figure}
\begin{isabellebody}%
*}
definition
  alg_dfs :: "('ma, 'rep, 'aAct list) MapOps
         \<Rightarrow> ('mt, 'rep \<times> 'obs, 'rep) MapOps
         \<Rightarrow> ('rep \<Rightarrow> 'obs)
         \<Rightarrow> ('rep \<Rightarrow> 'rep list)
         \<Rightarrow> ('rep \<Rightarrow> 'aAct list)
         \<Rightarrow> 'rep list
         \<Rightarrow> ('ma, 'mt) AlgState"
where
  "alg_dfs aOps tOps simObs simTrans simAction \<equiv>
    let k_empt = \<lparr> aActs = empty aOps, aTrans = empty tOps \<rparr>;
       k_memb = (\<lambda>s A. isSome (lookup aOps (aActs A) s));
       k_succs = simTrans;
       actsUpdate = \<lambda>ec A. update aOps ec (simAction ec) (aActs A);
       transUpdate = \<lambda>ec ec' at. update tOps (ec, simObs ec') ec' at;
       k_ins = \<lambda>ec A. \<lparr> aActs = actsUpdate ec A,
                         aTrans = foldr (transUpdate ec) (k_succs ec) (aTrans A) \<rparr>
     in gen_dfs k_succs k_ins k_memb k_empt"

text{**}

definition
  mkAlgAuto :: "('ma, 'rep, 'aAct list) MapOps
            \<Rightarrow> ('mt, 'rep \<times> 'obs, 'rep) MapOps
            \<Rightarrow> ('a \<Rightarrow> 'rep \<Rightarrow> 'obs)
            \<Rightarrow> ('a \<Rightarrow> 'obs \<Rightarrow> 'rep)
            \<Rightarrow> ('a \<Rightarrow> 'rep \<Rightarrow> 'rep list)
            \<Rightarrow> ('a \<Rightarrow> 'rep \<Rightarrow> 'aAct list)
            \<Rightarrow> ('a \<Rightarrow> 'rep list)
            \<Rightarrow> ('a, 'obs, 'aAct, 'rep) JointProtocol"
where
  "mkAlgAuto aOps tOps simObs simInit simTrans simAction frontier \<equiv> \<lambda>a.
    let auto = alg_dfs aOps tOps (simObs a) (simTrans a) (simAction a)
                       (frontier a)
     in \<lparr> pInit = simInit a,
          pTrans = \<lambda>obs ec. the (lookup tOps (aTrans auto) (ec, obs)),
          pAct = \<lambda>ec. the (lookup aOps (aActs auto) ec) \<rparr>"

text_raw{*
  \end{isabellebody}%
  \caption{The algorithm. The function @{term "the"} projects a value from the
    @{typ "'a option"} type, diverging on @{term "None"}.}
  \label{fig:kbps-alg-algorithm}
\end{figure}
*}
(*<*)
lemma mkAutoSim_simps[simp]:
  "pInit (mkAlgAuto aOps tOps simObs simInit simTrans simAction frontier a) = simInit a"
  "pTrans (mkAlgAuto aOps tOps simObs simInit simTrans simAction frontier a)
 = (\<lambda>obs ec. the (lookup tOps (aTrans (alg_dfs aOps tOps (simObs a) (simTrans a) (simAction a) (frontier a))) (ec, obs)))"
  "pAct (mkAlgAuto aOps tOps simObs simInit simTrans simAction frontier a)
 = (\<lambda>ec. the (lookup aOps (aActs (alg_dfs aOps tOps (simObs a) (simTrans a) (simAction a) (frontier a))) ec))"
  unfolding mkAlgAuto_def
  apply (simp_all add: Let_def)
  done

(* Later we want to show that a particular DFS implementation does the
right thing. *)

definition
  alg_mk_auto :: "('ma, 'rep, 'aAct list) MapOps
                \<Rightarrow> ('mt, 'rep \<times> 'obs, 'rep) MapOps
                \<Rightarrow> ('obs \<Rightarrow> 'rep)
                \<Rightarrow> ('ma, 'mt) AlgState
                \<Rightarrow> ('obs, 'aAct, 'rep) Protocol"
where
  "alg_mk_auto aOps tOps simInit k_dfs \<equiv>
    \<lparr> pInit = simInit,
      pTrans = \<lambda>obs ec. the (lookup tOps (aTrans k_dfs) (ec, obs)),
      pAct = \<lambda>ec. the (lookup aOps (aActs k_dfs) ec)
    \<rparr>"

(*>*)
context AlgorithmForAgent
begin

text{*

The final algorithm, with the constants inlined, is shown in
Figure~\ref{fig:kbps-alg-algorithm}. The rest of this section shows
its correctness.

Firstly it follows immediately from @{text "dfs_invariant"} that the
invariant holds of the result of the DFS:

*}
(*<*)

abbreviation
  "k_dfs \<equiv> KBPsAlg.alg_dfs aOps tOps (simObs a) (simTrans a) (simAction a) (k_frontier a)"

(* This is a syntactic nightmare. *)

lemma k_dfs_gen_dfs_unfold[simp]:
  "k_dfs = gen_dfs k_succs k_ins k_memb k_empt (k_frontier a)"
  unfolding alg_dfs_def
  apply (fold k_empt_def k_memb_def actsUpdate_def transUpdate_def)
  apply (simp add: k_ins_def[symmetric])
  done

(*>*)
lemma k_dfs_invariant: "k_invariant k_dfs"
(*<*)
  using KBPAlg.dfs_invariant[where S="k_empt" and xs="k_frontier a"]
  by simp

(*>*)
text{*

Secondly we can see that the set of reachable equivalence classes
coincides with the partition of @{term "jkbpC"} under the simulation
and representation functions:

*}

lemma k_reachable:
  "simAbs ` KBPAlg.reachable (set (k_frontier a)) = sim_equiv_class a ` jkbpC"
(*<*)(is "?lhs = ?rhs")
proof
  show "?lhs \<subseteq> ?rhs"
  proof
    fix sx assume "sx \<in> ?lhs"
    then obtain x
      where x: "x \<in> KBPAlg.reachable (set (k_frontier a))"
        and sx: "simAbs x = sx"
      by auto
    hence "x \<in> ({ (x, y). y \<in> set (k_succs x) })\<^sup>*
                 `` set (map (simInit a \<circ> envObs a) envInit)"
      unfolding KBPAlg.reachable_def k_frontier_def by simp
    then obtain s iobs
      where R: "(simInit a iobs, x) \<in> ({ (x, y). y \<in> set (k_succs x)})\<^sup>*"
        and sI: "s \<in> set envInit"
        and iobs: "envObs a s = iobs"
      by auto
    from R x have "simAbs x \<in> ?rhs"
    proof(induct arbitrary: sx rule: rtrancl_induct)
      case base
      with sI iobs show ?case by (auto simp: jviewInit simInit)
    next
      case (step x y)
      with sI iobs
      have "simAbs x \<in> sim_equiv_class a ` jkbpC"
        unfolding KBPAlg.reachable_def Image_def k_frontier_def
        by auto
      then obtain t
        where tC: "t \<in> jkbpC"
          and F: "simAbs x = sim_equiv_class a t"
        by auto
      from step
      have "simAbs y \<in> simAbs ` set (k_succs x)" by auto
      thus  ?case
        using simTrans[rule_format, where a=a and t=t] tC F by auto
    qed
    with sx show "sx \<in> ?rhs" by simp
  qed
next
  show "?rhs \<subseteq> ?lhs"
  proof
    fix ec assume "ec \<in> ?rhs"
    then obtain t
      where tC: "t \<in> jkbpC"
        and ec: "ec = sim_equiv_class a t"
      by auto
    thus "ec \<in> ?lhs"
    proof(induct t arbitrary: ec)
      case (tInit s) thus ?case
        unfolding KBPAlg.reachable_def (* FIXME ouch this is touchy *)
        unfolding k_frontier_def
        apply simp
        apply (rule image_eqI[where x="simInit a (envObs a s)"])
         apply (simp add: simInit jviewInit)
        apply (rule ImageI[where a="simInit a (envObs a s)"])
        apply auto
        done
    next
      case (tStep t s)
      hence tsC: "t \<leadsto> s \<in> jkbpC"
        and ec: "ec = sim_equiv_class a (t \<leadsto> s)"
        and "sim_equiv_class a t
           \<in> simAbs ` DFS.reachable k_succs (set (k_frontier a))"
        by auto
      then obtain rect
        where rect: "rect \<in> DFS.reachable k_succs (set (k_frontier a))"
          and srect: "simAbs rect = sim_equiv_class a t"
        by auto
      from tsC ec srect
      have "ec \<in> simAbs ` set (simTrans a rect)"
        using simTrans[rule_format, where a=a and t="t" and ec="rect"] srect by auto
      then obtain rec
        where rec: "ec = simAbs rec"
          and F: "rec \<in> set (simTrans a rect)"
        by auto
      from rect obtain rec0
        where rec0: "rec0 \<in> set (k_frontier a)"
          and rec0rect: "(rec0, rect) \<in> ({ (x, y). y \<in> set (k_succs x)})\<^sup>*"
        unfolding KBPAlg.reachable_def by auto
      show ?case
        apply -
        apply (rule image_eqI[where x="rec"])
         apply (rule rec)
        unfolding KBPAlg.reachable_def
        apply (rule ImageI[where a="rec0"])
         apply (rule rtrancl_into_rtrancl[where b="rect"])
          apply (rule rec0rect)
         apply clarsimp
         apply (rule F)
         apply (rule rec0)
         done
     qed
   qed
qed
(*>*)
text{*

Left to right follows from an induction on the reflexive, transitive
closure, and right to left by induction over canonical traces.

This result immediately yields the same result at the level of
representations:

*}

lemma k_memb_rep:
  assumes N: "k_isNode rec"
  shows "k_memb rec k_dfs"
(*<*)
proof -
  from N obtain rec'
    where r: "rec' \<in> DFS.reachable k_succs (set (k_frontier a))"
      and rec': "simAbs rec = simAbs rec'"
    unfolding k_isNode_def by (auto iff: k_reachable[symmetric])

  from N k_isNode_cong[OF rec', symmetric]
  have N': "k_isNode rec'"
    unfolding k_isNode_def by auto

  show "k_memb rec k_dfs"
    using KBPAlg.reachable_imp_dfs[OF N' k_frontier_is_node r]
    apply clarsimp
    apply (subst k_memb_def)
    apply (subst (asm) k_memb_def)
    using k_invariantAOD[OF N' N rec' k_dfs_invariant, symmetric]
    apply (cut_tac ec=y' and ec'=rec' in k_invariantAOD[OF _ _ _ k_dfs_invariant, symmetric])
     apply simp_all

     apply (cut_tac ec=rec' and ec'=y' in k_isNode_cong)
     apply simp
     using N'
     apply simp
     apply (rule N')
     done
qed
(*>*)

end (* context AlgorithmForAgent *)

text{*

This concludes our agent-specific reasoning; we now show that the
algorithm works for all agents. The following command generalises all
our lemmas in the @{term "AlgorithmForAgent"} to the @{term
"Algorithm"} locale, giving them the mandatory prefix @{text "KBP"}:

*}

sublocale Algorithm
        < KBP!: AlgorithmForAgent
            jkbp envInit envAction envTrans envVal jview envObs
            jviewInit jviewIncr simf simRels simVal simAbs simObs
            simInit simTrans simAction aOps tOps a for a
(*<*)
  by unfold_locales
(*>*)

context Algorithm
begin

abbreviation
  "k_mkAlgAuto \<equiv>
    mkAlgAuto aOps tOps simObs simInit simTrans simAction k_frontier"
(*<*)

lemma k_mkAlgAuto_mkAutoSim_equiv:
  assumes tC: "t \<in> jkbpC"
  shows "simAbs (runJP k_mkAlgAuto t a) = simAbs (runJP mkAutoSim t a)"
using tC
proof(induct t)
  case (tInit s) thus ?case by simp
next
  case (tStep t s)
  hence tC: "t \<in> jkbpC" by blast

  from tStep
  have N: "KBP.k_isNode a (runJP k_mkAlgAuto t a)"
    unfolding KBP.k_isNode_def
    by (simp only: mkAutoSim_ec) auto

  from tStep
  have ect: "simAbs (runJP k_mkAlgAuto t a) = sim_equiv_class a t"
    by (simp only: mkAutoSim_ec) auto

  from tStep
  have "sim_equiv_class a (t \<leadsto> s) \<in> simAbs ` set (simTrans a (runJP k_mkAlgAuto t a))"
    using simTrans[rule_format, where a=a and t=t] tC ect by auto
  then obtain ec
    where ec: "ec \<in> set (simTrans a (runJP k_mkAlgAuto t a))"
      and sec: "simAbs ec = sim_equiv_class a (t \<leadsto> s)"
    by auto

  from tStep
  have F: "envObs a s \<in> simObs a ` set (simTrans a (runJP k_mkAlgAuto t a))"
    using simObs[rule_format, where a=a and t="t\<leadsto>s", symmetric] sec ec by auto
  from KBP.k_memb_rep[OF N]
  have E: "KBP.k_memb (runJP k_mkAlgAuto t a) (KBP.k_dfs a)" by blast

  have G: "simAbs (runJP k_mkAlgAuto (t \<leadsto> s) a) = sim_equiv_class a (t \<leadsto> s)"
    using KBP.k_invariantTD[OF N E F KBP.k_dfs_invariant]
    apply (clarsimp simp: jviewIncr)
    using simTrans[rule_format, where a=a and t=t and ec="runJP k_mkAlgAuto t a"] tC ect
    apply (subgoal_tac "simAbs x \<in> simAbs ` set (simTrans a (runJP k_mkAlgAuto t a))")
     apply (clarsimp simp: jviewIncr)
     apply (cut_tac a=a and ec=ec' and t="t'\<leadsto>sa" in simObs[rule_format])
      apply (simp add: jviewIncr)
     apply simp
    apply blast
    done

  from tStep show ?case by (simp only: G mkAutoSim_ec)
qed

(*>*)
text{*

Running the automata produced by the DFS on a canonical trace @{term
"t"} yields some representation of the expected equivalence class:

*}

lemma k_mkAlgAuto_ec:
  assumes tC: "t \<in> jkbpC"
  shows "simAbs (runJP k_mkAlgAuto t a) = sim_equiv_class a t"
(*<*)
  using k_mkAlgAuto_mkAutoSim_equiv[OF tC] mkAutoSim_ec[OF tC]
  by simp

(*>*)
text{*

This involves an induction over the canonical trace @{term "t"}.

That the DFS and @{term "mkAutoSim"} yield the same actions on
canonical traces follows immediately from this result and the
invariant:

*}

lemma k_mkAlgAuto_mkAutoSim_act_eq:
  assumes tC: "t \<in> jkbpC"
  shows "set \<circ> actJP k_mkAlgAuto t = set \<circ> actJP mkAutoSim t"
(*<*)
proof
  fix a
  let ?ec = "sim_equiv_class a t"
  let ?rec = "runJP k_mkAlgAuto t a"

  from tC have E: "?ec \<in> sim_equiv_class a ` jkbpC"
    by auto

  from tC E have N: "KBP.k_isNode a (runJP k_mkAlgAuto t a)"
    unfolding KBP.k_isNode_def by (simp add: k_mkAlgAuto_ec[OF tC])

  from KBP.k_memb_rep[OF N]
  have E: "KBP.k_memb ?rec (KBP.k_dfs a)" by blast

  obtain acts
    where "lookup aOps (aActs (KBP.k_dfs a)) ?rec = Some acts"
      and "set acts = set (simAction a ?rec)"
    using KBP.k_invariantAD[OF N E KBP.k_dfs_invariant] by blast

  thus "(set \<circ> actJP k_mkAlgAuto t) a = (set \<circ> actJP mkAutoSim t) a"
    by (auto intro!: jAction_simAbs_cong[OF tC]
               simp: k_mkAlgAuto_ec[OF tC] mkAutoSim_ec[OF tC])
qed
(*>*)

text{*

Therefore these two constructions are behaviourally equivalent, and so
the DFS generates an implementation of @{term "jkbp"} in the given
environment:

*}

theorem k_mkAlgAuto_implements: "implements k_mkAlgAuto"
(*<*)
proof -
  have "behaviourally_equiv mkAutoSim k_mkAlgAuto"
    by rule (simp only: k_mkAlgAuto_mkAutoSim_act_eq)
  with mkAutoSim_implements show ?thesis
    by (simp add: behaviourally_equiv_implements)
qed
(*>*)

end (* context Algorithm *)

text{*

Clearly the automata generated by this algorithm are large. We discuss
this issue in \S\ref{sec:kbps-alg-auto-min}.

\FloatBarrier

*}

(*<*)
end
(*>*)


theory Rev
  imports "../Refine_Imperative_HOL/Sepref"
 "../RefineMonadicVCG"
begin

context
  fixes t ::  "'c list \<Rightarrow> nat"
begin

  definition "mop_append x xs = SPECT [ (x#xs) \<mapsto> t xs]"

  lemma progress_mop_append[progress_rules]: "t xs > 0 \<Longrightarrow> progress (mop_append x xs)"
      unfolding mop_append_def by (progress\<open>simp add:   zero_enat_def\<close>)

  lemma mop_append: "tt \<le> lst (SPECT [ (x#xs) \<mapsto> t xs]) Q \<Longrightarrow> tt
           \<le> lst (mop_append x xs) Q" unfolding mop_append_def by simp

  sepref_register "mop_append"
end

definition myfun :: "nat list \<Rightarrow> nat list \<Rightarrow> nat list nrest" where
      "myfun as bs = RECT (\<lambda>fw (as,bs). (case as of [] \<Rightarrow> RETURNT bs
                  | a#as \<Rightarrow> fw (as,a#bs) )) (as,bs)"

lemma myfun_simps:
  "myfun [] bs           = RETURNT bs"
  "myfun (a#as) bs        = myfun as (a#bs)"
  unfolding myfun_def by (subst RECT_unfold, refine_mono, auto)+

definition myfun2 :: "nat \<Rightarrow> nat list \<Rightarrow> nat list nrest" where
      "myfun2 n bs = RECT (\<lambda>fw (n,bs). (if n = 0 then RETURNT bs
                  else do {
                      bs'\<leftarrow> mop_append (%_. 1) 0 bs;
                      fw (n-1,bs') } )) (n,bs)"

lemma myfun2_simps:
  "myfun2 0  bs       = RETURNT bs"
  "myfun2 (Suc n) bs       = do {
                      bs' \<leftarrow> mop_append (%_. 1) 0 bs;
                      myfun2  n bs' }"
  unfolding myfun2_def  by (subst RECT_unfold, refine_mono, auto)+

definition "oappend x' xs' = return (x'#xs')"

lemma mop_lookup_list_as_array_rule[sepref_fr_rules]:
  "\<And>R. 1 \<le> t xs \<Longrightarrow>
    hn_refine (hn_ctxt (list_assn R) xs xs' * hn_ctxt R x x')
     (oappend x' xs')
     (hn_invalid (list_assn R) xs xs' * hn_invalid R x x') (list_assn R) ( PR_CONST (mop_append t) $  x $ xs)"
  unfolding autoref_tag_defs mop_append_def oappend_def
  unfolding hn_refine_def
  apply (auto simp: execute_return pure_def hn_ctxt_def invalid_assn_def relH_def top_assn_rule)
  apply(rule exI[where x=1] ) apply auto
  subgoal
    by (metis mod_star_trueI pf)
  subgoal using mod_starD by auto
  subgoal using mod_starD by blast
  done

lemma hn_refine_hd[sepref_fr_rules]: " hn_refine (hn_val Id s' s)
           (ureturn (hd s))
       (hn_val Id s' s)
       (pure Id) (RETURNT $ (hd $ s'))"
  unfolding hn_refine_def apply (auto simp:   mult.assoc  execute_ureturn pure_def hn_ctxt_def)
     by (auto simp: top_assn_rule zero_enat_def relH_def  elim: pureD )

context
  fixes n::"nat"
  notes [[sepref_register_adhoc n]]
  notes [sepref_import_param] = IdI[of n]
begin

lemma ff: "hn_ctxt (list_assn nat_assn) a c \<Longrightarrow>\<^sub>t hn_val Id a c"
  unfolding hn_ctxt_def
  by (simp add: list_assn_pure_conv)

sepref_definition synth_myfun is "uncurry0 (myfun2 n [])" :: "unit_assn\<^sup>k \<rightarrow>\<^sub>a pure Id"
  using [[goals_limit = 3]]
  unfolding myfun2_def

  apply sepref_dbg_preproc
  apply sepref_dbg_cons_init
  apply sepref_dbg_id
     apply sepref_dbg_monadify

     apply sepref_dbg_opt_init

  thm sepref_fr_rules
  thm sepref_comb_rules

  apply sepref_dbg_trans_step+

  apply sepref_dbg_opt
  apply sepref_dbg_cons_solve \<comment> \<open>Frame rule, recovering the invalidated list
    or pure elements, propagating recovery over the list structure\<close>
   (* apply sepref_dbg_cons_solve \<comment> \<open>Trivial frame rule\<close> *) apply(rule ff)
  apply sepref_dbg_constraints
  done

context
  fixes as::"nat list"
  notes [[sepref_register_adhoc as]]
  notes [sepref_import_param] = IdI[of as]
begin

sepref_definition synth_myfun is "uncurry0 (myfun as [])" :: "unit_assn\<^sup>k \<rightarrow>\<^sub>a pure Id"
  using [[goals_limit = 3]]
  unfolding myfun_def

  apply sepref_dbg_preproc
  apply sepref_dbg_cons_init
  apply sepref_dbg_id
     apply sepref_dbg_monadify

     apply sepref_dbg_opt_init

  thm sepref_fr_rules
  thm sepref_comb_rules

  apply sepref_dbg_trans_step+

  apply sepref_dbg_opt
  apply sepref_dbg_cons_solve \<comment> \<open>Frame rule, recovering the invalidated list
    or pure elements, propagating recovery over the list structure\<close>
  apply sepref_dbg_cons_solve \<comment> \<open>Trivial frame rule\<close>
  apply sepref_dbg_constraints
  done

end


header {* The main lemma about NUM and the Second Fixed Point Theorem *}

theory Theorem imports Consts begin

lemmas [simp] = b3[OF bI] b1 b4 b5 supp_NUM[unfolded NUM_def supp_ltgt] NUM_def lam.fresh[unfolded fresh_def] fresh_def b6
lemmas app = Ltgt1_app

lemma NUM:
  shows "NUM \<cdot> \<lbrace>M\<rbrace> \<approx> \<lbrace>\<lbrace>M\<rbrace>\<rbrace>"
proof (induct M rule: lam.induct)
  case (Var n)
  have "NUM \<cdot> \<lbrace>Var n\<rbrace> = NUM \<cdot> (VAR \<cdot> Var n)" by simp
  also have "... = \<guillemotleft>[\<guillemotleft>[A1,A2,A3]\<guillemotright>]\<guillemotright> \<cdot> (VAR \<cdot> Var n)" by simp
  also have "... \<approx> VAR \<cdot> Var n \<cdot> \<guillemotleft>[A1,A2,A3]\<guillemotright>" using app .
  also have "... \<approx> \<guillemotleft>[A1,A2,A3]\<guillemotright> \<cdot> Umn 2 2 \<cdot> Var n \<cdot> \<guillemotleft>[A1,A2,A3]\<guillemotright>" using VAR_app .
  also have "... \<approx> A1 \<cdot> Var n \<cdot> \<guillemotleft>[A1,A2,A3]\<guillemotright>" using U_app by simp
  also have "... \<approx> F1 \<cdot> Var n" using A_app(1) .
  also have "... \<approx> APP \<cdot> \<lbrace>VAR\<rbrace> \<cdot> (VAR \<cdot> Var n)" using F_app(1) .
  also have "... = \<lbrace>\<lbrace>Var n\<rbrace>\<rbrace>" by simp
  finally show "NUM \<cdot> \<lbrace>Var n\<rbrace> \<approx> \<lbrace>\<lbrace>Var n\<rbrace>\<rbrace>".
next
  case (App M N)
  assume IH: "NUM \<cdot> \<lbrace>M\<rbrace> \<approx> \<lbrace>\<lbrace>M\<rbrace>\<rbrace>" "NUM \<cdot> \<lbrace>N\<rbrace> \<approx> \<lbrace>\<lbrace>N\<rbrace>\<rbrace>"
  have "NUM \<cdot> \<lbrace>M \<cdot> N\<rbrace> = NUM \<cdot> (APP \<cdot> \<lbrace>M\<rbrace> \<cdot> \<lbrace>N\<rbrace>)" by simp
  also have "... = \<guillemotleft>[\<guillemotleft>[A1,A2,A3]\<guillemotright>]\<guillemotright> \<cdot> (APP \<cdot> \<lbrace>M\<rbrace> \<cdot> \<lbrace>N\<rbrace>)" by simp
  also have "... \<approx> APP \<cdot> \<lbrace>M\<rbrace> \<cdot> \<lbrace>N\<rbrace> \<cdot> \<guillemotleft>[A1,A2,A3]\<guillemotright>" using app .
  also have "... \<approx> \<guillemotleft>[A1,A2,A3]\<guillemotright> \<cdot> Umn 2 1 \<cdot> \<lbrace>M\<rbrace> \<cdot> \<lbrace>N\<rbrace> \<cdot> \<guillemotleft>[A1,A2,A3]\<guillemotright>" using APP_app .
  also have "... \<approx> A2 \<cdot> \<lbrace>M\<rbrace> \<cdot> \<lbrace>N\<rbrace> \<cdot> \<guillemotleft>[A1,A2,A3]\<guillemotright>" using U_app by simp
  also have "... \<approx> F2 \<cdot> \<lbrace>M\<rbrace> \<cdot> \<lbrace>N\<rbrace> \<cdot> NUM" using A_app(2) by simp
  also have "... \<approx> APP \<cdot> (APP \<cdot> \<lbrace>APP\<rbrace> \<cdot> (NUM \<cdot> \<lbrace>M\<rbrace>)) \<cdot> (NUM \<cdot> \<lbrace>N\<rbrace>)" using F_app(2) .
  also have "... \<approx> APP \<cdot> (APP \<cdot> \<lbrace>APP\<rbrace> \<cdot> (\<lbrace>\<lbrace>M\<rbrace>\<rbrace>)) \<cdot> (NUM \<cdot> \<lbrace>N\<rbrace>)" using IH by simp
  also have "... \<approx> \<lbrace>\<lbrace>M \<cdot> N\<rbrace>\<rbrace>" using IH by simp
  finally show "NUM \<cdot> \<lbrace>M \<cdot> N\<rbrace> \<approx> \<lbrace>\<lbrace>M \<cdot> N\<rbrace>\<rbrace>".
next
  case (Lam x P)
  assume IH: "NUM \<cdot> \<lbrace>P\<rbrace> \<approx> \<lbrace>\<lbrace>P\<rbrace>\<rbrace>"
  have "NUM \<cdot> \<lbrace>\<integral> x. P\<rbrace> = NUM \<cdot> (Abs \<cdot> \<integral> x. \<lbrace>P\<rbrace>)" by simp
  also have "... = \<guillemotleft>[\<guillemotleft>[A1,A2,A3]\<guillemotright>]\<guillemotright> \<cdot> (Abs \<cdot> \<integral> x. \<lbrace>P\<rbrace>)" by simp
  also have "... \<approx> Abs \<cdot> (\<integral> x. \<lbrace>P\<rbrace>) \<cdot> \<guillemotleft>[A1,A2,A3]\<guillemotright>" using app .
  also have "... \<approx> \<guillemotleft>[A1,A2,A3]\<guillemotright> \<cdot> Umn 2 0 \<cdot> (\<integral> x. \<lbrace>P\<rbrace>) \<cdot> \<guillemotleft>[A1,A2,A3]\<guillemotright>" using Abs_app .
  also have "... \<approx> A3 \<cdot> (\<integral> x. \<lbrace>P\<rbrace>) \<cdot> \<guillemotleft>[A1,A2,A3]\<guillemotright>" using U_app by simp
  also have "... \<approx> F3 \<cdot> (\<integral> x. \<lbrace>P\<rbrace>) \<cdot> \<guillemotleft>[\<guillemotleft>[A1,A2,A3]\<guillemotright>]\<guillemotright>" using A_app(3) .
  also have "... = F3 \<cdot> (\<integral> x. \<lbrace>P\<rbrace>) \<cdot> NUM" by simp
  also have "... \<approx> APP \<cdot> \<lbrace>Abs\<rbrace> \<cdot> (Abs \<cdot> \<integral> x. (NUM \<cdot> ((\<integral> x. \<lbrace>P\<rbrace>) \<cdot> Var x)))" by (rule F3_app) simp_all
  also have "... \<approx> APP \<cdot> \<lbrace>Abs\<rbrace> \<cdot> (Abs \<cdot> \<integral> x. (NUM \<cdot> \<lbrace>P\<rbrace>))" using beta_app by simp
  also have "... \<approx> APP \<cdot> \<lbrace>Abs\<rbrace> \<cdot> (Abs \<cdot> \<integral> x. \<lbrace>\<lbrace>P\<rbrace>\<rbrace>)" using IH by simp
  also have "... = \<lbrace>\<lbrace>\<integral> x. P\<rbrace>\<rbrace>" by simp
  finally show "NUM \<cdot> \<lbrace>\<integral> x. P\<rbrace> \<approx> \<lbrace>\<lbrace>\<integral> x. P\<rbrace>\<rbrace>" .
qed

lemmas [simp] = Ap NUM
lemmas [simp del] = fresh_def NUM_def

theorem SFP:
  fixes F :: lam
  shows "\<exists>X. X \<approx> F \<cdot> \<lbrace>X\<rbrace>"
proof -
  obtain x :: name where [simp]:"atom x \<sharp> F" using obtain_fresh by blast
  def W \<equiv> "\<integral>x. (F \<cdot> (APP \<cdot> Var x \<cdot> (NUM \<cdot> Var x)))"
  def X \<equiv> "W \<cdot> \<lbrace>W\<rbrace>"
  have a: "X = W \<cdot> \<lbrace>W\<rbrace>" unfolding X_def ..
  also have "... = (\<integral>x. (F \<cdot> (APP \<cdot> Var x \<cdot> (NUM \<cdot> Var x)))) \<cdot> \<lbrace>W\<rbrace>" unfolding W_def ..
  also have "... \<approx> F \<cdot> (APP \<cdot> \<lbrace>W\<rbrace> \<cdot> (NUM \<cdot> \<lbrace>W\<rbrace>))" by simp
  also have "... \<approx> F \<cdot> (APP \<cdot> \<lbrace>W\<rbrace> \<cdot> \<lbrace>\<lbrace>W\<rbrace>\<rbrace>)" by simp
  also have "... \<approx> F \<cdot> \<lbrace>W \<cdot> \<lbrace>W\<rbrace>\<rbrace>" by simp
  also have "... = F \<cdot> \<lbrace>X\<rbrace>" unfolding X_def ..
  finally show ?thesis by blast
qed

end


(*  Title:      HOL/ex/Argo_Examples.thy
    Author:     Sascha Boehme
*)

section \<open>Argo\<close>

theory Argo_Examples
imports Complex_Main
begin

text \<open>
  This theory is intended to showcase and test different features of the \<open>argo\<close> proof method.

  The \<open>argo\<close> proof method can be applied to propositional problems, problems involving equality
  reasoning and problems of linear real arithmetic.

  The \<open>argo\<close> proof method provides two options. To specify an upper limit of the proof methods
  run time in seconds, use the option \<open>argo_timeout\<close>. To specify the amount of output, use the
  option \<open>argo_trace\<close> with value \<open>none\<close> for no tracing output, value \<open>basic\<close> for viewing the
  underlying propositions and some timings, and value \<open>full\<close> for additionally inspecting the
  proof replay steps.
\<close>

declare[[argo_trace = full]]

subsection \<open>Propositional logic\<close>

notepad
begin
  have "True" by argo
next
  have "~False" by argo
next
  fix P :: bool
  assume "False"
  then have "P" by argo
next
  fix P :: bool
  assume "~True"
  then have "P" by argo
next
  fix P :: bool
  assume "P"
  then have "P" by argo
next
  fix P :: bool
  assume "~~P"
  then have "P" by argo
next
  fix P Q R :: bool
  assume "P & Q & R"
  then have "R & P & Q" by argo
next
  fix P Q R :: bool
  assume "P & (Q & True & R) & (Q & P) & True"
  then have "R & P & Q" by argo
next
  fix P Q1 Q2 Q3 Q4 Q5 :: bool
  assume "Q1 & (Q2 & P & Q3) & (Q4 & ~P & Q5)"
  then have "~True" by argo
next
  fix P Q1 Q2 Q3  :: bool
  assume "(Q1 & False) & Q2 & Q3"
  then have "P::bool" by argo
next
  fix P Q R :: bool
  assume "P | Q | R"
  then have "R | P | Q" by argo
next
  fix P Q R :: bool
  assume "P | (Q | False | R) | (Q | P) | False"
  then have "R | P | Q" by argo
next
  fix P Q1 Q2 Q3 Q4 :: bool
  have "(Q1 & P & Q2) --> False | (Q3 | (Q4 | P) | False)" by argo
next
  fix Q1 Q2 Q3 Q4 :: bool
  have "Q1 | (Q2 | True | Q3) | Q4" by argo
next
  fix P Q R :: bool
  assume "(P & Q) | (P & ~Q) | (P & R) | (P & ~R)"
  then have "P" by argo
next
  fix P :: bool
  assume "P = True"
  then have "P" by argo
next
  fix P :: bool
  assume "False = P"
  then have "~P" by argo
next
  fix P Q :: bool
  assume "P = (~P)"
  then have "Q" by argo
next
  fix P :: bool
  have "(~P) = (~P)" by argo
next
  fix P Q :: bool
  assume "P" and "~Q"
  then have "P = (~Q)" by argo
next
  fix P Q :: bool
  assume "((P::bool) = Q) | (Q = P)"
  then have "(P --> Q) & (Q --> P)" by argo
next
  fix P Q :: bool
  assume "(P::bool) = Q"
  then have "Q = P" by argo
next
  fix P Q R :: bool
  assume "if P then Q else R"
  then have "Q | R" by argo
next
  fix P Q :: bool
  assume "P | Q"
     and "P | ~Q"
     and "~P | Q"
     and "~P | ~Q"
  then have "False" by argo
next
  fix P Q R :: bool
  assume "P | Q | R"
     and "P | Q | ~R"
     and "P | ~Q | R"
     and "P | ~Q | ~R"
     and "~P | Q | R"
     and "~P | Q | ~R"
     and "~P | ~Q | R"
     and "~P | ~Q | ~R"
  then have "False" by argo
next
  fix a b c d e f g h i j k l m n p q :: bool
  assume "(a & b | c & d) & (e & f | g & h) | (i & j | k & l) & (m & n | p & q)"
  then have "(a & b | c & d) & (e & f | g & h) | (i & j | k & l) & (m & n | p & q)" by argo
next
  fix P :: bool
  have "P=P=P=P=P=P=P=P=P=P" by argo
next
  fix a b c d e f p q x :: bool
  assume "a | b | c | d"
     and "e | f | (a & d)"
     and "~(a | (c & ~c)) | b"
     and "~(b & (x | ~x)) | c"
     and "~(d | False) | c"
     and "~(c | (~p & (p | (q & ~q))))"
  then have "False" by argo
next
  have "(True & True & True) = True" by argo
next
  have "(False | False | False) = False" by argo
end

subsection \<open>Equality, congruence and predicates\<close>

notepad
begin
  fix t :: "'a"
  have "t = t" by argo
next
  fix t u :: "'a"
  assume "t = u"
  then have "u = t" by argo
next
  fix s t u :: "'a"
  assume "s = t" and "t = u"
  then have "s = u" by argo
next
  fix s t u v :: "'a"
  assume "s = t" and "t = u" and "u = v" and "u = s"
  then have "s = v" by argo
next
  fix s t u v w :: "'a"
  assume "s = t" and "t = u" and "s = v" and "v = w"
  then have "w = u" by argo
next
  fix s t u a b c :: "'a"
  assume "s = t" and "t = u" and "a = b" and "b = c"
  then have "s = a --> c = u" by argo
next
  fix a b c d :: "'a"
  assume "(a = b & b = c) | (a = d & d = c)"
  then have "a = c" by argo
next
  fix a b1 b2 b3 b4 c d :: "'a"
  assume "(a = b1 & ((b1 = b2 & b2 = b3) | (b1 = b4 & b4 = b3)) & b3 = c) | (a = d & d = c)"
  then have "a = c" by argo
next
  fix a b :: "'a"
  have "(if True then a else b) = a" by argo
next
  fix a b :: "'a"
  have "(if False then a else b) = b" by argo
next
  fix a b :: "'a"
  have "(if \<not>True then a else b) = b" by argo
next
  fix a b :: "'a"
  have "(if \<not>False then a else b) = a" by argo
next
  fix P :: "bool"
  fix a :: "'a"
  have "(if P then a else a) = a" by argo
next
  fix P :: "bool"
  fix a b c :: "'a"
  assume "P" and "a = c"
  then have "(if P then a else b) = c" by argo
next
  fix P :: "bool"
  fix a b c :: "'a"
  assume "~P" and "b = c"
  then have "(if P then a else b) = c" by argo
next
  fix P Q :: "bool"
  fix a b c d :: "'a"
  assume "P" and "Q" and "a = d"
  then have "(if P then (if Q then a else b) else c) = d" by argo
next
  fix a b c :: "'a"
  assume "a \<noteq> b" and "b = c"
  then have "a \<noteq> c" by argo
next
  fix a b c :: "'a"
  assume "a \<noteq> b" and "a = c"
  then have "c \<noteq> b" by argo
next
  fix a b c d :: "'a"
  assume "a = b" and "c = d" and "b \<noteq> d"
  then have "a \<noteq> c" by argo
next
  fix a b c d :: "'a"
  assume "a = b" and "c = d" and "d \<noteq> b"
  then have "a \<noteq> c" by argo
next
  fix a b c d :: "'a"
  assume "a = b" and "c = d" and "b \<noteq> d"
  then have "c \<noteq> a" by argo
next
  fix a b c d :: "'a"
  assume "a = b" and "c = d" and "d \<noteq> b"
  then have "c \<noteq> a" by argo
next
  fix a b c d e f :: "'a"
  assume "a \<noteq> b" and "b = c" and "b = d" and "d = e" and "a = f"
  then have "f \<noteq> e" by argo
next
  fix a b :: "'a" and f :: "'a \<Rightarrow> 'a"
  assume "a = b"
  then have "f a = f b" by argo
next
  fix a b c :: "'a" and f :: "'a \<Rightarrow> 'a"
  assume "f a = f b" and "b = c"
  then have "f a = f c" by argo
next
  fix a :: "'a" and f :: "'a \<Rightarrow> 'a"
  assume "f a = a"
  then have "f (f a) = a" by argo
next
  fix a b :: "'a" and f g :: "'a \<Rightarrow> 'a"
  assume "a = b"
  then have "g (f a) = g (f b)" by argo
next
  fix a b :: "'a" and f g :: "'a \<Rightarrow> 'a"
  assume "f a = b" and "g b = a"
  then have "f (g (f a)) = b" by argo
next
  fix a b :: "'a" and g :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"
  assume "a = b"
  then have "g a b = g b a" by argo
next
  fix a b :: "'a" and f :: "'a \<Rightarrow> 'a" and g :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"
  assume "f a = b"
  then have "g (f a) b = g b (f a)" by argo
next
  fix a b c d e g h :: "'a" and f :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"
  assume "c = d" and "e = c" and "e = b" and "b = h" and "f g h = d" and "f g d = a"
  then have "a = b" by argo
next
  fix a b :: "'a" and P :: "'a \<Rightarrow> bool"
  assume "P a" and "a = b"
  then have "P b" by argo
next
  fix a b :: "'a" and P :: "'a \<Rightarrow> bool"
  assume "~ P a" and "a = b"
  then have "~ P b" by argo
next
  fix a b c d :: "'a" and P :: "'a \<Rightarrow> 'a \<Rightarrow> bool"
  assume "P a b" and "a = c" and "b = d"
  then have "P c d" by argo
next
  fix a b c d :: "'a" and P :: "'a \<Rightarrow> 'a \<Rightarrow> bool"
  assume "~ P a b" and "a = c" and "b = d"
  then have "~ P c d" by argo
end

subsection \<open>Linear real arithmetic\<close>

subsubsection \<open>Negation and subtraction\<close>

notepad
begin
  fix a b :: real
  have
    "-a = -1 * a"
    "-(-a) = a"
    "a - b = a + -1 * b"
    "a - (-b) = a + b"
    by argo+
end

subsubsection \<open>Multiplication\<close>

notepad
begin
  fix a b c d :: real
  have
    "(2::real) * 3 = 6"
    "0 * a = 0"
    "a * 0 = 0"
    "1 * a = a"
    "a * 1 = a"
    "2 * a = a * 2"
    "2 * a * 3 = 6 * a"
    "2 * a * 3 * 5 = 30 * a"
    "2 * (a * (3 * 5)) = 30 * a"
    "a * 0 * b = 0"
    "a * (0 * b) = 0"
    "a * b = b * a"
    "a * b * a = b * a * a"
    "a * (b * c) = (a * b) * c"
    "a * (b * (c * d)) = ((a * b) * c) * d"
    "a * (b * (c * d)) = ((d * c) * b) * a"
    "a * (b + c + d) = a * b + a * c + a * d"
    "(a + b + c) * d = a * d + b * d + c * d"
    by argo+
end

subsubsection \<open>Division\<close>

notepad
begin
  fix a b c d :: real
  have
    "(6::real) / 2 = 3"
    "a / 0 = a / 0"
    "a / 0 <= a / 0"
    "~(a / 0 < a / 0)"
    "0 / a = 0"
    "a / 1 = a"
    "a / 3 = 1/3 * a"
    "6 * a / 2 = 3 * a"
    "(6 * a) / 2 = 3 * a"
    "a / ((5 * b) / 2) = 2/5 * a / b"
    "a / (5 * (b / 2)) = 2/5 * a / b"
    "(a / 5) * (b / 2) = 1/10 * a * b"
    "a / (3 * b) = 1/3 * a / b"
    "(a + b) / 5 = 1/5 * a + 1/5 * b"
    "a / (5 * 1/5) = a"
    "a * (b / c) = (b * a) / c"
    "(a / b) * c = (c * a) / b"
    "(a / b) / (c / d) = (a * d) / (c * b)"
    "1 / (a * b) = 1 / (b * a)"
    "a / (3 * b) = 1 / 3 * a / b"
    "(a + b + c) / d = a / d + b / d + c / d"
    by argo+
end

subsubsection \<open>Addition\<close>

notepad
begin
  fix a b c d :: real
  have
    "a + b = b + a"
    "a + b + c = c + b + a"
    "a + b + c + d = d + c + b + a"
    "a + (b + (c + d)) = ((a + b) + c) + d"
    "(5::real) + -3 = 2"
    "(3::real) + 5 + -1 = 7"
    "2 + a = a + 2"
    "a + b + a = b + 2 * a"
    "-1 + a + -1 + 2 + b + 5/3 + b + 1/3 + 5 * b + 2/3 = 8/3 + a + 7 * b"
    "1 + b + b + 5 * b + 3 * a + 7 + a + 2 = 10 + 4 * a + 7 * b"
    by argo+
end

subsubsection \<open>Minimum and maximum\<close>

notepad
begin
  fix a b :: real
  have
    "min (3::real) 5 = 3"
    "min (5::real) 3 = 3"
    "min (3::real) (-5) = -5"
    "min (-5::real) 3 = -5"
    "min a a = a"
    "a \<le> b \<longrightarrow> min a b = a"
    "a > b \<longrightarrow> min a b = b"
    "min a b \<le> a"
    "min a b \<le> b"
    "min a b = min b a"
    by argo+
next
  fix a b :: real
  have
    "max (3::real) 5 = 5"
    "max (5::real) 3 = 5"
    "max (3::real) (-5) = 3"
    "max (-5::real) 3 = 3"
    "max a a = a"
    "a \<le> b \<longrightarrow> max a b = b"
    "a > b \<longrightarrow> max a b = a"
    "a \<le> max a b"
    "b \<le> max a b"
    "max a b = max b a"
    by argo+
next
  fix a b :: real
  have
    "min a b \<le> max a b"
    "min a b + max a b = a + b"
    "a < b \<longrightarrow> min a b < max a b"
    by argo+
end

subsubsection \<open>Absolute value\<close>

notepad
begin
  fix a :: real
  have
    "abs (3::real) = 3"
    "abs (-3::real) = 3"
    "0 \<le> abs a"
    "a \<le> abs a"
    "a \<ge> 0 \<longrightarrow> abs a = a"
    "a < 0 \<longrightarrow> abs a = -a"
    "abs (abs a) = abs a"
    by argo+
end

subsubsection \<open>Equality\<close>

notepad
begin
  fix a b c d :: real
  have
    "(3::real) = 3"
    "~((3::real) = 4)"
    "~((4::real) = 3)"
    "3 * a = 5 --> a = 5/3"
    "-3 * a = 5 --> -5/3 = a"
    "5 = 3 * a --> 5/3  = a "
    "5 = -3 * a --> a = -5/3"
    "2 + 3 * a = 4 --> a = 2/3"
    "4 = 2 + 3 * a --> 2/3 = a"
    "2 + 3 * a + 5 * b + c = 4 --> 3 * a + 5 * b + c = 2"
    "4 = 2 + 3 * a + 5 * b + c --> 2 = 3 * a + 5 * b + c"
    "-2 * a + b + -3 * c = 7 --> -7 = 2 * a + -1 * b + 3 * c"
    "7 = -2 * a + b + -3 * c --> 2 * a + -1 * b + 3 * c = -7"
    "-2 * a + b + -3 * c + 4 * d = 7 --> -7 = 2 * a + -1 * b + 3 * c + -4 * d"
    "7 = -2 * a + b + -3 * c + 4 * d --> 2 * a + -1 * b + 3 * c + -4 * d = -7"
    "a + 3 * b = 5 * c + b --> a + 2 * b + -5 * c = 0"
    by argo+
end

subsubsection \<open>Less-equal\<close>

notepad
begin
  fix a b c d :: real
  have
    "(3::real) <= 3"
    "(3::real) <= 4"
    "~((4::real) <= 3)"
    "3 * a <= 5 --> a <= 5/3"
    "-3 * a <= 5 --> -5/3 <= a"
    "5 <= 3 * a --> 5/3  <= a "
    "5 <= -3 * a --> a <= -5/3"
    "2 + 3 * a <= 4 --> a <= 2/3"
    "4 <= 2 + 3 * a --> 2/3 <= a"
    "2 + 3 * a + 5 * b + c <= 4 --> 3 * a + 5 * b + c <= 2"
    "4 <= 2 + 3 * a + 5 * b + c --> 2 <= 3 * a + 5 * b + c"
    "-2 * a + b + -3 * c <= 7 --> -7 <= 2 * a + -1 * b + 3 * c"
    "7 <= -2 * a + b + -3 * c --> 2 * a + -1 * b + 3 * c <= -7"
    "-2 * a + b + -3 * c + 4 * d <= 7 --> -7 <= 2 * a + -1 * b + 3 * c + -4 * d"
    "7 <= -2 * a + b + -3 * c + 4 * d --> 2 * a + -1 * b + 3 * c + -4 * d <= -7"
    "a + 3 * b <= 5 * c + b --> a + 2 * b + -5 * c <= 0"
    by argo+
end

subsubsection \<open>Less\<close>

notepad
begin
  fix a b c d :: real
  have
    "(3::real) < 4"
    "~((3::real) < 3)"
    "~((4::real) < 3)"
    "3 * a < 5 --> a < 5/3"
    "-3 * a < 5 --> -5/3 < a"
    "5 < 3 * a --> 5/3  < a "
    "5 < -3 * a --> a < -5/3"
    "2 + 3 * a < 4 --> a < 2/3"
    "4 < 2 + 3 * a --> 2/3 < a"
    "2 + 3 * a + 5 * b + c < 4 --> 3 * a + 5 * b + c < 2"
    "4 < 2 + 3 * a + 5 * b + c --> 2 < 3 * a + 5 * b + c"
    "-2 * a + b + -3 * c < 7 --> -7 < 2 * a + -1 * b + 3 * c"
    "7 < -2 * a + b + -3 * c --> 2 * a + -1 * b + 3 * c < -7"
    "-2 * a + b + -3 * c + 4 * d < 7 --> -7 < 2 * a + -1 * b + 3 * c + -4 * d"
    "7 < -2 * a + b + -3 * c + 4 * d --> 2 * a + -1 * b + 3 * c + -4 * d < -7"
    "a + 3 * b < 5 * c + b --> a + 2 * b + -5 * c < 0"
    by argo+
end

subsubsection \<open>Other examples\<close>

notepad
begin
  fix a b :: real
  fix f :: "real \<Rightarrow> 'a"
  have "f (a + b) = f (b + a)" by argo
next
  have
    "(0::real) < 1"
    "(47::real) + 11 < 8 * 15"
    by argo+
next
  fix a :: real
  assume "a < 3"
  then have "a < 5" "a <= 5" "~(5 < a)" "~(5 <= a)" by argo+
next
  fix a :: real
  assume "a <= 3"
  then have "a < 5" "a <= 5" "~(5 < a)" "~(5 <= a)" by argo+
next
  fix a :: real
  assume "~(3 < a)"
  then have "a < 5" "a <= 5" "~(5 < a)" "~(5 <= a)" by argo+
next
  fix a :: real
  assume "~(3 <= a)"
  then have "a < 5" "a <= 5" "~(5 < a)" "~(5 <= a)" by argo+
next
  fix a :: real
  have "a < 3 | a = 3 | a > 3" by argo
next
  fix a b :: real
  assume "0 < a" and "a < b"
  then have "0 < b" by argo
next
  fix a b :: real
  assume "0 < a" and "a \<le> b"
  then have "0 \<le> b" by argo
next
  fix a b :: real
  assume "0 \<le> a" and "a < b"
  then have "0 \<le> b" by argo
next
  fix a b :: real
  assume "0 \<le> a" and "a \<le> b"
  then have "0 \<le> b" by argo
next
  fix a b c :: real
  assume "2 \<le> a" and "3 \<le> b" and "c \<le> 5"
  then have "-2 * a + -3 * b + 5 * c < 13" by argo
next
  fix a b c :: real
  assume "2 \<le> a" and "3 \<le> b" and "c \<le> 5"
  then have "-2 * a + -3 * b + 5 * c \<le> 12" by argo
next
  fix a b :: real
  assume "a = 2" and "b = 3"
  then have "a + b > 5 \<or> a < b" by argo
next
  fix a b c :: real
  assume "5 < b + c" and "a + c < 0" and "a > 0"
  then have "b > 0" by argo
next
  fix a b c :: real
  assume "a + b < 7" and "5 < b + c" and "a + c < 0" and "a > 0"
  then have "0 < b \<and> b < 7" by argo
next
  fix a b c :: real
  assume "a < b" and "b < c" and "c < a"
  then have "False" by argo
next
  fix a b :: real
  assume "a - 5 > b"
  then have "b < a" by argo
next
  fix a b :: real
  have "(a - b) - a = (a - a) - b" by argo
next
  fix n m n' m' :: real
  have "
    (n < m & m < n') | (n < m & m = n') | (n < n' & n' < m) |
    (n = n' & n' < m) | (n = m & m < n') |
    (n' < m & m < n) | (n' < m & m = n) |
    (n' < n & n < m) | (n' = n & n < m) | (n' = m & m < n) |
    (m < n & n < n') | (m < n & n' = n) | (m < n' & n' < n) |
    (m = n & n < n') | (m = n' & n' < n) |
    (n' = m & m = n)"
    by argo
end

subsection \<open>Larger examples\<close>

declare[[argo_trace = basic, argo_timeout = 120]]

text \<open>Translated from TPTP problem library: PUZ015-2.006.dimacs\<close>

lemma assumes 1: "~x0"
  and 2: "~x30"
  and 3: "~x29"
  and 4: "~x59"
  and 5: "x1 | x31 | x0"
  and 6: "x2 | x32 | x1"
  and 7: "x3 | x33 | x2"
  and 8: "x4 | x34 | x3"
  and 9: "x35 | x4"
  and 10: "x5 | x36 | x30"
  and 11: "x6 | x37 | x5 | x31"
  and 12: "x7 | x38 | x6 | x32"
  and 13: "x8 | x39 | x7 | x33"
  and 14: "x9 | x40 | x8 | x34"
  and 15: "x41 | x9 | x35"
  and 16: "x10 | x42 | x36"
  and 17: "x11 | x43 | x10 | x37"
  and 18: "x12 | x44 | x11 | x38"
  and 19: "x13 | x45 | x12 | x39"
  and 20: "x14 | x46 | x13 | x40"
  and 21: "x47 | x14 | x41"
  and 22: "x15 | x48 | x42"
  and 23: "x16 | x49 | x15 | x43"
  and 24: "x17 | x50 | x16 | x44"
  and 25: "x18 | x51 | x17 | x45"
  and 26: "x19 | x52 | x18 | x46"
  and 27: "x53 | x19 | x47"
  and 28: "x20 | x54 | x48"
  and 29: "x21 | x55 | x20 | x49"
  and 30: "x22 | x56 | x21 | x50"
  and 31: "x23 | x57 | x22 | x51"
  and 32: "x24 | x58 | x23 | x52"
  and 33: "x59 | x24 | x53"
  and 34: "x25 | x54"
  and 35: "x26 | x25 | x55"
  and 36: "x27 | x26 | x56"
  and 37: "x28 | x27 | x57"
  and 38: "x29 | x28 | x58"
  and 39: "~x1 | ~x31"
  and 40: "~x1 | ~x0"
  and 41: "~x31 | ~x0"
  and 42: "~x2 | ~x32"
  and 43: "~x2 | ~x1"
  and 44: "~x32 | ~x1"
  and 45: "~x3 | ~x33"
  and 46: "~x3 | ~x2"
  and 47: "~x33 | ~x2"
  and 48: "~x4 | ~x34"
  and 49: "~x4 | ~x3"
  and 50: "~x34 | ~x3"
  and 51: "~x35 | ~x4"
  and 52: "~x5 | ~x36"
  and 53: "~x5 | ~x30"
  and 54: "~x36 | ~x30"
  and 55: "~x6 | ~x37"
  and 56: "~x6 | ~x5"
  and 57: "~x6 | ~x31"
  and 58: "~x37 | ~x5"
  and 59: "~x37 | ~x31"
  and 60: "~x5 | ~x31"
  and 61: "~x7 | ~x38"
  and 62: "~x7 | ~x6"
  and 63: "~x7 | ~x32"
  and 64: "~x38 | ~x6"
  and 65: "~x38 | ~x32"
  and 66: "~x6 | ~x32"
  and 67: "~x8 | ~x39"
  and 68: "~x8 | ~x7"
  and 69: "~x8 | ~x33"
  and 70: "~x39 | ~x7"
  and 71: "~x39 | ~x33"
  and 72: "~x7 | ~x33"
  and 73: "~x9 | ~x40"
  and 74: "~x9 | ~x8"
  and 75: "~x9 | ~x34"
  and 76: "~x40 | ~x8"
  and 77: "~x40 | ~x34"
  and 78: "~x8 | ~x34"
  and 79: "~x41 | ~x9"
  and 80: "~x41 | ~x35"
  and 81: "~x9 | ~x35"
  and 82: "~x10 | ~x42"
  and 83: "~x10 | ~x36"
  and 84: "~x42 | ~x36"
  and 85: "~x11 | ~x43"
  and 86: "~x11 | ~x10"
  and 87: "~x11 | ~x37"
  and 88: "~x43 | ~x10"
  and 89: "~x43 | ~x37"
  and 90: "~x10 | ~x37"
  and 91: "~x12 | ~x44"
  and 92: "~x12 | ~x11"
  and 93: "~x12 | ~x38"
  and 94: "~x44 | ~x11"
  and 95: "~x44 | ~x38"
  and 96: "~x11 | ~x38"
  and 97: "~x13 | ~x45"
  and 98: "~x13 | ~x12"
  and 99: "~x13 | ~x39"
  and 100: "~x45 | ~x12"
  and 101: "~x45 | ~x39"
  and 102: "~x12 | ~x39"
  and 103: "~x14 | ~x46"
  and 104: "~x14 | ~x13"
  and 105: "~x14 | ~x40"
  and 106: "~x46 | ~x13"
  and 107: "~x46 | ~x40"
  and 108: "~x13 | ~x40"
  and 109: "~x47 | ~x14"
  and 110: "~x47 | ~x41"
  and 111: "~x14 | ~x41"
  and 112: "~x15 | ~x48"
  and 113: "~x15 | ~x42"
  and 114: "~x48 | ~x42"
  and 115: "~x16 | ~x49"
  and 116: "~x16 | ~x15"
  and 117: "~x16 | ~x43"
  and 118: "~x49 | ~x15"
  and 119: "~x49 | ~x43"
  and 120: "~x15 | ~x43"
  and 121: "~x17 | ~x50"
  and 122: "~x17 | ~x16"
  and 123: "~x17 | ~x44"
  and 124: "~x50 | ~x16"
  and 125: "~x50 | ~x44"
  and 126: "~x16 | ~x44"
  and 127: "~x18 | ~x51"
  and 128: "~x18 | ~x17"
  and 129: "~x18 | ~x45"
  and 130: "~x51 | ~x17"
  and 131: "~x51 | ~x45"
  and 132: "~x17 | ~x45"
  and 133: "~x19 | ~x52"
  and 134: "~x19 | ~x18"
  and 135: "~x19 | ~x46"
  and 136: "~x52 | ~x18"
  and 137: "~x52 | ~x46"
  and 138: "~x18 | ~x46"
  and 139: "~x53 | ~x19"
  and 140: "~x53 | ~x47"
  and 141: "~x19 | ~x47"
  and 142: "~x20 | ~x54"
  and 143: "~x20 | ~x48"
  and 144: "~x54 | ~x48"
  and 145: "~x21 | ~x55"
  and 146: "~x21 | ~x20"
  and 147: "~x21 | ~x49"
  and 148: "~x55 | ~x20"
  and 149: "~x55 | ~x49"
  and 150: "~x20 | ~x49"
  and 151: "~x22 | ~x56"
  and 152: "~x22 | ~x21"
  and 153: "~x22 | ~x50"
  and 154: "~x56 | ~x21"
  and 155: "~x56 | ~x50"
  and 156: "~x21 | ~x50"
  and 157: "~x23 | ~x57"
  and 158: "~x23 | ~x22"
  and 159: "~x23 | ~x51"
  and 160: "~x57 | ~x22"
  and 161: "~x57 | ~x51"
  and 162: "~x22 | ~x51"
  and 163: "~x24 | ~x58"
  and 164: "~x24 | ~x23"
  and 165: "~x24 | ~x52"
  and 166: "~x58 | ~x23"
  and 167: "~x58 | ~x52"
  and 168: "~x23 | ~x52"
  and 169: "~x59 | ~x24"
  and 170: "~x59 | ~x53"
  and 171: "~x24 | ~x53"
  and 172: "~x25 | ~x54"
  and 173: "~x26 | ~x25"
  and 174: "~x26 | ~x55"
  and 175: "~x25 | ~x55"
  and 176: "~x27 | ~x26"
  and 177: "~x27 | ~x56"
  and 178: "~x26 | ~x56"
  and 179: "~x28 | ~x27"
  and 180: "~x28 | ~x57"
  and 181: "~x27 | ~x57"
  and 182: "~x29 | ~x28"
  and 183: "~x29 | ~x58"
  and 184: "~x28 | ~x58"
  shows "False"
    using assms
    by argo

text \<open>Translated from TPTP problem library: MSC007-1.008.dimacs\<close>

lemma assumes 1: "x0 | x1 | x2 | x3 | x4 | x5 | x6"
  and 2: "x7 | x8 | x9 | x10 | x11 | x12 | x13"
  and 3: "x14 | x15 | x16 | x17 | x18 | x19 | x20"
  and 4: "x21 | x22 | x23 | x24 | x25 | x26 | x27"
  and 5: "x28 | x29 | x30 | x31 | x32 | x33 | x34"
  and 6: "x35 | x36 | x37 | x38 | x39 | x40 | x41"
  and 7: "x42 | x43 | x44 | x45 | x46 | x47 | x48"
  and 8: "x49 | x50 | x51 | x52 | x53 | x54 | x55"
  and 9: "~x0 | ~x7"
  and 10: "~x0 | ~x14"
  and 11: "~x0 | ~x21"
  and 12: "~x0 | ~x28"
  and 13: "~x0 | ~x35"
  and 14: "~x0 | ~x42"
  and 15: "~x0 | ~x49"
  and 16: "~x7 | ~x14"
  and 17: "~x7 | ~x21"
  and 18: "~x7 | ~x28"
  and 19: "~x7 | ~x35"
  and 20: "~x7 | ~x42"
  and 21: "~x7 | ~x49"
  and 22: "~x14 | ~x21"
  and 23: "~x14 | ~x28"
  and 24: "~x14 | ~x35"
  and 25: "~x14 | ~x42"
  and 26: "~x14 | ~x49"
  and 27: "~x21 | ~x28"
  and 28: "~x21 | ~x35"
  and 29: "~x21 | ~x42"
  and 30: "~x21 | ~x49"
  and 31: "~x28 | ~x35"
  and 32: "~x28 | ~x42"
  and 33: "~x28 | ~x49"
  and 34: "~x35 | ~x42"
  and 35: "~x35 | ~x49"
  and 36: "~x42 | ~x49"
  and 37: "~x1 | ~x8"
  and 38: "~x1 | ~x15"
  and 39: "~x1 | ~x22"
  and 40: "~x1 | ~x29"
  and 41: "~x1 | ~x36"
  and 42: "~x1 | ~x43"
  and 43: "~x1 | ~x50"
  and 44: "~x8 | ~x15"
  and 45: "~x8 | ~x22"
  and 46: "~x8 | ~x29"
  and 47: "~x8 | ~x36"
  and 48: "~x8 | ~x43"
  and 49: "~x8 | ~x50"
  and 50: "~x15 | ~x22"
  and 51: "~x15 | ~x29"
  and 52: "~x15 | ~x36"
  and 53: "~x15 | ~x43"
  and 54: "~x15 | ~x50"
  and 55: "~x22 | ~x29"
  and 56: "~x22 | ~x36"
  and 57: "~x22 | ~x43"
  and 58: "~x22 | ~x50"
  and 59: "~x29 | ~x36"
  and 60: "~x29 | ~x43"
  and 61: "~x29 | ~x50"
  and 62: "~x36 | ~x43"
  and 63: "~x36 | ~x50"
  and 64: "~x43 | ~x50"
  and 65: "~x2 | ~x9"
  and 66: "~x2 | ~x16"
  and 67: "~x2 | ~x23"
  and 68: "~x2 | ~x30"
  and 69: "~x2 | ~x37"
  and 70: "~x2 | ~x44"
  and 71: "~x2 | ~x51"
  and 72: "~x9 | ~x16"
  and 73: "~x9 | ~x23"
  and 74: "~x9 | ~x30"
  and 75: "~x9 | ~x37"
  and 76: "~x9 | ~x44"
  and 77: "~x9 | ~x51"
  and 78: "~x16 | ~x23"
  and 79: "~x16 | ~x30"
  and 80: "~x16 | ~x37"
  and 81: "~x16 | ~x44"
  and 82: "~x16 | ~x51"
  and 83: "~x23 | ~x30"
  and 84: "~x23 | ~x37"
  and 85: "~x23 | ~x44"
  and 86: "~x23 | ~x51"
  and 87: "~x30 | ~x37"
  and 88: "~x30 | ~x44"
  and 89: "~x30 | ~x51"
  and 90: "~x37 | ~x44"
  and 91: "~x37 | ~x51"
  and 92: "~x44 | ~x51"
  and 93: "~x3 | ~x10"
  and 94: "~x3 | ~x17"
  and 95: "~x3 | ~x24"
  and 96: "~x3 | ~x31"
  and 97: "~x3 | ~x38"
  and 98: "~x3 | ~x45"
  and 99: "~x3 | ~x52"
  and 100: "~x10 | ~x17"
  and 101: "~x10 | ~x24"
  and 102: "~x10 | ~x31"
  and 103: "~x10 | ~x38"
  and 104: "~x10 | ~x45"
  and 105: "~x10 | ~x52"
  and 106: "~x17 | ~x24"
  and 107: "~x17 | ~x31"
  and 108: "~x17 | ~x38"
  and 109: "~x17 | ~x45"
  and 110: "~x17 | ~x52"
  and 111: "~x24 | ~x31"
  and 112: "~x24 | ~x38"
  and 113: "~x24 | ~x45"
  and 114: "~x24 | ~x52"
  and 115: "~x31 | ~x38"
  and 116: "~x31 | ~x45"
  and 117: "~x31 | ~x52"
  and 118: "~x38 | ~x45"
  and 119: "~x38 | ~x52"
  and 120: "~x45 | ~x52"
  and 121: "~x4 | ~x11"
  and 122: "~x4 | ~x18"
  and 123: "~x4 | ~x25"
  and 124: "~x4 | ~x32"
  and 125: "~x4 | ~x39"
  and 126: "~x4 | ~x46"
  and 127: "~x4 | ~x53"
  and 128: "~x11 | ~x18"
  and 129: "~x11 | ~x25"
  and 130: "~x11 | ~x32"
  and 131: "~x11 | ~x39"
  and 132: "~x11 | ~x46"
  and 133: "~x11 | ~x53"
  and 134: "~x18 | ~x25"
  and 135: "~x18 | ~x32"
  and 136: "~x18 | ~x39"
  and 137: "~x18 | ~x46"
  and 138: "~x18 | ~x53"
  and 139: "~x25 | ~x32"
  and 140: "~x25 | ~x39"
  and 141: "~x25 | ~x46"
  and 142: "~x25 | ~x53"
  and 143: "~x32 | ~x39"
  and 144: "~x32 | ~x46"
  and 145: "~x32 | ~x53"
  and 146: "~x39 | ~x46"
  and 147: "~x39 | ~x53"
  and 148: "~x46 | ~x53"
  and 149: "~x5 | ~x12"
  and 150: "~x5 | ~x19"
  and 151: "~x5 | ~x26"
  and 152: "~x5 | ~x33"
  and 153: "~x5 | ~x40"
  and 154: "~x5 | ~x47"
  and 155: "~x5 | ~x54"
  and 156: "~x12 | ~x19"
  and 157: "~x12 | ~x26"
  and 158: "~x12 | ~x33"
  and 159: "~x12 | ~x40"
  and 160: "~x12 | ~x47"
  and 161: "~x12 | ~x54"
  and 162: "~x19 | ~x26"
  and 163: "~x19 | ~x33"
  and 164: "~x19 | ~x40"
  and 165: "~x19 | ~x47"
  and 166: "~x19 | ~x54"
  and 167: "~x26 | ~x33"
  and 168: "~x26 | ~x40"
  and 169: "~x26 | ~x47"
  and 170: "~x26 | ~x54"
  and 171: "~x33 | ~x40"
  and 172: "~x33 | ~x47"
  and 173: "~x33 | ~x54"
  and 174: "~x40 | ~x47"
  and 175: "~x40 | ~x54"
  and 176: "~x47 | ~x54"
  and 177: "~x6 | ~x13"
  and 178: "~x6 | ~x20"
  and 179: "~x6 | ~x27"
  and 180: "~x6 | ~x34"
  and 181: "~x6 | ~x41"
  and 182: "~x6 | ~x48"
  and 183: "~x6 | ~x55"
  and 184: "~x13 | ~x20"
  and 185: "~x13 | ~x27"
  and 186: "~x13 | ~x34"
  and 187: "~x13 | ~x41"
  and 188: "~x13 | ~x48"
  and 189: "~x13 | ~x55"
  and 190: "~x20 | ~x27"
  and 191: "~x20 | ~x34"
  and 192: "~x20 | ~x41"
  and 193: "~x20 | ~x48"
  and 194: "~x20 | ~x55"
  and 195: "~x27 | ~x34"
  and 196: "~x27 | ~x41"
  and 197: "~x27 | ~x48"
  and 198: "~x27 | ~x55"
  and 199: "~x34 | ~x41"
  and 200: "~x34 | ~x48"
  and 201: "~x34 | ~x55"
  and 202: "~x41 | ~x48"
  and 203: "~x41 | ~x55"
  and 204: "~x48 | ~x55"
  shows "False"
    using assms
    by argo

lemma "0 \<le> (yc::real) \<and>
       0 \<le> yd \<and> 0 \<le> yb \<and> 0 \<le> ya \<Longrightarrow>
       0 \<le> yf \<and>
       0 \<le> xh \<and> 0 \<le> ye \<and> 0 \<le> yg \<Longrightarrow>
       0 \<le> yw \<and> 0 \<le> xs \<and> 0 \<le> yu \<Longrightarrow>
       0 \<le> aea \<and> 0 \<le> aee \<and> 0 \<le> aed \<Longrightarrow>
       0 \<le> zy \<and> 0 \<le> xz \<and> 0 \<le> zw \<Longrightarrow>
       0 \<le> zb \<and>
       0 \<le> za \<and> 0 \<le> yy \<and> 0 \<le> yz \<Longrightarrow>
       0 \<le> zp \<and> 0 \<le> zo \<and> 0 \<le> yq \<Longrightarrow>
       0 \<le> adp \<and> 0 \<le> aeb \<and> 0 \<le> aec \<Longrightarrow>
       0 \<le> acm \<and> 0 \<le> aco \<and> 0 \<le> acn \<Longrightarrow>
       0 \<le> abl \<Longrightarrow>
       0 \<le> zr \<and> 0 \<le> zq \<and> 0 \<le> abh \<Longrightarrow>
       0 \<le> abq \<and> 0 \<le> zd \<and> 0 \<le> abo \<Longrightarrow>
       0 \<le> acd \<and>
       0 \<le> acc \<and> 0 \<le> xi \<and> 0 \<le> acb \<Longrightarrow>
       0 \<le> acp \<and> 0 \<le> acr \<and> 0 \<le> acq \<Longrightarrow>
       0 \<le> xw \<and>
       0 \<le> xr \<and> 0 \<le> xv \<and> 0 \<le> xu \<Longrightarrow>
       0 \<le> zc \<and> 0 \<le> acg \<and> 0 \<le> ach \<Longrightarrow>
       0 \<le> zt \<and> 0 \<le> zs \<and> 0 \<le> xy \<Longrightarrow>
       0 \<le> ady \<and> 0 \<le> adw \<and> 0 \<le> zg \<Longrightarrow>
       0 \<le> abd \<and>
       0 \<le> abc \<and> 0 \<le> yr \<and> 0 \<le> abb \<Longrightarrow>
       0 \<le> adi \<and>
       0 \<le> x \<and> 0 \<le> adh \<and> 0 \<le> xa \<Longrightarrow>
       0 \<le> aak \<and> 0 \<le> aai \<and> 0 \<le> aad \<Longrightarrow>
       0 \<le> aba \<and> 0 \<le> zh \<and> 0 \<le> aay \<Longrightarrow>
       0 \<le> abg \<and> 0 \<le> ys \<and> 0 \<le> abe \<Longrightarrow>
       0 \<le> abs1 \<and>
       0 \<le> yt \<and> 0 \<le> abr \<and> 0 \<le> zu \<Longrightarrow>
       0 \<le> abv \<and>
       0 \<le> zn \<and> 0 \<le> abw \<and> 0 \<le> zm \<Longrightarrow>
       0 \<le> adl \<and> 0 \<le> adn \<Longrightarrow>
       0 \<le> acf \<and> 0 \<le> aca \<Longrightarrow>
       0 \<le> ads \<and> 0 \<le> aaq \<Longrightarrow>
       0 \<le> ada \<Longrightarrow>
       0 \<le> aaf \<and> 0 \<le> aac \<and> 0 \<le> aag \<Longrightarrow>
       0 \<le> aal \<and>
       0 \<le> acu \<and> 0 \<le> acs \<and> 0 \<le> act \<Longrightarrow>
       0 \<le> aas \<and> 0 \<le> xb \<and> 0 \<le> aat \<Longrightarrow>
       0 \<le> zk \<and> 0 \<le> zj \<and> 0 \<le> zi \<Longrightarrow>
       0 \<le> ack \<and>
       0 \<le> acj \<and> 0 \<le> xc \<and> 0 \<le> aci \<Longrightarrow>
       0 \<le> aav \<and> 0 \<le> aah \<and> 0 \<le> xd \<Longrightarrow>
       0 \<le> abt \<and>
       0 \<le> xo \<and> 0 \<le> abu \<and> 0 \<le> xn \<Longrightarrow>
       0 \<le> adc \<and>
       0 \<le> abz \<and> 0 \<le> adc \<and> 0 \<le> abz \<Longrightarrow>
       0 \<le> xt \<and>
       0 \<le> zz \<and> 0 \<le> aab \<and> 0 \<le> aaa \<Longrightarrow>
       0 \<le> adq \<and>
       0 \<le> xl \<and> 0 \<le> adr \<and> 0 \<le> adb \<Longrightarrow>
       0 \<le> zf \<and> 0 \<le> yh \<and> 0 \<le> yi \<Longrightarrow>
       0 \<le> aao \<and> 0 \<le> aam \<and> 0 \<le> xe \<Longrightarrow>
       0 \<le> abk \<and>
       0 \<le> aby \<and> 0 \<le> abj \<and> 0 \<le> abx \<Longrightarrow>
       0 \<le> yp \<Longrightarrow>
       0 \<le> yl \<and> 0 \<le> yj \<and> 0 \<le> ym \<Longrightarrow>
       0 \<le> acw \<Longrightarrow>
       0 \<le> adk \<and>
       0 \<le> adg \<and> 0 \<le> adj \<and> 0 \<le> adf \<Longrightarrow>
       0 \<le> adv \<and> 0 \<le> xf \<and> 0 \<le> adu \<Longrightarrow>
       yc + yd + yb + ya = 1 \<Longrightarrow>
       yf + xh + ye + yg = 1 \<Longrightarrow>
       yw + xs + yu = 1 \<Longrightarrow>
       aea + aee + aed = 1 \<Longrightarrow>
       zy + xz + zw = 1 \<Longrightarrow>
       zb + za + yy + yz = 1 \<Longrightarrow>
       zp + zo + yq = 1 \<Longrightarrow>
       adp + aeb + aec = 1 \<Longrightarrow>
       acm + aco + acn = 1 \<Longrightarrow>
       abl + abl = 1 \<Longrightarrow>
       zr + zq + abh = 1 \<Longrightarrow>
       abq + zd + abo = 1 \<Longrightarrow>
       acd + acc + xi + acb = 1 \<Longrightarrow>
       acp + acr + acq = 1 \<Longrightarrow>
       xw + xr + xv + xu = 1 \<Longrightarrow>
       zc + acg + ach = 1 \<Longrightarrow>
       zt + zs + xy = 1 \<Longrightarrow>
       ady + adw + zg = 1 \<Longrightarrow>
       abd + abc + yr + abb = 1 \<Longrightarrow>
       adi + x + adh + xa = 1 \<Longrightarrow>
       aak + aai + aad = 1 \<Longrightarrow>
       aba + zh + aay = 1 \<Longrightarrow>
       abg + ys + abe = 1 \<Longrightarrow>
       abs1 + yt + abr + zu = 1 \<Longrightarrow>
       abv + zn + abw + zm = 1 \<Longrightarrow>
       adl + adn = 1 \<Longrightarrow>
       acf + aca = 1 \<Longrightarrow>
       ads + aaq = 1 \<Longrightarrow>
       ada + ada = 1 \<Longrightarrow>
       aaf + aac + aag = 1 \<Longrightarrow>
       aal + acu + acs + act = 1 \<Longrightarrow>
       aas + xb + aat = 1 \<Longrightarrow>
       zk + zj + zi = 1 \<Longrightarrow>
       ack + acj + xc + aci = 1 \<Longrightarrow>
       aav + aah + xd = 1 \<Longrightarrow>
       abt + xo + abu + xn = 1 \<Longrightarrow>
       adc + abz + adc + abz = 1 \<Longrightarrow>
       xt + zz + aab + aaa = 1 \<Longrightarrow>
       adq + xl + adr + adb = 1 \<Longrightarrow>
       zf + yh + yi = 1 \<Longrightarrow>
       aao + aam + xe = 1 \<Longrightarrow>
       abk + aby + abj + abx = 1 \<Longrightarrow>
       yp + yp = 1 \<Longrightarrow>
       yl + yj + ym = 1 \<Longrightarrow>
       acw + acw + acw + acw = 1 \<Longrightarrow>
       adk + adg + adj + adf = 1 \<Longrightarrow>
       adv + xf + adu = 1 \<Longrightarrow>
       yd = 0 \<or> yb = 0 \<Longrightarrow>
       xh = 0 \<or> ye = 0 \<Longrightarrow>
       yy = 0 \<or> za = 0 \<Longrightarrow>
       acc = 0 \<or> xi = 0 \<Longrightarrow>
       xv = 0 \<or> xr = 0 \<Longrightarrow>
       yr = 0 \<or> abc = 0 \<Longrightarrow>
       zn = 0 \<or> abw = 0 \<Longrightarrow>
       xo = 0 \<or> abu = 0 \<Longrightarrow>
       xl = 0 \<or> adr = 0 \<Longrightarrow>
       (yr + abd < abl \<or>
        yr + (abd + abb) < 1) \<or>
       yr + abd = abl \<and>
       yr + (abd + abb) = 1 \<Longrightarrow>
       adb + adr < xn + abu \<or>
       adb + adr = xn + abu \<Longrightarrow>
       (abl < abt \<or> abl < abt + xo) \<or>
       abl = abt \<and> abl = abt + xo \<Longrightarrow>
       yd + yc < abc + abd \<or>
       yd + yc = abc + abd \<Longrightarrow>
       aca < abb + yr \<or> aca = abb + yr \<Longrightarrow>
       acb + acc < xu + xv \<or>
       acb + acc = xu + xv \<Longrightarrow>
       (yq < xu + xr \<or>
        yq + zp < xu + (xr + xw)) \<or>
       yq = xu + xr \<and>
       yq + zp = xu + (xr + xw) \<Longrightarrow>
       (zw < xw \<or>
        zw < xw + xv \<or>
        zw + zy < xw + (xv + xu)) \<or>
       zw = xw \<and>
       zw = xw + xv \<and>
       zw + zy = xw + (xv + xu) \<Longrightarrow>
       xs + yw < zs + zt \<or>
       xs + yw = zs + zt \<Longrightarrow>
       aab + xt < ye + yf \<or>
       aab + xt = ye + yf \<Longrightarrow>
       (ya + yb < yg + ye \<or>
        ya + (yb + yc) < yg + (ye + yf)) \<or>
       ya + yb = yg + ye \<and>
       ya + (yb + yc) = yg + (ye + yf) \<Longrightarrow>
       (xu + xv < acb + acc \<or>
        xu + (xv + xw) < acb + (acc + acd)) \<or>
       xu + xv = acb + acc \<and>
       xu + (xv + xw) = acb + (acc + acd) \<Longrightarrow>
       (zs < xz + zy \<or>
        zs + xy < xz + (zy + zw)) \<or>
       zs = xz + zy \<and>
       zs + xy = xz + (zy + zw) \<Longrightarrow>
       (zs + zt < xz + zy \<or>
        zs + (zt + xy) < xz + (zy + zw)) \<or>
       zs + zt = xz + zy \<and>
       zs + (zt + xy) = xz + (zy + zw) \<Longrightarrow>
       yg + ye < ya + yb \<or>
       yg + ye = ya + yb \<Longrightarrow>
       (abd < yc \<or> abd + abc < yc + yd) \<or>
       abd = yc \<and> abd + abc = yc + yd \<Longrightarrow>
       (ye + yf < adr + adq \<or>
        ye + (yf + yg) < adr + (adq + adb)) \<or>
       ye + yf = adr + adq \<and>
       ye + (yf + yg) = adr + (adq + adb) \<Longrightarrow>
       yh + yi < ym + yj \<or>
       yh + yi = ym + yj \<Longrightarrow>
       (abq < yl \<or> abq + abo < yl + ym) \<or>
       abq = yl \<and> abq + abo = yl + ym \<Longrightarrow>
       (yp < zp \<or>
        yp < zp + zo \<or> 1 < zp + (zo + yq)) \<or>
       yp = zp \<and>
       yp = zp + zo \<and> 1 = zp + (zo + yq) \<Longrightarrow>
       (abb + yr < aca \<or>
        abb + (yr + abd) < aca + acf) \<or>
       abb + yr = aca \<and>
       abb + (yr + abd) = aca + acf \<Longrightarrow>
       adw + zg < abe + ys \<or>
       adw + zg = abe + ys \<Longrightarrow>
       zd + abq < ys + abg \<or>
       zd + abq = ys + abg \<Longrightarrow>
       yt + abs1 < aby + abk \<or>
       yt + abs1 = aby + abk \<Longrightarrow>
       (yu < abx \<or>
        yu < abx + aby \<or>
        yu + yw < abx + (aby + abk)) \<or>
       yu = abx \<and>
       yu = abx + aby \<and>
       yu + yw = abx + (aby + abk) \<Longrightarrow>
       aaf < adv \<or> aaf = adv \<Longrightarrow>
       abj + abk < yy + zb \<or>
       abj + abk = yy + zb \<Longrightarrow>
       (abb < yz \<or>
        abb + abc < yz + za \<or>
        abb + (abc + abd) < yz + (za + zb)) \<or>
       abb = yz \<and>
       abb + abc = yz + za \<and>
       abb + (abc + abd) = yz + (za + zb) \<Longrightarrow>
       (acg + zc < zd + abq \<or>
        acg + (zc + ach)
        < zd + (abq + abo)) \<or>
       acg + zc = zd + abq \<and>
       acg + (zc + ach) =
       zd + (abq + abo) \<Longrightarrow>
       zf < acm \<or> zf = acm \<Longrightarrow>
       (zg + ady < acn + acm \<or>
        zg + (ady + adw)
        < acn + (acm + aco)) \<or>
       zg + ady = acn + acm \<and>
       zg + (ady + adw) =
       acn + (acm + aco) \<Longrightarrow>
       aay + zh < zi + zj \<or>
       aay + zh = zi + zj \<Longrightarrow>
       zy < zk \<or> zy = zk \<Longrightarrow>
       (adn < zm + zn \<or>
        adn + adl < zm + (zn + abv)) \<or>
       adn = zm + zn \<and>
       adn + adl = zm + (zn + abv) \<Longrightarrow>
       zo + zp < zs + zt \<or>
       zo + zp = zs + zt \<Longrightarrow>
       zq + zr < zs + zt \<or>
       zq + zr = zs + zt \<Longrightarrow>
       (aai < adi \<or> aai < adi + adh) \<or>
       aai = adi \<and> aai = adi + adh \<Longrightarrow>
       (abr < acj \<or>
        abr + (abs1 + zu)
        < acj + (aci + ack)) \<or>
       abr = acj \<and>
       abr + (abs1 + zu) =
       acj + (aci + ack) \<Longrightarrow>
       (abl < zw \<or> 1 < zw + zy) \<or>
       abl = zw \<and> 1 = zw + zy \<Longrightarrow>
       (zz + aaa < act + acu \<or>
        zz + (aaa + aab)
        < act + (acu + aal)) \<or>
       zz + aaa = act + acu \<and>
       zz + (aaa + aab) =
       act + (acu + aal) \<Longrightarrow>
       (aam < aac \<or> aam + aao < aac + aaf) \<or>
       aam = aac \<and> aam + aao = aac + aaf \<Longrightarrow>
       (aak < aaf \<or> aak + aad < aaf + aag) \<or>
       aak = aaf \<and> aak + aad = aaf + aag \<Longrightarrow>
       (aah < aai \<or> aah + aav < aai + aak) \<or>
       aah = aai \<and> aah + aav = aai + aak \<Longrightarrow>
       act + (acu + aal) < aam + aao \<or>
       act + (acu + aal) = aam + aao \<Longrightarrow>
       (ads < aat \<or> 1 < aat + aas) \<or>
       ads = aat \<and> 1 = aat + aas \<Longrightarrow>
       (aba < aas \<or> aba + aay < aas + aat) \<or>
       aba = aas \<and> aba + aay = aas + aat \<Longrightarrow>
       acm < aav \<or> acm = aav \<Longrightarrow>
       (ada < aay \<or> 1 < aay + aba) \<or>
       ada = aay \<and> 1 = aay + aba \<Longrightarrow>
       abb + (abc + abd) < abe + abg \<or>
       abb + (abc + abd) = abe + abg \<Longrightarrow>
       (abh < abj \<or> abh < abj + abk) \<or>
       abh = abj \<and> abh = abj + abk \<Longrightarrow>
       1 < abo + abq \<or> 1 = abo + abq \<Longrightarrow>
       (acj < abr \<or> acj + aci < abr + abs1) \<or>
       acj = abr \<and> acj + aci = abr + abs1 \<Longrightarrow>
       (abt < abv \<or> abt + abu < abv + abw) \<or>
       abt = abv \<and> abt + abu = abv + abw \<Longrightarrow>
       (abx < adc \<or> abx + aby < adc + abz) \<or>
       abx = adc \<and> abx + aby = adc + abz \<Longrightarrow>
       (acf < acd \<or>
        acf < acd + acc \<or>
        1 < acd + (acc + acb)) \<or>
       acf = acd \<and>
       acf = acd + acc \<and>
       1 = acd + (acc + acb) \<Longrightarrow>
       acc + acd < acf \<or> acc + acd = acf \<Longrightarrow>
       (acg < acq \<or> acg + ach < acq + acr) \<or>
       acg = acq \<and> acg + ach = acq + acr \<Longrightarrow>
       aci + (acj + ack) < acr + acp \<or>
       aci + (acj + ack) = acr + acp \<Longrightarrow>
       (acm < acp \<or>
        acm + acn < acp + acq \<or>
        acm + (acn + aco)
        < acp + (acq + acr)) \<or>
       acm = acp \<and>
       acm + acn = acp + acq \<and>
       acm + (acn + aco) =
       acp + (acq + acr) \<Longrightarrow>
       (acs + act < acw + acw \<or>
        acs + (act + acu)
        < acw + (acw + acw)) \<or>
       acs + act = acw + acw \<and>
       acs + (act + acu) =
       acw + (acw + acw) \<Longrightarrow>
       (ada < adb + adr \<or>
        1 < adb + (adr + adq)) \<or>
       ada = adb + adr \<and>
       1 = adb + (adr + adq) \<Longrightarrow>
       (adc + adc < adf + adg \<or>
        adc + (adc + abz)
        < adf + (adg + adk)) \<or>
       adc + adc = adf + adg \<and>
       adc + (adc + abz) =
       adf + (adg + adk) \<Longrightarrow>
       adh + adi < adj + adk \<or>
       adh + adi = adj + adk \<Longrightarrow>
       (adl < aec \<or> 1 < aec + adp) \<or>
       adl = aec \<and> 1 = aec + adp \<Longrightarrow>
       (adq < ads \<or> adq + adr < ads) \<or>
       adq = ads \<and> adq + adr = ads \<Longrightarrow>
       adu + adv < aed + aea \<or>
       adu + adv = aed + aea \<Longrightarrow>
       (adw < aee \<or> adw + ady < aee + aea) \<or>
       adw = aee \<and> adw + ady = aee + aea \<Longrightarrow>
       (aeb < aed \<or> aeb + aec < aed + aee) \<or>
       aeb = aed \<and> aeb + aec = aed + aee \<Longrightarrow>
       False"
       by argo

end


theory AbstractLock_Lib
imports Lib Lib_ProofRules
begin

definition "lock_acquire t w \<sigma>\<^sub>L \<sigma>\<^sub>C ts' \<equiv>
    let v =  lib_value \<sigma>\<^sub>L w; v' = v + 1 in
     if (2 dvd v)
      then
        (lib_update t w v' \<sigma>\<^sub>L \<sigma>\<^sub>C ts', (True, v))
      else
        ((\<sigma>\<^sub>L ,\<sigma>\<^sub>C), (False, v))"

definition "lock_release t w \<sigma>\<^sub>L \<sigma>\<^sub>C ts' \<equiv>
            let v =  lib_value \<sigma>\<^sub>L w; v' = v + 1 in
               lib_write t True w v' \<sigma>\<^sub>L \<sigma>\<^sub>C ts'"

definition "lock_acquire_step t x \<sigma>\<^sub>L \<sigma>\<^sub>C  \<sigma>\<^sub>L' \<sigma>\<^sub>C'  res ver \<equiv>
            \<exists> w ts' . w \<in> lib_visible_writes \<sigma>\<^sub>L t x \<and>
             w \<notin> lib_covered \<sigma>\<^sub>L \<and>
             lib_valid_fresh_ts \<sigma>\<^sub>L w ts' \<and>
             \<sigma>\<^sub>L' = fst(fst(lock_acquire t w \<sigma>\<^sub>L \<sigma>\<^sub>C ts')) \<and>
             \<sigma>\<^sub>C' = snd(fst(lock_acquire t w \<sigma>\<^sub>L \<sigma>\<^sub>C ts')) \<and>
             res = fst(snd(lock_acquire t w \<sigma>\<^sub>L \<sigma>\<^sub>C ts')) \<and>
             ver = snd(snd(lock_acquire t w \<sigma>\<^sub>L \<sigma>\<^sub>C ts'))"

definition "lock_release_step t x \<sigma>\<^sub>L \<sigma>\<^sub>C \<sigma>\<^sub>L' \<sigma>\<^sub>C' \<equiv>
            \<exists> w ts' . w \<in> lib_visible_writes \<sigma>\<^sub>L t x \<and>
              w \<notin> lib_covered \<sigma>\<^sub>L \<and>
              lib_valid_fresh_ts \<sigma>\<^sub>L w ts' \<and>
              \<sigma>\<^sub>L' = lock_release t w \<sigma>\<^sub>L \<sigma>\<^sub>C ts' \<and>
              \<sigma>\<^sub>C' =  \<sigma>\<^sub>C"

abbreviation Lock_acquire_abbr:: " surrey_state \<Rightarrow> lib_state \<Rightarrow> T \<Rightarrow> L \<Rightarrow> surrey_state \<Rightarrow> lib_state \<Rightarrow> bool \<Rightarrow> V  \<Rightarrow> bool" ("[_ _ _  LOCKACQ(_)  _ _ _ _]")
  where "[\<sigma>\<^sub>C \<sigma>\<^sub>L t LOCKACQ(x) \<sigma>\<^sub>C' \<sigma>\<^sub>L' r v] \<equiv> lock_acquire_step t x \<sigma>\<^sub>L \<sigma>\<^sub>C  \<sigma>\<^sub>L' \<sigma>\<^sub>C' r v"

abbreviation Lock_rel_abbr:: " surrey_state \<Rightarrow> lib_state \<Rightarrow> T \<Rightarrow> L  \<Rightarrow> lib_state \<Rightarrow> surrey_state \<Rightarrow> bool" ("[_ _ _  LOCKREL(_)  _ _ ]")
  where "[\<sigma>\<^sub>C \<sigma>\<^sub>L t LOCKREL(x) \<sigma>\<^sub>L' \<sigma>\<^sub>C'] \<equiv> lock_release_step t x \<sigma>\<^sub>L \<sigma>\<^sub>C \<sigma>\<^sub>L' \<sigma>\<^sub>C'"

definition "lib_covered_val \<sigma> l v \<equiv>
  (\<exists> ts . ts \<in> lib_writes_on \<sigma> l \<and> lib_value \<sigma> ts = v) \<and>
  (\<forall> ts . ts \<in> lib_writes_on \<sigma> l \<and> ts \<notin> lib_covered \<sigma> \<longrightarrow> lib_value \<sigma> ts > v)"

abbreviation l_covered_val_abbr:: "nat \<Rightarrow> nat \<Rightarrow> lib_state \<Rightarrow> bool" ("cvv[lib(_), _] _" [100, 100, 100])
 where "cvv[lib(l), u] \<sigma> \<equiv> lib_covered_val \<sigma> l u"

definition "even_not_covered_last ls x \<equiv> \<forall> w . w\<in>lib_writes_on ls x \<and> even (lib_value ls w) \<and> w\<notin>lib_covered ls \<longrightarrow> lib_lastWr ls x = w"

definition "abslock_invs ls x \<equiv> even_not_covered_last ls x"

lemmas invs_abs = even_not_covered_last_def

lemma abslock_even_not_covered_last_inv:
  assumes "lib_wfs ls cs"
      and "wfs cs "
      and "even_not_covered_last ls x"
      and "lock_acquire_step t x ls cs ls' cs' res ver"
    shows "even_not_covered_last ls' x"
  using assms
  apply(simp add: even_not_covered_last_def abslock_invs_def)
  apply(intro conjI impI allI, elim conjE)
  apply(case_tac "res = False", simp)
   apply(simp add: invs_abs lock_acquire_step_def lock_acquire_def)
   apply auto[1]
  apply simp
  apply(subgoal_tac "a = x", simp)
   defer
   apply(simp add: lib_writes_on_def)
  apply(simp add: lock_acquire_step_def lock_acquire_def )
   apply(elim exE conjE)
 apply(case_tac "even (lib_value ls (aa, ba))", simp_all)
  apply(simp add: lib_update_def all_updates_l  lib_writes_on_def lib_value_def)
  apply safe
  apply(simp add: lib_visible_writes_def)
     apply (simp add: lib_writes_on_def)
  apply(simp add: lib_visible_writes_def)
    apply (simp add: lib_writes_on_def)
   apply(simp add: lib_visible_writes_def lib_writes_on_def)
   apply clarsimp
   apply(simp add: lib_visible_writes_def lib_writes_on_def)
  defer
   apply(simp add: lib_visible_writes_def lib_writes_on_def lib_lastWr_def lib_valid_fresh_ts_def)
  proof -
    fix b :: rat and aa :: nat and ba :: rat and ts' :: rat
    assume a1: "even (lib_val (lib_mods ls (x, ba)))"
    assume "ver = lib_val (lib_mods ls (x, ba))"
    assume a2: "aa = x \<and> (aa, ba) \<in> lib_writes ls \<and> tst (lib_thrView ls t x) \<le> ba"
    assume a3: "even (lib_val (if b = ts' then \<lparr>lib_val = Suc (lib_val (lib_mods ls (aa, ba))), lib_rel = True\<rparr> else lib_mods ls (x, b)))"
    assume a4: "\<forall>b. (x, b) \<in> lib_writes ls \<and> even (lib_val (lib_mods ls (x, b))) \<and> (x, b) \<notin> lib_covered ls \<longrightarrow> Max (tst ` {w. var w = x \<and> w \<in> lib_writes ls}) = b"
    assume a5: "(x, ba) \<notin> lib_covered ls"
    assume a6: "(x, b) \<in> lib_writes ls"
    assume a7: "b \<noteq> ba"
    assume a8: "(x, b) \<notin> lib_covered ls"
    have "Max (tst ` {p. var p = x \<and> p \<in> lib_writes ls}) = ba"
      using a5 a4 a2 a1 by meson
    then have "b = ts'"
      using a8 a7 a6 a4 a3 by auto
    then show "Max (tst ` {w. var w = x \<and> (w = (x, ts') \<or> w \<in> lib_writes ls)}) = b"
      using a3 a2 a1 by force
  next
  fix b :: rat and aa :: nat and ba :: rat and ts' :: rat
assume a1: "aa = x \<and> (aa, ba) \<in> lib_writes ls \<and> tst (lib_thrView ls t x) \<le> ba"
  assume a2: "b \<noteq> ba"
  assume a3: "(x, b) \<in> lib_writes ls"
  assume a4: "(x, ba) \<notin> lib_covered ls"
  assume "ver = lib_val (lib_mods ls (x, ba))"
  assume a5: "(x, b) \<notin> lib_covered ls"
  assume a6: "even (lib_val (lib_mods ls (x, ba)))"
  assume a7: "even (lib_val (if b = ts' then \<lparr>lib_val = Suc (lib_val (lib_mods ls (aa, ba))), lib_rel = True\<rparr> else lib_mods ls (x, b)))"
  assume a8: "\<forall>b. (x, b) \<in> lib_writes ls \<and> even (lib_val (lib_mods ls (x, b))) \<and> (x, b) \<notin> lib_covered ls \<longrightarrow> lib_lastWr ls x = (x, b)"
  then have "lib_lastWr ls x = (x, ba)"
    using a6 a4 a1 by blast
  then have "b = ts' \<or> (x, b) = (x, ba)"
    using a8 a7 a5 a3 by presburger
  then show "lib_lastWr (ls\<lparr>lib_thrView := (lib_thrView ls) (t := ts_oride ((lib_thrView ls t)(x := (x, ts'))) (lib_modView ls (x, ba) LVARS)), lib_modView := (lib_modView ls) ((x, ts') := (lib_modView ls (x, ts')) (CVARS := ts_oride (thrView cs t) (lib_modView ls (x, ba) CVARS), LVARS := ts_oride ((lib_thrView ls t)(x := (x, ts'))) (lib_modView ls (x, ba) LVARS))), lib_mods := (lib_mods ls) ((x, ts') := \<lparr>lib_val = Suc (lib_val (lib_mods ls (x, ba))), lib_rel = True\<rparr>), lib_writes := insert (x, ts') (lib_writes ls), lib_covered := insert (x, ba) (lib_covered ls)\<rparr>) x = (x, b)"
    using a7 a6 a2 a1 by simp
qed

lemma lock_release_last: "lib_wfs ls cs \<Longrightarrow> ls' = lock_release t (aa, ba) ls cs ts' \<Longrightarrow>
       lib_valid_fresh_ts ls (aa, ba) ts' \<Longrightarrow>
       (aa, ba) = lib_lastWr ls x \<Longrightarrow> (aa, ts') = lib_lastWr ls' aa"
  apply(simp add:lock_release_def lib_lastWr_def lib_writes_on_def  tst_def var_def)
  apply(simp add: lib_write_def all_updates_l lib_valid_fresh_ts_def)
  apply(elim conjE)
  apply(subgoal_tac "ts'>ba") defer
   apply blast
  apply(subgoal_tac "{w. fst w = x \<and> (w = (x, ts') \<or> w \<in> lib_writes ls)} =
        {w. fst w = x \<and>  w \<in> lib_writes ls} \<union> {(x,ts')}", simp)
  apply(case_tac "ts'\<in>(snd ` {w. fst w = x \<and> w \<in> lib_writes ls})")
  apply (smt image_iff less_imp_neq lib_writes_on_def mem_Collect_eq tst_def var_def)
   apply(subgoal_tac "finite {w. fst w = x \<and> w \<in> lib_writes ls}")
  apply (smt Max_in Max_less_iff empty_iff finite_imageI finite_insert infinite_growing insertE insertI1)
   apply(simp add: lib_wfs_def)
   apply (simp add: lib_writes_on_def var_def)
  apply(case_tac "ts'\<in>(snd ` {w. fst w = x \<and> w \<in> lib_writes ls})")
   apply auto[1]
  apply(subgoal_tac "finite {w. fst w = x \<and> w \<in> lib_writes ls}")
  apply simp
  apply auto[1]
   apply(simp add: lib_wfs_def)
   by (simp add: lib_writes_on_def var_def)

lemma abslock_release_even_not_covered_last_inv:
  assumes "lib_wfs ls cs"
      and "wfs cs "
      and "even_not_covered_last ls x"
      and "[lib(x) =\<^sub>t u] ls"
      and "odd u"
      and "lock_release_step t x ls cs ls' cs'"
    shows "even_not_covered_last ls' x"
  using assms
  apply(simp add: even_not_covered_last_def lock_release_step_def)
  apply(intro allI impI, elim exE conjE)
  apply(subgoal_tac "(aa, ba) = lib_lastWr ls x")
   defer
  apply(subgoal_tac "aa = x", simp)
    apply (simp add: lib_dobs_visible_writes_last)
   apply(simp add: lib_visible_writes_def lib_writes_on_def)
  apply(subgoal_tac "lib_value ls (aa, ba) = u") defer
  using lib_dobs_visible_writes apply blast
  apply(subgoal_tac "(aa, ts') = lib_lastWr ls' aa") defer
  using lock_release_last apply blast
  apply(subgoal_tac "aa = x \<and> a = x") defer
  apply(simp add: lib_visible_writes_def lib_writes_on_def lib_lastWr_def)
  apply(case_tac "b = ts'", simp_all)
  apply(simp add: lib_lastWr_def lock_release_def lib_value_def lib_writes_on_def)
  apply(simp add: var_def tst_def lib_visible_writes_def)
  apply(simp add: lib_write_def all_updates_l)
  done

end