(*  Title:      Jinja/BV/SemiType.thy

    Author:     Tobias Nipkow, Gerwin Klein
    Copyright   2000 TUM
*)

header {* \isaheader{The Jinja Type System as a Semilattice} *}

theory SemiType
imports "../Common/WellForm" "../DFA/Semilattices"
begin

definition super :: "'a prog \<Rightarrow> cname \<Rightarrow> cname"
where "super P C \<equiv> fst (the (class P C))"

lemma superI:
  "(C,D) \<in> subcls1 P \<Longrightarrow> super P C = D"
  by (unfold super_def) (auto dest: subcls1D)

primrec the_Class :: "ty \<Rightarrow> cname"
where
  "the_Class (Class C) = C"

definition sup :: "'c prog \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> ty err"
where
  "sup P T\<^sub>1 T\<^sub>2 \<equiv>
  if is_refT T\<^sub>1 \<and> is_refT T\<^sub>2 then
  OK (if T\<^sub>1 = NT then T\<^sub>2 else
      if T\<^sub>2 = NT then T\<^sub>1 else
      (Class (exec_lub (subcls1 P) (super P) (the_Class T\<^sub>1) (the_Class T\<^sub>2))))
  else
  (if T\<^sub>1 = T\<^sub>2 then OK T\<^sub>1 else Err)"

lemma sup_def':
  "sup P = (\<lambda>T\<^sub>1 T\<^sub>2.
  if is_refT T\<^sub>1 \<and> is_refT T\<^sub>2 then
  OK (if T\<^sub>1 = NT then T\<^sub>2 else
      if T\<^sub>2 = NT then T\<^sub>1 else
      (Class (exec_lub (subcls1 P) (super P) (the_Class T\<^sub>1) (the_Class T\<^sub>2))))
  else
  (if T\<^sub>1 = T\<^sub>2 then OK T\<^sub>1 else Err))"
  by (simp add: sup_def fun_eq_iff)

abbreviation
  subtype :: "'c prog \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> bool"
  where "subtype P \<equiv> widen P"

definition esl :: "'c prog \<Rightarrow> ty esl"
where
  "esl P \<equiv> (types P, subtype P, sup P)"

(* FIXME: move to wellform *)
lemma is_class_is_subcls:
  "wf_prog m P \<Longrightarrow> is_class P C = P \<turnstile> C \<preceq>\<^sup>* Object"
(*<*)by (fastforce simp:is_class_def
                  elim: subcls_C_Object converse_rtranclE subcls1I
                  dest: subcls1D)
(*>*)

(* FIXME: move to wellform *)
lemma subcls_antisym:
  "\<lbrakk>wf_prog m P; P \<turnstile> C \<preceq>\<^sup>* D; P \<turnstile> D \<preceq>\<^sup>* C\<rbrakk> \<Longrightarrow> C = D"
  (*<*) by (auto dest: acyclic_subcls1 acyclic_impl_antisym_rtrancl antisymD) (*>*)

(* FIXME: move to wellform *)
lemma widen_antisym:
  "\<lbrakk> wf_prog m P; P \<turnstile> T \<le> U; P \<turnstile> U \<le> T \<rbrakk> \<Longrightarrow> T = U"
(*<*)
apply (cases T)
 apply (cases U)
 apply auto
apply (cases U)
 apply (auto elim!: subcls_antisym)
done
(*>*)

lemma order_widen [intro,simp]:
  "wf_prog m P \<Longrightarrow> order (subtype P)"
(*<*)
  apply (unfold Semilat.order_def lesub_def)
  apply (auto intro: widen_trans widen_antisym)
  done
(*>*)

(* FIXME: move to TypeRel *)
lemma NT_widen:
  "P \<turnstile> NT \<le> T = (T = NT \<or> (\<exists>C. T = Class C))"
(*<*) by (cases T) auto (*>*)

(* FIXME: move to TypeRel *)
lemma Class_widen2: "P \<turnstile> Class C \<le> T = (\<exists>D. T = Class D \<and> P \<turnstile> C \<preceq>\<^sup>* D)"
(*<*) by (cases T) auto (*>*)

lemma wf_converse_subcls1_impl_acc_subtype:
  "wf ((subcls1 P)^-1) \<Longrightarrow> acc (subtype P)"
(*<*)
apply (unfold Semilat.acc_def lesssub_def)
apply (drule_tac p = "(subcls1 P)^-1 - Id" in wf_subset)
 apply blast
apply (drule wf_trancl)
apply (simp add: wf_eq_minimal)
apply clarify
apply (unfold lesub_def)
apply (rename_tac M T)
apply (case_tac "EX C. Class C : M")
 prefer 2
 apply (case_tac T)
     apply fastforce
    apply fastforce
   apply fastforce
  apply simp
  apply (rule_tac x = NT in bexI)
   apply (rule allI)
   apply (rule impI, erule conjE)
   apply (clarsimp simp add: NT_widen)
  apply simp
 apply clarsimp
apply (erule_tac x = "{C. Class C : M}" in allE)
apply auto
apply (rename_tac D)
apply (rule_tac x = "Class D" in bexI)
 prefer 2
 apply assumption
apply clarify
apply (clarsimp simp: Class_widen2)
apply (insert rtrancl_r_diff_Id [symmetric, of "subcls1 P"])
apply simp
apply (erule rtranclE)
 apply blast
apply (drule rtrancl_converseI)
apply (subgoal_tac "((subcls1 P)-Id)^-1 = ((subcls1 P)^-1 - Id)")
 prefer 2
 apply blast
apply simp
apply (blast intro: rtrancl_into_trancl2)
done
(*>*)

lemma wf_subtype_acc [intro, simp]:
  "wf_prog wf_mb P \<Longrightarrow> acc (subtype P)"
(*<*) by (rule wf_converse_subcls1_impl_acc_subtype, rule wf_subcls1) (*>*)

lemma exec_lub_refl [simp]: "exec_lub r f T T = T"
(*<*) by (simp add: exec_lub_def while_unfold) (*>*)

lemma closed_err_types:
  "wf_prog wf_mb P \<Longrightarrow> closed (err (types P)) (lift2 (sup P))"
