Theory TAO_9_PLM

(*<*)
theory TAO_9_PLM
imports 
  TAO_8_Definitions 
  "HOL-Eisbach.Eisbach_Tools"
begin
(*>*)

section‹The Deductive System PLM›
text‹\label{TAO_PLM}›

declare meta_defs[no_atp] meta_aux[no_atp]

locale PLM = Axioms
begin

subsection‹Automatic Solver›
text‹\label{TAO_PLM_Solver}›

  named_theorems PLM
  named_theorems PLM_intro
  named_theorems PLM_elim
  named_theorems PLM_dest
  named_theorems PLM_subst

  method PLM_solver declares PLM_intro PLM_elim PLM_subst PLM_dest PLM
    = ((assumption | (match axiom in A: "[[φ]]" for φ ⇒ ‹fact A[axiom_instance]›)
        | fact PLM | rule PLM_intro | subst PLM_subst | subst (asm) PLM_subst
        | fastforce | safe | drule PLM_dest | erule PLM_elim); (PLM_solver)?)

subsection‹Modus Ponens›
text‹\label{TAO_PLM_ModusPonens}›

  lemma modus_ponens[PLM]:
    "⟦[φ in v]; [φ → ψ in v]⟧ ⟹ [ψ in v]"
    by (simp add: Semantics.T5)

subsection‹Axioms›
text‹\label{TAO_PLM_Axioms}›

  interpretation Axioms .
  declare axiom[PLM]
  declare conn_defs[PLM]

subsection‹(Modally Strict) Proofs and Derivations›
text‹\label{TAO_PLM_ProofsAndDerivations}›

  lemma vdash_properties_6[no_atp]:
    "⟦[φ in v]; [φ → ψ in v]⟧ ⟹ [ψ in v]"
    using modus_ponens .
  lemma vdash_properties_9[PLM]:
    "[φ in v] ⟹ [ψ → φ in v]"
    using modus_ponens pl_1[axiom_instance] by blast
  lemma vdash_properties_10[PLM]:
    "[φ → ψ in v] ⟹ ([φ in v] ⟹ [ψ in v])"
    using vdash_properties_6 .

  attribute_setup deduction = ‹
    Scan.succeed (Thm.rule_attribute [] 
      (fn _ => fn thm => thm RS @{thm vdash_properties_10}))
›

subsection‹GEN and RN›
text‹\label{TAO_PLM_GEN_RN}›

  lemma rule_gen[PLM]:
    "⟦⋀α . [φ α in v]⟧ ⟹ [∀α . φ α in v]"
    by (simp add: Semantics.T8)

  lemma RN_2[PLM]:
    "(⋀ v . [ψ in v] ⟹ [φ in v]) ⟹ ([□ψ in v] ⟹ [□φ in v])"
    by (simp add: Semantics.T6)

  lemma RN[PLM]:
    "(⋀ v . [φ in v]) ⟹ [□φ in v]"
    using qml_3[axiom_necessitation, axiom_instance] RN_2 by blast

subsection‹Negations and Conditionals›
text‹\label{TAO_PLM_NegationsAndConditionals}›

  lemma if_p_then_p[PLM]:
    "[φ → φ in v]"
    using pl_1 pl_2 vdash_properties_10 axiom_instance by blast

  lemma deduction_theorem[PLM,PLM_intro]:
    "⟦[φ in v] ⟹ [ψ in v]⟧ ⟹ [φ → ψ in v]"
    by (simp add: Semantics.T5)
  lemmas CP = deduction_theorem

  lemma ded_thm_cor_3[PLM]:
    "⟦[φ → ψ in v]; [ψ → χ in v]⟧ ⟹ [φ → χ in v]"
    by (meson pl_2 vdash_properties_10 vdash_properties_9 axiom_instance)
  lemma ded_thm_cor_4[PLM]:
    "⟦[φ → (ψ → χ) in v]; [ψ in v]⟧ ⟹ [φ → χ in v]"
    by (meson pl_2 vdash_properties_10 vdash_properties_9 axiom_instance)

  lemma useful_tautologies_1[PLM]:
    "[¬¬φ → φ in v]"
    by (meson pl_1 pl_3 ded_thm_cor_3 ded_thm_cor_4 axiom_instance)
  lemma useful_tautologies_2[PLM]:
    "[φ → ¬¬φ in v]"
    by (meson pl_1 pl_3 ded_thm_cor_3 useful_tautologies_1
              vdash_properties_10 axiom_instance)
  lemma useful_tautologies_3[PLM]:
    "[¬φ → (φ → ψ) in v]"
    by (meson pl_1 pl_2 pl_3 ded_thm_cor_3 ded_thm_cor_4 axiom_instance)
  lemma useful_tautologies_4[PLM]:
    "[(¬ψ → ¬φ) → (φ → ψ) in v]"
    by (meson pl_1 pl_2 pl_3 ded_thm_cor_3 ded_thm_cor_4 axiom_instance)
  lemma useful_tautologies_5[PLM]:
    "[(φ → ψ) → (¬ψ → ¬φ) in v]"
    by (metis CP useful_tautologies_4 vdash_properties_10)
  lemma useful_tautologies_6[PLM]:
    "[(φ → ¬ψ) → (ψ → ¬φ) in v]"
    by (metis CP useful_tautologies_4 vdash_properties_10)
  lemma useful_tautologies_7[PLM]:
    "[(¬φ → ψ) → (¬ψ → φ) in v]"
    using ded_thm_cor_3 useful_tautologies_4 useful_tautologies_5
          useful_tautologies_6 by blast
  lemma useful_tautologies_8[PLM]:
    "[φ → (¬ψ → ¬(φ → ψ)) in v]"
    by (meson ded_thm_cor_3 CP useful_tautologies_5)
  lemma useful_tautologies_9[PLM]:
    "[(φ → ψ) → ((¬φ → ψ) → ψ) in v]"
    by (metis CP useful_tautologies_4 vdash_properties_10)
  lemma useful_tautologies_10[PLM]:
    "[(φ → ¬ψ) → ((φ → ψ) → ¬φ) in v]"
    by (metis ded_thm_cor_3 CP useful_tautologies_6)

  lemma modus_tollens_1[PLM]:
    "⟦[φ → ψ in v]; [¬ψ in v]⟧ ⟹ [¬φ in v]"
    by (metis ded_thm_cor_3 ded_thm_cor_4 useful_tautologies_3
              useful_tautologies_7 vdash_properties_10)
  lemma modus_tollens_2[PLM]:
    "⟦[φ → ¬ψ in v]; [ψ in v]⟧ ⟹ [¬φ in v]"
    using modus_tollens_1 useful_tautologies_2
          vdash_properties_10 by blast

  lemma contraposition_1[PLM]:
    "[φ → ψ in v] = [¬ψ → ¬φ in v]"
    using useful_tautologies_4 useful_tautologies_5
          vdash_properties_10 by blast
  lemma contraposition_2[PLM]:
    "[φ → ¬ψ in v] = [ψ → ¬φ in v]"
    using contraposition_1 ded_thm_cor_3
          useful_tautologies_1 by blast

  lemma reductio_aa_1[PLM]:
    "⟦[¬φ in v] ⟹ [¬ψ in v]; [¬φ in v] ⟹ [ψ in v]⟧ ⟹ [φ in v]"
    using CP modus_tollens_2 useful_tautologies_1
          vdash_properties_10 by blast
  lemma reductio_aa_2[PLM]:
    "⟦[φ in v] ⟹ [¬ψ in v]; [φ in v] ⟹ [ψ in v]⟧ ⟹ [¬φ in v]"
    by (meson contraposition_1 reductio_aa_1)
  lemma reductio_aa_3[PLM]:
    "⟦[¬φ → ¬ψ in v]; [¬φ → ψ in v]⟧ ⟹ [φ in v]"
    using reductio_aa_1 vdash_properties_10 by blast
  lemma reductio_aa_4[PLM]:
    "⟦[φ → ¬ψ in v]; [φ → ψ in v]⟧ ⟹ [¬φ in v]"
    using reductio_aa_2 vdash_properties_10 by blast

  lemma raa_cor_1[PLM]:
    "⟦[φ in v]; [¬ψ in v] ⟹ [¬φ in v]⟧ ⟹ ([φ in v] ⟹ [ψ in v])"
    using reductio_aa_1 vdash_properties_9 by blast
  lemma raa_cor_2[PLM]:
    "⟦[¬φ in v]; [¬ψ in v] ⟹ [φ in v]⟧ ⟹ ([¬φ in v] ⟹ [ψ in v])"
    using reductio_aa_1 vdash_properties_9 by blast
  lemma raa_cor_3[PLM]:
    "⟦[φ in v]; [¬ψ → ¬φ in v]⟧ ⟹ ([φ in v] ⟹ [ψ in v])"
    using raa_cor_1 vdash_properties_10 by blast
  lemma raa_cor_4[PLM]:
    "⟦[¬φ in v]; [¬ψ → φ in v]⟧ ⟹ ([¬φ in v] ⟹ [ψ in v])"
    using raa_cor_2 vdash_properties_10 by blast

text‹
\begin{remark}
  In contrast to PLM the classical introduction and elimination rules are proven
  before the tautologies. The statements proven so far are sufficient
  for the proofs and using the derived rules the tautologies can be derived
  automatically.
\end{remark}
›

  lemma intro_elim_1[PLM]:
    "⟦[φ in v]; [ψ in v]⟧ ⟹ [φ & ψ in v]"
    unfolding conj_def using ded_thm_cor_4 if_p_then_p modus_tollens_2 by blast
  lemmas "&I" = intro_elim_1
  lemma intro_elim_2_a[PLM]:
    "[φ & ψ in v] ⟹ [φ in v]"
    unfolding conj_def using CP reductio_aa_1 by blast
  lemma intro_elim_2_b[PLM]:
    "[φ & ψ in v] ⟹ [ψ in v]"
    unfolding conj_def using pl_1 CP reductio_aa_1 axiom_instance by blast
  lemmas "&E" = intro_elim_2_a intro_elim_2_b
  lemma intro_elim_3_a[PLM]:
    "[φ in v] ⟹ [φ ∨ ψ in v]"
    unfolding disj_def using ded_thm_cor_4 useful_tautologies_3 by blast
  lemma intro_elim_3_b[PLM]:
    "[ψ in v] ⟹ [φ ∨ ψ in v]"
    by (simp only: disj_def vdash_properties_9)
  lemmas "∨I" = intro_elim_3_a intro_elim_3_b
  lemma intro_elim_4_a[PLM]:
    "⟦[φ ∨ ψ in v]; [φ → χ in v]; [ψ → χ in v]⟧ ⟹ [χ in v]"
    unfolding disj_def by (meson reductio_aa_2 vdash_properties_10)
  lemma intro_elim_4_b[PLM]:
    "⟦[φ ∨ ψ in v]; [¬φ in v]⟧ ⟹ [ψ in v]"
    unfolding disj_def using vdash_properties_10 by blast
  lemma intro_elim_4_c[PLM]:
    "⟦[φ ∨ ψ in v]; [¬ψ in v]⟧ ⟹ [φ in v]"
    unfolding disj_def using raa_cor_2 vdash_properties_10 by blast
  lemma intro_elim_4_d[PLM]:
    "⟦[φ ∨ ψ in v]; [φ → χ in v]; [ψ → Θ in v]⟧ ⟹ [χ ∨ Θ in v]"
    unfolding disj_def using contraposition_1 ded_thm_cor_3 by blast
  lemma intro_elim_4_e[PLM]:
    "⟦[φ ∨ ψ in v]; [φ ≡ χ in v]; [ψ ≡ Θ in v]⟧ ⟹ [χ ∨ Θ in v]"
    unfolding equiv_def using "&E"(1) intro_elim_4_d by blast
  lemmas "∨E" = intro_elim_4_a intro_elim_4_b intro_elim_4_c intro_elim_4_d
  lemma intro_elim_5[PLM]:
    "⟦[φ → ψ in v]; [ψ → φ in v]⟧ ⟹ [φ ≡ ψ in v]"
    by (simp only: equiv_def "&I")
  lemmas "≡I" = intro_elim_5
  lemma intro_elim_6_a[PLM]:
    "⟦[φ ≡ ψ in v]; [φ in v]⟧ ⟹ [ψ in v]"
    unfolding equiv_def using "&E"(1) vdash_properties_10 by blast
  lemma intro_elim_6_b[PLM]:
    "⟦[φ ≡ ψ in v]; [ψ in v]⟧ ⟹ [φ in v]"
    unfolding equiv_def using "&E"(2) vdash_properties_10 by blast
  lemma intro_elim_6_c[PLM]:
    "⟦[φ ≡ ψ in v]; [¬φ in v]⟧ ⟹ [¬ψ in v]"
    unfolding equiv_def using "&E"(2) modus_tollens_1 by blast
  lemma intro_elim_6_d[PLM]:
    "⟦[φ ≡ ψ in v]; [¬ψ in v]⟧ ⟹ [¬φ in v]"
    unfolding equiv_def using "&E"(1) modus_tollens_1 by blast
  lemma intro_elim_6_e[PLM]:
    "⟦[φ ≡ ψ in v]; [ψ ≡ χ in v]⟧ ⟹ [φ ≡ χ in v]"
    by (metis equiv_def ded_thm_cor_3 "&E" "≡I")
  lemma intro_elim_6_f[PLM]:
    "⟦[φ ≡ ψ in v]; [φ ≡ χ in v]⟧ ⟹ [χ ≡ ψ in v]"
    by (metis equiv_def ded_thm_cor_3 "&E" "≡I")
  lemmas "≡E" = intro_elim_6_a intro_elim_6_b intro_elim_6_c
                intro_elim_6_d intro_elim_6_e intro_elim_6_f
  lemma intro_elim_7[PLM]:
    "[φ in v] ⟹ [¬¬φ in v]"
    using if_p_then_p modus_tollens_2 by blast
  lemmas "¬¬I" = intro_elim_7
  lemma intro_elim_8[PLM]:
    "[¬¬φ in v] ⟹ [φ in v]"
    using if_p_then_p raa_cor_2 by blast
  lemmas "¬¬E" = intro_elim_8

  context
  begin
    private lemma NotNotI[PLM_intro]:
      "[φ in v] ⟹ [¬(¬φ) in v]"
      by (simp add: "¬¬I")
    private lemma NotNotD[PLM_dest]:
      "[¬(¬φ) in v] ⟹ [φ in v]"
      using "¬¬E" by blast

    private lemma ImplI[PLM_intro]:
      "([φ in v] ⟹ [ψ in v]) ⟹ [φ → ψ in v]"
      using CP .
    private lemma ImplE[PLM_elim, PLM_dest]:
      "[φ → ψ in v] ⟹ ([φ in v] ⟹ [ψ in v])"
      using modus_ponens .
    private lemma ImplS[PLM_subst]:
      "[φ → ψ in v] = ([φ in v] ⟶ [ψ in v])"
      using ImplI ImplE by blast

    private lemma NotI[PLM_intro]:
      "([φ in v] ⟹ (⋀ψ .[ψ in v])) ⟹ [¬φ in v]"
      using CP modus_tollens_2 by blast
    private lemma NotE[PLM_elim,PLM_dest]:
      "[¬φ in v] ⟹ ([φ in v] ⟶ (∀ψ .[ψ in v]))"
      using "∨I"(2) "∨E"(3) by blast
    private lemma NotS[PLM_subst]:
      "[¬φ in v] = ([φ in v] ⟶ (∀ψ .[ψ in v]))"
      using NotI NotE by blast

    private lemma ConjI[PLM_intro]:
      "⟦[φ in v]; [ψ in v]⟧ ⟹ [φ & ψ in v]"
      using "&I" by blast
    private lemma ConjE[PLM_elim,PLM_dest]:
      "[φ & ψ in v] ⟹ (([φ in v] ∧ [ψ in v]))"
      using CP "&E" by blast
    private lemma ConjS[PLM_subst]:
      "[φ & ψ in v] = (([φ in v] ∧ [ψ in v]))"
      using ConjI ConjE by blast

    private lemma DisjI[PLM_intro]:
      "[φ in v] ∨ [ψ in v] ⟹ [φ ∨ ψ in v]"
      using "∨I" by blast
    private lemma DisjE[PLM_elim,PLM_dest]:
      "[φ ∨ ψ in v] ⟹ [φ in v] ∨ [ψ in v]"
      using CP "∨E"(1) by blast
    private lemma DisjS[PLM_subst]:
      "[φ ∨ ψ in v] = ([φ in v] ∨ [ψ in v])"
      using DisjI DisjE by blast

    private lemma EquivI[PLM_intro]:
      "⟦[φ in v] ⟹ [ψ in v];[ψ in v] ⟹ [φ in v]⟧ ⟹ [φ ≡ ψ in v]"
      using CP "≡I" by blast
    private lemma EquivE[PLM_elim,PLM_dest]:
      "[φ ≡ ψ in v] ⟹ (([φ in v] ⟶ [ψ in v]) ∧ ([ψ in v] ⟶ [φ in v]))"
      using "≡E"(1) "≡E"(2) by blast
    private lemma EquivS[PLM_subst]:
      "[φ ≡ ψ in v] = ([φ in v] ⟷ [ψ in v])"
      using EquivI EquivE by blast

    private lemma NotOrD[PLM_dest]:
      "¬[φ ∨ ψ in v] ⟹ ¬[φ in v] ∧ ¬[ψ in v]"
      using "∨I" by blast
    private lemma NotAndD[PLM_dest]:
      "¬[φ & ψ in v] ⟹ ¬[φ in v] ∨ ¬[ψ in v]"
      using "&I" by blast
    private lemma NotEquivD[PLM_dest]:
      "¬[φ ≡ ψ in v] ⟹ [φ in v] ≠ [ψ in v]"
      by (meson NotI contraposition_1 "≡I" vdash_properties_9)

    private lemma BoxI[PLM_intro]:
      "(⋀ v . [φ in v]) ⟹ [□φ in v]"
      using RN by blast
    private lemma NotBoxD[PLM_dest]:
      "¬[□φ in v] ⟹ (∃ v . ¬[φ in v])"
      using BoxI by blast

    private lemma AllI[PLM_intro]:
      "(⋀ x . [φ x in v]) ⟹ [∀ x . φ x in v]"
      using rule_gen by blast
    lemma NotAllD[PLM_dest]:
      "¬[∀ x . φ x in v] ⟹ (∃ x . ¬[φ x in v])"
      using AllI by fastforce
  end

  lemma oth_class_taut_1_a[PLM]:
    "[¬(φ & ¬φ) in v]"
    by PLM_solver
  lemma oth_class_taut_1_b[PLM]:
    "[¬(φ ≡ ¬φ) in v]"
    by PLM_solver
  lemma oth_class_taut_2[PLM]:
    "[φ ∨ ¬φ in v]"
    by PLM_solver
  lemma oth_class_taut_3_a[PLM]:
    "[(φ & φ) ≡ φ in v]"
    by PLM_solver
  lemma oth_class_taut_3_b[PLM]:
    "[(φ & ψ) ≡ (ψ & φ) in v]"
    by PLM_solver
  lemma oth_class_taut_3_c[PLM]:
    "[(φ & (ψ & χ)) ≡ ((φ & ψ) & χ) in v]"
    by PLM_solver
  lemma oth_class_taut_3_d[PLM]:
    "[(φ ∨ φ) ≡ φ in v]"
    by PLM_solver
  lemma oth_class_taut_3_e[PLM]:
    "[(φ ∨ ψ) ≡ (ψ ∨ φ) in v]"
    by PLM_solver
  lemma oth_class_taut_3_f[PLM]:
    "[(φ ∨ (ψ ∨ χ)) ≡ ((φ ∨ ψ) ∨ χ) in v]"
    by PLM_solver
  lemma oth_class_taut_3_g[PLM]:
    "[(φ ≡ ψ) ≡ (ψ ≡ φ) in v]"
    by PLM_solver
  lemma oth_class_taut_3_i[PLM]:
    "[(φ ≡ (ψ ≡ χ)) ≡ ((φ ≡ ψ) ≡ χ) in v]"
    by PLM_solver
  lemma oth_class_taut_4_a[PLM]:
    "[φ ≡ φ in v]"
    by PLM_solver
  lemma oth_class_taut_4_b[PLM]:
    "[φ ≡ ¬¬φ in v]"
    by PLM_solver
  lemma oth_class_taut_5_a[PLM]:
    "[(φ → ψ) ≡ ¬(φ & ¬ψ) in v]"
    by PLM_solver
  lemma oth_class_taut_5_b[PLM]:
    "[¬(φ → ψ) ≡ (φ & ¬ψ) in v]"
    by PLM_solver
  lemma oth_class_taut_5_c[PLM]:
    "[(φ → ψ) → ((ψ → χ) → (φ → χ)) in v]"
    by PLM_solver
  lemma oth_class_taut_5_d[PLM]:
    "[(φ ≡ ψ) ≡ (¬φ ≡ ¬ψ) in v]"
    by PLM_solver
  lemma oth_class_taut_5_e[PLM]:
    "[(φ ≡ ψ) → ((φ → χ) ≡ (ψ → χ)) in v]"
    by PLM_solver
  lemma oth_class_taut_5_f[PLM]:
    "[(φ ≡ ψ) → ((χ → φ) ≡ (χ → ψ)) in v]"
    by PLM_solver
  lemma oth_class_taut_5_g[PLM]:
    "[(φ ≡ ψ) → ((φ ≡ χ) ≡ (ψ ≡ χ)) in v]"
    by PLM_solver
  lemma oth_class_taut_5_h[PLM]:
    "[(φ ≡ ψ) → ((χ ≡ φ) ≡ (χ ≡ ψ)) in v]"
    by PLM_solver
  lemma oth_class_taut_5_i[PLM]:
    "[(φ ≡ ψ) ≡ ((φ & ψ) ∨ (¬φ & ¬ψ)) in v]"
    by PLM_solver
  lemma oth_class_taut_5_j[PLM]:
    "[(¬(φ ≡ ψ)) ≡ ((φ & ¬ψ) ∨ (¬φ & ψ)) in v]"
    by PLM_solver
  lemma oth_class_taut_5_k[PLM]:
    "[(φ → ψ) ≡ (¬φ ∨ ψ) in v]"
    by PLM_solver

  lemma oth_class_taut_6_a[PLM]:
    "[(φ & ψ) ≡ ¬(¬φ ∨ ¬ψ) in v]"
    by PLM_solver
  lemma oth_class_taut_6_b[PLM]:
    "[(φ ∨ ψ) ≡ ¬(¬φ & ¬ψ) in v]"
    by PLM_solver
  lemma oth_class_taut_6_c[PLM]:
    "[¬(φ & ψ) ≡ (¬φ ∨ ¬ψ) in v]"
    by PLM_solver
  lemma oth_class_taut_6_d[PLM]:
    "[¬(φ ∨ ψ) ≡ (¬φ & ¬ψ) in v]"
    by PLM_solver

  lemma oth_class_taut_7_a[PLM]:
    "[(φ & (ψ ∨ χ)) ≡ ((φ & ψ) ∨ (φ & χ)) in v]"
    by PLM_solver
  lemma oth_class_taut_7_b[PLM]:
    "[(φ ∨ (ψ & χ)) ≡ ((φ ∨ ψ) & (φ ∨ χ)) in v]"
    by PLM_solver

  lemma oth_class_taut_8_a[PLM]:
    "[((φ & ψ) → χ) → (φ → (ψ → χ)) in v]"
    by PLM_solver
  lemma oth_class_taut_8_b[PLM]:
    "[(φ → (ψ → χ)) → ((φ & ψ) → χ) in v]"
    by PLM_solver

  lemma oth_class_taut_9_a[PLM]:
    "[(φ & ψ) → φ in v]"
    by PLM_solver
  lemma oth_class_taut_9_b[PLM]:
    "[(φ & ψ) → ψ in v]"
    by PLM_solver

  lemma oth_class_taut_10_a[PLM]:
    "[φ → (ψ → (φ & ψ)) in v]"
    by PLM_solver
  lemma oth_class_taut_10_b[PLM]:
    "[(φ → (ψ → χ)) ≡ (ψ → (φ → χ)) in v]"
    by PLM_solver
  lemma oth_class_taut_10_c[PLM]:
    "[(φ → ψ) → ((φ → χ) → (φ → (ψ & χ))) in v]"
    by PLM_solver
  lemma oth_class_taut_10_d[PLM]:
    "[(φ → χ) → ((ψ → χ) → ((φ ∨ ψ) → χ)) in v]"
    by PLM_solver
  lemma oth_class_taut_10_e[PLM]:
    "[(φ → ψ) → ((χ → Θ) → ((φ & χ) → (ψ & Θ))) in v]"
    by PLM_solver
  lemma oth_class_taut_10_f[PLM]:
    "[((φ & ψ) ≡ (φ & χ)) ≡ (φ → (ψ ≡ χ)) in v]"
    by PLM_solver
  lemma oth_class_taut_10_g[PLM]:
    "[((φ & ψ) ≡ (χ & ψ)) ≡ (ψ → (φ ≡ χ)) in v]"
    by PLM_solver

  attribute_setup equiv_lr = ‹
    Scan.succeed (Thm.rule_attribute [] 
      (fn _ => fn thm => thm RS @{thm "≡E"(1)}))
›

  attribute_setup equiv_rl = ‹
    Scan.succeed (Thm.rule_attribute [] 
      (fn _ => fn thm => thm RS @{thm "≡E"(2)}))
›

  attribute_setup equiv_sym = ‹
    Scan.succeed (Thm.rule_attribute [] 
      (fn _ => fn thm => thm RS @{thm oth_class_taut_3_g[equiv_lr]}))
›

  attribute_setup conj1 = ‹
    Scan.succeed (Thm.rule_attribute [] 
      (fn _ => fn thm => thm RS @{thm "&E"(1)}))
›

  attribute_setup conj2 = ‹
    Scan.succeed (Thm.rule_attribute [] 
      (fn _ => fn thm => thm RS @{thm "&E"(2)}))
›

  attribute_setup conj_sym = ‹
    Scan.succeed (Thm.rule_attribute [] 
      (fn _ => fn thm => thm RS @{thm oth_class_taut_3_b[equiv_lr]}))
›

  
subsection‹Identity›
text‹\label{TAO_PLM_Identity}›

  lemma id_eq_prop_prop_1[PLM]:
    "[(F::Π1) = F in v]"
    unfolding identity_defs by PLM_solver 
  lemma id_eq_prop_prop_2[PLM]:
    "[((F::Π1) = G) → (G = F) in v]"
    by (meson id_eq_prop_prop_1 CP ded_thm_cor_3 l_identity[axiom_instance])
  lemma id_eq_prop_prop_3[PLM]:
    "[(((F::Π1) = G) & (G = H)) → (F = H) in v]"
    by (metis l_identity[axiom_instance] ded_thm_cor_4 CP "&E")
  lemma id_eq_prop_prop_4_a[PLM]:
    "[(F::Π2) = F in v]"
    unfolding identity_defs by PLM_solver
  lemma id_eq_prop_prop_4_b[PLM]:
    "[(F::Π3) = F in v]"
    unfolding identity_defs by PLM_solver
  lemma id_eq_prop_prop_5_a[PLM]:
    "[((F::Π2) = G) → (G = F) in v]"
    by (meson id_eq_prop_prop_4_a CP ded_thm_cor_3 l_identity[axiom_instance])
  lemma id_eq_prop_prop_5_b[PLM]:
    "[((F::Π3) = G) → (G = F) in v]"
    by (meson id_eq_prop_prop_4_b CP ded_thm_cor_3 l_identity[axiom_instance])
  lemma id_eq_prop_prop_6_a[PLM]:
    "[(((F::Π2) = G) & (G = H)) → (F = H) in v]"
    by (metis l_identity[axiom_instance] ded_thm_cor_4 CP "&E")
  lemma id_eq_prop_prop_6_b[PLM]:
    "[(((F::Π3) = G) & (G = H)) → (F = H) in v]"
    by (metis l_identity[axiom_instance] ded_thm_cor_4 CP "&E")
  lemma id_eq_prop_prop_7[PLM]:
    "[(p::Π0) = p in v]"
    unfolding identity_defs by PLM_solver
  lemma id_eq_prop_prop_7_b[PLM]:
    "[(p::𝗈) = p in v]"
    unfolding identity_defs by PLM_solver
  lemma id_eq_prop_prop_8[PLM]:
    "[((p::Π0) = q) → (q = p) in v]"
    by (meson id_eq_prop_prop_7 CP ded_thm_cor_3 l_identity[axiom_instance])
  lemma id_eq_prop_prop_8_b[PLM]:
    "[((p::𝗈) = q) → (q = p) in v]"
    by (meson id_eq_prop_prop_7_b CP ded_thm_cor_3 l_identity[axiom_instance])
  lemma id_eq_prop_prop_9[PLM]:
    "[(((p::Π0) = q) & (q = r)) → (p = r) in v]"
    by (metis l_identity[axiom_instance] ded_thm_cor_4 CP "&E")
  lemma id_eq_prop_prop_9_b[PLM]:
    "[(((p::𝗈) = q) & (q = r)) → (p = r) in v]"
    by (metis l_identity[axiom_instance] ded_thm_cor_4 CP "&E")

  lemma eq_E_simple_1[PLM]:
    "[(x =E y) ≡ (⦇O!,x⦈ & ⦇O!,y⦈ & □(∀F . ⦇F,x⦈ ≡ ⦇F,y⦈)) in v]"
    proof (rule "≡I"; rule CP)
      assume 1: "[x =E y in v]"
      have "[∀ x y . ((xP) =E (yP)) ≡ (⦇O!,xP⦈ & ⦇O!,yP⦈
              & □(∀F . ⦇F,xP⦈ ≡ ⦇F,yP⦈)) in v]"
        unfolding identityE_infix_def identityE_def
        apply (rule lambda_predicates_2_2[axiom_universal, axiom_universal, axiom_instance])
        by show_proper
      moreover have "[∃ α . (αP) = x in v]"
        apply (rule cqt_5_mod[where ψ="λ x . x =E y", axiom_instance,deduction])
        unfolding identityE_infix_def
        apply (rule SimpleExOrEnc.intros)
        using 1 unfolding identityE_infix_def by auto
      moreover have "[∃ β . (βP) = y in v]"
        apply (rule cqt_5_mod[where ψ="λ y . x =E y",axiom_instance,deduction])
        unfolding identityE_infix_def
        apply (rule SimpleExOrEnc.intros) using 1
        unfolding identityE_infix_def by auto
      ultimately have "[(x =E y) ≡ (⦇O!,x⦈ & ⦇O!,y⦈
                        & □(∀F . ⦇F,x⦈ ≡ ⦇F,y⦈)) in v]"
        using cqt_1_κ[axiom_instance,deduction, deduction] by meson
      thus "[(⦇O!,x⦈ & ⦇O!,y⦈ & □(∀F . ⦇F,x⦈ ≡ ⦇F,y⦈)) in v]"
        using 1 "≡E"(1) by blast
    next
      assume 1: "[⦇O!,x⦈ & ⦇O!,y⦈ & □(∀F. ⦇F,x⦈ ≡ ⦇F,y⦈) in v]"
      have "[∀ x y . ((xP) =E (yP)) ≡ (⦇O!,xP⦈ & ⦇O!,yP⦈
              & □(∀F . ⦇F,xP⦈ ≡ ⦇F,yP⦈)) in v]"
        unfolding identityE_def identityE_infix_def
        apply (rule lambda_predicates_2_2[axiom_universal, axiom_universal, axiom_instance])
        by show_proper
      moreover have "[∃ α . (αP) = x in v]"
        apply (rule cqt_5_mod[where ψ="λ x . ⦇O!,x⦈",axiom_instance,deduction])
        apply (rule SimpleExOrEnc.intros)
        using 1[conj1,conj1] by auto
      moreover have "[∃ β . (βP) = y in v]"
        apply (rule cqt_5_mod[where ψ="λ y . ⦇O!,y⦈",axiom_instance,deduction])
         apply (rule SimpleExOrEnc.intros)
        using 1[conj1,conj2] by auto
      ultimately have "[(x =E y) ≡ (⦇O!,x⦈ & ⦇O!,y⦈
                        & □(∀F . ⦇F,x⦈ ≡ ⦇F,y⦈)) in v]"
      using cqt_1_κ[axiom_instance,deduction, deduction] by meson
      thus "[(x =E y) in v]" using 1 "≡E"(2) by blast
    qed
  lemma eq_E_simple_2[PLM]:
    "[(x =E y) → (x = y) in v]"
    unfolding identity_defs by PLM_solver
  lemma eq_E_simple_3[PLM]:
    "[(x = y) ≡ ((⦇O!,x⦈ & ⦇O!,y⦈ & □(∀F . ⦇F,x⦈ ≡ ⦇F,y⦈))
               ∨ (⦇A!,x⦈ & ⦇A!,y⦈ & □(∀F. ⦃x,F⦄ ≡ ⦃y,F⦄))) in v]"
    using eq_E_simple_1
    apply - unfolding identity_defs
    by PLM_solver

  lemma id_eq_obj_1[PLM]: "[(xP) = (xP) in v]"
    proof -
      have "[(◇⦇E!, xP⦈) ∨ (¬◇⦇E!, xP⦈) in v]"
        using PLM.oth_class_taut_2 by simp
      hence "[(◇⦇E!, xP⦈) in v] ∨ [(¬◇⦇E!, xP⦈) in v]"
        using CP "∨E"(1) by blast
      moreover {
        assume "[(◇⦇E!, xP⦈) in v]"
        hence "[⦇λx. ◇⦇E!,xP⦈,xP⦈ in v]"
          apply (rule lambda_predicates_2_1[axiom_instance, equiv_rl, rotated])
          by show_proper
        hence "[⦇λx. ◇⦇E!,xP⦈,xP⦈ & ⦇λx. ◇⦇E!,xP⦈,xP⦈
                & □(∀F. ⦇F,xP⦈ ≡ ⦇F,xP⦈) in v]"
          apply - by PLM_solver
        hence "[(xP) =E (xP) in v]"
          using eq_E_simple_1[equiv_rl] unfolding Ordinary_def by fast
      }
      moreover {
        assume "[(¬◇⦇E!, xP⦈) in v]"
        hence "[⦇λx. ¬◇⦇E!,xP⦈,xP⦈ in v]"
          apply (rule lambda_predicates_2_1[axiom_instance, equiv_rl, rotated])
          by show_proper
        hence "[⦇λx. ¬◇⦇E!,xP⦈,xP⦈ & ⦇λx. ¬◇⦇E!,xP⦈,xP⦈
                & □(∀F. ⦃xP,F⦄ ≡ ⦃xP,F⦄) in v]"
          apply - by PLM_solver
      }
      ultimately show ?thesis unfolding identity_defs Ordinary_def Abstract_def
        using "∨I" by blast
    qed
  lemma id_eq_obj_2[PLM]:
    "[((xP) = (yP)) → ((yP) = (xP)) in v]"
    by (meson l_identity[axiom_instance] id_eq_obj_1 CP ded_thm_cor_3)
  lemma id_eq_obj_3[PLM]:
    "[((xP) = (yP)) & ((yP) = (zP)) → ((xP) = (zP)) in v]"
    by (metis l_identity[axiom_instance] ded_thm_cor_4 CP "&E")
end

text‹
\begin{remark}
  To unify the statements of the properties of equality a type class is introduced.
\end{remark}
›

class id_eq = quantifiable_and_identifiable +
  assumes id_eq_1: "[(x :: 'a) = x in v]"
  assumes id_eq_2: "[((x :: 'a) = y) → (y = x) in v]"
  assumes id_eq_3: "[((x :: 'a) = y) & (y = z) → (x = z) in v]"

