(*
    This file is a part of MMIsar - a translation of Metamath's set.mm to Isabelle 2005 (ZF logic).

    Copyright (C) 2006  Slawomir Kolodynski

    This program is free software; Redistribution and use in source and binary forms,
    with or without modification, are permitted provided that the following conditions are met:

   1. Redistributions of source code must retain the above copyright notice,
   this list of conditions and the following disclaimer.
   2. Redistributions in binary form must reproduce the above copyright notice,
   this list of conditions and the following disclaimer in the documentation and/or
   other materials provided with the distribution.
   3. The name of the author may not be used to endorse or promote products
   derived from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES,
INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT,
INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

*)

section \<open>More on logic and sets in Metamatah\<close>

theory MMI_logic_and_sets_1 imports MMI_logic_and_sets

begin

subsection\<open>Basic Metamath theorems, continued\<close>

text\<open>This section continues \<open>MMI_logic_and_sets\<close>.
  It exists only so that we  don't have all Metamath basic
  theorems in one huge file.\<close>

(**  dependencies of nnind and peano2nn *************)

lemma MMI_pm3_27d: assumes A1: "\<phi> \<longrightarrow> \<psi> \<and> ch"
   shows "\<phi> \<longrightarrow> ch"
   using assms by auto

(*lemma MMI_elrab: original
  assumes A1: "x = A \<longrightarrow>  \<phi> \<longleftrightarrow> \<psi>"
   shows "A \<in> {x \<in> B. \<phi> } \<longleftrightarrow> A \<in> B \<and> \<psi>"
   using assms by auto*)

lemma MMI_elrab:
  assumes A1: "\<forall>x. x = A \<longrightarrow>  \<phi>(x) \<longleftrightarrow> \<psi>(x)"
  shows "A \<in> {x \<in> B. \<phi>(x) } \<longleftrightarrow> A \<in> B \<and> \<psi>(A)"
  using assms by auto

lemma MMI_ssrab2:
   shows "{x \<in> A. \<phi>(x) } \<subseteq> A"
  by auto

lemma MMI_anim12d: assumes A1: "\<phi> \<longrightarrow> \<psi> \<longrightarrow> ch" and
    A2: "\<phi> \<longrightarrow>  \<theta> \<longrightarrow> \<tau>"
   shows "\<phi> \<longrightarrow> \<psi> \<and> \<theta> \<longrightarrow> ch \<and> \<tau>"
   using assms by auto

lemma MMI_mpcom: assumes A1: "\<psi> \<longrightarrow> \<phi>" and
    A2: "\<phi> \<longrightarrow> \<psi> \<longrightarrow> ch"
   shows "\<psi> \<longrightarrow> ch"
   using assms by auto

lemma MMI_rabex: assumes A1: "A = A"
   shows "{x \<in> A. \<phi>(x) } = {x \<in> A. \<phi>(x) }"
   using assms by auto

lemma MMI_rcla4cv: assumes A1: "\<forall>x. x = A \<longrightarrow> \<phi>(x) \<longleftrightarrow> \<psi>(x)"
   shows "(\<forall>x\<in>B. \<phi>(x)) \<longrightarrow>  A \<in> B \<longrightarrow> \<psi>(A)"
  using assms by auto

lemma MMI_a2i: assumes A1: "\<phi> \<longrightarrow> \<psi> \<longrightarrow> ch"
   shows "(\<phi> \<longrightarrow> \<psi>) \<longrightarrow> \<phi> \<longrightarrow> ch"
   using assms by auto

lemma MMI_19_20i: assumes A1: "\<forall>x. \<phi>(x) \<longrightarrow> \<psi>(x)"
   shows "(\<forall>x. \<phi>(x)) \<longrightarrow> (\<forall>x. \<psi>(x))"
   using assms by auto

(*lemma MMI_elintab: assumes A1: "A = A"
   shows "A \<in> \<Inter> {x\<in> Pow(\<real>). \<phi> } \<longleftrightarrow>
   (\<forall>x. \<phi> \<longrightarrow> A \<in> x)"
   using assms by auto; original *)
(* the Additional assumption is required bc. in Isabelle
  intersection of empty set is (pretty much) undefined *)

lemma MMI_elintab: assumes A1: "A = A"
  and Additional: "{x\<in>B. \<phi>(x) } \<noteq> 0"
   shows "A \<in> \<Inter> {x\<in>B. \<phi>(x) } \<longleftrightarrow> (\<forall>x\<in>B. \<phi>(x) \<longrightarrow> A \<in> x)"
   using assms by auto

(********* nn1suc **********)

(*lemma MMI_dfsbcq:
   shows "A = B \<longrightarrow>
   [ A / x ] \<phi> \<longleftrightarrow> [ B / x ] \<phi>"
  by auto

lemma MMI_sbequ:
   shows "x = y \<longrightarrow>
   [ x / z ] \<phi> \<longleftrightarrow> [ y / z ] \<phi>"
  by auto*)

lemma MMI_elex:
   shows "A \<in> B \<longrightarrow> ( \<exists>x. x = A)"
  by auto

(*lemma MMI_hbsbc1: assumes A1: "y \<in> A \<longrightarrow> (\<forall>x. y \<in> A)"
   shows "(A \<in> B \<longrightarrow> [ A / x ] \<phi>) \<longrightarrow>
   (\<forall>x. A \<in> B \<longrightarrow> [ A / x ] \<phi>)"
   using assms by auto*)

(*lemma MMI_hbbi: assumes A1: "\<phi> \<longrightarrow> (\<forall>x. \<phi>)" and
    A2: "\<psi> \<longrightarrow> (\<forall>x. \<psi>)"
   shows "\<phi> \<longleftrightarrow> \<psi> \<longrightarrow>  (\<forall>x. \<phi> \<longleftrightarrow> \<psi>)"
   using assms by auto;

lemma MMI_sbceq1a:
   shows "x = A \<longrightarrow>
   \<phi> \<longleftrightarrow> [ A / x ] \<phi>"
  by auto

lemma MMI_19_23ai: assumes A1: "\<psi> \<longrightarrow> (\<forall>x. \<psi>)" and
    A2: "\<phi> \<longrightarrow> \<psi>"
   shows "( \<exists>x. \<phi>) \<longrightarrow> \<psi>"
   using assms by auto*)

lemma MMI_pm5_74rd: assumes A1: "\<phi> \<longrightarrow>
   (\<psi> \<longrightarrow> ch) \<longleftrightarrow>
   (\<psi> \<longrightarrow> \<theta>)"
   shows "\<phi> \<longrightarrow>
   \<psi> \<longrightarrow>
   ch \<longleftrightarrow> \<theta>"
   using assms by auto

lemma MMI_pm5_74d: assumes A1: "\<phi> \<longrightarrow>
   \<psi> \<longrightarrow>
   ch \<longleftrightarrow> \<theta>"
   shows "\<phi> \<longrightarrow>
   (\<psi> \<longrightarrow> ch) \<longleftrightarrow>
   (\<psi> \<longrightarrow> \<theta>)"
   using assms by auto

(*lemma MMI_sb19_21: assumes A1: "\<phi> \<longrightarrow> (\<forall>x. \<phi>)"
   shows "[ y / x ] (\<phi> \<longrightarrow> \<psi>) \<longleftrightarrow>
   (\<phi> \<longrightarrow> [ y / x ] \<psi>)"
   using assms by auto*)

lemma MMI_isseti: assumes A1: "A = A"
   shows " \<exists>x. x = A"
   using assms by auto

(*lemma MMI_hbsbc1v: assumes A1: "A = A"
   shows "[ A / x ] \<phi> \<longrightarrow> (\<forall>x. [ A / x ] \<phi>)"
   using assms by auto

lemma MMI_sbc19_21g: assumes A1: "\<phi> \<longrightarrow> (\<forall>x. \<phi>)"
   shows "A \<in> B \<longrightarrow>
   [ A / x ] (\<phi> \<longrightarrow> \<psi>) \<longleftrightarrow>
   (\<phi> \<longrightarrow> [ A / x ] \<psi>)"
   using assms by auto*)

(******* nnaddclt ***********)

lemma MMI_a2d: assumes A1: "\<phi> \<longrightarrow>
   \<psi> \<longrightarrow> ch \<longrightarrow> \<theta>"
   shows "\<phi> \<longrightarrow>
   (\<psi> \<longrightarrow> ch) \<longrightarrow>
   \<psi> \<longrightarrow> \<theta>"
   using assms by auto

(*** nnmulclt ***)

lemma MMI_exp4b: assumes A1: "\<phi> \<and> \<psi> \<longrightarrow>
   ch \<and> \<theta> \<longrightarrow> \<tau>"
   shows "\<phi> \<longrightarrow>
   \<psi> \<longrightarrow>
   ch \<longrightarrow>
   \<theta> \<longrightarrow> \<tau>"
   using assms by auto

lemma MMI_pm2_43b: assumes A1: "\<psi> \<longrightarrow>
   \<phi> \<longrightarrow> \<psi> \<longrightarrow> ch"
   shows "\<phi> \<longrightarrow> \<psi> \<longrightarrow> ch"
   using assms by auto

(********* nn2get nnge1t nngt1ne1t *********)
lemma MMI_biantrud: assumes A1: "\<phi> \<longrightarrow> \<psi>"
   shows "\<phi> \<longrightarrow>
   ch \<longleftrightarrow> ch \<and> \<psi>"
   using assms by auto

lemma MMI_anc2li: assumes A1: "\<phi> \<longrightarrow> \<psi> \<longrightarrow> ch"
   shows "\<phi> \<longrightarrow>
   \<psi> \<longrightarrow> \<phi> \<and> ch"
   using assms by auto

lemma MMI_biantrurd: assumes A1: "\<phi> \<longrightarrow> \<psi>"
   shows "\<phi> \<longrightarrow>
   ch \<longleftrightarrow> \<psi> \<and> ch"
   using assms by auto

(*****nnle1eq1t-lt1nnn***********)
lemma MMI_sylc: assumes A1: "\<phi> \<longrightarrow> \<psi> \<longrightarrow> ch" and
    A2: "\<theta> \<longrightarrow> \<phi>" and
    A3: "\<theta> \<longrightarrow> \<psi>"
   shows "\<theta> \<longrightarrow> ch"
   using assms by auto

lemma MMI_con3i: assumes Aa: "\<phi> \<longrightarrow> \<psi>"
   shows "\<not>\<psi> \<longrightarrow> \<not>\<phi>"
   using assms by auto

(*********** nnleltp1t - nnaddm1clt ***********)
lemma MMI_mpan2i: assumes A1: "ch" and
    A2: "\<phi> \<longrightarrow>
   \<psi> \<and> ch \<longrightarrow> \<theta>"
   shows "\<phi> \<longrightarrow>
   \<psi> \<longrightarrow> \<theta>"
   using assms by auto

lemma MMI_ralbidv: assumes A1: "\<forall>x. \<phi> \<longrightarrow>  \<psi>(x) \<longleftrightarrow> ch(x)"
   shows "\<phi> \<longrightarrow> (\<forall>x\<in>A. \<psi>(x)) \<longleftrightarrow> (\<forall>x\<in>A. ch(x))"
   using assms by auto

lemma MMI_mp3an23: assumes A1: "\<psi>" and
    A2: "ch" and
    A3: "\<phi> \<and> \<psi> \<and> ch \<longrightarrow> \<theta>"
   shows "\<phi> \<longrightarrow> \<theta>"
   using assms by auto

lemma (in MMIsar0) MMI_syl5eqbrr: assumes A1: "\<phi> \<longrightarrow> A \<ls> B" and
    A2: "A = C"
   shows "\<phi> \<longrightarrow> C \<ls> B"
   using assms by auto

lemma MMI_rcla4va: assumes A1: "\<forall>x. x = A \<longrightarrow> \<phi>(x) \<longleftrightarrow> \<psi>(A)"
   shows "A \<in> B \<and> (\<forall>x\<in>B. \<phi>(x)) \<longrightarrow> \<psi>(A)"
   using assms by auto

lemma MMI_3anrot:
   shows "\<phi> \<and> \<psi> \<and> ch \<longleftrightarrow> \<psi> \<and> ch \<and> \<phi>"
  by auto

lemma MMI_3simpc:
   shows "\<phi> \<and> \<psi> \<and> ch \<longrightarrow> \<psi> \<and> ch"
  by auto

lemma MMI_anandir:
   shows "(\<phi> \<and> \<psi>) \<and> ch \<longleftrightarrow>
   (\<phi> \<and> ch) \<and> \<psi> \<and> ch"
  by auto

lemma MMI_eqeqan12d: assumes A1: "\<phi> \<longrightarrow> A = B" and
    A2: "\<psi> \<longrightarrow> C = D"
   shows "\<phi> \<and> \<psi> \<longrightarrow>
   A = C \<longleftrightarrow> B = D"
   using assms by auto

lemma MMI_3imtr3d: assumes A1: "\<phi> \<longrightarrow> \<psi> \<longrightarrow> ch" and
    A2: "\<phi> \<longrightarrow>
   \<psi> \<longleftrightarrow> \<theta>" and
    A3: "\<phi> \<longrightarrow>
   ch \<longleftrightarrow> \<tau>"
   shows "\<phi> \<longrightarrow>
   \<theta> \<longrightarrow> \<tau>"
   using assms by auto

lemma MMI_exp31: assumes A1: "(\<phi> \<and> \<psi>) \<and> ch \<longrightarrow> \<theta>"
   shows "\<phi> \<longrightarrow>
   \<psi> \<longrightarrow> ch \<longrightarrow> \<theta>"
   using assms by auto

lemma MMI_com3l: assumes A1: "\<phi> \<longrightarrow>
   \<psi> \<longrightarrow> ch \<longrightarrow> \<theta>"
   shows "\<psi> \<longrightarrow>
   ch \<longrightarrow>
   \<phi> \<longrightarrow> \<theta>"
   using assms by auto

(** original
lemma MMI_r19_21adv: assumes A1: "\<phi> \<longrightarrow>
   \<psi> \<longrightarrow> x \<in> A \<longrightarrow> ch"
   shows "\<phi> \<longrightarrow>
   \<psi> \<longrightarrow> (\<forall>x\<in>A. ch)"
   using assms by auto *)
lemma MMI_r19_21adv: assumes A1: "\<phi> \<longrightarrow>
   \<psi> \<longrightarrow> (\<forall>x. x \<in> A \<longrightarrow> ch)"
   shows "\<phi> \<longrightarrow> \<psi> \<longrightarrow> (\<forall>x\<in>A. ch)"
   using assms by auto

lemma MMI_cbvralv: assumes A1: "\<forall>x y. x = y \<longrightarrow>  \<phi>(x) \<longleftrightarrow> \<psi>(y)"
   shows "(\<forall>x\<in>A. \<phi>(x)) \<longleftrightarrow> (\<forall>y\<in>A. \<psi>(y))"
   using assms by auto

lemma MMI_syl5ib: assumes A1: "\<phi> \<longrightarrow> \<psi> \<longrightarrow> ch" and
    A2: "\<theta> \<longleftrightarrow> \<psi>"
   shows "\<phi> \<longrightarrow> \<theta> \<longrightarrow> ch"
   using assms by auto

lemma MMI_pm2_21i: assumes A1: "\<not>\<phi>"
   shows "\<phi> \<longrightarrow> \<psi>"
   using assms by auto

lemma MMI_imim2d: assumes A1: "\<phi> \<longrightarrow> \<psi> \<longrightarrow> ch"
   shows "\<phi> \<longrightarrow>
   (\<theta> \<longrightarrow> \<psi>) \<longrightarrow> \<theta> \<longrightarrow> ch"
   using assms by auto

lemma MMI_syl6eqelr: assumes A1: "\<phi> \<longrightarrow> B = A" and
    A2: "B \<in> C"
   shows "\<phi> \<longrightarrow> A \<in> C"
   using assms by auto

(********** nndivt,nndivtrt ****************)

lemma MMI_r19_23adv:
  assumes A1: "\<forall>x. \<phi> \<longrightarrow>  x \<in> A \<longrightarrow> \<psi>(x) \<longrightarrow> ch"
  shows "\<phi> \<longrightarrow> ( \<exists>x\<in>A. \<psi>(x)) \<longrightarrow> ch"
  using assms by auto

(*****9re - 2nn *********************)

lemma (in MMIsar0) MMI_breqtrr: assumes A1: "A \<ls> B" and
    A2: "C = B"
   shows "A \<ls> C"
   using assms by auto

(******* ltdiv23i- lble ****************)