(*<*)
  apply (unfold closed_def plussub_def lift2_def sup_def')
  apply (frule acyclic_subcls1)
  apply (frule single_valued_subcls1)
  apply (auto simp: is_type_def is_refT_def is_class_is_subcls split: err.split ty.splits)
  apply (blast dest!: is_lub_exec_lub is_lubD is_ubD intro!: is_ubI superI)
  done
(*>*)

lemma sup_subtype_greater:
  "\<lbrakk> wf_prog wf_mb P; is_type P t1; is_type P t2; sup P t1 t2 = OK s \<rbrakk>
  \<Longrightarrow> subtype P t1 s \<and> subtype P t2 s"
(*<*)
proof -
  assume wf_prog: "wf_prog wf_mb P"

  { fix c1 c2
    assume is_class: "is_class P c1" "is_class P c2"
    with wf_prog
    obtain
      "P \<turnstile> c1 \<preceq>\<^sup>* Object"
      "P \<turnstile> c2 \<preceq>\<^sup>* Object"
      by (blast intro: subcls_C_Object)
    with single_valued_subcls1[OF wf_prog]
    obtain u where
      "is_lub ((subcls1 P)^* ) c1 c2 u"
      by (blast dest: single_valued_has_lubs)
    moreover
    note acyclic_subcls1[OF wf_prog]
    moreover
    have "\<forall>x y. (x, y) \<in> subcls1 P \<longrightarrow> super P x = y"
      by (blast intro: superI)
    ultimately
    have "P \<turnstile> c1 \<preceq>\<^sup>* exec_lub (subcls1 P) (super P) c1 c2 \<and>
          P \<turnstile> c2 \<preceq>\<^sup>* exec_lub (subcls1 P) (super P) c1 c2"
      by (simp add: exec_lub_conv) (blast dest: is_lubD is_ubD)
  } note this [simp]

  assume "is_type P t1" "is_type P t2" "sup P t1 t2 = OK s"
  thus ?thesis
    apply (unfold sup_def)
    apply (cases s)
    apply (auto simp add: is_refT_def split: split_if_asm)
    done
qed
(*>*)

lemma sup_subtype_smallest:
  "\<lbrakk> wf_prog wf_mb P; is_type P a; is_type P b; is_type P c;
      subtype P a c; subtype P b c; sup P a b = OK d \<rbrakk>
  \<Longrightarrow> subtype P d c"
(*<*)
proof -
  assume wf_prog: "wf_prog wf_mb P"

  { fix c1 c2 D
    assume is_class: "is_class P c1" "is_class P c2"
    assume le: "P \<turnstile> c1 \<preceq>\<^sup>* D" "P \<turnstile> c2 \<preceq>\<^sup>* D"
    from wf_prog is_class
    obtain
      "P \<turnstile> c1 \<preceq>\<^sup>* Object"
      "P \<turnstile> c2 \<preceq>\<^sup>* Object"
      by (blast intro: subcls_C_Object)
    with single_valued_subcls1[OF wf_prog]
    obtain u where
      lub: "is_lub ((subcls1 P)^* ) c1 c2 u"
      by (blast dest: single_valued_has_lubs)
    with acyclic_subcls1[OF wf_prog]
    have "exec_lub (subcls1 P) (super P) c1 c2 = u"
      by (blast intro: superI exec_lub_conv)
    moreover
    from lub le
    have "P \<turnstile> u \<preceq>\<^sup>* D"
      by (simp add: is_lub_def is_ub_def)
    ultimately
    have "P \<turnstile> exec_lub (subcls1 P) (super P) c1 c2 \<preceq>\<^sup>* D"
      by blast
  } note this [intro]

  have [dest!]:
    "\<And>C T. P \<turnstile> Class C \<le> T \<Longrightarrow> \<exists>D. T=Class D \<and> P \<turnstile> C \<preceq>\<^sup>* D"
    by (frule Class_widen, auto)

  assume "is_type P a" "is_type P b" "is_type P c"
         "subtype P a c" "subtype P b c" "sup P a b = OK d"
  thus ?thesis
    by (auto simp add: sup_def is_refT_def
             split: split_if_asm)
qed
(*>*)

lemma sup_exists:
  "\<lbrakk> subtype P a c; subtype P b c \<rbrakk> \<Longrightarrow> EX T. sup P a b = OK T"
(*<*)
apply (unfold sup_def)
apply (cases b)
apply auto
apply (cases a)
apply auto
apply (cases a)
apply auto
done
(*>*)

lemma err_semilat_JType_esl:
  "wf_prog wf_mb P \<Longrightarrow> err_semilat (esl P)"
(*<*)
proof -
  assume wf_prog: "wf_prog wf_mb P"
  hence "order (subtype P)"..
  moreover from wf_prog
  have "closed (err (types P)) (lift2 (sup P))"
    by (rule closed_err_types)
  moreover
  from wf_prog have
    "(\<forall>x\<in>err (types P). \<forall>y\<in>err (types P). x \<sqsubseteq>\<^bsub>Err.le (subtype P)\<^esub> x \<squnion>\<^bsub>lift2 (sup P)\<^esub> y) \<and>
     (\<forall>x\<in>err (types P). \<forall>y\<in>err (types P). y \<sqsubseteq>\<^bsub>Err.le (subtype P)\<^esub> x \<squnion>\<^bsub>lift2 (sup P)\<^esub> y)"
    by (auto simp add: lesub_def plussub_def Err.le_def lift2_def sup_subtype_greater split: err.split)
  moreover from wf_prog have
    "\<forall>x\<in>err (types P). \<forall>y\<in>err (types P). \<forall>z\<in>err (types P).
    x \<sqsubseteq>\<^bsub>Err.le (subtype P)\<^esub> z \<and> y \<sqsubseteq>\<^bsub>Err.le (subtype P)\<^esub> z \<longrightarrow> x \<squnion>\<^bsub>lift2 (sup P)\<^esub> y \<sqsubseteq>\<^bsub>Err.le (subtype P)\<^esub> z"
    by (unfold lift2_def plussub_def lesub_def Err.le_def)
       (auto intro: sup_subtype_smallest dest:sup_exists split: err.split)
  ultimately show ?thesis by (simp add: esl_def semilat_def sl_def Err.sl_def)
qed
(*>*)

end


theory BDD_simplify
  imports Main BDD_basic BDD_union BDD_intersect BDD_uniqueness
begin

fun simplify_n :: "nat \<Rightarrow> BDD \<Rightarrow> BDD \<Rightarrow> BDD" where
  "simplify_n _ Nothing _ = Nothing" |
  "simplify_n _ Top b = b" |
  "simplify_n _ (Select va ta ea) Nothing = Nothing" |
  "simplify_n _ (Select va ta ea) Top = Top" |
  "simplify_n 0 (Select _ _ _) (Select _ _ _) = Top" |
  "simplify_n (Suc n) (Select va ta ea) (Select vb tb eb) =
     (if va > vb then
        simplify_n n (union ta ea) (Select vb tb eb)
      else if va = vb then
        if ta = Nothing then
          simplify_n n ea eb
        else if ea = Nothing then
          simplify_n n ta tb
        else
          select va (simplify_n n ta tb) (simplify_n n ea eb)
      else
        select vb (simplify_n n (Select va ta ea) tb)
                  (simplify_n n (Select va ta ea) eb))"

fun simplify :: "BDD \<Rightarrow> BDD \<Rightarrow> BDD" where
  "simplify Nothing _ = Nothing" |
  "simplify Top b = b" |
  "simplify (Select va ta ea) Nothing = Nothing" |
  "simplify (Select va ta ea) Top = Top" |
  "simplify (Select va ta ea) (Select vb tb eb) =
     (if va > vb then
        simplify_n (Suc va) (Select va ta ea) (Select vb tb eb)
      else
        simplify_n (Suc vb) (Select va ta ea) (Select vb tb eb))"

lemma simplify_n_top[simp]: "simplify_n n ta Top = (if ta = Nothing then Nothing else Top)"
  by (metis BDD.exhaust simplify_n.simps(1) simplify_n.simps(2) simplify_n.simps(4))

lemma not_norm_0_select[simp]: "~norm 0 (Select v t e)"
  using norm.cases by blast

lemma simplify_n_nothing [simp]: "simplify_n n a Nothing = Nothing"
  apply (induction a arbitrary: n)
  by auto

lemma simplify_nothing [simp]: "simplify a Nothing = Nothing"
  apply (case_tac a)
  by auto

lemma simplify_top: "a \<noteq> Nothing \<Longrightarrow> simplify a Top = Top"
  apply (case_tac a)
  by auto

lemma union_select_contains: "contains (Select v t e) f \<Longrightarrow> contains (union t e) f"
  apply simp
  apply (case_tac "f v")
  apply (simp add: contains_p_correct)
  apply (simp add: contains_p_correct)
  done

lemma simplify_n_idem: "norm n a \<Longrightarrow> norm n b \<Longrightarrow> s = simplify_n n a b \<Longrightarrow> simplify_n n a s = s"
  apply (induction n arbitrary: s a b)
  apply simp
  oops

end


section \<open>A generic model for separation kernels \label{sect:generic}\<close>

theory K
  imports List_Theorems Option_Binders
begin

text \<open>
{\em
  This section defines a detailed generic model of separation kernels
  called CISK (Controlled Interruptible Separation Kernel).  It
  contains a generic functional model of the behaviour of a separation kernel
  as a transition system, definitions of
  the security property and proofs that the functional model satisfies
  security properties. It is based on Rushby's approach \<^cite>\<open>"Rushby1992noninterference"\<close>
  for  noninterference.  For an explanation of the model, its structure and
  an overview of the proofs, we refer to the document entitled ``A New
  Theory of Intransitive Noninterference for Separation Kernels with
  Control''~\<^cite>\<open>"Verbeek2013"\<close>.

  The structure of the model is based on locales and refinement:
  \begin{itemize}
  \item locale ``Kernel" defines a highly generic model for a kernel, with execution semantics.
        It defines a state transition system with some extensions to the one
        used in \<^cite>\<open>"Rushby1992noninterference"\<close>.
        The transition system defined here stores the currently active
        domain in the state, and has transitions for explicit
        context switches and interrupts and provides a notion of control.
        As each operation of the system will be split into atomic actions
        in our model, only certain sequences of actions will correspond to a run on a
        real system. Therefore,
        the function $run$, which applies an execution on a state and computes the resulting
        new state, is partial and defined for realistic traces only.
        Later, but not in this locale, we will define a predicate to distinguish
        realistic traces from other traces.
        Security properties are also not part of this locale, but will
        be introduced in the locales to be described next.
  \item locale ``Separation\_Kernel" extends "Kernel" with constraints concerning non-interference.
        The theorem is only sensical for realistic traces; for unrealistic trace it will hold vacuously.
  \item locale ``Interruptible\_Separation\_Kernel" refines ``Separation\_Kernel" with interruptible action sequences.
        It defines function ``realistic\_trace'' based on these action sequences.
        Therefore, we can formulate a total run function.
  \item locale ``Controlled\_Interruptible\_Separation\_Kernel" refines ``Interruptible\_Separation\_Kernel" with abortable action sequences.
        It refines function ``control'' which now uses a generic predicate ``aborting'' and a generic function ``set\_error\_code''
        to manage aborting of action sequences.
  \end{itemize}
  }
\<close>

subsection \<open>K (Kernel)\<close>

text \<open>
The model makes use of the following types:
\begin{description}
\item['state\_t] A state  contains information about the resources of the system,
                 as well as which domain is currently active.
We decided that a state does \emph{not} need to include a program stack, as in this model the actions that are executed are modelled separately.
\item['dom\_t] A domain is an entity executing actions and making calls to the kernel.
               This type represents the names of all domains.
               Later on, we define security policies in terms of domains.
\item['action\_t] Actions of type 'action\_t represent atomic instructions that are executed by the kernel.
As kernel actions are assumed to be atomic, we assume that after each kernel action an interrupt point can occur.
\item['action\_t execution] An execution of some domain is the code or the program that is executed by the domain.
One call from a domain to the kernel will typically trigger a succession of one or more kernel actions.
Therefore, an execution is represented as a list of \emph{sequences} of kernel actions.
Non-kernel actions are not take into account.
\item['output\_t] Given the current state and an action an output can be computed deterministically.
\item[time\_t] Time is modelled using natural numbers. Each atomic kernel action can be executed within one time unit.
\end{description}
\<close>

type_synonym ('action_t) execution = "'action_t list list"
type_synonym time_t = nat

text \<open>
  Function \emph{kstep} (for kernel step) computes the next state based on the current state $s$ and a given action $a$.
  It may assume that it makes sense to perform this action, i.e., that any precondition that is necessary for execution of action $a$ in state $s$ is met.
  If not, it may return any result. This precondition is represented by generic predicate \emph{kprecondition} (for kernel precondition).
  Only realistic traces are considered. Predicate \emph{realistic\_execution} decides whether a given execution is realistic.

  Function \emph{current} returns given the state the domain that is currently executing actions. The model assumes a single-core setting, i.e., at all times only one domain is active.
  Interrupt behavior is modelled using functions \emph{interrupt} and \emph{cswitch} (for context switch) that dictate respectively  when interrupts occur and how interrupts occur.
  Interrupts are solely time-based, meaning that there is an at beforehand fixed schedule dictating which domain is active at which time.

  Finally, we add function \emph{control}.
  This function represents control of the kernel over the execution as performed by the domains.
  Given the current state $s$, the currently active domain $d$ and the execution $\alpha$ of that domain,
  it returns three objects.
  First, it returns the next action that domain $d$ will perform. Commonly, this is the next action in execution $\alpha$. It may also return None, indicating that no action is done.
  Secondly, it returns the updated execution. When executing action $a$, typically, this action will be removed from the current execution (i.e., updating the program stack).
  Thirdly, it can update the state to set, e.g., error codes.
\<close>

locale Kernel =
  fixes kstep :: "'state_t \<Rightarrow> 'action_t \<Rightarrow> 'state_t"
    and output_f :: "'state_t \<Rightarrow> 'action_t \<Rightarrow> 'output_t"
    and s0 :: 'state_t
    and current :: "'state_t => 'dom_t" (* "Returns the currently active domain"*)
    and cswitch :: "time_t \<Rightarrow> 'state_t \<Rightarrow> 'state_t" (* "Switches the current domain" *)
    and interrupt :: "time_t \<Rightarrow> bool" (* "Returns t iff an interrupt occurs in the given state at the given time"*)
    and kprecondition :: "'state_t \<Rightarrow> 'action_t \<Rightarrow> bool" (* "Returns t if an precondition holds that relates the current action to the state" *)
    and realistic_execution :: "'action_t execution \<Rightarrow> bool" (* "In this locale, this function is completely unconstrained." *)
    and control :: "'state_t \<Rightarrow> 'dom_t \<Rightarrow> 'action_t execution \<Rightarrow>
                              (('action_t option) \<times> 'action_t execution \<times> 'state_t)"
    and kinvolved :: "'action_t \<Rightarrow> 'dom_t set"
begin

subsubsection \<open>Execution semantics\<close>

text \<open>
  Short hand notations for using function control.
\<close>
definition next_action::"'state_t \<Rightarrow> ('dom_t \<Rightarrow> 'action_t execution) \<Rightarrow> 'action_t option"
where "next_action s execs = fst (control s (current s) (execs (current s)))"
definition next_execs::"'state_t \<Rightarrow> ('dom_t \<Rightarrow> 'action_t execution) \<Rightarrow> ('dom_t \<Rightarrow> 'action_t execution)"
where "next_execs s execs = (fun_upd execs (current s) (fst (snd (control s  (current s) (execs (current s))))))"
definition next_state::"'state_t \<Rightarrow> ('dom_t \<Rightarrow> 'action_t execution) \<Rightarrow> 'state_t"
where "next_state s execs = snd (snd (control s  (current s) (execs (current s))))"

text \<open>
  A thread is empty iff either it has no further action sequences to execute, or when the current action sequence is finished and there are no further action sequences to execute.
\<close>
abbreviation thread_empty::"'action_t execution \<Rightarrow> bool"
where "thread_empty exec \<equiv> exec = [] \<or> exec = [[]]"

text \<open>
  Wrappers for function kstep and kprecondition that deal with the case where the given action is None.
\<close>
definition step where "step s oa \<equiv> case oa of None \<Rightarrow> s | (Some a) \<Rightarrow> kstep s a"
definition precondition :: "'state_t \<Rightarrow> 'action_t option \<Rightarrow> bool"
where "precondition s a \<equiv> a \<rightharpoonup> kprecondition s"
definition involved
where "involved oa \<equiv> case oa of None \<Rightarrow> {} | (Some a) \<Rightarrow> kinvolved a"

text \<open>
  Execution semantics are defined as follows: a run consists of consecutively running sequences of actions.
  These sequences are interruptable.
  Run first checks whether an interrupt occurs.
  When this happens, function cswitch may switch the context.
  Otherwise, function control is used to determine the next action $a$, which also yields a new state $s'$.
  Action $a$ is executed by executing (step $s'$ $a$).
  The current execution of the current domain is updated.

  Note that run is a partial function, i.e., it computes results only when at all times the preconditions hold.
  Such runs are the realistic ones. For other runs, we do not need to -- and cannot -- prove security.
  All the theorems are formulated in such a way that they hold vacuously for unrealistic runs.
\<close>
function run :: "time_t \<Rightarrow> 'state_t option \<Rightarrow> ('dom_t \<Rightarrow> 'action_t execution) \<Rightarrow> 'state_t option"
where "run 0 s execs = s"
| "run (Suc n) None execs = None"
| "interrupt (Suc n) \<Longrightarrow> run (Suc n) (Some s) execs = run n (Some (cswitch (Suc n) s)) execs"
| "\<not>interrupt (Suc n) \<Longrightarrow> thread_empty(execs (current s)) \<Longrightarrow> run (Suc n) (Some s) execs = run n (Some s) execs"
| "\<not>interrupt (Suc n) \<Longrightarrow> \<not>thread_empty(execs (current s)) \<Longrightarrow> \<not>precondition (next_state s execs) (next_action s execs) \<Longrightarrow> run (Suc n) (Some s) execs = None"
| "\<not>interrupt (Suc n) \<Longrightarrow> \<not>thread_empty(execs (current s)) \<Longrightarrow> precondition (next_state s execs) (next_action s execs) \<Longrightarrow>
      run (Suc n) (Some s) execs = run n (Some (step (next_state s execs)  (next_action s execs))) (next_execs s execs)"
using not0_implies_Suc by (metis option.exhaust prod_cases3,auto)
termination by lexicographic_order
end

end


theory AOT_ExtendedRelationComprehension
  imports AOT_RestrictedVariables
begin

section\<open>Extended Relation Comprehension\<close>

text\<open>This theory depends on choosing extended models.\<close>
interpretation AOT_ExtendedModel by (standard; auto)

text\<open>Auxiliary lemma: negations of denoting relations denote.\<close>
AOT_theorem negation_denotes: \<open>[\<lambda>x \<phi>{x}]\<down> \<rightarrow> [\<lambda>x \<not>\<phi>{x}]\<down>\<close>
proof(rule "\<rightarrow>I")
  AOT_assume 0: \<open>[\<lambda>x \<phi>{x}]\<down>\<close>
  AOT_show \<open>[\<lambda>x \<not>\<phi>{x}]\<down>\<close>
  proof (rule "safe-ext"[axiom_inst, THEN "\<rightarrow>E", OF "&I"])
    AOT_show \<open>[\<lambda>x \<not>[\<lambda>x \<phi>{x}]x]\<down>\<close> by "cqt:2"
  next
    AOT_have \<open>\<box>[\<lambda>x \<phi>{x}]\<down>\<close>
      using 0 "exist-nec"[THEN "\<rightarrow>E"] by blast
    moreover AOT_have \<open>\<box>[\<lambda>x \<phi>{x}]\<down> \<rightarrow> \<box>\<forall>x (\<not>[\<lambda>x \<phi>{x}]x \<equiv> \<not>\<phi>{x})\<close>
      by(rule RM; safe intro!: GEN "\<equiv>I" "\<rightarrow>I" "\<beta>\<rightarrow>C"(2) "\<beta>\<leftarrow>C"(2) "cqt:2")
    ultimately AOT_show \<open>\<box>\<forall>x (\<not>[\<lambda>x \<phi>{x}]x \<equiv> \<not>\<phi>{x})\<close>
      using "\<rightarrow>E" by blast
  qed
qed

text\<open>Auxiliary lemma: conjunctions of denoting relations denote.\<close>
AOT_theorem conjunction_denotes: \<open>[\<lambda>x \<phi>{x}]\<down> & [\<lambda>x \<psi>{x}]\<down> \<rightarrow> [\<lambda>x \<phi>{x} & \<psi>{x}]\<down>\<close>
proof(rule "\<rightarrow>I")
  AOT_assume 0: \<open>[\<lambda>x \<phi>{x}]\<down> & [\<lambda>x \<psi>{x}]\<down>\<close>
  AOT_show \<open>[\<lambda>x \<phi>{x} & \<psi>{x}]\<down>\<close>
  proof (rule "safe-ext"[axiom_inst, THEN "\<rightarrow>E", OF "&I"])
    AOT_show \<open>[\<lambda>x [\<lambda>x \<phi>{x}]x & [\<lambda>x \<psi>{x}]x]\<down>\<close> by "cqt:2"
  next
    AOT_have \<open>\<box>([\<lambda>x \<phi>{x}]\<down> & [\<lambda>x \<psi>{x}]\<down>)\<close>
      using 0 "exist-nec"[THEN "\<rightarrow>E"] "&E"
            "KBasic:3" "df-simplify:2" "intro-elim:3:b" by blast
    moreover AOT_have
      \<open>\<box>([\<lambda>x \<phi>{x}]\<down> & [\<lambda>x \<psi>{x}]\<down>) \<rightarrow> \<box>\<forall>x ([\<lambda>x \<phi>{x}]x & [\<lambda>x \<psi>{x}]x \<equiv> \<phi>{x} & \<psi>{x})\<close>
      by(rule RM; auto intro!: GEN "\<equiv>I" "\<rightarrow>I" "cqt:2" "&I"
                        intro: "\<beta>\<leftarrow>C"
                         dest: "&E" "\<beta>\<rightarrow>C")
    ultimately AOT_show \<open>\<box>\<forall>x ([\<lambda>x \<phi>{x}]x & [\<lambda>x \<psi>{x}]x \<equiv> \<phi>{x} & \<psi>{x})\<close>
      using "\<rightarrow>E" by blast
  qed
qed

AOT_register_rigid_restricted_type
  Ordinary: \<open>O!\<kappa>\<close>
proof
  AOT_modally_strict {
    AOT_show \<open>\<exists>x O!x\<close>
      by (meson "B\<diamond>" "T\<diamond>" "o-objects-exist:1" "\<rightarrow>E")
  }
next
  AOT_modally_strict {
    AOT_show \<open>O!\<kappa> \<rightarrow> \<kappa>\<down>\<close> for \<kappa>
      by (simp add: "\<rightarrow>I" "cqt:5:a[1]"[axiom_inst, THEN "\<rightarrow>E", THEN "&E"(2)])
  }
next
  AOT_modally_strict {
    AOT_show \<open>\<forall>\<alpha>(O!\<alpha> \<rightarrow> \<box>O!\<alpha>)\<close>
      by (simp add: GEN "oa-facts:1")
  }
qed

AOT_register_variable_names
  Ordinary: u v r t s

text\<open>In PLM this is defined in the Natural Numbers chapter,
     but since it is helpful for stating the comprehension principles,
     we already define it here.\<close>
AOT_define eqE :: \<open>\<tau> \<Rightarrow> \<tau> \<Rightarrow> \<phi>\<close> (infixl \<open>\<equiv>\<^sub>E\<close> 50)
  eqE: \<open>F \<equiv>\<^sub>E G \<equiv>\<^sub>d\<^sub>f F\<down> & G\<down> & \<forall>u ([F]u \<equiv> [G]u)\<close>

text\<open>Derive existence claims about relations from the axioms.\<close>
AOT_theorem denotes_all: \<open>[\<lambda>x \<forall>G (\<box>G \<equiv>\<^sub>E F \<rightarrow> x[G])]\<down>\<close>
    and denotes_all_neg: \<open>[\<lambda>x \<forall>G (\<box>G \<equiv>\<^sub>E F \<rightarrow> \<not>x[G])]\<down>\<close>
proof -
  AOT_have Aux: \<open>\<forall>F (\<box>F \<equiv>\<^sub>E G \<rightarrow> (x[F] \<equiv> x[G])), \<not>(x[G] \<equiv> y[G])
    \<^bold>\<turnstile>\<^sub>\<box> \<exists>F([F]x & \<not>[F]y)\<close> for x y G
  proof -
    AOT_modally_strict {
    AOT_assume 0: \<open>\<forall>F (\<box>F \<equiv>\<^sub>E G \<rightarrow> (x[F] \<equiv> x[G]))\<close>
    AOT_assume G_prop: \<open>\<not>(x[G] \<equiv> y[G])\<close>
    {
      AOT_assume \<open>\<not>\<exists>F([F]x & \<not>[F]y)\<close>
      AOT_hence 0: \<open>\<forall>F \<not>([F]x & \<not>[F]y)\<close>
        by (metis "cqt-further:4" "\<rightarrow>E")
      AOT_have \<open>\<forall>F ([F]x \<equiv> [F]y)\<close>
      proof (rule GEN; rule "\<equiv>I"; rule "\<rightarrow>I")
        fix F
        AOT_assume \<open>[F]x\<close>
        moreover AOT_have \<open>\<not>([F]x & \<not>[F]y)\<close>
          using 0[THEN "\<forall>E"(2)] by blast
        ultimately AOT_show \<open>[F]y\<close>
          by (metis "&I" "raa-cor:1")
      next
        fix F
        AOT_assume \<open>[F]y\<close>
        AOT_hence \<open>\<not>[\<lambda>x \<not>[F]x]y\<close>
          by (metis "\<not>\<not>I" "\<beta>\<rightarrow>C"(2))
        moreover AOT_have \<open>\<not>([\<lambda>x \<not>[F]x]x & \<not>[\<lambda>x \<not>[F]x]y)\<close>
          apply (rule 0[THEN "\<forall>E"(1)]) by "cqt:2[lambda]"
        ultimately AOT_have 1: \<open>\<not>[\<lambda>x \<not>[F]x]x\<close>
          by (metis "&I" "raa-cor:3")
        {
          AOT_assume \<open>\<not>[F]x\<close>
          AOT_hence \<open>[\<lambda>x \<not>[F]x]x\<close>
            by (auto intro!: "\<beta>\<leftarrow>C"(1) "cqt:2")
          AOT_hence \<open>p & \<not>p\<close> for p
            using 1 by (metis "raa-cor:3")
        }
        AOT_thus \<open>[F]x\<close> by (metis "raa-cor:1")
      qed
      AOT_hence \<open>\<box>\<forall>F ([F]x \<equiv> [F]y)\<close>
        using "ind-nec"[THEN "\<rightarrow>E"] by blast
      AOT_hence \<open>\<forall>F \<box>([F]x \<equiv> [F]y)\<close>
        by (metis "CBF" "\<rightarrow>E")
    } note indistI = this
    {
      AOT_assume G_prop: \<open>x[G] & \<not>y[G]\<close>
      AOT_hence Ax: \<open>A!x\<close>
        using "&E"(1) "\<exists>I"(2) "\<rightarrow>E" "encoders-are-abstract" by blast

      {
        AOT_assume Ay: \<open>A!y\<close>
        {
          fix F
          {
            AOT_assume \<open>\<forall>u\<box>([F]u \<equiv> [G]u)\<close>
            AOT_hence \<open>\<box>\<forall>u([F]u \<equiv> [G]u)\<close>
              using "Ordinary.res-var-bound-reas[BF]"[THEN "\<rightarrow>E"] by simp
            AOT_hence \<open>\<box>F \<equiv>\<^sub>E G\<close>
              by (AOT_subst \<open>F \<equiv>\<^sub>E G\<close> \<open>\<forall>u ([F]u \<equiv> [G]u)\<close>)
                 (auto intro!: "eqE"[THEN "\<equiv>Df", THEN "\<equiv>S"(1), OF "&I"] "cqt:2")
            AOT_hence \<open>x[F] \<equiv> x[G]\<close>
              using 0[THEN "\<forall>E"(2)] "\<equiv>E" "\<rightarrow>E" by meson
            AOT_hence \<open>x[F]\<close>
              using G_prop "&E" "\<equiv>E" by blast
          }
          AOT_hence \<open>\<forall>u\<box>([F]u \<equiv> [G]u) \<rightarrow> x[F]\<close>
            by (rule "\<rightarrow>I")
        }
        AOT_hence xprop: \<open>\<forall>F(\<forall>u\<box>([F]u \<equiv> [G]u) \<rightarrow> x[F])\<close>
          by (rule GEN)
        moreover AOT_have yprop: \<open>\<not>\<forall>F(\<forall>u\<box>([F]u \<equiv> [G]u) \<rightarrow> y[F])\<close>
        proof (rule "raa-cor:2")
          AOT_assume \<open>\<forall>F(\<forall>u\<box>([F]u \<equiv> [G]u) \<rightarrow> y[F])\<close>
          AOT_hence \<open>\<forall>F(\<box>\<forall>u([F]u \<equiv> [G]u) \<rightarrow> y[F])\<close>
            apply (AOT_subst \<open>\<box>\<forall>u([F]u \<equiv> [G]u)\<close> \<open>\<forall>u\<box>([F]u \<equiv> [G]u)\<close> for: F)
            using "Ordinary.res-var-bound-reas[BF]"
                  "Ordinary.res-var-bound-reas[CBF]"
                  "intro-elim:2" apply presburger
            by simp
          AOT_hence A: \<open>\<forall>F(\<box>F \<equiv>\<^sub>E G \<rightarrow> y[F])\<close>
            by (AOT_subst \<open>F \<equiv>\<^sub>E G\<close> \<open>\<forall>u ([F]u \<equiv> [G]u)\<close> for: F)
               (auto intro!: "eqE"[THEN "\<equiv>Df", THEN "\<equiv>S"(1), OF "&I"] "cqt:2")
          moreover AOT_have \<open>\<box>G \<equiv>\<^sub>E G\<close>
            by (auto intro!: "eqE"[THEN "\<equiv>\<^sub>d\<^sub>fI"] "cqt:2" RN "&I" GEN "\<rightarrow>I" "\<equiv>I")
          ultimately AOT_have \<open>y[G]\<close> using "\<forall>E"(2) "\<rightarrow>E" by blast
          AOT_thus \<open>p & \<not>p\<close> for p using G_prop "&E" by (metis "raa-cor:3")
        qed
        AOT_have \<open>\<exists>F([F]x & \<not>[F]y)\<close>
        proof(rule "raa-cor:1")
          AOT_assume \<open>\<not>\<exists>F([F]x & \<not>[F]y)\<close>
          AOT_hence indist: \<open>\<forall>F \<box>([F]x \<equiv> [F]y)\<close> using indistI by blast
          AOT_have \<open>\<forall>F(\<forall>u\<box>([F]u \<equiv> [G]u) \<rightarrow> y[F])\<close>
            using indistinguishable_ord_enc_all[axiom_inst, THEN "\<rightarrow>E", OF "&I",
                      OF "&I", OF "&I", OF "cqt:2[const_var]"[axiom_inst],
                      OF Ax, OF Ay, OF indist, THEN "\<equiv>E"(1), OF xprop].
          AOT_thus \<open>\<forall>F(\<forall>u\<box>([F]u \<equiv> [G]u) \<rightarrow> y[F]) & \<not>\<forall>F(\<forall>u\<box>([F]u \<equiv> [G]u) \<rightarrow> y[F])\<close>
            using yprop "&I" by blast
        qed
      }
      moreover {
        AOT_assume notAy: \<open>\<not>A!y\<close>
        AOT_have \<open>\<exists>F([F]x & \<not>[F]y)\<close>
          apply (rule "\<exists>I"(1)[where \<tau>=\<open>\<guillemotleft>A!\<guillemotright>\<close>])
          using Ax notAy "&I" apply blast
          by (simp add: "oa-exist:2")
      }
      ultimately AOT_have \<open>\<exists>F([F]x & \<not>[F]y)\<close>
        by (metis "raa-cor:1")
    }
    moreover {
      AOT_assume G_prop: \<open>\<not>x[G] & y[G]\<close>
      AOT_hence Ay: \<open>A!y\<close>
        by (meson "&E"(2) "encoders-are-abstract" "existential:2[const_var]" "\<rightarrow>E")
      AOT_hence notOy: \<open>\<not>O!y\<close>
        using "\<equiv>E"(1) "oa-contingent:3" by blast
      {
        AOT_assume Ax: \<open>A!x\<close>
        {
          fix F
          {
            AOT_assume \<open>\<box>\<forall>u([F]u \<equiv> [G]u)\<close>
            AOT_hence \<open>\<box>F \<equiv>\<^sub>E G\<close>
              by (AOT_subst \<open>F \<equiv>\<^sub>E G\<close> \<open>\<forall>u([F]u \<equiv> [G]u)\<close>)
                 (auto intro!: "eqE"[THEN "\<equiv>Df", THEN "\<equiv>S"(1), OF "&I"] "cqt:2")
            AOT_hence \<open>x[F] \<equiv> x[G]\<close>
              using 0[THEN "\<forall>E"(2)] "\<equiv>E" "\<rightarrow>E" by meson
            AOT_hence \<open>\<not>x[F]\<close>
              using G_prop "&E" "\<equiv>E" by blast
          }
          AOT_hence \<open>\<box>\<forall>u([F]u \<equiv> [G]u) \<rightarrow> \<not>x[F]\<close>
            by (rule "\<rightarrow>I")
        }
        AOT_hence x_prop: \<open>\<forall>F(\<box>\<forall>u([F]u \<equiv> [G]u) \<rightarrow> \<not>x[F])\<close>
          by (rule GEN)
        AOT_have x_prop: \<open>\<not>\<exists>F(\<forall>u\<box>([F]u \<equiv> [G]u) & x[F])\<close>
        proof (rule "raa-cor:2")
          AOT_assume \<open>\<exists>F(\<forall>u \<box>([F]u \<equiv> [G]u) & x[F])\<close>
          then AOT_obtain F where F_prop: \<open>\<forall>u \<box>([F]u \<equiv> [G]u) & x[F]\<close>
            using "\<exists>E"[rotated] by blast
          AOT_have \<open>\<box>([F]u \<equiv> [G]u)\<close> for u
            using F_prop[THEN "&E"(1), THEN "Ordinary.\<forall>E"].
          AOT_hence \<open>\<forall>u \<box>([F]u \<equiv> [G]u)\<close>
            by (rule Ordinary.GEN)
          AOT_hence \<open>\<box>\<forall>u([F]u \<equiv> [G]u)\<close>
            by (metis "Ordinary.res-var-bound-reas[BF]" "\<rightarrow>E")
          AOT_hence \<open>\<not>x[F]\<close>
            using x_prop[THEN "\<forall>E"(2), THEN "\<rightarrow>E"] by blast
          AOT_thus \<open>p & \<not>p\<close> for p
            using F_prop[THEN "&E"(2)] by (metis "raa-cor:3")
        qed
        AOT_have y_prop: \<open>\<exists>F(\<forall>u \<box>([F]u \<equiv> [G]u) & y[F])\<close>
        proof (rule "raa-cor:1")
          AOT_assume \<open>\<not>\<exists>F (\<forall>u \<box>([F]u \<equiv> [G]u) & y[F])\<close>
          AOT_hence 0: \<open>\<forall>F \<not>(\<forall>u \<box>([F]u \<equiv> [G]u) & y[F])\<close>
            using "cqt-further:4"[THEN "\<rightarrow>E"] by blast
          {
            fix F
            {
              AOT_assume \<open>\<forall>u \<box>([F]u \<equiv> [G]u)\<close>
              AOT_hence \<open>\<not>y[F]\<close>
                using 0[THEN "\<forall>E"(2)] "&I" "raa-cor:1" by meson
            }
            AOT_hence \<open>(\<forall>u \<box>([F]u \<equiv> [G]u) \<rightarrow> \<not>y[F])\<close>
              by (rule "\<rightarrow>I")
          }
          AOT_hence A: \<open>\<forall>F(\<forall>u \<box>([F]u \<equiv> [G]u) \<rightarrow> \<not>y[F])\<close>
            by (rule GEN)
          moreover AOT_have \<open>\<forall>u \<box>([G]u \<equiv> [G]u)\<close>
            by (simp add: RN "oth-class-taut:3:a" "universal-cor" "\<rightarrow>I")
          ultimately AOT_have \<open>\<not>y[G]\<close>
            using "\<forall>E"(2) "\<rightarrow>E" by blast
          AOT_thus \<open>p & \<not>p\<close> for p
            using G_prop "&E" by (metis "raa-cor:3")
        qed
        AOT_have \<open>\<exists>F([F]x & \<not>[F]y)\<close>
        proof(rule "raa-cor:1")
          AOT_assume \<open>\<not>\<exists>F([F]x & \<not>[F]y)\<close>
          AOT_hence indist: \<open>\<forall>F \<box>([F]x \<equiv> [F]y)\<close>
            using indistI by blast
          AOT_thus \<open>\<exists>F(\<forall>u \<box>([F]u \<equiv> [G]u) & x[F]) & \<not>\<exists>F(\<forall>u \<box>([F]u \<equiv> [G]u) & x[F])\<close>
            using indistinguishable_ord_enc_ex[axiom_inst, THEN "\<rightarrow>E", OF "&I",
                    OF "&I", OF "&I", OF "cqt:2[const_var]"[axiom_inst],
                    OF Ax, OF Ay, OF indist, THEN "\<equiv>E"(2), OF y_prop]
                x_prop "&I" by blast
        qed
      }
      moreover {
        AOT_assume notAx: \<open>\<not>A!x\<close>
        AOT_hence Ox: \<open>O!x\<close>
          using "\<or>E"(3) "oa-exist:3" by blast
        AOT_have \<open>\<exists>F([F]x & \<not>[F]y)\<close>
          apply (rule "\<exists>I"(1)[where \<tau>=\<open>\<guillemotleft>O!\<guillemotright>\<close>])
          using Ox notOy "&I" apply blast
          by (simp add: "oa-exist:1")
      }
      ultimately AOT_have \<open>\<exists>F([F]x & \<not>[F]y)\<close>
        by (metis "raa-cor:1")
    }
    ultimately AOT_show \<open>\<exists>F([F]x & \<not>[F]y)\<close>
      using G_prop by (metis "&I" "\<rightarrow>I" "\<equiv>I" "raa-cor:1")
  }
  qed

  AOT_modally_strict {
    fix x y
    AOT_assume indist: \<open>\<forall>F ([F]x \<equiv> [F]y)\<close>
    AOT_hence nec_indist: \<open>\<box>\<forall>F ([F]x \<equiv> [F]y)\<close>
      using "ind-nec" "vdash-properties:10" by blast
    AOT_hence indist_nec: \<open>\<forall>F \<box>([F]x \<equiv> [F]y)\<close>
      using "CBF" "vdash-properties:10" by blast
    AOT_assume 0: \<open>\<forall>G (\<box>G \<equiv>\<^sub>E F \<rightarrow> x[G])\<close>
    AOT_hence 1: \<open>\<forall>G (\<box>\<forall>u ([G]u \<equiv> [F]u) \<rightarrow> x[G])\<close>
      by (AOT_subst (reverse) \<open>\<forall>u ([G]u \<equiv> [F]u)\<close> \<open>G \<equiv>\<^sub>E F\<close> for: G)
         (auto intro!: "eqE"[THEN "\<equiv>Df", THEN "\<equiv>S"(1), OF "&I"] "cqt:2")
    AOT_have \<open>x[F]\<close>
      by (safe intro!: 1[THEN "\<forall>E"(2), THEN "\<rightarrow>E"] GEN "\<rightarrow>I" RN "\<equiv>I")
    AOT_have \<open>\<forall>G (\<box>G \<equiv>\<^sub>E F \<rightarrow> y[G])\<close>
    proof(rule "raa-cor:1")
      AOT_assume \<open>\<not>\<forall>G (\<box>G \<equiv>\<^sub>E F \<rightarrow> y[G])\<close>
      AOT_hence \<open>\<exists>G \<not>(\<box>G \<equiv>\<^sub>E F \<rightarrow> y[G])\<close>
        using "cqt-further:2" "\<rightarrow>E" by blast
      then AOT_obtain G where G_prop: \<open>\<not>(\<box>G \<equiv>\<^sub>E F \<rightarrow> y[G])\<close>
        using "\<exists>E"[rotated] by blast
      AOT_hence 1: \<open>\<box>G \<equiv>\<^sub>E F & \<not>y[G]\<close>
        by (metis "\<equiv>E"(1) "oth-class-taut:1:b")
      AOT_have xG: \<open>x[G]\<close>
        using 0[THEN "\<forall>E"(2), THEN "\<rightarrow>E"] 1[THEN "&E"(1)] by blast
      AOT_hence \<open>x[G] & \<not>y[G]\<close>
        using 1[THEN "&E"(2)] "&I" by blast
      AOT_hence B: \<open>\<not>(x[G] \<equiv> y[G])\<close>
        using "&E"(2) "\<equiv>E"(1) "reductio-aa:1" xG by blast
      {
        fix H
        {
          AOT_assume \<open>\<box>H \<equiv>\<^sub>E G\<close>
          AOT_hence \<open>\<box>(H \<equiv>\<^sub>E G & G \<equiv>\<^sub>E F)\<close>
            using 1 by (metis "KBasic:3" "con-dis-i-e:1" "con-dis-i-e:2:a"
                              "intro-elim:3:b")
          moreover AOT_have \<open>\<box>(H \<equiv>\<^sub>E G & G \<equiv>\<^sub>E F) \<rightarrow> \<box>(H \<equiv>\<^sub>E F)\<close>
          proof(rule RM)
            AOT_modally_strict {
              AOT_show \<open>H \<equiv>\<^sub>E G & G \<equiv>\<^sub>E F \<rightarrow> H \<equiv>\<^sub>E F\<close>
              proof (safe intro!: "\<rightarrow>I" "eqE"[THEN "\<equiv>\<^sub>d\<^sub>fI"] "&I" "cqt:2" Ordinary.GEN)
                fix u
                AOT_assume \<open>H \<equiv>\<^sub>E G & G \<equiv>\<^sub>E F\<close>
                AOT_hence \<open>\<forall>u ([H]u \<equiv> [G]u)\<close> and \<open>\<forall>u ([G]u \<equiv> [F]u)\<close>
                  using "eqE"[THEN "\<equiv>\<^sub>d\<^sub>fE"] "&E" by blast+
                AOT_thus \<open>[H]u \<equiv> [F]u\<close>
                  by (auto dest!: "Ordinary.\<forall>E" dest: "\<equiv>E")
              qed
            }
          qed
          ultimately AOT_have \<open>\<box>(H \<equiv>\<^sub>E F)\<close>
            using "\<rightarrow>E" by blast
          AOT_hence \<open>x[H]\<close>
            using 0[THEN "\<forall>E"(2)] "\<rightarrow>E" by blast
          AOT_hence \<open>x[H] \<equiv> x[G]\<close>
            using xG "\<equiv>I" "\<rightarrow>I" by blast
        }
        AOT_hence \<open>\<box>H \<equiv>\<^sub>E G \<rightarrow> (x[H] \<equiv> x[G])\<close> by (rule "\<rightarrow>I")
      }
      AOT_hence A: \<open>\<forall>H(\<box>H \<equiv>\<^sub>E G \<rightarrow> (x[H] \<equiv> x[G]))\<close>
        by (rule GEN)
      then AOT_obtain F where F_prop: \<open>[F]x & \<not>[F]y\<close>
        using Aux[OF A, OF B] "\<exists>E"[rotated] by blast
      moreover AOT_have \<open>[F]y\<close>
        using indist[THEN "\<forall>E"(2), THEN "\<equiv>E"(1), OF F_prop[THEN "&E"(1)]].
      AOT_thus \<open>p & \<not>p\<close> for p
        using F_prop[THEN "&E"(2)] by (metis "raa-cor:3")
    qed
  } note 0 = this
  AOT_modally_strict {
    fix x y
    AOT_assume \<open>\<forall>F ([F]x \<equiv> [F]y)\<close>
    moreover AOT_have \<open>\<forall>F ([F]y \<equiv> [F]x)\<close>
      by (metis calculation "cqt-basic:11" "\<equiv>E"(2))
    ultimately AOT_have \<open>\<forall>G (\<box>G \<equiv>\<^sub>E F \<rightarrow> x[G]) \<equiv> \<forall>G (\<box>G \<equiv>\<^sub>E F \<rightarrow> y[G])\<close>
      using 0 "\<equiv>I" "\<rightarrow>I" by auto
  } note 1 = this
  AOT_show \<open>[\<lambda>x \<forall>G (\<box>G \<equiv>\<^sub>E F \<rightarrow> x[G])]\<down>\<close>
    by (safe intro!: RN GEN "\<rightarrow>I" 1 "kirchner-thm:2"[THEN "\<equiv>E"(2)])

  AOT_modally_strict {
    fix x y
    AOT_assume indist: \<open>\<forall>F ([F]x \<equiv> [F]y)\<close>
    AOT_hence nec_indist: \<open>\<box>\<forall>F ([F]x \<equiv> [F]y)\<close>
      using "ind-nec" "vdash-properties:10" by blast
    AOT_hence indist_nec: \<open>\<forall>F \<box>([F]x \<equiv> [F]y)\<close>
      using "CBF" "vdash-properties:10" by blast
    AOT_assume 0: \<open>\<forall>G (\<box>G \<equiv>\<^sub>E F \<rightarrow> \<not>x[G])\<close>
    AOT_hence 1: \<open>\<forall>G (\<box>\<forall>u ([G]u \<equiv> [F]u) \<rightarrow> \<not>x[G])\<close>
      by (AOT_subst (reverse) \<open>\<forall>u ([G]u \<equiv> [F]u)\<close> \<open>G \<equiv>\<^sub>E F\<close> for: G)
         (auto intro!: "eqE"[THEN "\<equiv>Df", THEN "\<equiv>S"(1), OF "&I"] "cqt:2")
    AOT_have \<open>\<not>x[F]\<close>
      by (safe intro!: 1[THEN "\<forall>E"(2), THEN "\<rightarrow>E"] GEN "\<rightarrow>I" RN "\<equiv>I")
    AOT_have \<open>\<forall>G (\<box>G \<equiv>\<^sub>E F \<rightarrow> \<not>y[G])\<close>
    proof(rule "raa-cor:1")
      AOT_assume \<open>\<not>\<forall>G (\<box>G \<equiv>\<^sub>E F \<rightarrow> \<not>y[G])\<close>
      AOT_hence \<open>\<exists>G \<not>(\<box>G \<equiv>\<^sub>E F \<rightarrow> \<not>y[G])\<close>
        using "cqt-further:2" "\<rightarrow>E" by blast
      then AOT_obtain G where G_prop: \<open>\<not>(\<box>G \<equiv>\<^sub>E F \<rightarrow> \<not>y[G])\<close>
        using "\<exists>E"[rotated] by blast
      AOT_hence 1: \<open>\<box>G \<equiv>\<^sub>E F & \<not>\<not>y[G]\<close>
        by (metis "\<equiv>E"(1) "oth-class-taut:1:b")
      AOT_hence yG: \<open>y[G]\<close>
        using G_prop "\<rightarrow>I" "raa-cor:3" by blast
      moreover AOT_hence 12: \<open>\<not>x[G]\<close>
        using 0[THEN "\<forall>E"(2), THEN "\<rightarrow>E"] 1[THEN "&E"(1)] by blast
      ultimately AOT_have \<open>\<not>x[G] & y[G]\<close>
        using "&I" by blast
      AOT_hence B: \<open>\<not>(x[G] \<equiv> y[G])\<close>
        by (metis "12" "\<equiv>E"(3) "raa-cor:3" yG)
      {
        fix H
        {
          AOT_assume 3: \<open>\<box>H \<equiv>\<^sub>E G\<close>
          AOT_hence \<open>\<box>(H \<equiv>\<^sub>E G & G \<equiv>\<^sub>E F)\<close>
            using 1
            by (metis "KBasic:3" "con-dis-i-e:1" "\<rightarrow>I" "intro-elim:3:b"
                      "reductio-aa:1" G_prop)
          moreover AOT_have \<open>\<box>(H \<equiv>\<^sub>E G & G \<equiv>\<^sub>E F) \<rightarrow> \<box>(H \<equiv>\<^sub>E F)\<close>
          proof (rule RM)
            AOT_modally_strict {
              AOT_show \<open>H \<equiv>\<^sub>E G & G \<equiv>\<^sub>E F \<rightarrow> H \<equiv>\<^sub>E F\<close>
              proof (safe intro!: "\<rightarrow>I" "eqE"[THEN "\<equiv>\<^sub>d\<^sub>fI"] "&I" "cqt:2" Ordinary.GEN)
                fix u
                AOT_assume \<open>H \<equiv>\<^sub>E G & G \<equiv>\<^sub>E F\<close>
                AOT_hence \<open>\<forall>u ([H]u \<equiv> [G]u)\<close> and \<open>\<forall>u ([G]u \<equiv> [F]u)\<close>
                  using "eqE"[THEN "\<equiv>\<^sub>d\<^sub>fE"] "&E" by blast+
                AOT_thus \<open>[H]u \<equiv> [F]u\<close>
                  by (auto dest!: "Ordinary.\<forall>E" dest: "\<equiv>E")
              qed
            }
          qed
          ultimately AOT_have \<open>\<box>(H \<equiv>\<^sub>E F)\<close>
            using "\<rightarrow>E" by blast
          AOT_hence \<open>\<not>x[H]\<close>
            using 0[THEN "\<forall>E"(2)] "\<rightarrow>E" by blast
          AOT_hence \<open>x[H] \<equiv> x[G]\<close>
            using 12 "\<equiv>I" "\<rightarrow>I" by (metis "raa-cor:3")
        }
        AOT_hence \<open>\<box>H \<equiv>\<^sub>E G \<rightarrow> (x[H] \<equiv> x[G])\<close>
          by (rule "\<rightarrow>I")
      }
      AOT_hence A: \<open>\<forall>H(\<box>H \<equiv>\<^sub>E G \<rightarrow> (x[H] \<equiv> x[G]))\<close>
        by (rule GEN)
      then AOT_obtain F where F_prop: \<open>[F]x & \<not>[F]y\<close>
        using Aux[OF A, OF B] "\<exists>E"[rotated] by blast
      moreover AOT_have \<open>[F]y\<close>
        using indist[THEN "\<forall>E"(2), THEN "\<equiv>E"(1), OF F_prop[THEN "&E"(1)]].
      AOT_thus \<open>p & \<not>p\<close> for p
        using F_prop[THEN "&E"(2)] by (metis "raa-cor:3")
    qed
  } note 0 = this
  AOT_modally_strict {
    fix x y
    AOT_assume \<open>\<forall>F ([F]x \<equiv> [F]y)\<close>
    moreover AOT_have \<open>\<forall>F ([F]y \<equiv> [F]x)\<close>
      by (metis calculation "cqt-basic:11" "\<equiv>E"(2))
    ultimately AOT_have \<open>\<forall>G (\<box>G \<equiv>\<^sub>E F \<rightarrow> \<not>x[G]) \<equiv> \<forall>G (\<box>G \<equiv>\<^sub>E F \<rightarrow> \<not>y[G])\<close>
      using 0 "\<equiv>I" "\<rightarrow>I" by auto
  } note 1 = this
  AOT_show \<open>[\<lambda>x \<forall>G (\<box>G \<equiv>\<^sub>E F \<rightarrow> \<not>x[G])]\<down>\<close>
    by (safe intro!: RN GEN "\<rightarrow>I" 1 "kirchner-thm:2"[THEN "\<equiv>E"(2)])
qed

text\<open>Reformulate the existence claims in terms of their negations.\<close>

AOT_theorem denotes_ex: \<open>[\<lambda>x \<exists>G (\<box>G \<equiv>\<^sub>E F & x[G])]\<down>\<close>
proof (rule "safe-ext"[axiom_inst, THEN "\<rightarrow>E", OF "&I"])
  AOT_show \<open>[\<lambda>x \<not>\<forall>G (\<box>G \<equiv>\<^sub>E F \<rightarrow> \<not>x[G])]\<down>\<close>
    using denotes_all_neg[THEN negation_denotes[THEN "\<rightarrow>E"]].
next
  AOT_show \<open>\<box>\<forall>x (\<not>\<forall>G (\<box>G \<equiv>\<^sub>E F \<rightarrow> \<not>x[G]) \<equiv> \<exists>G (\<box>G \<equiv>\<^sub>E F & x[G]))\<close>
    by (AOT_subst  \<open>\<box>G \<equiv>\<^sub>E F & x[G]\<close> \<open>\<not>(\<box>G \<equiv>\<^sub>E F \<rightarrow> \<not>x[G])\<close> for: G x)
       (auto simp: "conventions:1" "rule-eq-df:1"
             intro: "oth-class-taut:4:b"[THEN "\<equiv>E"(2)]
                    "intro-elim:3:f"[OF "cqt-further:3", OF "oth-class-taut:3:b"]
             intro!: RN GEN)
qed

AOT_theorem denotes_ex_neg: \<open>[\<lambda>x \<exists>G (\<box>G \<equiv>\<^sub>E F & \<not>x[G])]\<down>\<close>
proof (rule "safe-ext"[axiom_inst, THEN "\<rightarrow>E", OF "&I"])
  AOT_show \<open>[\<lambda>x \<not>\<forall>G (\<box>G \<equiv>\<^sub>E F \<rightarrow> x[G])]\<down>\<close>
    using denotes_all[THEN negation_denotes[THEN "\<rightarrow>E"]].
next
  AOT_show \<open>\<box>\<forall>x (\<not>\<forall>G (\<box>G \<equiv>\<^sub>E F \<rightarrow> x[G]) \<equiv> \<exists>G (\<box>G \<equiv>\<^sub>E F & \<not>x[G]))\<close>
    by (AOT_subst (reverse) \<open>\<box>G \<equiv>\<^sub>E F & \<not>x[G]\<close> \<open>\<not>(\<box>G \<equiv>\<^sub>E F \<rightarrow> x[G])\<close> for: G x)
       (auto simp: "oth-class-taut:1:b"
             intro: "oth-class-taut:4:b"[THEN "\<equiv>E"(2)]
                    "intro-elim:3:f"[OF "cqt-further:3", OF "oth-class-taut:3:b"]
             intro!: RN GEN)
qed

text\<open>Derive comprehension principles.\<close>

AOT_theorem Comprehension_1:
  shows \<open>\<box>\<forall>F\<forall>G(\<box>G \<equiv>\<^sub>E F \<rightarrow> (\<phi>{F} \<equiv> \<phi>{G})) \<rightarrow> [\<lambda>x \<exists>F (\<phi>{F} & x[F])]\<down>\<close>
proof(rule "\<rightarrow>I")
  AOT_assume assm: \<open>\<box>\<forall>F\<forall>G(\<box>G \<equiv>\<^sub>E F \<rightarrow> (\<phi>{F} \<equiv> \<phi>{G}))\<close>
  AOT_modally_strict {
    fix x y
    AOT_assume 0: \<open>\<forall>F\<forall>G (\<box>G \<equiv>\<^sub>E F \<rightarrow> (\<phi>{F} \<equiv> \<phi>{G}))\<close>
    AOT_assume indist: \<open>\<forall>F ([F]x \<equiv> [F]y)\<close>
    AOT_assume x_prop: \<open>\<exists>F (\<phi>{F} & x[F])\<close>
    then AOT_obtain F where F_prop: \<open>\<phi>{F} & x[F]\<close>
      using "\<exists>E"[rotated] by blast
    AOT_hence \<open>\<box>F \<equiv>\<^sub>E F & x[F]\<close>
      by (auto intro!: RN eqE[THEN "\<equiv>\<^sub>d\<^sub>fI"] "&I" "cqt:2" GEN "\<equiv>I" "\<rightarrow>I" dest: "&E")
    AOT_hence \<open>\<exists>G(\<box>G \<equiv>\<^sub>E F & x[G])\<close>
      by (rule "\<exists>I")
    AOT_hence \<open>[\<lambda>x \<exists>G(\<box>G \<equiv>\<^sub>E F & x[G])]x\<close>
      by (safe intro!: "\<beta>\<leftarrow>C" denotes_ex "cqt:2")
    AOT_hence \<open>[\<lambda>x \<exists>G(\<box>G \<equiv>\<^sub>E F & x[G])]y\<close>
      using indist[THEN "\<forall>E"(1), OF denotes_ex, THEN "\<equiv>E"(1)] by blast
    AOT_hence \<open>\<exists>G(\<box>G \<equiv>\<^sub>E F & y[G])\<close>
      using "\<beta>\<rightarrow>C" by blast
    then AOT_obtain G where \<open>\<box>G \<equiv>\<^sub>E F & y[G]\<close>
      using "\<exists>E"[rotated] by blast
    AOT_hence \<open>\<phi>{G} & y[G]\<close>
      using 0[THEN "\<forall>E"(2), THEN "\<forall>E"(2), THEN "\<rightarrow>E", THEN "\<equiv>E"(1)]
            F_prop[THEN "&E"(1)] "&E" "&I" by blast
    AOT_hence \<open>\<exists>F (\<phi>{F} & y[F])\<close>
      by (rule "\<exists>I")
  } note 1 = this
  AOT_modally_strict {
    AOT_assume 0: \<open>\<forall>F\<forall>G (\<box>G \<equiv>\<^sub>E F \<rightarrow> (\<phi>{F} \<equiv> \<phi>{G}))\<close>
    {
      fix x y
      {
        AOT_assume \<open>\<forall>F ([F]x \<equiv> [F]y)\<close>
        moreover AOT_have \<open>\<forall>F ([F]y \<equiv> [F]x)\<close>
          by (metis calculation "cqt-basic:11" "\<equiv>E"(1))
        ultimately AOT_have \<open>\<exists>F (\<phi>{F} & x[F]) \<equiv> \<exists>F (\<phi>{F} & y[F])\<close>
          using 0 1[OF 0] "\<equiv>I" "\<rightarrow>I" by simp
      }
      AOT_hence \<open>\<forall>F ([F]x \<equiv> [F]y) \<rightarrow> (\<exists>F (\<phi>{F} & x[F]) \<equiv> \<exists>F (\<phi>{F} & y[F]))\<close>
        using "\<rightarrow>I" by blast
    }
    AOT_hence \<open>\<forall>x\<forall>y(\<forall>F ([F]x \<equiv> [F]y) \<rightarrow> (\<exists>F (\<phi>{F} & x[F]) \<equiv>  \<exists>F (\<phi>{F} & y[F])))\<close>
      by (auto intro!: GEN)
  } note 1 = this
  AOT_hence \<open>\<^bold>\<turnstile>\<^sub>\<box> \<forall>F\<forall>G (\<box>G \<equiv>\<^sub>E F \<rightarrow> (\<phi>{F} \<equiv> \<phi>{G})) \<rightarrow>
                \<forall>x\<forall>y(\<forall>F ([F]x \<equiv> [F]y) \<rightarrow> (\<exists>F (\<phi>{F} & x[F]) \<equiv> \<exists>F (\<phi>{F} & y[F])))\<close>
    by (rule "\<rightarrow>I")
  AOT_hence \<open>\<box>\<forall>F\<forall>G (\<box>G \<equiv>\<^sub>E F \<rightarrow> (\<phi>{F} \<equiv> \<phi>{G})) \<rightarrow>
             \<box>\<forall>x\<forall>y(\<forall>F ([F]x \<equiv> [F]y) \<rightarrow> (\<exists>F (\<phi>{F} & x[F]) \<equiv> \<exists>F (\<phi>{F} & y[F])))\<close>
    by (rule RM)
  AOT_hence \<open>\<box>\<forall>x\<forall>y(\<forall>F ([F]x \<equiv> [F]y) \<rightarrow> (\<exists>F (\<phi>{F} & x[F]) \<equiv> \<exists>F (\<phi>{F} & y[F])))\<close>
    using "\<rightarrow>E" assm by blast
  AOT_thus \<open>[\<lambda>x \<exists>F (\<phi>{F} & x[F])]\<down>\<close>
    by (safe intro!: "kirchner-thm:2"[THEN "\<equiv>E"(2)])
qed

AOT_theorem Comprehension_2:
  shows \<open>\<box>\<forall>F\<forall>G(\<box>G \<equiv>\<^sub>E F \<rightarrow> (\<phi>{F} \<equiv> \<phi>{G})) \<rightarrow> [\<lambda>x \<exists>F (\<phi>{F} & \<not>x[F])]\<down>\<close>
proof(rule "\<rightarrow>I")
  AOT_assume assm: \<open>\<box>\<forall>F\<forall>G(\<box>G \<equiv>\<^sub>E F \<rightarrow> (\<phi>{F} \<equiv> \<phi>{G}))\<close>
  AOT_modally_strict {
    fix x y
    AOT_assume 0: \<open>\<forall>F\<forall>G (\<box>G \<equiv>\<^sub>E F \<rightarrow> (\<phi>{F} \<equiv> \<phi>{G}))\<close>
    AOT_assume indist: \<open>\<forall>F ([F]x \<equiv> [F]y)\<close>
    AOT_assume x_prop: \<open>\<exists>F (\<phi>{F} & \<not>x[F])\<close>
    then AOT_obtain F where F_prop: \<open>\<phi>{F} & \<not>x[F]\<close>
      using "\<exists>E"[rotated] by blast
    AOT_hence \<open>\<box>F \<equiv>\<^sub>E F & \<not>x[F]\<close>
      by (auto intro!: RN eqE[THEN "\<equiv>\<^sub>d\<^sub>fI"] "&I" "cqt:2" GEN "\<equiv>I" "\<rightarrow>I" dest: "&E")
    AOT_hence \<open>\<exists>G(\<box>G \<equiv>\<^sub>E F & \<not>x[G])\<close>
      by (rule "\<exists>I")
    AOT_hence \<open>[\<lambda>x \<exists>G(\<box>G \<equiv>\<^sub>E F & \<not>x[G])]x\<close>
      by (safe intro!: "\<beta>\<leftarrow>C" denotes_ex_neg "cqt:2")
    AOT_hence \<open>[\<lambda>x \<exists>G(\<box>G \<equiv>\<^sub>E F & \<not>x[G])]y\<close>
      using indist[THEN "\<forall>E"(1), OF denotes_ex_neg, THEN "\<equiv>E"(1)] by blast
    AOT_hence \<open>\<exists>G(\<box>G \<equiv>\<^sub>E F & \<not>y[G])\<close>
      using "\<beta>\<rightarrow>C" by blast
    then AOT_obtain G where \<open>\<box>G \<equiv>\<^sub>E F & \<not>y[G]\<close>
      using "\<exists>E"[rotated] by blast
    AOT_hence \<open>\<phi>{G} & \<not>y[G]\<close>
      using 0[THEN "\<forall>E"(2), THEN "\<forall>E"(2), THEN "\<rightarrow>E", THEN "\<equiv>E"(1)]
            F_prop[THEN "&E"(1)] "&E" "&I" by blast
    AOT_hence \<open>\<exists>F (\<phi>{F} & \<not>y[F])\<close>
      by (rule "\<exists>I")
  } note 1 = this
  AOT_modally_strict {
    AOT_assume 0: \<open>\<forall>F\<forall>G (\<box>G \<equiv>\<^sub>E F \<rightarrow> (\<phi>{F} \<equiv> \<phi>{G}))\<close>
    {
      fix x y
      {
        AOT_assume \<open>\<forall>F ([F]x \<equiv> [F]y)\<close>
        moreover AOT_have \<open>\<forall>F ([F]y \<equiv> [F]x)\<close>
          by (metis calculation "cqt-basic:11" "\<equiv>E"(1))
        ultimately AOT_have \<open>\<exists>F (\<phi>{F} & \<not>x[F]) \<equiv> \<exists>F (\<phi>{F} & \<not>y[F])\<close>
          using 0 1[OF 0] "\<equiv>I" "\<rightarrow>I" by simp
      }
      AOT_hence \<open>\<forall>F ([F]x \<equiv> [F]y) \<rightarrow> (\<exists>F (\<phi>{F} & \<not>x[F]) \<equiv> \<exists>F (\<phi>{F} & \<not>y[F]))\<close>
        using "\<rightarrow>I" by blast
    }
    AOT_hence \<open>\<forall>x\<forall>y(\<forall>F ([F]x \<equiv> [F]y) \<rightarrow> (\<exists>F (\<phi>{F} & \<not>x[F]) \<equiv>  \<exists>F (\<phi>{F} & \<not>y[F])))\<close>
      by (auto intro!: GEN)
  } note 1 = this
  AOT_hence \<open>\<^bold>\<turnstile>\<^sub>\<box> \<forall>F\<forall>G (\<box>G \<equiv>\<^sub>E F \<rightarrow> (\<phi>{F} \<equiv> \<phi>{G})) \<rightarrow>
                \<forall>x\<forall>y(\<forall>F ([F]x \<equiv> [F]y) \<rightarrow> (\<exists>F (\<phi>{F} & \<not>x[F]) \<equiv> \<exists>F (\<phi>{F} & \<not>y[F])))\<close>
    by (rule "\<rightarrow>I")
  AOT_hence \<open>\<box>\<forall>F\<forall>G (\<box>G \<equiv>\<^sub>E F \<rightarrow> (\<phi>{F} \<equiv> \<phi>{G})) \<rightarrow>
             \<box>\<forall>x\<forall>y(\<forall>F ([F]x \<equiv> [F]y) \<rightarrow> (\<exists>F (\<phi>{F} & \<not>x[F]) \<equiv> \<exists>F (\<phi>{F} & \<not>y[F])))\<close>
    by (rule RM)
  AOT_hence \<open>\<box>\<forall>x\<forall>y(\<forall>F ([F]x \<equiv> [F]y) \<rightarrow> (\<exists>F (\<phi>{F} & \<not>x[F]) \<equiv> \<exists>F (\<phi>{F} & \<not>y[F])))\<close>
    using "\<rightarrow>E" assm by blast
  AOT_thus \<open>[\<lambda>x \<exists>F (\<phi>{F} & \<not>x[F])]\<down>\<close>
    by (safe intro!: "kirchner-thm:2"[THEN "\<equiv>E"(2)])
qed

text\<open>Derived variants of the comprehension principles above.\<close>

AOT_theorem Comprehension_1':
  shows \<open>\<box>\<forall>F\<forall>G(\<box>G \<equiv>\<^sub>E F \<rightarrow> (\<phi>{F} \<equiv> \<phi>{G})) \<rightarrow> [\<lambda>x \<forall>F (x[F] \<rightarrow> \<phi>{F})]\<down>\<close>
proof(rule "\<rightarrow>I")
  AOT_assume \<open>\<box>\<forall>F\<forall>G(\<box>G \<equiv>\<^sub>E F \<rightarrow> (\<phi>{F} \<equiv> \<phi>{G}))\<close>
  AOT_hence 0: \<open>\<box>\<forall>F\<forall>G(\<box>G \<equiv>\<^sub>E F \<rightarrow> (\<not>\<phi>{F} \<equiv> \<not>\<phi>{G}))\<close>
    by (AOT_subst (reverse) \<open>\<not>\<phi>{F} \<equiv> \<not>\<phi>{G}\<close> \<open>\<phi>{F} \<equiv> \<phi>{G}\<close> for: F G)
       (auto simp: "oth-class-taut:4:b")
  AOT_show \<open>[\<lambda>x \<forall>F (x[F] \<rightarrow> \<phi>{F})]\<down>\<close>
  proof(rule "safe-ext"[axiom_inst, THEN "\<rightarrow>E", OF "&I"])
    AOT_show \<open>[\<lambda>x \<not>\<exists>F(\<not>\<phi>{F} & x[F])]\<down>\<close>
      using Comprehension_1[THEN "\<rightarrow>E", OF 0, THEN negation_denotes[THEN "\<rightarrow>E"]].
  next
    AOT_show \<open>\<box>\<forall>x (\<not>\<exists>F (\<not>\<phi>{F} & x[F]) \<equiv> \<forall>F (x[F] \<rightarrow> \<phi>{F}))\<close>
      by (AOT_subst (reverse) \<open>\<not>\<phi>{F} & x[F]\<close> \<open>\<not>(x[F] \<rightarrow> \<phi>{F})\<close> for: F x)
         (auto simp: "oth-class-taut:1:b"[THEN "intro-elim:3:e",
                                          OF "oth-class-taut:2:a"]
             intro: "intro-elim:3:f"[OF "cqt-further:3", OF "oth-class-taut:3:a",
                                     symmetric]
             intro!: RN GEN)
  qed
qed

AOT_theorem Comprehension_2':
  shows \<open>\<box>\<forall>F\<forall>G(\<box>G \<equiv>\<^sub>E F \<rightarrow> (\<phi>{F} \<equiv> \<phi>{G})) \<rightarrow> [\<lambda>x \<forall>F (\<phi>{F} \<rightarrow> x[F])]\<down>\<close>
proof(rule "\<rightarrow>I")
  AOT_assume 0: \<open>\<box>\<forall>F\<forall>G(\<box>G \<equiv>\<^sub>E F \<rightarrow> (\<phi>{F} \<equiv> \<phi>{G}))\<close>
  AOT_show \<open>[\<lambda>x \<forall>F (\<phi>{F} \<rightarrow> x[F])]\<down>\<close>
  proof(rule "safe-ext"[axiom_inst, THEN "\<rightarrow>E", OF "&I"])
    AOT_show \<open>[\<lambda>x \<not>\<exists>F(\<phi>{F} & \<not>x[F])]\<down>\<close>
      using Comprehension_2[THEN "\<rightarrow>E", OF 0, THEN negation_denotes[THEN "\<rightarrow>E"]].
  next
    AOT_show \<open>\<box>\<forall>x (\<not>\<exists>F (\<phi>{F} & \<not>x[F]) \<equiv> \<forall>F (\<phi>{F} \<rightarrow> x[F]))\<close>
      by (AOT_subst (reverse) \<open>\<phi>{F} & \<not>x[F]\<close> \<open>\<not>(\<phi>{F} \<rightarrow> x[F])\<close> for: F x)
         (auto simp: "oth-class-taut:1:b"
             intro: "intro-elim:3:f"[OF "cqt-further:3", OF "oth-class-taut:3:a",
                                     symmetric]
             intro!: RN GEN)
  qed
qed

text\<open>Derive a combined comprehension principles.\<close>

AOT_theorem Comprehension_3:
  \<open>\<box>\<forall>F\<forall>G(\<box>G \<equiv>\<^sub>E F \<rightarrow> (\<phi>{F} \<equiv> \<phi>{G})) \<rightarrow> [\<lambda>x \<forall>F (x[F] \<equiv> \<phi>{F})]\<down>\<close>
proof(rule "\<rightarrow>I")
  AOT_assume 0: \<open>\<box>\<forall>F\<forall>G(\<box>G \<equiv>\<^sub>E F \<rightarrow> (\<phi>{F} \<equiv> \<phi>{G}))\<close>
  AOT_show \<open>[\<lambda>x \<forall>F (x[F] \<equiv> \<phi>{F})]\<down>\<close>
  proof(rule "safe-ext"[axiom_inst, THEN "\<rightarrow>E", OF "&I"])
    AOT_show \<open>[\<lambda>x \<forall>F (x[F] \<rightarrow> \<phi>{F}) & \<forall>F (\<phi>{F} \<rightarrow> x[F])]\<down>\<close>
      by (safe intro!: conjunction_denotes[THEN "\<rightarrow>E", OF "&I"]
                       Comprehension_1'[THEN "\<rightarrow>E"]
                       Comprehension_2'[THEN "\<rightarrow>E"] 0)
  next
    AOT_show \<open>\<box>\<forall>x (\<forall>F (x[F] \<rightarrow> \<phi>{F}) & \<forall>F (\<phi>{F} \<rightarrow> x[F]) \<equiv> \<forall>F (x[F] \<equiv> \<phi>{F}))\<close>
      by (auto intro!: RN GEN "\<equiv>I" "\<rightarrow>I" "&I" dest: "&E" "\<forall>E"(2) "\<rightarrow>E" "\<equiv>E"(1,2))
  qed
qed

notepad
begin
text\<open>Verify that the original axioms are equivalent to @{thm denotes_ex}
     and @{thm denotes_ex_neg}.\<close>
AOT_modally_strict {
  fix x y H
  AOT_have \<open>A!x & A!y & \<forall>F \<box>([F]x \<equiv> [F]y) \<rightarrow>
  (\<forall>G (\<forall>z (O!z \<rightarrow> \<box>([G]z \<equiv> [H]z)) \<rightarrow> x[G]) \<equiv>
   \<forall>G (\<forall>z (O!z \<rightarrow> \<box>([G]z \<equiv> [H]z)) \<rightarrow> y[G]))\<close>
  proof(rule "\<rightarrow>I")
    {
      fix x y
      AOT_assume \<open>A!x\<close>
      AOT_assume \<open>A!y\<close>
      AOT_assume indist: \<open>\<forall>F \<box>([F]x \<equiv> [F]y)\<close>
      AOT_assume \<open>\<forall>G (\<forall>u \<box>([G]u \<equiv> [H]u) \<rightarrow> x[G])\<close>
      AOT_hence \<open>\<forall>G (\<box>\<forall>u ([G]u \<equiv> [H]u) \<rightarrow> x[G])\<close>
        using "Ordinary.res-var-bound-reas[BF]" "Ordinary.res-var-bound-reas[CBF]"
              "intro-elim:2"
        by (AOT_subst \<open>\<box>\<forall>u ([G]u \<equiv> [H]u)\<close> \<open>\<forall>u \<box>([G]u \<equiv> [H]u)\<close> for: G) auto
      AOT_hence \<open>\<forall>G (\<box>G \<equiv>\<^sub>E H \<rightarrow> x[G])\<close>
        by (AOT_subst \<open>G \<equiv>\<^sub>E H\<close> \<open>\<forall>u ([G]u \<equiv> [H]u)\<close> for: G)
            (safe intro!: "eqE"[THEN "\<equiv>Df", THEN "\<equiv>S"(1), OF "&I"] "cqt:2")
      AOT_hence \<open>\<not>\<exists>G (\<box>G \<equiv>\<^sub>E H & \<not>x[G])\<close>
        by (AOT_subst (reverse) \<open>(\<box>G \<equiv>\<^sub>E H & \<not>x[G])\<close> \<open>\<not>(\<box>G \<equiv>\<^sub>E H \<rightarrow> x[G])\<close> for: G)
           (auto simp: "oth-class-taut:1:b" "cqt-further:3"[THEN "\<equiv>E"(1)])
      AOT_hence \<open>\<not>[\<lambda>x \<exists>G (\<box>G \<equiv>\<^sub>E H & \<not>x[G])]x\<close>
        by (auto intro: "\<beta>\<rightarrow>C")
      AOT_hence \<open>\<not>[\<lambda>x \<exists>G (\<box>G \<equiv>\<^sub>E H & \<not>x[G])]y\<close>
        using indist[THEN "\<forall>E"(1), OF denotes_ex_neg,
                     THEN "qml:2"[axiom_inst, THEN "\<rightarrow>E"],
                     THEN "\<equiv>E"(3)] by blast
      AOT_hence \<open>\<not>\<exists>G (\<box>G \<equiv>\<^sub>E H & \<not>y[G])\<close>
        by (safe intro!: "\<beta>\<leftarrow>C" denotes_ex_neg "cqt:2")
      AOT_hence \<open>\<forall>G \<not>(\<box>G \<equiv>\<^sub>E H & \<not>y[G])\<close>
        using "cqt-further:4"[THEN "\<rightarrow>E"] by blast
      AOT_hence \<open>\<forall>G(\<box>G \<equiv>\<^sub>E H \<rightarrow> y[G])\<close>
        by (AOT_subst \<open>\<box>G \<equiv>\<^sub>E H \<rightarrow> y[G]\<close> \<open>\<not>(\<box>G \<equiv>\<^sub>E H & \<not>y[G])\<close> for: G)
           (auto simp: "oth-class-taut:1:a")
      AOT_hence \<open>\<forall>G (\<box>\<forall>u([G]u \<equiv> [H]u) \<rightarrow> y[G])\<close>
        by (AOT_subst (reverse) \<open>\<forall>u ([G]u \<equiv> [H]u)\<close> \<open>G \<equiv>\<^sub>E H\<close> for: G)
           (safe intro!: "eqE"[THEN "\<equiv>Df", THEN "\<equiv>S"(1), OF "&I"] "cqt:2")
      AOT_hence \<open>\<forall>G (\<forall>u \<box>([G]u \<equiv> [H]u) \<rightarrow> y[G])\<close>
        using "Ordinary.res-var-bound-reas[BF]" "Ordinary.res-var-bound-reas[CBF]"
              "intro-elim:2"
        by (AOT_subst \<open>\<forall>u \<box>([G]u \<equiv> [H]u)\<close> \<open>\<box>\<forall>u ([G]u \<equiv> [H]u)\<close> for: G) auto
    } note 0 = this
    AOT_assume \<open>A!x & A!y & \<forall>F \<box>([F]x \<equiv> [F]y)\<close>
    AOT_hence \<open>A!x\<close> and \<open>A!y\<close> and \<open>\<forall>F \<box>([F]x \<equiv> [F]y)\<close>
      using "&E" by blast+
    moreover AOT_have \<open>\<forall>F \<box>([F]y \<equiv> [F]x)\<close>
      using calculation(3)
      apply (safe intro!: CBF[THEN "\<rightarrow>E"] dest!: BF[THEN "\<rightarrow>E"])
      using "RM:3" "cqt-basic:11" "intro-elim:3:b" by fast
    ultimately AOT_show \<open>\<forall>G (\<forall>u \<box>([G]u \<equiv> [H]u) \<rightarrow> x[G]) \<equiv>
                         \<forall>G (\<forall>u \<box>([G]u \<equiv> [H]u) \<rightarrow> y[G])\<close>
      using 0 by (auto intro!: "\<equiv>I" "\<rightarrow>I")
  qed

  AOT_have \<open>A!x & A!y & \<forall>F \<box>([F]x \<equiv> [F]y) \<rightarrow>
  (\<exists>G (\<forall>z (O!z \<rightarrow> \<box>([G]z \<equiv> [H]z)) & x[G]) \<equiv> \<exists>G (\<forall>z (O!z \<rightarrow> \<box>([G]z \<equiv> [H]z)) & y[G]))\<close>
  proof(rule "\<rightarrow>I")
    {
      fix x y
      AOT_assume \<open>A!x\<close>
      AOT_assume \<open>A!y\<close>
      AOT_assume indist: \<open>\<forall>F \<box>([F]x \<equiv> [F]y)\<close>
      AOT_assume x_prop: \<open>\<exists>G (\<forall>u \<box>([G]u \<equiv> [H]u) & x[G])\<close>
      AOT_hence \<open>\<exists>G (\<box>\<forall>u ([G]u \<equiv> [H]u) & x[G])\<close>
        using "Ordinary.res-var-bound-reas[BF]" "Ordinary.res-var-bound-reas[CBF]"
              "intro-elim:2"
        by (AOT_subst \<open>\<box>\<forall>u ([G]u \<equiv> [H]u)\<close> \<open>\<forall>u \<box>([G]u \<equiv> [H]u)\<close> for: G) auto
      AOT_hence \<open>\<exists>G (\<box>G \<equiv>\<^sub>E H & x[G])\<close>
        by (AOT_subst \<open>G \<equiv>\<^sub>E H\<close> \<open>\<forall>u ([G]u \<equiv> [H]u)\<close> for: G)
           (safe intro!: "eqE"[THEN "\<equiv>Df", THEN "\<equiv>S"(1), OF "&I"] "cqt:2")
      AOT_hence \<open>[\<lambda>x \<exists>G (\<box>G \<equiv>\<^sub>E H & x[G])]x\<close>
        by (safe intro!: "\<beta>\<leftarrow>C" denotes_ex "cqt:2")
      AOT_hence \<open>[\<lambda>x \<exists>G (\<box>G \<equiv>\<^sub>E H & x[G])]y\<close>
        using indist[THEN "\<forall>E"(1), OF denotes_ex,
                     THEN "qml:2"[axiom_inst, THEN "\<rightarrow>E"],
                     THEN "\<equiv>E"(1)] by blast
      AOT_hence \<open>\<exists>G (\<box>G \<equiv>\<^sub>E H & y[G])\<close>
        by (rule "\<beta>\<rightarrow>C")
      AOT_hence \<open>\<exists>G (\<box>\<forall>u ([G]u \<equiv> [H]u) & y[G])\<close>
        by (AOT_subst (reverse) \<open>\<forall>u ([G]u \<equiv> [H]u)\<close> \<open>G \<equiv>\<^sub>E H\<close> for: G)
           (safe intro!: "eqE"[THEN "\<equiv>Df", THEN "\<equiv>S"(1), OF "&I"] "cqt:2")
      AOT_hence \<open>\<exists>G (\<forall>u \<box>([G]u \<equiv> [H]u) & y[G])\<close>
        using "Ordinary.res-var-bound-reas[BF]"
              "Ordinary.res-var-bound-reas[CBF]"
              "intro-elim:2"
        by (AOT_subst \<open>\<forall>u \<box>([G]u \<equiv> [H]u)\<close> \<open>\<box>\<forall>u ([G]u \<equiv> [H]u)\<close> for: G) auto
    } note 0 = this
    AOT_assume \<open>A!x & A!y & \<forall>F \<box>([F]x \<equiv> [F]y)\<close>
    AOT_hence \<open>A!x\<close> and \<open>A!y\<close> and \<open>\<forall>F \<box>([F]x \<equiv> [F]y)\<close>
      using "&E" by blast+
    moreover AOT_have \<open>\<forall>F \<box>([F]y \<equiv> [F]x)\<close>
      using calculation(3)
      apply (safe intro!: CBF[THEN "\<rightarrow>E"] dest!: BF[THEN "\<rightarrow>E"])
      using "RM:3" "cqt-basic:11" "intro-elim:3:b" by fast
    ultimately AOT_show \<open>\<exists>G (\<forall>u \<box>([G]u \<equiv> [H]u) & x[G]) \<equiv>
                         \<exists>G (\<forall>u \<box>([G]u \<equiv> [H]u) & y[G])\<close>
      using 0 by (auto intro!: "\<equiv>I" "\<rightarrow>I")
  qed
}
end
end


section "Enqueue Proofs"

theory RealTimeDeque_Enqueue
imports Deque RealTimeDeque States_Proof
begin

lemma list_enqL: "invar deque \<Longrightarrow> listL (enqL x deque) = x # listL deque"
proof(induction x deque rule: enqL.induct)
  case (5 x left right length_right)

  obtain left' length_left' where pushed [simp]:
      "Idle.push x left = idle.Idle left' length_left'"
    using is_empty_idle.cases by blast

  then have invar_left': "invar (idle.Idle left' length_left')"
    using Idle_Proof.invar_push[of left x] 5 by auto

  show ?case
  proof(cases "length_left' \<le> 3 * length_right")
    case True
    then show ?thesis
      using Idle_Proof.push_list[of x left]
      by(auto simp: Let_def)
  next
    case False
    let ?length_left = "length_left' - length_right - 1"
    let ?length_right = "2 * length_right + 1"
    let ?big = "Reverse  (Current [] 0 left' ?length_left) left' [] ?length_left"
    let ?small = "Reverse1 (Current [] 0 right ?length_right) right []"
    let ?states = "States Right ?big ?small"
    let ?states_stepped = "(step^^6) ?states"

    from False 5 invar_left' have invar: "invar ?states"
      by(auto simp: rev_drop rev_take)

    then have "States.listL ?states = x # Idle.list left @ rev (Stack.list right)"
      using Idle_Proof.push_list[of x left]
      by(auto)

    then have "States.listL ?states_stepped = x # Idle.list left @ rev (Stack.list right)"
      by (metis invar step_n_listL)

    with False show ?thesis
      by(auto simp: Let_def)
  qed
next
  case (6 x big small)
  let ?small = "Small.push x small"
  let ?states = "States Left big ?small"
  let ?states_stepped = "(step^^4) ?states"

  obtain big_stepped small_stepped where stepped:
      "?states_stepped = States Left big_stepped small_stepped"
    by (metis remaining_steps_states.cases step_n_same)

  from 6 have "invar ?states"
    using invar_push_small[of Left big small x]
    by auto

  then have
      "States.listL ?states_stepped = x # Small.list_current small @ rev (Big.list_current big)"
    using step_n_listL by fastforce

  with 6 show ?case
    by(cases big_stepped; cases small_stepped)
      (auto simp: Let_def stepped split!: Common.state.split)
next
  case (7 x big small)

  let ?big = "Big.push x big"
  let ?states = "States Right ?big small"
  let ?states_stepped = "(step^^4) ?states"

  obtain big_stepped small_stepped where stepped:
      "?states_stepped = States Right big_stepped small_stepped"
    by (metis remaining_steps_states.cases step_n_same)

   from 7 have list_invar:
    "list_current_small_first (States Right big small) = list_small_first (States Right big small)"
    by auto

  from 7 have invar: "invar ?states"
    using invar_push_big[of Right big small x]
    by auto

  then have
      "States.listL ?states = x # Big.list_current big @ rev (Small.list_current small)"
    using app_rev[of _ _ _ "x # Big.list_current big"]
    by(auto split: prod.split)

  then have "
      States.listL ?states_stepped = x # Big.list_current big @ rev (Small.list_current small)"
    by (metis invar step_n_listL)

  with list_invar show ?case
    using app_rev[of "Small.list_current small" "Big.list_current big"]
    by(cases big_stepped; cases small_stepped)
      (auto simp: Let_def stepped split!: prod.split Common.state.split)
qed auto

lemma invar_enqL: "invar deque \<Longrightarrow> invar (enqL x deque)"
proof(induction x deque rule: enqL.induct)
  case (5 x left right length_right)
  obtain left' length_left' where pushed [simp]:
      "Idle.push x left = idle.Idle left' length_left'"
    using is_empty_idle.cases by blast

  then have invar_left': "invar (idle.Idle left' length_left')"
    using Idle_Proof.invar_push[of left x] 5 by auto

  have [simp]: "size left' = Suc (size left)"
    using Idle_Proof.size_push[of x left]
    by auto

  show ?case
  proof(cases "length_left' \<le> 3 * length_right")
    case True
    with 5 show ?thesis
      using invar_left' Idle_Proof.size_push[of x left] Stack_Proof.size_not_empty[of left']
      by auto
  next
    case False
    let ?length_left = "length_left' - length_right - 1"
    let ?length_right = "Suc (2 * length_right)"
    let ?states = "States Right
          (Reverse (Current [] 0 left' ?length_left) left' [] ?length_left)
          (Reverse1 (Current [] 0 right ?length_right) right [])"
    let ?states_stepped = "(step^^6) ?states"

    from invar_left' 5 False have invar: "invar ?states"
      by(auto simp: rev_drop rev_take)

    then have invar_stepped: "invar ?states_stepped"
      using invar_step_n by blast

    from False invar_left' 5 have remaining_steps: "6 < remaining_steps ?states"
      using Stack_Proof.size_not_empty[of right]
      by auto

    then have remaining_steps_stepped: "0 < remaining_steps ?states_stepped"
      using invar remaining_steps_n_steps_sub
      by (metis zero_less_diff)

    from False invar_left' 5 have "size_ok' ?states (remaining_steps ?states - 6)"
      using Stack_Proof.size_not_empty[of right]
            size_not_empty
      by auto

    then have size_ok_stepped: "size_ok ?states_stepped"
      using size_ok_steps[of ?states 6] remaining_steps invar
      by blast

    from False show ?thesis
      using invar_stepped remaining_steps_stepped size_ok_stepped
      by(auto simp: Let_def)
  qed
next
  case (6 x big small)
  let ?small = "Small.push x small"
  let ?states = "States Left big ?small"
  let ?states_stepped = "(step^^4) ?states"

  from 6 have invar: "invar ?states"
    using invar_push_small[of Left big small x]
    by auto

  then have invar_stepped: "invar ?states_stepped"
    using invar_step_n by blast

  show ?case
   proof(cases "4 < remaining_steps ?states")
     case True

     obtain big_stepped small_stepped where stepped [simp]:
       "?states_stepped = States Left big_stepped small_stepped"
       by (metis remaining_steps_states.cases step_n_same)

     from True have remaining_steps: "0 < remaining_steps ?states_stepped"
       using invar remaining_steps_n_steps_sub[of ?states 4]
       by simp

     from True 6(1) have size_ok: "size_ok ?states_stepped"
       using
          step_4_push_small_size_ok[of Left big small x]
          remaining_steps_push_small[of Left big small x]
       by auto

     from remaining_steps size_ok invar_stepped show ?thesis
       by(cases big_stepped; cases small_stepped)
         (auto simp: Let_def split!: Common.state.split)
   next
     case False
     then have remaining_steps_stepped: "remaining_steps ?states_stepped = 0"
       using invar by auto

     then obtain small_current small_idle big_current big_idle where idle [simp]: "
      ?states_stepped =
      States Left
          (Big.state.Common (state.Idle big_current big_idle))
          (Small.state.Common (state.Idle small_current small_idle))
      "
       using remaining_steps_idle' invar_stepped remaining_steps_stepped step_n_same
       by (smt (verit) invar_states.elims(2))

     from 6 have [simp]: "size_new (Small.push x small) = Suc (size_new small)"
       using Small_Proof.size_new_push by auto

     have [simp]: "size small_idle = size_new (Small.push x small)"
       using invar invar_stepped step_n_size_new_small[of Left big "Small.push x small" 4]
       by auto

     then have [simp]: "\<not>is_empty small_idle"
       using Idle_Proof.size_not_empty[of small_idle]
       by auto

     have size_new_big [simp]: "0 < size_new big"
       using 6
       by auto

     then have [simp]: "size big_idle = size_new big"
       using invar invar_stepped step_n_size_new_big[of Left big "Small.push x small" 4]
       by auto

     then have [simp]: "\<not>is_empty big_idle"
       using Idle_Proof.size_not_empty size_new_big
       by metis

     have size_ok_1: "size small_idle \<le> 3 * size big_idle"
       using 6 by auto

     have size_ok_2: "size big_idle \<le> 3 * size small_idle"
      using 6 by auto

     from False show ?thesis
       using invar_stepped size_ok_1 size_ok_2
       by auto
   qed
next
  case (7 x big small)
  let ?big = "Big.push x big"
  let ?states = "States Right ?big small"
  let ?states_stepped = "(step^^4) ?states"

  from 7 have invar: "invar ?states"
    using invar_push_big[of Right big small x]
    by auto

  then have invar_stepped: "invar ?states_stepped"
    using invar_step_n by blast

  show ?case
   proof(cases "4 < remaining_steps ?states")
     case True

     obtain big_stepped small_stepped where stepped [simp]:
       "?states_stepped = States Right big_stepped small_stepped"
       by (metis remaining_steps_states.cases step_n_same)

     from True have remaining_steps: "0 < remaining_steps ?states_stepped"
       using invar remaining_steps_n_steps_sub[of ?states 4]
       by simp

     from True 7(1) have size_ok: "size_ok ?states_stepped"
       using
          step_4_push_big_size_ok[of Right big small x]
          remaining_steps_push_big[of Right big small x]
       by auto

     from remaining_steps size_ok invar_stepped show ?thesis
       by(cases big_stepped; cases small_stepped)
         (auto simp: Let_def split!: Common.state.split)
   next
     case False
     then have remaining_steps_stepped: "remaining_steps ?states_stepped = 0"
       using invar by auto

     then obtain small_current small_idle big_current big_idle where idle [simp]: "
      ?states_stepped =
      States Right
          (Big.state.Common (state.Idle big_current big_idle))
          (Small.state.Common (state.Idle small_current small_idle))
      "
       using remaining_steps_idle' invar_stepped remaining_steps_stepped step_n_same
       by (smt (verit) invar_states.elims(2))

     from 7 have [simp]: "size_new (Big.push x big) = Suc (size_new big)"
       using Big_Proof.size_new_push by auto

     have [simp]: "size big_idle = size_new (Big.push x big)"
       using invar invar_stepped step_n_size_new_big[of Right "Big.push x big" small 4]
       by auto

     then have [simp]: "\<not>is_empty big_idle"
       using Idle_Proof.size_not_empty[of big_idle]
       by auto

     have size_new_small [simp]: "0 < size_new small"
       using 7
       by auto

     then have [simp]: "size small_idle = size_new small"
       using invar invar_stepped step_n_size_new_small[of Right "Big.push x big" small 4]
       by auto

     then have [simp]: "\<not>is_empty small_idle"
       using Idle_Proof.size_not_empty size_new_small
       by metis

     have size_ok_1: "size small_idle \<le> 3 * size big_idle"
       using 7 by auto

     have size_ok_2: "size big_idle \<le> 3 * size small_idle"
      using 7 by auto

     from False show ?thesis
       using invar_stepped size_ok_1 size_ok_2
       by auto
   qed
qed auto

end


section \<open>\isaheader{Hashable Interface}\<close>
theory Intf_Hash
imports
    Main
    "../../Lib/HashCode"
    "../../Lib/Code_Target_ICF"
    Automatic_Refinement.Automatic_Refinement
begin

type_synonym 'a eq = "'a \<Rightarrow> 'a \<Rightarrow> bool"
type_synonym 'k bhc = "nat \<Rightarrow> 'k \<Rightarrow> nat"

subsection \<open>Abstract and concrete hash functions\<close>

definition is_bounded_hashcode :: "('c\<times>'a) set \<Rightarrow> 'c eq \<Rightarrow> 'c bhc \<Rightarrow> bool"
  where "is_bounded_hashcode R eq bhc \<equiv>
             ((eq,(=)) \<in> R \<rightarrow> R \<rightarrow> bool_rel) \<and>
             (\<forall>n. \<forall> x \<in> Domain R. \<forall> y \<in> Domain R. eq x y \<longrightarrow> bhc n x = bhc n y) \<and>
             (\<forall>n x. 1 < n \<longrightarrow> bhc n x < n)"
definition abstract_bounded_hashcode :: "('c\<times>'a) set \<Rightarrow> 'c bhc \<Rightarrow> 'a bhc"
  where "abstract_bounded_hashcode Rk bhc n x' \<equiv>
             if x' \<in> Range Rk
                 then THE c. \<exists>x. (x,x') \<in> Rk \<and> bhc n x = c
                 else 0"

lemma is_bounded_hashcodeI[intro]:
  "((eq,(=)) \<in> R \<rightarrow> R \<rightarrow> bool_rel) \<Longrightarrow>
   (\<And>x y n. x \<in> Domain R \<Longrightarrow> y \<in> Domain R \<Longrightarrow> eq x y \<Longrightarrow> bhc n x = bhc n y) \<Longrightarrow>
   (\<And>x n. 1 < n \<Longrightarrow> bhc n x < n) \<Longrightarrow> is_bounded_hashcode R eq bhc"
  unfolding is_bounded_hashcode_def by force

lemma is_bounded_hashcodeD[dest]:
  assumes "is_bounded_hashcode R eq bhc"
  shows "(eq,(=)) \<in> R \<rightarrow> R \<rightarrow> bool_rel" and
        "\<And>n x y. x \<in> Domain R \<Longrightarrow> y \<in> Domain R \<Longrightarrow> eq x y \<Longrightarrow> bhc n x = bhc n y" and
        "\<And>n x. 1 < n \<Longrightarrow> bhc n x < n"
  using assms unfolding is_bounded_hashcode_def by simp_all

lemma bounded_hashcode_welldefined:
  assumes BHC: "is_bounded_hashcode Rk eq bhc" and
          R1: "(x1,x') \<in> Rk" and R2: "(x2,x') \<in> Rk"
  shows "bhc n x1 = bhc n x2"
proof-
  from is_bounded_hashcodeD[OF BHC] have "(eq,(=)) \<in> Rk \<rightarrow> Rk \<rightarrow> bool_rel" by simp
  with R1 R2 have "eq x1 x2" by (force dest: fun_relD)
  thus ?thesis using R1 R2 BHC by blast
qed

lemma abstract_bhc_correct[intro]:
  assumes "is_bounded_hashcode Rk eq bhc"
  shows "(bhc, abstract_bounded_hashcode Rk bhc) \<in>
      nat_rel \<rightarrow> Rk \<rightarrow> nat_rel" (is "(bhc, ?bhc') \<in> _")
proof (intro fun_relI)
  fix n n' x x'
  assume A: "(n,n') \<in> nat_rel" and B: "(x,x') \<in> Rk"
  hence C: "n = n'" and D: "x' \<in> Range Rk" by auto
  have "?bhc' n' x' = bhc n x"
      unfolding abstract_bounded_hashcode_def
      apply (simp add: C D, rule)
      apply (intro exI conjI, fact B, rule refl)
      apply (elim exE conjE, hypsubst,
          erule bounded_hashcode_welldefined[OF assms _ B])
      done
  thus "(bhc n x, ?bhc' n' x') \<in> nat_rel" by simp
qed

lemma abstract_bhc_is_bhc[intro]:
  fixes Rk :: "('c\<times>'a) set"
  assumes bhc: "is_bounded_hashcode Rk eq bhc"
  shows "is_bounded_hashcode Id (=) (abstract_bounded_hashcode Rk bhc)"
      (is "is_bounded_hashcode _ (=) ?bhc'")
proof
  fix x'::'a and y'::'a and n'::nat assume "x' = y'"
  thus "?bhc' n' x' = ?bhc' n' y'" by simp
next
  fix x'::'a and n'::nat assume "1 < n'"
  from abstract_bhc_correct[OF bhc] show "?bhc' n' x' < n'"
  proof (cases "x' \<in> Range Rk")
    case False
      with \<open>1 < n'\<close> show ?thesis
          unfolding abstract_bounded_hashcode_def by simp
  next
    case True
      then obtain x where "(x,x') \<in> Rk" ..
      have "(n',n') \<in> nat_rel" ..
      from abstract_bhc_correct[OF assms] have "?bhc' n' x' = bhc n' x"
        apply -
        apply (drule fun_relD[OF _ \<open>(n',n') \<in> nat_rel\<close>],
               drule fun_relD[OF _ \<open>(x,x') \<in> Rk\<close>], simp)
        done
      also from \<open>1 < n'\<close> and bhc have "... < n'" by blast
      finally show "?bhc' n' x' < n'" .
  qed
qed simp

(*lemma hashable_bhc_is_bhc[autoref_ga_rules]:
  "\<lbrakk>STRUCT_EQ_tag eq (=;) REL_IS_ID R\<rbrakk> \<Longrightarrow> is_bounded_hashcode R eq bounded_hashcode"
  unfolding is_bounded_hashcode_def
  by (simp add: bounded_hashcode_bounds)*)

(* TODO: This is a hack that causes the relation to be instantiated to Id, if it is not
    yet fixed! *)
lemma hashable_bhc_is_bhc[autoref_ga_rules]:
  "\<lbrakk>STRUCT_EQ_tag eq (=); REL_FORCE_ID R\<rbrakk> \<Longrightarrow> is_bounded_hashcode R eq bounded_hashcode_nat"
  unfolding is_bounded_hashcode_def
  by (simp add: bounded_hashcode_nat_bounds)

subsection \<open>Default hash map size\<close>

definition is_valid_def_hm_size :: "'k itself \<Rightarrow> nat \<Rightarrow> bool"
    where "is_valid_def_hm_size type n \<equiv> n > 1"

lemma hashable_def_size_is_def_size[autoref_ga_rules]:
  shows "is_valid_def_hm_size TYPE('k::hashable) (def_hashmap_size TYPE('k))"
    unfolding is_valid_def_hm_size_def by (fact def_hashmap_size)

end


(*  Title:      Presburger-Automata/DFS.thy
    Author:     Toshiaki Nishihara and Yasuhiko Minamide
    Author:     Stefan Berghofer and Alex Krauss, TU Muenchen, 2008-2009
    Author:     Peter Gammie (data refinement futz), 2010
*)

(*<*)
theory DFS
imports Main
begin
(*>*)

subsection\<open>Generic DFS\<close>

text\<open>

\label{sec:dfs}

We use a generic DFS to construct the transitions and action function
of the implementation of the JKBP. This theory is largely due to
Stefan Berghofer and Alex Krauss
\<^citep>\<open>"DBLP:conf/tphol/BerghoferR09"\<close>. All proofs are elided as the
fine details of how we explore the state space are inessential to the
synthesis algorithm.

The DFS itself is defined in the standard tail-recursive way:

\<close>

partial_function (tailrec) gen_dfs where
  "gen_dfs succs ins memb S wl = (case wl of
     [] \<Rightarrow> S
   | (x # xs) \<Rightarrow>
       if memb x S then gen_dfs succs ins memb S xs
       else gen_dfs succs ins memb (ins x S) (succs x @ xs))"
(*<*)
lemma gen_dfs_simps[code, simp]:
  "gen_dfs succs ins memb S [] = S"
  "gen_dfs succs ins memb S (x # xs) =
    (if memb x S then gen_dfs succs ins memb S xs
     else gen_dfs succs ins memb (ins x S) (succs x @ xs))"
  by (simp_all add: gen_dfs.simps)
(*>*)

text_raw\<open>
\begin{figure}
\begin{isabellebody}%
\<close>
locale DFS =
  fixes succs :: "'a \<Rightarrow> 'a list"
  and isNode :: "'a \<Rightarrow> bool"
  and invariant :: "'b \<Rightarrow> bool"
  and ins :: "'a \<Rightarrow> 'b \<Rightarrow> 'b"
  and memb :: "'a \<Rightarrow> 'b \<Rightarrow> bool"
  and empt :: 'b
  and nodeAbs :: "'a \<Rightarrow> 'c"
  assumes ins_eq: "\<And>x y S. \<lbrakk> isNode x; isNode y; invariant S; \<not> memb y S \<rbrakk>
                       \<Longrightarrow> memb x (ins y S)
                       \<longleftrightarrow> ((nodeAbs x = nodeAbs y) \<or> memb x S)"
  and succs: "\<And>x y. \<lbrakk> isNode x; isNode y; nodeAbs x = nodeAbs y \<rbrakk>
                       \<Longrightarrow> nodeAbs ` set (succs x) = nodeAbs ` set (succs y)"
  and empt: "\<And>x. isNode x \<Longrightarrow> \<not> memb x empt"
  and succs_isNode: "\<And>x. isNode x \<Longrightarrow> list_all isNode (succs x)"
  and empt_invariant: "invariant empt"
  and ins_invariant: "\<And>x S. \<lbrakk> isNode x; invariant S; \<not> memb x S \<rbrakk>
                        \<Longrightarrow> invariant (ins x S)"
  and graph_finite: "finite (nodeAbs ` { x . isNode x})"
text_raw\<open>
\end{isabellebody}%
\begin{isamarkuptext}%
\caption{The \<open>DFS\<close> locale.}
\label{fig:kbps-theory-dfs-locale}
\end{isamarkuptext}%
\end{figure}
\<close>

text\<open>

The proofs are carried out in the locale of
Figure~\ref{fig:kbps-theory-dfs-locale}, which details our
requirements on the parameters for the DFS to behave as one would
expect. Intuitively we are traversing a graph defined by @{term
"succs"} from some initial work list @{term "wl"}, constructing an
object of type @{typ "'b"} as we go. The function @{term "ins"}
integrates the current node into this construction. The predicate
@{term "isNode"} is invariant over the set of states reachable from
the initial work list, and is respected by @{term "empt"} and @{term
"ins"}. We can also supply an invariant for the constructed object
(@{term "invariant"}). Inside the locale, @{term "dfs"} abbreviates
@{term "gen_dfs"} partially applied to the fixed parameters.

To support our data refinement
(\S\ref{sec:kbps-automata-synthesis-alg}) we also require that the
representation of nodes be adequate via the abstraction function
@{term "nodeAbs"}, which the transition relation @{term "succs"} and
visited predicate @{term "memb"} must respect. To ensure termination
it must be the case that there are only a finite number of states,
though there might be an infinity of representations.

We characterise the DFS traversal using the reflexive
transitive closure operator:

\<close>

definition (in DFS) reachable :: "'a set \<Rightarrow> 'a set" where
  "reachable xs \<equiv> {(x, y). y \<in> set (succs x)}\<^sup>* `` xs"
(*<*)

context DFS
begin

definition
  "succss xs \<equiv> \<Union>x\<in>xs. set (succs x)"

definition
  "set_of S \<equiv> {x. isNode x \<and> memb x S}"

abbreviation
  "dfs \<equiv> gen_dfs succs ins memb"

definition rel where
  "rel = inv_image finite_psubset (\<lambda>S. nodeAbs ` {n.  isNode n \<and> \<not> memb n S})"

(* Yuck, something to do with Skolems broke. *)
lemma nodeAbs_subset_grot:
  "\<lbrakk>invariant S; isNode x; list_all isNode xs; \<not>memb x S\<rbrakk>
     \<Longrightarrow> nodeAbs ` {n . isNode n \<and> \<not> memb n (ins x S)}
       \<subset> nodeAbs ` {n . isNode n \<and> \<not> memb n S}"
  apply rule
   apply (auto simp add: ins_eq cong: conj_cong)
  apply (subgoal_tac "nodeAbs x \<in> nodeAbs ` {n. isNode n \<and> \<not> memb n S}")
   apply (subgoal_tac "nodeAbs x \<notin> nodeAbs ` {n. isNode n \<and> nodeAbs n \<noteq> nodeAbs x \<and> \<not> memb n S}")
    apply blast
   apply rule
   apply (erule imageE) back
   apply auto[1]
  apply auto[1]
  done

lemma psubsetI2: "\<lbrakk> A \<subseteq> B; x \<in> A; x \<notin> B\<rbrakk> \<Longrightarrow> A \<subset> B"
  by (unfold less_le) blast

lemma dfs_induct[consumes 2, case_names base step]:
  assumes S: "invariant S"
  and xs: "list_all isNode xs"
  and I1: "\<And>S. invariant S \<Longrightarrow> P S []"
  and I2: "\<And>S x xs. invariant S \<Longrightarrow> isNode x \<Longrightarrow> list_all isNode xs \<Longrightarrow>
    (memb x S \<Longrightarrow> P S xs) \<Longrightarrow> (\<not> memb x S \<Longrightarrow> P (ins x S) (succs x @ xs)) \<Longrightarrow> P S (x # xs)"
  shows "P S xs" using I1 I2 S xs
  apply induction_schema
  apply atomize_elim
  apply (case_tac xs, simp+)
  apply atomize_elim
  apply (rule conjI)
  apply (rule ins_invariant, assumption+)
  apply (rule succs_isNode, assumption)
  apply (relation "rel <*lex*> measure length")
  apply (simp add: wf_lex_prod rel_def)
  apply simp
  apply simp
  apply (rule disjI1)
  apply (simp add: rel_def finite_psubset_def)
  apply (rule conjI)
  apply (erule (3) nodeAbs_subset_grot)
  apply (rule finite_subset[OF _ graph_finite])
  apply auto
  done

lemma visit_subset_dfs: "invariant S \<Longrightarrow> list_all isNode xs \<Longrightarrow>
  isNode y \<Longrightarrow> memb y S \<Longrightarrow> memb y (dfs S xs)"
  by (induct S xs rule: dfs_induct) (simp_all add: ins_eq)

lemma next_subset_dfs: "invariant S \<Longrightarrow> list_all isNode xs \<Longrightarrow>
  x \<in> set xs \<Longrightarrow> memb x (dfs S xs)"
proof (induct S xs rule: dfs_induct)
  case (step S y xs)
  then show ?case
    by (auto simp add: visit_subset_dfs ins_eq ins_invariant succs_isNode)
qed simp

lemma succss_closed_dfs':
  "invariant ys \<Longrightarrow> list_all isNode xs \<Longrightarrow>
   nodeAbs ` succss (set_of ys) \<subseteq> nodeAbs ` (set xs \<union> set_of ys) \<Longrightarrow> nodeAbs ` succss (set_of (dfs ys xs)) \<subseteq> nodeAbs ` set_of (dfs ys xs)"
proof(induct ys xs rule: dfs_induct)
  case (base S) thus ?case by simp
next
  case (step S x xs) thus ?case
    apply (auto simp add: succss_def set_of_def cong: conj_cong)
     apply (subgoal_tac "nodeAbs xa \<in> nodeAbs ` (\<Union>x\<in>{x. isNode x \<and> memb x (dfs S xs)}. set (succs x))")
      apply blast
     apply blast
    apply (subgoal_tac "nodeAbs ` (\<Union>x\<in>{xa. isNode xa \<and> memb xa (ins x S)}. set (succs x)) \<subseteq> nodeAbs ` (set (succs x) \<union> set xs \<union> {xa. isNode xa \<and> memb xa (ins x S)})")
     apply blast
    apply (auto simp add: ins_eq succss_def set_of_def cong: conj_cong)
    apply (subgoal_tac "\<exists>xc'. xc' \<in> set (succs x) \<and> nodeAbs xc' = nodeAbs xc")
     apply clarsimp
     apply (rule_tac x=xc' in image_eqI)
      apply simp
     apply simp
    apply (cut_tac x=xd and y=x in succs)
     apply simp_all
    apply (subgoal_tac "nodeAbs xc \<in> nodeAbs ` set (succs x)")
     apply auto[1]
    apply auto[1]
   apply (subgoal_tac "nodeAbs ` set (succs xd) \<subseteq> nodeAbs ` (\<Union>x\<in>{x. isNode x \<and> memb x S}. set (succs x))")
    defer
    apply auto[1]
   apply (subgoal_tac "nodeAbs xc \<in> nodeAbs ` set (succs xd)")
    defer
    apply auto[1]
   apply (subgoal_tac "nodeAbs xc \<in> insert (nodeAbs x) (nodeAbs ` (set xs \<union> {x. isNode x \<and> memb x S}))")
    defer
    apply (erule rev_subsetD)
    apply (erule subset_trans)
    apply blast
   apply auto
   done
qed

lemma succss_closed_dfs: "list_all isNode xs \<Longrightarrow>
  nodeAbs ` succss (set_of (dfs empt xs)) \<subseteq> nodeAbs ` set_of (dfs empt xs)"
  apply (rule succss_closed_dfs')
  apply (rule empt_invariant)
  apply assumption
  apply (simp add: succss_def)
  apply (rule subsetI)
  apply clarsimp
  unfolding set_of_def
  using empt
  apply clarsimp
  done

definition
  "succsr \<equiv> {(x, y). y \<in> set (succs x)}"

theorem succsr_isNode:
  assumes xy: "(x, y) \<in> succsr\<^sup>*"
  shows "isNode x \<Longrightarrow> isNode y" using xy
proof induct
  case (step y z)
  then have "isNode y" by simp
  then have "list_all isNode (succs y)"
    by (rule succs_isNode)
  with step show ?case
    by (simp add: succsr_def list_all_iff)
qed

lemma succss_closed:
  assumes inc: "nodeAbs ` succss X \<subseteq> nodeAbs ` X"
      and X: "X \<subseteq> { x . isNode x }"
  shows "nodeAbs ` reachable X = nodeAbs ` X"
proof
  show "nodeAbs ` X \<subseteq> nodeAbs ` reachable X"
    unfolding reachable_def by auto
next
  show "nodeAbs ` reachable X \<subseteq> nodeAbs ` X"
  proof(unfold reachable_def, auto)
    fix x y
    assume y: "y \<in> X"
    assume "(y, x) \<in> {(x, y). y \<in> set (succs x)}\<^sup>*"
    thus "nodeAbs x \<in> nodeAbs ` X" using y
    proof induct
      case base thus ?case by simp
    next
      case (step r s)
      from X step have "isNode r"
        using succsr_isNode[where x=y and y=r]
        unfolding succsr_def by fastforce
      with inc step show ?case
        apply clarsimp
        apply (subgoal_tac "isNode x")
         apply (cut_tac x=r and y=x in succs)
         apply auto
         apply (subgoal_tac "nodeAbs s \<in> nodeAbs ` set (succs x)")
         using X
         apply (auto simp: succss_def)
         done
     qed
   qed
qed

lemma dfs_isNode:
  assumes S: "invariant S"
      and xs: "list_all isNode xs"
  shows "set_of (dfs S xs) \<subseteq> {x . isNode x}"
  using assms
  by (induct S xs rule: dfs_induct) (auto simp: set_of_def)

lemma reachable_closed_dfs:
  assumes xs: "list_all isNode xs"
  shows "nodeAbs ` reachable (set xs) \<subseteq> nodeAbs ` set_of (dfs empt xs)"
proof -
  from xs have "reachable (set xs) \<subseteq> reachable (set_of (dfs empt xs))"
    apply (unfold reachable_def)
    apply (rule Image_mono)
    apply (auto simp add: set_of_def next_subset_dfs empt_invariant list_all_iff)
    done
  hence "nodeAbs ` reachable (set xs) \<subseteq> nodeAbs ` reachable (set_of (dfs empt xs))"
    by auto
  also from succss_closed_dfs[OF xs] have "\<dots> = nodeAbs ` set_of (dfs empt xs)"
    apply (rule succss_closed)
    apply (rule dfs_isNode[OF empt_invariant xs])
    done
  finally show ?thesis .
qed

lemma reachable_succs: "reachable (set (succs x)) \<subseteq> reachable {x}"
  by (auto simp add: reachable_def intro: converse_rtrancl_into_rtrancl)

lemma dfs_subset_reachable_visit_nodes:
  "invariant ys \<Longrightarrow> list_all isNode xs \<Longrightarrow>
   nodeAbs ` set_of (dfs ys xs) \<subseteq> nodeAbs ` (reachable (set xs) \<union> set_of ys)"
proof(induct ys xs rule: dfs_induct)
  case (step S x xs)
  show ?case
  proof (cases "memb x S")
    case True
    with step show ?thesis by (auto simp add: reachable_def)
  next
    case False
    have "reachable (set (succs x)) \<subseteq> reachable {x}"
      by (rule reachable_succs)
    then have "reachable (set (succs x @ xs)) \<subseteq> reachable (set (x # xs))"
      by (auto simp add: reachable_def)
    then show ?thesis using step
      apply (auto simp add: reachable_def set_of_def cong: conj_cong)
       apply (subgoal_tac "nodeAbs xa \<in> nodeAbs `
            ({(x, y). y \<in> set (succs x)}\<^sup>* `` set xs \<union>
             {x. isNode x \<and> memb x S})")
        apply auto[1]
       apply auto[1]
      apply (subgoal_tac "nodeAbs xa \<in> nodeAbs `
            ({(x, y). y \<in> set (succs x)}\<^sup>* `` (set (succs x) \<union> set xs) \<union>
             {xa. isNode xa \<and> memb xa (ins x S)})")
       defer
       apply auto[1]
      apply auto[1]
       apply (rule_tac x=xb in image_eqI)
        apply auto[1]
       apply auto[1]
      apply (auto iff: ins_eq)
      done
(* by (auto simp add: reachable_def ins_eq set_of_def cong: conj_cong) *)
  qed
qed (simp add: reachable_def)

theorem dfs_imp_reachable:
  assumes y: "isNode y"
      and xs: "list_all isNode xs"
      and m: "memb y (dfs empt xs)"
  shows "\<exists>y'. nodeAbs y' = nodeAbs y \<and> y' \<in> reachable (set xs)"
proof -
  from m dfs_subset_reachable_visit_nodes [OF empt_invariant xs] y
  obtain y'
    where "nodeAbs y' = nodeAbs y"
      and "y' \<in> reachable (set xs)"
    by (auto simp add: empt set_of_def)
  thus ?thesis by blast
qed

(*>*)
text\<open>

We make use of two results about the traversal. Firstly, that some
representation of each reachable node has been incorporated into the
final construction:

\<close>

theorem (in DFS) reachable_imp_dfs:
  assumes y: "isNode y"
      and xs: "list_all isNode xs"
      and m: "y \<in> reachable (set xs)"
  shows "\<exists>y'. nodeAbs y' = nodeAbs y \<and> memb y' (dfs empt xs)"
(*<*)
  using y m reachable_closed_dfs[OF xs]
  apply (auto simp add: set_of_def)
  apply (drule subsetD[where c="nodeAbs y"])
   apply simp
  apply auto
  done

theorem dfs_invariant' [consumes 2, case_names base step]:
  assumes S: "invariant S"
  and xs: "list_all isNode xs"
  and H: "I S"
  and I: "\<And>S x. \<not> memb x S \<Longrightarrow> isNode x \<Longrightarrow> invariant S \<Longrightarrow> I S \<Longrightarrow> I (ins x S)"
  shows "I (dfs S xs)"
proof -
  from S xs H
  have "I (dfs S xs) \<and> invariant (dfs S xs)"
  proof (induct S xs rule: dfs_induct)
    case (step S x xs)
    show ?case
    proof (cases "memb x S")
      case False
      then show ?thesis
        apply simp
        apply (rule step)
        apply assumption
        apply (rule I)
        apply assumption
        apply (rule step)+
        done
    qed (simp add: step)
  qed simp
  then show ?thesis ..
qed

end (* context DFS *)
(*>*)

text\<open>

Secondly, that if an invariant holds on the initial object then it
holds on the final one:

\<close>

theorem (in DFS) dfs_invariant:
  assumes "invariant S"
  assumes "list_all isNode xs"
  shows "invariant (dfs S xs)"
(*<*)
  using assms
  by (induct S xs rule: dfs_induct) auto
(*>*)

text\<open>

\FloatBarrier

\<close>

(*<*)
end
(*>*)