instantiation ν :: id_eq
begin
  instance proof
    fix x :: ν and v
    show "[x = x in v]"
      using PLM.id_eq_obj_1
      by (simp add: identity_ν_def)
  next
    fix x y::ν and v
    show "[x = y → y = x in v]"
      using PLM.id_eq_obj_2
      by (simp add: identity_ν_def)
  next
    fix x y z::ν and v
    show "[((x = y) & (y = z)) → x = z in v]"
      using PLM.id_eq_obj_3
      by (simp add: identity_ν_def)
  qed
end

instantiation 𝗈 :: id_eq
begin
  instance proof
    fix x :: 𝗈 and v
    show "[x = x in v]"
      using PLM.id_eq_prop_prop_7 .
  next
    fix x y :: 𝗈 and v
    show "[x = y → y = x in v]"
      using PLM.id_eq_prop_prop_8 .
  next
    fix x y z :: 𝗈 and v
    show "[((x = y) & (y = z)) → x = z in v]"
      using PLM.id_eq_prop_prop_9 .
  qed
end

instantiation Π1 :: id_eq
begin
  instance proof
    fix x :: Π1 and v
    show "[x = x in v]"
      using PLM.id_eq_prop_prop_1 .
  next
    fix x y :: Π1 and v
    show "[x = y → y = x in v]"
      using PLM.id_eq_prop_prop_2 .
  next
    fix x y z :: Π1 and v
    show "[((x = y) & (y = z)) → x = z in v]"
      using PLM.id_eq_prop_prop_3 .
  qed
end

instantiation Π2 :: id_eq
begin
  instance proof
    fix x :: Π2 and v
    show "[x = x in v]"
      using PLM.id_eq_prop_prop_4_a .
  next
    fix x y :: Π2 and v
    show "[x = y → y = x in v]"
      using PLM.id_eq_prop_prop_5_a .
  next
    fix x y z :: Π2 and v
    show "[((x = y) & (y = z)) → x = z in v]"
      using PLM.id_eq_prop_prop_6_a .
  qed
end

instantiation Π3 :: id_eq
begin
  instance proof
    fix x :: Π3 and v
    show "[x = x in v]"
      using PLM.id_eq_prop_prop_4_b .
  next
    fix x y :: Π3 and v
    show "[x = y → y = x in v]"
      using PLM.id_eq_prop_prop_5_b .
  next
    fix x y z :: Π3 and v
    show "[((x = y) & (y = z)) → x = z in v]"
      using PLM.id_eq_prop_prop_6_b .
  qed
end

context PLM
begin
  lemma id_eq_1[PLM]:
    "[(x::'a::id_eq) = x in v]"
    using id_eq_1 .
  lemma id_eq_2[PLM]:
    "[((x::'a::id_eq) = y) → (y = x) in v]"
    using id_eq_2 .
  lemma id_eq_3[PLM]:
    "[((x::'a::id_eq) = y) & (y = z) → (x = z) in v]"
    using id_eq_3 .

  attribute_setup eq_sym = ‹
    Scan.succeed (Thm.rule_attribute [] 
      (fn _ => fn thm => thm RS @{thm id_eq_2[deduction]}))
›


  lemma all_self_eq_1[PLM]:
    "[□(∀ α :: 'a::id_eq . α = α) in v]"
    by PLM_solver
  lemma all_self_eq_2[PLM]:
    "[∀α :: 'a::id_eq . □(α = α) in v]"
    by PLM_solver

  lemma t_id_t_proper_1[PLM]:
    "[τ = τ' → (∃ β . (βP) = τ) in v]"
    proof (rule CP)
      assume "[τ = τ' in v]"
      moreover {
        assume "[τ =E τ' in v]"
        hence "[∃ β . (βP) = τ in v]"
          apply -
          apply (rule cqt_5_mod[where ψ="λ τ . τ =E τ'", axiom_instance, deduction])
           subgoal unfolding identity_defs by (rule SimpleExOrEnc.intros)
          by simp
      }
      moreover {
        assume "[⦇A!,τ⦈ & ⦇A!,τ'⦈ & □(∀F. ⦃τ,F⦄ ≡ ⦃τ',F⦄) in v]"
        hence "[∃ β . (βP) = τ in v]"
          apply -
          apply (rule cqt_5_mod[where ψ="λ τ . ⦇A!,τ⦈", axiom_instance, deduction])
           subgoal unfolding identity_defs by (rule SimpleExOrEnc.intros)
          by PLM_solver
      }
      ultimately show "[∃ β . (βP) = τ in v]" unfolding identityκ_def
        using intro_elim_4_b reductio_aa_1 by blast
    qed

  lemma t_id_t_proper_2[PLM]: "[τ = τ' → (∃ β . (βP) = τ') in v]"
  proof (rule CP)
    assume "[τ = τ' in v]"
    moreover {
      assume "[τ =E τ' in v]"
      hence "[∃ β . (βP) = τ' in v]"
        apply -
        apply (rule cqt_5_mod[where ψ="λ τ' . τ =E τ'", axiom_instance, deduction])
         subgoal unfolding identity_defs by (rule SimpleExOrEnc.intros)
        by simp
    }
    moreover {
      assume "[⦇A!,τ⦈ & ⦇A!,τ'⦈ & □(∀F. ⦃τ,F⦄ ≡ ⦃τ',F⦄) in v]"
      hence "[∃ β . (βP) = τ' in v]"
        apply -
        apply (rule cqt_5_mod[where ψ="λ τ . ⦇A!,τ⦈", axiom_instance, deduction])
         subgoal unfolding identity_defs by (rule SimpleExOrEnc.intros)
        by PLM_solver
    }
    ultimately show "[∃ β . (βP) = τ' in v]" unfolding identityκ_def
      using intro_elim_4_b reductio_aa_1 by blast
  qed

  lemma id_nec[PLM]: "[((α::'a::id_eq) = (β)) ≡ □((α) = (β)) in v]"
    apply (rule "≡I")
     using l_identity[where φ = "(λ β .  □((α) = (β)))", axiom_instance]
           id_eq_1 RN ded_thm_cor_4 unfolding identity_ν_def
     apply blast
    using qml_2[axiom_instance] by blast

  lemma id_nec_desc[PLM]:
    "[((ιx. φ x) = (ιx. ψ x)) ≡ □((ιx. φ x) = (ιx. ψ x)) in v]"
    proof (cases "[(∃ α. (αP) = (ιx . φ x)) in v] ∧ [(∃ β. (βP) = (ιx . ψ x)) in v]")
      assume "[(∃ α. (αP) = (ιx . φ x)) in v] ∧ [(∃ β. (βP) = (ιx . ψ x)) in v]"
      then obtain α and β where
        "[(αP) = (ιx . φ x) in v] ∧ [(βP) = (ιx . ψ x) in v]"
        apply - unfolding conn_defs by PLM_solver
      moreover {
        moreover have "[(α) = (β) ≡ □((α) = (β)) in v]" by PLM_solver
        ultimately have "[((ιx. φ x) = (βP) ≡ □((ιx. φ x) = (βP))) in v]"
          using l_identity[where φ="λ α . (α) = (βP) ≡ □((α) = (βP))", axiom_instance]
          modus_ponens unfolding identity_ν_def by metis
      }
      ultimately show ?thesis
        using l_identity[where φ="λ α . (ιx . φ x) = (α)
                                   ≡ □((ιx . φ x) = (α))", axiom_instance]
        modus_ponens by metis
    next
      assume "¬([(∃ α. (αP) = (ιx . φ x)) in v] ∧ [(∃ β. (βP) = (ιx . ψ x)) in v])"
      hence "¬[⦇A!,(ιx . φ x)⦈ in v] ∧ ¬[(ιx . φ x) =E (ιx . ψ x) in v]
           ∨ ¬[⦇A!,(ιx . ψ x)⦈ in v] ∧ ¬[(ιx . φ x) =E (ιx . ψ x) in v]"
      unfolding identityE_infix_def
      using cqt_5[axiom_instance] PLM.contraposition_1 SimpleExOrEnc.intros
            vdash_properties_10 by meson
      hence "¬[(ιx . φ x) = (ιx . ψ x) in v]"
        apply - unfolding identity_defs by PLM_solver
      thus ?thesis apply - apply PLM_solver
        using qml_2[axiom_instance, deduction] by auto
    qed

subsection‹Quantification›
text‹\label{TAO_PLM_Quantification}›

  lemma rule_ui[PLM,PLM_elim,PLM_dest]:
    "[∀α . φ α in v] ⟹ [φ β in v]"
    by (meson cqt_1[axiom_instance, deduction])
  lemmas "∀E" = rule_ui

  lemma rule_ui_2[PLM,PLM_elim,PLM_dest]:
    "⟦[∀α . φ (αP) in v]; [∃ α . (α)P = β in v]⟧ ⟹ [φ β in v]"
    using cqt_1_κ[axiom_instance, deduction, deduction] by blast

  lemma cqt_orig_1[PLM]:
    "[(∀α. φ α) → φ β in v]"
    by PLM_solver
  lemma cqt_orig_2[PLM]:
    "[(∀α. φ → ψ α) → (φ → (∀α. ψ α)) in v]"
    by PLM_solver

  lemma universal[PLM]:
    "(⋀α . [φ α in v]) ⟹ [∀ α . φ α in v]"
    using rule_gen .
  lemmas "∀I" = universal

  lemma cqt_basic_1[PLM]:
    "[(∀α. (∀β . φ α β)) ≡ (∀β. (∀α. φ α β)) in v]"
    by PLM_solver
  lemma cqt_basic_2[PLM]:
    "[(∀α. φ α ≡ ψ α) ≡ ((∀α. φ α → ψ α) & (∀α. ψ α → φ α)) in v]"
    by PLM_solver
  lemma cqt_basic_3[PLM]:
    "[(∀α. φ α ≡ ψ α) → ((∀α. φ α) ≡ (∀α. ψ α)) in v]"
    by PLM_solver
  lemma cqt_basic_4[PLM]:
    "[(∀α. φ α & ψ α) ≡ ((∀α. φ α) & (∀α. ψ α)) in v]"
    by PLM_solver
  lemma cqt_basic_6[PLM]:
    "[(∀α. (∀α. φ α)) ≡ (∀α. φ α) in v]"
    by PLM_solver
  lemma cqt_basic_7[PLM]:
    "[(φ → (∀α . ψ α)) ≡ (∀α.(φ → ψ α)) in v]"
    by PLM_solver
  lemma cqt_basic_8[PLM]:
    "[((∀α. φ α) ∨ (∀α. ψ α)) → (∀α. (φ α ∨ ψ α)) in v]"
    by PLM_solver
  lemma cqt_basic_9[PLM]:
    "[((∀α. φ α → ψ α) & (∀α. ψ α → χ α)) → (∀α. φ α → χ α) in v]"
    by PLM_solver
  lemma cqt_basic_10[PLM]:
    "[((∀α. φ α ≡ ψ α) & (∀α. ψ α ≡ χ α)) → (∀α. φ α ≡ χ α) in v]"
    by PLM_solver
  lemma cqt_basic_11[PLM]:
    "[(∀α. φ α ≡ ψ α) ≡ (∀α. ψ α ≡ φ α) in v]"
    by PLM_solver
  lemma cqt_basic_12[PLM]:
    "[(∀α. φ α) ≡ (∀β. φ β) in v]"
    by PLM_solver

  lemma existential[PLM,PLM_intro]:
    "[φ α in v] ⟹ [∃ α. φ α in v]"
    unfolding exists_def by PLM_solver
  lemmas "∃I" = existential
  lemma instantiation_[PLM,PLM_elim,PLM_dest]:
    "⟦[∃α . φ α in v]; (⋀α.[φ α in v] ⟹ [ψ in v])⟧ ⟹ [ψ in v]"
    unfolding exists_def by PLM_solver

  lemma Instantiate:
    assumes "[∃ x . φ x  in v]"
    obtains x where "[φ x in v]"
    apply (insert assms) unfolding exists_def by PLM_solver
  lemmas "∃E" = Instantiate

  lemma cqt_further_1[PLM]:
    "[(∀α. φ α) → (∃α. φ α) in v]"
    by PLM_solver
  lemma cqt_further_2[PLM]:
    "[(¬(∀α. φ α)) ≡ (∃α. ¬φ α) in v]"
    unfolding exists_def by PLM_solver
  lemma cqt_further_3[PLM]:
    "[(∀α. φ α) ≡ ¬(∃α. ¬φ α) in v]"
    unfolding exists_def by PLM_solver
  lemma cqt_further_4[PLM]:
    "[(¬(∃α. φ α)) ≡ (∀α. ¬φ α) in v]"
    unfolding exists_def by PLM_solver
  lemma cqt_further_5[PLM]:
    "[(∃α. φ α & ψ α) → ((∃α. φ α) & (∃α. ψ α)) in v]"
      unfolding exists_def by PLM_solver
  lemma cqt_further_6[PLM]:
    "[(∃α. φ α ∨ ψ α) ≡ ((∃α. φ α) ∨ (∃α. ψ α)) in v]"
    unfolding exists_def by PLM_solver
  lemma cqt_further_10[PLM]:
    "[(φ (α::'a::id_eq) & (∀ β . φ β → β = α)) ≡ (∀ β . φ β ≡ β = α) in v]"
    apply PLM_solver
     using l_identity[axiom_instance, deduction, deduction] id_eq_2[deduction]
     apply blast
    using id_eq_1 by auto
  lemma cqt_further_11[PLM]:
    "[((∀α. φ α) & (∀α. ψ α)) → (∀α. φ α ≡ ψ α) in v]"
    by PLM_solver
  lemma cqt_further_12[PLM]:
    "[((¬(∃α. φ α)) & (¬(∃α. ψ α))) → (∀α. φ α ≡ ψ α) in v]"
    unfolding exists_def by PLM_solver
  lemma cqt_further_13[PLM]:
    "[((∃α. φ α) & (¬(∃α. ψ α))) → (¬(∀α. φ α ≡ ψ α)) in v]"
    unfolding exists_def by PLM_solver
  lemma cqt_further_14[PLM]:
    "[(∃α. ∃β. φ α β) ≡ (∃β. ∃α. φ α β) in v]"
    unfolding exists_def by PLM_solver

  lemma nec_exist_unique[PLM]:
    "[(∀ x. φ x → □(φ x)) → ((∃!x. φ x) → (∃!x. □(φ x))) in v]"
    proof (rule CP)
      assume a: "[∀x. φ x → □φ x in v]"
      show "[(∃!x. φ x) → (∃!x. □φ x) in v]"
      proof (rule CP)
        assume "[(∃!x. φ x) in v]"
        hence "[∃α. φ α & (∀β. φ β → β = α) in v]"
          by (simp only: exists_unique_def)
        then obtain α where 1:
          "[φ α & (∀β. φ β → β = α) in v]"
          by (rule "∃E")
        {
          fix β
          have "[□φ β → β = α in v]"
            using 1 "&E"(2) qml_2[axiom_instance]
              ded_thm_cor_3 "∀E" by fastforce
        }
        hence "[∀β. □φ β → β = α in v]" by (rule "∀I")
        moreover have "[□(φ α) in v]"
          using 1 "&E"(1) a vdash_properties_10 cqt_orig_1[deduction]
          by fast
        ultimately have "[∃α. □(φ α) & (∀β. □φ β → β = α) in v]"
          using "&I" "∃I" by fast
        thus "[(∃!x. □φ x) in v]"
          unfolding exists_unique_def by assumption
      qed
    qed


subsection‹Actuality and Descriptions›
text‹\label{TAO_PLM_ActualityAndDescriptions}›

  lemma nec_imp_act[PLM]: "[□φ → 𝒜φ in v]"
    apply (rule CP)
    using qml_act_2[axiom_instance, equiv_lr]
          qml_2[axiom_actualization, axiom_instance]
          logic_actual_nec_2[axiom_instance, equiv_lr, deduction]
    by blast
  lemma act_conj_act_1[PLM]:
    "[𝒜(𝒜φ → φ) in v]"
    using equiv_def logic_actual_nec_2[axiom_instance]
          logic_actual_nec_4[axiom_instance] "&E"(2) "≡E"(2)
    by metis
  lemma act_conj_act_2[PLM]:
    "[𝒜(φ → 𝒜φ) in v]"
    using logic_actual_nec_2[axiom_instance] qml_act_1[axiom_instance]
          ded_thm_cor_3 "≡E"(2) nec_imp_act
    by blast
  lemma act_conj_act_3[PLM]:
    "[(𝒜φ & 𝒜ψ) → 𝒜(φ & ψ) in v]"
    unfolding conn_defs
    by (metis logic_actual_nec_2[axiom_instance]
              logic_actual_nec_1[axiom_instance]
              "≡E"(2) CP "≡E"(4) reductio_aa_2
              vdash_properties_10)
  lemma act_conj_act_4[PLM]:
    "[𝒜(𝒜φ ≡ φ) in v]"
    unfolding equiv_def
    by (PLM_solver PLM_intro: act_conj_act_3[where φ="𝒜φ → φ"
                                and ψ="φ → 𝒜φ", deduction])
  lemma closure_act_1a[PLM]:
    "[𝒜𝒜(𝒜φ ≡ φ) in v]"
    using logic_actual_nec_4[axiom_instance]
          act_conj_act_4 "≡E"(1)
    by blast
  lemma closure_act_1b[PLM]:
    "[𝒜𝒜𝒜(𝒜φ ≡ φ) in v]"
    using logic_actual_nec_4[axiom_instance]
          act_conj_act_4 "≡E"(1)
    by blast
  lemma closure_act_1c[PLM]:
    "[𝒜𝒜𝒜𝒜(𝒜φ ≡ φ) in v]"
    using logic_actual_nec_4[axiom_instance]
          act_conj_act_4 "≡E"(1)
    by blast
  lemma closure_act_2[PLM]:
    "[∀α. 𝒜(𝒜(φ α) ≡ φ α) in v]"
    by PLM_solver

  lemma closure_act_3[PLM]:
    "[𝒜(∀α. 𝒜(φ α) ≡ φ α) in v]"
    by (PLM_solver PLM_intro: logic_actual_nec_3[axiom_instance, equiv_rl])
  lemma closure_act_4[PLM]:
    "[𝒜(∀α1 α2. 𝒜(φ α1 α2) ≡ φ α1 α2) in v]"
    by (PLM_solver PLM_intro: logic_actual_nec_3[axiom_instance, equiv_rl])
  lemma closure_act_4_b[PLM]:
    "[𝒜(∀α1 α2 α3. 𝒜(φ α1 α2 α3) ≡ φ α1 α2 α3) in v]"
    by (PLM_solver PLM_intro: logic_actual_nec_3[axiom_instance, equiv_rl])
  lemma closure_act_4_c[PLM]:
    "[𝒜(∀α1 α2 α3 α4. 𝒜(φ α1 α2 α3 α4) ≡ φ α1 α2 α3 α4) in v]"
    by (PLM_solver PLM_intro: logic_actual_nec_3[axiom_instance, equiv_rl])

  lemma RA[PLM,PLM_intro]:
    "([φ in dw]) ⟹ [𝒜φ in dw]"
    using logic_actual[necessitation_averse_axiom_instance, equiv_rl] .

  lemma RA_2[PLM,PLM_intro]:
    "([ψ in dw] ⟹ [φ in dw]) ⟹ ([𝒜ψ in dw] ⟹ [𝒜φ in dw])"
    using RA logic_actual[necessitation_averse_axiom_instance] intro_elim_6_a by blast

  context
  begin
    private lemma ActualE[PLM,PLM_elim,PLM_dest]:
      "[𝒜φ in dw] ⟹ [φ in dw]"
      using logic_actual[necessitation_averse_axiom_instance, equiv_lr] .
    
    private lemma NotActualD[PLM_dest]:
      "¬[𝒜φ in dw] ⟹ ¬[φ in dw]"
      using RA by metis
    
    private lemma ActualImplI[PLM_intro]:
      "[𝒜φ → 𝒜ψ in v] ⟹ [𝒜(φ → ψ) in v]"
      using logic_actual_nec_2[axiom_instance, equiv_rl] .
    private lemma ActualImplE[PLM_dest, PLM_elim]:
      "[𝒜(φ → ψ) in v] ⟹ [𝒜φ → 𝒜ψ in v]"
      using logic_actual_nec_2[axiom_instance, equiv_lr] .
    private lemma NotActualImplD[PLM_dest]:
      "¬[𝒜(φ → ψ) in v] ⟹ ¬[𝒜φ → 𝒜ψ in v]"
      using ActualImplI by blast
    
    private lemma ActualNotI[PLM_intro]:
      "[¬𝒜φ in v] ⟹ [𝒜¬φ in v]"
      using logic_actual_nec_1[axiom_instance, equiv_rl] .
    lemma ActualNotE[PLM_elim,PLM_dest]:
      "[𝒜¬φ in v] ⟹ [¬𝒜φ in v]"
      using logic_actual_nec_1[axiom_instance, equiv_lr] .
    lemma NotActualNotD[PLM_dest]:
      "¬[𝒜¬φ in v] ⟹ ¬[¬𝒜φ in v]"
      using ActualNotI by blast
    
    private  lemma ActualConjI[PLM_intro]:
      "[𝒜φ & 𝒜ψ in v] ⟹ [𝒜(φ & ψ) in v]"
      unfolding equiv_def
      by (PLM_solver PLM_intro: act_conj_act_3[deduction])
    private lemma ActualConjE[PLM_elim,PLM_dest]:
      "[𝒜(φ & ψ) in v] ⟹ [𝒜φ & 𝒜ψ in v]"
      unfolding conj_def by PLM_solver
    
    private lemma ActualEquivI[PLM_intro]:
      "[𝒜φ ≡ 𝒜ψ in v] ⟹ [𝒜(φ ≡ ψ) in v]"
      unfolding equiv_def
      by (PLM_solver PLM_intro: act_conj_act_3[deduction])
    private lemma ActualEquivE[PLM_elim, PLM_dest]:
      "[𝒜(φ ≡ ψ) in v] ⟹ [𝒜φ ≡ 𝒜ψ in v]"
      unfolding equiv_def by PLM_solver

    private lemma ActualBoxI[PLM_intro]:
      "[□φ in v] ⟹ [𝒜(□φ) in v]"
      using qml_act_2[axiom_instance, equiv_lr] .
    private lemma ActualBoxE[PLM_elim, PLM_dest]:
      "[𝒜(□φ) in v] ⟹ [□φ in v]"
      using qml_act_2[axiom_instance, equiv_rl] .
    private lemma NotActualBoxD[PLM_dest]:
      "¬[𝒜(□φ) in v] ⟹ ¬[□φ in v]"
      using ActualBoxI by blast

    private lemma ActualDisjI[PLM_intro]:
      "[𝒜φ ∨ 𝒜ψ in v] ⟹ [𝒜(φ ∨ ψ) in v]"
      unfolding disj_def by PLM_solver
    private lemma ActualDisjE[PLM_elim,PLM_dest]:
      "[𝒜(φ ∨ ψ) in v] ⟹ [𝒜φ ∨ 𝒜ψ in v]"
      unfolding disj_def by PLM_solver
    private lemma NotActualDisjD[PLM_dest]:
      "¬[𝒜(φ ∨ ψ) in v] ⟹ ¬[𝒜φ ∨ 𝒜ψ in v]"
      using ActualDisjI by blast

    private lemma ActualForallI[PLM_intro]:
      "[∀ x . 𝒜(φ x) in v] ⟹ [𝒜(∀ x . φ x) in v]"
      using logic_actual_nec_3[axiom_instance, equiv_rl] .
    lemma ActualForallE[PLM_elim,PLM_dest]:
      "[𝒜(∀ x . φ x) in v] ⟹ [∀ x . 𝒜(φ x) in v]"
      using logic_actual_nec_3[axiom_instance, equiv_lr] .
    lemma NotActualForallD[PLM_dest]:
      "¬[𝒜(∀ x . φ x) in v] ⟹ ¬[∀ x . 𝒜(φ x) in v]"
      using ActualForallI by blast

    lemma ActualActualI[PLM_intro]:
      "[𝒜φ in v] ⟹ [𝒜𝒜φ in v]"
      using logic_actual_nec_4[axiom_instance, equiv_lr] .
    lemma ActualActualE[PLM_elim,PLM_dest]:
      "[𝒜𝒜φ in v] ⟹ [𝒜φ in v]"
      using logic_actual_nec_4[axiom_instance, equiv_rl] .
    lemma NotActualActualD[PLM_dest]:
      "¬[𝒜𝒜φ in v] ⟹ ¬[𝒜φ in v]"
      using ActualActualI by blast
  end

  lemma ANeg_1[PLM]:
    "[¬𝒜φ ≡ ¬φ in dw]"
    by PLM_solver
  lemma ANeg_2[PLM]:
    "[¬𝒜¬φ ≡ φ in dw]"
    by PLM_solver
  lemma Act_Basic_1[PLM]:
    "[𝒜φ ∨ 𝒜¬φ in v]"
    by PLM_solver
  lemma Act_Basic_2[PLM]:
    "[𝒜(φ & ψ) ≡ (𝒜φ & 𝒜ψ) in v]"
    by PLM_solver
  lemma Act_Basic_3[PLM]:
    "[𝒜(φ ≡ ψ) ≡ ((𝒜(φ → ψ)) & (𝒜(ψ → φ))) in v]"
    by PLM_solver
  lemma Act_Basic_4[PLM]:
    "[(𝒜(φ → ψ) & 𝒜(ψ → φ)) ≡ (𝒜φ ≡ 𝒜ψ) in v]"
    by PLM_solver
  lemma Act_Basic_5[PLM]:
    "[𝒜(φ ≡ ψ) ≡ (𝒜φ ≡ 𝒜ψ) in v]"
    by PLM_solver
  lemma Act_Basic_6[PLM]:
    "[◇φ ≡ 𝒜(◇φ) in v]"
    unfolding diamond_def by PLM_solver
  lemma Act_Basic_7[PLM]:
    "[𝒜φ ≡ □𝒜φ in v]"
    by (simp add: qml_2[axiom_instance] qml_act_1[axiom_instance] "≡I")
  lemma Act_Basic_8[PLM]:
    "[𝒜(□φ) → □𝒜φ in v]"
    by (metis qml_act_2[axiom_instance] CP Act_Basic_7 "≡E"(1)
              "≡E"(2) nec_imp_act vdash_properties_10)
  lemma Act_Basic_9[PLM]:
    "[□φ → □𝒜φ in v]"
    using qml_act_1[axiom_instance] ded_thm_cor_3 nec_imp_act by blast
  lemma Act_Basic_10[PLM]:
    "[𝒜(φ ∨ ψ) ≡ 𝒜φ ∨ 𝒜ψ in v]"
    by PLM_solver

  lemma Act_Basic_11[PLM]:
    "[𝒜(∃α. φ α) ≡ (∃α.𝒜(φ α)) in v]"
    proof -
      have "[𝒜(∀ α . ¬φ α) ≡ (∀ α . 𝒜¬φ α) in v]"
        using logic_actual_nec_3[axiom_instance] by blast
      hence "[¬𝒜(∀ α . ¬φ α) ≡ ¬(∀ α . 𝒜¬φ α) in v]"
        using oth_class_taut_5_d[equiv_lr] by blast
      moreover have "[𝒜¬(∀ α . ¬φ α) ≡ ¬𝒜(∀ α . ¬φ α) in v]"
        using logic_actual_nec_1[axiom_instance] by blast
      ultimately have "[𝒜¬(∀ α . ¬φ α) ≡ ¬(∀ α . 𝒜¬φ α) in v]"
        using "≡E"(5) by auto
      moreover {
        have "[∀ α . 𝒜¬φ α ≡ ¬𝒜φ α in v]"
          using logic_actual_nec_1[axiom_universal, axiom_instance] by blast 
        hence "[(∀ α . 𝒜¬φ α) ≡ (∀ α . ¬𝒜φ α) in v]"
          using cqt_basic_3[deduction] by fast
        hence "[(¬(∀ α . 𝒜¬φ α)) ≡ ¬(∀ α . ¬𝒜φ α) in v]"
          using oth_class_taut_5_d[equiv_lr] by blast
      }
      ultimately show ?thesis unfolding exists_def using "≡E"(5) by auto
    qed

  lemma act_quant_uniq[PLM]:
    "[(∀ z . 𝒜φ z ≡ z = x) ≡ (∀ z . φ z ≡ z = x) in dw]"
    by PLM_solver

  lemma fund_cont_desc[PLM]:
    "[(xP = (ιx. φ x)) ≡ (∀ z . φ z ≡ (z = x)) in dw]"
    using descriptions[axiom_instance] act_quant_uniq "≡E"(5) by fast

  lemma hintikka[PLM]:
    "[(xP = (ιx. φ x)) ≡ (φ x & (∀ z . φ z → z = x)) in dw]"
    proof -
      have "[(∀ z . φ z ≡ z = x) ≡ (φ x & (∀ z . φ z → z = x)) in dw]"
        unfolding identity_ν_def apply PLM_solver using id_eq_obj_1 apply simp
        using l_identity[where φ="λ x . φ x", axiom_instance,
                          deduction, deduction]
        using id_eq_obj_2[deduction] unfolding identity_ν_def by fastforce
      thus ?thesis using "≡E"(5) fund_cont_desc by blast
    qed

  lemma russell_axiom_a[PLM]:
    "[(⦇F, ιx. φ x⦈) ≡ (∃ x . φ x & (∀ z . φ z → z = x) & ⦇F, xP⦈) in dw]"
    (is "[?lhs ≡ ?rhs in dw]")
    proof -
      {
        assume 1: "[?lhs in dw]"
        hence "[∃α. αP = (ιx. φ x) in dw]"
        using cqt_5[axiom_instance, deduction]
              SimpleExOrEnc.intros
        by blast
        then obtain α where 2:
          "[αP = (ιx. φ x) in dw]"
          using "∃E" by auto          
        hence 3: "[φ α & (∀ z . φ z → z = α) in dw]"
          using hintikka[equiv_lr] by simp
        from 2 have "[(ιx. φ x) = (αP)  in dw]"
          using l_identity[where α="αP" and β="ιx. φ x" and φ="λ x . x = αP",
                axiom_instance, deduction, deduction]
                id_eq_obj_1[where x=α] by auto
        hence "[⦇F, αP⦈ in dw]"
        using 1 l_identity[where β="αP" and α="ιx. φ x" and φ="λ x . ⦇F,x⦈",
                           axiom_instance, deduction, deduction] by auto
        with 3 have "[φ α & (∀ z . φ z → z = α) & ⦇F, αP⦈ in dw]" by (rule "&I")
        hence "[?rhs in dw]" using "∃I"[where α=α] by simp
      }
      moreover {
        assume "[?rhs in dw]"
        then obtain α where 4:
          "[φ α & (∀ z . φ z → z = α) & ⦇F, αP⦈ in dw]"
          using "∃E" by auto
        hence "[αP = (ιx . φ x) in dw] ∧ [⦇F, αP⦈ in dw]"
          using hintikka[equiv_rl] "&E" by blast
        hence "[?lhs in dw]"
          using l_identity[axiom_instance, deduction, deduction]
          by blast
      }
      ultimately show ?thesis by PLM_solver
    qed

  lemma russell_axiom_g[PLM]:
    "[⦃ιx. φ x,F⦄ ≡ (∃ x . φ x & (∀ z . φ z → z = x) & ⦃xP, F⦄) in dw]"
    (is "[?lhs ≡ ?rhs in dw]")
    proof -
      {
        assume 1: "[?lhs in dw]"
        hence "[∃α. αP = (ιx. φ x) in dw]"
        using cqt_5[axiom_instance, deduction] SimpleExOrEnc.intros by blast
        then obtain α where 2: "[αP = (ιx. φ x) in dw]" by (rule "∃E")
        hence 3: "[(φ α & (∀ z . φ z → z = α)) in dw]"
          using hintikka[equiv_lr] by simp
        from 2 have "[(ιx. φ x) = αP  in dw]"
          using l_identity[where α="αP" and β="ιx. φ x" and φ="λ x . x = αP",
                axiom_instance, deduction, deduction]
                id_eq_obj_1[where x=α] by auto
        hence "[⦃αP, F⦄ in dw]"
        using 1 l_identity[where β="αP" and α="ιx. φ x" and φ="λ x . ⦃x,F⦄",
                           axiom_instance, deduction, deduction] by auto
        with 3 have "[(φ α & (∀ z . φ z → z = α)) & ⦃αP, F⦄ in dw]"
          using "&I" by auto
        hence "[?rhs in dw]" using "∃I"[where α=α] by (simp add: identity_defs)
      }
      moreover {
        assume "[?rhs in dw]"
        then obtain α where 4:
          "[φ α & (∀ z . φ z → z = α) & ⦃αP, F⦄ in dw]"
          using "∃E" by auto
        hence "[αP = (ιx . φ x) in dw] ∧ [⦃αP, F⦄ in dw]"
          using hintikka[equiv_rl] "&E" by blast
        hence "[?lhs in dw]"
          using l_identity[axiom_instance, deduction, deduction]
          by fast
      }
      ultimately show ?thesis by PLM_solver
    qed

  lemma russell_axiom[PLM]:
    assumes "SimpleExOrEnc ψ"
    shows "[ψ (ιx. φ x) ≡ (∃ x . φ x & (∀ z . φ z → z = x) & ψ (xP)) in dw]"
    (is "[?lhs ≡ ?rhs in dw]")
    proof -
      {
        assume 1: "[?lhs in dw]"
        hence "[∃α. αP = (ιx. φ x) in dw]"
        using cqt_5[axiom_instance, deduction] assms by blast
        then obtain α where 2: "[αP = (ιx. φ x) in dw]" by (rule "∃E")
        hence 3: "[(φ α & (∀ z . φ z → z = α)) in dw]"
          using hintikka[equiv_lr] by simp
        from 2 have "[(ιx. φ x) = (αP)  in dw]"
          using l_identity[where α="αP" and β="ιx. φ x" and φ="λ x . x = αP",
                axiom_instance, deduction, deduction]
                id_eq_obj_1[where x=α] by auto
        hence "[ψ (αP) in dw]"
          using 1 l_identity[where β="αP" and α="ιx. φ x" and φ="λ x . ψ x",
                             axiom_instance, deduction, deduction] by auto
        with 3 have "[φ α & (∀ z . φ z → z = α) & ψ (αP) in dw]"
          using "&I" by auto
        hence "[?rhs in dw]" using "∃I"[where α=α] by (simp add: identity_defs)
      }
      moreover {
        assume "[?rhs in dw]"
        then obtain α where 4:
          "[φ α & (∀ z . φ z → z = α) & ψ (αP) in dw]"
          using "∃E" by auto
        hence "[αP = (ιx . φ x) in dw] ∧ [ψ (αP) in dw]"
          using hintikka[equiv_rl] "&E" by blast
        hence "[?lhs in dw]"
          using l_identity[axiom_instance, deduction, deduction]
          by fast
      }
      ultimately show ?thesis by PLM_solver
    qed

  lemma unique_exists[PLM]:
    "[(∃ y . yP = (ιx. φ x)) ≡ (∃!x . φ x) in dw]"     
    proof((rule "≡I", rule CP, rule_tac[2] CP))
      assume "[∃y. yP = (ιx. φ x) in dw]"
      then obtain α where
        "[αP = (ιx. φ x) in dw]"
        by (rule "∃E")
      hence "[φ α & (∀β. φ β → β = α) in dw]"
        using hintikka[equiv_lr] by auto
      thus "[∃!x . φ x in dw]"
        unfolding exists_unique_def using "∃I" by fast
    next
      assume "[∃!x . φ x in dw]"
      then obtain α where
        "[φ α & (∀β. φ β → β = α) in dw]"
        unfolding exists_unique_def by (rule "∃E")
      hence "[αP = (ιx. φ x) in dw]"
        using hintikka[equiv_rl] by auto
      thus "[∃y. yP = (ιx. φ x) in dw]"
        using "∃I" by fast
    qed

  lemma y_in_1[PLM]:
    "[xP = (ιx . φ) → φ in dw]"
    using hintikka[equiv_lr, conj1] by (rule CP)

  lemma y_in_2[PLM]:
    "[zP = (ιx . φ x) → φ z in dw]"
    using hintikka[equiv_lr, conj1] by (rule CP)

  lemma y_in_3[PLM]:
    "[(∃ y . yP = (ιx . φ (xP))) → φ (ιx . φ (xP)) in dw]"
    proof (rule CP)
      assume "[(∃ y . yP = (ιx . φ (xP))) in dw]"
      then obtain y where 1:
        "[yP = (ιx. φ (xP)) in dw]"
        by (rule "∃E")
      hence "[φ (yP) in dw]"
        using y_in_2[deduction] unfolding identity_ν_def by blast
      thus "[φ (ιx. φ (xP)) in dw]"
        using l_identity[axiom_instance, deduction,
                         deduction] 1 by fast
    qed

  lemma act_quant_nec[PLM]:
    "[(∀z . (𝒜φ z ≡ z = x)) ≡ (∀z. 𝒜𝒜φ z ≡ z = x) in v]"
    by PLM_solver

  lemma equi_desc_descA_1[PLM]:
    "[(xP = (ιx . φ x)) ≡ (xP = (ιx . 𝒜φ x)) in v]"
    using descriptions[axiom_instance] apply (rule "≡E"(5))
    using act_quant_nec apply (rule "≡E"(5))
    using descriptions[axiom_instance]
    by (meson "≡E"(6) oth_class_taut_4_a)

  lemma equi_desc_descA_2[PLM]:
    "[(∃ y . yP = (ιx. φ x)) → ((ιx . φ x) = (ιx . 𝒜φ x)) in v]"
    proof (rule CP)
      assume "[∃y. yP = (ιx. φ x) in v]"
      then obtain y where
        "[yP = (ιx. φ x) in v]"
        by (rule "∃E")
      moreover hence "[yP = (ιx. 𝒜φ x) in v]"
        using equi_desc_descA_1[equiv_lr] by auto
      ultimately show "[(ιx. φ x) = (ιx. 𝒜φ x) in v]"
        using l_identity[axiom_instance, deduction, deduction]
        by fast
    qed

  lemma equi_desc_descA_3[PLM]:
    assumes "SimpleExOrEnc ψ"
    shows "[ψ (ιx. φ x) → (∃ y . yP = (ιx. 𝒜φ x)) in v]"
    proof (rule CP)
      assume "[ψ (ιx. φ x) in v]"
      hence "[∃α. αP = (ιx. φ x) in v]"
        using cqt_5[OF assms, axiom_instance, deduction] by auto
      then obtain α where "[αP = (ιx. φ x) in v]" by (rule "∃E")
      hence "[αP = (ιx . 𝒜φ x) in v]"
        using equi_desc_descA_1[equiv_lr] by auto
      thus "[∃y. yP = (ιx. 𝒜φ x) in v]"
        using "∃I" by fast
    qed

  lemma equi_desc_descA_4[PLM]:
    assumes "SimpleExOrEnc ψ"
    shows "[ψ (ιx. φ x) → ((ιx. φ x) = (ιx. 𝒜φ x)) in v]"
    proof (rule CP)
      assume "[ψ (ιx. φ x) in v]"
      hence "[∃α. αP = (ιx. φ x) in v]"
        using cqt_5[OF assms, axiom_instance, deduction] by auto
      then obtain α where "[αP = (ιx. φ x) in v]" by (rule "∃E")
      moreover hence "[αP  = (ιx . 𝒜φ x) in v]"
        using equi_desc_descA_1[equiv_lr] by auto
      ultimately show "[(ιx. φ x)  = (ιx . 𝒜φ x) in v]"
        using l_identity[axiom_instance, deduction, deduction] by fast
    qed

  lemma nec_hintikka_scheme[PLM]:
    "[(xP = (ιx. φ x)) ≡ (𝒜φ x & (∀ z . 𝒜φ z → z = x)) in v]"
    using descriptions[axiom_instance]
    apply (rule "≡E"(5))
    apply PLM_solver
     using id_eq_obj_1 apply simp
     using id_eq_obj_2[deduction]
           l_identity[where α="x", axiom_instance, deduction, deduction]
     unfolding identity_ν_def
     apply blast
    using l_identity[where α="x", axiom_instance, deduction, deduction]
    id_eq_2[where 'a=ν, deduction] unfolding identity_ν_def by meson

  lemma equiv_desc_eq[PLM]:
    assumes "⋀x.[𝒜(φ x ≡ ψ x) in v]"
    shows "[(∀ x . ((xP = (ιx . φ x)) ≡ (xP = (ιx . ψ x)))) in v]"
    proof(rule "∀I")
      fix x
      {
        assume "[xP = (ιx . φ x) in v]"
        hence 1: "[𝒜φ x & (∀z. 𝒜φ z → z = x) in v]"
          using nec_hintikka_scheme[equiv_lr] by auto
        hence 2: "[𝒜φ x in v] ∧ [(∀z. 𝒜φ z → z = x) in v]"
          using "&E" by blast
        {
           fix z
           {
             assume "[𝒜ψ z in v]"
             hence "[𝒜φ z in v]"
              using assms[where x=z] apply - by PLM_solver
             moreover have "[𝒜φ z → z = x in v]"
               using 2 cqt_1[axiom_instance,deduction] by auto
             ultimately have "[z = x in v]"
              using vdash_properties_10 by auto
           }
           hence "[𝒜ψ z → z = x in v]" by (rule CP)
        }
        hence "[(∀ z . 𝒜ψ z → z = x) in v]" by (rule "∀I")
        moreover have "[𝒜ψ x in v]"
          using 1[conj1] assms[where x=x]
          apply - by PLM_solver
        ultimately have "[𝒜ψ x & (∀z. 𝒜ψ z → z = x) in v]"
          by PLM_solver
        hence "[xP = (ιx. ψ x) in v]"
         using nec_hintikka_scheme[where φ="ψ", equiv_rl] by auto
      }
      moreover {
        assume "[xP = (ιx . ψ x) in v]"
        hence 1: "[𝒜ψ x & (∀z. 𝒜ψ z → z = x) in v]"
          using nec_hintikka_scheme[equiv_lr] by auto
        hence 2: "[𝒜ψ x in v] ∧ [(∀z. 𝒜ψ z → z = x) in v]"
          using "&E" by blast
        {
          fix z
          {
            assume "[𝒜φ z in v]"
            hence "[𝒜ψ z in v]"
              using assms[where x=z]
              apply - by PLM_solver
            moreover have "[𝒜ψ z → z = x in v]"
              using 2 cqt_1[axiom_instance,deduction] by auto
            ultimately have "[z = x in v]"
              using vdash_properties_10 by auto
          }
          hence "[𝒜φ z → z = x in v]" by (rule CP)
        }
        hence "[(∀z. 𝒜φ z → z = x) in v]" by (rule "∀I")
        moreover have "[𝒜φ x in v]"
          using 1[conj1] assms[where x=x]
          apply - by PLM_solver
        ultimately have "[𝒜φ x & (∀z. 𝒜φ z → z = x) in v]"
          by PLM_solver
        hence "[xP = (ιx. φ x) in v]"
          using nec_hintikka_scheme[where φ="φ",equiv_rl]
          by auto
      }
      ultimately show "[xP = (ιx. φ x) ≡ (xP) = (ιx. ψ x) in v]"
        using "≡I" CP by auto
    qed

  lemma UniqueAux:
    assumes "[(𝒜φ (α::ν) & (∀ z . 𝒜(φ z) → z = α)) in v]"
    shows "[(∀ z . (𝒜(φ z) ≡ (z = α))) in v]"
    proof -
      {
        fix z
        {
          assume "[𝒜(φ z) in v]"
          hence "[z = α in v]"
            using assms[conj2, THEN cqt_1[where α=z,
                          axiom_instance, deduction],
                        deduction] by auto
        }
        moreover {
          assume "[z = α in v]"
          hence "[α = z in v]"
            unfolding identity_ν_def
            using id_eq_obj_2[deduction] by fast
          hence "[𝒜(φ z) in v]" using assms[conj1]
            using l_identity[axiom_instance, deduction,
                             deduction] by fast
        }
        ultimately have "[(𝒜(φ z) ≡ (z = α)) in v]"
          using "≡I" CP by auto
      }
      thus "[(∀ z . (𝒜(φ z) ≡ (z = α))) in v]"
      by (rule "∀I")
    qed

  lemma nec_russell_axiom[PLM]:
    assumes "SimpleExOrEnc ψ"
    shows "[(ψ (ιx. φ x)) ≡ (∃ x . (𝒜φ x & (∀ z . 𝒜(φ z) → z = x))
                              & ψ (xP)) in v]"
    (is "[?lhs ≡ ?rhs in v]")
    proof -
      {
        assume 1: "[?lhs in v]"
        hence "[∃α. (αP) = (ιx. φ x) in v]"
          using cqt_5[axiom_instance, deduction] assms by blast
        then obtain α where 2: "[(αP) = (ιx. φ x) in v]" by (rule "∃E")
        hence "[(∀ z . (𝒜(φ z) ≡ (z = α))) in v]"
          using descriptions[axiom_instance, equiv_lr] by auto
        hence 3: "[(𝒜φ α) & (∀ z . (𝒜(φ z) → (z = α))) in v]"
          using cqt_1[where α=α and φ="λ z . (𝒜(φ z) ≡ (z = α))",
                      axiom_instance, deduction, equiv_rl]
          using id_eq_obj_1[where x=α] unfolding identity_ν_def
          using hintikka[equiv_lr] cqt_basic_2[equiv_lr,conj1]
          "&I" by fast
        from 2 have "[(ιx. φ x) = (αP)  in v]"
          using l_identity[where β="(ιx. φ x)" and φ="λ x . x = (αP)",
                axiom_instance, deduction, deduction]
                id_eq_obj_1[where x=α] by auto
        hence "[ψ (αP) in v]"
          using 1 l_identity[where α="(ιx. φ x)" and φ="λ x . ψ x",
                             axiom_instance, deduction,
                             deduction] by auto
        with 3 have "[(𝒜φ α & (∀ z . 𝒜(φ z) → (z = α))) & ψ (αP) in v]"
          using "&I" by simp
        hence "[?rhs in v]"
          using "∃I"[where α=α]
          by (simp add: identity_defs)
      }
      moreover {
        assume "[?rhs in v]"
        then obtain α where 4:
          "[(𝒜φ α & (∀ z . 𝒜(φ z) → z = α)) & ψ (αP) in v]"
          using "∃E" by auto
        hence "[(∀ z . (𝒜(φ z) ≡ (z = α))) in v]"
          using UniqueAux "&E"(1) by auto
        hence "[(αP) = (ιx . φ x) in v] ∧ [ψ (αP) in v]"
          using descriptions[axiom_instance, equiv_rl]
                4[conj2] by blast
        hence "[?lhs in v]"
          using l_identity[axiom_instance, deduction,
                           deduction]
          by fast
      }
      ultimately show ?thesis by PLM_solver
    qed

  lemma actual_desc_1[PLM]:
    "[(∃ y . (yP) = (ιx. φ x)) ≡ (∃! x . 𝒜(φ x)) in v]" (is "[?lhs ≡ ?rhs in v]")
    proof -
      {
        assume "[?lhs in v]"
        then obtain α where
          "[((αP) = (ιx. φ x)) in v]"
          by (rule "∃E")
        hence "[⦇A!,(ιx. φ x)⦈ in v] ∨ [(αP) =E (ιx. φ x) in v]"
          apply - unfolding identity_defs by PLM_solver
        then obtain x where
          "[((𝒜φ x & (∀ z . 𝒜(φ z) → z = x))) in v]"
          using nec_russell_axiom[where ψ="λx . ⦇A!,x⦈", equiv_lr, THEN "∃E"]
          using nec_russell_axiom[where ψ="λx . (αP) =E x", equiv_lr, THEN "∃E"]
          using SimpleExOrEnc.intros unfolding identityE_infix_def
          by (meson "&E")
        hence "[?rhs in v]" unfolding exists_unique_def by (rule "∃I")
      }
      moreover {
        assume "[?rhs in v]"
        then obtain x where
          "[((𝒜φ x & (∀ z . 𝒜(φ z) → z = x))) in v]"
          unfolding exists_unique_def by (rule "∃E")
        hence "[∀z. 𝒜φ z ≡ z = x in v]"
          using UniqueAux by auto
        hence "[(xP) = (ιx. φ x) in v]"
          using descriptions[axiom_instance, equiv_rl] by auto
        hence "[?lhs in v]" by (rule "∃I")
      }
      ultimately show ?thesis
        using "≡I" CP by auto
    qed

  lemma actual_desc_2[PLM]:
    "[(xP) = (ιx. φ) → 𝒜φ in v]"
    using nec_hintikka_scheme[equiv_lr, conj1]
    by (rule CP)

  lemma actual_desc_3[PLM]:
    "[(zP) = (ιx. φ x) → 𝒜(φ z) in v]"
    using nec_hintikka_scheme[equiv_lr, conj1]
    by (rule CP)

  lemma actual_desc_4[PLM]:
    "[(∃ y . ((yP) = (ιx. φ (xP)))) → 𝒜(φ (ιx. φ (xP))) in v]"
    proof (rule CP)
      assume "[(∃ y . (yP) = (ιx . φ (xP))) in v]"
      then obtain y where 1:
        "[yP = (ιx. φ (xP)) in v]"
        by (rule "∃E")
      hence "[𝒜(φ (yP)) in v]" using actual_desc_3[deduction] by fast
      thus "[𝒜(φ (ιx. φ (xP))) in v]"
        using l_identity[axiom_instance, deduction,
                         deduction] 1 by fast
    qed

  lemma unique_box_desc_1[PLM]:
    "[(∃!x . □(φ x)) → (∀ y . (yP) = (ιx. φ x) → φ y) in v]"
    proof (rule CP)
      assume "[(∃!x . □(φ x)) in v]"
      then obtain α where 1:
        "[□φ α & (∀β. □(φ β) → β = α) in v]"
        unfolding exists_unique_def by (rule "∃E")
      {
        fix y
        {
          assume "[(yP) = (ιx. φ x) in v]"
          hence "[𝒜φ α → α = y in v]"
            using nec_hintikka_scheme[where x="y" and φ="φ", equiv_lr, conj2,
                          THEN cqt_1[where α=α,axiom_instance, deduction]] by simp
          hence "[α = y in v]"
            using 1[conj1] nec_imp_act vdash_properties_10 by blast
          hence "[φ y in v]"
            using 1[conj1] qml_2[axiom_instance, deduction]
                  l_identity[axiom_instance, deduction, deduction]
            by fast
        }
        hence "[(yP) = (ιx. φ x) → φ y in v]"
          by (rule CP)
      }
      thus "[∀ y . (yP) = (ιx. φ x) → φ y in v]"
        by (rule "∀I")
    qed

  lemma unique_box_desc[PLM]:
    "[(∀ x . (φ x → □(φ x))) → ((∃!x . φ x)
      → (∀ y . (yP = (ιx . φ x)) → φ y)) in v]"
    apply (rule CP, rule CP)
    using nec_exist_unique[deduction, deduction]
          unique_box_desc_1[deduction] by blast