lemma (in MMIsar0) MMI_eqbrtr: assumes A1: "A = B" and
    A2: "B \<ls> C"
   shows "A \<ls> C"
   using assms by auto

lemma MMI_nrex: assumes A1: "\<forall>x. x \<in> A \<longrightarrow> \<not>\<psi>(x)"
   shows "\<not>( \<exists>x\<in>A. \<psi>(x))"
   using assms by auto

lemma MMI_iman:
   shows "(\<phi> \<longrightarrow> \<psi>) \<longleftrightarrow>
   \<not>(\<phi> \<and> \<not>\<psi>)"
  by auto

lemma MMI_im2anan9r: assumes A1: "\<phi> \<longrightarrow> \<psi> \<longrightarrow> ch" and
    A2: "\<theta> \<longrightarrow>
   \<tau> \<longrightarrow> \<eta>"
   shows "\<theta> \<and> \<phi> \<longrightarrow>
   \<psi> \<and> \<tau> \<longrightarrow> ch \<and> \<eta>"
   using assms by auto

lemma MMI_ssel:
   shows "A \<subseteq>B \<longrightarrow>
   C \<in> A \<longrightarrow> C \<in> B"
  by auto

lemma MMI_com3r: assumes A1: "\<phi> \<longrightarrow>
   \<psi> \<longrightarrow> ch \<longrightarrow> \<theta>"
   shows "ch \<longrightarrow>
   \<phi> \<longrightarrow>
   \<psi> \<longrightarrow> \<theta>"
   using assms by auto

(*lemma MMI_r19_21aivv:
  assumes A1: "\<forall>x y. \<phi> \<longrightarrow>  (x \<in> A \<and> y \<in> B \<longrightarrow> \<psi>(x,y))"
   shows "\<phi> \<longrightarrow> (\<forall>x\<in>A. \<forall>y\<in>B. \<psi>(x,y))"
   using assms by auto;*)

lemma MMI_r19_21aivv:
  assumes A1: "\<phi> \<longrightarrow>  (\<forall>x y.  x \<in> A \<and> y \<in> B \<longrightarrow> \<psi>(x,y))"
   shows "\<phi> \<longrightarrow> (\<forall>x\<in>A. \<forall>y\<in>B. \<psi>(x,y))"
   using assms by auto

lemma MMI_reucl2:
   shows
  "(\<exists>!x. x\<in>A \<and> \<phi>(x)) \<longrightarrow> \<Union> {x \<in> A. \<phi>(x)} \<in> {x \<in> A. \<phi>(x) }"
proof
  assume "\<exists>!x. x\<in>A \<and> \<phi>(x)"
  then obtain a where I: "{a} = {x\<in>A. \<phi>(x)}" by auto
  moreover have "\<Union>{a} = a" by auto
  moreover have "a \<in> {a}" by blast
  ultimately show "\<Union> {x \<in> A. \<phi>(x)} \<in> {x \<in> A. \<phi>(x) }"
    by simp
qed

lemma MMI_hbra1:
   shows "(\<forall>x\<in>A. \<phi>(x)) \<longrightarrow> (\<forall>x. \<forall>x\<in>A. \<phi>(x))"
  by auto

lemma MMI_hbrab: assumes A1: "\<phi> \<longrightarrow> (\<forall>x. \<phi>)" and
    A2: "z \<in> A \<longrightarrow> (\<forall>x. z \<in> A)"
   shows "z \<in> {y \<in> A. \<phi> } \<longrightarrow>
   (\<forall>x. z \<in> {y \<in> A. \<phi> })"
   using assms by auto

lemma MMI_hbuni: assumes A1: "y \<in> A \<longrightarrow> (\<forall>x. y \<in> A)"
   shows "y \<in> \<Union> A \<longrightarrow>  (\<forall>x. y \<in> \<Union> A)"
   using assms by auto

lemma (in MMIsar0) MMI_hbbr: assumes A1: "y \<in> A \<longrightarrow> (\<forall>x. y \<in> A)" and
    A2: "y \<in> R \<longrightarrow> (\<forall>x. y \<in> R)" and
    A3: "y \<in> B \<longrightarrow> (\<forall>x. y \<in> B)"
   shows
  "A \<lsq> B \<longrightarrow> (\<forall>x. A \<lsq> B)"
  "A \<ls> B \<longrightarrow> (\<forall>x. A \<ls> B)"
   using assms by auto

lemma MMI_rcla4: assumes A1: "\<psi> \<longrightarrow> (\<forall>x. \<psi>)" and
    A2: "\<forall>x. x = A \<longrightarrow> \<phi> \<longleftrightarrow> \<psi>"
   shows "A \<in> B \<longrightarrow>  (\<forall>x\<in>B. \<phi>) \<longrightarrow> \<psi>"
   using assms by auto

lemma twimp2eq: assumes "p\<longrightarrow>q" and "q\<longrightarrow>p" shows "p\<longleftrightarrow>q"
  using assms by blast

lemma MMI_cbvreuv: assumes A1: "\<forall>x y. x = y \<longrightarrow>  \<phi>(x) \<longleftrightarrow> \<psi>(y)"
   shows "(\<exists>!x. x\<in>A\<and>\<phi>(x)) \<longleftrightarrow> (\<exists>!y. y\<in>A\<and>\<psi>(y))"
   using assms
proof -
  { assume A2: "\<exists>!x. x\<in>A \<and> \<phi>(x)"
    then obtain a where I: "a\<in>A" and II: "\<phi>(a)" by auto
    with A1 have "\<psi>(a)" by simp
    with I have "\<exists>y. y\<in>A\<and>\<psi>(y)" by auto
    moreover
    { fix y\<^sub>1 y\<^sub>2
      assume "y\<^sub>1\<in>A \<and> \<psi>(y\<^sub>1)" and "y\<^sub>2\<in>A \<and> \<psi>(y\<^sub>2)"
      with A1 have "y\<^sub>1\<in>A \<and> \<phi>(y\<^sub>1)" and "y\<^sub>2\<in>A \<and> \<phi>(y\<^sub>2)" by auto
      with A2 have "y\<^sub>1 = y\<^sub>2" by auto }
    ultimately have "\<exists>!y. y\<in>A \<and> \<psi>(y)" by auto
  } then have "(\<exists>!x. x\<in>A\<and>\<phi>(x)) \<longrightarrow> (\<exists>!y. y\<in>A\<and>\<psi>(y))" by simp
  moreover
  { assume A2: "\<exists>!y. y\<in>A \<and> \<psi>(y)"
    then obtain a where I: "a\<in>A" and II: "\<psi>(a)" by auto
    with A1 have "\<phi>(a)" by simp
    with I have "\<exists>x. x\<in>A \<and> \<phi>(x)" by auto
    moreover
    { fix x\<^sub>1 x\<^sub>2
      assume "x\<^sub>1\<in>A \<and> \<phi>(x\<^sub>1)" and "x\<^sub>2\<in>A \<and> \<phi>(x\<^sub>2)"
      with A1 have "x\<^sub>1\<in>A \<and> \<psi>(x\<^sub>1)" and "x\<^sub>2\<in>A \<and> \<psi>(x\<^sub>2)" by auto
      with A2 have "x\<^sub>1 = x\<^sub>2" by auto }
    ultimately have "\<exists>!x. x\<in>A \<and> \<phi>(x)" by auto
  } then have "(\<exists>!y. y\<in>A\<and>\<psi>(y)) \<longrightarrow> (\<exists>!x. x\<in>A\<and>\<phi>(x))" by simp
  ultimately show ?thesis by (rule twimp2eq)
qed

lemma MMI_hbeleq: assumes A1: "y \<in> A \<longrightarrow> (\<forall>x. y \<in> A)"
   shows "y = A \<longrightarrow> (\<forall>x. y = A)"
   using assms by auto

lemma MMI_ralbid: assumes A1: "\<phi> \<longrightarrow> (\<forall>x. \<phi>)" and
    A2: "\<phi> \<longrightarrow>
   \<psi> \<longleftrightarrow> ch"
   shows "\<phi> \<longrightarrow>
   (\<forall>x\<in>A. \<psi>) \<longleftrightarrow> (\<forall>x\<in>A. ch)"
   using assms by auto

lemma MMI_reuuni3:
  assumes A1: "\<forall>x y. x = y \<longrightarrow>  \<phi>(x) \<longleftrightarrow> \<psi>(y)" and
    A2: "\<forall>x. x = \<Union> {y \<in> A. \<psi>(y) } \<longrightarrow>  (\<phi>(x) \<longleftrightarrow> ch)"
   shows "(\<exists>!x. x\<in>A \<and> \<phi>(x)) \<longrightarrow> ch"
proof
  assume A3: "\<exists>!x. x\<in>A \<and> \<phi>(x)"
  then obtain a where I: "{a} = {x\<in>A. \<phi>(x)}" by auto
  with A1 have "{a} = {y\<in>A. \<psi>(y)}" by auto
  moreover have "\<Union>{a} = a" by auto
  ultimately have "a = \<Union> {y \<in> A. \<psi>(y) }" by auto
  with A2 have "\<phi>(a) \<longleftrightarrow> ch" by simp
  moreover
  have "a \<in> {a}" by simp
  with I have "\<phi>(a)" by simp
  ultimately show "ch" by simp
qed

(******* lbinfm ****************)

lemma MMI_ssex: assumes A1: "B = B"
   shows "A \<subseteq>B \<longrightarrow> A = A"
   using assms by auto

lemma MMI_rabexg:
   shows "A \<in> B \<longrightarrow>
   {x \<in> A. \<phi>(x) } = {x \<in> A. \<phi>(x) }"
  by auto

lemma MMI_uniexg:
   shows "A \<in> B \<longrightarrow> \<Union>A = \<Union>A "
  by auto

(*lemma (in MMIsar0) MMI_brcnvg:
  shows "A \<in> C \<and> B \<in> D \<longrightarrow>  A > B \<longleftrightarrow> B \<ls> A"
  using cltrr_def convcltrr_def converse_iff by auto original *)

lemma (in MMIsar0) MMI_brcnvg:
  shows "A = A \<and> B = B \<longrightarrow>  A > B \<longleftrightarrow> B \<ls> A"
  using cltrr_def convcltrr_def converse_iff by auto

lemma MMI_r19_21aiva: assumes A1: "\<forall>x. \<phi> \<and> x \<in> A \<longrightarrow> \<psi>(x)"
   shows "\<phi> \<longrightarrow> (\<forall>x\<in>A. \<psi>(x))"
   using assms by auto

lemma MMI_ancrd: assumes A1: "\<phi> \<longrightarrow> \<psi> \<longrightarrow> ch"
   shows "\<phi> \<longrightarrow>
   \<psi> \<longrightarrow> ch \<and> \<psi>"
   using assms by auto

lemma MMI_reuuni2:
  assumes A1: "\<forall>x. x = B \<longrightarrow> \<phi>(x) \<longleftrightarrow> \<psi>"
   shows "B \<in> A \<and> (\<exists>!x. x\<in>A\<and>\<phi>(x)) \<longrightarrow>
   \<psi> \<longleftrightarrow>  \<Union> {x \<in> A. \<phi>(x) } = B"
proof
  assume A2: "B \<in> A \<and> (\<exists>!x. x\<in>A\<and>\<phi>(x))"
  { assume "\<psi>"
    with A1 have "\<phi>(B)" by simp
    with A2 have "{x \<in> A. \<phi>(x) } = {B}" by auto
    then have "\<Union> {x \<in> A. \<phi>(x) } = B" by auto }
  moreover
  { assume A3: "\<Union> {x \<in> A. \<phi>(x) } = B"
    moreover
    from A2 obtain b where I: "{b} = {x \<in> A. \<phi>(x) }" by auto
    moreover have "\<Union>{b} = b" by auto
    ultimately have "\<Union> {x \<in> A. \<phi>(x) } = b" by simp
    with A3 I have "{B} = {x \<in> A. \<phi>(x) }" by simp
    moreover have "B \<in> {B}" by simp
    ultimately have "\<phi>(B)" by auto
    with A1 have "\<psi>" by simp }
  ultimately show "\<psi> \<longleftrightarrow>  \<Union> {x \<in> A. \<phi>(x) } = B" by blast
qed

lemma (in MMIsar0) MMI_cnvso:
   shows "\<cltrrset> Orders A \<longleftrightarrow> converse(\<cltrrset>) Orders A"
  using cnvso by simp

lemma (in MMIsar0) MMI_supeu: assumes A1: "\<cltrrset> Orders A"
   shows "( \<exists>x\<in>A. (\<forall>y\<in>B. \<not>(x\<ls>y)) \<and> (\<forall>y\<in>A. y \<ls> x \<longrightarrow> ( \<exists>z\<in>B. y \<ls> z))) \<longrightarrow>
   (\<exists>!x. x\<in>A\<and>(\<forall>y\<in>B. \<not>(x \<ls> y)) \<and> (\<forall>y\<in>A. y \<ls> x \<longrightarrow> ( \<exists>z\<in>B. y \<ls> z)))"
proof
  assume
    "\<exists>x\<in>A. (\<forall>y\<in>B. \<not>(x\<ls>y)) \<and> (\<forall>y\<in>A. y \<ls> x \<longrightarrow> ( \<exists>z\<in>B. y \<ls> z))"
  then obtain x where
    "x\<in>A"  "\<forall>y\<in>B. \<langle>x,y\<rangle> \<notin> \<cltrrset>"
    "\<forall>y\<in>A. \<langle>y,x\<rangle> \<in> \<cltrrset>  \<longrightarrow> ( \<exists>z\<in>B. \<langle>y,z\<rangle> \<in> \<cltrrset>)"
    using cltrr_def by auto
  with A1 have
    "\<exists>!x. x\<in>A\<and>(\<forall>y\<in>B. \<langle>x,y\<rangle> \<notin> \<cltrrset>) \<and> (\<forall>y\<in>A. \<langle>y,x\<rangle> \<in> \<cltrrset> \<longrightarrow>
    ( \<exists>z\<in>B. \<langle>y,z\<rangle> \<in> \<cltrrset>))"
    using supeu by simp
  then show
    "\<exists>!x. x\<in>A\<and>(\<forall>y\<in>B. \<not>(x \<ls> y)) \<and> (\<forall>y\<in>A. y \<ls> x \<longrightarrow> ( \<exists>z\<in>B. y \<ls> z))"
    using cltrr_def by simp
qed

(** This is actually not in Metamath, we need it only because
    Isabelle does not support $a R b$ notation for relations $R$.
    Metamath covers both we MMI_supeu and MMI_infeu
    in one theorem, we need two **)

lemma (in MMIsar0) MMI_infeu: assumes A1: "converse(\<cltrrset>) Orders A"
   shows
  "(\<exists>x\<in>A. (\<forall>y\<in>B. \<not>(x > y)) \<and> (\<forall>y\<in>A. y  >  x \<longrightarrow> ( \<exists>z\<in>B. y  >  z))) \<longrightarrow>
   (\<exists>!x. x\<in>A\<and>(\<forall>y\<in>B. \<not>(x  >  y)) \<and> (\<forall>y\<in>A. y  >  x \<longrightarrow> ( \<exists>z\<in>B. y  >  z)))"
proof
  let ?r = "converse(\<cltrrset>)"
  assume
    "\<exists>x\<in>A. (\<forall>y\<in>B. \<not>(x > y)) \<and> (\<forall>y\<in>A. y  >  x \<longrightarrow> ( \<exists>z\<in>B. y  >  z))"
  then obtain x where
    "x\<in>A"  "\<forall>y\<in>B. \<langle>x,y\<rangle> \<notin> ?r"
    "\<forall>y\<in>A. \<langle>y,x\<rangle> \<in> ?r  \<longrightarrow> ( \<exists>z\<in>B. \<langle>y,z\<rangle> \<in> ?r)"
    using convcltrr_def by auto
  with A1 have
    "\<exists>!x. x\<in>A\<and>(\<forall>y\<in>B. \<langle>x,y\<rangle> \<notin> ?r) \<and> (\<forall>y\<in>A. \<langle>y,x\<rangle> \<in> ?r \<longrightarrow> ( \<exists>z\<in>B. \<langle>y,z\<rangle> \<in> ?r))"
    by (rule supeu)
  then show
    "\<exists>!x. x\<in>A\<and>(\<forall>y\<in>B. \<not>(x  >  y)) \<and> (\<forall>y\<in>A. y  >  x \<longrightarrow> ( \<exists>z\<in>B. y  >  z))"
    using convcltrr_def by simp
qed

(******** lbinfmcl, lbinfmle ***********************)