subsection‹Necessity›
text‹\label{TAO_PLM_Necessity}›

  lemma RM_1[PLM]:
    "(⋀v.[φ → ψ in v]) ⟹ [□φ → □ψ in v]"
    using RN qml_1[axiom_instance] vdash_properties_10 by blast

  lemma RM_1_b[PLM]:
    "(⋀v.[χ in v] ⟹ [φ → ψ in v]) ⟹ ([□χ in v] ⟹ [□φ → □ψ in v])"
    using RN_2 qml_1[axiom_instance] vdash_properties_10 by blast

  lemma RM_2[PLM]:
    "(⋀v.[φ → ψ in v]) ⟹ [◇φ → ◇ψ in v]"
    unfolding diamond_def
    using RM_1 contraposition_1 by auto

  lemma RM_2_b[PLM]:
    "(⋀v.[χ in v] ⟹ [φ → ψ in v]) ⟹ ([□χ in v] ⟹ [◇φ → ◇ψ in v])"
    unfolding diamond_def
    using RM_1_b contraposition_1 by blast

  lemma KBasic_1[PLM]:
    "[□φ → □(ψ → φ) in v]"
    by (simp only: pl_1[axiom_instance] RM_1)
  lemma KBasic_2[PLM]:
    "[□(¬φ) → □(φ → ψ) in v]"
    by (simp only: RM_1 useful_tautologies_3)
  lemma KBasic_3[PLM]:
    "[□(φ & ψ) ≡ □φ & □ψ in v]"
    apply (rule "≡I")
     apply (rule CP)
     apply (rule "&I")
      using RM_1 oth_class_taut_9_a vdash_properties_6 apply blast
     using RM_1 oth_class_taut_9_b vdash_properties_6 apply blast
    using qml_1[axiom_instance] RM_1 ded_thm_cor_3 oth_class_taut_10_a
          oth_class_taut_8_b vdash_properties_10
    by blast
  lemma KBasic_4[PLM]:
    "[□(φ ≡ ψ) ≡ (□(φ → ψ) & □(ψ → φ)) in v]"
    apply (rule "≡I")
     unfolding equiv_def using KBasic_3 PLM.CP "≡E"(1)
     apply blast
    using KBasic_3 PLM.CP "≡E"(2)
    by blast
  lemma KBasic_5[PLM]:
    "[(□(φ → ψ) & □(ψ → φ)) → (□φ ≡ □ψ) in v]"
    by (metis qml_1[axiom_instance] CP "&E" "≡I" vdash_properties_10)
  lemma KBasic_6[PLM]:
    "[□(φ ≡ ψ) → (□φ ≡ □ψ) in v]"
    using KBasic_4 KBasic_5 by (metis equiv_def ded_thm_cor_3 "&E"(1))
  lemma "[(□φ ≡ □ψ) → □(φ ≡ ψ) in v]"
    nitpick[expect=genuine, user_axioms, card = 1, card i = 2]
    oops ― ‹countermodel as desired›
  lemma KBasic_7[PLM]:
    "[(□φ & □ψ) → □(φ ≡ ψ) in v]"
    proof (rule CP)
      assume "[□φ & □ψ in v]"
      hence "[□(ψ → φ) in v] ∧ [□(φ → ψ) in v]"
        using "&E" KBasic_1 vdash_properties_10 by blast
      thus "[□(φ ≡ ψ) in v]"
        using KBasic_4 "≡E"(2) intro_elim_1 by blast
    qed

  lemma KBasic_8[PLM]:
    "[□(φ & ψ) → □(φ ≡ ψ) in v]"
    using KBasic_7 KBasic_3
    by (metis equiv_def PLM.ded_thm_cor_3 "&E"(1))
  lemma KBasic_9[PLM]:
    "[□((¬φ) & (¬ψ)) → □(φ ≡ ψ) in v]"
    proof (rule CP)
      assume "[□((¬φ) & (¬ψ)) in v]"
      hence "[□((¬φ) ≡ (¬ψ)) in v]"
        using KBasic_8 vdash_properties_10 by blast
      moreover have "⋀v.[((¬φ) ≡ (¬ψ)) → (φ ≡ ψ) in v]"
        using CP "≡E"(2) oth_class_taut_5_d by blast
      ultimately show "[□(φ ≡ ψ) in v]"
        using RM_1 PLM.vdash_properties_10 by blast
    qed

  lemma rule_sub_lem_1_a[PLM]:
    "[□(ψ ≡ χ) in v] ⟹ [(¬ψ) ≡ (¬χ) in v]"
    using qml_2[axiom_instance] "≡E"(1) oth_class_taut_5_d
          vdash_properties_10
    by blast
  lemma rule_sub_lem_1_b[PLM]:
    "[□(ψ ≡ χ) in v] ⟹ [(ψ → Θ) ≡ (χ → Θ) in v]"
    by (metis equiv_def contraposition_1 CP "&E"(2) "≡I"
              "≡E"(1) rule_sub_lem_1_a)
  lemma rule_sub_lem_1_c[PLM]:
    "[□(ψ ≡ χ) in v] ⟹ [(Θ → ψ) ≡ (Θ → χ) in v]"
    by (metis CP "≡I" "≡E"(3) "≡E"(4) "¬¬I"
              "¬¬E" rule_sub_lem_1_a)
  lemma rule_sub_lem_1_d[PLM]:
    "(⋀x.[□(ψ x ≡ χ x) in v]) ⟹ [(∀α. ψ α) ≡ (∀α. χ α) in v]" 
    by (metis equiv_def "∀I" CP "&E" "≡I" raa_cor_1
              vdash_properties_10 rule_sub_lem_1_a "∀E")
  lemma rule_sub_lem_1_e[PLM]:
    "[□(ψ ≡ χ) in v] ⟹ [𝒜ψ ≡ 𝒜χ in v]"
    using Act_Basic_5 "≡E"(1) nec_imp_act
          vdash_properties_10
    by blast
  lemma rule_sub_lem_1_f[PLM]:
    "[□(ψ ≡ χ) in v] ⟹ [□ψ ≡ □χ in v]" 
    using KBasic_6 "≡I" "≡E"(1) vdash_properties_9
    by blast


  named_theorems Substable_intros
  
  definition Substable :: "('a⇒'a⇒bool)⇒('a⇒𝗈) ⇒ bool"
    where "Substable ≡ (λ cond φ . ∀ ψ χ v . (cond ψ χ) ⟶ [φ ψ ≡ φ χ in v])"
  
  lemma Substable_intro_const[Substable_intros]:
    "Substable cond (λ φ . Θ)"
    unfolding Substable_def using oth_class_taut_4_a by blast

  lemma Substable_intro_not[Substable_intros]:
    assumes "Substable cond ψ"
    shows "Substable cond (λ φ . ¬(ψ φ))"
    using assms unfolding Substable_def
    using rule_sub_lem_1_a RN_2 "≡E" oth_class_taut_5_d by metis
  lemma Substable_intro_impl[Substable_intros]:
    assumes "Substable cond ψ"
        and "Substable cond χ"
    shows "Substable cond (λ φ . ψ φ → χ φ)"
    using assms unfolding Substable_def
    by (metis "≡I" CP intro_elim_6_a intro_elim_6_b)
  lemma Substable_intro_box[Substable_intros]:
    assumes "Substable cond ψ"
    shows "Substable cond (λ φ . □(ψ φ))"
    using assms unfolding Substable_def
    using rule_sub_lem_1_f RN by meson
  lemma Substable_intro_actual[Substable_intros]:
    assumes "Substable cond ψ"
    shows "Substable cond (λ φ . 𝒜(ψ φ))"
    using assms unfolding Substable_def
    using rule_sub_lem_1_e RN by meson
  lemma Substable_intro_all[Substable_intros]:
    assumes "∀ x . Substable cond (ψ x)"
    shows "Substable cond (λ φ . ∀ x . ψ x φ)"
    using assms unfolding Substable_def
    by (simp add: RN rule_sub_lem_1_d)

  named_theorems Substable_Cond_defs
end

class Substable =
  fixes Substable_Cond :: "'a⇒'a⇒bool"
  assumes rule_sub_nec:
    "⋀ φ ψ χ Θ v . ⟦PLM.Substable Substable_Cond φ; Substable_Cond ψ χ⟧
      ⟹ Θ [φ ψ in v] ⟹ Θ [φ χ in v]"

instantiation 𝗈 :: Substable
begin
  definition Substable_Cond_𝗈 where [PLM.Substable_Cond_defs]:
    "Substable_Cond_𝗈 ≡ λ φ ψ . ∀ v . [φ ≡ ψ in v]"
  instance proof
    interpret PLM .
    fix φ :: "𝗈 ⇒ 𝗈" and  ψ χ :: 𝗈 and Θ :: "bool ⇒ bool" and v::i
    assume "Substable Substable_Cond φ"
    moreover assume "Substable_Cond ψ χ"
    ultimately have "[φ ψ ≡ φ χ in v]"
    unfolding Substable_def by blast
    hence "[φ ψ in v] = [φ χ in v]" using "≡E" by blast
    moreover assume "Θ [φ ψ in v]"
    ultimately show "Θ [φ χ in v]" by simp
  qed
end

instantiation "fun" :: (type, Substable) Substable
begin
  definition Substable_Cond_fun where [PLM.Substable_Cond_defs]:
    "Substable_Cond_fun ≡ λ φ ψ . ∀ x . Substable_Cond (φ x) (ψ x)"
  instance proof
    interpret PLM .
    fix φ:: "('a ⇒ 'b) ⇒ 𝗈" and  ψ χ :: "'a ⇒ 'b" and Θ v
    assume "Substable Substable_Cond φ"
    moreover assume "Substable_Cond ψ χ"
    ultimately have "[φ ψ ≡ φ χ in v]"
      unfolding Substable_def by blast
    hence "[φ ψ in v] = [φ χ in v]" using "≡E" by blast
    moreover assume "Θ [φ ψ in v]"
    ultimately show "Θ [φ χ in v]" by simp
  qed
end

context PLM
begin

  lemma Substable_intro_equiv[Substable_intros]:
    assumes "Substable cond ψ"
        and "Substable cond χ"
    shows "Substable cond (λ φ . ψ φ ≡ χ φ)"
    unfolding conn_defs by (simp add: assms Substable_intros)
  lemma Substable_intro_conj[Substable_intros]:
    assumes "Substable cond ψ"
        and "Substable cond χ"
    shows "Substable cond (λ φ . ψ φ & χ φ)"
    unfolding conn_defs by (simp add: assms Substable_intros)
  lemma Substable_intro_disj[Substable_intros]:
    assumes "Substable cond ψ"
        and "Substable cond χ"
    shows "Substable cond (λ φ . ψ φ ∨ χ φ)"
    unfolding conn_defs by (simp add: assms Substable_intros)
  lemma Substable_intro_diamond[Substable_intros]:
    assumes "Substable cond ψ"
    shows "Substable cond (λ φ . ◇(ψ φ))"
    unfolding conn_defs by (simp add: assms Substable_intros)
  lemma Substable_intro_exist[Substable_intros]:
    assumes "∀ x . Substable cond (ψ x)"
    shows "Substable cond (λ φ . ∃ x . ψ x φ)"
    unfolding conn_defs by (simp add: assms Substable_intros)

  lemma Substable_intro_id_𝗈[Substable_intros]:
    "Substable Substable_Cond (λ φ . φ)"
    unfolding Substable_def Substable_Cond_𝗈_def by blast
  lemma Substable_intro_id_fun[Substable_intros]:
    assumes "Substable Substable_Cond ψ"
    shows "Substable Substable_Cond (λ φ . ψ (φ x))"
    using assms unfolding Substable_def Substable_Cond_fun_def
    by blast

  method PLM_subst_method for ψ::"'a::Substable" and χ::"'a::Substable" =
    (match conclusion in "Θ [φ χ in v]" for Θ and φ and v ⇒
      ‹(rule rule_sub_nec[where Θ=Θ and χ=χ and ψ=ψ and φ=φ and v=v],
        ((fast intro: Substable_intros, ((assumption)+)?)+; fail),
        unfold Substable_Cond_defs)›)

  method PLM_autosubst =
    (match premises in "⋀v . [ψ ≡ χ in v]" for ψ and χ ⇒
      ‹ match conclusion in "Θ [φ χ in v]" for Θ φ and v ⇒
        ‹(rule rule_sub_nec[where Θ=Θ and χ=χ and ψ=ψ and φ=φ and v=v],
          ((fast intro: Substable_intros, ((assumption)+)?)+; fail),
          unfold Substable_Cond_defs)› ›)

  method PLM_autosubst1 =
    (match premises in "⋀v x . [ψ x ≡ χ x in v]"
      for ψ::"'a::type⇒𝗈" and χ::"'a⇒𝗈" ⇒
      ‹ match conclusion in "Θ [φ χ in v]" for Θ φ and v ⇒
        ‹(rule rule_sub_nec[where Θ=Θ and χ=χ and ψ=ψ and φ=φ and v=v],
          ((fast intro: Substable_intros, ((assumption)+)?)+; fail),
          unfold Substable_Cond_defs)› ›)

  method PLM_autosubst2 =
    (match premises in "⋀v x y . [ψ x y ≡ χ x y in v]"
      for ψ::"'a::type⇒'a⇒𝗈" and χ::"'a::type⇒'a⇒𝗈" ⇒
      ‹ match conclusion in "Θ [φ χ in v]" for Θ φ and v ⇒
        ‹(rule rule_sub_nec[where Θ=Θ and χ=χ and ψ=ψ and φ=φ and v=v],
          ((fast intro: Substable_intros, ((assumption)+)?)+; fail),
          unfold Substable_Cond_defs)› ›)

  method PLM_subst_goal_method for φ::"'a::Substable⇒𝗈" and ψ::"'a" =
    (match conclusion in "Θ [φ χ in v]" for Θ and χ and v ⇒
      ‹(rule rule_sub_nec[where Θ=Θ and χ=χ and ψ=ψ and φ=φ and v=v],
        ((fast intro: Substable_intros, ((assumption)+)?)+; fail),
        unfold Substable_Cond_defs)›)

(*
  text{* \begin{TODO}
            This can only be proven using the Semantics of the Box operator.
            As it is not needed for the further reasoning it remains commented for now.
         \end{TODO} *}
  lemma rule_sub_lem_2:
    assumes "Substable Substable_Cond φ"
    shows "[□(ψ ≡ χ) in v] ⟹ [φ ψ ≡ φ χ in v]"
    using assms unfolding Substable_def Substable_Cond_defs
    using Semantics.T6 by fast
*)

  lemma rule_sub_nec[PLM]:
    assumes "Substable Substable_Cond φ"
    shows "(⋀v.[(ψ ≡ χ) in v]) ⟹ Θ [φ ψ in v] ⟹ Θ [φ χ in v]"
    proof -
      assume "(⋀v.[(ψ ≡ χ) in v])"
      hence "[φ ψ in v] = [φ χ in v]"
        using assms RN unfolding Substable_def Substable_Cond_defs
        using "≡I" CP "≡E"(1) "≡E"(2) by meson
      thus "Θ [φ ψ in v] ⟹ Θ [φ χ in v]" by auto
    qed

  lemma rule_sub_nec1[PLM]:
    assumes "Substable Substable_Cond φ"
    shows "(⋀v x .[(ψ x ≡ χ x) in v]) ⟹ Θ [φ ψ in v] ⟹ Θ [φ χ in v]"
    proof -
      assume "(⋀v x.[(ψ x ≡ χ x) in v])"
      hence "[φ ψ in v] = [φ χ in v]"
        using assms RN unfolding Substable_def Substable_Cond_defs
        using "≡I" CP "≡E"(1) "≡E"(2) by metis
      thus "Θ [φ ψ in v] ⟹ Θ [φ χ in v]" by auto
    qed

  lemma rule_sub_nec2[PLM]:
    assumes "Substable Substable_Cond φ"
    shows "(⋀v x y .[ψ x y ≡ χ x y in v]) ⟹ Θ [φ ψ in v] ⟹ Θ [φ χ in v]"
    proof -
      assume "(⋀v x y .[ψ x y ≡ χ x y in v])"
      hence "[φ ψ in v] = [φ χ in v]"
        using assms RN unfolding Substable_def Substable_Cond_defs
        using "≡I" CP "≡E"(1) "≡E"(2) by metis
      thus "Θ [φ ψ in v] ⟹ Θ [φ χ in v]" by auto
    qed

  lemma rule_sub_remark_1_autosubst:
    assumes "(⋀v.[⦇A!,x⦈ ≡ (¬(◇⦇E!,x⦈)) in v])"
        and "[¬⦇A!,x⦈ in v]"
    shows"[¬¬◇⦇E!,x⦈ in v]"
    apply (insert assms) apply PLM_autosubst by auto

  lemma rule_sub_remark_1:
    assumes "(⋀v.[⦇A!,x⦈ ≡ (¬(◇⦇E!,x⦈)) in v])"
        and "[¬⦇A!,x⦈ in v]"
      shows"[¬¬◇⦇E!,x⦈ in v]"
    apply (PLM_subst_method "⦇A!,x⦈" "(¬(◇⦇E!,x⦈))")
     apply (simp add: assms(1))
    by (simp add: assms(2))

  lemma rule_sub_remark_2:
    assumes "(⋀v.[⦇R,x,y⦈ ≡ (⦇R,x,y⦈ & (⦇Q,a⦈ ∨ (¬⦇Q,a⦈))) in v])"
        and "[p → ⦇R,x,y⦈ in v]"
    shows"[p → (⦇R,x,y⦈ & (⦇Q,a⦈ ∨ (¬⦇Q,a⦈)))  in v]"
    apply (insert assms) apply PLM_autosubst by auto

  lemma rule_sub_remark_3_autosubst:
    assumes "(⋀v x.[⦇A!,xP⦈ ≡ (¬(◇⦇E!,xP⦈)) in v])"
        and "[∃ x . ⦇A!,xP⦈ in v]"
    shows"[∃ x . (¬(◇⦇E!,xP⦈))  in v]"
    apply (insert assms) apply PLM_autosubst1 by auto

  lemma rule_sub_remark_3:
    assumes "(⋀v x.[⦇A!,xP⦈ ≡ (¬(◇⦇E!,xP⦈)) in v])"
        and "[∃ x . ⦇A!,xP⦈ in v]"
    shows "[∃ x . (¬(◇⦇E!,xP⦈))  in v]"
    apply (PLM_subst_method "λx . ⦇A!,xP⦈" "λx . (¬(◇⦇E!,xP⦈))")
     apply (simp add: assms(1))
    by (simp add: assms(2))

  lemma rule_sub_remark_4:
    assumes "⋀v x.[(¬(¬⦇P,xP⦈)) ≡ ⦇P,xP⦈ in v]"
        and "[𝒜(¬(¬⦇P,xP⦈)) in v]"
    shows "[𝒜⦇P,xP⦈ in v]"
    apply (insert assms) apply PLM_autosubst1 by auto

  lemma rule_sub_remark_5:
    assumes "⋀v.[(φ → ψ) ≡ ((¬ψ) → (¬φ)) in v]"
        and "[□(φ → ψ) in v]"
    shows "[□((¬ψ) → (¬φ)) in v]"
    apply (insert assms) apply PLM_autosubst by auto

  lemma rule_sub_remark_6:
    assumes "⋀v.[ψ ≡ χ in v]"
        and "[□(φ → ψ) in v]"
    shows "[□(φ → χ) in v]"
    apply (insert assms) apply PLM_autosubst by auto

  lemma rule_sub_remark_7:
    assumes "⋀v.[φ ≡ (¬(¬φ)) in v]"
        and "[□(φ → φ) in v]"
    shows "[□((¬(¬φ)) → φ) in v]"
    apply (insert assms) apply PLM_autosubst by auto

  lemma rule_sub_remark_8:
    assumes "⋀v.[𝒜φ ≡ φ in v]"
        and "[□(𝒜φ) in v]"
    shows "[□(φ) in v]"
    apply (insert assms) apply PLM_autosubst by auto

  lemma rule_sub_remark_9:
    assumes "⋀v.[⦇P,a⦈ ≡ (⦇P,a⦈ & (⦇Q,b⦈ ∨ (¬⦇Q,b⦈))) in v]"
        and "[⦇P,a⦈ = ⦇P,a⦈ in v]"
    shows "[⦇P,a⦈ = (⦇P,a⦈ & (⦇Q,b⦈ ∨ (¬⦇Q,b⦈))) in v]"
      unfolding identity_defs apply (insert assms)
      apply PLM_autosubst oops ― ‹no match as desired›

  ― ‹@{text "dr_alphabetic_rules"} implicitly holds›
  ― ‹@{text "dr_alphabetic_thm"} implicitly holds›

  lemma KBasic2_1[PLM]:
    "[□φ ≡ □(¬(¬φ)) in v]"
    apply (PLM_subst_method "φ" "(¬(¬φ))")
     by PLM_solver+

  lemma KBasic2_2[PLM]:
    "[(¬(□φ)) ≡ ◇(¬φ) in v]"
    unfolding diamond_def
    apply (PLM_subst_method "φ" "¬(¬φ)")
     by PLM_solver+

  lemma KBasic2_3[PLM]:
    "[□φ ≡ (¬(◇(¬φ))) in v]"
    unfolding diamond_def
    apply (PLM_subst_method "φ" "¬(¬φ)")
     apply PLM_solver
    by (simp add: oth_class_taut_4_b)
  lemmas "Df□" = KBasic2_3

  lemma KBasic2_4[PLM]:
    "[□(¬(φ)) ≡ (¬(◇φ)) in v]"
    unfolding diamond_def
    by (simp add: oth_class_taut_4_b)

  lemma KBasic2_5[PLM]:
    "[□(φ → ψ) → (◇φ → ◇ψ) in v]"
    by (simp only: CP RM_2_b)
  lemmas "K◇" = KBasic2_5

  lemma KBasic2_6[PLM]:
    "[◇(φ ∨ ψ) ≡ (◇φ ∨ ◇ψ) in v]"
    proof -
      have "[□((¬φ) & (¬ψ)) ≡ (□(¬φ) & □(¬ψ)) in v]"
        using KBasic_3 by blast
      hence "[(¬(◇(¬((¬φ) & (¬ψ))))) ≡ (□(¬φ) & □(¬ψ)) in v]"
        using "Df□" by (rule "≡E"(6))
      hence "[(¬(◇(¬((¬φ) & (¬ψ))))) ≡ ((¬(◇φ)) & (¬(◇ψ))) in v]"
        apply - apply (PLM_subst_method "□(¬φ)" "¬(◇φ)")
         apply (simp add: KBasic2_4)
        apply (PLM_subst_method "□(¬ψ)" "¬(◇ψ)")
         apply (simp add: KBasic2_4)
        unfolding diamond_def by assumption
      hence "[(¬(◇(φ ∨ ψ))) ≡ ((¬(◇φ)) & (¬(◇ψ))) in v]"
        apply - apply (PLM_subst_method "¬((¬φ) & (¬ψ))" "φ ∨ ψ")
        using oth_class_taut_6_b[equiv_sym] by auto
      hence "[(¬(¬(◇(φ ∨ ψ)))) ≡ (¬((¬(◇φ))&(¬(◇ψ)))) in v]"
        by (rule oth_class_taut_5_d[equiv_lr])
      hence "[◇(φ ∨ ψ) ≡ (¬((¬(◇φ)) & (¬(◇ψ)))) in v]"
        apply - apply (PLM_subst_method "¬(¬(◇(φ ∨ ψ)))" "◇(φ ∨ ψ)")
        using oth_class_taut_4_b[equiv_sym] by auto
      thus ?thesis
        apply - apply (PLM_subst_method "¬((¬(◇φ)) & (¬(◇ψ)))" "(◇φ) ∨ (◇ψ)")
        using oth_class_taut_6_b[equiv_sym] by auto
    qed

  lemma KBasic2_7[PLM]:
    "[(□φ ∨ □ψ) → □(φ ∨ ψ) in v]"
    proof -
      have "⋀ v . [φ → (φ ∨ ψ) in v]"
        by (metis contraposition_1 contraposition_2 useful_tautologies_3 disj_def)
      hence "[□φ → □(φ ∨ ψ) in v]" using RM_1 by auto
      moreover {
          have "⋀ v . [ψ → (φ ∨ ψ) in v]"
            by (simp only: pl_1[axiom_instance] disj_def)
          hence "[□ψ → □(φ ∨ ψ) in v]"
            using RM_1 by auto
      }
      ultimately show ?thesis
        using oth_class_taut_10_d vdash_properties_10 by blast
    qed

  lemma KBasic2_8[PLM]:
    "[◇(φ & ψ) → (◇φ & ◇ψ) in v]"
    by (metis CP RM_2 "&I" oth_class_taut_9_a
              oth_class_taut_9_b vdash_properties_10)

  lemma KBasic2_9[PLM]:
    "[◇(φ → ψ) ≡ (□φ → ◇ψ) in v]"
    apply (PLM_subst_method "(¬(□φ)) ∨ (◇ψ)" "□φ → ◇ψ")
     using oth_class_taut_5_k[equiv_sym] apply simp
    apply (PLM_subst_method "(¬φ) ∨ ψ" "φ → ψ")
     using oth_class_taut_5_k[equiv_sym] apply simp
    apply (PLM_subst_method "◇(¬φ)" "¬(□φ)")
     using KBasic2_2[equiv_sym] apply simp
    using KBasic2_6 .

  lemma KBasic2_10[PLM]:
    "[◇(□φ) ≡ (¬(□◇(¬φ))) in v]"
    unfolding diamond_def apply (PLM_subst_method "φ" "¬¬φ")
    using oth_class_taut_4_b oth_class_taut_4_a by auto

  lemma KBasic2_11[PLM]:
    "[◇◇φ ≡ (¬(□□(¬φ))) in v]"
    unfolding diamond_def
    apply (PLM_subst_method "□(¬φ)" "¬(¬(□(¬φ)))")
    using oth_class_taut_4_b oth_class_taut_4_a by auto

  lemma KBasic2_12[PLM]: "[□(φ ∨ ψ) → (□φ ∨ ◇ψ) in v]"
    proof -
      have "[□(ψ ∨ φ) → (□(¬ψ) → □φ) in v]"
        using CP RM_1_b "∨E"(2) by blast
      hence "[□(ψ ∨ φ) → (◇ψ ∨ □φ) in v]"
        unfolding diamond_def disj_def
        by (meson CP "¬¬E" vdash_properties_6)
      thus ?thesis apply -
        apply (PLM_subst_method "(◇ψ ∨ □φ)" "(□φ ∨ ◇ψ)")
         apply (simp add: PLM.oth_class_taut_3_e)
        apply (PLM_subst_method "(ψ ∨ φ)" "(φ ∨ ψ)")
         apply (simp add: PLM.oth_class_taut_3_e)
        by assumption
    qed

  lemma TBasic[PLM]:
    "[φ → ◇φ in v]"
    unfolding diamond_def
    apply (subst contraposition_1)
    apply (PLM_subst_method "□¬φ" "¬¬□¬φ")
     apply (simp add: PLM.oth_class_taut_4_b)
    using qml_2[where φ="¬φ", axiom_instance]
    by simp
  lemmas "T◇" = TBasic

  lemma S5Basic_1[PLM]:
    "[◇□φ → □φ in v]"
    proof (rule CP)
      assume "[◇□φ in v]"
      hence "[¬□◇¬φ in v]"
        using KBasic2_10[equiv_lr] by simp
      moreover have "[◇(¬φ) → □◇(¬φ) in v]"
        by (simp add: qml_3[axiom_instance])
      ultimately have "[¬◇¬φ in v]"
        by (simp add: PLM.modus_tollens_1)
      thus "[□φ in v]"
        unfolding diamond_def apply -
        apply (PLM_subst_method "¬¬φ" "φ")
         using oth_class_taut_4_b[equiv_sym] apply simp
        unfolding diamond_def using oth_class_taut_4_b[equiv_rl]
        by simp
    qed
  lemmas "5◇" = S5Basic_1

  lemma S5Basic_2[PLM]:
    "[□φ ≡ ◇□φ in v]"
    using "5◇" "T◇" "≡I" by blast

  lemma S5Basic_3[PLM]:
    "[◇φ ≡ □◇φ in v]"
    using qml_3[axiom_instance] qml_2[axiom_instance] "≡I" by blast

  lemma S5Basic_4[PLM]:
    "[φ → □◇φ in v]"
    using "T◇"[deduction, THEN S5Basic_3[equiv_lr]]
    by (rule CP)

  lemma S5Basic_5[PLM]:
    "[◇□φ → φ in v]"
    using S5Basic_2[equiv_rl, THEN qml_2[axiom_instance, deduction]]
    by (rule CP)
  lemmas "B◇" = S5Basic_5

  lemma S5Basic_6[PLM]:
    "[□φ → □□φ in v]"
    using S5Basic_4[deduction] RM_1[OF S5Basic_1, deduction] CP by auto
  lemmas "4□" = S5Basic_6

  lemma S5Basic_7[PLM]:
    "[□φ ≡ □□φ in v]"
    using "4□" qml_2[axiom_instance] by (rule "≡I")

  lemma S5Basic_8[PLM]:
    "[◇◇φ → ◇φ in v]"
    using S5Basic_6[where φ="¬φ", THEN contraposition_1[THEN iffD1], deduction]
          KBasic2_11[equiv_lr] CP unfolding diamond_def by auto
  lemmas "4◇" = S5Basic_8

  lemma S5Basic_9[PLM]:
    "[◇◇φ ≡ ◇φ in v]"
    using "4◇" "T◇" by (rule "≡I")

  lemma S5Basic_10[PLM]:
    "[□(φ ∨ □ψ) ≡ (□φ ∨ □ψ) in v]"
    apply (rule "≡I")
     apply (PLM_subst_goal_method "λ χ . □(φ ∨ □ψ) → (□φ ∨ χ)" "◇□ψ")
      using S5Basic_2[equiv_sym] apply simp
     using KBasic2_12 apply assumption
    apply (PLM_subst_goal_method "λ χ .(□φ ∨ χ) → □(φ ∨ □ψ)" "□□ψ")
     using S5Basic_7[equiv_sym] apply simp
    using KBasic2_7 by auto

  lemma S5Basic_11[PLM]:
    "[□(φ ∨ ◇ψ) ≡ (□φ ∨ ◇ψ) in v]"
    apply (rule "≡I")
     apply (PLM_subst_goal_method "λ χ . □(φ ∨ ◇ψ) → (□φ ∨ χ)" "◇◇ψ")
      using S5Basic_9 apply simp
     using KBasic2_12 apply assumption
    apply (PLM_subst_goal_method "λ χ .(□φ ∨ χ) → □(φ ∨ ◇ψ)" "□◇ψ")
     using S5Basic_3[equiv_sym] apply simp
    using KBasic2_7 by assumption

  lemma S5Basic_12[PLM]:
    "[◇(φ & ◇ψ) ≡ (◇φ & ◇ψ) in v]"
    proof -
      have "[□((¬φ) ∨ □(¬ψ)) ≡ (□(¬φ) ∨ □(¬ψ)) in v]"
        using S5Basic_10 by auto
      hence 1: "[(¬□((¬φ) ∨ □(¬ψ))) ≡ ¬(□(¬φ) ∨ □(¬ψ)) in v]"
        using oth_class_taut_5_d[equiv_lr] by auto
      have 2: "[(◇(¬((¬φ) ∨ (¬(◇ψ))))) ≡ (¬((¬(◇φ)) ∨ (¬(◇ψ)))) in v]"
        apply (PLM_subst_method "□¬ψ" "¬◇ψ")
         using KBasic2_4 apply simp
        apply (PLM_subst_method "□¬φ" "¬◇φ")
         using KBasic2_4 apply simp
        apply (PLM_subst_method "(¬□((¬φ) ∨ □(¬ψ)))" "(◇(¬((¬φ) ∨ (□(¬ψ)))))")
         unfolding diamond_def
         apply (simp add: RN oth_class_taut_4_b rule_sub_lem_1_a rule_sub_lem_1_f)
        using 1 by assumption
      show ?thesis
        apply (PLM_subst_method "¬((¬φ) ∨ (¬◇ψ))" "φ & ◇ψ")
         using oth_class_taut_6_a[equiv_sym] apply simp
        apply (PLM_subst_method "¬((¬(◇φ)) ∨ (¬◇ψ))" "◇φ & ◇ψ")
         using oth_class_taut_6_a[equiv_sym] apply simp
        using 2 by assumption
    qed

  lemma S5Basic_13[PLM]:
    "[◇(φ & (□ψ)) ≡ (◇φ & (□ψ)) in v]"
    apply (PLM_subst_method "◇□ψ" "□ψ")
     using S5Basic_2[equiv_sym] apply simp
    using S5Basic_12 by simp

  lemma S5Basic_14[PLM]:
    "[□(φ → (□ψ)) ≡ □(◇φ → ψ) in v]"
    proof (rule "≡I"; rule CP)
      assume "[□(φ → □ψ) in v]"
      moreover {
        have "⋀v.[□(φ → □ψ) → (◇φ → ψ) in v]"
          proof (rule CP)
            fix v
            assume "[□(φ → □ψ) in v]"
            hence "[◇φ → ◇□ψ in v]"
              using "K◇"[deduction] by auto
            thus "[◇φ → ψ in v]"
              using "B◇" ded_thm_cor_3 by blast
          qed
        hence "[□(□(φ → □ψ) → (◇φ → ψ)) in v]"
          by (rule RN)
        hence "[□(□(φ → □ψ)) → □((◇φ → ψ)) in v]"
          using qml_1[axiom_instance, deduction] by auto
      }
      ultimately show "[□(◇φ → ψ) in v]"
        using S5Basic_6 CP vdash_properties_10 by meson
    next
      assume "[□(◇φ → ψ) in v]"
      moreover {
        fix v
        {
          assume "[□(◇φ → ψ) in v]"
          hence 1: "[□◇φ → □ψ in v]"
            using qml_1[axiom_instance, deduction] by auto
          assume "[φ in v]"
          hence "[□◇φ in v]"
            using S5Basic_4[deduction] by auto
          hence "[□ψ in v]"
            using 1[deduction] by auto
        }
        hence "[□(◇φ → ψ) in v] ⟹ [φ → □ψ in v]"
          using CP by auto
      }
      ultimately show "[□(φ → □ψ) in v]"
        using S5Basic_6 RN_2 vdash_properties_10 by blast
    qed

  lemma sc_eq_box_box_1[PLM]:
    "[□(φ → □φ) → (◇φ ≡ □φ) in v]"
    proof(rule CP)
      assume 1: "[□(φ → □φ) in v]"
      hence "[□(◇φ → φ) in v]"
        using S5Basic_14[equiv_lr] by auto
      hence "[◇φ → φ in v]"
        using qml_2[axiom_instance, deduction] by auto
      moreover from 1 have "[φ → □φ in v]"
        using qml_2[axiom_instance, deduction] by auto
      ultimately have "[◇φ → □φ in v]"
        using ded_thm_cor_3 by auto
      moreover have "[□φ → ◇φ in v]"
        using qml_2[axiom_instance] "T◇"
        by (rule ded_thm_cor_3)
      ultimately show "[◇φ ≡ □φ in v]"
        by (rule "≡I")
    qed

  lemma sc_eq_box_box_2[PLM]:
    "[□(φ → □φ) → ((¬□φ) ≡ (□(¬φ))) in v]"
    proof (rule CP)
      assume "[□(φ → □φ) in v]"
      hence "[(¬□(¬φ)) ≡ □φ in v]"
        using sc_eq_box_box_1[deduction] unfolding diamond_def by auto
      thus "[((¬□φ) ≡ (□(¬φ))) in v]"
        by (meson CP "≡I" "≡E"(3)
                  "≡E"(4) "¬¬I" "¬¬E")
    qed

  lemma sc_eq_box_box_3[PLM]:
    "[(□(φ → □φ) & □(ψ → □ψ)) → ((□φ ≡ □ψ) → □(φ ≡ ψ)) in v]"
    proof (rule CP)
      assume 1: "[(□(φ → □φ) & □(ψ → □ψ)) in v]"
      {
        assume "[□φ ≡ □ψ in v]"
        hence "[(□φ & □ψ) ∨ ((¬(□φ)) & (¬(□ψ))) in v]"
          using oth_class_taut_5_i[equiv_lr] by auto
        moreover {
          assume "[□φ & □ψ in v]"
          hence "[□(φ ≡ ψ) in v]"
            using KBasic_7[deduction] by auto
        }
        moreover {
          assume "[(¬(□φ)) & (¬(□ψ)) in v]"
          hence "[□(¬φ) & □(¬ψ) in v]"
             using 1 "&E" "&I" sc_eq_box_box_2[deduction, equiv_lr]
             by metis
          hence "[□((¬φ) & (¬ψ)) in v]"
            using KBasic_3[equiv_rl] by auto
          hence "[□(φ ≡ ψ) in v]"
            using KBasic_9[deduction] by auto
        }
        ultimately have "[□(φ ≡ ψ) in v]"
          using CP "∨E"(1) by blast
      }
      thus "[□φ ≡ □ψ → □(φ ≡ ψ) in v]"
        using CP by auto
    qed

  lemma derived_S5_rules_1_a[PLM]:
    assumes "⋀v. [χ in v] ⟹ [◇φ → ψ in v]"
    shows "[□χ in v] ⟹ [φ → □ψ in v]"
    proof -
      have "[□χ in v] ⟹ [□◇φ → □ψ in v]"
        using assms RM_1_b by metis
      thus "[□χ in v] ⟹ [φ → □ψ in v]"
        using S5Basic_4 vdash_properties_10 CP by metis
    qed

  lemma derived_S5_rules_1_b[PLM]:
    assumes "⋀v. [◇φ → ψ in v]"
    shows "[φ → □ψ in v]"
    using derived_S5_rules_1_a all_self_eq_1 assms by blast

  lemma derived_S5_rules_2_a[PLM]:
    assumes "⋀v. [χ in v] ⟹ [φ → □ψ in v]"
    shows "[□χ in v] ⟹ [◇φ → ψ in v]"
    proof -
      have "[□χ in v] ⟹ [◇φ → ◇□ψ in v]"
        using RM_2_b assms by metis
      thus "[□χ in v] ⟹ [◇φ → ψ in v]"
        using "B◇" vdash_properties_10 CP by metis
    qed

  lemma derived_S5_rules_2_b[PLM]:
    assumes "⋀v. [φ → □ψ in v]"
    shows "[◇φ → ψ in v]"
    using assms derived_S5_rules_2_a all_self_eq_1 by blast

  lemma BFs_1[PLM]: "[(∀α. □(φ α)) → □(∀α. φ α) in v]"
    proof (rule derived_S5_rules_1_b)
      fix v
      {
        fix α
        have "⋀v.[(∀α . □(φ α)) → □(φ α) in v]"
          using cqt_orig_1 by metis
        hence "[◇(∀α. □(φ α)) → ◇□(φ α) in v]"
          using RM_2 by metis
        moreover have "[◇□(φ α) → (φ α) in v]"
          using "B◇" by auto
        ultimately have "[◇(∀α. □(φ α)) → (φ α) in v]"
          using ded_thm_cor_3 by auto
      }
      hence "[∀ α . ◇(∀α. □(φ α)) → (φ α) in v]"
        using "∀I" by metis
      thus "[◇(∀α. □(φ α)) → (∀α. φ α) in v]"
        using cqt_orig_2[deduction] by auto
    qed
  lemmas BF = BFs_1

  lemma BFs_2[PLM]:
    "[□(∀α. φ α) → (∀α. □(φ α)) in v]"
    proof -
      {
        fix α
        {
           fix v
           have "[(∀α. φ α) → φ α in v]" using cqt_orig_1 by metis
        }
        hence "[□(∀α . φ α) → □(φ α) in v]" using RM_1 by auto
      }
      hence "[∀α . □(∀α . φ α) → □(φ α) in v]" using "∀I" by metis
      thus ?thesis using cqt_orig_2[deduction] by metis
    qed
  lemmas CBF = BFs_2

  lemma BFs_3[PLM]:
    "[◇(∃ α. φ α) → (∃ α . ◇(φ α)) in v]"
    proof -
      have "[(∀α. □(¬(φ α))) → □(∀α. ¬(φ α)) in v]"
        using BF by metis
      hence 1: "[(¬(□(∀α. ¬(φ α)))) → (¬(∀α. □(¬(φ α)))) in v]"
        using contraposition_1 by simp
      have 2: "[◇(¬(∀α. ¬(φ α))) → (¬(∀α. □(¬(φ α)))) in v]"
        apply (PLM_subst_method "¬□(∀α . ¬(φ α))" "◇(¬(∀α. ¬(φ α)))")
        using KBasic2_2 1 by simp+
      have "[◇(¬(∀α. ¬(φ α))) → (∃ α . ¬(□(¬(φ α)))) in v]"
        apply (PLM_subst_method "¬(∀α. □(¬(φ α)))" "∃ α. ¬(□(¬(φ α)))")
         using cqt_further_2 apply metis
        using 2 by metis
      thus ?thesis
        unfolding exists_def diamond_def by auto
    qed
  lemmas "BF◇" = BFs_3

  lemma BFs_4[PLM]:
    "[(∃ α . ◇(φ α)) → ◇(∃ α. φ α) in v]"
    proof -
      have 1: "[□(∀α . ¬(φ α)) → (∀α. □(¬(φ α))) in v]"
        using CBF by auto
      have 2: "[(∃ α . (¬(□(¬(φ α))))) → (¬(□(∀α. ¬(φ α)))) in v]"
        apply (PLM_subst_method "¬(∀α. □(¬(φ α)))" "(∃ α . (¬(□(¬(φ α)))))")
         using cqt_further_2 apply blast
        using 1 using contraposition_1 by metis
      have "[(∃ α . (¬(□(¬(φ α))))) → ◇(¬(∀ α . ¬(φ α))) in v]"
        apply (PLM_subst_method "¬(□(∀α. ¬(φ α)))" "◇(¬(∀α. ¬(φ α)))")
         using KBasic2_2 apply blast
        using 2 by assumption
      thus ?thesis
        unfolding diamond_def exists_def by auto
    qed
  lemmas "CBF◇" = BFs_4

  lemma sign_S5_thm_1[PLM]:
    "[(∃ α. □(φ α)) → □(∃ α. φ α) in v]"
    proof (rule CP)
      assume "[∃  α . □(φ α) in v]"
      then obtain τ where "[□(φ τ) in v]"
        by (rule "∃E")
      moreover {
        fix v
        assume "[φ τ in v]"
        hence "[∃ α . φ α in v]"
          by (rule "∃I")
      }
      ultimately show "[□(∃  α . φ α) in v]"
        using RN_2 by blast
    qed
  lemmas Buridan = sign_S5_thm_1

  lemma sign_S5_thm_2[PLM]:
    "[◇(∀ α . φ α) → (∀ α . ◇(φ α)) in v]"
    proof -
      {
        fix α
        {
          fix v
          have "[(∀ α . φ α) → φ α in v]"
            using cqt_orig_1 by metis
        }
        hence "[◇(∀ α . φ α) → ◇(φ α) in v]"
          using RM_2 by metis
      }
      hence "[∀ α . ◇(∀ α . φ α) → ◇(φ α) in v]"
        using "∀I" by metis
      thus ?thesis
        using cqt_orig_2[deduction] by metis
    qed
  lemmas "Buridan◇" = sign_S5_thm_2

  lemma sign_S5_thm_3[PLM]:
    "[◇(∃ α . φ α & ψ α) → ◇((∃ α . φ α) & (∃ α . ψ α)) in v]"
    by (simp only: RM_2 cqt_further_5)

  lemma sign_S5_thm_4[PLM]:
    "[((□(∀ α. φ α → ψ α)) & (□(∀ α . ψ α → χ α))) → □(∀α. φ α → χ α) in v]"
    proof (rule CP)
      assume "[□(∀α. φ α → ψ α) & □(∀α. ψ α → χ α) in v]"
      hence "[□((∀α. φ α → ψ α) & (∀α. ψ α → χ α)) in v]"
        using KBasic_3[equiv_rl] by blast
      moreover {
        fix v
        assume "[((∀α. φ α → ψ α) & (∀α. ψ α → χ α)) in v]"
        hence "[(∀ α . φ α → χ α) in v]"
          using cqt_basic_9[deduction] by blast
      }
      ultimately show "[□(∀α. φ α → χ α) in v]"
        using RN_2 by blast
    qed

  lemma sign_S5_thm_5[PLM]:
    "[((□(∀α. φ α ≡ ψ α)) & (□(∀α. ψ α ≡ χ α))) → (□(∀α. φ α ≡ χ α)) in v]"
    proof (rule CP)
      assume "[□(∀α. φ α ≡ ψ α) & □(∀α. ψ α ≡ χ α) in v]"
      hence "[□((∀α. φ α ≡ ψ α) & (∀α. ψ α ≡ χ α)) in v]"
        using KBasic_3[equiv_rl] by blast
      moreover {
        fix v
        assume "[((∀α. φ α ≡ ψ α) & (∀α. ψ α ≡ χ α)) in v]"
        hence "[(∀ α . φ α ≡ χ α) in v]"
          using cqt_basic_10[deduction] by blast
      }
      ultimately show "[□(∀α. φ α ≡ χ α) in v]"
        using RN_2 by blast
    qed
  
  lemma id_nec2_1[PLM]:
    "[◇((α::'a::id_eq) = β) ≡ (α = β) in v]"
    apply (rule "≡I"; rule CP)
     using id_nec[equiv_lr] derived_S5_rules_2_b CP modus_ponens apply blast
    using "T◇"[deduction] by auto

  lemma id_nec2_2_Aux:
    "[(◇φ) ≡ ψ in v] ⟹ [(¬ψ) ≡ □(¬φ) in v]"
    proof -
      assume "[(◇φ) ≡ ψ in v]"
      moreover have "⋀φ ψ. [(¬φ) ≡ ψ in v] ⟹ [(¬ψ) ≡ φ in v]"
        by PLM_solver
      ultimately show ?thesis
        unfolding diamond_def by blast
    qed

  lemma id_nec2_2[PLM]:
    "[((α::'a::id_eq) ≠ β) ≡ □(α ≠ β) in v]"
    using id_nec2_1[THEN id_nec2_2_Aux] by auto

  lemma id_nec2_3[PLM]:
    "[(◇((α::'a::id_eq) ≠ β)) ≡ (α ≠ β) in v]"
    using "T◇" "≡I" id_nec2_2[equiv_lr]
          CP derived_S5_rules_2_b by metis

  lemma exists_desc_box_1[PLM]:
    "[(∃ y . (yP) = (ιx. φ x)) → (∃ y . □((yP) = (ιx. φ x))) in v]"
    proof (rule CP)
      assume "[∃y. (yP) = (ιx. φ x) in v]"
      then obtain y where "[(yP) = (ιx. φ x) in v]"
        by (rule "∃E")
      hence "[□(yP = (ιx. φ x)) in v]"
        using l_identity[axiom_instance, deduction, deduction]
              cqt_1[axiom_instance] all_self_eq_2[where 'a=ν]
              modus_ponens unfolding identity_ν_def by fast
      thus "[∃y. □((yP) = (ιx. φ x)) in v]"
        by (rule "∃I")
    qed

  lemma exists_desc_box_2[PLM]:
    "[(∃ y . (yP) = (ιx. φ x)) →  □(∃ y .((yP) = (ιx. φ x))) in v]"
    using exists_desc_box_1 Buridan ded_thm_cor_3 by fast

  lemma en_eq_1[PLM]:
    "[◇⦃x,F⦄ ≡ □⦃x,F⦄ in v]"
    using encoding[axiom_instance] RN
          sc_eq_box_box_1 modus_ponens by blast
  lemma en_eq_2[PLM]:
    "[⦃x,F⦄ ≡ □⦃x,F⦄ in v]"
    using encoding[axiom_instance] qml_2[axiom_instance] by (rule "≡I")
  lemma en_eq_3[PLM]:
    "[◇⦃x,F⦄ ≡ ⦃x,F⦄ in v]"
    using encoding[axiom_instance] derived_S5_rules_2_b "≡I" "T◇" by auto
  lemma en_eq_4[PLM]:
    "[(⦃x,F⦄ ≡ ⦃y,G⦄) ≡ (□⦃x,F⦄ ≡ □⦃y,G⦄) in v]"
    by (metis CP en_eq_2 "≡I" "≡E"(1) "≡E"(2))
  lemma en_eq_5[PLM]:
    "[□(⦃x,F⦄ ≡ ⦃y,G⦄) ≡ (□⦃x,F⦄ ≡ □⦃y,G⦄) in v]"
    using "≡I" KBasic_6 encoding[axiom_necessitation, axiom_instance]
    sc_eq_box_box_3[deduction] "&I" by simp
  lemma en_eq_6[PLM]:
    "[(⦃x,F⦄ ≡ ⦃y,G⦄) ≡ □(⦃x,F⦄ ≡ ⦃y,G⦄) in v]"
    using en_eq_4 en_eq_5 oth_class_taut_4_a "≡E"(6) by meson
  lemma en_eq_7[PLM]:
    "[(¬⦃x,F⦄) ≡ □(¬⦃x,F⦄) in v]"
    using en_eq_3[THEN id_nec2_2_Aux] by blast
  lemma en_eq_8[PLM]:
    "[◇(¬⦃x,F⦄) ≡ (¬⦃x,F⦄) in v]"
     unfolding diamond_def apply (PLM_subst_method "⦃x,F⦄" "¬¬⦃x,F⦄")
      using oth_class_taut_4_b apply simp
     apply (PLM_subst_method "⦃x,F⦄" "□⦃x,F⦄")
      using en_eq_2 apply simp
     using oth_class_taut_4_a by assumption
  lemma en_eq_9[PLM]:
    "[◇(¬⦃x,F⦄) ≡ □(¬⦃x,F⦄) in v]"
    using en_eq_8 en_eq_7 "≡E"(5) by blast
  lemma en_eq_10[PLM]:
    "[𝒜⦃x,F⦄ ≡ ⦃x,F⦄ in v]"
    apply (rule "≡I")
     using encoding[axiom_actualization, axiom_instance,
                    THEN logic_actual_nec_2[axiom_instance, equiv_lr],
                    deduction, THEN qml_act_2[axiom_instance, equiv_rl],
                    THEN en_eq_2[equiv_rl]] CP
     apply simp
    using encoding[axiom_instance] nec_imp_act ded_thm_cor_3 by blast

subsection‹The Theory of Relations› 
text‹\label{TAO_PLM_Relations}›

  lemma beta_equiv_eq_1_1[PLM]:
    assumes "IsProperInX φ"
        and "IsProperInX ψ"
        and "⋀x.[φ (xP) ≡ ψ (xP) in v]"
    shows "[⦇λ y. φ (yP), xP⦈ ≡ ⦇λ y. ψ (yP), xP⦈ in v]"
    using lambda_predicates_2_1[OF assms(1), axiom_instance]
    using lambda_predicates_2_1[OF assms(2), axiom_instance]
    using assms(3) by (meson "≡E"(6) oth_class_taut_4_a)

  lemma beta_equiv_eq_1_2[PLM]:
    assumes "IsProperInXY φ"
        and "IsProperInXY ψ"
        and "⋀x y.[φ (xP) (yP) ≡ ψ (xP) (yP) in v]"
    shows "[⦇λ2 (λ x y. φ (xP) (yP)), xP, yP⦈
            ≡ ⦇λ2 (λ x y. ψ (xP) (yP)), xP, yP⦈ in v]"
    using lambda_predicates_2_2[OF assms(1), axiom_instance]
    using lambda_predicates_2_2[OF assms(2), axiom_instance]
    using assms(3) by (meson "≡E"(6) oth_class_taut_4_a)

  lemma beta_equiv_eq_1_3[PLM]:
    assumes "IsProperInXYZ φ"
        and "IsProperInXYZ ψ"
        and "⋀x y z.[φ (xP) (yP) (zP) ≡ ψ (xP) (yP) (zP) in v]"
    shows "[⦇λ3 (λ x y z. φ (xP) (yP) (zP)), xP, yP, zP⦈
            ≡ ⦇λ3 (λ x y z. ψ (xP) (yP) (zP)), xP, yP, zP⦈ in v]"
    using lambda_predicates_2_3[OF assms(1), axiom_instance]
    using lambda_predicates_2_3[OF assms(2), axiom_instance]
    using assms(3) by (meson "≡E"(6) oth_class_taut_4_a)

  lemma beta_equiv_eq_2_1[PLM]:
    assumes "IsProperInX φ"
        and "IsProperInX ψ"
    shows "[(□(∀ x . φ (xP) ≡ ψ (xP))) →
            (□(∀ x . ⦇λ y. φ (yP), xP⦈ ≡ ⦇λ y. ψ (yP), xP⦈)) in v]"
     apply (rule qml_1[axiom_instance, deduction])
     apply (rule RN)
     proof (rule CP, rule "∀I")
      fix v x
      assume "[∀x. φ (xP) ≡ ψ (xP) in v]"
      hence "⋀x.[φ (xP) ≡ ψ (xP) in v]"
        by PLM_solver
      thus "[⦇λ y. φ (yP), xP⦈ ≡ ⦇λ y. ψ (yP), xP⦈ in v]"
        using assms beta_equiv_eq_1_1 by auto
     qed

  lemma beta_equiv_eq_2_2[PLM]:
    assumes "IsProperInXY φ"
        and "IsProperInXY ψ"
    shows "[(□(∀ x y . φ (xP) (yP) ≡ ψ (xP) (yP))) →
            (□(∀ x y . ⦇λ2 (λ x y. φ (xP) (yP)), xP, yP⦈
              ≡ ⦇λ2 (λ x y. ψ (xP) (yP)), xP, yP⦈)) in v]"
    apply (rule qml_1[axiom_instance, deduction])
    apply (rule RN)
    proof (rule CP, rule "∀I", rule "∀I")
      fix v x y
      assume "[∀x y. φ (xP) (yP) ≡ ψ (xP) (yP) in v]"
      hence "(⋀x y.[φ (xP) (yP) ≡ ψ (xP) (yP) in v])"
        by (meson "∀E")
      thus "[⦇λ2 (λ x y. φ (xP) (yP)), xP, yP⦈
            ≡ ⦇λ2 (λ x y. ψ (xP) (yP)), xP, yP⦈ in v]"
        using assms beta_equiv_eq_1_2 by auto
    qed

  lemma beta_equiv_eq_2_3[PLM]:
    assumes "IsProperInXYZ φ"
        and "IsProperInXYZ ψ"
    shows "[(□(∀ x y z . φ (xP) (yP) (zP) ≡ ψ (xP) (yP) (zP))) →
            (□(∀ x y z . ⦇λ3 (λ x y z. φ (xP) (yP) (zP)), xP, yP, zP⦈
                ≡ ⦇λ3 (λ x y z. ψ (xP) (yP) (zP)), xP, yP, zP⦈)) in v]"
    apply (rule qml_1[axiom_instance, deduction])
    apply (rule RN)
    proof (rule CP, rule "∀I", rule "∀I", rule "∀I")
      fix v x y z
      assume "[∀x y z. φ (xP) (yP) (zP) ≡ ψ (xP) (yP) (zP) in v]"
      hence "(⋀x y z.[φ (xP) (yP) (zP) ≡ ψ (xP) (yP) (zP) in v])"
        by (meson "∀E")
      thus "[⦇λ3 (λ x y z. φ (xP) (yP) (zP)), xP, yP, zP⦈
              ≡ ⦇λ3 (λ x y z. ψ (xP) (yP) (zP)), xP, yP, zP⦈ in v]"
        using assms beta_equiv_eq_1_3 by auto
    qed

  lemma beta_C_meta_1[PLM]:
    assumes "IsProperInX φ"
    shows "[⦇λ y. φ (yP), xP⦈ ≡ φ (xP) in v]"
    using lambda_predicates_2_1[OF assms, axiom_instance] by auto

  lemma beta_C_meta_2[PLM]:
    assumes "IsProperInXY φ"
    shows "[⦇λ2 (λ x y. φ (xP) (yP)), xP, yP⦈ ≡ φ (xP) (yP) in v]"
    using lambda_predicates_2_2[OF assms, axiom_instance] by auto

  lemma beta_C_meta_3[PLM]:
    assumes "IsProperInXYZ φ"
    shows "[⦇λ3 (λ x y z. φ (xP) (yP) (zP)), xP, yP, zP⦈ ≡ φ (xP) (yP) (zP) in v]"
    using lambda_predicates_2_3[OF assms, axiom_instance] by auto

  lemma relations_1[PLM]:
    assumes "IsProperInX φ"
    shows "[∃ F. □(∀ x. ⦇F,xP⦈ ≡ φ (xP)) in v]"
    using assms apply - by PLM_solver

  lemma relations_2[PLM]:
    assumes "IsProperInXY φ"
    shows "[∃ F. □(∀ x y. ⦇F,xP,yP⦈ ≡ φ (xP) (yP)) in v]"
    using assms apply - by PLM_solver

  lemma relations_3[PLM]:
    assumes "IsProperInXYZ φ"
    shows "[∃ F. □(∀ x y z. ⦇F,xP,yP,zP⦈ ≡ φ (xP) (yP) (zP)) in v]"
    using assms apply - by PLM_solver

  lemma prop_equiv[PLM]:
    shows "[(∀ x . (⦃xP,F⦄ ≡ ⦃xP,G⦄)) → F = G in v]"
    proof (rule CP)
      assume 1: "[∀x. ⦃xP,F⦄ ≡ ⦃xP,G⦄ in v]"
      {
        fix x
        have "[⦃xP,F⦄ ≡ ⦃xP,G⦄ in v]"
          using 1 by (rule "∀E")
        hence "[□(⦃xP,F⦄ ≡ ⦃xP,G⦄) in v]"
          using PLM.en_eq_6 "≡E"(1) by blast
      }
      hence "[∀x. □(⦃xP,F⦄ ≡ ⦃xP,G⦄) in v]"
        by (rule "∀I")
      thus "[F = G in v]"
        unfolding identity_defs
        by (rule BF[deduction])
    qed

  lemma propositions_lemma_1[PLM]:
    "[λ0 φ = φ in v]"
    using lambda_predicates_3_0[axiom_instance] .

  lemma propositions_lemma_2[PLM]:
    "[λ0 φ ≡ φ in v]"
    using lambda_predicates_3_0[axiom_instance, THEN id_eq_prop_prop_8_b[deduction]]
    apply (rule l_identity[axiom_instance, deduction, deduction])
    by PLM_solver

  lemma propositions_lemma_4[PLM]:
    assumes "⋀x.[𝒜(φ x ≡ ψ x) in v]"
    shows "[(χ::κ⇒𝗈) (ιx. φ x) = χ (ιx. ψ x) in v]"
    proof -
      have "[λ0 (χ (ιx. φ x)) = λ0 (χ (ιx. ψ x)) in v]"
        using assms lambda_predicates_4_0[axiom_instance]
        by blast
      hence "[(χ (ιx. φ x)) = λ0 (χ (ιx. ψ x)) in v]"
        using propositions_lemma_1[THEN id_eq_prop_prop_8_b[deduction]]
              id_eq_prop_prop_9_b[deduction] "&I"
        by blast
      thus ?thesis
        using propositions_lemma_1 id_eq_prop_prop_9_b[deduction] "&I"
        by blast
    qed

  lemma propositions[PLM]:
    "[∃ p . □(p ≡ p') in v]"
    by PLM_solver

  lemma pos_not_equiv_then_not_eq[PLM]:
    "[◇(¬(∀x. ⦇F,xP⦈ ≡ ⦇G,xP⦈)) → F ≠ G in v]"
    unfolding diamond_def
    proof (subst contraposition_1[symmetric], rule CP)
      assume "[F = G in v]"
      thus "[□(¬(¬(∀x. ⦇F,xP⦈ ≡ ⦇G,xP⦈))) in v]"
        apply (rule l_identity[axiom_instance, deduction, deduction])
        by PLM_solver
    qed

  lemma thm_relation_negation_1_1[PLM]:
    "[⦇F-, xP⦈ ≡ ¬⦇F, xP⦈ in v]"
    unfolding propnot_defs
    apply (rule lambda_predicates_2_1[axiom_instance])
    by show_proper

  lemma thm_relation_negation_1_2[PLM]:
    "[⦇F-, xP, yP⦈ ≡ ¬⦇F, xP, yP⦈ in v]"
    unfolding propnot_defs
    apply (rule lambda_predicates_2_2[axiom_instance])
    by show_proper

  lemma thm_relation_negation_1_3[PLM]:
    "[⦇F-, xP, yP, zP⦈ ≡ ¬⦇F, xP, yP, zP⦈ in v]"
    unfolding propnot_defs
    apply (rule lambda_predicates_2_3[axiom_instance])
    by show_proper

  lemma thm_relation_negation_2_1[PLM]:
    "[(¬⦇F-, xP⦈) ≡ ⦇F, xP⦈ in v]"
    using thm_relation_negation_1_1[THEN oth_class_taut_5_d[equiv_lr]]
    apply - by PLM_solver

  lemma thm_relation_negation_2_2[PLM]:
    "[(¬⦇F-, xP, yP⦈) ≡ ⦇F, xP, yP⦈ in v]"
    using thm_relation_negation_1_2[THEN oth_class_taut_5_d[equiv_lr]]
    apply - by PLM_solver

  lemma thm_relation_negation_2_3[PLM]:
    "[(¬⦇F-, xP, yP, zP⦈) ≡ ⦇F, xP, yP, zP⦈ in v]"
    using thm_relation_negation_1_3[THEN oth_class_taut_5_d[equiv_lr]]
    apply - by PLM_solver

  lemma thm_relation_negation_3[PLM]:
    "[(p)- ≡ ¬p in v]"
    unfolding propnot_defs
    using propositions_lemma_2 by simp

  lemma thm_relation_negation_4[PLM]:
    "[(¬((p::𝗈)-)) ≡ p in v]"
    using thm_relation_negation_3[THEN oth_class_taut_5_d[equiv_lr]]
    apply - by PLM_solver

  lemma thm_relation_negation_5_1[PLM]:
    "[(F::Π1) ≠ (F-) in v]"
    using id_eq_prop_prop_2[deduction]
          l_identity[where φ="λ G . ⦇G,xP⦈ ≡ ⦇F-,xP⦈", axiom_instance,
                      deduction, deduction]
          oth_class_taut_4_a thm_relation_negation_1_1 "≡E"(5)
          oth_class_taut_1_b modus_tollens_1 CP
    by meson

  lemma thm_relation_negation_5_2[PLM]:
    "[(F::Π2) ≠ (F-) in v]"
    using id_eq_prop_prop_5_a[deduction]
          l_identity[where φ="λ G . ⦇G,xP,yP⦈ ≡ ⦇F-,xP,yP⦈", axiom_instance,
                      deduction, deduction]
          oth_class_taut_4_a thm_relation_negation_1_2 "≡E"(5)
          oth_class_taut_1_b modus_tollens_1 CP
    by meson

  lemma thm_relation_negation_5_3[PLM]:
    "[(F::Π3) ≠ (F-) in v]"
    using id_eq_prop_prop_5_b[deduction]
          l_identity[where φ="λ G . ⦇G,xP,yP,zP⦈ ≡ ⦇F-,xP,yP,zP⦈",
                     axiom_instance, deduction, deduction]
          oth_class_taut_4_a thm_relation_negation_1_3 "≡E"(5)
          oth_class_taut_1_b modus_tollens_1 CP
    by meson

  lemma thm_relation_negation_6[PLM]:
    "[(p::𝗈) ≠ (p-) in v]"
    using id_eq_prop_prop_8_b[deduction]
          l_identity[where φ="λ G . G ≡ (p-)", axiom_instance,
                      deduction, deduction]
          oth_class_taut_4_a thm_relation_negation_3 "≡E"(5)
          oth_class_taut_1_b modus_tollens_1 CP
    by meson

  lemma thm_relation_negation_7[PLM]:
    "[((p::𝗈)-) = ¬p in v]"
    unfolding propnot_defs using propositions_lemma_1 by simp

  lemma thm_relation_negation_8[PLM]:
    "[(p::𝗈) ≠ ¬p in v]"
    unfolding propnot_defs 
    using id_eq_prop_prop_8_b[deduction]
          l_identity[where φ="λ G . G ≡ ¬(p)", axiom_instance,
                      deduction, deduction]
          oth_class_taut_4_a oth_class_taut_1_b
          modus_tollens_1 CP
    by meson

  lemma thm_relation_negation_9[PLM]:
    "[((p::𝗈) = q) → ((¬p) = (¬q)) in v]"
    using l_identity[where α="p" and β="q" and φ="λ x . (¬p) = (¬x)",
                      axiom_instance, deduction]
          id_eq_prop_prop_7_b using CP modus_ponens by blast

  lemma thm_relation_negation_10[PLM]:
    "[((p::𝗈) = q) → ((p-) = (q-)) in v]"
    using l_identity[where α="p" and β="q" and φ="λ x . (p-) = (x-)",
                      axiom_instance, deduction]
          id_eq_prop_prop_7_b using CP modus_ponens by blast

  lemma thm_cont_prop_1[PLM]:
    "[NonContingent (F::Π1) ≡ NonContingent (F-) in v]"
    proof (rule "≡I"; rule CP)
      assume "[NonContingent F in v]"
      hence "[□(∀x.⦇F,xP⦈) ∨ □(∀x.¬⦇F,xP⦈) in v]"
        unfolding NonContingent_def Necessary_defs Impossible_defs .
      hence "[□(∀x. ¬⦇F-,xP⦈) ∨ □(∀x. ¬⦇F,xP⦈) in v]"
        apply -
        apply (PLM_subst_method "λ x . ⦇F,xP⦈" "λ x . ¬⦇F-,xP⦈")
        using thm_relation_negation_2_1[equiv_sym] by auto
      hence "[□(∀x. ¬⦇F-,xP⦈) ∨ □(∀x. ⦇F-,xP⦈) in v]"
        apply -
        apply (PLM_subst_goal_method
               "λ φ . □(∀x. ¬⦇F-,xP⦈) ∨ □(∀x. φ x)" "λ x . ¬⦇F,xP⦈")
        using thm_relation_negation_1_1[equiv_sym] by auto
      hence "[□(∀x. ⦇F-,xP⦈) ∨ □(∀x. ¬⦇F-,xP⦈) in v]"
        by (rule oth_class_taut_3_e[equiv_lr])
      thus "[NonContingent (F-) in v]"
        unfolding NonContingent_def Necessary_defs Impossible_defs .
    next
      assume "[NonContingent (F-) in v]"
      hence "[□(∀x. ¬⦇F-,xP⦈) ∨ □(∀x. ⦇F-,xP⦈) in v]"
        unfolding NonContingent_def Necessary_defs Impossible_defs
        by (rule oth_class_taut_3_e[equiv_lr])
      hence "[□(∀x.⦇F,xP⦈) ∨ □(∀x.⦇F-,xP⦈) in v]"
        apply -
        apply (PLM_subst_method  "λ x . ¬⦇F-,xP⦈" "λ x . ⦇F,xP⦈")
        using thm_relation_negation_2_1 by auto
      hence "[□(∀x. ⦇F,xP⦈) ∨ □(∀x. ¬⦇F,xP⦈) in v]"
        apply -
        apply (PLM_subst_method "λ x . ⦇F-,xP⦈" "λ x . ¬⦇F,xP⦈")
        using thm_relation_negation_1_1 by auto
      thus "[NonContingent F in v]"
        unfolding NonContingent_def Necessary_defs Impossible_defs .
    qed

  lemma thm_cont_prop_2[PLM]:
    "[Contingent F ≡ ◇(∃ x . ⦇F,xP⦈) & ◇(∃ x . ¬⦇F,xP⦈) in v]"
    proof (rule "≡I"; rule CP)
      assume "[Contingent F in v]"
      hence "[¬(□(∀x.⦇F,xP⦈) ∨ □(∀x.¬⦇F,xP⦈)) in v]"
        unfolding Contingent_def Necessary_defs Impossible_defs .
      hence "[(¬□(∀x.⦇F,xP⦈)) & (¬□(∀x.¬⦇F,xP⦈)) in v]"
        by (rule oth_class_taut_6_d[equiv_lr])
      hence "[(◇¬(∀x.¬⦇F,xP⦈)) & (◇¬(∀x.⦇F,xP⦈)) in v]"
        using KBasic2_2[equiv_lr] "&I" "&E" by meson
      thus "[(◇(∃ x.⦇F,xP⦈)) & (◇(∃x. ¬⦇F,xP⦈)) in v]"
        unfolding exists_def apply -
        apply (PLM_subst_method "λ x . ⦇F,xP⦈" "λ x . ¬¬⦇F,xP⦈")
        using oth_class_taut_4_b by auto
    next
      assume "[(◇(∃ x.⦇F,xP⦈)) & (◇(∃x. ¬⦇F,xP⦈)) in v]"
      hence "[(◇¬(∀x.¬⦇F,xP⦈)) & (◇¬(∀x.⦇F,xP⦈)) in v]"
        unfolding exists_def apply -
        apply (PLM_subst_goal_method
               "λ φ . (◇¬(∀x.¬⦇F,xP⦈)) & (◇¬(∀x. φ x))" "λ x . ¬¬⦇F,xP⦈")
        using oth_class_taut_4_b[equiv_sym] by auto
      hence "[(¬□(∀x.⦇F,xP⦈)) & (¬□(∀x.¬⦇F,xP⦈)) in v]"
        using KBasic2_2[equiv_rl] "&I" "&E" by meson
      hence "[¬(□(∀x.⦇F,xP⦈) ∨ □(∀x.¬⦇F,xP⦈)) in v]"
        by (rule oth_class_taut_6_d[equiv_rl])
      thus "[Contingent F in v]"
        unfolding Contingent_def Necessary_defs Impossible_defs .
    qed

  lemma thm_cont_prop_3[PLM]:
    "[Contingent (F::Π1) ≡ Contingent (F-) in v]"
    using thm_cont_prop_1
    unfolding NonContingent_def Contingent_def
    by (rule oth_class_taut_5_d[equiv_lr])

  lemma lem_cont_e[PLM]:
    "[◇(∃ x . ⦇F,xP⦈ & (◇(¬⦇F,xP⦈))) ≡ ◇(∃ x . ((¬⦇F,xP⦈) & ◇⦇F,xP⦈))in v]"
    proof -
      have "[◇(∃ x . ⦇F,xP⦈ & (◇(¬⦇F,xP⦈))) in v]
             = [(∃ x . ◇(⦇F,xP⦈ & ◇(¬⦇F,xP⦈))) in v]"
        using "BF◇"[deduction] "CBF◇"[deduction] by fast
      also have "... = [∃ x . (◇⦇F,xP⦈ & ◇(¬⦇F,xP⦈)) in v]"
        apply (PLM_subst_method
               "λ x . ◇(⦇F,xP⦈ & ◇(¬⦇F,xP⦈))"
               "λ x . ◇⦇F,xP⦈ & ◇(¬⦇F,xP⦈)")
        using S5Basic_12 by auto
      also have "... = [∃ x . ◇(¬⦇F,xP⦈) & ◇⦇F,xP⦈ in v]" 
        apply (PLM_subst_method
               "λ x . ◇⦇F,xP⦈ & ◇(¬⦇F,xP⦈)"
               "λ x . ◇(¬⦇F,xP⦈) & ◇⦇F,xP⦈")
        using oth_class_taut_3_b by auto
      also have "... = [∃ x . ◇((¬⦇F,xP⦈) & ◇⦇F,xP⦈) in v]"
        apply (PLM_subst_method
               "λ x . ◇(¬⦇F,xP⦈) & ◇⦇F,xP⦈"
               "λ x . ◇((¬⦇F,xP⦈) & ◇⦇F,xP⦈)")
        using S5Basic_12[equiv_sym] by auto
      also have "... = [◇ (∃ x . ((¬⦇F,xP⦈) & ◇⦇F,xP⦈)) in v]"
        using "CBF◇"[deduction] "BF◇"[deduction] by fast
      finally show ?thesis using "≡I" CP by blast
    qed

  lemma lem_cont_e_2[PLM]:
    "[◇(∃ x . ⦇F,xP⦈ & ◇(¬⦇F,xP⦈)) ≡ ◇(∃ x . ⦇F-,xP⦈ & ◇(¬⦇F-,xP⦈)) in v]"
    apply (PLM_subst_method "λ x . ⦇F,xP⦈" "λ x . ¬⦇F-,xP⦈")
     using thm_relation_negation_2_1[equiv_sym] apply simp
    apply (PLM_subst_method "λ x . ¬⦇F,xP⦈" "λ x . ⦇F-,xP⦈")
     using thm_relation_negation_1_1[equiv_sym] apply simp
    using lem_cont_e by simp

  lemma thm_cont_e_1[PLM]:
    "[◇(∃ x . ((¬⦇E!,xP⦈) & (◇⦇E!,xP⦈))) in v]"
    using lem_cont_e[where F="E!", equiv_lr] qml_4[axiom_instance,conj1]
    by blast

  lemma thm_cont_e_2[PLM]:
    "[Contingent (E!) in v]"
    using thm_cont_prop_2[equiv_rl] "&I" qml_4[axiom_instance, conj1]
          KBasic2_8[deduction, OF sign_S5_thm_3[deduction], conj1]
          KBasic2_8[deduction, OF sign_S5_thm_3[deduction, OF thm_cont_e_1], conj1]
    by fast

  lemma thm_cont_e_3[PLM]:
    "[Contingent (E!-) in v]"
    using thm_cont_e_2 thm_cont_prop_3[equiv_lr] by blast

  lemma thm_cont_e_4[PLM]:
    "[∃ (F::Π1) G . (F ≠ G & Contingent F & Contingent G) in v]"
    apply (rule_tac α="E!" in "∃I", rule_tac α="E!-" in "∃I")
    using thm_cont_e_2 thm_cont_e_3 thm_relation_negation_5_1 "&I" by auto

  context
  begin
    qualified definition L where "L ≡ (λ x . ⦇E!, xP⦈ → ⦇E!, xP⦈)"
    
    lemma thm_noncont_e_e_1[PLM]:
      "[Necessary L in v]"
      unfolding Necessary_defs L_def apply (rule RN, rule "∀I")
      apply (rule lambda_predicates_2_1[axiom_instance, equiv_rl])
        apply show_proper
      using if_p_then_p .

    lemma thm_noncont_e_e_2[PLM]:
      "[Impossible (L-) in v]"
      unfolding Impossible_defs L_def apply (rule RN, rule "∀I")
      apply (rule thm_relation_negation_2_1[equiv_rl])
      apply (rule lambda_predicates_2_1[axiom_instance, equiv_rl])
       apply show_proper
      using if_p_then_p .

    lemma thm_noncont_e_e_3[PLM]:
      "[NonContingent (L) in v]"
      unfolding NonContingent_def using thm_noncont_e_e_1
      by (rule "∨I"(1))

    lemma thm_noncont_e_e_4[PLM]:
      "[NonContingent (L-) in v]"
      unfolding NonContingent_def using thm_noncont_e_e_2
      by (rule "∨I"(2))

    lemma thm_noncont_e_e_5[PLM]:
      "[∃ (F::Π1) G . F ≠ G & NonContingent F & NonContingent G in v]"
      apply (rule_tac α="L" in "∃I", rule_tac α="L-" in "∃I")
      using "∃I" thm_relation_negation_5_1 thm_noncont_e_e_3
            thm_noncont_e_e_4 "&I"
      by simp


  lemma four_distinct_1[PLM]:
    "[NonContingent (F::Π1) → ¬(∃ G . (Contingent G & G = F)) in v]"
    proof (rule CP)
      assume "[NonContingent F in v]"
      hence "[¬(Contingent F) in v]"
        unfolding NonContingent_def Contingent_def
        apply - by PLM_solver
      moreover {
         assume "[∃ G . Contingent G & G = F in v]"
         then obtain P where "[Contingent P & P = F in v]"
          by (rule "∃E")
         hence "[Contingent F in v]"
           using "&E" l_identity[axiom_instance, deduction, deduction]
           by blast
      }
      ultimately show "[¬(∃G. Contingent G & G = F) in v]"
        using modus_tollens_1 CP by blast
    qed

  lemma four_distinct_2[PLM]:
    "[Contingent (F::Π1) → ¬(∃ G . (NonContingent G & G = F)) in v]"
    proof (rule CP)
      assume "[Contingent F in v]"
      hence "[¬(NonContingent F) in v]"
        unfolding NonContingent_def Contingent_def
        apply - by PLM_solver
      moreover {
         assume "[∃ G . NonContingent G & G = F in v]"
         then obtain P where "[NonContingent P & P = F in v]"
          by (rule "∃E")
         hence "[NonContingent F in v]"
           using "&E" l_identity[axiom_instance, deduction, deduction]
           by blast
      }
      ultimately show "[¬(∃G. NonContingent G & G = F) in v]"
        using modus_tollens_1 CP by blast
    qed

    lemma four_distinct_3[PLM]:
      "[L ≠ (L-) & L ≠ E! & L ≠ (E!-) & (L-) ≠ E!
        & (L-) ≠ (E!-) & E! ≠ (E!-) in v]"
      proof (rule "&I")+
        show "[L ≠ (L-) in v]"
        by (rule thm_relation_negation_5_1)
      next
        {
          assume "[L = E! in v]"
          hence "[NonContingent L & L = E! in v]"
            using thm_noncont_e_e_3 "&I" by auto
          hence "[∃ G . NonContingent G & G = E! in v]"
            using thm_noncont_e_e_3 "&I" "∃I" by fast
        }
        thus "[L ≠ E! in v]"
          using four_distinct_2[deduction, OF thm_cont_e_2]
                modus_tollens_1 CP
          by blast
      next
        {
          assume "[L = (E!-) in v]"
          hence "[NonContingent L & L = (E!-) in v]"
            using thm_noncont_e_e_3 "&I" by auto
          hence "[∃ G . NonContingent G & G = (E!-) in v]"
            using thm_noncont_e_e_3 "&I" "∃I" by fast
        }
        thus "[L ≠ (E!-) in v]"
          using four_distinct_2[deduction, OF thm_cont_e_3]
                modus_tollens_1 CP
          by blast
      next
        {
          assume "[(L-) = E! in v]"
          hence "[NonContingent (L-) & (L-) = E! in v]"
            using thm_noncont_e_e_4 "&I" by auto
          hence "[∃ G . NonContingent G & G = E! in v]"
            using thm_noncont_e_e_3 "&I" "∃I" by fast
        }
        thus "[(L-) ≠ E! in v]"
          using four_distinct_2[deduction, OF thm_cont_e_2]
                modus_tollens_1 CP
          by blast
      next
        {
          assume "[(L-) = (E!-) in v]"
          hence "[NonContingent (L-) & (L-) = (E!-) in v]"
            using thm_noncont_e_e_4 "&I" by auto
          hence "[∃ G . NonContingent G & G = (E!-) in v]"
            using thm_noncont_e_e_3 "&I" "∃I" by fast
        }
        thus "[(L-) ≠ (E!-) in v]"
          using four_distinct_2[deduction, OF thm_cont_e_3]
                modus_tollens_1 CP
          by blast
      next
        show "[E! ≠ (E!-) in v]"
          by (rule thm_relation_negation_5_1)
      qed
  end

  lemma thm_cont_propos_1[PLM]:
    "[NonContingent (p::𝗈) ≡ NonContingent (p-) in v]"
    proof (rule "≡I"; rule CP)
      assume "[NonContingent p in v]"
      hence "[□p ∨ □¬p in v]"
        unfolding NonContingent_def Necessary_defs Impossible_defs .
      hence "[□(¬(p-)) ∨ □(¬p) in v]"
        apply -
        apply (PLM_subst_method "p" "¬(p-)")
        using thm_relation_negation_4[equiv_sym] by auto
      hence "[□(¬(p-)) ∨ □(p-) in v]"
        apply -
        apply (PLM_subst_goal_method "λφ . □(¬(p-)) ∨ □(φ)" "¬p")
        using thm_relation_negation_3[equiv_sym] by auto
      hence "[□(p-) ∨ □(¬(p-)) in v]"
        by (rule oth_class_taut_3_e[equiv_lr])
      thus "[NonContingent (p-) in v]"
        unfolding NonContingent_def Necessary_defs Impossible_defs .
    next
      assume "[NonContingent (p-) in v]"
      hence "[□(¬(p-)) ∨ □(p-) in v]"
        unfolding NonContingent_def Necessary_defs Impossible_defs
        by (rule oth_class_taut_3_e[equiv_lr])
      hence "[□(p) ∨ □(p-) in v]"
        apply -
        apply (PLM_subst_goal_method  "λφ . □φ ∨ □(p-)" "¬(p-)")
        using thm_relation_negation_4 by auto
      hence "[□(p) ∨ □(¬p) in v]"
        apply -
        apply (PLM_subst_method "p-" "¬p")
        using thm_relation_negation_3 by auto
      thus "[NonContingent p in v]"
        unfolding NonContingent_def Necessary_defs Impossible_defs .
    qed

  lemma thm_cont_propos_2[PLM]:
    "[Contingent p ≡ ◇p & ◇(¬p) in v]"
    proof (rule "≡I"; rule CP)
      assume "[Contingent p in v]"
      hence "[¬(□p ∨ □(¬p)) in v]"
        unfolding Contingent_def Necessary_defs Impossible_defs .
      hence "[(¬□p) & (¬□(¬p)) in v]"
        by (rule oth_class_taut_6_d[equiv_lr])
      hence "[(◇¬(¬p)) & (◇¬p) in v]"
        using KBasic2_2[equiv_lr] "&I" "&E" by meson
      thus "[(◇p) & (◇(¬p)) in v]"
        apply - apply PLM_solver
        apply (PLM_subst_method "¬¬p" "p")
        using oth_class_taut_4_b[equiv_sym] by auto
    next
      assume "[(◇p) & (◇¬(p)) in v]"
      hence "[(◇¬(¬p)) & (◇¬(p)) in v]"
        apply - apply PLM_solver
        apply (PLM_subst_method "p" "¬¬p")
        using oth_class_taut_4_b by auto
      hence "[(¬□p) & (¬□(¬p)) in v]"
        using KBasic2_2[equiv_rl] "&I" "&E" by meson
      hence "[¬(□(p) ∨ □(¬p)) in v]"
        by (rule oth_class_taut_6_d[equiv_rl])
      thus "[Contingent p in v]"
        unfolding Contingent_def Necessary_defs Impossible_defs .
    qed

  lemma thm_cont_propos_3[PLM]:
    "[Contingent (p::𝗈) ≡ Contingent (p-) in v]"
    using thm_cont_propos_1
    unfolding NonContingent_def Contingent_def
    by (rule oth_class_taut_5_d[equiv_lr])

  context
  begin
    private definition p0 where
      "p0 ≡ ∀x. ⦇E!,xP⦈ → ⦇E!,xP⦈"

    lemma thm_noncont_propos_1[PLM]:
      "[Necessary p0 in v]"
      unfolding Necessary_defs p0_def
      apply (rule RN, rule "∀I")
      using if_p_then_p .

    lemma thm_noncont_propos_2[PLM]:
      "[Impossible (p0-) in v]"
      unfolding Impossible_defs
      apply (PLM_subst_method "¬p0" "p0-")
       using thm_relation_negation_3[equiv_sym] apply simp
      apply (PLM_subst_method "p0" "¬¬p0")
       using oth_class_taut_4_b apply simp
      using thm_noncont_propos_1 unfolding Necessary_defs
      by simp

    lemma thm_noncont_propos_3[PLM]:
      "[NonContingent (p0) in v]"
      unfolding NonContingent_def using thm_noncont_propos_1
      by (rule "∨I"(1))

    lemma thm_noncont_propos_4[PLM]:
      "[NonContingent (p0-) in v]"
      unfolding NonContingent_def using thm_noncont_propos_2
      by (rule "∨I"(2))

    lemma thm_noncont_propos_5[PLM]:
      "[∃ (p::𝗈) q . p ≠ q & NonContingent p & NonContingent q in v]"
      apply (rule_tac α="p0" in "∃I", rule_tac α="p0-" in "∃I")
      using "∃I" thm_relation_negation_6 thm_noncont_propos_3
            thm_noncont_propos_4 "&I" by simp

    private definition q0 where
      "q0 ≡ ∃ x . ⦇E!,xP⦈ & ◇(¬⦇E!,xP⦈)"

    lemma basic_prop_1[PLM]:
      "[∃ p . ◇p & ◇(¬p) in v]"
      apply (rule_tac α="q0" in "∃I") unfolding q0_def
      using qml_4[axiom_instance] by simp

    lemma basic_prop_2[PLM]:
      "[Contingent q0 in v]"
      unfolding Contingent_def Necessary_defs Impossible_defs
      apply (rule oth_class_taut_6_d[equiv_rl])
      apply (PLM_subst_goal_method "λ φ . (¬□(φ)) & ¬□¬q0" "¬¬q0")
       using oth_class_taut_4_b[equiv_sym] apply simp
      using qml_4[axiom_instance,conj_sym]
      unfolding q0_def diamond_def by simp

    lemma basic_prop_3[PLM]:
      "[Contingent (q0-) in v]"
      apply (rule thm_cont_propos_3[equiv_lr])
      using basic_prop_2 .

    lemma basic_prop_4[PLM]:
      "[∃ (p::𝗈) q . p ≠ q & Contingent p & Contingent q in v]"
      apply (rule_tac α="q0" in "∃I", rule_tac α="q0-" in "∃I")
      using thm_relation_negation_6 basic_prop_2 basic_prop_3 "&I" by simp

    lemma four_distinct_props_1[PLM]:
      "[NonContingent (p::Π0) → (¬(∃ q . Contingent q & q = p)) in v]"
      proof (rule CP)
        assume "[NonContingent p in v]"
        hence "[¬(Contingent p) in v]"
          unfolding NonContingent_def Contingent_def
          apply - by PLM_solver
        moreover {
           assume "[∃ q . Contingent q & q = p in v]"
           then obtain r where "[Contingent r & r = p in v]"
            by (rule "∃E")
           hence "[Contingent p in v]"
             using "&E" l_identity[axiom_instance, deduction, deduction]
             by blast
        }
        ultimately show "[¬(∃q. Contingent q & q = p) in v]"
          using modus_tollens_1 CP by blast
      qed

    lemma four_distinct_props_2[PLM]:
      "[Contingent (p::𝗈) → ¬(∃ q . (NonContingent q & q = p)) in v]"
      proof (rule CP)
        assume "[Contingent p in v]"
        hence "[¬(NonContingent p) in v]"
          unfolding NonContingent_def Contingent_def
          apply - by PLM_solver
        moreover {
           assume "[∃ q . NonContingent q & q = p in v]"
           then obtain r where "[NonContingent r & r = p in v]"
            by (rule "∃E")
           hence "[NonContingent p in v]"
             using "&E" l_identity[axiom_instance, deduction, deduction]
             by blast
        }
        ultimately show "[¬(∃q. NonContingent q & q = p) in v]"
          using modus_tollens_1 CP by blast
      qed

    lemma four_distinct_props_4[PLM]:
      "[p0 ≠ (p0-) & p0 ≠ q0 & p0 ≠ (q0-) & (p0-) ≠ q0
        & (p0-) ≠ (q0-) & q0 ≠ (q0-) in v]"
      proof (rule "&I")+
        show "[p0 ≠ (p0-) in v]"
          by (rule thm_relation_negation_6)
        next
          {
            assume "[p0 = q0 in v]"
            hence "[∃ q . NonContingent q & q = q0 in v]"
              using "&I" thm_noncont_propos_3 "∃I"[where α=p0]
              by simp
          }
          thus "[p0 ≠ q0 in v]"
            using four_distinct_props_2[deduction, OF basic_prop_2]
                  modus_tollens_1 CP
            by blast
        next
          {
            assume "[p0 = (q0-) in v]"
            hence "[∃ q . NonContingent q & q = (q0-) in v]"
              using thm_noncont_propos_3 "&I" "∃I"[where α=p0] by simp
          }
          thus "[p0 ≠ (q0-) in v]"
            using four_distinct_props_2[deduction, OF basic_prop_3]
                  modus_tollens_1 CP
          by blast
        next
          {
            assume "[(p0-) = q0 in v]"
            hence "[∃ q . NonContingent q & q = q0 in v]"
              using thm_noncont_propos_4 "&I" "∃I"[where α="p0-"] by auto
          }
          thus "[(p0-) ≠ q0 in v]"
            using four_distinct_props_2[deduction, OF basic_prop_2]
                  modus_tollens_1 CP
            by blast
        next
          {
            assume "[(p0-) = (q0-) in v]"
            hence "[∃ q . NonContingent q & q = (q0-) in v]"
              using thm_noncont_propos_4 "&I" "∃I"[where α="p0-"] by auto
          }
          thus "[(p0-) ≠ (q0-) in v]"
            using four_distinct_props_2[deduction, OF basic_prop_3]
                  modus_tollens_1 CP
            by blast
        next
          show "[q0 ≠ (q0-) in v]"
            by (rule thm_relation_negation_6)
        qed

    lemma cont_true_cont_1[PLM]:
      "[ContingentlyTrue p → Contingent p in v]"
      apply (rule CP, rule thm_cont_propos_2[equiv_rl])
      unfolding ContingentlyTrue_def
      apply (rule "&I", drule "&E"(1))
       using "T◇"[deduction] apply simp
      by (rule "&E"(2))
  
    lemma cont_true_cont_2[PLM]:
      "[ContingentlyFalse p → Contingent p in v]"
      apply (rule CP, rule thm_cont_propos_2[equiv_rl])
      unfolding ContingentlyFalse_def
      apply (rule "&I", drule "&E"(2))
       apply simp
      apply (drule "&E"(1))
      using "T◇"[deduction] by simp
  
    lemma cont_true_cont_3[PLM]:
      "[ContingentlyTrue p ≡ ContingentlyFalse (p-) in v]"
      unfolding ContingentlyTrue_def ContingentlyFalse_def
      apply (PLM_subst_method "¬p" "p-")
       using thm_relation_negation_3[equiv_sym] apply simp
      apply (PLM_subst_method "p" "¬¬p")
      by PLM_solver+
  
    lemma cont_true_cont_4[PLM]:
      "[ContingentlyFalse p ≡ ContingentlyTrue (p-) in v]"
      unfolding ContingentlyTrue_def ContingentlyFalse_def
      apply (PLM_subst_method "¬p" "p-")
       using thm_relation_negation_3[equiv_sym] apply simp
      apply (PLM_subst_method "p" "¬¬p")
      by PLM_solver+

    lemma cont_tf_thm_1[PLM]:
      "[ContingentlyTrue q0 ∨ ContingentlyFalse q0 in v]"
      proof -
        have "[q0 ∨ ¬q0 in v]"
          by PLM_solver
        moreover {
          assume "[q0 in v]"
          hence "[q0 & ◇¬q0 in v]"
            unfolding q0_def
            using qml_4[axiom_instance,conj2] "&I"
            by auto
        }
        moreover {
          assume "[¬q0 in v]"
          hence "[(¬q0) & ◇q0 in v]"
            unfolding q0_def
            using qml_4[axiom_instance,conj1] "&I"
            by auto
        }
        ultimately show ?thesis
          unfolding ContingentlyTrue_def ContingentlyFalse_def
          using "∨E"(4) CP by auto
      qed

    lemma cont_tf_thm_2[PLM]:
      "[ContingentlyFalse q0 ∨ ContingentlyFalse (q0-) in v]"
      using cont_tf_thm_1 cont_true_cont_3[where p="q0"]
            cont_true_cont_4[where p="q0"]
      apply - by PLM_solver

    lemma cont_tf_thm_3[PLM]:
      "[∃ p . ContingentlyTrue p in v]"
      proof (rule "∨E"(1); (rule CP)?)
        show "[ContingentlyTrue q0 ∨ ContingentlyFalse q0 in v]"
          using cont_tf_thm_1 .
      next
        assume "[ContingentlyTrue q0 in v]"
        thus ?thesis
          using "∃I" by metis
      next
        assume "[ContingentlyFalse q0 in v]"
        hence "[ContingentlyTrue (q0-) in v]"
          using cont_true_cont_4[equiv_lr] by simp
        thus ?thesis
          using "∃I" by metis
      qed

    lemma cont_tf_thm_4[PLM]:
      "[∃ p . ContingentlyFalse p in v]"
      proof (rule "∨E"(1); (rule CP)?)
        show "[ContingentlyTrue q0 ∨ ContingentlyFalse q0 in v]"
          using cont_tf_thm_1 .
      next
        assume "[ContingentlyTrue q0 in v]"
        hence "[ContingentlyFalse (q0-) in v]"
          using cont_true_cont_3[equiv_lr] by simp
        thus ?thesis
          using "∃I" by metis
      next
        assume "[ContingentlyFalse q0 in v]"
        thus ?thesis
          using "∃I" by metis
      qed

    lemma cont_tf_thm_5[PLM]:
      "[ContingentlyTrue p & Necessary q → p ≠ q in v]"
      proof (rule CP)
        assume "[ContingentlyTrue p & Necessary q in v]"
        hence 1: "[◇(¬p) & □ q in v]"
          unfolding ContingentlyTrue_def Necessary_defs
          using "&E" "&I" by blast
        hence "[¬□p in v]"
          apply - apply (drule "&E"(1))
          unfolding diamond_def
          apply (PLM_subst_method "¬¬p" "p")
          using oth_class_taut_4_b[equiv_sym] by auto
        moreover {
          assume "[p = q in v]"
          hence "[□p in v]"
            using l_identity[where α="q" and β="p" and φ="λ x . □ x",
                             axiom_instance, deduction, deduction]
                  1[conj2] id_eq_prop_prop_8_b[deduction]
            by blast
        }
        ultimately show "[p ≠ q in v]"
          using modus_tollens_1 CP by blast
      qed

    lemma cont_tf_thm_6[PLM]:
      "[(ContingentlyFalse p & Impossible q) → p ≠ q in v]"
      proof (rule CP)
        assume "[ContingentlyFalse p & Impossible q in v]"
        hence 1: "[◇p & □(¬q) in v]"
          unfolding ContingentlyFalse_def Impossible_defs
          using "&E" "&I" by blast
        hence "[¬◇q in v]"
          unfolding diamond_def apply - by PLM_solver
        moreover {
          assume "[p = q in v]"
          hence "[◇q in v]"
            using l_identity[axiom_instance, deduction, deduction] 1[conj1]
                  id_eq_prop_prop_8_b[deduction]
            by blast
        }
        ultimately show "[p ≠ q in v]"
          using modus_tollens_1 CP by blast
      qed
  end

  lemma oa_contingent_1[PLM]:
    "[O! ≠ A! in v]"
    proof -
      {
        assume "[O! = A! in v]"
        hence "[(λx. ◇⦇E!,xP⦈) = (λx. ¬◇⦇E!,xP⦈) in v]"
          unfolding Ordinary_def Abstract_def .
        moreover have "[⦇(λx. ◇⦇E!,xP⦈), xP⦈ ≡ ◇⦇E!,xP⦈ in v]"
          apply (rule beta_C_meta_1)
          by show_proper
        ultimately have "[⦇(λx. ¬◇⦇E!,xP⦈), xP⦈ ≡ ◇⦇E!,xP⦈ in v]"
          using l_identity[axiom_instance, deduction, deduction] by fast
        moreover have "[⦇(λx. ¬◇⦇E!,xP⦈), xP⦈ ≡ ¬◇⦇E!,xP⦈ in v]"
          apply (rule beta_C_meta_1)
          by show_proper
        ultimately have "[◇⦇E!,xP⦈ ≡ ¬◇⦇E!,xP⦈ in v]"
          apply - by PLM_solver
      }
      thus ?thesis
        using oth_class_taut_1_b modus_tollens_1 CP
        by blast
    qed

  lemma oa_contingent_2[PLM]:
    "[⦇O!,xP⦈ ≡ ¬⦇A!,xP⦈ in v]"
    proof -
        have "[⦇(λx. ¬◇⦇E!,xP⦈), xP⦈ ≡ ¬◇⦇E!,xP⦈ in v]"
          apply (rule beta_C_meta_1)
          by show_proper
        hence "[(¬⦇(λx. ¬◇⦇E!,xP⦈), xP⦈) ≡ ◇⦇E!,xP⦈ in v]"
          using oth_class_taut_5_d[equiv_lr] oth_class_taut_4_b[equiv_sym]
                "≡E"(5) by blast
        moreover have "[⦇(λx. ◇⦇E!,xP⦈), xP⦈ ≡ ◇⦇E!,xP⦈ in v]"
          apply (rule beta_C_meta_1)
          by show_proper
        ultimately show ?thesis
          unfolding Ordinary_def Abstract_def
          apply - by PLM_solver
    qed

  lemma oa_contingent_3[PLM]:
    "[⦇A!,xP⦈ ≡ ¬⦇O!,xP⦈ in v]"
    using oa_contingent_2
    apply - by PLM_solver

  lemma oa_contingent_4[PLM]:
    "[Contingent O! in v]"
    apply (rule thm_cont_prop_2[equiv_rl], rule "&I")
    subgoal
      unfolding Ordinary_def
      apply (PLM_subst_method "λ x . ◇⦇E!,xP⦈" "λ x . ⦇λx. ◇⦇E!,xP⦈,xP⦈")
       apply (safe intro!: beta_C_meta_1[equiv_sym])
        apply show_proper
      using "BF◇"[deduction, OF thm_cont_prop_2[equiv_lr, OF thm_cont_e_2, conj1]]
      by (rule "T◇"[deduction])
    subgoal
      apply (PLM_subst_method "λ x . ⦇A!,xP⦈" "λ x . ¬⦇O!,xP⦈")
       using oa_contingent_3 apply simp
      using cqt_further_5[deduction,conj1, OF A_objects[axiom_instance]]
      by (rule "T◇"[deduction])
    done

  lemma oa_contingent_5[PLM]:
    "[Contingent A! in v]"
    apply (rule thm_cont_prop_2[equiv_rl], rule "&I")
    subgoal
      using cqt_further_5[deduction,conj1, OF A_objects[axiom_instance]]
      by (rule "T◇"[deduction])
    subgoal
      unfolding Abstract_def
      apply (PLM_subst_method "λ x . ¬◇⦇E!,xP⦈" "λ x . ⦇λx. ¬◇⦇E!,xP⦈,xP⦈")
       apply (safe intro!: beta_C_meta_1[equiv_sym])
        apply show_proper
      apply (PLM_subst_method "λ x . ◇⦇E!,xP⦈" "λ x . ¬¬◇⦇E!,xP⦈")
       using oth_class_taut_4_b apply simp
      using "BF◇"[deduction, OF thm_cont_prop_2[equiv_lr, OF thm_cont_e_2, conj1]]
      by (rule "T◇"[deduction])
    done

  lemma oa_contingent_6[PLM]:
    "[(O!-) ≠ (A!-) in v]"
    proof -
      {
        assume "[(O!-) = (A!-) in v]"
        hence "[(λx. ¬⦇O!,xP⦈) = (λx. ¬⦇A!,xP⦈) in v]"
          unfolding propnot_defs .
        moreover have "[⦇(λx. ¬⦇O!,xP⦈), xP⦈ ≡ ¬⦇O!,xP⦈ in v]"
          apply (rule beta_C_meta_1)
          by show_proper
        ultimately have "[⦇λx. ¬⦇A!,xP⦈,xP⦈ ≡  ¬⦇O!,xP⦈ in v]"
          using l_identity[axiom_instance, deduction, deduction]
          by fast
        hence "[(¬⦇A!,xP⦈) ≡ ¬⦇O!,xP⦈ in v]"
          apply -
          apply (PLM_subst_method "⦇λx. ¬⦇A!,xP⦈,xP⦈" "(¬⦇A!,xP⦈)")
           apply (safe intro!: beta_C_meta_1)
          by show_proper
        hence "[⦇O!,xP⦈ ≡ ¬⦇O!,xP⦈ in v]"
          using oa_contingent_2 apply - by PLM_solver
      }
      thus ?thesis
        using oth_class_taut_1_b modus_tollens_1 CP
        by blast
    qed

  lemma oa_contingent_7[PLM]:
    "[⦇O!-,xP⦈ ≡ ¬⦇A!-,xP⦈ in v]"
    proof -
      have "[(¬⦇λx. ¬⦇A!,xP⦈,xP⦈) ≡ ⦇A!,xP⦈ in v]"
        apply (PLM_subst_method "(¬⦇A!,xP⦈)" "⦇λx. ¬⦇A!,xP⦈,xP⦈")
         apply (safe intro!: beta_C_meta_1[equiv_sym])
          apply show_proper
        using oth_class_taut_4_b[equiv_sym] by auto
      moreover have "[⦇λx. ¬⦇O!,xP⦈,xP⦈ ≡ ¬⦇O!,xP⦈ in v]"
        apply (rule beta_C_meta_1)
        by show_proper
      ultimately show ?thesis
        unfolding propnot_defs
        using oa_contingent_3
        apply - by PLM_solver
    qed

  lemma oa_contingent_8[PLM]:
    "[Contingent (O!-) in v]"
    using oa_contingent_4 thm_cont_prop_3[equiv_lr] by auto

  lemma oa_contingent_9[PLM]:
    "[Contingent (A!-) in v]"
    using oa_contingent_5 thm_cont_prop_3[equiv_lr] by auto

  lemma oa_facts_1[PLM]:
    "[⦇O!,xP⦈ → □⦇O!,xP⦈ in v]"
    proof (rule CP)
      assume "[⦇O!,xP⦈ in v]"
      hence "[◇⦇E!,xP⦈ in v]"
        unfolding Ordinary_def apply -
        apply (rule beta_C_meta_1[equiv_lr])
        by show_proper
      hence "[□◇⦇E!,xP⦈ in v]"
        using qml_3[axiom_instance, deduction] by auto
      thus "[□⦇O!,xP⦈ in v]"
        unfolding Ordinary_def
        apply -
        apply (PLM_subst_method "◇⦇E!,xP⦈" "⦇λx. ◇⦇E!,xP⦈,xP⦈")
         apply (safe intro!: beta_C_meta_1[equiv_sym])
        by show_proper
    qed

  lemma oa_facts_2[PLM]:
    "[⦇A!,xP⦈ → □⦇A!,xP⦈ in v]"
    proof (rule CP)
      assume "[⦇A!,xP⦈ in v]"
      hence "[¬◇⦇E!,xP⦈ in v]"
        unfolding Abstract_def apply -
        apply (rule beta_C_meta_1[equiv_lr])
        by show_proper
      hence "[□□¬⦇E!,xP⦈ in v]"
        using KBasic2_4[equiv_rl] "4□"[deduction] by auto
      hence "[□¬◇⦇E!,xP⦈ in v]"
        apply -
        apply (PLM_subst_method "□¬⦇E!,xP⦈" "¬◇⦇E!,xP⦈")
        using KBasic2_4 by auto
      thus "[□⦇A!,xP⦈ in v]"
        unfolding Abstract_def
        apply -
        apply (PLM_subst_method "¬◇⦇E!,xP⦈" "⦇λx. ¬◇⦇E!,xP⦈,xP⦈")
         apply (safe intro!: beta_C_meta_1[equiv_sym])
        by show_proper
    qed

  lemma oa_facts_3[PLM]:
    "[◇⦇O!,xP⦈ → ⦇O!,xP⦈ in v]"
    using oa_facts_1 by (rule derived_S5_rules_2_b)

  lemma oa_facts_4[PLM]:
    "[◇⦇A!,xP⦈ → ⦇A!,xP⦈ in v]"
    using oa_facts_2 by (rule derived_S5_rules_2_b)

  lemma oa_facts_5[PLM]:
    "[◇⦇O!,xP⦈ ≡ □⦇O!,xP⦈ in v]"
    using oa_facts_1[deduction, OF oa_facts_3[deduction]]
      "T◇"[deduction, OF qml_2[axiom_instance, deduction]]
      "≡I" CP by blast

  lemma oa_facts_6[PLM]:
    "[◇⦇A!,xP⦈ ≡ □⦇A!,xP⦈ in v]"
    using oa_facts_2[deduction, OF oa_facts_4[deduction]]
      "T◇"[deduction, OF qml_2[axiom_instance, deduction]]
      "≡I" CP by blast

  lemma oa_facts_7[PLM]:
    "[⦇O!,xP⦈ ≡ 𝒜⦇O!,xP⦈ in v]"
    apply (rule "≡I"; rule CP)
     apply (rule nec_imp_act[deduction, OF oa_facts_1[deduction]]; assumption)
    proof -
      assume "[𝒜⦇O!,xP⦈ in v]"
      hence "[𝒜(◇⦇E!,xP⦈) in v]"
        unfolding Ordinary_def  apply -
        apply (PLM_subst_method "⦇λx. ◇⦇E!,xP⦈,xP⦈" "◇⦇E!,xP⦈")
        apply (safe intro!: beta_C_meta_1)
        by show_proper
      hence "[◇⦇E!,xP⦈ in v]"
        using Act_Basic_6[equiv_rl] by auto
      thus "[⦇O!,xP⦈ in v]"
        unfolding Ordinary_def apply -
        apply (PLM_subst_method "◇⦇E!,xP⦈" "⦇λx. ◇⦇E!,xP⦈,xP⦈")
         apply (safe intro!: beta_C_meta_1[equiv_sym])
        by show_proper
    qed

  lemma oa_facts_8[PLM]:
    "[⦇A!,xP⦈ ≡ 𝒜⦇A!,xP⦈ in v]"
    apply (rule "≡I"; rule CP)
     apply (rule nec_imp_act[deduction, OF oa_facts_2[deduction]]; assumption)
    proof -
      assume "[𝒜⦇A!,xP⦈ in v]"
      hence "[𝒜(¬◇⦇E!,xP⦈) in v]"
        unfolding Abstract_def apply -
        apply (PLM_subst_method "⦇λx. ¬◇⦇E!,xP⦈,xP⦈" "¬◇⦇E!,xP⦈")
        apply (safe intro!: beta_C_meta_1)
        by show_proper
      hence "[𝒜(□¬⦇E!,xP⦈) in v]"
        apply -
        apply (PLM_subst_method "(¬◇⦇E!,xP⦈)" "(□¬⦇E!,xP⦈)")
        using KBasic2_4[equiv_sym] by auto
      hence "[¬◇⦇E!,xP⦈ in v]"
        using qml_act_2[axiom_instance, equiv_rl] KBasic2_4[equiv_lr] by auto
      thus "[⦇A!,xP⦈ in v]"
        unfolding Abstract_def apply -
        apply (PLM_subst_method "¬◇⦇E!,xP⦈" "⦇λx. ¬◇⦇E!,xP⦈,xP⦈")
        apply (safe intro!: beta_C_meta_1[equiv_sym])
        by show_proper
    qed

  lemma cont_nec_fact1_1[PLM]:
    "[WeaklyContingent F ≡ WeaklyContingent (F-) in v]"
    proof (rule "≡I"; rule CP)
      assume "[WeaklyContingent F in v]"
      hence wc_def: "[Contingent F & (∀ x . (◇⦇F,xP⦈ → □⦇F,xP⦈)) in v]"
        unfolding WeaklyContingent_def .
      have "[Contingent (F-) in v]"
        using wc_def[conj1] by (rule thm_cont_prop_3[equiv_lr])
      moreover {
        {
          fix x
          assume "[◇⦇F-,xP⦈ in v]"
          hence "[¬□⦇F,xP⦈ in v]"
            unfolding diamond_def apply -
            apply (PLM_subst_method "¬⦇F-,xP⦈" "⦇F,xP⦈")
             using thm_relation_negation_2_1 by auto
          moreover {
            assume "[¬□⦇F-,xP⦈ in v]"
            hence "[¬□⦇λx. ¬⦇F,xP⦈,xP⦈ in v]"
              unfolding propnot_defs .
            hence "[◇⦇F,xP⦈ in v]"
              unfolding diamond_def
              apply - apply (PLM_subst_method "⦇λx. ¬⦇F,xP⦈,xP⦈" "¬⦇F,xP⦈")
              apply (safe intro!: beta_C_meta_1)
              by show_proper
            hence "[□⦇F,xP⦈ in v]"
              using wc_def[conj2] cqt_1[axiom_instance, deduction]
                    modus_ponens by fast
          }
          ultimately have "[□⦇F-, xP⦈ in v]"
            using "¬¬E" modus_tollens_1 CP by blast
        }
        hence "[∀ x . ◇⦇F-,xP⦈ → □⦇F-, xP⦈ in v]"
          using "∀I" CP by fast
      }
      ultimately show "[WeaklyContingent (F-) in v]"
        unfolding WeaklyContingent_def by (rule "&I")
    next
      assume "[WeaklyContingent (F-) in v]"
      hence wc_def: "[Contingent (F-) & (∀ x . (◇⦇F-,xP⦈ → □⦇F-,xP⦈)) in v]"
        unfolding WeaklyContingent_def .
      have "[Contingent F in v]"
        using wc_def[conj1] by (rule thm_cont_prop_3[equiv_rl])
      moreover {
        {
          fix x
          assume "[◇⦇F,xP⦈ in v]"
          hence "[¬□⦇F-,xP⦈ in v]"
            unfolding diamond_def apply -
            apply (PLM_subst_method "¬⦇F,xP⦈" "⦇F-,xP⦈")
            using thm_relation_negation_1_1[equiv_sym] by auto
          moreover {
            assume "[¬□⦇F,xP⦈ in v]"
            hence "[◇⦇F-,xP⦈ in v]"
              unfolding diamond_def
              apply - apply (PLM_subst_method "⦇F,xP⦈" "¬⦇F-,xP⦈")
              using thm_relation_negation_2_1[equiv_sym] by auto
            hence "[□⦇F-,xP⦈ in v]"
              using wc_def[conj2] cqt_1[axiom_instance, deduction]
                    modus_ponens by fast
          }
          ultimately have "[□⦇F, xP⦈ in v]"
            using "¬¬E" modus_tollens_1 CP by blast
        }
        hence "[∀ x . ◇⦇F,xP⦈ → □⦇F, xP⦈ in v]"
          using "∀I" CP by fast
      }
      ultimately show "[WeaklyContingent (F) in v]"
        unfolding WeaklyContingent_def by (rule "&I")
    qed

  lemma cont_nec_fact1_2[PLM]:
    "[(WeaklyContingent F & ¬(WeaklyContingent G)) → (F ≠ G) in v]"
    using l_identity[axiom_instance,deduction,deduction] "&E" "&I"
          modus_tollens_1 CP by metis

  lemma cont_nec_fact2_1[PLM]:
    "[WeaklyContingent (O!) in v]"
    unfolding WeaklyContingent_def
    apply (rule "&I")
     using oa_contingent_4 apply simp
    using oa_facts_5 unfolding equiv_def
    using "&E"(1) "∀I" by fast

  lemma cont_nec_fact2_2[PLM]:
    "[WeaklyContingent (A!) in v]"
    unfolding WeaklyContingent_def
    apply (rule "&I")
     using oa_contingent_5 apply simp
    using oa_facts_6 unfolding equiv_def
    using "&E"(1) "∀I" by fast

  lemma cont_nec_fact2_3[PLM]:
    "[¬(WeaklyContingent (E!)) in v]"
    proof (rule modus_tollens_1, rule CP)
      assume "[WeaklyContingent E! in v]"
      thus "[∀ x . ◇⦇E!,xP⦈ → □⦇E!,xP⦈ in v]"
      unfolding WeaklyContingent_def using "&E"(2) by fast
    next
      {
        assume 1: "[∀ x . ◇⦇E!,xP⦈ → □⦇E!,xP⦈ in v]"
        have "[∃ x . ◇(⦇E!,xP⦈ & ◇(¬⦇E!,xP⦈)) in v]"
          using qml_4[axiom_instance,conj1, THEN BFs_3[deduction]] .
        then obtain x where "[◇(⦇E!,xP⦈ & ◇(¬⦇E!,xP⦈)) in v]"
          by (rule "∃E")
        hence "[◇⦇E!,xP⦈ & ◇(¬⦇E!,xP⦈) in v]"
          using KBasic2_8[deduction] S5Basic_8[deduction]
                "&I" "&E" by blast
        hence "[□⦇E!,xP⦈ & (¬□⦇E!,xP⦈) in v]"
          using 1[THEN "∀E", deduction] "&E" "&I"
                KBasic2_2[equiv_rl] by blast
        hence "[¬(∀ x . ◇⦇E!,xP⦈ → □⦇E!,xP⦈) in v]"
          using oth_class_taut_1_a modus_tollens_1 CP by blast
      }
      thus "[¬(∀ x . ◇⦇E!,xP⦈ → □⦇E!,xP⦈) in v]"
        using reductio_aa_2 if_p_then_p CP by meson
    qed

  lemma cont_nec_fact2_4[PLM]:
    "[¬(WeaklyContingent (PLM.L)) in v]"
    proof -
      {
        assume "[WeaklyContingent PLM.L in v]"
        hence "[Contingent PLM.L in v]"
          unfolding WeaklyContingent_def using "&E"(1) by blast
      }
      thus ?thesis
        using thm_noncont_e_e_3
        unfolding Contingent_def NonContingent_def
        using modus_tollens_2 CP by blast
    qed

  lemma cont_nec_fact2_5[PLM]:
    "[O! ≠ E! & O! ≠ (E!-) & O! ≠ PLM.L & O! ≠ (PLM.L-) in v]"
    proof ((rule "&I")+)
      show "[O! ≠ E! in v]"
        using cont_nec_fact2_1 cont_nec_fact2_3
              cont_nec_fact1_2[deduction] "&I" by simp
    next
      have "[¬(WeaklyContingent (E!-)) in v]"
        using cont_nec_fact1_1[THEN oth_class_taut_5_d[equiv_lr], equiv_lr]
              cont_nec_fact2_3 by auto
      thus "[O! ≠ (E!-) in v]"
        using cont_nec_fact2_1 cont_nec_fact1_2[deduction] "&I" by simp
    next
      show "[O! ≠ PLM.L in v]"
        using cont_nec_fact2_1 cont_nec_fact2_4
              cont_nec_fact1_2[deduction] "&I" by simp
    next
      have "[¬(WeaklyContingent (PLM.L-)) in v]"
        using cont_nec_fact1_1[THEN oth_class_taut_5_d[equiv_lr], equiv_lr]
              cont_nec_fact2_4 by auto
      thus "[O! ≠ (PLM.L-) in v]"
        using cont_nec_fact2_1 cont_nec_fact1_2[deduction] "&I" by simp
    qed

  lemma cont_nec_fact2_6[PLM]:
    "[A! ≠ E! & A! ≠ (E!-) & A! ≠ PLM.L & A! ≠ (PLM.L-) in v]"
    proof ((rule "&I")+)
      show "[A! ≠ E! in v]"
        using cont_nec_fact2_2 cont_nec_fact2_3
              cont_nec_fact1_2[deduction] "&I" by simp
    next
      have "[¬(WeaklyContingent (E!-)) in v]"
        using cont_nec_fact1_1[THEN oth_class_taut_5_d[equiv_lr], equiv_lr]
              cont_nec_fact2_3 by auto
      thus "[A! ≠ (E!-) in v]"
        using cont_nec_fact2_2 cont_nec_fact1_2[deduction] "&I" by simp
    next
      show "[A! ≠ PLM.L in v]"
        using cont_nec_fact2_2 cont_nec_fact2_4
              cont_nec_fact1_2[deduction] "&I" by simp
    next
      have "[¬(WeaklyContingent (PLM.L-)) in v]"
        using cont_nec_fact1_1[THEN oth_class_taut_5_d[equiv_lr],
                equiv_lr] cont_nec_fact2_4 by auto
      thus "[A! ≠ (PLM.L-) in v]"
        using cont_nec_fact2_2 cont_nec_fact1_2[deduction] "&I" by simp
    qed

  lemma id_nec3_1[PLM]:
    "[((xP) =E (yP)) ≡ (□((xP) =E (yP)))  in v]"
    proof (rule "≡I"; rule CP)
      assume "[(xP) =E (yP) in v]"
      hence "[⦇O!,xP⦈ in v] ∧ [⦇O!,yP⦈ in v] ∧ [□(∀ F . ⦇F,xP⦈ ≡ ⦇F,yP⦈) in v]"
        using eq_E_simple_1[equiv_lr] using "&E" by blast
      hence "[□⦇O!,xP⦈ in v] ∧ [□⦇O!,yP⦈ in v]
             ∧ [□□(∀ F . ⦇F,xP⦈ ≡ ⦇F,yP⦈) in v]"
        using oa_facts_1[deduction] S5Basic_6[deduction] by blast
      hence "[□(⦇O!,xP⦈ & ⦇O!,yP⦈ & □(∀ F. ⦇F,xP⦈ ≡ ⦇F,yP⦈)) in v]"
        using "&I" KBasic_3[equiv_rl] by presburger
      thus "[□((xP) =E (yP)) in v]"
        apply -
        apply (PLM_subst_method
               "(⦇O!,xP⦈ & ⦇O!,yP⦈ & □(∀ F. ⦇F,xP⦈ ≡ ⦇F,yP⦈))"
               "(xP) =E (yP)")
        using eq_E_simple_1[equiv_sym] by auto
    next
      assume "[□((xP) =E (yP)) in v]"
      thus "[((xP) =E (yP)) in v]"
      using qml_2[axiom_instance,deduction] by simp
    qed

  lemma id_nec3_2[PLM]:
    "[◇((xP) =E (yP)) ≡ ((xP) =E (yP)) in v]"
    proof (rule "≡I"; rule CP)
      assume "[◇((xP) =E (yP)) in v]"
      thus "[(xP) =E (yP) in v]"
        using derived_S5_rules_2_b[deduction] id_nec3_1[equiv_lr]
              CP modus_ponens by blast
    next
      assume "[(xP) =E (yP) in v]"
      thus "[◇((xP) =E (yP)) in v]"
        by (rule TBasic[deduction])
    qed

  lemma thm_neg_eqE[PLM]:
    "[((xP) ≠E (yP)) ≡ (¬((xP) =E (yP))) in v]"
    proof -
      have "[(xP) ≠E (yP) in v] = [⦇(λ2 (λ x y . (xP) =E (yP)))-, xP, yP⦈ in v]"
        unfolding not_identicalE_def by simp
      also have "... = [¬⦇(λ2 (λ x y . (xP) =E (yP))), xP, yP⦈ in v]"
        unfolding propnot_defs
        apply (safe intro!: beta_C_meta_2[equiv_lr] beta_C_meta_2[equiv_rl])
        by show_proper+
      also have "... = [¬((xP) =E (yP)) in v]"
        apply (PLM_subst_method
               "⦇(λ2 (λ x y . (xP) =E (yP))), xP, yP⦈"
               "(xP) =E (yP)")
         apply (safe intro!: beta_C_meta_2)
        unfolding identity_defs by show_proper
      finally show ?thesis
        using "≡I" CP by presburger
    qed

  lemma id_nec4_1[PLM]:
    "[((xP) ≠E (yP)) ≡ □((xP) ≠E (yP)) in v]"
    proof -
      have "[(¬((xP) =E (yP))) ≡ □(¬((xP) =E (yP))) in v]"
        using id_nec3_2[equiv_sym] oth_class_taut_5_d[equiv_lr]
        KBasic2_4[equiv_sym] intro_elim_6_e by fast
      thus ?thesis
        apply -
        apply (PLM_subst_method "(¬((xP) =E (yP)))" "(xP) ≠E (yP)")
        using thm_neg_eqE[equiv_sym] by auto
    qed

  lemma id_nec4_2[PLM]:
    "[◇((xP) ≠E (yP)) ≡ ((xP) ≠E (yP)) in v]"
    using "≡I" id_nec4_1[equiv_lr] derived_S5_rules_2_b CP "T◇" by simp

  lemma id_act_1[PLM]:
    "[((xP) =E (yP)) ≡ (𝒜((xP) =E (yP))) in v]"
    proof (rule "≡I"; rule CP)
      assume "[(xP) =E (yP) in v]"
      hence "[□((xP) =E (yP)) in v]"
        using id_nec3_1[equiv_lr] by auto
      thus "[𝒜((xP) =E (yP)) in v]"
        using nec_imp_act[deduction] by fast
    next
      assume "[𝒜((xP) =E (yP)) in v]"
      hence "[𝒜(⦇O!,xP⦈ & ⦇O!,yP⦈ & □(∀ F . ⦇F,xP⦈ ≡ ⦇F,yP⦈)) in v]"
        apply -
        apply (PLM_subst_method
               "(xP) =E (yP)"
               "(⦇O!,xP⦈ & ⦇O!,yP⦈ & □(∀ F . ⦇F,xP⦈ ≡ ⦇F,yP⦈))")
        using eq_E_simple_1 by auto
      hence "[𝒜⦇O!,xP⦈ & 𝒜⦇O!,yP⦈ & 𝒜(□(∀ F . ⦇F,xP⦈ ≡ ⦇F,yP⦈)) in v]"
        using Act_Basic_2[equiv_lr] "&I" "&E" by meson
      thus "[(xP) =E (yP) in v]"
        apply - apply (rule eq_E_simple_1[equiv_rl])
        using oa_facts_7[equiv_rl] qml_act_2[axiom_instance, equiv_rl]
              "&I" "&E" by meson
    qed

  lemma id_act_2[PLM]:
    "[((xP) ≠E (yP)) ≡ (𝒜((xP) ≠E (yP))) in v]"
    apply (PLM_subst_method "(¬((xP) =E (yP)))" "((xP) ≠E (yP))")
     using thm_neg_eqE[equiv_sym] apply simp
    using id_act_1 oth_class_taut_5_d[equiv_lr] thm_neg_eqE intro_elim_6_e
          logic_actual_nec_1[axiom_instance,equiv_sym] by meson