lemma MMI_eqeltrd: assumes A1: "\<phi> \<longrightarrow> A = B" and
    A2: "\<phi> \<longrightarrow> B \<in> C"
   shows "\<phi> \<longrightarrow> A \<in> C"
   using assms by auto

lemma (in MMIsar0) MMI_eqbrtrd: assumes A1: "\<phi> \<longrightarrow> A = B" and
    A2: "\<phi> \<longrightarrow> B \<lsq> C"
   shows "\<phi> \<longrightarrow> A \<lsq> C"
   using assms by auto

(****** sup2 ************************************)

lemma MMI_df_ral: shows "(\<forall>x\<in>A. \<phi>(x)) \<longleftrightarrow> (\<forall>x. x\<in>A \<longrightarrow> \<phi>(x))"
  by auto

lemma MMI_df_3an: shows  "(\<phi> \<and> \<psi>  \<and> ch ) \<longleftrightarrow> ( (\<phi> \<and> \<psi> ) \<and> ch )"
  by auto

lemma MMI_pm2_43d: assumes A1: "\<phi> \<longrightarrow>
   \<psi> \<longrightarrow> \<psi> \<longrightarrow> ch"
   shows "\<phi> \<longrightarrow> \<psi> \<longrightarrow> ch"
   using assms by auto

lemma MMI_biimprcd: assumes A1: "\<phi> \<longrightarrow>
   \<psi> \<longleftrightarrow> ch"
   shows "ch \<longrightarrow>
   \<phi> \<longrightarrow> \<psi>"
   using assms by auto

lemma MMI_19_20dv: assumes A1: "\<forall> y. \<phi> \<longrightarrow> \<psi>(y) \<longrightarrow> ch(y)"
   shows "\<phi> \<longrightarrow>  (\<forall>y. \<psi>(y)) \<longrightarrow> (\<forall>y. ch(y))"
   using assms by auto

lemma MMI_cla4ev: assumes A1: "A = A" and
    A2: "\<forall>x. x = A \<longrightarrow>  \<phi>(x) \<longleftrightarrow> \<psi>(x)"
   shows "\<psi>(A) \<longrightarrow> ( \<exists>x. \<phi>(x))"
   using assms by auto

lemma MMI_19_23adv: assumes A1: "\<forall>x. \<phi> \<longrightarrow> \<psi>(x) \<longrightarrow> ch"
   shows "\<phi> \<longrightarrow>  ( \<exists>x. \<psi>(x)) \<longrightarrow> ch"
   using assms by auto

lemma MMI_cbvexv: assumes A1: "\<forall>x y. x = y \<longrightarrow> \<phi>(x) \<longleftrightarrow> \<psi>(y)"
   shows "( \<exists>x. \<phi>(x)) \<longleftrightarrow> ( \<exists>y. \<psi>(y))"
   using assms by auto

(********** sup3 *********************)

lemma MMI_bicomi: assumes A1: "\<phi> \<longleftrightarrow> \<psi>"
   shows "\<psi> \<longleftrightarrow> \<phi>"
   using assms by auto

lemma MMI_syl9: assumes A1: "\<phi> \<longrightarrow> \<psi> \<longrightarrow> ch" and
    A2: "\<theta> \<longrightarrow> ch \<longrightarrow> \<tau>"
   shows "\<phi> \<longrightarrow>
   \<theta> \<longrightarrow>
   \<psi> \<longrightarrow> \<tau>"
   using assms by auto

lemma MMI_imp31: assumes A1: "\<phi> \<longrightarrow>
   \<psi> \<longrightarrow> ch \<longrightarrow> \<theta>"
   shows "(\<phi> \<and> \<psi>) \<and> ch \<longrightarrow> \<theta>"
   using assms by auto

lemma MMI_pm5_32i: assumes A1: "\<phi> \<longrightarrow>
   \<psi> \<longleftrightarrow> ch"
   shows "\<phi> \<and> \<psi> \<longleftrightarrow> \<phi> \<and> ch"
   using assms by auto

(****** infm3 *************************)

lemma MMI_3impib: assumes A1: "\<phi> \<longrightarrow>
   \<psi> \<and> ch \<longrightarrow> \<theta>"
   shows "\<phi> \<and> \<psi> \<and> ch \<longrightarrow> \<theta>"
   using assms by auto

lemma MMI_pm4_71rd: assumes A1: "\<phi> \<longrightarrow> \<psi> \<longrightarrow> ch"
   shows "\<phi> \<longrightarrow>
   \<psi> \<longleftrightarrow> ch \<and> \<psi>"
   using assms by auto

lemma MMI_exbidv: assumes A1: "\<phi> \<longrightarrow>
   \<psi> \<longleftrightarrow> ch"
   shows "\<phi> \<longrightarrow>
   ( \<exists>x. \<psi>) \<longleftrightarrow> ( \<exists>x. ch)"
   using assms by auto

(** original
lemma MMI_rexxfr: assumes A1: "y \<in> B \<longrightarrow> A \<in> B" and
    A2: "x \<in> B \<longrightarrow> ( \<exists>y\<in>B. x = A)" and
    A3: "x = A \<longrightarrow>
   \<phi> \<longleftrightarrow> \<psi>"
   shows "( \<exists>x\<in>B. \<phi>) \<longleftrightarrow> ( \<exists>y\<in>B. \<psi>)"
   using assms by auto *********)

lemma MMI_rexxfr: assumes A1: "\<forall>y. y \<in> B \<longrightarrow> A(y) \<in> B" and
    A2: "\<forall> x. x \<in> B \<longrightarrow> ( \<exists>y\<in>B. x = A(y))" and
    A3: "\<forall> x y. x = A(y) \<longrightarrow> ( \<phi>(x) \<longleftrightarrow> \<psi>(y) ) "
   shows "( \<exists>x\<in>B. \<phi>(x)) \<longleftrightarrow> ( \<exists>y\<in>B. \<psi>(y))"
proof
  assume "\<exists>x\<in>B. \<phi>(x)"
  then obtain x where "x\<in>B" and I: "\<phi>(x)" by auto
  with A2 obtain y where II: "y\<in>B" and "x=A(y)" by auto
  with A3 I have "\<psi>(y)" by simp
  with II show "\<exists>y\<in>B. \<psi>(y)" by auto
next assume "\<exists>y\<in>B. \<psi>(y)"
  then obtain y where "y\<in>B" and III: "\<psi>(y)" by auto
  with A1 have IV: "A(y) \<in> B" by simp
  with A2 obtain x where "x\<in>B" and "A(x) = A(y)" by auto
  with A3 III have "\<phi>(A(y))" by auto
  with IV show "\<exists>x\<in>B. \<phi>(x)" by auto
qed

lemma MMI_n0:
   shows "\<not>(A = 0) \<longleftrightarrow> ( \<exists>x. x \<in> A)"
  by auto

lemma MMI_rabn0:
   shows "\<not>({x \<in> A. \<phi>(x) } = 0) \<longleftrightarrow> ( \<exists>x\<in>A. \<phi>(x))"
  by auto

lemma MMI_impexp:
   shows "(\<phi> \<and> \<psi> \<longrightarrow> ch) \<longleftrightarrow>
   (\<phi> \<longrightarrow> \<psi> \<longrightarrow> ch)"
  by auto

lemma MMI_albidv: assumes A1: "\<forall>x. \<phi> \<longrightarrow>  \<psi>(x) \<longleftrightarrow> ch(x)"
   shows "\<phi> \<longrightarrow>  (\<forall>x. \<psi>(x)) \<longleftrightarrow> (\<forall>x. ch(x))"
   using assms by auto

lemma MMI_ralxfr: assumes A1: "\<forall>y. y \<in> B \<longrightarrow> A(y) \<in> B" and
    A2: "\<forall>x. x \<in> B \<longrightarrow> ( \<exists>y\<in>B. x = A(y))" and
    A3: "\<forall>x y. x = A(y) \<longrightarrow>  \<phi>(x) \<longleftrightarrow> \<psi>(y)"
   shows "(\<forall>x\<in>B. \<phi>(x)) \<longleftrightarrow> (\<forall>y\<in>B. \<psi>(y))"
proof
  assume A4: "\<forall>x\<in>B. \<phi>(x)"
  { fix y assume "y\<in>B"
    with A1 A3 A4 have "\<psi>(y)" by auto
  } then show "\<forall>y\<in>B. \<psi>(y)" by simp
next assume A5: "\<forall>y\<in>B. \<psi>(y)"
  { fix x assume "x\<in>B"
    with A2 A3 A5 have "\<phi>(x)" by auto
  } then show "\<forall>x\<in>B. \<phi>(x)" by simp
qed

lemma MMI_rexbidv: assumes A1: "\<forall>x. \<phi> \<longrightarrow>  \<psi>(x) \<longleftrightarrow> ch(x)"
   shows "\<phi> \<longrightarrow> ( \<exists>x\<in>A. \<psi>(x)) \<longleftrightarrow> ( \<exists>x\<in>A. ch(x))"
   using assms by auto

lemma MMI_imbi1i: assumes Aa: "\<phi> \<longleftrightarrow> \<psi>"
   shows "(\<phi> \<longrightarrow> ch) \<longleftrightarrow> (\<psi> \<longrightarrow> ch)"
   using assms by auto

lemma MMI_3bitr4r: assumes A1: "\<phi> \<longleftrightarrow> \<psi>" and
    A2: "ch \<longleftrightarrow> \<phi>" and
    A3: "\<theta> \<longleftrightarrow> \<psi>"
   shows "\<theta> \<longleftrightarrow> ch"
   using assms by auto

lemma MMI_rexbiia: assumes A1: "\<forall>x. x \<in> A \<longrightarrow>  \<phi>(x) \<longleftrightarrow> \<psi>(x)"
   shows "( \<exists>x\<in>A. \<phi>(x)) \<longleftrightarrow> ( \<exists>x\<in>A. \<psi>(x))"
   using assms by auto

lemma MMI_anass:
   shows "(\<phi> \<and> \<psi>) \<and> ch \<longleftrightarrow> \<phi> \<and> \<psi> \<and> ch"
  by auto

lemma MMI_rexbii2: assumes A1: "\<forall>x. x \<in> A \<and> \<phi>(x) \<longleftrightarrow> x \<in> B \<and> \<psi>(x)"
   shows "( \<exists>x\<in>A. \<phi>(x)) \<longleftrightarrow> ( \<exists>x\<in>B. \<psi>(x))"
   using assms by auto

lemma MMI_sylibrd: assumes A1: "\<phi> \<longrightarrow> \<psi> \<longrightarrow> ch" and
    A2: "\<phi> \<longrightarrow>
   \<theta> \<longleftrightarrow> ch"
   shows "\<phi> \<longrightarrow>
   \<psi> \<longrightarrow> \<theta>"
   using assms by auto

(************** suprcl, suprub *******************)

lemma (in MMIsar0) MMI_supcl: assumes A1:   "\<cltrrset> Orders A"
  shows
  "( \<exists>x\<in>A. (\<forall>y\<in>B. \<not>(x \<ls> y)) \<and> (\<forall>y\<in>A. y \<ls> x \<longrightarrow>
  ( \<exists>z\<in>B. y \<ls> z))) \<longrightarrow>  Sup(B,A,\<cltrrset>) \<in> A"
proof
  let ?R = "\<cltrrset>"
  assume
    "\<exists>x\<in>A. (\<forall>y\<in>B. \<not>(x \<ls> y)) \<and> (\<forall>y\<in>A. y \<ls> x \<longrightarrow> ( \<exists>z\<in>B. y \<ls> z))"
  then have
    "\<exists>x\<in>A. (\<forall>y\<in>B. \<not>(\<langle>x,y\<rangle> \<in> ?R) ) \<and> (\<forall>y\<in>A. \<langle>y,x\<rangle> \<in> ?R \<longrightarrow> ( \<exists>z\<in>B. \<langle>y,z\<rangle> \<in> ?R))"
    using cltrr_def by simp
  with A1 show "Sup(B,A,?R) \<in> A" by (rule sup_props)
qed

lemma (in MMIsar0) MMI_supub: assumes A1: "\<cltrrset> Orders A"
   shows
  "( \<exists>x\<in>A. (\<forall>y\<in>B. \<not>(x \<ls> y)) \<and> (\<forall>y\<in>A. y \<ls> x \<longrightarrow> ( \<exists>z\<in>B. y \<ls> z))) \<longrightarrow>
   C \<in> B \<longrightarrow> \<not>( Sup(B,A,\<cltrrset>) \<ls> C)"
proof
  let ?R = "\<cltrrset>"
  assume
    "\<exists>x\<in>A. (\<forall>y\<in>B. \<not>(x \<ls> y)) \<and> (\<forall>y\<in>A. y \<ls> x \<longrightarrow> ( \<exists>z\<in>B. y \<ls> z))"
  then have
    "\<exists>x\<in>A. (\<forall>y\<in>B. \<langle>x,y\<rangle> \<notin> ?R) \<and> (\<forall>y\<in>A. \<langle>y,x\<rangle> \<in> ?R \<longrightarrow> ( \<exists>z\<in>B. \<langle>y,z\<rangle> \<in> ?R))"
    using cltrr_def by simp
  with A1 have I: "\<forall>y\<in>B. \<langle>Sup(B,A,?R),y\<rangle> \<notin> ?R" by (rule sup_props)
  { assume "C \<in> B"
    with I have  "\<not>( Sup(B,A,?R) \<ls> C)" using cltrr_def by simp
  } then show "C \<in> B \<longrightarrow> \<not>( Sup(B,A,?R) \<ls> C)" by simp
qed

lemma MMI_sseld: assumes A1: "\<phi> \<longrightarrow> A \<subseteq> B"
   shows "\<phi> \<longrightarrow> C \<in> A \<longrightarrow> C \<in> B"
   using assms by auto

(********suprlub - suprleub **********************)

lemma (in MMIsar0) MMI_suplub: assumes A1: "\<cltrrset> Orders A"
   shows "( \<exists>x\<in>A. (\<forall>y\<in>B. \<not>(x \<ls> y)) \<and>
  (\<forall>y\<in>A. y \<ls> x \<longrightarrow> ( \<exists>z\<in>B. y \<ls> z))) \<longrightarrow>
   C \<in> A \<and> C \<ls> Sup(B,A,\<cltrrset>) \<longrightarrow> ( \<exists>z\<in>B. C \<ls> z)"
proof
  let ?R = "\<cltrrset>"
  assume
    "\<exists>x\<in>A. (\<forall>y\<in>B. \<not>(x \<ls> y)) \<and> (\<forall>y\<in>A. y \<ls> x \<longrightarrow> ( \<exists>z\<in>B. y \<ls> z))"
  then have
    "\<exists>x\<in>A. (\<forall>y\<in>B. \<langle>x,y\<rangle> \<notin> ?R) \<and> (\<forall>y\<in>A. \<langle>y,x\<rangle> \<in> ?R \<longrightarrow> ( \<exists>z\<in>B. \<langle>y,z\<rangle> \<in> ?R))"
    using cltrr_def by simp
  with A1 have I:
    "\<forall>y\<in>A. \<langle>y,Sup(B,A,?R)\<rangle> \<in> ?R \<longrightarrow> ( \<exists>z\<in>B. \<langle>y,z\<rangle> \<in> ?R )"
    by (rule sup_props)
  then show "C \<in> A \<and> C \<ls> Sup(B,A,?R) \<longrightarrow> ( \<exists>z\<in>B. C \<ls> z)"
    using cltrr_def by simp
qed

lemma (in MMIsar0) MMI_supnub: assumes A1: "\<cltrrset> Orders A"
   shows
  "(\<exists>x\<in>A. (\<forall>y\<in>B. \<not>(x \<ls> y)) \<and> (\<forall>y\<in>A. y \<ls> x \<longrightarrow>
  ( \<exists>z\<in>B. y \<ls> z))) \<longrightarrow>
   C \<in> A \<and> (\<forall>z\<in>B. \<not>(C \<ls> z)) \<longrightarrow> \<not>(C \<ls> Sup(B,A,\<cltrrset>))"
proof
  let ?R = "\<cltrrset>"
  assume
    "\<exists>x\<in>A. (\<forall>y\<in>B. \<not>(x \<ls> y)) \<and> (\<forall>y\<in>A. y \<ls> x \<longrightarrow> ( \<exists>z\<in>B. y \<ls> z))"
  then have
    "\<exists>x\<in>A. (\<forall>y\<in>B. \<langle>x,y\<rangle> \<notin> ?R) \<and> (\<forall>y\<in>A. \<langle>y,x\<rangle> \<in> ?R \<longrightarrow> ( \<exists>z\<in>B. \<langle>y,z\<rangle> \<in> ?R))"
    using cltrr_def by simp
  with A1 show
    "C \<in> A \<and> (\<forall>z\<in>B. \<not>(C \<ls> z)) \<longrightarrow> \<not>(C \<ls> Sup(B,A,\<cltrrset>))"
    using cltrr_def supnub by simp