end

class id_act = id_eq +
  assumes id_act_prop: "[𝒜(α = β) in v] ⟹ [(α = β) in v]"

instantiation ν :: id_act
begin
  instance proof
    interpret PLM .
    fix x::ν and y::ν and v::i
    assume "[𝒜(x = y) in v]"
    hence "[𝒜(((xP) =E (yP)) ∨ (⦇A!,xP⦈ & ⦇A!,yP⦈
            & □(∀ F . ⦃xP,F⦄ ≡ ⦃yP,F⦄))) in v]"
      unfolding identity_defs by auto
    hence "[𝒜(((xP) =E (yP))) ∨ 𝒜((⦇A!,xP⦈ & ⦇A!,yP⦈
            & □(∀ F . ⦃xP,F⦄ ≡ ⦃yP,F⦄))) in v]"
      using Act_Basic_10[equiv_lr] by auto
    moreover {
       assume "[𝒜(((xP) =E (yP))) in v]"
       hence "[(xP) = (yP) in v]"
        using id_act_1[equiv_rl] eq_E_simple_2[deduction] by auto
    }
    moreover {
       assume "[𝒜(⦇A!,xP⦈ & ⦇A!,yP⦈ & □(∀ F . ⦃xP,F⦄ ≡ ⦃yP,F⦄)) in v]"
       hence "[𝒜⦇A!,xP⦈ & 𝒜⦇A!,yP⦈ & 𝒜(□(∀ F . ⦃xP,F⦄ ≡ ⦃yP,F⦄)) in v]"
         using Act_Basic_2[equiv_lr] "&I" "&E" by meson
       hence "[⦇A!,xP⦈ & ⦇A!,yP⦈ & (□(∀ F . ⦃xP,F⦄ ≡ ⦃yP,F⦄)) in v]"
         using oa_facts_8[equiv_rl] qml_act_2[axiom_instance,equiv_rl]
           "&I" "&E" by meson
       hence "[(xP) = (yP) in v]"
        unfolding identity_defs using "∨I" by auto
    }
    ultimately have "[(xP) = (yP) in v]"
      using intro_elim_4_a CP by meson
    thus "[x = y in v]"
      unfolding identity_defs by auto
  qed
end

instantiation Π1 :: id_act
begin
  instance proof
    interpret PLM .
    fix F::Π1 and G::Π1 and v::i
    show "[𝒜(F = G) in v] ⟹ [(F = G) in v]" 
      unfolding identity_defs
      using qml_act_2[axiom_instance,equiv_rl] by auto
  qed
end

instantiation 𝗈 :: id_act
begin
  instance proof
    interpret PLM .
    fix p :: 𝗈 and q :: 𝗈 and v::i
    show "[𝒜(p = q) in v] ⟹ [p = q in v]"
      unfolding identity𝗈_def using id_act_prop by blast
  qed
end

instantiation Π2 :: id_act
begin
  instance proof
    interpret PLM .
    fix F::Π2 and G::Π2 and v::i
    assume a: "[𝒜(F = G) in v]"
    {
      fix x
      have "[𝒜((λy. ⦇F,xP,yP⦈) = (λy. ⦇G,xP,yP⦈)
             & (λy. ⦇F,yP,xP⦈) = (λy. ⦇G,yP,xP⦈)) in v]"
        using a logic_actual_nec_3[axiom_instance, equiv_lr] cqt_basic_4[equiv_lr] "∀E"
        unfolding identity2_def by fast
      hence "[((λy. ⦇F,xP,yP⦈) = (λy. ⦇G,xP,yP⦈))
              & ((λy. ⦇F,yP,xP⦈) = (λy. ⦇G,yP,xP⦈)) in v]"
        using "&I" "&E" id_act_prop Act_Basic_2[equiv_lr] by metis
    }
    thus "[F = G in v]" unfolding identity_defs by (rule "∀I")
  qed
end