qed

lemma MMI_pm5_32d: assumes A1: "\<phi> \<longrightarrow> \<psi> \<longrightarrow>  ch \<longleftrightarrow> \<theta>"
   shows "\<phi> \<longrightarrow>  \<psi> \<and> ch \<longleftrightarrow> \<psi> \<and> \<theta>"
   using assms by auto

(********* sup3i - suprnubi **********************)

lemma (in MMIsar0) MMI_supcli:
  assumes A1: "\<cltrrset> Orders A" and A2:
  "\<exists>x\<in>A. (\<forall>y\<in>B. \<not>(x \<ls> y)) \<and> (\<forall>y\<in>A. y \<ls> x \<longrightarrow> ( \<exists>z\<in>B. y \<ls> z))"
  shows "Sup(B,A,\<cltrrset>) \<in> A"
  using assms MMI_supcl by simp

lemma (in MMIsar0) MMI_suplubi: assumes A1: "\<cltrrset> Orders A" and
  A2: "\<exists>x\<in>A. (\<forall>y\<in>B. \<not>(x \<ls> y)) \<and> (\<forall>y\<in>A. y \<ls> x \<longrightarrow> ( \<exists>z\<in>B. y \<ls> z))"
  shows "C \<in> A \<and> C \<ls> Sup(B,A,\<cltrrset>) \<longrightarrow> ( \<exists>z\<in>B. C \<ls> z)"
proof -
  from A1 have "( \<exists>x\<in>A. (\<forall>y\<in>B. \<not>(x \<ls> y)) \<and>
    (\<forall>y\<in>A. y \<ls> x \<longrightarrow> ( \<exists>z\<in>B. y \<ls> z))) \<longrightarrow>
    C \<in> A \<and> C \<ls> Sup(B,A,\<cltrrset>) \<longrightarrow> ( \<exists>z\<in>B. C \<ls> z)"
    by (rule MMI_suplub)
  with A2 show "C \<in> A \<and> C \<ls> Sup(B,A,\<cltrrset>) \<longrightarrow> ( \<exists>z\<in>B. C \<ls> z)"
    by simp
qed

lemma  (in MMIsar0) MMI_supnubi: assumes A1: "\<cltrrset> Orders A" and
    A2: " \<exists>x\<in>A. (\<forall>y\<in>B. \<not>(x \<ls> y)) \<and>
  (\<forall>y\<in>A. y \<ls> x \<longrightarrow> ( \<exists>z\<in>B. y \<ls> z))"
   shows "C \<in> A \<and> (\<forall>z\<in>B. \<not>(C \<ls> z)) \<longrightarrow> \<not>(C \<ls>Sup(B,A,\<cltrrset>))"
   using assms  MMI_supnub by simp

(************ suprleubi - dfinfmr *********************)

lemma MMI_reuunixfr_helper: assumes
  A1: "\<forall>x y. x = B(y) \<longrightarrow> \<phi>(x) \<longleftrightarrow> \<psi>(y)" and
  A2: "\<forall>y. y\<in>A \<longrightarrow> B(y) \<in> A" and
  A3: "\<forall> x. x \<in> A \<longrightarrow>  (\<exists>!y. y\<in>A \<and> x = B(y))" and
  A4: "\<exists>!x. x\<in>A \<and> \<phi>(x)"
shows "\<exists>!y. y\<in>A \<and> \<psi>(y)"
proof
  from A4 obtain x where I: "x\<in>A" and II: "\<phi>(x)" by auto
  with A3 obtain y where III: "y\<in>A" and "x = B(y)" by auto
  with A1 II show "\<exists>y. y \<in> A \<and> \<psi>(y)" by auto
next fix y\<^sub>1 y\<^sub>2
  assume A5: "y\<^sub>1 \<in> A \<and> \<psi>(y\<^sub>1)"   "y\<^sub>2 \<in> A \<and> \<psi>(y\<^sub>2)"
  with A2 have IV: "B(y\<^sub>1) \<in> A" and "B(y\<^sub>2) \<in> A" by auto
  with A4 A1 A5 have "y\<^sub>1 \<in> A" and "y\<^sub>2 \<in> A" and "B(y\<^sub>1) = B(y\<^sub>2)" by auto
  with A3 IV show "y\<^sub>1 = y\<^sub>2" by blast
qed

lemma MMI_reuunixfr: assumes A1: "\<forall> z. z \<in> C \<longrightarrow> (\<forall>y. z \<in> C)" and
    A2: "\<forall> y. y \<in> A \<longrightarrow> B(y) \<in> A" and
    A3: "\<Union> {y \<in> A. \<psi>(y) } \<in> A \<longrightarrow> C \<in> A" and
    A4: "\<forall>x y. x = B(y) \<longrightarrow>  \<phi>(x) \<longleftrightarrow> \<psi>(y)" and
    A5: "\<forall> y. y = \<Union> {y \<in> A. \<psi>(y) } \<longrightarrow> B(y) = C" and
    A6: "\<forall> x. x \<in> A \<longrightarrow>  (\<exists>!y. y\<in>A \<and> x = B(y))"
   shows "(\<exists>!x. x\<in>A \<and> \<phi>(x)) \<longrightarrow>  \<Union> {x \<in> A. \<phi>(x) } = C"
proof
  let ?D = "\<Union> {y \<in> A. \<psi>(y)}"
  assume A7: "\<exists>!x. x\<in>A \<and> \<phi>(x)"
  with A4 A2 A6 have I: "\<exists>!y. y\<in>A \<and> \<psi>(y)" by (rule MMI_reuunixfr_helper)
  with A3 have T: "C \<in> A" using ZF1_1_L9 by simp
  from A4 A5 have "\<phi>(C) \<longleftrightarrow> \<psi>(?D)" by auto
  moreover from I have "\<psi>(?D)" by (rule ZF1_1_L9)
  ultimately have "\<phi>(C)" by simp
  with T A7 show "\<Union> {x \<in> A. \<phi>(x) } = C" by auto
qed

lemma MMI_hbrab1:
   shows "y \<in> {x \<in> A. \<phi>(x) } \<longrightarrow>  (\<forall>x. y \<in> {x \<in> A. \<phi>(x) })"
  by auto

lemma MMI_reuhyp: assumes A1: "\<forall>x. x \<in> C \<longrightarrow> B(x) \<in> C" and
    A2: "\<forall> x y.  x \<in> C \<and> y \<in> C \<longrightarrow>  x = A(y) \<longleftrightarrow> y = B(x)"
   shows "\<forall> x. x \<in> C \<longrightarrow> (\<exists>!y. y\<in>C \<and> x = A(y))"
proof -
  { fix x
    assume A3: "x\<in>C"
    with A1 have I: "B(x) \<in> C" by simp
    with A2 A3 have II: "x = A(B(x))" by simp
    have "\<exists>!y. y\<in>C \<and> x = A(y)"
    proof
      from I II show "\<exists>y. y\<in>C \<and> x = A(y)" by auto
    next fix y\<^sub>1 y\<^sub>2
      assume A4: "y\<^sub>1 \<in> C \<and> x = A(y\<^sub>1)"   "y\<^sub>2 \<in> C \<and> x = A(y\<^sub>2)"
      with A3 have "x \<in> C \<and> y\<^sub>1 \<in> C" and "x \<in> C \<and> y\<^sub>2 \<in> C" by auto
      with A2 have "x = A(y\<^sub>1) \<longleftrightarrow> y\<^sub>1 = B(x)" and "x = A(y\<^sub>2) \<longleftrightarrow> y\<^sub>2 = B(x)"
	by auto
      with A4 show "y\<^sub>1 = y\<^sub>2" by auto
    qed
  } then show ?thesis by simp
qed

lemma (in MMIsar0) MMI_brcnv: assumes A1: "A = A" and
    A2: "B = B"
   shows "A > B \<longleftrightarrow> B \<ls> A"
   using convcltrr_def cltrr_def by auto

lemma MMI_imbi12i: assumes A1: "\<phi> \<longleftrightarrow> \<psi>" and
    A2: "ch \<longleftrightarrow> \<theta>"
   shows "(\<phi> \<longrightarrow> ch) \<longleftrightarrow>  (\<psi> \<longrightarrow> \<theta>)"
   using assms by auto

lemma MMI_ralbii: assumes A1: "\<forall> x. \<phi>(x) \<longleftrightarrow> \<psi>(x)"
   shows "(\<forall>x\<in>A. \<phi>(x)) \<longleftrightarrow> (\<forall>x\<in>A. \<psi>(x))"
   using assms by auto

lemma MMI_rabbidv: assumes A1: "\<forall> x. \<phi> \<longrightarrow> x \<in> A \<longrightarrow>  \<psi>(x) \<longleftrightarrow> ch(x)"
   shows "\<phi> \<longrightarrow>  {x \<in> A. \<psi>(x) } = {x \<in> A. ch(x) }"
   using assms by auto

lemma MMI_unieqd: assumes A1: "\<phi> \<longrightarrow> A = B"
   shows "\<phi> \<longrightarrow> \<Union> A = \<Union> B"
   using assms by auto

(************ infmsup, infmrcl **********************)

lemma MMI_rabbii: assumes A1: "\<forall> x. x \<in> A \<longrightarrow>  \<psi>(x) \<longleftrightarrow> ch(x)"
   shows "{x \<in> A. \<psi>(x) } = {x \<in> A. ch(x) }"
   using assms by auto

lemma MMI_unieqi: assumes A1: "A = B"
   shows "\<Union> A = \<Union> B"
   using assms by auto

lemma MMI_syl5rbb: assumes A1: "\<phi> \<longrightarrow>
   \<psi> \<longleftrightarrow> ch" and
    A2: "\<theta> \<longleftrightarrow> \<psi>"
   shows "\<phi> \<longrightarrow>
   ch \<longleftrightarrow> \<theta>"
   using assms by auto

lemma MMI_reubii: assumes A1: "\<forall>x. \<phi>(x) \<longleftrightarrow> \<psi>(x)"
   shows "(\<exists>!x. x\<in>A \<and> \<phi>(x)) \<longleftrightarrow> (\<exists>!x. x\<in>A \<and> \<psi>(x))"
   using assms by auto

lemma MMI_3imtr3: assumes A1: "\<phi> \<longrightarrow> \<psi>" and
    A2: "\<phi> \<longleftrightarrow> ch" and
    A3: "\<psi> \<longleftrightarrow> \<theta>"
   shows "ch \<longrightarrow> \<theta>"
   using assms by auto

lemma MMI_syl6d: assumes A1: "\<phi> \<longrightarrow>
   \<psi> \<longrightarrow> ch \<longrightarrow> \<theta>" and
    A2: "\<phi> \<longrightarrow>
   \<theta> \<longrightarrow> \<tau>"
   shows "\<phi> \<longrightarrow>
   \<psi> \<longrightarrow> ch \<longrightarrow> \<tau>"
   using assms by auto

lemma MMI_n0i:
   shows "B \<in> A \<longrightarrow> \<not>(A = 0)"
  by auto

end


section \<open>Base system E\<close>
(*<*)
theory cube_old
imports Main

begin
(*>*)

subsection \<open>Introduction\<close>

subsection \<open>Base System E\<close>

text \<open>We present an approach to meta-reasoning about dyadic deontic logics, and
apply it to verify the relative strengths of logics in the deontic cube. This one is still
under construction, and closer to a line at the moment. We introduce the
properties of the betterness relation, and their syntactical counterparts. We ask Isabelle/HOL to

(1) confirm known correspondance (established by pen and paper) under
different evaluation rules for the conditional obligation operator: max rule, opt rule, closure
maximality, and  Lewis rule.
(2) verify the asbsence of syntactical counterpart of some properties
(3) answer open problems regarding correspondance problems  (open in the sense of unsettled by
 pen and paper). \<close>

(*which is illustrated in Figure 1. In particular, proofs are
given for the equivalences of different axiomatizations and the
inclusion relations shown in the cube.*)

section \<open>Framework\<close>

text \<open>This is Aqvis's system E from the 2019 IfColog paper.\<close>

typedecl i (*Possible worlds.*)
type_synonym \<sigma> = "(i\<Rightarrow>bool)"
type_synonym \<alpha> = "i\<Rightarrow>\<sigma>" (*Type of betterness relation between worlds.*)
type_synonym \<tau> = "\<sigma>\<Rightarrow>\<sigma>"

consts aw::i (*Actual world.*)
abbreviation etrue  :: "\<sigma>" ("\<^bold>\<top>") where "\<^bold>\<top> \<equiv> \<lambda>w. True"
abbreviation efalse :: "\<sigma>" ("\<^bold>\<bottom>")  where "\<^bold>\<bottom> \<equiv> \<lambda>w. False"
abbreviation enot :: "\<sigma>\<Rightarrow>\<sigma>" ("\<^bold>\<not>_"[52]53)  where "\<^bold>\<not>\<phi> \<equiv> \<lambda>w. \<not>\<phi>(w)"
abbreviation eand :: "\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>\<sigma>" (infixr"\<^bold>\<and>"51) where "\<phi>\<^bold>\<and>\<psi> \<equiv> \<lambda>w. \<phi>(w)\<and>\<psi>(w)"
abbreviation eor  :: "\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>\<sigma>" (infixr"\<^bold>\<or>"50) where "\<phi>\<^bold>\<or>\<psi> \<equiv> \<lambda>w. \<phi>(w)\<or>\<psi>(w)"
abbreviation eimp :: "\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>\<sigma>" (infixr"\<^bold>\<rightarrow>"49) where "\<phi>\<^bold>\<rightarrow>\<psi> \<equiv> \<lambda>w. \<phi>(w)\<longrightarrow>\<psi>(w)"
abbreviation eequ :: "\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>\<sigma>" (infixr"\<^bold>\<leftrightarrow>"48) where "\<phi>\<^bold>\<leftrightarrow>\<psi> \<equiv> \<lambda>w. \<phi>(w)\<longleftrightarrow>\<psi>(w)"

abbreviation ebox :: "\<sigma>\<Rightarrow>\<sigma>" ("\<box>") where "\<box> \<equiv> \<lambda>\<phi> w.  \<forall>v. \<phi>(v)"
definition ddediomond  :: "\<sigma>\<Rightarrow>\<sigma>" ("\<diamond>") where "\<diamond>\<phi> \<equiv> \<lambda>w. \<exists>v. \<phi>(v)"

abbreviation evalid :: "\<sigma>\<Rightarrow>bool" ("\<lfloor>_\<rfloor>"[8]109)  (*Global validity.*)
  where "\<lfloor>p\<rfloor> \<equiv> \<forall>w. p w"
abbreviation ecjactual :: "\<sigma>\<Rightarrow>bool" ("\<lfloor>_\<rfloor>\<^sub>l"[7]105) (*Local validity — in world aw.*)
  where "\<lfloor>p\<rfloor>\<^sub>l \<equiv> p(aw)"

consts r :: "\<alpha>" (infixr "r" 70) (*Betterness relation*)

abbreviation esubset :: "\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>bool" (infix "\<^bold>\<subseteq>" 53)
  where "\<phi> \<^bold>\<subseteq> \<psi> \<equiv> \<forall>x. \<phi> x \<longrightarrow> \<psi> x"

abbreviation eopt  :: "\<sigma>\<Rightarrow>\<sigma>" ("opt<_>")  (* opt rule*)
  where "opt<\<phi>> \<equiv> (\<lambda>v. ( (\<phi>)(v) \<and> (\<forall>x. ((\<phi>)(x) \<longrightarrow> v r x) )) )"
abbreviation econdopt :: "\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>\<sigma>" ("\<odot><_|_>")
  where "\<odot><\<psi>|\<phi>> \<equiv>  \<lambda>w. opt<\<phi>> \<^bold>\<subseteq> \<psi>"
abbreviation eperm :: "\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>\<sigma>" ("\
<_|_>")
  where "\
<\<psi>|\<phi>> \<equiv> \<^bold>\<not>\<odot><\<^bold>\<not>\<psi>|\<phi>>"

abbreviation emax  :: "\<sigma>\<Rightarrow>\<sigma>" ("max<_>")      (*Max rule *)
  where "max<\<phi>> \<equiv> (\<lambda>v. ( (\<phi>)(v) \<and> (\<forall>x. ((\<phi>)(x) \<longrightarrow> (x r v \<longrightarrow>  v r x)) )) )"