instantiation Π3 :: id_act
begin
  instance proof
    interpret PLM .
    fix F::Π3 and G::Π3 and v::i
    assume a: "[𝒜(F = G) in v]"
    let ?p = "λ x y . (λz. ⦇F,zP,xP,yP⦈) = (λz. ⦇G,zP,xP,yP⦈)
                    & (λz. ⦇F,xP,zP,yP⦈) = (λz. ⦇G,xP,zP,yP⦈)
                    & (λz. ⦇F,xP,yP,zP⦈) = (λz. ⦇G,xP,yP,zP⦈)"
    {
      fix x
      {
        fix y
        have "[𝒜(?p x y) in v]"
          using a logic_actual_nec_3[axiom_instance, equiv_lr]
                cqt_basic_4[equiv_lr] "∀E"[where 'a=ν]
          unfolding identity3_def by blast
        hence "[?p x y in v]"
          using "&I" "&E" id_act_prop Act_Basic_2[equiv_lr] by metis
      }
      hence "[∀ y . ?p x y in v]"
        by (rule "∀I")
    }
    thus "[F = G in v]"
      unfolding identity3_def by (rule "∀I")
  qed
end

context PLM
begin
  lemma id_act_3[PLM]:
    "[((α::('a::id_act)) = β) ≡ 𝒜(α = β) in v]"
    using "≡I" CP id_nec[equiv_lr, THEN nec_imp_act[deduction]]
          id_act_prop by metis

  lemma id_act_4[PLM]:
    "[((α::('a::id_act)) ≠ β) ≡ 𝒜(α ≠ β) in v]"
    using id_act_3[THEN oth_class_taut_5_d[equiv_lr]]
          logic_actual_nec_1[axiom_instance, equiv_sym]
          intro_elim_6_e by blast

  lemma id_act_desc[PLM]:
    "[(yP) = (ιx . x = y) in v]"
    using descriptions[axiom_instance,equiv_rl]
          id_act_3[equiv_sym] "∀I" by fast

  lemma eta_conversion_lemma_1[PLM]:
    "[(λ x . ⦇F,xP⦈) = F in v]"
    using lambda_predicates_3_1[axiom_instance] .

  lemma eta_conversion_lemma_0[PLM]:
    "[(λ0 p) = p in v]"
    using lambda_predicates_3_0[axiom_instance] .

  lemma eta_conversion_lemma_2[PLM]:
    "[(λ2 (λ x y . ⦇F,xP,yP⦈)) = F in v]"
    using lambda_predicates_3_2[axiom_instance] .

  lemma eta_conversion_lemma_3[PLM]:
    "[(λ3 (λ x y z . ⦇F,xP,yP,zP⦈)) = F in v]"
    using lambda_predicates_3_3[axiom_instance] .

  lemma lambda_p_q_p_eq_q[PLM]:
    "[((λ0 p) = (λ0 q)) ≡ (p = q) in v]"
    using eta_conversion_lemma_0
          l_identity[axiom_instance, deduction, deduction]
          eta_conversion_lemma_0[eq_sym] "≡I" CP
    by metis

subsection‹The Theory of Objects›
text‹\label{TAO_PLM_Objects}›

  lemma partition_1[PLM]:
    "[∀ x . ⦇O!,xP⦈ ∨ ⦇A!,xP⦈ in v]"
    proof (rule "∀I")
      fix x
      have "[◇⦇E!,xP⦈ ∨ ¬◇⦇E!,xP⦈ in v]"
        by PLM_solver
      moreover have "[◇⦇E!,xP⦈ ≡ ⦇λ y . ◇⦇E!,yP⦈, xP⦈ in v]"
        apply (rule beta_C_meta_1[equiv_sym])
        by show_proper
      moreover have "[(¬◇⦇E!,xP⦈) ≡ ⦇λ y . ¬◇⦇E!,yP⦈, xP⦈ in v]"
        apply (rule beta_C_meta_1[equiv_sym])
        by show_proper
      ultimately show "[⦇O!, xP⦈ ∨ ⦇A!, xP⦈ in v]"
        unfolding Ordinary_def Abstract_def by PLM_solver
    qed

  lemma partition_2[PLM]:
    "[¬(∃ x . ⦇O!,xP⦈ & ⦇A!,xP⦈) in v]"
    proof -
      {
        assume "[∃ x . ⦇O!,xP⦈ & ⦇A!,xP⦈ in v]"
        then obtain b where "[⦇O!,bP⦈ & ⦇A!,bP⦈ in v]"
          by (rule "∃E")
        hence ?thesis
          using "&E" oa_contingent_2[equiv_lr]
                reductio_aa_2 by fast
      }
      thus ?thesis
        using reductio_aa_2 by blast
    qed

  lemma ord_eq_Eequiv_1[PLM]:
    "[⦇O!,x⦈ → (x =E x) in v]"
    proof (rule CP)
      assume "[⦇O!,x⦈ in v]"
      moreover have "[□(∀ F . ⦇F,x⦈ ≡ ⦇F,x⦈) in v]"
        by PLM_solver
      ultimately show "[(x) =E (x) in v]"
        using "&I" eq_E_simple_1[equiv_rl] by blast
    qed

  lemma ord_eq_Eequiv_2[PLM]:
    "[(x =E y) → (y =E x) in v]"
    proof (rule CP)
      assume "[x =E y in v]"
      hence 1: "[⦇O!,x⦈ & ⦇O!,y⦈ & □(∀ F . ⦇F,x⦈ ≡ ⦇F,y⦈) in v]"
        using eq_E_simple_1[equiv_lr] by simp
      have "[□(∀ F . ⦇F,y⦈ ≡ ⦇F,x⦈) in v]"
        apply (PLM_subst_method
               "λ F . ⦇F,x⦈ ≡ ⦇F,y⦈"
               "λ F . ⦇F,y⦈ ≡ ⦇F,x⦈")
        using oth_class_taut_3_g 1[conj2] by auto
      thus "[y =E x in v]"
        using eq_E_simple_1[equiv_rl] 1[conj1]
              "&E" "&I" by meson
    qed

  lemma ord_eq_Eequiv_3[PLM]:
    "[((x =E y) & (y =E z)) → (x =E z) in v]"
    proof (rule CP)
      assume a: "[(x =E y) & (y =E z) in v]"
      have "[□((∀ F . ⦇F,x⦈ ≡ ⦇F,y⦈) & (∀ F . ⦇F,y⦈ ≡ ⦇F,z⦈)) in v]"
        using KBasic_3[equiv_rl] a[conj1, THEN eq_E_simple_1[equiv_lr,conj2]]
              a[conj2, THEN eq_E_simple_1[equiv_lr,conj2]] "&I" by blast
      moreover {
        {
          fix w
          have "[((∀ F . ⦇F,x⦈ ≡ ⦇F,y⦈) & (∀ F . ⦇F,y⦈ ≡ ⦇F,z⦈))
                  → (∀ F . ⦇F,x⦈ ≡ ⦇F,z⦈) in w]"
            by PLM_solver
        }
        hence "[□(((∀ F . ⦇F,x⦈ ≡ ⦇F,y⦈) & (∀ F . ⦇F,y⦈ ≡ ⦇F,z⦈))
                → (∀ F . ⦇F,x⦈ ≡ ⦇F,z⦈)) in v]"
          by (rule RN)
      }
      ultimately have "[□(∀ F . ⦇F,x⦈ ≡ ⦇F,z⦈) in v]"
        using qml_1[axiom_instance,deduction,deduction] by blast
      thus "[x =E z in v]"
        using a[conj1, THEN eq_E_simple_1[equiv_lr,conj1,conj1]]
        using a[conj2, THEN eq_E_simple_1[equiv_lr,conj1,conj2]]
              eq_E_simple_1[equiv_rl] "&I"
        by presburger
    qed

  lemma ord_eq_E_eq[PLM]:
    "[(⦇O!,xP⦈ ∨ ⦇O!,yP⦈) → ((xP = yP) ≡ (xP =E yP)) in v]"
    proof (rule CP)
      assume "[⦇O!,xP⦈ ∨ ⦇O!,yP⦈ in v]"
      moreover {
        assume "[⦇O!,xP⦈ in v]"
        hence "[(xP = yP) ≡ (xP =E yP) in v]"
          using "≡I" CP l_identity[axiom_instance, deduction, deduction]
                ord_eq_Eequiv_1[deduction] eq_E_simple_2[deduction] by metis
      }
      moreover {
        assume "[⦇O!,yP⦈ in v]"
        hence "[(xP = yP) ≡ (xP =E yP) in v]"
          using "≡I" CP l_identity[axiom_instance, deduction, deduction]
                ord_eq_Eequiv_1[deduction] eq_E_simple_2[deduction] id_eq_2[deduction]
                ord_eq_Eequiv_2[deduction] identity_ν_def by metis
      }
      ultimately show "[(xP = yP) ≡ (xP =E yP) in v]"
        using intro_elim_4_a CP by blast
    qed

  lemma ord_eq_E[PLM]:
    "[(⦇O!,xP⦈ & ⦇O!,yP⦈) → ((∀ F . ⦇F,xP⦈ ≡ ⦇F,yP⦈) → xP =E yP) in v]"
    proof (rule CP; rule CP)
      assume ord_xy: "[⦇O!,xP⦈ & ⦇O!,yP⦈ in v]"
      assume "[∀ F . ⦇F,xP⦈ ≡ ⦇F,yP⦈ in v]"
      hence "[⦇λ z . zP =E xP, xP⦈ ≡ ⦇λ z . zP =E xP, yP⦈ in v]"
        by (rule "∀E")
      moreover have "[⦇λ z . zP =E xP, xP⦈ in v]"
        apply (rule beta_C_meta_1[equiv_rl])
        unfolding identityE_infix_def
         apply show_proper
        using ord_eq_Eequiv_1[deduction] ord_xy[conj1]
        unfolding identityE_infix_def by simp
      ultimately have "[⦇λ z . zP =E xP, yP⦈ in v]"
        using "≡E" by blast
      hence "[yP =E xP in v]"
        unfolding identityE_infix_def
        apply (safe intro!:
            beta_C_meta_1[where φ = "λ z . ⦇basic_identityE,z,xP⦈", equiv_lr])
        by show_proper
      thus "[xP =E yP in v]"
        by (rule ord_eq_Eequiv_2[deduction])
    qed

  lemma ord_eq_E2[PLM]:
    "[(⦇O!,xP⦈ & ⦇O!,yP⦈) →
      ((xP ≠ yP) ≡ (λz . zP =E xP) ≠ (λz . zP =E yP)) in v]"
    proof (rule CP; rule "≡I"; rule CP)
      assume ord_xy: "[⦇O!,xP⦈ & ⦇O!,yP⦈ in v]"
      assume "[xP ≠ yP in v]"
      hence "[¬(xP =E yP) in v]"
        using eq_E_simple_2 modus_tollens_1 by fast
      moreover {
        assume "[(λz . zP =E xP) = (λz . zP =E yP) in v]"
        moreover have "[⦇λz . zP =E xP, xP⦈ in v]"
          apply (rule beta_C_meta_1[equiv_rl])
          unfolding identityE_infix_def
           apply show_proper
          using ord_eq_Eequiv_1[deduction] ord_xy[conj1]
          unfolding identityE_infix_def by presburger
        ultimately have "[⦇λz . zP =E yP, xP⦈ in v]"
          using l_identity[axiom_instance, deduction, deduction] by fast
        hence "[xP =E yP in v]"
          unfolding identityE_infix_def
          apply (safe intro!:
              beta_C_meta_1[where φ = "λ z . ⦇basic_identityE,z,yP⦈", equiv_lr])
          by show_proper
      }
      ultimately show "[(λz . zP =E xP) ≠ (λz . zP =E yP) in v]"
        using modus_tollens_1 CP by blast
    next
      assume ord_xy: "[⦇O!,xP⦈ & ⦇O!,yP⦈ in v]"
      assume "[(λz . zP =E xP) ≠ (λz . zP =E yP) in v]"
      moreover {
        assume "[xP = yP in v]"
        hence "[(λz . zP =E xP) = (λz . zP =E yP) in v]"
          using id_eq_1 l_identity[axiom_instance, deduction, deduction]
          by fast
      }
      ultimately show "[xP ≠ yP in v]"
        using modus_tollens_1 CP by blast
    qed

  lemma ab_obey_1[PLM]:
    "[(⦇A!,xP⦈ & ⦇A!,yP⦈) → ((∀ F . ⦃xP, F⦄ ≡ ⦃yP, F⦄) → xP = yP) in v]"
    proof(rule CP; rule CP)
      assume abs_xy: "[⦇A!,xP⦈ & ⦇A!,yP⦈ in v]"
      assume enc_equiv: "[∀ F . ⦃xP, F⦄ ≡ ⦃yP, F⦄ in v]"
      {
        fix P
        have "[⦃xP, P⦄ ≡ ⦃yP, P⦄ in v]"
          using enc_equiv by (rule "∀E")
        hence "[□(⦃xP, P⦄ ≡ ⦃yP, P⦄) in v]"
          using en_eq_2 intro_elim_6_e intro_elim_6_f
                en_eq_5[equiv_rl] by meson
      }
      hence "[□(∀ F . ⦃xP, F⦄ ≡ ⦃yP, F⦄) in v]"
        using BF[deduction] "∀I" by fast
      thus "[xP = yP in v]"
        unfolding identity_defs
        using "∨I"(2) abs_xy "&I" by presburger
    qed

  lemma ab_obey_2[PLM]:
    "[(⦇A!,xP⦈ & ⦇A!,yP⦈) → ((∃ F . ⦃xP, F⦄ & ¬⦃yP, F⦄) → xP ≠ yP) in v]"
    proof(rule CP; rule CP)
      assume abs_xy: "[⦇A!,xP⦈ & ⦇A!,yP⦈ in v]"
      assume "[∃ F . ⦃xP, F⦄ & ¬⦃yP, F⦄ in v]"
      then obtain P where P_prop:
        "[⦃xP, P⦄ & ¬⦃yP, P⦄ in v]"
        by (rule "∃E")
      {
        assume "[xP = yP in v]"
        hence "[⦃xP, P⦄ ≡ ⦃yP, P⦄ in v]"
          using l_identity[axiom_instance, deduction, deduction]
                oth_class_taut_4_a by fast
        hence "[⦃yP, P⦄ in v]"
          using P_prop[conj1] by (rule "≡E")
      }
      thus "[xP ≠ yP in v]"
        using P_prop[conj2] modus_tollens_1 CP by blast
    qed

  lemma ordnecfail[PLM]:
    "[⦇O!,xP⦈ → □(¬(∃ F . ⦃xP, F⦄)) in v]"
    proof (rule CP)
      assume "[⦇O!,xP⦈ in v]"
      hence "[□⦇O!,xP⦈ in v]"
        using oa_facts_1[deduction] by simp
      moreover hence "[□(⦇O!,xP⦈ → (¬(∃ F . ⦃xP, F⦄))) in v]"
        using nocoder[axiom_necessitation, axiom_instance] by simp
      ultimately show "[□(¬(∃ F . ⦃xP, F⦄)) in v]"
        using qml_1[axiom_instance, deduction, deduction] by fast
    qed

  lemma o_objects_exist_1[PLM]:
    "[◇(∃ x . ⦇E!,xP⦈) in v]"
    proof -
      have "[◇(∃ x . ⦇E!,xP⦈ & ◇(¬⦇E!,xP⦈)) in v]"
        using qml_4[axiom_instance, conj1] .
      hence "[◇((∃ x . ⦇E!,xP⦈) & (∃ x . ◇(¬⦇E!,xP⦈))) in v]"
        using sign_S5_thm_3[deduction] by fast
      hence "[◇(∃ x . ⦇E!,xP⦈) & ◇(∃ x . ◇(¬⦇E!,xP⦈)) in v]"
        using KBasic2_8[deduction] by blast
      thus ?thesis using "&E" by blast
    qed

  lemma o_objects_exist_2[PLM]:
    "[□(∃ x . ⦇O!,xP⦈) in v]"
    apply (rule RN) unfolding Ordinary_def
    apply (PLM_subst_method  "λ x . ◇⦇E!,xP⦈" "λ x . ⦇λy. ◇⦇E!,yP⦈, xP⦈")
     apply (safe intro!: beta_C_meta_1[equiv_sym])
     apply show_proper
    using o_objects_exist_1 "BF◇"[deduction] by blast

  lemma o_objects_exist_3[PLM]:
    "[□(¬(∀ x . ⦇A!,xP⦈)) in v]"
    apply (PLM_subst_method "(∃x. ¬⦇A!,xP⦈)" "¬(∀x. ⦇A!,xP⦈)")
     using cqt_further_2[equiv_sym] apply fast
    apply (PLM_subst_method "λ x . ⦇O!,xP⦈" "λ x . ¬⦇A!,xP⦈")
    using oa_contingent_2 o_objects_exist_2 by auto

  lemma a_objects_exist_1[PLM]:
    "[□(∃ x . ⦇A!,xP⦈) in v]"
    proof -
      {
        fix v
        have "[∃ x . ⦇A!,xP⦈ & (∀ F . ⦃xP, F⦄ ≡ (F = F)) in v]"
          using A_objects[axiom_instance] by simp
        hence "[∃ x . ⦇A!,xP⦈ in v]"
          using cqt_further_5[deduction,conj1] by fast
      }
      thus ?thesis by (rule RN)
    qed

  lemma a_objects_exist_2[PLM]:
    "[□(¬(∀ x . ⦇O!,xP⦈)) in v]"
    apply (PLM_subst_method "(∃x. ¬⦇O!,xP⦈)" "¬(∀x. ⦇O!,xP⦈)")
     using cqt_further_2[equiv_sym] apply fast
    apply (PLM_subst_method "λ x . ⦇A!,xP⦈" "λ x . ¬⦇O!,xP⦈")
     using oa_contingent_3 a_objects_exist_1 by auto

  lemma a_objects_exist_3[PLM]:
    "[□(¬(∀ x . ⦇E!,xP⦈)) in v]"
    proof -
      {
        fix v
        have "[∃ x . ⦇A!,xP⦈ & (∀ F . ⦃xP, F⦄ ≡ (F = F)) in v]"
          using A_objects[axiom_instance] by simp
        hence "[∃ x . ⦇A!,xP⦈ in v]"
          using cqt_further_5[deduction,conj1] by fast
        then obtain a where
          "[⦇A!,aP⦈ in v]"
          by (rule "∃E")
        hence "[¬(◇⦇E!,aP⦈) in v]"
          unfolding Abstract_def
          apply (safe intro!: beta_C_meta_1[equiv_lr])
          by show_proper
        hence "[(¬⦇E!,aP⦈) in v]"
          using KBasic2_4[equiv_rl] qml_2[axiom_instance,deduction]
          by simp
        hence "[¬(∀ x . ⦇E!,xP⦈) in v]"
          using "∃I" cqt_further_2[equiv_rl]
          by fast  
      }
      thus ?thesis
        by (rule RN)
    qed

  lemma encoders_are_abstract[PLM]:
    "[(∃ F . ⦃xP, F⦄) → ⦇A!,xP⦈ in v]"
    using nocoder[axiom_instance] contraposition_2
          oa_contingent_2[THEN oth_class_taut_5_d[equiv_lr], equiv_lr]
          useful_tautologies_1[deduction]
          vdash_properties_10 CP by metis

  lemma A_objects_unique[PLM]:
    "[∃! x . ⦇A!,xP⦈ & (∀ F . ⦃xP, F⦄ ≡ φ F) in v]"
    proof -
      have "[∃ x . ⦇A!,xP⦈ & (∀ F . ⦃xP, F⦄ ≡ φ F) in v]"
        using A_objects[axiom_instance] by simp
      then obtain a where a_prop:
        "[⦇A!,aP⦈ & (∀ F . ⦃aP, F⦄ ≡ φ F) in v]" by (rule "∃E")
      moreover have "[∀ y . ⦇A!,yP⦈ & (∀ F . ⦃yP, F⦄ ≡ φ F) → (y = a) in v]"
        proof (rule "∀I"; rule CP)
          fix b
          assume b_prop: "[⦇A!,bP⦈ & (∀ F . ⦃bP, F⦄ ≡ φ F) in v]"
          {
            fix P
            have "[⦃bP,P⦄ ≡ ⦃aP, P⦄ in v]"
              using a_prop[conj2] b_prop[conj2] "≡I" "≡E"(1) "≡E"(2)
                    CP vdash_properties_10 "∀E" by metis
          }
          hence "[∀ F . ⦃bP,F⦄ ≡ ⦃aP, F⦄ in v]"
            using "∀I" by fast
          thus "[b = a in v]"
            unfolding identity_ν_def
            using ab_obey_1[deduction, deduction]
                  a_prop[conj1] b_prop[conj1] "&I" by blast
        qed
      ultimately show ?thesis
        unfolding exists_unique_def
        using "&I" "∃I" by fast
    qed

  lemma obj_oth_1[PLM]:
    "[∃! x . ⦇A!,xP⦈ & (∀ F . ⦃xP, F⦄ ≡ ⦇F, yP⦈) in v]"
    using A_objects_unique .

  lemma obj_oth_2[PLM]:
    "[∃! x . ⦇A!,xP⦈ & (∀ F . ⦃xP, F⦄ ≡ (⦇F, yP⦈ & ⦇F, zP⦈)) in v]"
    using A_objects_unique .

  lemma obj_oth_3[PLM]:
    "[∃! x . ⦇A!,xP⦈ & (∀ F . ⦃xP, F⦄ ≡ (⦇F, yP⦈ ∨ ⦇F, zP⦈)) in v]"
    using A_objects_unique .

  lemma obj_oth_4[PLM]:
    "[∃! x . ⦇A!,xP⦈ & (∀ F . ⦃xP, F⦄ ≡ (□⦇F, yP⦈)) in v]"
    using A_objects_unique .

  lemma obj_oth_5[PLM]:
    "[∃! x . ⦇A!,xP⦈ & (∀ F . ⦃xP, F⦄ ≡ (F = G)) in v]"
    using A_objects_unique .

  lemma obj_oth_6[PLM]:
    "[∃! x . ⦇A!,xP⦈ & (∀ F . ⦃xP, F⦄ ≡ □(∀ y . ⦇G, yP⦈ → ⦇F, yP⦈)) in v]"
    using A_objects_unique .

  lemma A_Exists_1[PLM]:
    "[𝒜(∃! x :: ('a :: id_act) . φ x) ≡ (∃! x . 𝒜(φ x)) in v]"
    unfolding exists_unique_def
    proof (rule "≡I"; rule CP)
      assume "[𝒜(∃α. φ α & (∀β. φ β → β = α)) in v]"
      hence "[∃α. 𝒜(φ α & (∀β. φ β → β = α)) in v]"
        using Act_Basic_11[equiv_lr] by blast
      then obtain α where
        "[𝒜(φ α & (∀β. φ β → β = α)) in v]"
        by (rule "∃E")
      hence 1: "[𝒜(φ α) & 𝒜(∀β. φ β → β = α) in v]"
        using Act_Basic_2[equiv_lr] by blast
      have 2: "[∀β. 𝒜(φ β → β = α) in v]"
        using 1[conj2] logic_actual_nec_3[axiom_instance, equiv_lr] by blast
      {
        fix β
        have "[𝒜(φ β → β = α) in v]"
          using 2 by (rule "∀E")
        hence "[𝒜(φ β) → (β = α) in v]"
          using logic_actual_nec_2[axiom_instance, equiv_lr, deduction]
                id_act_3[equiv_rl] CP by blast
      }
      hence "[∀ β . 𝒜(φ β) → (β = α) in v]"
        by (rule "∀I")
      thus "[∃α. 𝒜φ α & (∀β. 𝒜φ β → β = α) in v]"
        using 1[conj1] "&I" "∃I" by fast
    next
      assume "[∃α. 𝒜φ α & (∀β. 𝒜φ β → β = α) in v]"
      then obtain α where 1:
        "[𝒜φ α & (∀β. 𝒜φ β → β = α) in v]"
        by (rule "∃E")
      {
        fix β
        have "[𝒜(φ β) → β = α in v]"
          using 1[conj2] by (rule "∀E")
        hence "[𝒜(φ β → β = α) in v]"
          using logic_actual_nec_2[axiom_instance, equiv_rl] id_act_3[equiv_lr]
                vdash_properties_10 CP by blast
      }
      hence "[∀ β . 𝒜(φ β → β = α) in v]"
        by (rule "∀I")
      hence "[𝒜(∀ β . φ β → β = α) in v]"
        using logic_actual_nec_3[axiom_instance, equiv_rl] by fast
      hence "[𝒜(φ α & (∀ β . φ β → β = α)) in v]"
        using 1[conj1] Act_Basic_2[equiv_rl] "&I" by blast
      hence "[∃α. 𝒜(φ α & (∀β. φ β → β = α)) in v]"
        using "∃I" by fast
      thus "[𝒜(∃α. φ α & (∀β. φ β → β = α)) in v]"
        using Act_Basic_11[equiv_rl] by fast
    qed

  lemma A_Exists_2[PLM]:
    "[(∃ y . yP = (ιx . φ x)) ≡ 𝒜(∃!x . φ x) in v]"
    using actual_desc_1 A_Exists_1[equiv_sym]
          intro_elim_6_e by blast

  lemma A_descriptions[PLM]:
    "[∃ y . yP = (ιx . ⦇A!,xP⦈ & (∀ F . ⦃xP,F⦄ ≡ φ F)) in v]"
    using A_objects_unique[THEN RN, THEN nec_imp_act[deduction]]
          A_Exists_2[equiv_rl] by auto

  lemma thm_can_terms2[PLM]:
    "[(yP = (ιx . ⦇A!,xP⦈ & (∀ F . ⦃xP,F⦄ ≡ φ F)))
      → (⦇A!,yP⦈ & (∀ F . ⦃yP,F⦄ ≡ φ F)) in dw]"
    using y_in_2 by auto

  lemma can_ab2[PLM]:
    "[(yP = (ιx . ⦇A!,xP⦈ & (∀ F . ⦃xP,F⦄ ≡ φ F))) → ⦇A!,yP⦈ in v]"
    proof (rule CP)
      assume "[yP = (ιx . ⦇A!,xP⦈ & (∀ F . ⦃xP,F⦄ ≡ φ F)) in v]"
      hence "[𝒜⦇A!,yP⦈ & 𝒜(∀ F . ⦃yP,F⦄ ≡ φ F) in v]"
        using nec_hintikka_scheme[equiv_lr, conj1]
              Act_Basic_2[equiv_lr] by blast
      thus "[⦇A!,yP⦈ in v]"
        using oa_facts_8[equiv_rl] "&E" by blast
    qed

  lemma desc_encode[PLM]:
    "[⦃ιx . ⦇A!,xP⦈ & (∀ F . ⦃xP,F⦄ ≡ φ F), G⦄ ≡ φ G in dw]"
    proof -
      obtain a where
        "[aP = (ιx . ⦇A!,xP⦈ & (∀ F . ⦃xP,F⦄ ≡ φ F)) in dw]"
        using A_descriptions by (rule "∃E")
      moreover hence "[⦃aP, G⦄ ≡ φ G in dw]"
        using hintikka[equiv_lr, conj1] "&E" "∀E" by fast
      ultimately show ?thesis
        using l_identity[axiom_instance, deduction, deduction] by fast
    qed

  lemma desc_nec_encode[PLM]:
    "[⦃ιx . ⦇A!,xP⦈ & (∀ F . ⦃xP,F⦄ ≡ φ F), G⦄ ≡ 𝒜(φ G) in v]"
    proof -
      obtain a where
        "[aP = (ιx . ⦇A!,xP⦈ & (∀ F . ⦃xP,F⦄ ≡ φ F)) in v]"
        using A_descriptions by (rule "∃E")
      moreover {
        hence "[𝒜(⦇A!,aP⦈ & (∀ F . ⦃aP,F⦄ ≡ φ F)) in v]"
          using nec_hintikka_scheme[equiv_lr, conj1] by fast
        hence "[𝒜(∀ F . ⦃aP,F⦄ ≡ φ F) in v]"
          using Act_Basic_2[equiv_lr,conj2] by blast
        hence "[∀ F . 𝒜( ⦃aP,F⦄ ≡ φ F) in v]"
          using logic_actual_nec_3[axiom_instance, equiv_lr] by blast
        hence "[𝒜(⦃aP, G⦄ ≡ φ G) in v]"
          using "∀E" by fast
        hence "[𝒜⦃aP, G⦄ ≡ 𝒜(φ G) in v]"
          using Act_Basic_5[equiv_lr] by fast
        hence "[⦃aP, G⦄ ≡ 𝒜(φ G) in v]"
          using en_eq_10[equiv_sym] intro_elim_6_e by blast
      }
      ultimately show ?thesis
        using l_identity[axiom_instance, deduction, deduction] by fast
    qed

  notepad
  begin
      fix v
      let ?x = "ιx . ⦇A!,xP⦈ & (∀ F . ⦃xP, F⦄ ≡ (∃ q . q & F = (λ y . q)))"
      have "[□(∃ p . ContingentlyTrue p) in v]"
        using cont_tf_thm_3 RN by auto
      hence "[𝒜(∃ p . ContingentlyTrue p) in v]"
        using nec_imp_act[deduction] by simp
      hence "[∃ p . 𝒜(ContingentlyTrue p) in v]"
        using Act_Basic_11[equiv_lr] by auto
      then obtain p1 where
        "[𝒜(ContingentlyTrue p1) in v]"
        by (rule "∃E")
      hence "[𝒜p1 in v]"
        unfolding ContingentlyTrue_def
        using Act_Basic_2[equiv_lr] "&E" by fast
      hence "[𝒜p1 & 𝒜((λ y . p1) = (λ y . p1)) in v]"
        using "&I" id_eq_1[THEN RN, THEN nec_imp_act[deduction]] by fast
      hence "[𝒜(p1 & (λ y . p1) = (λ y . p1)) in v]"
        using Act_Basic_2[equiv_rl] by fast
      hence "[∃ q . 𝒜( q & (λ y . p1) = (λ y . q)) in v]"
        using "∃I" by fast
      hence "[𝒜(∃ q . q & (λ y . p1) = (λ y . q)) in v]"
        using Act_Basic_11[equiv_rl] by fast
      moreover have "[⦃?x, λ y . p1⦄ ≡ 𝒜(∃ q . q & (λ y . p1) = (λ y . q)) in v]"
        using desc_nec_encode by fast
      ultimately have "[⦃?x, λ y . p1⦄ in v]"
        using "≡E" by blast
  end

  lemma Box_desc_encode_1[PLM]:
    "[□(φ G) → ⦃(ιx . ⦇A!,xP⦈ & (∀ F . ⦃xP, F⦄ ≡ φ F)), G⦄ in v]"
    proof (rule CP)
      assume "[□(φ G) in v]"
      hence "[𝒜(φ G) in v]"
        using nec_imp_act[deduction] by auto
      thus "[⦃ιx . ⦇A!,xP⦈ & (∀ F . ⦃xP,F⦄ ≡ φ F), G⦄ in v]"
        using desc_nec_encode[equiv_rl] by simp
    qed

  lemma Box_desc_encode_2[PLM]:
    "[□(φ G) → □(⦃(ιx . ⦇A!,xP⦈ & (∀ F . ⦃xP, F⦄ ≡ φ F)), G⦄ ≡ φ G) in v]"
    proof (rule CP)
      assume a: "[□(φ G) in v]"
      hence "[□(⦃(ιx . ⦇A!,xP⦈ & (∀ F . ⦃xP, F⦄ ≡ φ F)), G⦄ → φ G) in v]"
        using KBasic_1[deduction] by simp
      moreover {
        have "[⦃(ιx . ⦇A!,xP⦈ & (∀ F . ⦃xP, F⦄ ≡ φ F)), G⦄ in v]"
          using a Box_desc_encode_1[deduction] by auto
        hence "[□⦃(ιx . ⦇A!,xP⦈ & (∀ F . ⦃xP, F⦄ ≡ φ F)), G⦄ in v]"
          using encoding[axiom_instance,deduction] by blast
        hence "[□(φ G →  ⦃(ιx . ⦇A!,xP⦈ & (∀ F . ⦃xP, F⦄ ≡ φ F)), G⦄) in v]"
          using KBasic_1[deduction] by simp
      }
      ultimately show "[□(⦃(ιx . ⦇A!,xP⦈ & (∀ F . ⦃xP, F⦄ ≡ φ F)), G⦄
                        ≡ φ G) in v]"
        using "&I" KBasic_4[equiv_rl] by blast
    qed

  lemma box_phi_a_1[PLM]:
    assumes "[□(∀ F . φ F → □(φ F)) in v]"
    shows "[(⦇A!,xP⦈ & (∀ F . ⦃xP, F⦄ ≡ φ F)) → □(⦇A!,xP⦈
            & (∀ F . ⦃xP, F⦄ ≡ φ F)) in v]"
    proof (rule CP)
      assume a: "[(⦇A!,xP⦈ & (∀ F . ⦃xP, F⦄ ≡ φ F)) in v]"
      have "[□⦇A!,xP⦈ in v]"
        using oa_facts_2[deduction] a[conj1] by auto
      moreover have "[□(∀ F . ⦃xP, F⦄ ≡ φ F) in v]"
        proof (rule BF[deduction]; rule "∀I")
          fix F
          have θ: "[□(φ F → □(φ F)) in v]"
            using assms[THEN CBF[deduction]] by (rule "∀E")
          moreover have "[□(⦃xP, F⦄ → □⦃xP, F⦄) in v]"
            using encoding[axiom_necessitation, axiom_instance] by simp
          moreover have "[□⦃xP, F⦄ ≡ □(φ F) in v]"
            proof (rule "≡I"; rule CP)
              assume "[□⦃xP, F⦄ in v]"
              hence "[⦃xP, F⦄ in v]"
                using qml_2[axiom_instance, deduction] by blast
              hence "[φ F in v]"
                using a[conj2] "∀E"[where 'a=Π1] "≡E" by blast
              thus "[□(φ F) in v]"
                using θ[THEN qml_2[axiom_instance, deduction], deduction] by simp
            next
              assume "[□(φ F) in v]"
              hence "[φ F in v]"
                using qml_2[axiom_instance, deduction] by blast
              hence "[⦃xP, F⦄ in v]"
                using a[conj2] "∀E"[where 'a=Π1] "≡E" by blast
              thus "[□⦃xP, F⦄ in v]"
                using encoding[axiom_instance, deduction] by simp
            qed
          ultimately show "[□(⦃xP,F⦄ ≡ φ F) in v]"
            using sc_eq_box_box_3[deduction, deduction] "&I" by blast
        qed
      ultimately show "[□(⦇A!,xP⦈ & (∀F. ⦃xP,F⦄ ≡ φ F)) in v]"
       using "&I" KBasic_3[equiv_rl] by blast
    qed

  lemma box_phi_a_2[PLM]:
    assumes "[□(∀ F . φ F → □(φ F)) in v]"
    shows "[yP = (ιx . ⦇A!,xP⦈ & (∀ F. ⦃xP, F⦄ ≡ φ F))
            → (⦇A!,yP⦈ & (∀ F . ⦃yP, F⦄ ≡ φ F)) in v]"
    proof -
      let ?ψ = "λ x . ⦇A!,xP⦈ & (∀ F . ⦃xP, F⦄ ≡ φ F)"
      have "[∀ x . ?ψ x → □(?ψ x) in v]"
        using box_phi_a_1[OF assms] "∀I" by fast
      hence "[(∃! x . ?ψ x) → (∀ y . yP = (ιx . ?ψ x) → ?ψ y) in v]"
        using unique_box_desc[deduction] by fast
      hence "[(∀ y . yP = (ιx . ?ψ x) → ?ψ y) in v]"
        using A_objects_unique modus_ponens by blast
      thus ?thesis by (rule "∀E")
   qed

  lemma box_phi_a_3[PLM]:
    assumes "[□(∀ F . φ F → □(φ F)) in v]"
    shows "[⦃ιx . ⦇A!,xP⦈ & (∀ F . ⦃xP, F⦄ ≡ φ F), G⦄ ≡ φ G in v]"
    proof -
      obtain a where
        "[aP = (ιx . ⦇A!,xP⦈ & (∀ F . ⦃xP, F⦄ ≡ φ F)) in v]"
        using A_descriptions by (rule "∃E")
      moreover {
        hence "[(∀ F . ⦃aP, F⦄ ≡ φ F) in v]"
          using box_phi_a_2[OF assms, deduction, conj2] by blast
        hence "[⦃aP, G⦄ ≡ φ G in v]" by (rule "∀E")
      }
      ultimately show ?thesis
        using l_identity[axiom_instance, deduction, deduction] by fast
    qed

  lemma null_uni_uniq_1[PLM]:
    "[∃! x . Null (xP) in v]"
    proof -
      have "[∃ x . ⦇A!,xP⦈ & (∀ F . ⦃xP, F⦄ ≡ (F ≠ F)) in v]"
        using A_objects[axiom_instance] by simp
      then obtain a where a_prop:
        "[⦇A!,aP⦈ & (∀ F . ⦃aP, F⦄ ≡ (F ≠ F)) in v]"
        by (rule "∃E")
      have 1: "[⦇A!,aP⦈ & (¬(∃ F . ⦃aP, F⦄)) in v]"
        using a_prop[conj1] apply (rule "&I")
        proof -
          {
            assume "[∃ F . ⦃aP, F⦄ in v]"
            then obtain P where
              "[⦃aP, P⦄ in v]" by (rule "∃E")
            hence "[P ≠ P in v]"
              using a_prop[conj2, THEN "∀E", equiv_lr] by simp
            hence "[¬(∃ F . ⦃aP, F⦄) in v]"
              using id_eq_1 reductio_aa_1 by fast
          }
          thus "[¬(∃ F . ⦃aP, F⦄) in v]"
            using reductio_aa_1 by blast
        qed
      moreover have "[∀ y . (⦇A!,yP⦈ & (¬(∃ F . ⦃yP, F⦄))) → y = a in v]"
        proof (rule "∀I"; rule CP)
          fix y
          assume 2: "[⦇A!,yP⦈ & (¬(∃ F . ⦃yP, F⦄)) in v]"
          have "[∀ F . ⦃yP, F⦄ ≡ ⦃aP, F⦄ in v]"
            using cqt_further_12[deduction] 1[conj2] 2[conj2] "&I" by blast
          thus "[y = a in v]"
            using ab_obey_1[deduction, deduction]
            "&I"[OF 2[conj1] 1[conj1]] identity_ν_def by presburger
        qed
      ultimately show ?thesis
        using "&I" "∃I"
        unfolding Null_def exists_unique_def by fast
    qed

  lemma null_uni_uniq_2[PLM]:
    "[∃! x . Universal (xP) in v]"
    proof -
      have "[∃ x . ⦇A!,xP⦈ & (∀ F . ⦃xP, F⦄ ≡ (F = F)) in v]"
        using A_objects[axiom_instance] by simp
      then obtain a where a_prop:
        "[⦇A!,aP⦈ & (∀ F . ⦃aP, F⦄ ≡ (F = F)) in v]"
        by (rule "∃E")
      have 1: "[⦇A!,aP⦈ & (∀ F . ⦃aP, F⦄) in v]"
        using a_prop[conj1] apply (rule "&I")
        using "∀I" a_prop[conj2, THEN "∀E", equiv_rl] id_eq_1 by fast
      moreover have "[∀ y . (⦇A!,yP⦈ & (∀ F . ⦃yP, F⦄)) → y = a in v]"
        proof (rule "∀I"; rule CP)
          fix y
          assume 2: "[⦇A!,yP⦈ & (∀ F . ⦃yP, F⦄) in v]"
          have "[∀ F . ⦃yP, F⦄ ≡ ⦃aP, F⦄ in v]"
            using cqt_further_11[deduction] 1[conj2] 2[conj2] "&I" by blast
          thus "[y = a in v]"
            using ab_obey_1[deduction, deduction]
              "&I"[OF 2[conj1] 1[conj1]] identity_ν_def
            by presburger
        qed
      ultimately show ?thesis
        using "&I" "∃I"
        unfolding Universal_def exists_unique_def by fast
    qed

  lemma null_uni_uniq_3[PLM]:
    "[∃ y . yP = (ιx . Null (xP)) in v]"
    using null_uni_uniq_1[THEN RN, THEN nec_imp_act[deduction]]
          A_Exists_2[equiv_rl] by auto

  lemma null_uni_uniq_4[PLM]:
    "[∃ y . yP = (ιx . Universal (xP)) in v]"
    using null_uni_uniq_2[THEN RN, THEN nec_imp_act[deduction]]
          A_Exists_2[equiv_rl] by auto

  lemma null_uni_facts_1[PLM]:
    "[Null (xP) → □(Null (xP)) in v]"
    proof (rule CP)
      assume "[Null (xP) in v]"
      hence 1: "[⦇A!,xP⦈ & (¬(∃ F . ⦃xP,F⦄)) in v]"
        unfolding Null_def .
      have "[□⦇A!,xP⦈ in v]"
        using 1[conj1] oa_facts_2[deduction] by simp
      moreover have "[□(¬(∃ F . ⦃xP,F⦄)) in v]"
        proof -
          {
            assume "[¬□(¬(∃ F . ⦃xP,F⦄)) in v]"
            hence "[◇(∃ F . ⦃xP,F⦄) in v]"
              unfolding diamond_def .
            hence "[∃ F . ◇⦃xP,F⦄ in v]"
              using "BF◇"[deduction] by blast
            then obtain P where "[◇⦃xP,P⦄ in v]"
              by (rule "∃E")
            hence "[⦃xP, P⦄ in v]"
              using en_eq_3[equiv_lr] by simp
            hence "[∃  F . ⦃xP, F⦄ in v]"
              using "∃I" by fast
          }
          thus ?thesis
            using 1[conj2] modus_tollens_1 CP
                  useful_tautologies_1[deduction] by metis
        qed
      ultimately show "[□Null (xP) in v]"
        unfolding Null_def
        using "&I" KBasic_3[equiv_rl] by blast
    qed

  lemma null_uni_facts_2[PLM]:
    "[Universal (xP) → □(Universal (xP)) in v]"
    proof (rule CP)
      assume "[Universal (xP) in v]"
      hence 1: "[⦇A!,xP⦈ & (∀ F . ⦃xP,F⦄) in v]"
        unfolding Universal_def .
      have "[□⦇A!,xP⦈ in v]"
        using 1[conj1] oa_facts_2[deduction] by simp
      moreover have "[□(∀ F . ⦃xP,F⦄) in v]"
        proof (rule BF[deduction]; rule "∀I")
          fix F
          have "[⦃xP, F⦄ in v]"
            using 1[conj2] by (rule "∀E")
          thus "[□⦃xP, F⦄ in v]"
            using encoding[axiom_instance, deduction] by auto
        qed
      ultimately show "[□Universal (xP) in v]"
        unfolding Universal_def
        using "&I" KBasic_3[equiv_rl] by blast
    qed

  lemma null_uni_facts_3[PLM]:
    "[Null (a∅) in v]"
    proof -
      let ?ψ = "λ x . Null x"
      have "[((∃! x . ?ψ (xP)) → (∀ y . yP = (ιx . ?ψ (xP)) → ?ψ (yP))) in v]"
        using unique_box_desc[deduction] null_uni_facts_1[THEN "∀I"] by fast
      have 1: "[(∀ y . yP = (ιx . ?ψ (xP)) → ?ψ (yP)) in v]"
        using unique_box_desc[deduction, deduction] null_uni_uniq_1
              null_uni_facts_1[THEN "∀I"] by fast
      have "[∃ y . yP = (a∅) in v]"
        unfolding NullObject_def using null_uni_uniq_3 .
      then obtain y where "[yP = (a∅) in v]"
        by (rule "∃E")
      moreover hence "[?ψ (yP) in v]"
        using 1[THEN "∀E", deduction] unfolding NullObject_def by simp
      ultimately show "[?ψ (a∅) in v]"
        using l_identity[axiom_instance, deduction, deduction] by blast
    qed

  lemma null_uni_facts_4[PLM]:
    "[Universal (aV) in v]"
    proof -
      let ?ψ = "λ x . Universal x"
      have "[((∃! x . ?ψ (xP)) → (∀ y . yP = (ιx . ?ψ (xP)) → ?ψ (yP))) in v]"
        using unique_box_desc[deduction] null_uni_facts_2[THEN "∀I"] by fast
      have 1: "[(∀ y . yP = (ιx . ?ψ (xP)) → ?ψ (yP)) in v]"
        using unique_box_desc[deduction, deduction] null_uni_uniq_2
              null_uni_facts_2[THEN "∀I"] by fast
      have "[∃ y . yP = (aV) in v]"
        unfolding UniversalObject_def using null_uni_uniq_4 .
      then obtain y where "[yP = (aV) in v]"
        by (rule "∃E")
      moreover hence "[?ψ (yP) in v]"
        using 1[THEN "∀E", deduction]
        unfolding UniversalObject_def by simp
      ultimately show "[?ψ (aV) in v]"
        using l_identity[axiom_instance, deduction, deduction] by blast
    qed

  lemma aclassical_1[PLM]:
    "[∀ R . ∃ x y . ⦇A!,xP⦈ & ⦇A!,yP⦈ & (x ≠ y)
      & (λ z . ⦇R,zP,xP⦈) = (λ z . ⦇R,zP,yP⦈) in v]"
    proof (rule "∀I")
      fix R
      obtain a where θ:
        "[⦇A!,aP⦈ & (∀ F . ⦃aP, F⦄ ≡ (∃ y . ⦇A!,yP⦈
          & F = (λ z . ⦇R,zP,yP⦈) & ¬⦃yP, F⦄)) in v]"
        using A_objects[axiom_instance] by (rule "∃E")
      {
        assume "[¬⦃aP, (λ z . ⦇R,zP,aP⦈)⦄ in v]"
        hence "[¬(⦇A!,aP⦈ & (λ z . ⦇R,zP,aP⦈) = (λ z . ⦇R,zP,aP⦈)
                & ¬⦃aP, (λ z . ⦇R,zP,aP⦈)⦄) in v]"
          using θ[conj2, THEN "∀E", THEN oth_class_taut_5_d[equiv_lr], equiv_lr]
                cqt_further_4[equiv_lr] "∀E" by fast
        hence "[⦇A!,aP⦈ & (λ z . ⦇R,zP,aP⦈) = (λ z . ⦇R,zP,aP⦈)
                → ⦃aP, (λ z . ⦇R,zP,aP⦈)⦄ in v]"
          apply - by PLM_solver
        hence "[⦃aP, (λ z . ⦇R,zP,aP⦈)⦄ in v]"
          using θ[conj1] id_eq_1 "&I" vdash_properties_10 by fast
      }
      hence 1: "[⦃aP, (λ z . ⦇R,zP,aP⦈)⦄ in v]"
        using reductio_aa_1 CP if_p_then_p by blast
      then obtain b where ξ:
        "[⦇A!,bP⦈ & (λ z . ⦇R,zP,aP⦈) = (λ z . ⦇R,zP,bP⦈)
          & ¬⦃bP, (λ z . ⦇R,zP,aP⦈)⦄ in v]"
        using θ[conj2, THEN "∀E", equiv_lr] "∃E" by blast
      have "[a ≠ b in v]"
        proof -
          {
            assume "[a = b in v]"
            hence "[⦃bP, (λ z . ⦇R,zP,aP⦈)⦄ in v]"
              using 1 l_identity[axiom_instance, deduction, deduction] by fast
            hence ?thesis
              using ξ[conj2] reductio_aa_1 by blast
          }
          thus ?thesis using reductio_aa_1 by blast
        qed
      hence "[⦇A!,aP⦈ & ⦇A!,bP⦈ & a ≠ b
              & (λ z . ⦇R,zP,aP⦈) = (λ z . ⦇R,zP,bP⦈) in v]"
        using θ[conj1] ξ[conj1, conj1] ξ[conj1, conj2] "&I" by presburger
      hence "[∃ y . ⦇A!,aP⦈ & ⦇A!,yP⦈ & a ≠ y
              & (λz. ⦇R,zP,aP⦈) = (λz. ⦇R,zP,yP⦈) in v]"
        using "∃I" by fast
      thus "[∃ x y . ⦇A!,xP⦈ & ⦇A!,yP⦈ & x ≠ y
             & (λz. ⦇R,zP,xP⦈) = (λz. ⦇R,zP,yP⦈) in v]"
        using "∃I" by fast
    qed

  lemma aclassical_2[PLM]:
    "[∀ R . ∃ x y . ⦇A!,xP⦈ & ⦇A!,yP⦈ & (x ≠ y)
      & (λ z . ⦇R,xP,zP⦈) = (λ z . ⦇R,yP,zP⦈) in v]"
    proof (rule "∀I")
      fix R
      obtain a where θ:
        "[⦇A!,aP⦈ & (∀ F . ⦃aP, F⦄ ≡ (∃ y . ⦇A!,yP⦈
          & F = (λ z . ⦇R,yP,zP⦈) & ¬⦃yP, F⦄)) in v]"
        using A_objects[axiom_instance] by (rule "∃E")
      {
        assume "[¬⦃aP, (λ z . ⦇R,aP,zP⦈)⦄ in v]"
        hence "[¬(⦇A!,aP⦈ & (λ z . ⦇R,aP,zP⦈) = (λ z . ⦇R,aP,zP⦈)
                & ¬⦃aP, (λ z . ⦇R,aP,zP⦈)⦄) in v]"
          using θ[conj2, THEN "∀E", THEN oth_class_taut_5_d[equiv_lr], equiv_lr]
                cqt_further_4[equiv_lr] "∀E" by fast
        hence "[⦇A!,aP⦈ & (λ z . ⦇R,aP,zP⦈) = (λ z . ⦇R,aP,zP⦈)
                → ⦃aP, (λ z . ⦇R,aP,zP⦈)⦄ in v]"
          apply - by PLM_solver
        hence "[⦃aP, (λ z . ⦇R,aP,zP⦈)⦄ in v]"
          using θ[conj1] id_eq_1 "&I" vdash_properties_10 by fast
      }
      hence 1: "[⦃aP, (λ z . ⦇R,aP,zP⦈)⦄ in v]"
        using reductio_aa_1 CP if_p_then_p by blast
      then obtain b where ξ:
        "[⦇A!,bP⦈ & (λ z . ⦇R,aP,zP⦈) = (λ z . ⦇R,bP,zP⦈)
          & ¬⦃bP, (λ z . ⦇R,aP,zP⦈)⦄ in v]"
        using θ[conj2, THEN "∀E", equiv_lr] "∃E" by blast
      have "[a ≠ b in v]"
        proof -
          {
            assume "[a = b in v]"
            hence "[⦃bP, (λ z . ⦇R,aP,zP⦈)⦄ in v]"
              using 1 l_identity[axiom_instance, deduction, deduction] by fast
            hence ?thesis using ξ[conj2] reductio_aa_1 by blast
          }
          thus ?thesis using ξ[conj2] reductio_aa_1 by blast
        qed
      hence "[⦇A!,aP⦈ & ⦇A!,bP⦈ & a ≠ b
              & (λ z . ⦇R,aP,zP⦈) = (λ z . ⦇R,bP,zP⦈) in v]"
        using θ[conj1] ξ[conj1, conj1] ξ[conj1, conj2] "&I" by presburger
      hence "[∃ y . ⦇A!,aP⦈ & ⦇A!,yP⦈ & a ≠ y
              & (λz. ⦇R,aP,zP⦈) = (λz. ⦇R,yP,zP⦈) in v]"
        using "∃I" by fast
      thus "[∃ x y . ⦇A!,xP⦈ & ⦇A!,yP⦈ & x ≠ y
             & (λz. ⦇R,xP,zP⦈) = (λz. ⦇R,yP,zP⦈) in v]"
        using "∃I" by fast
    qed

  lemma aclassical_3[PLM]:
    "[∀ F . ∃ x y . ⦇A!,xP⦈ & ⦇A!,yP⦈ & (x ≠ y)
      & ((λ0 ⦇F,xP⦈) = (λ0 ⦇F,yP⦈)) in v]"
    proof (rule "∀I")
      fix R
      obtain a where θ:
        "[⦇A!,aP⦈ & (∀ F . ⦃aP, F⦄ ≡ (∃ y . ⦇A!,yP⦈
          & F = (λ z . ⦇R,yP⦈) & ¬⦃yP, F⦄)) in v]"
        using A_objects[axiom_instance] by (rule "∃E")
      {
        assume "[¬⦃aP, (λ z . ⦇R,aP⦈)⦄ in v]"
        hence "[¬(⦇A!,aP⦈ & (λ z . ⦇R,aP⦈) = (λ z . ⦇R,aP⦈)
                & ¬⦃aP, (λ z . ⦇R,aP⦈)⦄) in v]"
          using θ[conj2, THEN "∀E", THEN oth_class_taut_5_d[equiv_lr], equiv_lr]
                cqt_further_4[equiv_lr] "∀E" by fast
        hence "[⦇A!,aP⦈ & (λ z . ⦇R,aP⦈) = (λ z . ⦇R,aP⦈)
                → ⦃aP, (λ z . ⦇R,aP⦈)⦄ in v]"
          apply - by PLM_solver
        hence "[⦃aP, (λ z . ⦇R,aP⦈)⦄ in v]"
          using θ[conj1] id_eq_1 "&I" vdash_properties_10 by fast
      }
      hence 1: "[⦃aP, (λ z . ⦇R,aP⦈)⦄ in v]"
        using reductio_aa_1 CP if_p_then_p by blast
      then obtain b where ξ:
        "[⦇A!,bP⦈ & (λ z . ⦇R,aP⦈) = (λ z . ⦇R,bP⦈)
          & ¬⦃bP, (λ z . ⦇R,aP⦈)⦄ in v]"
        using θ[conj2, THEN "∀E", equiv_lr] "∃E" by blast
      have "[a ≠ b in v]"
        proof -
          {
            assume "[a = b in v]"
            hence "[⦃bP, (λ z . ⦇R,aP⦈)⦄ in v]"
              using 1 l_identity[axiom_instance, deduction, deduction] by fast
            hence ?thesis
              using ξ[conj2] reductio_aa_1 by blast
          }
          thus ?thesis using reductio_aa_1 by blast
        qed
      moreover {
        have "[⦇R,aP⦈ = ⦇R,bP⦈ in v]"
          unfolding identity𝗈_def
          using ξ[conj1, conj2] by auto
        hence "[(λ0 ⦇R,aP⦈) = (λ0 ⦇R,bP⦈) in v]"
          using lambda_p_q_p_eq_q[equiv_rl] by simp
      }
      ultimately have "[⦇A!,aP⦈ & ⦇A!,bP⦈ & a ≠ b
                & ((λ0 ⦇R,aP⦈) =(λ0 ⦇R,bP⦈)) in v]"
        using θ[conj1] ξ[conj1, conj1] ξ[conj1, conj2] "&I"
        by presburger
      hence "[∃ y . ⦇A!,aP⦈ & ⦇A!,yP⦈ & a ≠ y
              & (λ0 ⦇R,aP⦈) = (λ0 ⦇R,yP⦈) in v]"
        using "∃I" by fast
      thus "[∃ x y . ⦇A!,xP⦈ & ⦇A!,yP⦈ & x ≠ y
             & (λ0 ⦇R,xP⦈) = (λ0 ⦇R,yP⦈) in v]"
        using "∃I" by fast
    qed

  lemma aclassical2[PLM]:
    "[∃ x y . ⦇A!,xP⦈ & ⦇A!,yP⦈ & x ≠ y & (∀ F . ⦇F,xP⦈ ≡ ⦇F,yP⦈) in v]"
    proof -
      let ?R1 = "λ2 (λ x y . ∀ F . ⦇F,xP⦈ ≡ ⦇F,yP⦈)"
      have "[∃ x y . ⦇A!,xP⦈ & ⦇A!,yP⦈ & x ≠ y
             & (λz. ⦇?R1,zP,xP⦈) = (λz. ⦇?R1,zP,yP⦈) in v]"
        using aclassical_1 by (rule "∀E")
      then obtain a where
        "[∃ y . ⦇A!,aP⦈ & ⦇A!,yP⦈ & a ≠ y
          & (λz. ⦇?R1,zP,aP⦈) = (λz. ⦇?R1,zP,yP⦈) in v]"
        by (rule "∃E")
      then obtain b where ab_prop:
        "[⦇A!,aP⦈ & ⦇A!,bP⦈ & a ≠ b
          & (λz. ⦇?R1,zP,aP⦈) = (λz. ⦇?R1,zP,bP⦈) in v]"
        by (rule "∃E")
      have "[⦇?R1, aP, aP⦈ in v]"
        apply (rule beta_C_meta_2[equiv_rl])
         apply show_proper
        using oth_class_taut_4_a[THEN "∀I"] by fast
      hence "[⦇λ z . ⦇?R1, zP, aP⦈, aP⦈ in v]"
        apply - apply (rule beta_C_meta_1[equiv_rl])
         apply show_proper
        by auto
      hence "[⦇λ z . ⦇?R1, zP, bP⦈, aP⦈ in v]"
        using ab_prop[conj2] l_identity[axiom_instance, deduction, deduction]
        by fast
      hence "[⦇?R1, aP, bP⦈ in v]"
        apply (safe intro!: beta_C_meta_1[where φ=
               "λz . ⦇λ2 (λx y. ∀F. ⦇F,xP⦈ ≡ ⦇F,yP⦈),z,bP⦈", equiv_lr])
        by show_proper
      moreover have "IsProperInXY (λx y. ∀F. ⦇F,x⦈ ≡ ⦇F,y⦈)"
        by show_proper
      ultimately have "[∀F. ⦇F,aP⦈ ≡ ⦇F,bP⦈ in v]"
        using beta_C_meta_2[equiv_lr] by blast
      hence "[⦇A!,aP⦈ & ⦇A!,bP⦈ & a ≠ b & (∀F. ⦇F,aP⦈ ≡ ⦇F,bP⦈) in v]"
        using ab_prop[conj1] "&I" by presburger
      hence "[∃ y . ⦇A!,aP⦈ & ⦇A!,yP⦈ & a ≠ y & (∀F. ⦇F,aP⦈ ≡ ⦇F,yP⦈) in v]"
        using "∃I" by fast
      thus ?thesis using "∃I" by fast
    qed