abbreviation econd  :: "\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>\<sigma>" ("\<circle><_|_>")
  where "\<circle><\<psi>|\<phi>> \<equiv>  \<lambda>w. max<\<phi>> \<^bold>\<subseteq> \<psi>"
abbreviation euncobl :: "\<sigma>\<Rightarrow>\<sigma>" ("\<^bold>\<circle><_>")
  where "\<^bold>\<circle><\<phi>> \<equiv> \<circle><\<phi>|\<^bold>\<top>>"
abbreviation ddeperm :: "\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>\<sigma>" ("P<_|_>")
  where "P<\<psi>|\<phi>> \<equiv>\<^bold>\<not>\<circle><\<^bold>\<not>\<psi>|\<phi>>"

lemma "\<odot><\<psi>|\<phi>> \<equiv> \<circle><\<psi>|\<phi>>" nitpick [show_all] (*countermodel found*) oops

(*David Lewis's evaluation rule for the conditional *)

abbreviation lewcond :: "\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>\<sigma>"  ("\<circ><_|_>")
  where "\<circ><\<psi>|\<phi>> \<equiv> \<lambda>v. (\<not>(\<exists>x. (\<phi>)(x))\<or>
        (\<exists>x. ((\<phi>)(x)\<and>(\<psi>)(x) \<and> (\<forall>y. ((y r x) \<longrightarrow> (\<phi>)(y)\<longrightarrow>(\<psi>)(y))))))"
abbreviation lewperm :: "\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>\<sigma>" ("\<integral><_|_>")
  where "\<integral><\<psi>|\<phi>> \<equiv>\<^bold>\<not>\<circ><\<^bold>\<not>\<psi>|\<phi>>"

lemma True nitpick [satisfy,user_axioms,expect=genuine] oops

subsection \<open>Properties\<close>

text \<open>We have the following constraints on the betterness relation\<close>

(*The standard properties*)
abbreviation reflexivity  where "reflexivity  \<equiv> (\<forall>x. x r x)"
abbreviation transitivity
  where "transitivity \<equiv> (\<forall>x y z. (x r y \<and> y r z) \<longrightarrow> x r z)"
abbreviation totalness
  where "totalness \<equiv> (\<forall>x y. (x r y \<or> y r x))"

(*4 versions of Lewis's limit assumption*)
abbreviation mlimitedness
  where "mlimitedness \<equiv> (\<forall>\<phi>. (\<exists>x. (\<phi>)x) \<longrightarrow> (\<exists>x. max<\<phi>>x))"
abbreviation msmoothness
  where "msmoothness \<equiv> (\<forall>\<phi> x. ((\<phi>)x \<longrightarrow>
                     (max<\<phi>>x \<or> (\<exists>y. (y r x \<and> \<not>(x r y) \<and> max<\<phi>>y)))))"
abbreviation olimitedness
  where "olimitedness \<equiv> (\<forall>\<phi>. (\<exists>x. (\<phi>)x) \<longrightarrow> (\<exists>x. opt<\<phi>>x))"
abbreviation osmoothness  where
   "osmoothness \<equiv> (\<forall>\<phi> x. ((\<phi>)x \<longrightarrow>
                      (opt<\<phi>>x \<or> (\<exists>y. (y r x \<and> \<not>(x r y) \<and> opt<\<phi>>y)))))"

definition transitive :: "\<alpha>\<Rightarrow>bool" where "transitive R \<equiv> \<forall>x y z. R x y \<and>  R y z \<longrightarrow> R x z"
definition sub_rel :: "\<alpha>\<Rightarrow>\<alpha>\<Rightarrow>bool" where "sub_rel R Q \<equiv> \<forall>u v. R u v \<longrightarrow> Q u v"
definition assfactor::"\<alpha>\<Rightarrow>\<alpha>" where "assfactor R \<equiv> \<lambda>u v. R u v \<and> \<not> R v u "

(*In HOL the transitive closure of a relation can be defined in a single line.*)
definition tc :: "\<alpha>\<Rightarrow>\<alpha>" where "tc R \<equiv> \<lambda>x y.\<forall>Q. transitive Q \<longrightarrow> (sub_rel R Q \<longrightarrow> Q x y)"

(* this is a first form of a-cyclicity. Cycles with one non-strict betterness are ruled out*)
abbreviation Suzumura
  where "Suzumura R \<equiv> \<forall>x y. (tc R x y \<longrightarrow> ( R y x \<longrightarrow> R x y))"

(* this is a second form of a-cyclicity. Cycles of non-strict betterness are ruled out*)
abbreviation loopfree
  where "loopfree R \<equiv> \<forall>x y. (tc (assfactor R) x y \<longrightarrow> ( R y x \<longrightarrow> R x y))"

(*Interval order condition is totalness plus Ferrers*)
abbreviation Ferrers
  where "Ferrers \<equiv> (\<forall>x y z u. ((x r u) \<and> (y r z)) \<longrightarrow> (x r z) \<or> (y r u))"

lemma assumes Ferrers reflexivity  (*fact overlooked in the literature*)
  shows totalness
  sledgehammer  (*proof found*)

(* Some useful relations for constraining the betterness relations*)

  section \<open>Max rule\<close>

 subsection \<open>Correspondence\<close>

text \<open>We go through the known correspondences, and verify them \<close>

(*max-Limitedness corresponds to D*)
lemma assumes "mlimitedness"
  shows  D*: "\<lfloor>\<diamond>\<phi> \<^bold>\<rightarrow> \<circle><\<psi>|\<phi>> \<^bold>\<rightarrow> P<\<psi>|\<phi>>\<rfloor>"
  sledgehammer (*proof found*)

lemma assumes D*: "\<lfloor>\<diamond>\<phi> \<^bold>\<rightarrow> \<circle><\<psi>|\<phi>> \<^bold>\<rightarrow> P<\<psi>|\<phi>>\<rfloor>"
  shows "mlimitedness"
  sledgehammer (*all timed out*)
  nitpick (* counterexample found *)
  oops

(*smoothness corresponds to cautious monotony *)
lemma assumes "msmoothness"
  shows  CM: "\<lfloor>(\<circle><\<psi>|\<phi>>\<^bold>\<and>\<circle><\<chi>|\<phi>>)\<^bold>\<rightarrow> \<circle><\<chi>|\<phi>\<^bold>\<and>\<psi>>\<rfloor>"
  sledgehammer  oops (*proof found*)

lemma assumes CM: "\<lfloor>(\<circle><\<psi>|\<phi>>\<^bold>\<and>\<circle><\<chi>|\<phi>>)\<^bold>\<rightarrow> \<circle><\<chi>|\<phi>\<^bold>\<and>\<psi>>\<rfloor>"
  shows  "msmoothness"
  sledgehammer (* timed out*)
  nitpick [show_all] (* counterexample found *)
  oops

(*interval order (reflexivity plus Ferrers) corresponds to disjunctive rationality*)
lemma assumes "reflexivity"
     (* assumes "Ferrers"*)
  shows  DR: "\<lfloor>\<circle><\<chi>|(\<phi>\<^bold>\<or>\<psi>)>\<^bold>\<rightarrow>((\<circle><\<chi>|\<phi>>)\<^bold>\<or>(\<circle><\<chi>|\<psi>>))\<rfloor>"
  sledgehammer (* timed out*)
  nitpick (* counterexample found *)
  oops

lemma assumes "reflexivity" "Ferrers"
  shows  DR: "\<forall>\<phi> \<psi> \<chi>.\<lfloor>\<circle><\<chi>|(\<phi>\<^bold>\<or>\<psi>)>\<^bold>\<rightarrow>((\<circle><\<chi>|\<phi>>)\<^bold>\<or>(\<circle><\<chi>|\<psi>>))\<rfloor>"
  sledgehammer (* proof found *)
  nitpick (* no counterexample found *)
  oops

lemma assumes DR: "\<lfloor>\<circle><\<chi>|\<phi>\<^bold>\<or>\<psi>>\<^bold>\<rightarrow>(\<circle><\<chi>|\<phi>>\<^bold>\<or>\<circle><\<chi>|\<psi>>)\<rfloor>"
   shows "reflexivity"
   sledgehammer (* timed out*)
   nitpick [show_all] (* counterexample found *)
   oops

lemma assumes DR: "\<lfloor>\<circle><\<chi>|\<phi>\<^bold>\<or>\<psi>>\<^bold>\<rightarrow>(\<circle><\<chi>|\<phi>>\<^bold>\<or>\<circle><\<chi>|\<psi>>)\<rfloor>"
  shows "Ferrers"
  sledgehammer (* timed out*)
  nitpick (* counterexample found *)
  oops

text \<open>Transitivity and totalness corresponds to the Spohn axiom (Sp)\<close>

lemma assumes "transitivity"
  shows  Sp: "\<lfloor>( P<\<psi>|\<phi>> \<^bold>\<and> \<circle><(\<psi>\<^bold>\<rightarrow>\<chi>)|\<phi>>) \<^bold>\<rightarrow> \<circle><\<chi>|(\<phi>\<^bold>\<and>\<psi>)>\<rfloor>"
  sledgehammer (* timed out *)
  nitpick (* counterexample for card i=5*)
  oops

lemma assumes "totalness"
  shows  Sp: "\<lfloor>( P<\<psi>|\<phi>> \<^bold>\<and> \<circle><(\<psi>\<^bold>\<rightarrow>\<chi>)|\<phi>>) \<^bold>\<rightarrow> \<circle><\<chi>|(\<phi>\<^bold>\<and>\<psi>)>\<rfloor>"
  sledgehammer (* timed out*)
  nitpick (* counterexample for card i=4*)
  oops

lemma assumes "transitivity" "totalness"
  shows  Sp: "\<lfloor>( P<\<psi>|\<phi>> \<^bold>\<and> \<circle><(\<psi>\<^bold>\<rightarrow>\<chi>)|\<phi>>) \<^bold>\<rightarrow> \<circle><\<chi>|(\<phi>\<^bold>\<and>\<psi>)>\<rfloor>"
  sledgehammer (* proof found *)
  nitpick (* no counterexample found *)
  oops

lemma assumes  Sp: "\<lfloor>( P<\<psi>|\<phi>> \<^bold>\<and> \<circle><(\<psi>\<^bold>\<rightarrow>\<chi>)|\<phi>>) \<^bold>\<rightarrow> \<circle><\<chi>|(\<phi>\<^bold>\<and>\<psi>)>\<rfloor>"
  shows "totalness"
  sledgehammer (* timed out*)
  nitpick (* counterexample found for card i=1*)
  oops

lemma assumes  Sp: "\<lfloor>( P<\<psi>|\<phi>> \<^bold>\<and> \<circle><(\<psi>\<^bold>\<rightarrow>\<chi>)|\<phi>>) \<^bold>\<rightarrow> \<circle><\<chi>|(\<phi>\<^bold>\<and>\<psi>)>\<rfloor>"
      shows "transitivity"
  sledgehammer (* timed out*)
  nitpick (* counterexample found for card =4*)
  oops

subsection \<open>Correspondance under the opt rule\<close>

text \<open>We move to the opt rule, and associate with it two news modal operators\<close>

text \<open>Here we redefine Lewis's limit assumption accordingly\<close>

text \<open>Correspondance\<close>

text \<open>opt-Limitedness corresponds to D\<close>

lemma assumes "olimitedness"
  shows  D: "\<lfloor>\<diamond>\<phi> \<^bold>\<rightarrow> \<odot><\<psi>|\<phi>> \<^bold>\<rightarrow> \
<\<psi>|\<phi>>\<rfloor>"
  sledgehammer (* timed out*)
  nitpick (* counterexample found *)
  oops
lemma assumes D: "\<lfloor>\<diamond>\<phi> \<^bold>\<rightarrow> \<odot><\<psi>|\<phi>> \<^bold>\<rightarrow> \
<\<psi>|\<phi>>\<rfloor>"
  shows "olimitedness"
  sledgehammer (* timed out*)oops
  nitpick (* counterexample found *)
  oops

text \<open>Smoothness corresponds to CM\<close>

lemma assumes "msmoothness"
  shows  CM: "\<lfloor>(\<odot><\<psi>|\<phi>>\<^bold>\<and>\<odot><\<chi>|\<phi>>)\<^bold>\<rightarrow> \<odot><\<chi>|\<phi>\<^bold>\<and>\<psi>>\<rfloor>"
  sledgehammer (* timed out*)
  nitpick (* counterexample found *)
  oops

lemma assumes CM: "\<lfloor>(\<odot><\<psi>|\<phi>>\<^bold>\<and>\<odot><\<chi>|\<phi>>)\<^bold>\<rightarrow> \<odot><\<chi>|\<phi>\<^bold>\<and>\<psi>>\<rfloor>"
  shows  "msmoothness"
  sledgehammer (* timed out*)
  nitpick (* counterexample found *)
  oops

lemma assumes "totalness"
     (* assumes "Ferrers"*)
  shows  DR: "\<lfloor>\<odot><\<chi>|\<phi>\<^bold>\<or>\<psi>>\<^bold>\<rightarrow>(\<odot><\<chi>|\<phi>>\<^bold>\<or>\<odot><\<chi>|\<psi>>)\<rfloor>"
  sledgehammer (* timed out*)
  nitpick (* counterexample found *)
  oops

 lemma assumes DR: "\<lfloor>\<odot><\<chi>|\<phi>\<^bold>\<or>\<psi>>\<^bold>\<rightarrow>(\<odot><\<chi>|\<phi>>\<^bold>\<or>\<odot><\<chi>|\<psi>>)\<rfloor>"
   shows "totalness"
   sledgehammer (* timed out*)
   nitpick (* counterexample found *)
   oops

lemma assumes DR: "\<lfloor>\<odot><\<chi>|\<phi>\<^bold>\<or>\<psi>>\<^bold>\<rightarrow>(\<odot><\<chi>|\<phi>>\<^bold>\<or>\<odot><\<chi>|\<psi>>)\<rfloor>"
  shows "Ferrers"
  sledgehammer (* timed out*)
  nitpick (* counterexample found *)
  oops

(*transitivity*)

lemma assumes "transitivity"
  shows  Sp: "\<lfloor>( \
<\<psi>|\<phi>> \<^bold>\<and> \<odot><(\<psi>\<^bold>\<rightarrow>\<chi>)|\<phi>>) \<^bold>\<rightarrow> \<odot><\<chi>|(\<phi>\<^bold>\<and>\<psi>)>\<rfloor>"
  sledgehammer (* proof found *)
  nitpick (* no counterexample found *)
  oops

lemma assumes "transitivity"
  shows  Trans: "\<lfloor>(\
<\<phi>|\<phi>\<^bold>\<or>\<psi>> \<^bold>\<and> \
<\<psi>|\<psi>\<^bold>\<or>\<xi>>)\<^bold>\<rightarrow>\
<\<phi>|\<phi>\<^bold>\<or>\<xi>>\<rfloor>"
  sledgehammer (* proof found *)
  nitpick [show_all] (* no counterexample found *)
  oops

lemma assumes Sp: "\<lfloor>( \
<\<psi>|\<phi>> \<^bold>\<and> \<odot><(\<psi>\<^bold>\<rightarrow>\<chi>)|\<phi>>) \<^bold>\<rightarrow> \<odot><\<chi>|(\<phi>\<^bold>\<and>\<psi>)>\<rfloor>"
      assumes Trans: "\<lfloor>(\
<\<phi>|\<phi>\<^bold>\<or>\<psi>> \<^bold>\<and> \
<\<psi>|\<psi>\<^bold>\<or>\<xi>>)\<^bold>\<rightarrow>\
<\<phi>|\<phi>\<^bold>\<or>\<xi>>\<rfloor>"
      shows "transitivity"
  sledgehammer (* timed out*)
  nitpick (* counterexample found for card i =3*)
  oops

subsection \<open>Closure maximality and Lewis rule\<close>

 text \<open>Under the Lewis rule, totalness corresponds to D \<close>

(*deontic explosion-max rule*)
lemma DEX: "\<lfloor>(\<circle><\<psi>|\<phi>>\<^bold>\<and>\<circle><\<^bold>\<not>\<psi>|\<phi>>)\<^bold>\<rightarrow> \<circle><\<chi>|\<phi>>\<rfloor>" oops
(*proof found*)