subsection‹Propositional Properties›
text‹\label{TAO_PLM_PropositionalProperties}›

  lemma prop_prop2_1:
    "[∀ p . ∃ F . F = (λ x . p) in v]"
    proof (rule "∀I")
      fix p
      have "[(λ x . p) = (λ x . p) in v]"
        using id_eq_prop_prop_1 by auto
      thus "[∃  F . F = (λ x . p) in v]"
        by PLM_solver
    qed

  lemma prop_prop2_2:
    "[F = (λ x . p) → □(∀ x . ⦇F,xP⦈ ≡ p) in v]"
    proof (rule CP)
      assume 1: "[F = (λ x . p) in v]"
      {
        fix v
        {
          fix x
          have "[⦇(λ x . p), xP⦈ ≡ p in v]"
            apply (rule beta_C_meta_1)
            by show_proper
        }
        hence "[∀ x . ⦇(λ x . p), xP⦈ ≡ p in v]"
          by (rule "∀I")
      }
      hence "[□(∀ x . ⦇(λ x . p), xP⦈ ≡ p) in v]"
        by (rule RN)
      thus "[□(∀x. ⦇F,xP⦈ ≡ p) in v]"
        using l_identity[axiom_instance,deduction,deduction,
              OF 1[THEN id_eq_prop_prop_2[deduction]]] by fast
    qed

  lemma prop_prop2_3:
    "[Propositional F → □(Propositional F) in v]"
    proof (rule CP)
      assume "[Propositional F in v]"
      hence "[∃ p . F = (λ x . p) in v]"
        unfolding Propositional_def .
      then obtain q where "[F = (λ x . q) in v]"
        by (rule "∃E")
      hence "[□(F = (λ x . q)) in v]"
        using id_nec[equiv_lr] by auto
      hence "[∃ p . □(F = (λ x . p)) in v]"
        using "∃I" by fast
      thus "[□(Propositional F) in v]"
        unfolding Propositional_def
        using sign_S5_thm_1[deduction] by fast
    qed


  lemma prop_indis:
    "[Indiscriminate F → (¬(∃ x y . ⦇F,xP⦈ & (¬⦇F,yP⦈))) in v]"
    proof (rule CP)
      assume "[Indiscriminate F in v]"
      hence 1: "[□((∃x. ⦇F,xP⦈) → (∀x. ⦇F,xP⦈)) in v]"
        unfolding Indiscriminate_def .
      {
        assume "[∃ x y . ⦇F,xP⦈ & ¬⦇F,yP⦈ in v]"
        then obtain x where "[∃ y . ⦇F,xP⦈ & ¬⦇F,yP⦈ in v]"
          by (rule "∃E")
        then obtain y where 2: "[⦇F,xP⦈ & ¬⦇F,yP⦈ in v]"
          by (rule "∃E")
        hence "[∃ x . ⦇F, xP⦈ in v]"
          using "&E"(1) "∃I" by fast
        hence "[∀ x . ⦇F,xP⦈ in v]"
          using 1[THEN qml_2[axiom_instance, deduction], deduction] by fast
        hence "[⦇F,yP⦈ in v]"
          using cqt_orig_1[deduction] by fast
        hence "[⦇F,yP⦈ & (¬⦇F,yP⦈) in v]"
          using 2 "&I" "&E" by fast
        hence "[¬(∃ x y . ⦇F,xP⦈ & ¬⦇F,yP⦈) in v]"
          using pl_1[axiom_instance, deduction, THEN modus_tollens_1]
                oth_class_taut_1_a by blast
      }
      thus "[¬(∃ x y . ⦇F,xP⦈ & ¬⦇F,yP⦈) in v]"
        using reductio_aa_2 if_p_then_p deduction_theorem by blast
    qed


  lemma prop_in_thm:
    "[Propositional F → Indiscriminate F in v]"
    proof (rule CP)
      assume "[Propositional F in v]"
      hence "[□(Propositional F) in v]"
        using prop_prop2_3[deduction] by auto
      moreover {
        fix w
        assume "[∃ p . (F = (λ y . p)) in w]"
        then obtain q where q_prop: "[F = (λ y . q) in w]"
          by (rule "∃E")
        {
          assume "[∃ x . ⦇F,xP⦈ in w]"
          then obtain a where "[⦇F,aP⦈ in w]"
            by (rule "∃E")
          hence "[⦇λ y . q, aP⦈ in w]"
            using q_prop l_identity[axiom_instance,deduction,deduction] by fast
          hence q: "[q in w]"
            apply (safe intro!: beta_C_meta_1[where φ="λy. q", equiv_lr])
             apply show_proper
            by simp
          {
            fix x
            have "[⦇λ y . q, xP⦈ in w]"
              apply (safe intro!: q beta_C_meta_1[equiv_rl])
              by show_proper
            hence "[⦇F,xP⦈ in w]"
              using q_prop[eq_sym] l_identity[axiom_instance, deduction, deduction]
              by fast
          }
          hence "[∀ x . ⦇F,xP⦈ in w]"
            by (rule "∀I")
        }
        hence "[(∃ x . ⦇F,xP⦈) → (∀ x . ⦇F, xP⦈) in w]"
          by (rule CP)
      }
      ultimately show "[Indiscriminate F in v]"
        unfolding Propositional_def Indiscriminate_def
        using RM_1[deduction] deduction_theorem by blast
    qed

  lemma prop_in_f_1:
    "[Necessary F → Indiscriminate F in v]"
    unfolding Necessary_defs Indiscriminate_def
    using pl_1[axiom_instance, THEN RM_1] by simp

  lemma prop_in_f_2:
    "[Impossible F → Indiscriminate F in v]"
    proof -
      {
        fix w
        have "[(¬(∃ x . ⦇F,xP⦈)) → ((∃ x . ⦇F,xP⦈) → (∀ x . ⦇F,xP⦈)) in w]"
          using useful_tautologies_3 by auto
        hence "[(∀ x . ¬⦇F,xP⦈) → ((∃ x . ⦇F,xP⦈) → (∀ x . ⦇F,xP⦈)) in w]"
          apply - apply (PLM_subst_method "¬(∃ x. ⦇F,xP⦈)" "(∀ x. ¬⦇F,xP⦈)")
          using cqt_further_4 unfolding exists_def by fast+
      }
      thus ?thesis
        unfolding Impossible_defs Indiscriminate_def using RM_1 CP by blast
    qed

  lemma prop_in_f_3_a:
    "[¬(Indiscriminate (E!)) in v]"
    proof (rule reductio_aa_2)
      show "[□¬(∀x. ⦇E!,xP⦈) in v]"
        using a_objects_exist_3 .
    next
      assume "[Indiscriminate E! in v]"
      thus "[¬□¬(∀ x . ⦇E!,xP⦈) in v]"
        unfolding Indiscriminate_def
        using o_objects_exist_1 KBasic2_5[deduction,deduction]
        unfolding diamond_def by blast
    qed

  lemma prop_in_f_3_b:
    "[¬(Indiscriminate (E!-)) in v]"
    proof (rule reductio_aa_2)
      assume "[Indiscriminate (E!-) in v]"
      moreover have "[□(∃ x . ⦇E!-, xP⦈) in v]"
        apply (PLM_subst_method "λ x . ¬⦇E!, xP⦈" "λ x . ⦇E!-, xP⦈")
         using thm_relation_negation_1_1[equiv_sym] apply simp
        unfolding exists_def
        apply (PLM_subst_method "λ x . ⦇E!, xP⦈" "λ x . ¬¬⦇E!, xP⦈")
         using oth_class_taut_4_b apply simp
        using a_objects_exist_3 by auto
      ultimately have "[□(∀x. ⦇E!-,xP⦈) in v]"
        unfolding Indiscriminate_def
        using qml_1[axiom_instance, deduction, deduction] by blast
      thus "[□(∀x. ¬⦇E!,xP⦈) in v]"
        apply -
        apply (PLM_subst_method "λ x . ⦇E!-, xP⦈" "λ x . ¬⦇E!, xP⦈")
        using thm_relation_negation_1_1 by auto
    next
      show "[¬□(∀ x . ¬⦇E!, xP⦈) in v]"
        using o_objects_exist_1
        unfolding diamond_def exists_def
        apply -
        apply (PLM_subst_method "¬¬(∀x. ¬⦇E!,xP⦈)" "∀x. ¬⦇E!,xP⦈")
        using oth_class_taut_4_b[equiv_sym] by auto
    qed

  lemma prop_in_f_3_c:
    "[¬(Indiscriminate (O!)) in v]"
    proof (rule reductio_aa_2)
      show "[¬(∀ x . ⦇O!,xP⦈) in v]"
        using a_objects_exist_2[THEN qml_2[axiom_instance, deduction]]
              by blast
    next
      assume "[Indiscriminate O! in v]"
      thus "[(∀ x . ⦇O!,xP⦈) in v]"
        unfolding Indiscriminate_def
        using o_objects_exist_2 qml_1[axiom_instance, deduction, deduction]
              qml_2[axiom_instance, deduction] by blast
    qed

  lemma prop_in_f_3_d:
    "[¬(Indiscriminate (A!)) in v]"
    proof (rule reductio_aa_2)
      show "[¬(∀ x . ⦇A!,xP⦈) in v]"
        using o_objects_exist_3[THEN qml_2[axiom_instance, deduction]]
              by blast
    next
      assume "[Indiscriminate A! in v]"
      thus "[(∀ x . ⦇A!,xP⦈) in v]"
        unfolding Indiscriminate_def
        using a_objects_exist_1 qml_1[axiom_instance, deduction, deduction]
              qml_2[axiom_instance, deduction] by blast
    qed

  lemma prop_in_f_4_a:
    "[¬(Propositional E!) in v]"
    using prop_in_thm[deduction] prop_in_f_3_a modus_tollens_1 CP
    by meson

  lemma prop_in_f_4_b:
    "[¬(Propositional (E!-)) in v]"
    using prop_in_thm[deduction] prop_in_f_3_b modus_tollens_1 CP
    by meson

  lemma prop_in_f_4_c:
    "[¬(Propositional (O!)) in v]"
    using prop_in_thm[deduction] prop_in_f_3_c modus_tollens_1 CP
    by meson

  lemma prop_in_f_4_d:
    "[¬(Propositional (A!)) in v]"
    using prop_in_thm[deduction] prop_in_f_3_d modus_tollens_1 CP
    by meson

  lemma prop_prop_nec_1:
    "[◇(∃ p . F = (λ x . p)) → (∃ p . F = (λ x . p)) in v]"
    proof (rule CP)
      assume "[◇(∃ p . F = (λ x . p)) in v]"
      hence "[∃ p . ◇(F = (λ x . p)) in v]"
        using "BF◇"[deduction] by auto
      then obtain p where "[◇(F = (λ x . p)) in v]"
        by (rule "∃E")
      hence "[◇□(∀x. ⦃xP,F⦄ ≡ ⦃xP,λx. p⦄) in v]"
        unfolding identity_defs .
      hence "[□(∀x. ⦃xP,F⦄ ≡ ⦃xP,λx. p⦄) in v]"
        using "5◇"[deduction] by auto
      hence "[(F = (λ x . p)) in v]"
        unfolding identity_defs .
      thus "[∃ p . (F = (λ x . p)) in v]"
        by PLM_solver
    qed

  lemma prop_prop_nec_2:
    "[(∀ p . F ≠ (λ x . p)) → □(∀ p . F ≠ (λ x . p)) in v]"
    apply (PLM_subst_method
           "¬(∃  p . (F = (λ x . p)))"
           "(∀ p . ¬(F = (λ x . p)))")
     using cqt_further_4 apply blast
    apply (PLM_subst_method
           "¬◇(∃p. F = (λx. p))"
           "□¬(∃p. F = (λx. p))")
     using KBasic2_4[equiv_sym] prop_prop_nec_1
           contraposition_1 by auto

  lemma prop_prop_nec_3:
    "[(∃ p . F = (λ x . p)) → □(∃ p . F = (λ x . p)) in v]"
    using prop_prop_nec_1 derived_S5_rules_1_b by simp

  lemma prop_prop_nec_4:
    "[◇(∀ p . F ≠ (λ x . p)) → (∀ p . F ≠ (λ x . p)) in v]"
    using prop_prop_nec_2 derived_S5_rules_2_b by simp

  lemma enc_prop_nec_1:
    "[◇(∀ F . ⦃xP, F⦄ → (∃ p . F = (λ x . p)))
      → (∀ F . ⦃xP, F⦄ → (∃ p . F = (λ x . p))) in v]"
    proof (rule CP)
      assume "[◇(∀F. ⦃xP,F⦄ → (∃p. F = (λx. p))) in v]"
      hence 1: "[(∀F. ◇(⦃xP,F⦄ → (∃p. F = (λx. p)))) in v]"
        using "Buridan◇"[deduction] by auto
      {
        fix Q
        assume "[⦃xP,Q⦄ in v]"
        hence "[□⦃xP,Q⦄ in v]"
          using encoding[axiom_instance, deduction] by auto
        moreover have "[◇(⦃xP,Q⦄ → (∃p. Q = (λx. p))) in v]"
          using cqt_1[axiom_instance, deduction] 1 by fast
        ultimately have "[◇(∃p. Q = (λx. p)) in v]"
          using KBasic2_9[equiv_lr,deduction] by auto
        hence "[(∃p. Q = (λx. p)) in v]"
          using prop_prop_nec_1[deduction] by auto
      }
      thus "[(∀ F . ⦃xP, F⦄ → (∃ p . F = (λ x . p))) in v]"
        apply - by PLM_solver
    qed

  lemma enc_prop_nec_2:
    "[(∀ F . ⦃xP, F⦄ → (∃ p . F = (λ x . p))) → □(∀ F . ⦃xP, F⦄
      → (∃ p . F = (λ x . p))) in v]"
    using derived_S5_rules_1_b enc_prop_nec_1 by blast
end
end