(*no-deontic explosion-lewis rule*)
lemma DEX: "\<lfloor>(\<circ><\<psi>|\<phi>>\<^bold>\<and>\<circ><\<^bold>\<not>\<psi>|\<phi>>)\<^bold>\<rightarrow> \<circ><\<chi>|\<phi>>\<rfloor>"
  sledgehammer (*timed out*)
  nitpick (*counter-model found for card i = 3*) oops

lemma assumes "mlimitedness"
  assumes "transitivity"
  assumes "totalness"
  shows "\<lfloor>\<circ><\<psi>|\<phi>>\<^bold>\<leftrightarrow>\<odot><\<psi>|\<phi>>\<rfloor>"
      sledgehammer [isar_proofs, timeout = 120] oops (*proof found*)

lemma assumes "mlimitedness"
  assumes "transitivity"
  assumes "totalness"
 shows "\<lfloor>\<circ><\<psi>|\<phi>>\<^bold>\<leftrightarrow>\<circle><\<psi>|\<phi>>\<rfloor>"
      sledgehammer (*proof found*)

lemma
 assumes "totalness"
 shows D : "\<lfloor>\<diamond>\<phi> \<^bold>\<rightarrow> (\<circ><\<psi>|\<phi>> \<^bold>\<rightarrow>\
<\<psi>|\<phi>>)\<rfloor>"
  sledgehammer (* proof found *)
  nitpick (* no counterexample found *)
  oops

lemma
  assumes  D : "\<lfloor>\<diamond>\<phi> \<^bold>\<rightarrow> (\<circ><\<psi>|\<phi>> \<^bold>\<rightarrow>\
<\<psi>|\<phi>>)\<rfloor>"
  shows "totalness"
  sledgehammer (* timed out*)
  nitpick (* counterexample found *)
  oops

section \<open>Negative results\<close>

text \<open>Under the max and opt rules there is no formula corresponding to reflexivity\<close>

(*ToDO not sure how to do it--something like there is no A such that "reflexivity <\<Rightarrow> A"*)

text \<open>Under the max and opt rules there is no formula corresponding to totalness\<close>

(*ToDO*)

text \<open>Under the max rule there is no formula corresponding to transitivity\<close>

(*ToDO*)

text \<open>Under the max rule there is no formula corresponding to a-cyclicity\<close>

(*ToDO*)

text \<open>Under the max rule there is no formula corresponding to Suzumura consistency\<close>

(*ToDO*)

text \<open>Under the Lewis rule there is no formula corresponding to limitedness/smoothness\<close>

section \<open>Some open problems\<close>

text \<open>Under the opt rule transitivity alone is equivalent to Sp and Trans\<close>

lemma assumes "transitivity"
  shows  Sp: "\<lfloor>( \
<\<psi>|\<phi>> \<^bold>\<and> \<odot><(\<psi>\<^bold>\<rightarrow>\<chi>)|\<phi>>) \<^bold>\<rightarrow> \<odot><\<chi>|(\<phi>\<^bold>\<and>\<psi>)>\<rfloor>"
  sledgehammer (* proof found *)
  nitpick (* no counterexample found *)
  oops

lemma assumes "transitivity"
  shows  Trans: "\<lfloor>(\
<\<phi>|\<phi>\<^bold>\<or>\<psi>> \<^bold>\<and> \
<\<xi>|\<psi>\<^bold>\<or>\<xi>>)\<^bold>\<rightarrow>\
<\<xi>|\<phi>\<^bold>\<or>\<xi>>\<rfloor>"
  sledgehammer (* proof found *)
  nitpick (* no counterexample found *)
  oops

lemma assumes Sp: "\<lfloor>( \
<\<psi>|\<phi>> \<^bold>\<and> \<odot><(\<psi>\<^bold>\<rightarrow>\<chi>)|\<phi>>) \<^bold>\<rightarrow> \<odot><\<chi>|(\<phi>\<^bold>\<and>\<psi>)>\<rfloor>"
      assumes Trans: "\<lfloor>(\
<\<phi>|\<phi>\<^bold>\<or>\<psi>> \<^bold>\<and> \
<\<xi>|\<psi>\<^bold>\<or>\<xi>>)\<^bold>\<rightarrow>\
<\<xi>|\<phi>\<^bold>\<or>\<xi>>\<rfloor>"
      shows "transitivity"
  sledgehammer (* timed out*)
  nitpick (* counterexample found *)
  oops

  text \<open>Under the opt rule quasi-transitivity, a-cyclicity and Suzumura consistent do not correspond to
any formula\<close>

(*to do*)

text \<open>Under the opt rule transitivity alone is equivalent to Sp and Trans\<close>


(* Author: Lukas Bulwahn, TU Muenchen *)

section \<open>Depth-Limited Sequences with failure element\<close>

theory Limited_Sequence
imports Lazy_Sequence
begin

subsection \<open>Depth-Limited Sequence\<close>

type_synonym 'a dseq = "natural \<Rightarrow> bool \<Rightarrow> 'a lazy_sequence option"

definition empty :: "'a dseq"
where
  "empty = (\<lambda>_ _. Some Lazy_Sequence.empty)"

definition single :: "'a \<Rightarrow> 'a dseq"
where
  "single x = (\<lambda>_ _. Some (Lazy_Sequence.single x))"

definition eval :: "'a dseq \<Rightarrow> natural \<Rightarrow> bool \<Rightarrow> 'a lazy_sequence option"
where
  [simp]: "eval f i pol = f i pol"

definition yield :: "'a dseq \<Rightarrow> natural \<Rightarrow> bool \<Rightarrow> ('a \<times> 'a dseq) option"
where
  "yield f i pol = (case eval f i pol of
    None \<Rightarrow> None
  | Some s \<Rightarrow> (map_option \<circ> apsnd) (\<lambda>r _ _. Some r) (Lazy_Sequence.yield s))"

definition map_seq :: "('a \<Rightarrow> 'b dseq) \<Rightarrow> 'a lazy_sequence \<Rightarrow> 'b dseq"
where
  "map_seq f xq i pol = map_option Lazy_Sequence.flat
    (Lazy_Sequence.those (Lazy_Sequence.map (\<lambda>x. f x i pol) xq))"

lemma map_seq_code [code]:
  "map_seq f xq i pol = (case Lazy_Sequence.yield xq of
    None \<Rightarrow> Some Lazy_Sequence.empty
  | Some (x, xq') \<Rightarrow> (case eval (f x) i pol of
      None \<Rightarrow> None
    | Some yq \<Rightarrow> (case map_seq f xq' i pol of
        None \<Rightarrow> None
      | Some zq \<Rightarrow> Some (Lazy_Sequence.append yq zq))))"
  by (cases xq)
    (auto simp add: map_seq_def Lazy_Sequence.those_def lazy_sequence_eq_iff split: list.splits option.splits)

definition bind :: "'a dseq \<Rightarrow> ('a \<Rightarrow> 'b dseq) \<Rightarrow> 'b dseq"
where
  "bind x f = (\<lambda>i pol.
     if i = 0 then
       (if pol then Some Lazy_Sequence.empty else None)
     else
       (case x (i - 1) pol of
         None \<Rightarrow> None
       | Some xq \<Rightarrow> map_seq f xq i pol))"

definition union :: "'a dseq \<Rightarrow> 'a dseq \<Rightarrow> 'a dseq"
where
  "union x y = (\<lambda>i pol. case (x i pol, y i pol) of
      (Some xq, Some yq) \<Rightarrow> Some (Lazy_Sequence.append xq yq)
    | _ \<Rightarrow> None)"

definition if_seq :: "bool \<Rightarrow> unit dseq"
where
  "if_seq b = (if b then single () else empty)"

definition not_seq :: "unit dseq \<Rightarrow> unit dseq"
where
  "not_seq x = (\<lambda>i pol. case x i (\<not> pol) of
    None \<Rightarrow> Some Lazy_Sequence.empty
  | Some xq \<Rightarrow> (case Lazy_Sequence.yield xq of
      None \<Rightarrow> Some (Lazy_Sequence.single ())
    | Some _ \<Rightarrow> Some (Lazy_Sequence.empty)))"

definition map :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a dseq \<Rightarrow> 'b dseq"
where
  "map f g = (\<lambda>i pol. case g i pol of
     None \<Rightarrow> None
   | Some xq \<Rightarrow> Some (Lazy_Sequence.map f xq))"

subsection \<open>Positive Depth-Limited Sequence\<close>

type_synonym 'a pos_dseq = "natural \<Rightarrow> 'a Lazy_Sequence.lazy_sequence"

definition pos_empty :: "'a pos_dseq"
where
  "pos_empty = (\<lambda>i. Lazy_Sequence.empty)"

definition pos_single :: "'a \<Rightarrow> 'a pos_dseq"
where
  "pos_single x = (\<lambda>i. Lazy_Sequence.single x)"

definition pos_bind :: "'a pos_dseq \<Rightarrow> ('a \<Rightarrow> 'b pos_dseq) \<Rightarrow> 'b pos_dseq"
where
  "pos_bind x f = (\<lambda>i. Lazy_Sequence.bind (x i) (\<lambda>a. f a i))"

definition pos_decr_bind :: "'a pos_dseq \<Rightarrow> ('a \<Rightarrow> 'b pos_dseq) \<Rightarrow> 'b pos_dseq"
where
  "pos_decr_bind x f = (\<lambda>i.
     if i = 0 then
       Lazy_Sequence.empty
     else
       Lazy_Sequence.bind (x (i - 1)) (\<lambda>a. f a i))"

definition pos_union :: "'a pos_dseq \<Rightarrow> 'a pos_dseq \<Rightarrow> 'a pos_dseq"
where
  "pos_union xq yq = (\<lambda>i. Lazy_Sequence.append (xq i) (yq i))"

definition pos_if_seq :: "bool \<Rightarrow> unit pos_dseq"
where
  "pos_if_seq b = (if b then pos_single () else pos_empty)"

definition pos_iterate_upto :: "(natural \<Rightarrow> 'a) \<Rightarrow> natural \<Rightarrow> natural \<Rightarrow> 'a pos_dseq"
where
  "pos_iterate_upto f n m = (\<lambda>i. Lazy_Sequence.iterate_upto f n m)"

definition pos_map :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a pos_dseq \<Rightarrow> 'b pos_dseq"
where
  "pos_map f xq = (\<lambda>i. Lazy_Sequence.map f (xq i))"

subsection \<open>Negative Depth-Limited Sequence\<close>

type_synonym 'a neg_dseq = "natural \<Rightarrow> 'a Lazy_Sequence.hit_bound_lazy_sequence"

definition neg_empty :: "'a neg_dseq"
where
  "neg_empty = (\<lambda>i. Lazy_Sequence.empty)"

definition neg_single :: "'a \<Rightarrow> 'a neg_dseq"
where
  "neg_single x = (\<lambda>i. Lazy_Sequence.hb_single x)"

definition neg_bind :: "'a neg_dseq \<Rightarrow> ('a \<Rightarrow> 'b neg_dseq) \<Rightarrow> 'b neg_dseq"
where
  "neg_bind x f = (\<lambda>i. hb_bind (x i) (\<lambda>a. f a i))"

definition neg_decr_bind :: "'a neg_dseq \<Rightarrow> ('a \<Rightarrow> 'b neg_dseq) \<Rightarrow> 'b neg_dseq"
where
  "neg_decr_bind x f = (\<lambda>i.
     if i = 0 then
       Lazy_Sequence.hit_bound
     else
       hb_bind (x (i - 1)) (\<lambda>a. f a i))"

definition neg_union :: "'a neg_dseq \<Rightarrow> 'a neg_dseq \<Rightarrow> 'a neg_dseq"
where
  "neg_union x y = (\<lambda>i. Lazy_Sequence.append (x i) (y i))"

definition neg_if_seq :: "bool \<Rightarrow> unit neg_dseq"
where
  "neg_if_seq b = (if b then neg_single () else neg_empty)"

definition neg_iterate_upto
where
  "neg_iterate_upto f n m = (\<lambda>i. Lazy_Sequence.iterate_upto (\<lambda>i. Some (f i)) n m)"

definition neg_map :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a neg_dseq \<Rightarrow> 'b neg_dseq"
where
  "neg_map f xq = (\<lambda>i. Lazy_Sequence.hb_map f (xq i))"

subsection \<open>Negation\<close>

definition pos_not_seq :: "unit neg_dseq \<Rightarrow> unit pos_dseq"
where
  "pos_not_seq xq = (\<lambda>i. Lazy_Sequence.hb_not_seq (xq (3 * i)))"

definition neg_not_seq :: "unit pos_dseq \<Rightarrow> unit neg_dseq"
where
  "neg_not_seq x = (\<lambda>i. case Lazy_Sequence.yield (x i) of
    None \<Rightarrow> Lazy_Sequence.hb_single ()
  | Some ((), xq) \<Rightarrow> Lazy_Sequence.empty)"

ML \<open>
signature LIMITED_SEQUENCE =
sig
  type 'a dseq = Code_Numeral.natural -> bool -> 'a Lazy_Sequence.lazy_sequence option
  val map : ('a -> 'b) -> 'a dseq -> 'b dseq
  val yield : 'a dseq -> Code_Numeral.natural -> bool -> ('a * 'a dseq) option
  val yieldn : int -> 'a dseq -> Code_Numeral.natural -> bool -> 'a list * 'a dseq
end;

structure Limited_Sequence : LIMITED_SEQUENCE =
struct

type 'a dseq = Code_Numeral.natural -> bool -> 'a Lazy_Sequence.lazy_sequence option

fun map f = @{code Limited_Sequence.map} f;

fun yield f = @{code Limited_Sequence.yield} f;

fun yieldn n f i pol = (case f i pol of
    NONE => ([], fn _ => fn _ => NONE)
  | SOME s => let val (xs, s') = Lazy_Sequence.yieldn n s in (xs, fn _ => fn _ => SOME s') end);

end;
\<close>

code_reserved Eval Limited_Sequence

hide_const (open) yield empty single eval map_seq bind union if_seq not_seq map
  pos_empty pos_single pos_bind pos_decr_bind pos_union pos_if_seq pos_iterate_upto pos_not_seq pos_map
  neg_empty neg_single neg_bind neg_decr_bind neg_union neg_if_seq neg_iterate_upto neg_not_seq neg_map

hide_fact (open) yield_def empty_def single_def eval_def map_seq_def bind_def union_def
  if_seq_def not_seq_def map_def
  pos_empty_def pos_single_def pos_bind_def pos_union_def pos_if_seq_def pos_iterate_upto_def pos_not_seq_def pos_map_def
  neg_empty_def neg_single_def neg_bind_def neg_union_def neg_if_seq_def neg_iterate_upto_def neg_not_seq_def neg_map_def

end


section\<open>Abstract ITE Implementation\<close>
theory Abstract_Impl
imports BDT
        "$AFP/Automatic_Refinement/Lib/Refine_Lib"
        Option_Helpers
begin

datatype ('a, 'ni) IFEXD = TD | FD | IFD 'a 'ni 'ni

locale bdd_impl_pre =
  fixes R :: "'s \<Rightarrow> ('ni \<times> ('a :: linorder) ifex) set"
  fixes I :: "'s \<Rightarrow> bool"
begin
  definition les:: "'s \<Rightarrow> 's \<Rightarrow> bool" where
  "les s s' == \<forall>ni n. (ni, n) \<in> R s \<longrightarrow> (ni, n) \<in> R s'"
end

locale bdd_impl = bdd_impl_pre R for R :: "'s \<Rightarrow> ('ni \<times> ('a :: linorder) ifex) set" +
  fixes Timpl :: "'s \<rightharpoonup> ('ni \<times> 's)"
  fixes Fimpl :: "'s \<rightharpoonup> ('ni \<times> 's)"
  fixes IFimpl :: "'a \<Rightarrow> 'ni \<Rightarrow> 'ni \<Rightarrow> 's \<rightharpoonup> ('ni \<times> 's)"
  fixes DESTRimpl :: "'ni  \<Rightarrow> 's \<rightharpoonup> ('a, 'ni) IFEXD"

  assumes Timpl_rule: "I s \<Longrightarrow> ospec (Timpl s) (\<lambda>(ni, s'). (ni, Trueif) \<in> R s' \<and> I s' \<and> les s s')"
  assumes Fimpl_rule: "I s \<Longrightarrow> ospec (Fimpl s) (\<lambda>(ni, s'). (ni, Falseif) \<in> R s' \<and> I s' \<and> les s s')"
  assumes IFimpl_rule: "\<lbrakk>I s; (ni1,n1) \<in> R s;(ni2,n2) \<in> R s\<rbrakk>
                        \<Longrightarrow> ospec (IFimpl v ni1 ni2 s) (\<lambda>(ni, s'). (ni, IFC v n1 n2) \<in> R s' \<and> I s' \<and> les s s')"

  assumes DESTRimpl_rule1: "I s \<Longrightarrow> (ni, Trueif) \<in> R s \<Longrightarrow> ospec (DESTRimpl ni s) (\<lambda>r. r = TD)"
  assumes DESTRimpl_rule2: "I s \<Longrightarrow> (ni, Falseif) \<in> R s \<Longrightarrow> ospec (DESTRimpl ni s) (\<lambda>r. r = FD)"
  assumes DESTRimpl_rule3: "I s \<Longrightarrow> (ni, IF v n1 n2) \<in> R s \<Longrightarrow>
                            ospec (DESTRimpl ni s)
                                  (\<lambda>r. \<exists>ni1 ni2. r = (IFD v ni1 ni2) \<and> (ni1, n1) \<in> R s \<and> (ni2, n2) \<in> R s)"
begin

lemma les_refl[simp,intro!]:"les s s" by (auto simp add: les_def)
lemma les_trans[trans]:"les s1 s2 \<Longrightarrow> les s2 s3 \<Longrightarrow> les s1 s3" by (auto simp add: les_def)
lemmas DESTRimpl_rules = DESTRimpl_rule1 DESTRimpl_rule2 DESTRimpl_rule3

lemma DESTRimpl_rule_useless:
  "I s \<Longrightarrow> (ni, n) \<in> R s \<Longrightarrow> ospec (DESTRimpl ni s) (\<lambda>r. (case r of
    TD \<Rightarrow> (ni, Trueif) \<in> R s |
    FD \<Rightarrow> (ni, Falseif) \<in> R s |
    IFD v nt ne \<Rightarrow> (\<exists>t e. n = IF v t e \<and> (ni, IF v t e) \<in> R s)))"
by(cases n; clarify; drule (1) DESTRimpl_rules; drule ospecD2; clarsimp)
lemma DESTRimpl_rule:
  "I s \<Longrightarrow> (ni, n) \<in> R s \<Longrightarrow> ospec (DESTRimpl ni s) (\<lambda>r. (case n of
    Trueif \<Rightarrow> r = TD |
    Falseif \<Rightarrow> r = FD |
    IF v t e \<Rightarrow> (\<exists>tn en. r = IFD v tn en \<and> (tn,t) \<in> R s \<and> (en,e) \<in> R s)))"
by(cases n; clarify; drule (1) DESTRimpl_rules; drule ospecD2; clarsimp)

definition "case_ifexi fti ffi fii ni s \<equiv> do {
  dest \<leftarrow> DESTRimpl ni s;
  case dest of
    TD \<Rightarrow> fti s
  | FD \<Rightarrow> ffi s
  | IFD v ti ei \<Rightarrow> fii v ti ei s}"

lemma case_ifexi_rule:
  assumes INV: "I s"
  assumes NI: "(ni,n)\<in>R s"
  assumes FTI: "\<lbrakk> n = Trueif \<rbrakk> \<Longrightarrow> ospec (fti s) (\<lambda>(r,s'). (r,ft) \<in> Q s \<and> I' s')"
  assumes FFI: "\<lbrakk> n = Falseif \<rbrakk> \<Longrightarrow> ospec (ffi s) (\<lambda>(r,s'). (r,ff) \<in> Q s \<and> I' s')"
  assumes FII: "\<And>ti ei v t e. \<lbrakk> n = IF v t e; (ti,t)\<in>R s; (ei,e)\<in>R s \<rbrakk> \<Longrightarrow> ospec (fii v ti ei s) (\<lambda>(r,s'). (r,fi v t e) \<in> Q s \<and> I' s')"
  shows "ospec (case_ifexi fti ffi fii ni s) (\<lambda>(r,s'). (r,case_ifex ft ff fi n) \<in> Q s \<and> I' s')"
  unfolding case_ifexi_def
  apply (cases n)
    subgoal
      apply (rule obind_rule)
       apply (rule DESTRimpl_rule1[OF INV])
       using NI FTI by (auto)
    subgoal
      apply (rule obind_rule)
       apply (rule DESTRimpl_rule2[OF INV])
       using NI FFI by (auto)
    subgoal
      apply (rule obind_rule)
       apply (rule DESTRimpl_rule3[OF INV])
       using NI FII by (auto)
done

abbreviation "return x \<equiv> \<lambda>s. Some (x,s)"

primrec lowest_tops_impl where
"lowest_tops_impl [] s = Some (None,s)" |
"lowest_tops_impl (e#es) s =
    case_ifexi
      (\<lambda>s. lowest_tops_impl es s)
      (\<lambda>s. lowest_tops_impl es s)
      (\<lambda>v t e s. do {
      (rec,s) \<leftarrow> lowest_tops_impl es s;
        (case rec of
          Some u \<Rightarrow> Some ((Some (min u v)), s) |
          None \<Rightarrow> Some ((Some v), s))
       }) e s"

declare lowest_tops_impl.simps[simp del]

fun lowest_tops_alt where
"lowest_tops_alt [] = None" |
"lowest_tops_alt (e#es) = (
    let rec = lowest_tops_alt es in
    case_ifex
      rec
      rec
      (\<lambda>v t e. (case rec of
          Some u \<Rightarrow> (Some (min u v)) |
          None \<Rightarrow> (Some v))
       ) e
  )"

lemma lowest_tops_alt: "lowest_tops l = lowest_tops_alt l"
  by (induction l rule: lowest_tops.induct) (auto split: option.splits simp: lowest_tops.simps)

lemma lowest_tops_impl_R:
  assumes "list_all2 (in_rel (R s)) li l" "I s"
  shows "ospec (lowest_tops_impl li s) (\<lambda>(r,s'). r = lowest_tops l \<and> s'=s)"
  unfolding lowest_tops_alt
  using assms apply (induction rule: list_all2_induct)
   subgoal by (simp add: lowest_tops_impl.simps)
   subgoal
     apply (simp add: lowest_tops_impl.simps)
     apply (rule case_ifexi_rule[where Q="\<lambda>s. Id", unfolded pair_in_Id_conv])
      apply assumption+
     apply (rule obind_rule)
      apply assumption
     apply (clarsimp split: option.splits)
    done
  done

definition restrict_top_impl where
"restrict_top_impl e vr vl s =
  case_ifexi
    (return e)
    (return e)
    (\<lambda>v te ee. return (if v = vr then (if vl then te else ee) else e))
    e s
  "

lemma restrict_top_alt: "restrict_top n var val = (case n of
  (IF v t e) \<Rightarrow> (if v = var then (if val then t else e) else (IF v t e))
| _ \<Rightarrow> n)"
  apply (induction n var val rule: restrict_top.induct)
  apply (simp_all)
  done

lemma restrict_top_impl_spec: "I s \<Longrightarrow> (ni,n) \<in> R s \<Longrightarrow> ospec (restrict_top_impl ni vr vl s) (\<lambda>(res,s'). (res, restrict_top n vr vl) \<in> R s \<and> s'=s)"
  unfolding restrict_top_impl_def restrict_top_alt
  by (rule case_ifexi_rule[where I'="\<lambda>s'. s'=s" and Q="R", simplified]) auto

partial_function(option) ite_impl where
"ite_impl i t e s = do {
  (lt,_) \<leftarrow> lowest_tops_impl [i, t, e] s;
  (case lt of
    Some a \<Rightarrow> do {
      (ti,_) \<leftarrow> restrict_top_impl i a True s;
      (tt,_) \<leftarrow> restrict_top_impl t a True s;
      (te,_) \<leftarrow> restrict_top_impl e a True s;
      (fi,_) \<leftarrow> restrict_top_impl i a False s;
      (ft,_) \<leftarrow> restrict_top_impl t a False s;
      (fe,_) \<leftarrow> restrict_top_impl e a False s;
      (tb,s) \<leftarrow> ite_impl ti tt te s;
      (fb,s) \<leftarrow> ite_impl fi ft fe s;
      IFimpl a tb fb s}
  | None \<Rightarrow> case_ifexi (\<lambda>_.(Some (t,s))) (\<lambda>_.(Some (e,s))) (\<lambda>_ _ _ _. None) i s
)}"

lemma ite_impl_R: "I s
       \<Longrightarrow> in_rel (R s) ii i \<Longrightarrow> in_rel (R s) ti t \<Longrightarrow> in_rel (R s) ei e
       \<Longrightarrow> ospec (ite_impl ii ti ei s) (\<lambda>(r, s'). (r, ifex_ite i t e) \<in> R s' \<and> I s' \<and> les s s')"
proof(induction i t e arbitrary: s ii ti ei rule: ifex_ite.induct, goal_cases)
  case (1 i t e s ii ti ei) note goal1 = 1
  have la2: "list_all2 (in_rel (R s)) [ii,ti,ei] [i,t,e]" using goal1(4-6) by simp
  show ?case proof(cases "lowest_tops [i,t,e]")
    case None from goal1(3-6) show ?thesis
        apply(subst ite_impl.simps)
        apply(rule obind_rule[where Q="\<lambda>(r, s'). r = lowest_tops [i,t,e] \<and> s'=s"])
         apply(rule ospec_cons)
          apply(rule lowest_tops_impl_R[OF la2])
          apply(assumption)
         apply(clarsimp split: prod.splits)
        apply(simp add: None split: prod.splits)
        apply(clarsimp)
        apply(rule ospec_cons)
         apply(rule case_ifexi_rule[where I'="\<lambda>s'. s'=s"])
        using None by (auto split: prod.splits ifex.splits simp: lowest_tops.simps)
    next
    case (Some lv)
      note mIH = goal1(1,2)[OF Some]
      from goal1(3-6) show ?thesis
        apply(subst ite_impl.simps)
        apply(rule obind_rule[where Q="\<lambda>(r, s'). r = lowest_tops [i,t,e]"])
         apply(rule ospec_cons)
          apply(rule lowest_tops_impl_R[OF la2])
          apply(assumption)
         apply(clarsimp split: prod.splits)
        apply(simp add: Some split: prod.splits)
        apply(clarsimp)
        (* take care of all those restrict_tops *)
        apply(rule obind_rule, rule restrict_top_impl_spec, assumption+, clarsimp split: prod.splits)+
        apply(rule obind_rule)
         apply(rule mIH(1))
            apply(simp;fail)+
        apply(clarsimp)
        apply(rule obind_rule)
         apply(rule mIH(2))
            apply(simp add: les_def;fail)+
        apply(simp split: prod.splits)
        apply(rule ospec_cons)
         apply(rule IFimpl_rule)
           apply(simp add: les_def;fail)+
           using les_def les_trans by blast+
    qed
qed

lemma case_ifexi_mono[partial_function_mono]:
  assumes [partial_function_mono]:
    "mono_option (\<lambda>F. fti F s)"
    "mono_option (\<lambda>F. ffi F s)"
    "\<And>x31 x32 x33. mono_option (\<lambda>F. fii F x31 x32 x33 s)"
  shows "mono_option (\<lambda>F. case_ifexi (fti F) (ffi F) (fii F) ni s)"
  unfolding case_ifexi_def by (tactic \<open>Partial_Function.mono_tac @{context} 1\<close>)

partial_function(option) val_impl :: "'ni \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> 's \<Rightarrow> (bool\<times>'s) option"
where
"val_impl e ass s = case_ifexi
  (\<lambda>s. Some (True,s))
  (\<lambda>s. Some (False,s))
  (\<lambda>v t e s. val_impl (if ass v then t else e) ass s)
  e  s"

lemma "I s \<Longrightarrow> (ni,n) \<in> R s \<Longrightarrow> ospec (val_impl ni ass s) (\<lambda>(r,s'). r = (val_ifex n ass) \<and> s'=s)"
  apply (induction n arbitrary: ni)
  subgoal
   apply (subst val_impl.simps)
   apply (rule ospec_cons)
    apply (rule case_ifexi_rule[where I'="\<lambda>s'. s'=s" and Q="\<lambda>s. Id"]; assumption?)
      by auto
  subgoal
   apply (subst val_impl.simps)
   apply (rule ospec_cons)
    apply (rule case_ifexi_rule[where I'="\<lambda>s'. s'=s" and Q="\<lambda>s. Id"]; assumption?)
      by auto
  subgoal
   apply (subst val_impl.simps)
   apply (subst val_ifex.simps)
   apply (clarsimp; intro impI conjI)
    apply (rule ospec_cons)
     apply (rule case_ifexi_rule[where I'="\<lambda>s'. s'=s" and Q="\<lambda>s. Id"]; assumption?)
       apply (simp; fail)
      apply (simp; fail)
     apply (rule ospec_cons)
      apply (rprems; simp; fail)
     apply (simp; fail)
    apply (simp; fail)
   apply (rule ospec_cons)
    apply (rule case_ifexi_rule[where I'="\<lambda>s'. s'=s" and Q="\<lambda>s. Id"]; assumption?)
      apply (simp; fail)
     apply (simp; fail)
    apply(simp)
    apply (rule ospec_cons)
     apply (rprems; simp; fail)
    apply (simp; fail)
   apply (simp; fail)
   done
  done

end

locale bdd_impl_cmp_pre = bdd_impl_pre
begin

definition "map_invar_impl m s =
  (\<forall>ii ti ei ri. m (ii,ti,ei) = Some ri \<longrightarrow>
  (\<exists>i t e. ((ri,ifex_ite_opt i t e) \<in> R s) \<and> (ii,i) \<in> R s \<and> (ti,t) \<in> R s \<and> (ei,e) \<in> R s))"

lemma map_invar_impl_les: "map_invar_impl m s \<Longrightarrow> les s s' \<Longrightarrow> map_invar_impl m s'"
  unfolding map_invar_impl_def bdd_impl_pre.les_def by blast

lemma map_invar_impl_update: "map_invar_impl m s \<Longrightarrow>
       (ii,i) \<in> R s \<Longrightarrow> (ti,t) \<in> R s \<Longrightarrow> (ei,e) \<in> R s \<Longrightarrow>
       (ri, ifex_ite_opt i t e) \<in> R s \<Longrightarrow> map_invar_impl (m((ii,ti,ei) \<mapsto> ri)) s"
unfolding map_invar_impl_def by auto

end

locale bdd_impl_cmp = bdd_impl + bdd_impl_cmp_pre +
  fixes M :: "'a \<Rightarrow> ('b \<times> 'b \<times> 'b) \<Rightarrow> 'b option"
  fixes U :: "'a \<Rightarrow> ('b \<times> 'b \<times> 'b) \<Rightarrow> 'b \<Rightarrow> 'a"
  fixes cmp :: "'b \<Rightarrow> 'b \<Rightarrow> bool"
  assumes cmp_rule1: "I s \<Longrightarrow> (ni, i) \<in> R s \<Longrightarrow> (ni', i) \<in> R s \<Longrightarrow> cmp ni ni'"
  assumes cmp_rule2: "I s \<Longrightarrow> cmp ni ni' \<Longrightarrow> (ni, i) \<in> R s \<Longrightarrow> (ni', i') \<in> R s \<Longrightarrow> i = i'"
  assumes map_invar_rule1: "I s \<Longrightarrow> map_invar_impl (M s) s"
  assumes map_invar_rule2: "I s \<Longrightarrow> (ii,it) \<in> R s \<Longrightarrow> (ti,tt) \<in> R s \<Longrightarrow> (ei,et) \<in> R s \<Longrightarrow>
                            (ri, ifex_ite_opt it tt et) \<in> R s \<Longrightarrow> U s (ii,ti,ei) ri = s' \<Longrightarrow>
                            I s'"
  assumes map_invar_rule3: "I s \<Longrightarrow> R (U s (ii, ti, ei) ri) = R s"
begin

lemma cmp_rule_eq: "I s \<Longrightarrow>  (ni, i) \<in> R s \<Longrightarrow> (ni', i') \<in> R s \<Longrightarrow> cmp ni ni' \<longleftrightarrow> i = i'"
  using cmp_rule1 cmp_rule2 by force

lemma DESTRimpl_Some: "I s \<Longrightarrow> (ni, i) \<in> R s \<Longrightarrow> ospec (DESTRimpl ni s) (\<lambda>r. True)"
  apply(cases i)
    apply(auto intro: ospec_cons dest: DESTRimpl_rules)
done

fun param_opt_impl where
  "param_opt_impl i t e s =  do {
    ii \<leftarrow> DESTRimpl i s;
    ti \<leftarrow> DESTRimpl t s;
    ei \<leftarrow> DESTRimpl e s;
    (tn,s) \<leftarrow> Timpl s;
    (fn,s) \<leftarrow> Fimpl s;
    Some ((if ii = TD then Some t else
    if ii = FD then Some e else
    if ti = TD \<and> ei = FD then Some i else
    if cmp t e then Some t else
    if ei = TD \<and> cmp i t then Some tn else
    if ti = FD \<and> cmp i e then Some fn else
    None), s)}"

declare param_opt_impl.simps[simp del]

lemma param_opt_impl_lesI:
  assumes "I s" "(ii,i) \<in> R s" "(ti,t) \<in> R s" "(ei,e) \<in> R s"
  shows "ospec (param_opt_impl ii ti ei s)
               (\<lambda>(r,s'). I s' \<and> les s s')"
  using assms apply(subst param_opt_impl.simps)
  by (auto simp add: param_opt_def les_def intro!: obind_rule
                dest: DESTRimpl_Some Timpl_rule Fimpl_rule)

lemma param_opt_impl_R:
  assumes "I s" "(ii,i) \<in> R s" "(ti,t) \<in> R s" "(ei,e) \<in> R s"
  shows "ospec (param_opt_impl ii ti ei s)
               (\<lambda>(r,s'). case r of None \<Rightarrow> param_opt i t e = None
                                 | Some r \<Rightarrow> (\<exists>r'. param_opt i t e  = Some r' \<and> (r, r') \<in> R s'))"
  using assms apply(subst param_opt_impl.simps)
  apply(rule obind_rule)
   apply(rule DESTRimpl_rule; assumption)
  apply(rule obind_rule)
   apply(rule DESTRimpl_rule; assumption)
  apply(rule obind_rule)
   apply(rule DESTRimpl_rule; assumption)
  apply(rule obind_rule)
   apply(rule Timpl_rule; assumption)
  apply(safe)
  apply(rule obind_rule)
   apply(rule Fimpl_rule; assumption)
  by (auto simp add: param_opt_def les_def cmp_rule_eq split: ifex.splits)

partial_function(option) ite_impl_opt where
"ite_impl_opt i t e s = do {
  (ld, s) \<leftarrow>  param_opt_impl i t e s;
  (case ld of Some b \<Rightarrow> Some (b, s) |
  None \<Rightarrow>
  do {
  (lt,_) \<leftarrow> lowest_tops_impl [i, t, e] s;
  (case lt of
    Some a \<Rightarrow> do {
      (ti,_) \<leftarrow> restrict_top_impl i a True s;
      (tt,_) \<leftarrow> restrict_top_impl t a True s;
      (te,_) \<leftarrow> restrict_top_impl e a True s;
      (fi,_) \<leftarrow> restrict_top_impl i a False s;
      (ft,_) \<leftarrow> restrict_top_impl t a False s;
      (fe,_) \<leftarrow> restrict_top_impl e a False s;
      (tb,s) \<leftarrow> ite_impl_opt ti tt te s;
      (fb,s) \<leftarrow> ite_impl_opt fi ft fe s;
      IFimpl a tb fb s}
  | None \<Rightarrow> case_ifexi (\<lambda>_.(Some (t,s))) (\<lambda>_.(Some (e,s))) (\<lambda>_ _ _ _. None) i s
)})}"

lemma ospec_and: "ospec f P \<Longrightarrow> ospec f Q \<Longrightarrow> ospec f (\<lambda>x. P x \<and> Q x)"
  using ospecD2 by force

lemma ite_impl_opt_R: "
  I s
  \<Longrightarrow> in_rel (R s) ii i \<Longrightarrow> in_rel (R s) ti t \<Longrightarrow> in_rel (R s) ei e
  \<Longrightarrow> ospec (ite_impl_opt ii ti ei s) (\<lambda>(r, s'). (r, ifex_ite_opt i t e) \<in> R s' \<and> I s' \<and> les s s')"
proof(induction i t e arbitrary: s ii ti ei rule: ifex_ite_opt.induct, goal_cases)
  note ifex_ite_opt.simps[simp del] restrict_top.simps[simp del]
  case (1 i t e s ii ti ei) note goal1 = 1
  have la2: "list_all2 (in_rel (R s)) [ii,ti,ei] [i,t,e]" using goal1(4-6) by simp
  note mIH = goal1(1,2)
  from goal1(3-6) show ?case
    apply(cases "param_opt i t e")
     defer
     apply(subst ite_impl_opt.simps)
      apply(rule obind_rule)
       apply(rule ospec_and[OF param_opt_impl_R param_opt_impl_lesI])
             apply(auto simp add: les_def ifex_ite_opt.simps split: option.splits)[9]
    (* param_opt i t e = None *)
    apply(frule param_opt_lowest_tops_lem)
    apply(clarsimp)
    apply(subst ite_impl_opt.simps)
     apply(rule obind_rule)
     apply(rule ospec_and[OF param_opt_impl_R param_opt_impl_lesI])
            apply(auto split: option.splits)[8]
    apply(clarsimp split: option.splits)
    apply(rule obind_rule[where Q="\<lambda>(r, s'). r = lowest_tops [i,t,e]"])
     apply(rule ospec_cons)
      apply(rule lowest_tops_impl_R)
       using les_def apply(fastforce)
      apply(assumption)
     apply(fastforce)
    using BDT.param_opt_lowest_tops_lem apply(clarsimp split: prod.splits)
    (* take care of all those restrict_tops *)
    apply(rule obind_rule, rule restrict_top_impl_spec, assumption, auto simp add: les_def split: prod.splits)+
    apply(rule obind_rule)
     apply(rule mIH(1))
          apply(simp add: les_def;fail)+
    apply(clarsimp)
     apply(rule obind_rule)
     apply(rule mIH(2))
          apply(simp add: les_def;fail)+
    apply(simp add: ifex_ite_opt.simps split: prod.splits)
    apply(rule ospec_cons)
     apply(rule IFimpl_rule)
       apply(auto simp add: les_def;fail)+
    done
qed

partial_function(option) ite_impl_lu where
"ite_impl_lu i t e s = do {
  (case M s (i,t,e) of Some b \<Rightarrow> Some (b,s) | None \<Rightarrow> do {
  (ld, s) \<leftarrow>  param_opt_impl i t e s;
  (case ld of Some b \<Rightarrow> Some (b, s) |
  None \<Rightarrow>
  do {
  (lt,_) \<leftarrow> lowest_tops_impl [i, t, e] s;
  (case lt of
    Some a \<Rightarrow> do {
      (ti,_) \<leftarrow> restrict_top_impl i a True s;
      (tt,_) \<leftarrow> restrict_top_impl t a True s;
      (te,_) \<leftarrow> restrict_top_impl e a True s;
      (fi,_) \<leftarrow> restrict_top_impl i a False s;
      (ft,_) \<leftarrow> restrict_top_impl t a False s;
      (fe,_) \<leftarrow> restrict_top_impl e a False s;
      (tb,s) \<leftarrow> ite_impl_lu ti tt te s;
      (fb,s) \<leftarrow> ite_impl_lu fi ft fe s;
      (r,s) \<leftarrow> IFimpl a tb fb s;
      let s = U s (i,t,e) r;
      Some (r,s)
      } |
    None \<Rightarrow> None
)})})}"

declare ifex_ite_opt.simps[simp del]

lemma ite_impl_lu_R: "I s
       \<Longrightarrow> (ii,i) \<in> R s \<Longrightarrow> (ti,t) \<in> R s \<Longrightarrow> (ei,e) \<in> R s
       \<Longrightarrow> ospec (ite_impl_lu ii ti ei s)
                 (\<lambda>(r, s'). (r, ifex_ite_opt i t e) \<in> R s' \<and> I s' \<and> les s s')"
proof(induction i t e arbitrary: s ii ti ei rule: ifex_ite_opt.induct, goal_cases)
  note restrict_top.simps[simp del]
  case (1 i t e s ii ti ei) note goal1 = 1
  have la2: "list_all2 (in_rel (R s)) [ii,ti,ei] [i,t,e]" using goal1(4-6) by simp
  note mIH = goal1(1,2)
  from goal1(3-6) show ?case
    apply(subst ite_impl_lu.simps)
    apply(cases "M s (ii, ti, ei)")
     defer
     (* M s (ii, ti, ei) = Some a *)
     apply(frule map_invar_rule1)
     apply(simp only: option.simps ospec.simps prod.simps simp_thms les_refl)
     apply(subst (asm) map_invar_impl_def)
     apply(erule allE[where x = ii])
     apply(erule allE[where x = ti])
     apply(erule allE[where x = ei])
     apply(rename_tac a)
     apply(erule_tac x = a in allE)
     apply(metis cmp_rule_eq)
    (* M s (ii, ti, ei) = Some a *)
    apply(clarsimp)
    apply(cases "param_opt i t e")
     defer
     (* param_opt i t e = Some a *)
     apply(rule obind_rule)
      apply(rule ospec_and[OF param_opt_impl_R param_opt_impl_lesI])
             apply(auto simp add: map_invar_impl_les ifex_ite_opt.simps  split: option.splits)[9]
    (* param_opt i t e = None *)
    apply(frule param_opt_lowest_tops_lem)
    apply(clarsimp)
    apply(rule obind_rule)
     apply(rule ospec_and[OF param_opt_impl_R param_opt_impl_lesI])
             apply(auto split: option.splits)[8]
    apply(clarsimp split: option.splits)
    apply(rule_tac obind_rule[where Q="\<lambda>(r, s'). r = lowest_tops [i,t,e]"])
     apply(rule ospec_cons)
      apply(rule lowest_tops_impl_R)
       using les_def apply(fastforce)
      apply(assumption)
     apply(fastforce)
    using BDT.param_opt_lowest_tops_lem apply(clarsimp split: prod.splits)
    apply(rule obind_rule, rule restrict_top_impl_spec, assumption+, auto simp add: les_def split: prod.splits)+
    apply(rule obind_rule)
     apply(rule mIH(1))
          apply(simp add: map_invar_impl_les les_def;fail)+
    apply(clarsimp)
    apply(rule obind_rule)
     apply(rule mIH(2))
          apply(simp add: map_invar_impl_les les_def;fail)+
    apply(simp add: ifex_ite_opt.simps split: prod.splits)
    apply(rule obind_rule)
     apply(rule IFimpl_rule)
       apply(simp)
      apply(auto simp add: les_def)[2]
    apply(clarsimp simp add: les_def)
    apply(safe)
    using map_invar_rule3 apply(presburger)
     apply(rule map_invar_rule2)
          prefer 6 apply(blast)
         apply(blast)
        apply(blast)
       apply(blast)
      apply(blast)
     apply(clarsimp simp add: ifex_ite_opt.simps)
    using map_invar_rule3 by presburger
qed

(* I could move this stuff into one of the not-so-strong locales. But for what? *)
partial_function(option) sat_list_impl where
"sat_list_impl ex s = do {
  d \<leftarrow> DESTRimpl ex s;
  case d of
    FD \<Rightarrow> Some None |
    TD \<Rightarrow> Some (Some []) |
    IFD v t e \<Rightarrow> do {
      rece \<leftarrow> sat_list_impl e s;
      case rece of
        Some a \<Rightarrow> Some (Some ((v,False)#a)) |
        None \<Rightarrow> do {
          rect \<leftarrow> sat_list_impl t s;
          Some (case rect of
            Some a \<Rightarrow> Some ((v,True)#a) |
            None \<Rightarrow> None)
        }
      }
}"

lemma sat_list_impl_spec: "I s \<Longrightarrow> (ni,n) \<in> R s \<Longrightarrow> ospec (sat_list_impl ni s) (\<lambda>rl. rl = ifex_sat_list n)"
  apply(induction n arbitrary: ni rule: ifex_sat_list.induct)
    apply(auto simp add: sat_list_impl.simps intro: obind_rule elim: DESTRimpl_rule1 DESTRimpl_rule2)[2]
  apply(subst sat_list_impl.simps)
  apply(auto intro!: obind_rule elim: DESTRimpl_rule3)
   apply(rprems)
   apply(assumption)
  apply(split option.splits)
  apply(intro conjI[rotated])
   apply(simp;fail)
  apply(clarsimp)
  apply(auto intro!: obind_rule elim: DESTRimpl_rule3)
done

fun sat_list_to_bdd where
"sat_list_to_bdd [] s = Timpl s" |
"sat_list_to_bdd ((v,u)#us) s = do {
  (r,s) \<leftarrow> sat_list_to_bdd us s;
  (f,s) \<leftarrow> Fimpl s;
  (if u then IFimpl v r f s else IFimpl v f r s)
}
"

lemma lesI: "(a,b) \<in> R s \<Longrightarrow> les s s' \<Longrightarrow> (a,b) \<in> R s'" unfolding les_def by simp

lemma sat_list_to_bdd_spec: "I s \<Longrightarrow> ospec (sat_list_to_bdd u s) (\<lambda>(r,s'). I s' \<and> (r, sat_list_to_bdt u) \<in> R s' \<and> les s s')"
  apply(induction arbitrary: s rule: sat_list_to_bdt.induct)
   apply(auto intro: obind_rule elim: Timpl_rule[THEN ospec_cons])[1]
  apply(subst sat_list_to_bdd.simps)
  apply(intro obind_rule)
   apply(subgoal_tac "ospec (sat_list_to_bdd us s) (\<lambda>(r, s'). I s' \<and> (r, sat_list_to_bdt us) \<in> R s' \<and> les s s')") (* the things you do if rprems doesn't work\<dots> *)
    apply(assumption)
   subgoal by auto
  apply(clarify)
  apply(intro obind_rule)
  apply(erule Fimpl_rule)
  apply(clarsimp; intro conjI; clarify)
  (* * *)
   apply(rule ospec_cons)
    apply(erule IFimpl_rule)
     apply(erule (1) lesI)
    apply(erule lesI)
    apply(rule les_refl;fail)
   apply(clarify)
   apply(auto simp add: IFC_def)[1]
   apply((erule les_trans)+, rule les_refl; fail)
  (* it is nearly the same reasoning again as from * *)
  apply(rule ospec_cons)
   apply(erule IFimpl_rule)
    apply(erule lesI; rule les_refl;fail)
   apply(((erule lesI)+, assumption | rule les_refl); fail)
  apply(auto simp add: IFC_def)
  apply((erule les_trans)+, rule les_refl; fail)
done

partial_function(option) sat_list_cover_impl where
"sat_list_cover_impl e s = do {
  sl1 \<leftarrow> sat_list_impl e s;
  (case sl1 of
      None \<Rightarrow> Some ([],s) |
      Some l \<Rightarrow> do {
        (le,s) \<leftarrow> sat_list_to_bdd l s;
        (f,s) \<leftarrow> Fimpl s;
        (lm,s) \<leftarrow> ite_impl_lu le f e s;
        (rec,s) \<leftarrow> sat_list_cover_impl lm s;
        Some ((l # rec),s)
      }
  )
}"

lemma sat_list_cover_impl_spec: "ro_ifex n (* børk *) \<Longrightarrow> I s \<Longrightarrow> (ni,n) \<in> R s \<Longrightarrow> ospec (sat_list_cover_impl ni s) (\<lambda>(rl,s'). rl = ifex_sat_list_cover n \<and> I s' \<and> les s s')"
  apply(induction n arbitrary: ni s rule: ifex_sat_list_cover.induct)
  apply(subst sat_list_cover_impl.simps)
  apply(rule obind_rule)
   apply(erule (1) sat_list_impl_spec)
  apply(split option.splits)
  apply(intro conjI)
   apply(simp;fail)
  apply(clarify, intro obind_rule)
   apply(erule sat_list_to_bdd_spec)
  apply(clarify, intro obind_rule)
   apply(erule Fimpl_rule)
  apply(clarify, intro obind_rule)
   apply(erule ite_impl_lu_R)
   apply(auto elim: lesI les_trans)[3]
  apply(clarify, intro obind_rule)
   apply(rprems)
         apply(clarify;fail)
        apply(assumption)
       apply(rule refl, rule refl)
     apply(meson ifex_minimal.simps(3) ifex_ordered.simps(3) minimal_ifex_ite_invar order_ifex_ite_invar sat_list_to_bdt_minimal sat_list_to_bdt_ordered) (* TODO: make a rule for this *)
    apply(assumption)
   apply(simp add: ifex_ite_opt_eq sat_list_to_bdt_minimal sat_list_to_bdt_ordered) (* and for this? *)
  apply(clarify)
  apply(rule oreturn_rule)
  apply(clarify)
  apply(intro conjI[rotated])
    apply(elim les_trans; rule les_refl; fail)
   apply(assumption)
  apply(simp)
done

end
end