diff --git a/admin/jenkins/ci_build_all.scala b/admin/jenkins/ci_build_all.scala
--- a/admin/jenkins/ci_build_all.scala
+++ b/admin/jenkins/ci_build_all.scala
@@ -1,257 +1,257 @@
 object profile extends isabelle.CI_Profile
 {
   import isabelle._
   import java.io.FileReader
   import scala.sys.process._
   import org.apache.commons.configuration2._
 
   override def clean = false
 
   val afp = Path.explode("$AFP_BASE")
   val afp_thys = afp + Path.explode("thys")
   val afp_id = hg_id(afp)
 
   sealed abstract class Status(val str: String)
   {
     def merge(that: Status): Status = (this, that) match {
       case (Ok, s) => s
       case (Failed, s) => Failed
       case (Skipped, Failed) => Failed
       case (Skipped, s) => Skipped
     }
   }
   object Status
   {
     def merge(statuses: List[Status]): Status =
       statuses.foldLeft(Ok: Status)(_ merge _)
 
     def from_results(results: Build.Results, session: String): Status =
       if (results.cancelled(session))
         Skipped
       else if (results(session).ok)
         Ok
       else
         Failed
   }
 
   case object Ok extends Status("ok")
   case object Skipped extends Status("skipped")
   case object Failed extends Status("failed")
 
   case class Mail(subject: String, recipients: List[String], text: String) {
     import java.util._
     import javax.mail._
     import javax.mail.internet._
     import javax.activation._
 
     def send(): Unit = {
       val authenticator = new Authenticator() {
         override def getPasswordAuthentication() =
           new PasswordAuthentication(System.getProperty("mail.smtp.user"), System.getProperty("mail.smtp.password"))
       }
 
       val session = Session.getDefaultInstance(System.getProperties(), authenticator)
       val message = new MimeMessage(session)
       message.setFrom(new InternetAddress("ci@isabelle.systems", "Isabelle/Jenkins"))
       message.setSender(new InternetAddress("ge73ruk@mytum.de"))
       message.setSubject(subject)
       message.setText(text, "UTF-8")
       message.setSentDate(new java.util.Date())
 
       recipients.foreach { recipient =>
         message.addRecipient(Message.RecipientType.TO, new InternetAddress(recipient))
       }
 
       try {
         Transport.send(message)
       }
       catch {
         case ex: MessagingException => println(s"Sending mail failed: ${ex.getMessage}")
       }
     }
   }
 
   class Metadata(ini: INIConfiguration)
   {
 
     def maintainers(entry: String): List[String] =
     {
       val config = ini.getSection(entry)
       val raw =
         if (config.containsKey("notify"))
           config.getString("notify")
         else
           ""
       List(raw.split(','): _*).map(_.trim).filterNot(_.isEmpty)
     }
 
     def entry_of_session(info: Sessions.Info): Option[String] =
       if (info.dir.dir.file == afp_thys.file)
         Some(info.dir.base.implode)
       else
         None
 
     def notify(name: String, result: Process_Result, info: Sessions.Info): Unit =
       entry_of_session(info).foreach { entry =>
         val mails = maintainers(entry)
 
         val text =
           s"""|The build for the session
               |  $name,
               |belonging to the AFP entry
               |  $entry
               |failed.
               |
               |You are receiving this mail because you are the maintainer of that AFP
               |entry.
               |
               |The following information might help you with resolving the problem.
               |
               |Build log:    ${Isabelle_System.getenv("BUILD_URL")}
               |Isabelle ID:  $isabelle_id
               |AFP ID:       $afp_id
               |Timeout?      ${result.timeout}
               |Exit code:    ${result.rc}
               |
               |Last 50 lines from stdout (if available):
               |
               |${result.out_lines.takeRight(50).mkString("\n")}
               |
               |Last 50 lines from stderr (if available):
               |
               |${result.err_lines.takeRight(50).mkString("\n")}
               |""".stripMargin
 
         val subject = s"Build of AFP entry $entry failed"
 
         if (mails.isEmpty)
           println(s"Entry $entry: WARNING no maintainers specified")
         else
           Mail(text = text, subject = subject, recipients = mails).send()
       }
 
     def group_by_entry(results: Build.Results): Map[Option[String], List[String]] =
       results.sessions.toList.map { name =>
         entry_of_session(results.info(name)) -> name
-      }.groupBy(_._1).mapValues(_.map(_._2))
+      }.groupBy(_._1).view.mapValues(_.map(_._2)).toMap
 
     def status_as_json(status: Map[Option[String], Status]): String =
     {
       val entries_strings = status.collect {
         case (Some(entry), status) =>
           s"""{"entry": "$entry", "status": "${status.str}"}"""
       }
 
       val entries_string = entries_strings.mkString("[", ",\n", "]")
 
       s"""
         {"build_data":
           {"isabelle_id": "$isabelle_id",
            "afp_id": "$afp_id",
            "time": "$start_time",
            "url": "${Isabelle_System.getenv("BUILD_URL")}",
            "job": "${Isabelle_System.getenv("JOB_NAME")}"
           },
          "entries":
            $entries_string
         }
       """
     }
 
     def status_as_html(status: Map[Option[String], Status]): String =
     {
       val entries_strings = status.collect {
         case (None, Failed) =>
           s"<li>Distribution</li>"
         case (Some(entry), Failed) =>
           s"""<li><a href="https://devel.isa-afp.org/entries/$entry.html">$entry</a></li>"""
       }
 
       if (entries_strings.isEmpty)
         ""
       else
         entries_strings.mkString("Failed entries: <ul>", "\n", "</ul>")
     }
   }
 
   val status_file = Path.explode("$ISABELLE_HOME/status.json").file
   val report_file = Path.explode("$ISABELLE_HOME/report.html").file
   val deps_file = Path.explode("$ISABELLE_HOME/dependencies.json").file
   def can_send_mails = System.getProperties().containsKey("mail.smtp.host")
 
   def include = List(afp_thys)
   def select = Nil
 
   def pre_hook(args: List[String]) =
   {
     println(s"AFP id $afp_id")
     if (status_file.exists())
       status_file.delete()
     if (report_file.exists())
       report_file.delete()
 
     File.write(report_file, "")
 
     if (!can_send_mails)
       println(s"Mail configuration not found.")
   }
 
   def post_hook(results: Build.Results) =
   {
     print_section("DEPENDENCIES")
     println("Generating dependencies file ...")
     val result = Isabelle_System.bash("isabelle afp_dependencies")
     result.check
     println("Writing dependencies file ...")
     File.write(deps_file, result.out)
 
     val metadata = {
       val path = afp + Path.explode("metadata/metadata")
       val ini = new INIConfiguration()
       if (path.is_file) {
         val reader = new FileReader(path.file)
         ini.read(reader)
         reader.close()
       }
       new Metadata(ini)
     }
 
     val status =
-      metadata.group_by_entry(results).mapValues { sessions =>
+      metadata.group_by_entry(results).view.mapValues { sessions =>
         Status.merge(sessions.map(Status.from_results(results, _)))
-      }
+      }.toMap
 
     print_section("REPORT")
     println("Writing report file ...")
     File.write(report_file, metadata.status_as_html(status))
 
     print_section("SITEGEN")
     println("Writing status file ...")
     File.write(status_file, metadata.status_as_json(status))
     println("Running sitegen ...")
 
     val script = afp + Path.explode("admin/sitegen-devel")
     val sitegen_result = List(script.file.toString, status_file.toString, deps_file.toString).!
     if (sitegen_result > 0)
       println("sitegen failed")
 
     if (!results.ok)
     {
       print_section("NOTIFICATIONS")
       for (name <- results.sessions)
       {
         val result = results(name)
         if (!result.ok && !results.cancelled(name) && can_send_mails)
           metadata.notify(name, result, results.info(name))
       }
     }
 
     print_section("COMPLETED")
   }
 
   def selection =
     Sessions.Selection(
       all_sessions = true,
       exclude_session_groups = List("slow"))
 
 }
diff --git a/admin/jenkins/ci_build_testboard.scala b/admin/jenkins/ci_build_testboard.scala
--- a/admin/jenkins/ci_build_testboard.scala
+++ b/admin/jenkins/ci_build_testboard.scala
@@ -1,114 +1,114 @@
 object profile extends isabelle.CI_Profile
 {
   import isabelle._
   import java.io.FileReader
   import scala.sys.process._
   import org.apache.commons.configuration2._
 
   override def clean = false
 
   val afp = Path.explode("$AFP_BASE")
   val afp_thys = afp + Path.explode("thys")
   val afp_id = hg_id(afp)
 
   sealed abstract class Status(val str: String)
   {
     def merge(that: Status): Status = (this, that) match {
       case (Ok, s) => s
       case (Failed, s) => Failed
       case (Skipped, Failed) => Failed
       case (Skipped, s) => Skipped
     }
   }
   object Status
   {
     def merge(statuses: List[Status]): Status =
       statuses.foldLeft(Ok: Status)(_ merge _)
 
     def from_results(results: Build.Results, session: String): Status =
       if (results.cancelled(session))
         Skipped
       else if (results(session).ok)
         Ok
       else
         Failed
   }
 
   case object Ok extends Status("ok")
   case object Skipped extends Status("skipped")
   case object Failed extends Status("failed")
 
   class Metadata(ini: INIConfiguration)
   {
 
     def entry_of_session(info: Sessions.Info): Option[String] =
       if (info.dir.dir.file == afp_thys.file)
         Some(info.dir.base.implode)
       else
         None
 
     def group_by_entry(results: Build.Results): Map[Option[String], List[String]] =
       results.sessions.toList.map { name =>
         entry_of_session(results.info(name)) -> name
-      }.groupBy(_._1).mapValues(_.map(_._2))
+      }.groupBy(_._1).view.mapValues(_.map(_._2)).toMap
 
     def status_as_html(status: Map[Option[String], Status]): String =
     {
       val entries_strings = status.collect {
         case (None, Failed) =>
           s"<li>Distribution</li>"
         case (Some(entry), Failed) =>
           s"""<li><a href="https://devel.isa-afp.org/entries/$entry.html">$entry</a></li>"""
       }
 
       if (entries_strings.isEmpty)
         ""
       else
         entries_strings.mkString("Failed entries: <ul>", "\n", "</ul>")
     }
   }
 
   val report_file = Path.explode("$ISABELLE_HOME/report.html").file
 
   def include = List(afp_thys)
   def select = Nil
 
   def pre_hook(args: List[String]) =
   {
     println(s"AFP id $afp_id")
     if (report_file.exists())
       report_file.delete()
 
     File.write(report_file, "")
   }
 
   def post_hook(results: Build.Results) =
   {
     val metadata = {
       val path = afp + Path.explode("metadata/metadata")
       val ini = new INIConfiguration()
       if (path.is_file) {
         val reader = new FileReader(path.file)
         ini.read(reader)
         reader.close()
       }
       new Metadata(ini)
     }
 
     val status =
-      metadata.group_by_entry(results).mapValues { sessions =>
+      metadata.group_by_entry(results).view.mapValues { sessions =>
         Status.merge(sessions.map(Status.from_results(results, _)))
-      }
+      }.toMap
 
     print_section("REPORT")
     println("Writing report file ...")
     File.write(report_file, metadata.status_as_html(status))
     print_section("COMPLETED")
   }
 
   def selection =
     Sessions.Selection(
       all_sessions = true,
       exclude_session_groups = List("slow"))
 
 }
diff --git a/thys/Complete_Non_Orders/Binary_Relations.thy b/thys/Complete_Non_Orders/Binary_Relations.thy
--- a/thys/Complete_Non_Orders/Binary_Relations.thy
+++ b/thys/Complete_Non_Orders/Binary_Relations.thy
@@ -1,992 +1,2245 @@
 (*
-Author:  Akihisa Yamada (2018-2019)
+Author:  Akihisa Yamada (2018-2021)
 License: LGPL (see file COPYING.LESSER)
 *)
 section \<open>Binary Relations\<close>
 
 text \<open>We start with basic properties of binary relations.\<close>
 
 theory Binary_Relations
-imports Main
-(* uses mainly concepts from the theories Complete_Partial_Order, Wellfounded, Partial_Function *)
+  imports
+(* To verify that we don't use the axiom of choice, import
+    HOL.Complete_Partial_Order HOL.Wellfounded
+   instead of *) Main
 begin
 
+lemma conj_imp_eq_imp_imp: "(P \<and> Q \<Longrightarrow> PROP R) \<equiv> (P \<Longrightarrow> Q \<Longrightarrow> PROP R)"
+  by standard simp_all
+
+lemma tranclp_trancl: "r\<^sup>+\<^sup>+ = (\<lambda>x y. (x,y) \<in> {(a,b). r a b}\<^sup>+)"
+  by (auto simp: tranclp_trancl_eq[symmetric])
+
+lemma tranclp_id[simp]: "transp r \<Longrightarrow> tranclp r = r"
+  using trancl_id[of "{(x,y). r x y}", folded transp_trans] by (auto simp:tranclp_trancl)
+
+lemma transp_tranclp[simp]: "transp (tranclp r)" by (auto simp: tranclp_trancl transp_trans)
+
+lemma funpow_dom: "f ` A \<subseteq> A \<Longrightarrow> (f^^n) ` A \<subseteq> A" by (induct n, auto)
+
 text \<open>Below we introduce an Isabelle-notation for $\{ \ldots x\ldots \mid x \in X \}$.\<close>
 
 syntax
-  "_range" :: "'a \<Rightarrow> pttrn \<Rightarrow> 'a set" ("(1{_ /|./ _})")
+  "_range" :: "'a \<Rightarrow> idts \<Rightarrow> 'a set" ("(1{_ /|./ _})")
   "_image" :: "'a \<Rightarrow> pttrn \<Rightarrow> 'a set \<Rightarrow> 'a set"  ("(1{_ /|./ (_/ \<in> _)})")
 translations
-  "{e |. p}" \<rightleftharpoons> "CONST range (\<lambda>p. e)"
+  "{e |. p}" \<rightleftharpoons> "{e | p. CONST True}"
   "{e |. p \<in> A}" \<rightleftharpoons> "CONST image (\<lambda>p. e) A"
 
 lemma image_constant:
   assumes "\<And>i. i \<in> I \<Longrightarrow> f i = y"
   shows "f ` I = (if I = {} then {} else {y})"
   using assms by auto
 
 
 subsection \<open>Various Definitions\<close>
 
 text \<open>Here we introduce various definitions for binary relations.
 The first one is our abbreviation for the dual of a relation.\<close>
 
 abbreviation(input) dual ("(_\<^sup>-)" [1000] 1000) where "r\<^sup>- x y \<equiv> r y x"
 
-lemma conversep_as_dual[simp]: "conversep r = r\<^sup>-" by auto
-
-text \<open>Monotonicity is already defined in the library.\<close>
-lemma monotone_dual: "monotone r s f \<Longrightarrow> monotone r\<^sup>- s\<^sup>- f"
-  by (auto simp: monotone_def)
-
-lemma monotone_id: "monotone r r id"
-  by (auto simp: monotone_def)
-
-text \<open>So is the chain, but it is somehow hidden. We reactivate it.\<close>
-abbreviation "chain \<equiv> Complete_Partial_Order.chain"
-
-context fixes r :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50) begin
-
-text \<open>Here we define the following notions in a standard manner:
-(upper) bounds of a set:\<close>
-definition "bound X b \<equiv> \<forall>x \<in> X. x \<sqsubseteq> b"
-
-lemma boundI[intro!]: "(\<And>x. x \<in> X \<Longrightarrow> x \<sqsubseteq> b) \<Longrightarrow> bound X b"
-  and boundE[elim]: "bound X b \<Longrightarrow> ((\<And>x. x \<in> X \<Longrightarrow> x \<sqsubseteq> b) \<Longrightarrow> thesis) \<Longrightarrow> thesis"
+lemma conversep_is_dual[simp]: "conversep = dual" by auto
+
+text \<open>Monotonicity is already defined in the library, but we want one restricted to a domain.\<close>
+
+definition "monotone_on X r s f \<equiv> \<forall>x y. x \<in> X \<longrightarrow> y \<in> X \<longrightarrow> r x y \<longrightarrow> s (f x) (f y)"
+
+lemmas monotone_onI = monotone_on_def[unfolded atomize_eq, THEN iffD2, rule_format]
+lemma monotone_onD: "monotone_on X r s f \<Longrightarrow> r x y \<Longrightarrow> x \<in> X \<Longrightarrow> y \<in> X \<Longrightarrow> s (f x) (f y)"
+  by (auto simp: monotone_on_def)
+
+lemmas monotone_onE = monotone_on_def[unfolded atomize_eq, THEN iffD1, elim_format, rule_format]
+
+lemma monotone_on_UNIV[simp]: "monotone_on UNIV = monotone"
+  by (intro ext, auto simp: monotone_on_def monotone_def)
+
+lemma monotone_on_dual: "monotone_on X r s f \<Longrightarrow> monotone_on X r\<^sup>- s\<^sup>- f"
+  by (auto simp: monotone_on_def)
+
+lemma monotone_on_id: "monotone_on X r r id"
+  by (auto simp: monotone_on_def)
+
+lemma monotone_on_cmono: "A \<subseteq> B \<Longrightarrow> monotone_on B \<le> monotone_on A"
+   by (intro le_funI, auto simp: monotone_on_def)
+
+text \<open>Here we define the following notions in a standard manner\<close>
+
+text \<open>The symmetric part of a relation:\<close>
+
+definition sympartp where "sympartp r x y \<equiv> r x y \<and> r y x"
+
+lemma sympartpI[intro]:
+  fixes r (infix "\<sqsubseteq>" 50)
+  assumes "x \<sqsubseteq> y" and "y \<sqsubseteq> x" shows "sympartp (\<sqsubseteq>) x y"
+  using assms by (auto simp: sympartp_def)
+
+lemma sympartpE[elim]:
+  fixes r (infix "\<sqsubseteq>" 50)
+  assumes "sympartp (\<sqsubseteq>) x y" and "x \<sqsubseteq> y \<Longrightarrow> y \<sqsubseteq> x \<Longrightarrow> thesis" shows thesis
+  using assms by (auto simp: sympartp_def)
+
+lemma sympartp_dual: "sympartp r\<^sup>- = sympartp r"
+  by (auto intro!:ext simp: sympartp_def)
+
+lemma sympartp_eq[simp]: "sympartp (=) = (=)" by auto
+
+lemma reflclp_sympartp[simp]: "(sympartp r)\<^sup>=\<^sup>= = sympartp r\<^sup>=\<^sup>=" by auto
+
+definition "equivpartp r x y \<equiv> x = y \<or> r x y \<and> r y x"
+
+lemma sympartp_reflclp_equivp[simp]: "sympartp r\<^sup>=\<^sup>= = equivpartp r" by (auto intro!:ext simp: equivpartp_def)
+
+lemma equivpartI[simp]: "equivpartp r x x"
+  and sympartp_equivpartpI: "sympartp r x y \<Longrightarrow> equivpartp r x y"
+  and equivpartpCI[intro]: "(x \<noteq> y \<Longrightarrow> sympartp r x y) \<Longrightarrow> equivpartp r x y"
+  by (auto simp:equivpartp_def)
+
+lemma equivpartpE[elim]:
+  assumes "equivpartp r x y"
+    and "x = y \<Longrightarrow> thesis"
+    and "r x y \<Longrightarrow> r y x \<Longrightarrow> thesis"
+  shows "thesis"
+  using assms by (auto simp: equivpartp_def)
+
+lemma equivpartp_eq[simp]: "equivpartp (=) = (=)" by auto
+
+lemma sympartp_equivpartp[simp]: "sympartp (equivpartp r) = (equivpartp r)"
+  and equivpartp_equivpartp[simp]: "equivpartp (equivpartp r) = (equivpartp r)"
+  and equivpartp_sympartp[simp]: "equivpartp (sympartp r) = (equivpartp r)"
+  by (auto 0 5 intro!:ext)
+
+lemma equivpartp_dual: "equivpartp r\<^sup>- = equivpartp r"
+  by (auto intro!:ext simp: equivpartp_def)
+
+text \<open>The asymmetric part:\<close>
+
+definition "asympartp r x y \<equiv> r x y \<and> \<not> r y x"
+
+lemma asympartpE[elim]:
+  fixes r (infix "\<sqsubseteq>" 50)
+  shows "asympartp (\<sqsubseteq>) x y \<Longrightarrow> (x \<sqsubseteq> y \<Longrightarrow> \<not>y \<sqsubseteq> x \<Longrightarrow> thesis) \<Longrightarrow> thesis"
+  by (auto simp: asympartp_def)
+
+lemmas asympartpI[intro] = asympartp_def[unfolded atomize_eq, THEN iffD2, unfolded conj_imp_eq_imp_imp, rule_format] 
+
+lemma asympartp_eq[simp]: "asympartp (=) = bot" by auto
+
+lemma asympartp_sympartp [simp]: "asympartp (sympartp r) = bot"
+  and sympartp_asympartp [simp]: "sympartp (asympartp r) = bot"
+  by (auto intro!: ext)
+
+text \<open>Restriction to a set:\<close>
+
+definition Restrp (infixl "\<restriction>" 60) where "(r \<restriction> A) a b \<equiv> a \<in> A \<and> b \<in> A \<and> r a b"
+
+lemmas RestrpI[intro!] = Restrp_def[unfolded atomize_eq, THEN iffD2, unfolded conj_imp_eq_imp_imp]
+lemmas RestrpE[elim!] = Restrp_def[unfolded atomize_eq, THEN iffD1, elim_format, unfolded conj_imp_eq_imp_imp]
+
+lemma Restrp_UNIV[simp]: "r \<restriction> UNIV \<equiv> r" by (auto simp: atomize_eq)
+
+lemma Restrp_Restrp[simp]: "r \<restriction> A \<restriction> B \<equiv> r \<restriction> A \<inter> B" by (auto simp: atomize_eq Restrp_def)
+
+lemma sympartp_Restrp[simp]: "sympartp (r \<restriction> A) \<equiv> sympartp r \<restriction> A"
+  by (auto simp: atomize_eq)
+
+text \<open>Relational images:\<close>
+definition Imagep (infixr "```" 59) where "r ``` A \<equiv> {b. \<exists>a \<in> A. r a b}"
+
+lemma Imagep_Image: "r ``` A = {(a,b). r a b} `` A"
+  by (auto simp: Imagep_def)
+
+lemma in_Imagep: "b \<in> r ``` A \<longleftrightarrow> (\<exists>a \<in> A. r a b)" by (auto simp: Imagep_def)
+
+lemma ImagepI: "a \<in> A \<Longrightarrow> r a b \<Longrightarrow> b \<in> r ``` A" by (auto simp: in_Imagep)
+
+lemma subset_Imagep: "B \<subseteq> r ``` A \<longleftrightarrow> (\<forall>b\<in>B. \<exists>a\<in>A. r a b)"
+  by (auto simp: Imagep_def)
+
+text \<open>Bounds of a set:\<close>
+definition "bound X r b \<equiv> \<forall>x \<in> X. r x b"
+
+lemma
+  fixes r (infix "\<sqsubseteq>" 50)
+  shows boundI[intro!]: "(\<And>x. x \<in> X \<Longrightarrow> x \<sqsubseteq> b) \<Longrightarrow> bound X (\<sqsubseteq>) b"
+    and boundE[elim]: "bound X (\<sqsubseteq>) b \<Longrightarrow> ((\<And>x. x \<in> X \<Longrightarrow> x \<sqsubseteq> b) \<Longrightarrow> thesis) \<Longrightarrow> thesis"
   by (auto simp: bound_def)
 
-lemma bound_empty: "bound {} = (\<lambda>x. True)" by auto
-lemma bound_insert[simp]: "bound (insert x X) b \<longleftrightarrow> x \<sqsubseteq> b \<and> bound X b" by auto
-
-lemma bound_cmono: assumes "X \<subseteq> Y" shows "bound Y x \<Longrightarrow> bound X x"
-  using assms by auto
+lemma bound_empty: "bound {} = (\<lambda>r x. True)" by auto
+
+lemma bound_insert[simp]:
+  fixes r (infix "\<sqsubseteq>" 50)
+  shows "bound (insert x X) (\<sqsubseteq>) b \<longleftrightarrow> x \<sqsubseteq> b \<and> bound X (\<sqsubseteq>) b" by auto
 
 text \<open>Extreme (greatest) elements in a set:\<close>
-definition "extreme X e \<equiv> e \<in> X \<and> (\<forall>x \<in> X. x \<sqsubseteq> e)"
-
-lemma extremeI[intro]: "e \<in> X \<Longrightarrow> (\<And>x. x \<in> X \<Longrightarrow> x \<sqsubseteq> e) \<Longrightarrow> extreme X e"
-  and extremeD: "extreme X e \<Longrightarrow> e \<in> X" "extreme X e \<Longrightarrow> (\<And>x. x \<in> X \<Longrightarrow> x \<sqsubseteq> e)"
-  and extremeE[elim]: "extreme X e \<Longrightarrow> (e \<in> X \<Longrightarrow> (\<And>x. x \<in> X \<Longrightarrow> x \<sqsubseteq> e) \<Longrightarrow> thesis) \<Longrightarrow> thesis"
+definition "extreme X r e \<equiv> e \<in> X \<and> (\<forall>x \<in> X. r x e)"
+
+lemma
+  fixes r (infix "\<sqsubseteq>" 50)
+  shows extremeI[intro]: "e \<in> X \<Longrightarrow> (\<And>x. x \<in> X \<Longrightarrow> x \<sqsubseteq> e) \<Longrightarrow> extreme X (\<sqsubseteq>) e"
+    and extremeD: "extreme X (\<sqsubseteq>) e \<Longrightarrow> e \<in> X" "extreme X (\<sqsubseteq>) e \<Longrightarrow> (\<And>x. x \<in> X \<Longrightarrow> x \<sqsubseteq> e)"
+    and extremeE[elim]: "extreme X (\<sqsubseteq>) e \<Longrightarrow> (e \<in> X \<Longrightarrow> (\<And>x. x \<in> X \<Longrightarrow> x \<sqsubseteq> e) \<Longrightarrow> thesis) \<Longrightarrow> thesis"
   by (auto simp: extreme_def)
 
-lemma extreme_UNIV[simp]: "extreme UNIV t \<longleftrightarrow> (\<forall>x. x \<sqsubseteq> t)" by auto
-
-lemma extremes_equiv: "extreme X b \<Longrightarrow> extreme X c \<Longrightarrow> b \<sqsubseteq> c \<and> c \<sqsubseteq> b" by auto
-
-text \<open>Directed sets:\<close>
-definition "directed X \<equiv> \<forall>x \<in> X. \<forall> y \<in> X. \<exists>z \<in> X. x \<sqsubseteq> z \<and> y \<sqsubseteq> z"
-
-lemma directedE:
-  assumes "directed X" and "x \<in> X" and "y \<in> X"
-    and "\<And>z. z \<in> X \<Longrightarrow> x \<sqsubseteq> z \<Longrightarrow> y \<sqsubseteq> z \<Longrightarrow> thesis"
-  shows "thesis"
-  using assms by (auto simp: directed_def)
-
-lemma directedI[intro]:
-  assumes "\<And>x y. x \<in> X \<Longrightarrow> y \<in> X \<Longrightarrow> \<exists>z \<in> X. x \<sqsubseteq> z \<and> y \<sqsubseteq> z"
-  shows "directed X" 
-  using assms by (auto simp: directed_def)
-
-lemma chain_imp_directed: "chain (\<sqsubseteq>) X \<Longrightarrow> directed X"
-  by (intro directedI, auto elim: chainE)
-
-text \<open>And sets of elements which are self-related:\<close>
-definition "reflexive_on X \<equiv> \<forall>x \<in> X. x \<sqsubseteq> x"
-
-lemma reflexive_onI[intro]:
-  assumes "\<And>x. x \<in> X \<Longrightarrow> x \<sqsubseteq> x" shows "reflexive_on X" using assms reflexive_on_def by auto
-
-lemma reflexive_onE[elim]:
-  assumes "reflexive_on X" and "(\<And>x. x \<in> X \<Longrightarrow> x \<sqsubseteq> x) \<Longrightarrow> thesis" shows thesis
-  using assms reflexive_on_def by auto
-
-lemma chain_imp_reflexive: "chain (\<sqsubseteq>) X \<Longrightarrow> reflexive_on X" by (auto elim: chainE)
-
-end
-
-context fixes r :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
+lemma
+  fixes r (infix "\<sqsubseteq>" 50)
+  shows extreme_UNIV[simp]: "extreme UNIV (\<sqsubseteq>) t \<longleftrightarrow> (\<forall>x. x \<sqsubseteq> t)" by auto
+
+lemma extremes_equiv: "extreme X r b \<Longrightarrow> extreme X r c \<Longrightarrow> sympartp r b c" by blast
+
+lemma bound_cmono: assumes "X \<subseteq> Y" shows "bound Y \<le> bound X"
+  using assms by auto
+
+lemma sympartp_sympartp[simp]: "sympartp (sympartp r) = sympartp r" by (auto intro!:ext)
+
+text \<open>Now suprema and infima are given uniformly as follows.
+  The definition is restricted to a given set.
+\<close>
+context
+  fixes A :: "'a set" and less_eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
 begin
 
-text \<open>Now suprema and infima are given uniformly as follows. \<close>
-abbreviation "extreme_bound X \<equiv> extreme (\<lambda>x y. y \<sqsubseteq> x) {b. bound (\<sqsubseteq>) X b}"
+abbreviation "extreme_bound X \<equiv> extreme {b \<in> A. bound X (\<sqsubseteq>) b} (\<lambda>x y. y \<sqsubseteq> x)"
 
 lemma extreme_boundI[intro]:
-  assumes "\<And>b. bound (\<sqsubseteq>) X b \<Longrightarrow> s \<sqsubseteq> b" and "\<And>x. x \<in> X \<Longrightarrow> x \<sqsubseteq> s"
+  assumes "\<And>b. bound X (\<sqsubseteq>) b \<Longrightarrow> b \<in> A \<Longrightarrow> s \<sqsubseteq> b" and "\<And>x. x \<in> X \<Longrightarrow> x \<sqsubseteq> s" and "s \<in> A"
   shows "extreme_bound X s"
   using assms by auto
 
+lemma extreme_bound_bound: "extreme_bound X y \<Longrightarrow> x \<in> X \<Longrightarrow> x \<sqsubseteq> y" by auto
+
 lemma extreme_bound_mono:
   assumes XY: "X \<subseteq> Y"
-    and bX: "extreme_bound X bX"
-    and bY: "extreme_bound Y bY"
-  shows "bX \<sqsubseteq> bY"
+    and sX: "extreme_bound X sX"
+    and sY: "extreme_bound Y sY"
+  shows "sX \<sqsubseteq> sY"
 proof-
-  have "bound (\<sqsubseteq>) X bY" using XY bY by force
-  with bX show ?thesis by auto
+  have "bound X (\<sqsubseteq>) sY" using XY sY by force
+  with sX sY show ?thesis by (auto 0 4)
 qed
 
 lemma extreme_bound_iff:
-  shows "extreme_bound X b \<longleftrightarrow> (\<forall>c. (\<forall>x\<in>X. x \<sqsubseteq> c) \<longrightarrow> b \<sqsubseteq> c) \<and> (\<forall>x \<in> X. x \<sqsubseteq> b)"
+  shows "extreme_bound X s \<longleftrightarrow> s \<in> A \<and> (\<forall>c \<in> A. (\<forall>x \<in> X. x \<sqsubseteq> c) \<longrightarrow> s \<sqsubseteq> c) \<and> (\<forall>x \<in> X. x \<sqsubseteq> s)"
   by (auto simp: extreme_def)
 
 lemma extreme_bound_singleton_refl[simp]:
-  "extreme_bound {x} x \<longleftrightarrow> x \<sqsubseteq> x" by auto
-
-lemma extreme_bound_equiv: "extreme_bound X b \<Longrightarrow> c \<in> X \<Longrightarrow> b \<sqsubseteq> c \<Longrightarrow> c \<sqsubseteq> b"
-  by auto
+  "extreme_bound {x} x \<longleftrightarrow> x \<in> A \<and> x \<sqsubseteq> x" by auto
 
 lemma extreme_bound_image_const:
-  "x \<sqsubseteq> x \<Longrightarrow> C \<noteq> {} \<Longrightarrow> (\<And>i. i \<in> C \<Longrightarrow> f i = x) \<Longrightarrow> extreme_bound (f ` C) x"
+  "x \<sqsubseteq> x \<Longrightarrow> I \<noteq> {} \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> f i = x) \<Longrightarrow> x \<in> A \<Longrightarrow> extreme_bound (f ` I) x"
   by (auto simp: image_constant)
 
 lemma extreme_bound_UN_const:
-  "x \<sqsubseteq> x \<Longrightarrow> C \<noteq> {} \<Longrightarrow> (\<And>i y. i \<in> C \<Longrightarrow> P i y \<longleftrightarrow> x = y) \<Longrightarrow>
-  extreme_bound (\<Union>i\<in>C. {y. P i y}) x"
+  "x \<sqsubseteq> x \<Longrightarrow> I \<noteq> {} \<Longrightarrow> (\<And>i y. i \<in> I \<Longrightarrow> P i y \<longleftrightarrow> x = y) \<Longrightarrow> x \<in> A \<Longrightarrow>
+  extreme_bound (\<Union>i\<in>I. {y. P i y}) x"
   by auto
 
 end
 
 context
-  fixes r :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
-begin
-
-lemma fun_ordI: "(\<And>x. f x \<sqsubseteq> g x) \<Longrightarrow> fun_ord (\<sqsubseteq>) f g"
-  and fun_ordD: "fun_ord (\<sqsubseteq>) f g \<Longrightarrow> f x \<sqsubseteq> g x"
-  by (auto simp: fun_ord_def)
-
-lemma dual_fun_ord: "(fun_ord (\<sqsubseteq>))\<^sup>- = fun_ord (\<sqsubseteq>)\<^sup>-" by (auto intro!:ext simp: fun_ord_def)
-
-lemma fun_extreme_bound_iff:
-  shows "extreme_bound (fun_ord (\<sqsubseteq>)) F e \<longleftrightarrow> (\<forall>x. extreme_bound (\<sqsubseteq>) {f x |. f \<in> F} (e x))" (is "?l \<longleftrightarrow> ?r")
-proof(intro iffI allI extreme_boundI fun_ordI)
-  fix f x
-  assume ?r
-  then have e: "extreme_bound (\<sqsubseteq>) {f x |. f \<in> F} (e x)" by auto
-  show "f \<in> F \<Longrightarrow> f x \<sqsubseteq> e x" using extremeD(1)[OF e] by auto
-  assume "bound (fun_ord (\<sqsubseteq>)) F f"
-  then have "bound (\<sqsubseteq>) {f x |. f \<in> F} (f x)" by (auto simp: fun_ord_def)
-  with e show "e x \<sqsubseteq> f x" by auto
-next
-  fix x y
-  assume l: ?l
-  from l have e: "f \<in> F \<Longrightarrow> f x \<sqsubseteq> e x" for f by (auto dest!:extremeD simp: fun_ord_def)
-  then show "y \<in> {f x |. f \<in> F} \<Longrightarrow> y \<sqsubseteq> e x" by auto
-  assume "bound (\<sqsubseteq>) {f x |. f \<in> F} y"
-  with extremeD(1)[OF l] have "bound (fun_ord (\<sqsubseteq>)) F (e(x:=y))" by (auto simp: fun_ord_def elim!:boundE)
-  with l have "fun_ord (\<sqsubseteq>) e (e(x:=y))" by auto
-  from fun_ordD[OF this, of x]
-  show "e x \<sqsubseteq> y" by auto
-qed
-
-context
   fixes ir :: "'i \<Rightarrow> 'i \<Rightarrow> bool" (infix "\<preceq>" 50)
-  fixes f
-  assumes mono: "monotone (\<preceq>) (\<sqsubseteq>) f"
-begin
-
-lemma monotone_chain_image:
-  assumes chain: "chain (\<preceq>) C" shows "chain (\<sqsubseteq>) (f ` C)"
-proof (rule chainI)
-  fix x y
-  assume "x \<in> f ` C" and "y \<in> f ` C"
-  then obtain i j where ij: "i \<in> C" "j \<in> C" and [simp]: "x = f i" "y = f j" by auto
-  from chain ij have "i \<preceq> j \<or> j \<preceq> i" by (auto elim: chainE)
-  with ij mono show "x \<sqsubseteq> y \<or> y \<sqsubseteq> x" by (elim disjE, auto dest: monotoneD) 
-qed
-
-lemma monotone_directed_image:
-  assumes dir: "directed (\<preceq>) D" shows "directed (\<sqsubseteq>) (f ` D)"
-proof (rule directedI, safe)
-  fix x y assume "x \<in> D" and "y \<in> D"
-  with dir obtain z where z: "z \<in> D" and "x \<preceq> z" and "y \<preceq> z" by (auto elim: directedE)
-  with mono have "f x \<sqsubseteq> f z" and "f y \<sqsubseteq> f z" by (auto dest: monotoneD)
-  with z show "\<exists>fz \<in> f ` D. f x \<sqsubseteq> fz \<and> f y \<sqsubseteq> fz" by auto
-qed
-
-context
-  fixes e C
-  assumes e: "extreme (\<preceq>) C e"
+    and r :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
+    and f and A and e and I
+  assumes fIA: "f ` I \<subseteq> A"
+    and mono: "monotone_on I (\<preceq>) (\<sqsubseteq>) f"
+    and e: "extreme I (\<preceq>) e"
 begin
 
 lemma monotone_extreme_imp_extreme_bound:
-  shows "extreme_bound (\<sqsubseteq>) (f ` C) (f e)"
-  using monotoneD[OF mono] e
-  by (auto simp: image_def intro!:extreme_boundI elim!:extremeE boundE)
+  "extreme_bound A (\<sqsubseteq>) (f ` I) (f e)"
+  using monotone_onD[OF mono] e fIA
+  by (intro extreme_boundI, auto simp: image_def elim!: extremeE)
 
 lemma monotone_extreme_extreme_boundI:
-  "x = f e \<Longrightarrow> extreme_bound (\<sqsubseteq>) (f ` C) x"
+  "x = f e \<Longrightarrow> extreme_bound A (\<sqsubseteq>) (f ` I) x"
   using monotone_extreme_imp_extreme_bound by auto
 
 end
 
-end
-
-end
-
 subsection \<open>Locales for Binary Relations\<close>
 
 text \<open>We now define basic properties of binary relations,
 in form of \emph{locales}~\cite{Kammuller00,locale}.\<close>
 
 subsubsection \<open>Syntactic Locales\<close>
 
 text \<open>The following locales do not assume anything, but provide infix notations for
-relations. \<close>
-
-locale less_eq_syntax = fixes less_eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
-
-locale less_syntax = fixes less :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubset>" 50)
-
-locale equivalence_syntax = fixes equiv :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sim>" 50)
+relations.\<close>
+
+locale less_eq_syntax =
+  fixes less_eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
+
+locale less_syntax =
+  fixes less :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubset>" 50)
+
+locale equivalence_syntax =
+  fixes equiv :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sim>" 50)
 begin
 
 abbreviation equiv_class ("[_]\<^sub>\<sim>") where "[x]\<^sub>\<sim> \<equiv> { y. x \<sim> y }"
 
 end
 
 text \<open>Next ones introduce abbreviations for dual etc.
 To avoid needless constants, one should be careful when declaring them as sublocales.\<close>
 
-locale less_eq_dualize = less_eq_syntax
+locale less_eq_notations = less_eq_syntax
 begin
 
 abbreviation (input) greater_eq (infix "\<sqsupseteq>" 50) where "x \<sqsupseteq> y \<equiv> y \<sqsubseteq> x"
-abbreviation (input) equiv (infix "\<sim>" 50) where "x \<sim> y \<equiv> x \<sqsubseteq> y \<and> y \<sqsubseteq> x"
-
-lemma equiv_sym[sym]: "x \<sim> y \<Longrightarrow> y \<sim> x" by auto
+abbreviation sym (infix "\<sim>" 50) where "(\<sim>) \<equiv> sympartp (\<sqsubseteq>)"
+abbreviation less (infix "\<sqsubset>" 50) where "(\<sqsubset>) \<equiv> asympartp (\<sqsubseteq>)"
+abbreviation greater (infix "\<sqsupset>" 50) where "(\<sqsupset>) \<equiv> (\<sqsubset>)\<^sup>-"
+abbreviation equiv (infix "(\<simeq>)" 50) where "(\<simeq>) \<equiv> equivpartp (\<sqsubseteq>)"
+
+lemma asym_cases[consumes 1, case_names asym sym]:
+  assumes "x \<sqsubseteq> y" and "x \<sqsubset> y \<Longrightarrow> thesis" and "x \<sim> y \<Longrightarrow> thesis"
+  shows thesis
+  using assms by auto
 
 end
 
-locale less_dualize = less_syntax
+locale less_notations = less_syntax
 begin
 
 abbreviation (input) greater (infix "\<sqsupset>" 50) where "x \<sqsupset> y \<equiv> y \<sqsubset> x"
 
 end
 
+locale related_set =
+  fixes A :: "'a set" and less_eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
+
 subsubsection \<open>Basic Properties of Relations\<close>
 
 text \<open>In the following we define basic properties in form of locales.\<close>
 
-locale reflexive = less_eq_syntax + assumes refl[iff]: "x \<sqsubseteq> x"
+text \<open>Reflexivity restricted on a set:\<close>
+locale reflexive = related_set +
+  assumes refl[intro]: "x \<in> A \<Longrightarrow> x \<sqsubseteq> x"
 begin
 
-lemma eq_implies: "x = y \<Longrightarrow> x \<sqsubseteq> y" by auto
-
-lemma extreme_singleton[simp]: "extreme (\<sqsubseteq>) {x} y \<longleftrightarrow> x = y" by auto
-
-lemma extreme_bound_singleton[iff]: "extreme_bound (\<sqsubseteq>) {x} x" by auto
-
-end
-lemmas reflexiveI[intro] = reflexive.intro
-
-locale irreflexive = less_syntax + assumes irrefl[iff]: "\<not> x \<sqsubset> x"
-begin
-
-lemma implies_not_eq: "x \<sqsubset> y \<Longrightarrow> x \<noteq> y" by auto
-
-end
-lemmas irreflexiveI[intro] = irreflexive.intro
-
-locale transitive = less_eq_syntax + assumes trans[trans]: "x \<sqsubseteq> y \<Longrightarrow> y \<sqsubseteq> z \<Longrightarrow> x \<sqsubseteq> z"
-lemmas [intro?] = transitive.intro
-
-locale symmetric = equivalence_syntax + assumes sym[sym]: "x \<sim> y \<Longrightarrow> y \<sim> x"
-begin
-
-lemma dual_sym: "(\<sim>)\<^sup>- = (\<sim>)" using sym by auto
+lemma eq_implies: "x = y \<Longrightarrow> x \<in> A \<Longrightarrow> x \<sqsubseteq> y" by auto
+
+lemma extreme_singleton[simp]: "x \<in> A \<Longrightarrow> extreme {x} (\<sqsubseteq>) y \<longleftrightarrow> x = y" by auto
+
+lemma extreme_bound_singleton: "x \<in> A \<Longrightarrow> extreme_bound A (\<sqsubseteq>) {x} x" by auto
+
+lemma reflexive_subset: "B \<subseteq> A \<Longrightarrow> reflexive B (\<sqsubseteq>)" apply unfold_locales by auto
 
 end
-lemmas [intro] = symmetric.intro
-
-locale antisymmetric = less_eq_syntax + assumes antisym[dest]: "x \<sqsubseteq> y \<Longrightarrow> y \<sqsubseteq> x \<Longrightarrow> x = y"
+
+declare reflexive.intro[intro!]
+
+lemma reflexiveE[elim]:
+  assumes "reflexive A r" and "(\<And>x. x \<in> A \<Longrightarrow> r x x) \<Longrightarrow> thesis" shows thesis
+  using assms by (auto simp: reflexive.refl)
+
+lemma reflexive_cong:
+  "(\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> r a b \<longleftrightarrow> r' a b) \<Longrightarrow> reflexive A r \<longleftrightarrow> reflexive A r'"
+  by (simp add: reflexive_def)
+
+locale irreflexive = related_set A "(\<sqsubset>)" for A and less (infix "\<sqsubset>" 50) +
+  assumes irrefl: "x \<in> A \<Longrightarrow> \<not> x \<sqsubset> x"
 begin
 
-interpretation less_eq_dualize. 
-
-lemma equiv_iff_eq_refl: "x \<sim> y \<longleftrightarrow> x = y \<and> y \<sqsubseteq> y" by auto
-
-lemma extreme_unique: "extreme (\<sqsubseteq>) X x \<Longrightarrow> extreme (\<sqsubseteq>) X y \<longleftrightarrow> x = y"
-  by (auto elim!: extremeE)
-
-lemma ex_extreme_iff_ex1: "Ex (extreme (\<sqsubseteq>) X) \<longleftrightarrow> Ex1 (extreme (\<sqsubseteq>) X)" by (auto simp: extreme_unique)
-
-lemma ex_extreme_iff_the:
-   "Ex (extreme (\<sqsubseteq>) X) \<longleftrightarrow> extreme (\<sqsubseteq>) X (The (extreme (\<sqsubseteq>) X))"
-  apply (rule iffI)
-  apply (rule  theI')
-  using extreme_unique by auto
+lemma irreflD[simp]: "x \<sqsubset> x \<Longrightarrow> \<not>x \<in> A" by (auto simp: irrefl)
+
+lemma implies_not_eq: "x \<sqsubset> y \<Longrightarrow> x \<in> A \<Longrightarrow> x \<noteq> y" by auto
+
+lemma Restrp_irreflexive: "irreflexive UNIV ((\<sqsubset>)\<restriction>A)"
+  apply unfold_locales by auto
+
+lemma irreflexive_subset: "B \<subseteq> A \<Longrightarrow> irreflexive B (\<sqsubset>)" apply unfold_locales by auto
 
 end
-lemmas antisymmetricI[intro] = antisymmetric.intro
+
+declare irreflexive.intro[intro!]
+
+lemma irreflexive_cong:
+  "(\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> r a b \<longleftrightarrow> r' a b) \<Longrightarrow> irreflexive A r \<longleftrightarrow> irreflexive A r'"
+  by (simp add: irreflexive_def)
+
+locale transitive = related_set +
+  assumes trans[trans]: "x \<sqsubseteq> y \<Longrightarrow> y \<sqsubseteq> z \<Longrightarrow> x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> z \<in> A \<Longrightarrow> x \<sqsubseteq> z"
+begin
+
+interpretation less_eq_notations.
+
+lemma Restrp_transitive: "transitive UNIV ((\<sqsubseteq>)\<restriction>A)"
+  apply unfold_locales
+  by (auto intro: trans)
+
+lemma bound_trans[trans]: "bound X (\<sqsubseteq>) b \<Longrightarrow> b \<sqsubseteq> c \<Longrightarrow> X \<subseteq> A \<Longrightarrow> b \<in> A \<Longrightarrow> c \<in> A \<Longrightarrow> bound X (\<sqsubseteq>) c"
+  by (auto 0 4 dest: trans)
+
+lemma transitive_subset:
+  assumes BA: "B \<subseteq> A" shows "transitive B (\<sqsubseteq>)"
+  apply unfold_locales
+  using trans BA by blast
+
+lemma asympartp_transitive: "transitive A (\<sqsubset>)"
+  apply unfold_locales by (auto dest:trans)
+
+lemma reflclp_transitive: "transitive A (\<sqsubseteq>)\<^sup>=\<^sup>="
+  apply unfold_locales by (auto dest: trans)
+
+text \<open>The symmetric part is also transitive, but this is done in the later semiattractive locale\<close>
+
+end
+
+declare transitive.intro[intro?]
+
+lemma transitive_cong:
+  assumes r: "\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> r a b \<longleftrightarrow> r' a b" shows "transitive A r \<longleftrightarrow> transitive A r'"
+proof (intro iffI)
+  show "transitive A r \<Longrightarrow> transitive A r'"
+    apply (intro transitive.intro)
+    apply (unfold r[symmetric])
+    using transitive.trans.
+  show "transitive A r' \<Longrightarrow> transitive A r"
+    apply (intro transitive.intro)
+    apply (unfold r)
+    using transitive.trans.
+qed
+
+lemma tranclp_transitive: "transitive A (tranclp r)"
+  using tranclp_trans by unfold_locales
+
+locale symmetric = related_set A "(\<sim>)" for A and equiv (infix "\<sim>" 50) +
+  assumes sym[sym]: "x \<sim> y \<Longrightarrow> x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> y \<sim> x"
+begin
+
+lemma sym_iff: "x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> x \<sim> y \<longleftrightarrow> y \<sim> x"
+  by (auto dest: sym)
+
+lemma Restrp_symmetric: "symmetric UNIV ((\<sim>)\<restriction>A)"
+  apply unfold_locales by (auto simp: sym_iff)
+
+lemma symmetric_subset: "B \<subseteq> A \<Longrightarrow> symmetric B (\<sim>)"
+  apply unfold_locales by (auto dest: sym)
+
+end
+
+declare symmetric.intro[intro]
+
+lemma symmetric_cong:
+  "(\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> r a b \<longleftrightarrow> r' a b) \<Longrightarrow> symmetric A r \<longleftrightarrow> symmetric A r'"
+  by (auto simp: symmetric_def)
+
+
+global_interpretation sympartp: symmetric UNIV "sympartp r"
+  rewrites "\<And>r. r \<restriction> UNIV \<equiv> r"
+    and "\<And>x. x \<in> UNIV \<equiv> True"
+    and "\<And>P1. (True \<Longrightarrow> P1) \<equiv> Trueprop P1"
+    and "\<And>P1 P2. (True \<Longrightarrow> PROP P1 \<Longrightarrow> PROP P2) \<equiv> (PROP P1 \<Longrightarrow> PROP P2)"
+  by auto
+
+lemma sympartp_symmetric: "symmetric A (sympartp r)" by auto
+
+locale antisymmetric = related_set +
+  assumes antisym: "x \<sqsubseteq> y \<Longrightarrow> y \<sqsubseteq> x \<Longrightarrow> x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> x = y"
+begin
+
+interpretation less_eq_notations.
+
+lemma sym_iff_eq_refl: "x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> x \<sim> y \<longleftrightarrow> x = y \<and> y \<sqsubseteq> y" by (auto dest: antisym)
+
+lemma equiv_iff_eq[simp]: "x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> x \<simeq> y \<longleftrightarrow> x = y" by (auto dest: antisym elim: equivpartpE)
+
+lemma extreme_unique: "X \<subseteq> A \<Longrightarrow> extreme X (\<sqsubseteq>) x \<Longrightarrow> extreme X (\<sqsubseteq>) y \<longleftrightarrow> x = y"
+  by (elim extremeE, auto dest!: antisym[OF _ _ subsetD])
+
+lemma ex_extreme_iff_ex1:
+  "X \<subseteq> A \<Longrightarrow> Ex (extreme X (\<sqsubseteq>)) \<longleftrightarrow> Ex1 (extreme X (\<sqsubseteq>))" by (auto simp: extreme_unique)
+
+lemma ex_extreme_iff_the:
+   "X \<subseteq> A \<Longrightarrow> Ex (extreme X (\<sqsubseteq>)) \<longleftrightarrow> extreme X (\<sqsubseteq>) (The (extreme X (\<sqsubseteq>)))"
+  apply (rule iffI)
+  apply (rule theI')
+  using extreme_unique by auto
+
+lemma Restrp_antisymmetric: "antisymmetric UNIV ((\<sqsubseteq>)\<restriction>A)"
+   apply unfold_locales
+  by (auto dest: antisym)
+
+lemma antisymmetric_subset: "B \<subseteq> A \<Longrightarrow> antisymmetric B (\<sqsubseteq>)"
+  apply unfold_locales using antisym by auto
+
+end
+
+declare antisymmetric.intro[intro]
+
+lemma antisymmetric_cong:
+  "(\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> r a b \<longleftrightarrow> r' a b) \<Longrightarrow> antisymmetric A r \<longleftrightarrow> antisymmetric A r'"
+  by (auto simp: antisymmetric_def)
+
+lemma antisymmetric_union:
+  fixes less_eq (infix "\<sqsubseteq>" 50)
+  assumes A: "antisymmetric A (\<sqsubseteq>)" and B: "antisymmetric B (\<sqsubseteq>)"
+    and AB: "\<forall>a \<in> A. \<forall>b \<in> B. a \<sqsubseteq> b \<longrightarrow> b \<sqsubseteq> a \<longrightarrow> a = b"
+  shows "antisymmetric (A \<union> B) (\<sqsubseteq>)"
+proof-
+  interpret A: antisymmetric A "(\<sqsubseteq>)" using A.
+  interpret B: antisymmetric B "(\<sqsubseteq>)" using B.
+  show ?thesis by (auto dest: AB[rule_format] A.antisym B.antisym)
+qed
 
 text \<open>The following notion is new, generalizing antisymmetry and transitivity.\<close>
 
-locale semiattractive = less_eq_syntax +
-  assumes attract: "x \<sqsubseteq> y \<Longrightarrow> y \<sqsubseteq> x \<Longrightarrow> x \<sqsubseteq> z \<Longrightarrow> y \<sqsubseteq> z"
+locale semiattractive = related_set +
+  assumes attract: "x \<sqsubseteq> y \<Longrightarrow> y \<sqsubseteq> x \<Longrightarrow> y \<sqsubseteq> z \<Longrightarrow> x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> z \<in> A \<Longrightarrow> x \<sqsubseteq> z"
 begin
 
-interpretation less_eq_dualize.
-
-lemma equiv_trans:
-  assumes xy: "x \<sim> y" and yz: "y \<sim> z" shows "x \<sim> z"
-  using attract[of y x z] attract[of y z x] xy yz by auto
+interpretation less_eq_notations.
+
+lemma equiv_order_trans[trans]:
+  assumes xy: "x \<simeq> y" and yz: "y \<sqsubseteq> z" and x: "x \<in> A" and y: "y \<in> A" and z: "z \<in> A"
+  shows "x \<sqsubseteq> z"
+  using attract[OF _ _ _ x y z] xy yz by (auto elim: equivpartpE)
+
+lemma equiv_transitive: "transitive A (\<simeq>)"
+proof unfold_locales
+  fix x y z
+  assume x: "x \<in> A" and y: "y \<in> A" and z: "z \<in> A" and xy: "x \<simeq> y" and yz: "y \<simeq> z"
+  show "x \<simeq> z"
+    using equiv_order_trans[OF xy _ x y z] attract[OF _ _ _ z y x] xy yz by (auto simp:equivpartp_def)
+qed
+
+lemma sym_order_trans[trans]:
+  assumes xy: "x \<sim> y" and yz: "y \<sqsubseteq> z" and x: "x \<in> A" and y: "y \<in> A" and z: "z \<in> A"
+  shows "x \<sqsubseteq> z"
+  using attract[OF _ _ _ x y z] xy yz by auto
+
+interpretation sym: transitive A "(\<sim>)"
+proof unfold_locales
+  fix x y z
+  assume x: "x \<in> A" and y: "y \<in> A" and z: "z \<in> A" and xy: "x \<sim> y" and yz: "y \<sim> z"
+  show "x \<sim> z"
+    using sym_order_trans[OF xy _ x y z] attract[OF _ _ _ z y x] xy yz by auto
+qed
+
+lemmas sym_transitive = sym.transitive_axioms
 
 lemma extreme_bound_quasi_const:
-  assumes C: "C \<noteq> {}" and const: "\<forall>y \<in> C. y \<sim> x" shows "extreme_bound (\<sqsubseteq>) C x"
-proof (intro extreme_boundI)
-  from C obtain c where c: "c \<in> C" by auto
-  with const have cx: "c \<sim> x" by auto
-  fix b assume "bound (\<sqsubseteq>) C b"
-  with c have cb: "c \<sqsubseteq> b" by auto
-  from attract[of c x b] cb cx show "x \<sqsubseteq> b" by auto
+  assumes C: "C \<subseteq> A" and x: "x \<in> A" and C0: "C \<noteq> {}" and const: "\<forall>y \<in> C. y \<sim> x"
+  shows "extreme_bound A (\<sqsubseteq>) C x"
+proof (intro extreme_boundI x)
+  from C0 obtain c where cC: "c \<in> C" by auto
+  with C have c: "c \<in> A" by auto
+  from cC const have cx: "c \<sim> x" by auto
+  fix b assume b: "b \<in> A" and "bound C (\<sqsubseteq>) b"
+  with cC have cb: "c \<sqsubseteq> b" by auto
+  from attract[OF _ _ cb x c b] cx show "x \<sqsubseteq> b" by auto
 next
   fix c assume "c \<in> C"
   with const show "c \<sqsubseteq> x" by auto
 qed
 
 lemma extreme_bound_quasi_const_iff:
-  assumes C: "C \<noteq> {}" and const: "\<forall>z \<in> C. z \<sim> x"
-  shows "extreme_bound (\<sqsubseteq>) C y \<longleftrightarrow> x \<sim> y"
+  assumes C: "C \<subseteq> A" and x: "x \<in> A" and y: "y \<in> A" and C0: "C \<noteq> {}" and const: "\<forall>z \<in> C. z \<sim> x"
+  shows "extreme_bound A (\<sqsubseteq>) C y \<longleftrightarrow> x \<sim> y"
 proof (intro iffI)
-  assume "extreme_bound (\<sqsubseteq>) C y"
-  with const show "x \<sim> y"
-    by (metis C extreme_bound_quasi_const extremes_equiv)
+  assume y: "extreme_bound A (\<sqsubseteq>) C y"
+  note x = extreme_bound_quasi_const[OF C x C0 const]
+  from extremes_equiv[OF y x]
+  show "x \<sim> y" by auto
 next
   assume xy: "x \<sim> y"
-  with const equiv_trans[of _ x y] have Cy: "\<forall>z \<in> C. z \<sim> y" by auto
-  show "extreme_bound (\<sqsubseteq>) C y"
-    using extreme_bound_quasi_const[OF C Cy].
+  with const C sym.trans[OF _ xy _ x y] have Cy: "\<forall>z \<in> C. z \<sim> y" by auto
+  show "extreme_bound A (\<sqsubseteq>) C y"
+    using extreme_bound_quasi_const[OF C y C0 Cy].
+qed
+
+lemma Restrp_semiattractive: "semiattractive UNIV ((\<sqsubseteq>)\<restriction>A)"
+  apply unfold_locales
+  by (auto dest: attract)
+
+lemma semiattractive_subset: "B \<subseteq> A \<Longrightarrow> semiattractive B (\<sqsubseteq>)"
+  apply unfold_locales using attract by blast
+
+end
+
+lemma semiattractive_cong:
+  assumes r: "\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> r a b \<longleftrightarrow> r' a b"
+  shows "semiattractive A r \<longleftrightarrow> semiattractive A r'" (is "?l \<longleftrightarrow> ?r")
+proof
+  show "?l \<Longrightarrow> ?r"
+    apply (intro semiattractive.intro)
+    apply (unfold r[symmetric])
+    using semiattractive.attract.
+  show "?r \<Longrightarrow> ?l"
+    apply (intro semiattractive.intro)
+    apply (unfold r)
+    using semiattractive.attract.
+qed
+
+locale attractive = semiattractive +
+  assumes "semiattractive A (\<sqsubseteq>)\<^sup>-"
+begin
+
+interpretation less_eq_notations.
+
+sublocale dual: semiattractive A "(\<sqsubseteq>)\<^sup>-"
+  rewrites "\<And>r. sympartp (r \<restriction> A) \<equiv> sympartp r \<restriction> A"
+    and "\<And>r. sympartp (sympartp r) \<equiv> sympartp r"
+    and "sympartp ((\<sqsubseteq>) \<restriction> A)\<^sup>- \<equiv> (\<sim>) \<restriction> A"
+    and "sympartp (\<sqsubseteq>)\<^sup>- \<equiv> (\<sim>)"
+    and "equivpartp (\<sqsubseteq>)\<^sup>- \<equiv> (\<simeq>)"
+  using attractive_axioms[unfolded attractive_def]
+  by (auto intro!: ext simp: attractive_axioms_def atomize_eq equivpartp_def)
+
+lemma order_equiv_trans[trans]:
+  assumes xy: "x \<sqsubseteq> y" and yz: "y \<simeq> z" and x: "x \<in> A" and y: "y \<in> A" and z: "z \<in> A"
+  shows "x \<sqsubseteq> z"
+  using dual.attract[OF _ _ _ z y x] xy yz by auto
+
+lemma order_sym_trans[trans]:
+  assumes xy: "x \<sqsubseteq> y" and yz: "y \<sim> z" and x: "x \<in> A" and y: "y \<in> A" and z: "z \<in> A"
+  shows "x \<sqsubseteq> z"
+  using dual.attract[OF _ _ _ z y x] xy yz by auto
+
+interpretation Restrp: semiattractive UNIV "(\<sqsubseteq>)\<restriction>A" using Restrp_semiattractive.
+interpretation dual.Restrp: semiattractive UNIV "(\<sqsubseteq>)\<^sup>-\<restriction>A" using dual.Restrp_semiattractive.
+
+lemma Restrp_attractive: "attractive UNIV ((\<sqsubseteq>)\<restriction>A)"
+  apply unfold_locales
+  using dual.Restrp.attract by auto
+
+lemma attractive_subset: "B \<subseteq> A \<Longrightarrow> attractive B (\<sqsubseteq>)"
+  apply (intro attractive.intro attractive_axioms.intro)
+  using semiattractive_subset dual.semiattractive_subset by auto
+
+end
+
+lemma attractive_cong:
+  assumes r: "\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> r a b \<longleftrightarrow> r' a b"
+  shows "attractive A r \<longleftrightarrow> attractive A r'"
+  by (simp add: attractive_def attractive_axioms_def r cong: semiattractive_cong)
+
+context antisymmetric begin
+
+sublocale attractive
+  apply unfold_locales by (auto dest: antisym)
+
+end
+
+context transitive begin
+
+sublocale attractive
+  rewrites "\<And>r. sympartp (r \<restriction> A) \<equiv> sympartp r \<restriction> A"
+    and "\<And>r. sympartp (sympartp r) \<equiv> sympartp r"
+    and "sympartp (\<sqsubseteq>)\<^sup>- \<equiv> sympartp (\<sqsubseteq>)"
+    and "(sympartp (\<sqsubseteq>))\<^sup>- \<equiv> sympartp (\<sqsubseteq>)"
+    and "(sympartp (\<sqsubseteq>) \<restriction> A)\<^sup>- \<equiv> sympartp (\<sqsubseteq>) \<restriction> A"
+    and "asympartp (asympartp (\<sqsubseteq>)) = asympartp (\<sqsubseteq>)"
+    and "asympartp (sympartp (\<sqsubseteq>)) = bot"
+    and "asympartp (\<sqsubseteq>) \<restriction> A = asympartp ((\<sqsubseteq>) \<restriction> A)"
+  apply unfold_locales
+  by (auto intro!:ext dest: trans simp: atomize_eq)
+
+end
+
+subsection \<open>Combined Properties\<close>
+
+text \<open>Some combinations of the above basic properties are given names.\<close>
+
+locale asymmetric = related_set A "(\<sqsubset>)" for A and less (infix "\<sqsubset>" 50) +
+  assumes asym: "x \<sqsubset> y \<Longrightarrow> y \<sqsubset> x \<Longrightarrow> x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> False"
+begin
+
+sublocale irreflexive
+  apply unfold_locales by (auto dest: asym)
+
+lemma antisymmetric_axioms: "antisymmetric A (\<sqsubset>)"
+  apply unfold_locales by (auto dest: asym)
+
+lemma Restrp_asymmetric: "asymmetric UNIV ((\<sqsubset>)\<restriction>A)"
+  apply unfold_locales
+  by (auto dest:asym)
+
+lemma asymmetric_subset: "B \<subseteq> A \<Longrightarrow> asymmetric B (\<sqsubset>)"
+  apply unfold_locales using asym by auto
+
+end
+
+lemma asymmetric_iff_irreflexive_antisymmetric:
+  fixes less (infix "\<sqsubset>" 50)
+  shows "asymmetric A (\<sqsubset>) \<longleftrightarrow> irreflexive A (\<sqsubset>) \<and> antisymmetric A (\<sqsubset>)" (is "?l \<longleftrightarrow> ?r")
+proof
+  assume ?l
+  then interpret asymmetric.
+  show ?r by (auto dest: asym)
+next
+  assume ?r
+  then interpret irreflexive + antisymmetric A "(\<sqsubset>)" by auto
+  show ?l by (auto intro!:asymmetric.intro dest: antisym irrefl)
+qed
+
+lemma asymmetric_cong:
+  assumes r: "\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> r a b \<longleftrightarrow> r' a b"
+  shows "asymmetric A r \<longleftrightarrow> asymmetric A r'"
+  by (simp add: asymmetric_iff_irreflexive_antisymmetric r cong: irreflexive_cong antisymmetric_cong)
+
+locale quasi_ordered_set = reflexive + transitive
+begin
+
+lemma quasi_ordered_subset: "B \<subseteq> A \<Longrightarrow> quasi_ordered_set B (\<sqsubseteq>)"
+  apply intro_locales
+  using reflexive_subset transitive_subset by auto
+
+end
+
+lemma quasi_ordered_set_cong:
+  assumes r: "\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> r a b \<longleftrightarrow> r' a b"
+  shows "quasi_ordered_set A r \<longleftrightarrow> quasi_ordered_set A r'"
+  by (simp add: quasi_ordered_set_def r cong: reflexive_cong transitive_cong)
+
+locale near_ordered_set = antisymmetric + transitive
+begin
+
+interpretation Restrp: antisymmetric UNIV "(\<sqsubseteq>)\<restriction>A" using Restrp_antisymmetric.
+interpretation Restrp: transitive UNIV "(\<sqsubseteq>)\<restriction>A" using Restrp_transitive.
+
+lemma Restrp_near_order: "near_ordered_set UNIV ((\<sqsubseteq>)\<restriction>A)"..
+
+lemma near_ordered_subset: "B \<subseteq> A \<Longrightarrow> near_ordered_set B (\<sqsubseteq>)"
+  apply intro_locales
+  using antisymmetric_subset transitive_subset by auto
+
+end
+
+lemma near_ordered_set_cong:
+  assumes r: "\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> r a b \<longleftrightarrow> r' a b"
+  shows "near_ordered_set A r \<longleftrightarrow> near_ordered_set A r'"
+  by (simp add: near_ordered_set_def r cong: antisymmetric_cong transitive_cong)
+
+locale pseudo_ordered_set = reflexive + antisymmetric
+begin
+
+interpretation less_eq_notations.
+
+lemma sym_eq[simp]: "x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> x \<sim> y \<longleftrightarrow> x = y"
+  by (auto simp: refl dest: antisym)
+
+lemma extreme_bound_singleton_eq[simp]: "x \<in> A \<Longrightarrow> extreme_bound A (\<sqsubseteq>) {x} y \<longleftrightarrow> x = y"
+  by (auto intro!: antisym)
+
+lemma eq_iff: "x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> x = y \<longleftrightarrow> x \<sqsubseteq> y \<and> y \<sqsubseteq> x" by (auto dest: antisym simp:refl)
+
+lemma extreme_order_iff_eq: "e \<in> A \<Longrightarrow> extreme {x \<in> A. x \<sqsubseteq> e} (\<sqsubseteq>) s \<longleftrightarrow> e = s"
+  by (auto intro!: antisym)
+
+lemma pseudo_ordered_subset: "B \<subseteq> A \<Longrightarrow> pseudo_ordered_set B (\<sqsubseteq>)"
+  apply intro_locales
+  using reflexive_subset antisymmetric_subset by auto
+
+end
+
+lemma pseudo_ordered_set_cong:
+  assumes r: "\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> r a b \<longleftrightarrow> r' a b"
+  shows "pseudo_ordered_set A r \<longleftrightarrow> pseudo_ordered_set A r'"
+  by (simp add: pseudo_ordered_set_def r cong: reflexive_cong antisymmetric_cong)
+
+locale partially_ordered_set = reflexive + antisymmetric + transitive
+begin
+
+sublocale pseudo_ordered_set + quasi_ordered_set + near_ordered_set ..
+
+lemma partially_ordered_subset: "B \<subseteq> A \<Longrightarrow> partially_ordered_set B (\<sqsubseteq>)"
+  apply intro_locales
+  using reflexive_subset transitive_subset antisymmetric_subset by auto
+
+end
+
+lemma partially_ordered_set_cong:
+  assumes r: "\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> r a b \<longleftrightarrow> r' a b"
+  shows "partially_ordered_set A r \<longleftrightarrow> partially_ordered_set A r'"
+  by (simp add: partially_ordered_set_def r cong: reflexive_cong antisymmetric_cong transitive_cong)
+
+locale strict_ordered_set = irreflexive + transitive A "(\<sqsubset>)"
+begin
+
+sublocale asymmetric
+proof
+  fix x y
+  assume x: "x \<in> A" and y: "y \<in> A"
+  assume xy: "x \<sqsubset> y"
+  also assume yx: "y \<sqsubset> x"
+  finally have "x \<sqsubset> x" using x y by auto
+  with x show False by auto
+qed
+
+lemma near_ordered_set_axioms: "near_ordered_set A (\<sqsubset>)"
+  using antisymmetric_axioms by intro_locales
+
+interpretation Restrp: asymmetric UNIV "(\<sqsubset>)\<restriction>A" using Restrp_asymmetric.
+interpretation Restrp: transitive UNIV "(\<sqsubset>)\<restriction>A" using Restrp_transitive.
+
+lemma Restrp_strict_order: "strict_ordered_set UNIV ((\<sqsubset>)\<restriction>A)"..
+
+lemma strict_ordered_subset: "B \<subseteq> A \<Longrightarrow> strict_ordered_set B (\<sqsubset>)"
+  apply intro_locales
+  using irreflexive_subset transitive_subset by auto
+
+end
+
+lemma strict_ordered_set_cong:
+  assumes r: "\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> r a b \<longleftrightarrow> r' a b"
+  shows "strict_ordered_set A r \<longleftrightarrow> strict_ordered_set A r'"
+  by (simp add: strict_ordered_set_def r cong: irreflexive_cong transitive_cong)
+
+locale tolerance = symmetric + reflexive A "(\<sim>)"
+begin
+
+lemma tolerance_subset: "B \<subseteq> A \<Longrightarrow> tolerance B (\<sim>)"
+  apply intro_locales
+  using symmetric_subset reflexive_subset by auto
+
+end
+
+lemma tolerance_cong:
+  assumes r: "\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> r a b \<longleftrightarrow> r' a b"
+  shows "tolerance A r \<longleftrightarrow> tolerance A r'"
+  by (simp add: tolerance_def r cong: reflexive_cong symmetric_cong)
+
+global_interpretation equiv: tolerance UNIV "equivpartp r"
+  rewrites "\<And>r. r \<restriction> UNIV \<equiv> r"
+    and "\<And>x. x \<in> UNIV \<equiv> True"
+    and "\<And>P1. (True \<Longrightarrow> P1) \<equiv> Trueprop P1"
+    and "\<And>P1 P2. (True \<Longrightarrow> PROP P1 \<Longrightarrow> PROP P2) \<equiv> (PROP P1 \<Longrightarrow> PROP P2)"
+  by unfold_locales (auto simp:equivpartp_def)
+
+locale partial_equivalence = symmetric +
+  assumes "transitive A (\<sim>)"
+begin
+
+sublocale transitive A "(\<sim>)"
+  rewrites "sympartp (\<sim>)\<restriction>A \<equiv> (\<sim>)\<restriction>A"
+    and "sympartp ((\<sim>)\<restriction>A) \<equiv> (\<sim>)\<restriction>A"
+  using partial_equivalence_axioms
+  unfolding partial_equivalence_axioms_def partial_equivalence_def
+  by (auto simp: atomize_eq sym intro!:ext)
+
+lemma partial_equivalence_subset: "B \<subseteq> A \<Longrightarrow> partial_equivalence B (\<sim>)"
+  apply (intro partial_equivalence.intro partial_equivalence_axioms.intro)
+  using symmetric_subset transitive_subset by auto
+
+end
+
+lemma partial_equivalence_cong:
+  assumes r: "\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> r a b \<longleftrightarrow> r' a b"
+  shows "partial_equivalence A r \<longleftrightarrow> partial_equivalence A r'"
+  by (simp add: partial_equivalence_def partial_equivalence_axioms_def r
+      cong: transitive_cong symmetric_cong)
+
+locale equivalence = symmetric + reflexive A "(\<sim>)" + transitive A "(\<sim>)"
+begin
+
+sublocale tolerance + partial_equivalence + quasi_ordered_set A "(\<sim>)"..
+
+lemma equivalence_subset: "B \<subseteq> A \<Longrightarrow> equivalence B (\<sim>)"
+  apply (intro equivalence.intro)
+  using symmetric_subset transitive_subset by auto
+
+end
+
+lemma equivalence_cong:
+  assumes r: "\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> r a b \<longleftrightarrow> r' a b"
+  shows "equivalence A r \<longleftrightarrow> equivalence A r'"
+  by (simp add: equivalence_def r cong: reflexive_cong transitive_cong symmetric_cong)
+
+text \<open>Some combinations lead to uninteresting relations.\<close>
+
+context
+  fixes r :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<bowtie>" 50)
+begin
+
+proposition reflexive_irreflexive_is_empty:
+  assumes r: "reflexive A (\<bowtie>)" and ir: "irreflexive A (\<bowtie>)"
+  shows "A = {}"
+proof (rule ccontr)
+  interpret irreflexive A "(\<bowtie>)" using ir.
+  interpret reflexive A "(\<bowtie>)" using r.
+  assume "A \<noteq> {}"
+  then obtain a where a: "a \<in> A" by auto
+  from a refl have "a \<bowtie> a" by auto
+  with irrefl a show False by auto
+qed
+
+proposition symmetric_antisymmetric_imp_eq:
+  assumes s: "symmetric A (\<bowtie>)" and as: "antisymmetric A (\<bowtie>)"
+  shows "(\<bowtie>)\<restriction>A \<le> (=)"
+proof-
+  interpret symmetric A "(\<bowtie>)" + antisymmetric A "(\<bowtie>)" using assms by auto
+  show "?thesis" using antisym by (auto dest: sym)
+qed
+
+proposition nontolerance:
+  shows "irreflexive A (\<bowtie>) \<and> symmetric A (\<bowtie>) \<longleftrightarrow> tolerance A (\<lambda>x y. \<not> x \<bowtie> y)"
+proof (intro iffI conjI, elim conjE)
+  assume "irreflexive A (\<bowtie>)" and "symmetric A (\<bowtie>)"
+  then interpret irreflexive A "(\<bowtie>)" + symmetric A "(\<bowtie>)".
+  show "tolerance A (\<lambda>x y. \<not> x \<bowtie> y)" by (unfold_locales, auto dest: sym irrefl)
+next
+  assume "tolerance A (\<lambda>x y. \<not> x \<bowtie> y)"
+  then interpret tolerance A "\<lambda>x y. \<not> x \<bowtie> y".
+  show "irreflexive A (\<bowtie>)" by (auto simp: eq_implies)
+  show "symmetric A (\<bowtie>)" using sym by auto
+qed
+
+proposition irreflexive_transitive_symmetric_is_empty:
+  assumes irr: "irreflexive A (\<bowtie>)" and tr: "transitive A (\<bowtie>)" and sym: "symmetric A (\<bowtie>)"
+  shows "(\<bowtie>)\<restriction>A = bot"
+proof (intro ext, unfold bot_fun_def bot_bool_def eq_False, rule notI, erule RestrpE)
+  interpret strict_ordered_set A "(\<bowtie>)" using assms by (unfold strict_ordered_set_def, auto)
+  interpret symmetric A "(\<bowtie>)" using assms by auto
+  fix x y assume x: "x \<in> A" and y: "y \<in> A"
+  assume xy: "x \<bowtie> y"
+  also note sym[OF xy x y]
+  finally have "x \<bowtie> x" using x y by auto
+  with x show False by auto
 qed
 
 end
 
-locale attractive = semiattractive + dual: semiattractive "(\<sqsubseteq>)\<^sup>-"
-
-sublocale transitive \<subseteq> attractive by (unfold_locales, auto dest: trans)
-
-sublocale antisymmetric \<subseteq> attractive by (unfold_locales, auto)
-
-locale asymmetric = irreflexive + strict: antisymmetric "(\<sqsubset>)"
+subsection \<open>Totality\<close>
+
+locale semiconnex = related_set A "(\<sqsubset>)" for A and less (infix "\<sqsubset>" 50) +
+  assumes semiconnex: "x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> x \<sqsubset> y \<or> x = y \<or> y \<sqsubset> x"
 begin
 
-lemma asym[trans]: "x \<sqsubset> y \<Longrightarrow> y \<sqsubset> x \<Longrightarrow> thesis" by auto
+lemma cases[consumes 2, case_names less eq greater]:
+  assumes "x \<in> A" and "y \<in> A" and "x \<sqsubset> y \<Longrightarrow> P" and "x = y \<Longrightarrow> P" and "y \<sqsubset> x \<Longrightarrow> P"
+  shows "P" using semiconnex assms by auto
+
+lemma neqE:
+  assumes "x \<in> A" and "y \<in> A"
+  shows "x \<noteq> y \<Longrightarrow> (x \<sqsubset> y \<Longrightarrow> P) \<Longrightarrow> (y \<sqsubset> x \<Longrightarrow> P) \<Longrightarrow> P"
+  by (cases rule: cases[OF assms], auto)
+
+lemma semiconnex_subset: "B \<subseteq> A \<Longrightarrow> semiconnex B (\<sqsubset>)"
+  apply (intro semiconnex.intro)
+  using semiconnex by auto
+
+end
+
+declare semiconnex.intro[intro]
+
+text \<open>Totality is negated antisymmetry \cite[Proposition 2.2.4]{Schmidt1993}.\<close>
+proposition semiconnex_iff_neg_antisymmetric:
+  fixes less (infix "\<sqsubset>" 50)
+  shows "semiconnex A (\<sqsubset>) \<longleftrightarrow> antisymmetric A (\<lambda>x y. \<not> x \<sqsubset> y)" (is "?l \<longleftrightarrow> ?r")
+proof (intro iffI semiconnex.intro antisymmetric.intro)
+  assume ?l
+  then interpret semiconnex.
+  fix x y
+  assume "x \<in> A" "y \<in> A" "\<not> x \<sqsubset> y" and "\<not> y \<sqsubset> x"
+  then show "x = y" by (cases rule: cases, auto)
+next
+  assume ?r
+  then interpret neg: antisymmetric A "(\<lambda>x y. \<not> x \<sqsubset> y)".
+  fix x y
+  show "x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> x \<sqsubset> y \<or> x = y \<or> y \<sqsubset> x" using neg.antisym by auto
+qed
+
+lemma semiconnex_cong:
+  assumes r: "\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> r a b \<longleftrightarrow> r' a b"
+  shows "semiconnex A r \<longleftrightarrow> semiconnex A r'"
+  by (simp add: semiconnex_iff_neg_antisymmetric r cong: antisymmetric_cong)
+
+locale semiconnex_irreflexive = semiconnex + irreflexive
+begin
+
+lemma neq_iff: "x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> x \<noteq> y \<longleftrightarrow> x \<sqsubset> y \<or> y \<sqsubset> x" by (auto elim:neqE dest: irrefl)
+
+lemma semiconnex_irreflexive_subset: "B \<subseteq> A \<Longrightarrow> semiconnex_irreflexive B (\<sqsubset>)"
+  apply (intro semiconnex_irreflexive.intro)
+  using semiconnex_subset irreflexive_subset by auto
+
+end
+
+lemma semiconnex_irreflexive_cong:
+  assumes r: "\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> r a b \<longleftrightarrow> r' a b"
+  shows "semiconnex_irreflexive A r \<longleftrightarrow> semiconnex_irreflexive A r'"
+  by (simp add: semiconnex_irreflexive_def r cong: semiconnex_cong irreflexive_cong)
+
+locale connex = related_set +
+  assumes comparable: "x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> x \<sqsubseteq> y \<or> y \<sqsubseteq> x"
+begin
+
+interpretation less_eq_notations.
+
+sublocale reflexive apply unfold_locales using comparable by auto
+
+lemma comparable_cases[consumes 2, case_names le ge]:
+  assumes "x \<in> A" and "y \<in> A" and "x \<sqsubseteq> y \<Longrightarrow> P" and "y \<sqsubseteq> x \<Longrightarrow> P" shows "P"
+  using assms comparable by auto
+
+lemma comparable_three_cases[consumes 2, case_names less eq greater]:
+  assumes "x \<in> A" and "y \<in> A" and "x \<sqsubset> y \<Longrightarrow> P" and "x \<sim> y \<Longrightarrow> P" and "y \<sqsubset> x \<Longrightarrow> P" shows "P"
+  using assms comparable by auto
+
+lemma
+  assumes x: "x \<in> A" and y: "y \<in> A"
+  shows not_iff_asym: "\<not>x \<sqsubseteq> y \<longleftrightarrow> y \<sqsubset> x"
+    and not_asym_iff[simp]: "\<not>x \<sqsubset> y \<longleftrightarrow> y \<sqsubseteq> x"
+  using comparable[OF x y] by auto
+
+lemma connex_subset: "B \<subseteq> A \<Longrightarrow> connex B (\<sqsubseteq>)"
+  by (intro connex.intro comparable, auto)
+
+end
+
+lemmas connexE = connex.comparable_cases
+
+lemmas connexI[intro] = connex.intro
+
+context
+  fixes less_eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
+begin
+
+lemma connex_iff_semiconnex_reflexive: "connex A (\<sqsubseteq>) \<longleftrightarrow> semiconnex A (\<sqsubseteq>) \<and> reflexive A (\<sqsubseteq>)"
+  (is "?c \<longleftrightarrow> ?t \<and> ?r")
+proof (intro iffI conjI; (elim conjE)?)
+  assume ?c then interpret connex.
+  show ?t apply unfold_locales using comparable by auto
+  show ?r by unfold_locales
+next
+  assume ?t then interpret semiconnex A "(\<sqsubseteq>)".
+  assume ?r then interpret reflexive.
+  from semiconnex show ?c by auto
+qed
+
+lemma chain_connect: "Complete_Partial_Order.chain r A \<equiv> connex A r"
+  by (auto intro!: ext simp: atomize_eq connex_def Complete_Partial_Order.chain_def)
+
+lemma connex_union:
+  assumes "connex X (\<sqsubseteq>)" and "connex Y (\<sqsubseteq>)" and "\<forall>x \<in> X. \<forall>y \<in> Y. x \<sqsubseteq> y \<or> y \<sqsubseteq> x"
+  shows "connex (X\<union>Y) (\<sqsubseteq>)"
+  using assms by (auto simp: connex_def)
+
+end
+
+lemma connex_cong:
+  assumes r: "\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> r a b \<longleftrightarrow> r' a b"
+  shows "connex A r \<longleftrightarrow> connex A r'"
+  by (simp add: connex_iff_semiconnex_reflexive r cong: semiconnex_cong reflexive_cong)
+
+locale total_pseudo_ordered_set = connex + antisymmetric
+begin
+
+sublocale pseudo_ordered_set ..
+
+lemma not_weak_iff:
+  assumes x: "x \<in> A" and y: "y \<in> A" shows "\<not> y \<sqsubseteq> x \<longleftrightarrow> x \<sqsubseteq> y \<and> x \<noteq> y"
+using x y by (cases rule: comparable_cases, auto intro:antisym)
+
+lemma total_pseudo_ordered_subset: "B \<subseteq> A \<Longrightarrow> total_pseudo_ordered_set B (\<sqsubseteq>)"
+  apply (intro_locales)
+  using antisymmetric_subset connex_subset by auto
+
+end
+
+lemma total_pseudo_ordered_set_cong:
+  assumes r: "\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> r a b \<longleftrightarrow> r' a b"
+  shows "total_pseudo_ordered_set A r \<longleftrightarrow> total_pseudo_ordered_set A r'"
+  by (simp add: total_pseudo_ordered_set_def r cong: connex_cong antisymmetric_cong)
+
+locale total_quasi_ordered_set = connex + transitive
+begin
+
+sublocale quasi_ordered_set ..
+
+lemma total_quasi_ordered_subset: "B \<subseteq> A \<Longrightarrow> total_quasi_ordered_set B (\<sqsubseteq>)"
+  using transitive_subset connex_subset by intro_locales
+
+end
+
+lemma total_quasi_ordered_set_cong:
+  assumes r: "\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> r a b \<longleftrightarrow> r' a b"
+  shows "total_quasi_ordered_set A r \<longleftrightarrow> total_quasi_ordered_set A r'"
+  by (simp add: total_quasi_ordered_set_def r cong: connex_cong transitive_cong)
+
+locale total_ordered_set = total_quasi_ordered_set + antisymmetric
+begin
+
+sublocale partially_ordered_set + total_pseudo_ordered_set ..
+
+lemma total_ordered_subset: "B \<subseteq> A \<Longrightarrow> total_ordered_set B (\<sqsubseteq>)"
+  using total_quasi_ordered_subset antisymmetric_subset by (intro total_ordered_set.intro)
+
+end
+
+lemma total_ordered_set_cong:
+  assumes r: "\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> r a b \<longleftrightarrow> r' a b"
+  shows "total_ordered_set A r \<longleftrightarrow> total_ordered_set A r'"
+  by (simp add: total_ordered_set_def r cong: total_quasi_ordered_set_cong antisymmetric_cong)
+
+subsection \<open>Well-Foundedness\<close>
+
+locale well_founded = related_set A "(\<sqsubset>)" for A and less (infix "\<sqsubset>" 50) +
+  assumes induct[consumes 1, case_names less, induct set]:
+    "a \<in> A \<Longrightarrow> (\<And>x. x \<in> A \<Longrightarrow> (\<And>y. y \<in> A \<Longrightarrow> y \<sqsubset> x \<Longrightarrow> P y) \<Longrightarrow> P x) \<Longrightarrow> P a"
+begin
+
+sublocale asymmetric
+proof (intro asymmetric.intro notI)
+  fix x y
+  assume xA: "x \<in> A"
+  then show "y \<in> A \<Longrightarrow> x \<sqsubset> y \<Longrightarrow> y \<sqsubset> x \<Longrightarrow> False"
+    by (induct arbitrary: y rule: induct, auto)
+qed
+
+lemma prefixed_Imagep_imp_empty:
+  assumes a: "X \<subseteq> ((\<sqsubset>) ``` X) \<inter> A" shows "X = {}"
+proof -
+  from a have XA: "X \<subseteq> A" by auto
+  have "x \<in> A \<Longrightarrow> x \<notin> X" for x
+  proof (induct x rule: induct)
+    case (less x)
+    with a show ?case by (auto simp: Imagep_def)
+  qed
+  with XA show ?thesis by auto
+qed
+
+lemma nonempty_imp_ex_extremal:
+  assumes QA: "Q \<subseteq> A" and Q: "Q \<noteq> {}"
+  shows "\<exists>z \<in> Q. \<forall>y \<in> Q. \<not> y \<sqsubset> z"
+  using Q prefixed_Imagep_imp_empty[of Q] QA by (auto simp: Imagep_def)
+
+interpretation Restrp: well_founded UNIV "(\<sqsubset>)\<restriction>A"
+  rewrites "\<And>x. x \<in> UNIV \<equiv> True"
+    and "(\<sqsubset>)\<restriction>A\<restriction>UNIV = (\<sqsubset>)\<restriction>A"
+    and "\<And>P1. (True \<Longrightarrow> PROP P1) \<equiv> PROP P1"
+    and "\<And>P1. (True \<Longrightarrow> P1) \<equiv> Trueprop P1"
+    and "\<And>P1 P2. (True \<Longrightarrow> PROP P1 \<Longrightarrow> PROP P2) \<equiv> (PROP P1 \<Longrightarrow> PROP P2)"
+proof -
+  have "(\<And>x. (\<And>y. ((\<sqsubset>) \<restriction> A) y x \<Longrightarrow> P y) \<Longrightarrow> P x) \<Longrightarrow> P a" for a P
+    using induct[of a P] by (auto simp: Restrp_def)
+  then show "well_founded UNIV ((\<sqsubset>)\<restriction>A)" apply unfold_locales by auto
+qed auto
+
+lemmas Restrp_well_founded = Restrp.well_founded_axioms
+lemmas Restrp_induct[consumes 0, case_names less] = Restrp.induct
+
+interpretation Restrp.tranclp: well_founded UNIV "((\<sqsubset>)\<restriction>A)\<^sup>+\<^sup>+"
+  rewrites "\<And>x. x \<in> UNIV \<equiv> True"
+    and "((\<sqsubset>)\<restriction>A)\<^sup>+\<^sup>+ \<restriction> UNIV = ((\<sqsubset>)\<restriction>A)\<^sup>+\<^sup>+"
+    and "(((\<sqsubset>)\<restriction>A)\<^sup>+\<^sup>+)\<^sup>+\<^sup>+ = ((\<sqsubset>)\<restriction>A)\<^sup>+\<^sup>+"
+    and "\<And>P1. (True \<Longrightarrow> PROP P1) \<equiv> PROP P1"
+    and "\<And>P1. (True \<Longrightarrow> P1) \<equiv> Trueprop P1"
+    and "\<And>P1 P2. (True \<Longrightarrow> PROP P1 \<Longrightarrow> PROP P2) \<equiv> (PROP P1 \<Longrightarrow> PROP P2)"
+proof-
+  { fix P x
+    assume induct_step: "\<And>x. (\<And>y. ((\<sqsubset>)\<restriction>A)\<^sup>+\<^sup>+ y x \<Longrightarrow> P y) \<Longrightarrow> P x"
+    have "P x"
+    proof (rule induct_step)
+      show "\<And>y. ((\<sqsubset>)\<restriction>A)\<^sup>+\<^sup>+ y x \<Longrightarrow> P y"
+      proof (induct x rule: Restrp_induct)
+        case (less x)
+        from \<open>((\<sqsubset>)\<restriction>A)\<^sup>+\<^sup>+ y x\<close>
+        show ?case
+        proof (cases rule: tranclp.cases)
+          case r_into_trancl
+          with induct_step less show ?thesis by auto
+        next
+          case (trancl_into_trancl b)
+          with less show ?thesis by auto
+        qed
+      qed
+    qed
+  }
+  then show "well_founded UNIV ((\<sqsubset>)\<restriction>A)\<^sup>+\<^sup>+" by unfold_locales auto
+qed auto
+
+lemmas Restrp_tranclp_well_founded = Restrp.tranclp.well_founded_axioms
+lemmas Restrp_tranclp_induct[consumes 0, case_names less] = Restrp.tranclp.induct
 
 end
 
 context
-  fixes less :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubset>" 50)
-begin
-
-lemma asymmetricI[intro]:
-  assumes "\<And>x y. x \<sqsubset> y \<Longrightarrow> y \<sqsubset> x \<Longrightarrow> False" 
-  shows "asymmetric (\<sqsubset>)"
-  apply unfold_locales using assms by auto
-
-lemma asymmetric_def': "asymmetric (\<sqsubset>) \<equiv> \<forall>x y. \<not> (x \<sqsubset> y \<and> y \<sqsubset> x)"
-  by (auto simp: atomize_eq dest!: asymmetric.asym)
-
-end
-
-locale well_founded = less_syntax +
-  assumes induct: "\<And>P a. (\<And>x. (\<And>y. y \<sqsubset> x \<Longrightarrow> P y) \<Longrightarrow> P x) \<Longrightarrow> P a"
+  fixes A :: "'a set" and less :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubset>" 50)
 begin
 
-lemma wfP[intro!]: "wfP (\<sqsubset>)" using induct wfPUNIVI by blast
-
-sublocale asymmetric
-proof (intro asymmetricI notI)
-  show "x \<sqsubset> y \<Longrightarrow> y \<sqsubset> x \<Longrightarrow> False" for x y by (induct x arbitrary: y rule: induct)
+lemma well_foundedI_pf:
+  assumes pre: "\<And>X. X \<subseteq> A \<Longrightarrow> X \<subseteq> ((\<sqsubset>) ``` X) \<inter> A \<Longrightarrow> X = {}"
+  shows "well_founded A (\<sqsubset>)"
+proof
+  fix P a assume aA: "a \<in> A" and Ind: "\<And>x. x \<in> A \<Longrightarrow> (\<And>y. y \<in> A \<Longrightarrow> y \<sqsubset> x \<Longrightarrow> P y) \<Longrightarrow> P x"
+  from Ind have "{a\<in>A. \<not>P a} \<subseteq> ((\<sqsubset>) ``` {a\<in>A. \<not>P a}) \<inter> A" by (auto simp: Imagep_def)
+  from pre[OF _ this] aA
+  show "P a" by auto
 qed
 
-end
-
-subsubsection \<open>Combined Properties\<close>
-
-text \<open>Some combinations of the above basic properties are given names.\<close>
-
-locale quasi_order = reflexive + transitive
-
-locale near_order = antisymmetric + transitive
-
-locale pseudo_order = reflexive + antisymmetric
-begin
-
-lemma equiv_eq[simp]: "x \<sqsubseteq> y \<and> y \<sqsubseteq> x \<longleftrightarrow> x = y" by auto
-
-lemma extreme_bound_singleton_eq[simp]: "extreme_bound (\<sqsubseteq>) {x} y \<longleftrightarrow> x = y" by auto
-
-lemma eq_iff: "x = y \<longleftrightarrow> x \<sqsubseteq> y \<and> y \<sqsubseteq> x" by auto
-
-lemma extreme_order_iff_eq[simp]: "extreme (\<sqsubseteq>) {x. x \<sqsubseteq> e} s \<longleftrightarrow> e = s" by auto
+lemma well_foundedI_extremal:
+  assumes a: "\<And>X. X \<subseteq> A \<Longrightarrow> X \<noteq> {} \<Longrightarrow> \<exists>x \<in> X. \<forall>y \<in> X. \<not> y \<sqsubset> x"
+  shows "well_founded A (\<sqsubset>)"
+proof (rule well_foundedI_pf)
+  fix X assume XA: "X \<subseteq> A" and pf: "X \<subseteq> ((\<sqsubset>) ``` X) \<inter> A"
+  from a[OF XA] pf show "X = {}" by (auto simp: Imagep_def)
+qed
+
+lemma well_founded_iff_ex_extremal:
+  "well_founded A (\<sqsubset>) \<longleftrightarrow> (\<forall>X \<subseteq> A. X \<noteq> {} \<longrightarrow> (\<exists>x \<in> X. \<forall>z \<in> X. \<not> z \<sqsubset> x))"
+  using well_founded.nonempty_imp_ex_extremal well_foundedI_extremal by blast
 
 end
 
-locale partial_order = quasi_order + antisymmetric
-
-sublocale partial_order \<subseteq> pseudo_order + near_order ..
-
-locale strict_order = irreflexive + transitive "(\<sqsubset>)"
-
-sublocale strict_order \<subseteq> asymmetric by (auto dest: trans)
-sublocale strict_order \<subseteq> near_order "(\<sqsubset>)" ..
-
-locale well_founded_order = well_founded + transitive "(\<sqsubset>)"
-
-sublocale well_founded_order \<subseteq> strict_order ..
-
-locale tolerance = equivalence_syntax + reflexive "(\<sim>)" + symmetric "(\<sim>)"
-
-locale partial_equivalence = equivalence_syntax + symmetric "(\<sim>)" + transitive "(\<sim>)"
-
-locale equivalence = equivalence_syntax + symmetric "(\<sim>)" + quasi_order "(\<sim>)"
-
-sublocale equivalence \<subseteq> partial_equivalence ..
-
-text \<open>Some combinations lead to uninteresting relations.\<close>
-
-proposition reflexive_irreflexive_is_empty:
-  assumes "reflexive r" and "irreflexive r"
-  shows "r = (\<lambda>x y. False)"
-proof(intro ext iffI)
-  interpret irreflexive r + reflexive r using assms by auto
-  fix x y
-  assume "r x y"
-  with irrefl have "x \<noteq> y" by auto
-  with refl show False by auto
-qed auto
-
-proposition symmetric_antisymmetric_imp_eq:
-  assumes "symmetric r" and "antisymmetric r"
-  shows "r x y \<Longrightarrow> x = y"
-proof-
-  interpret symmetric r + antisymmetric r using assms by auto
-  fix x y
-  assume "r x y"
-  with sym[OF this] show "x = y" by auto
+lemma well_founded_cong:
+  assumes r: "\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> r a b \<longleftrightarrow> r' a b"
+    and A: "\<And>a b. r' a b \<Longrightarrow> a \<in> A \<longleftrightarrow> a \<in> A'"
+    and B: "\<And>a b. r' a b \<Longrightarrow> b \<in> A \<longleftrightarrow> b \<in> A'"
+  shows "well_founded A r \<longleftrightarrow> well_founded A' r'"
+proof (intro iffI)
+  assume wf: "well_founded A r"
+  show "well_founded A' r'"
+  proof (intro well_foundedI_extremal)
+    fix X
+    assume X: "X \<subseteq> A'" and X0: "X \<noteq> {}"
+    show "\<exists>x\<in>X. \<forall>y\<in>X. \<not> r' y x"
+    proof (cases "X \<inter> A = {}")
+      case True
+      from X0 obtain x where xX: "x \<in> X" by auto
+      with True have "x \<notin> A" by auto
+      with xX X have "\<forall>y\<in>X. \<not> r' y x" by (auto simp: B)
+      with xX show ?thesis by auto
+    next
+      case False
+      from well_founded.nonempty_imp_ex_extremal[OF wf _ this]
+      obtain x where x: "x \<in> X \<inter> A" and Ar: "\<And>y. y \<in> X \<Longrightarrow> y \<in> A \<Longrightarrow> \<not> r y x" by auto
+      have "\<forall>y \<in> X. \<not> r' y x"
+      proof (intro ballI notI)
+        fix y assume yX: "y \<in> X" and yx: "r' y x"
+        from yX X have yA': "y \<in> A'" by auto
+        show False
+        proof (cases "y \<in> A")
+          case True with x Ar[OF yX] yx r show ?thesis by auto
+        next
+          case False with yA' x A[OF yx] r X show ?thesis by (auto simp:)
+        qed
+      qed
+      with x show "\<exists>x \<in> X. \<forall>y \<in> X. \<not> r' y x" by auto
+    qed
+  qed
+next
+  assume wf: "well_founded A' r'"
+  show "well_founded A r"
+  proof (intro well_foundedI_extremal)
+    fix X
+    assume X: "X \<subseteq> A" and X0: "X \<noteq> {}"
+    show "\<exists>x\<in>X. \<forall>y\<in>X. \<not> r y x"
+    proof (cases "X \<inter> A' = {}")
+      case True
+      from X0 obtain x where xX: "x \<in> X" by auto
+      with True have "x \<notin> A'" by auto
+      with xX X B have "\<forall>y\<in>X. \<not> r y x" by (auto simp: r in_mono)
+      with xX show ?thesis by auto
+    next
+      case False
+      from well_founded.nonempty_imp_ex_extremal[OF wf _ this]
+      obtain x where x: "x \<in> X \<inter> A'" and Ar: "\<And>y. y \<in> X \<Longrightarrow> y \<in> A' \<Longrightarrow> \<not> r' y x" by auto
+      have "\<forall>y \<in> X. \<not> r y x"
+      proof (intro ballI notI)
+        fix y assume yX: "y \<in> X" and yx: "r y x"
+        from yX X have y: "y \<in> A" by auto
+        show False
+        proof (cases "y \<in> A'")
+          case True with x Ar[OF yX] yx r X y show ?thesis by auto
+        next
+          case False with y x A yx r X show ?thesis by auto
+        qed
+      qed
+      with x show "\<exists>x \<in> X. \<forall>y \<in> X. \<not> r y x" by auto
+    qed
+  qed
 qed
 
-proposition nontolerance:
-  fixes r (infix "\<bowtie>" 50)
-  shows "irreflexive (\<bowtie>) \<and> symmetric (\<bowtie>) \<longleftrightarrow> tolerance (\<lambda>x y. \<not> x \<bowtie> y)"
-proof safe
-  assume "irreflexive (\<bowtie>)" and "symmetric (\<bowtie>)"
-  then interpret irreflexive "(\<bowtie>)" + symmetric "(\<bowtie>)".
-  show "tolerance (\<lambda>x y. \<not> x \<bowtie> y)" by (unfold_locales, auto dest: sym)
+lemma wfP_iff_well_founded_UNIV: "wfP r \<longleftrightarrow> well_founded UNIV r"
+  by (auto simp: wfP_def wf_def well_founded_def)
+
+lemma well_founded_singleton:
+  assumes "\<not>r x x" shows "well_founded {x} r"
+  using assms by (auto simp: well_founded_iff_ex_extremal)
+
+lemma well_founded_Restrp[simp]: "well_founded A (r\<restriction>B) \<longleftrightarrow> well_founded (A\<inter>B) r" (is "?l \<longleftrightarrow> ?r")
+proof (intro iffI well_foundedI_extremal)
+  assume l: ?l
+  fix X assume XAB: "X \<subseteq> A \<inter> B" and X0: "X \<noteq> {}"
+  with l[THEN well_founded.nonempty_imp_ex_extremal]
+  have "\<exists>x\<in>X. \<forall>z\<in>X. \<not> (r \<restriction> B) z x" by auto
+  with XAB show "\<exists>x\<in>X. \<forall>y\<in>X. \<not> r y x" by (auto simp: Restrp_def)
 next
-  assume "tolerance (\<lambda>x y. \<not> x \<bowtie> y)"
-  then interpret tolerance "\<lambda>x y. \<not> x \<bowtie> y".
-  show "irreflexive (\<bowtie>)" by auto
-  show "symmetric (\<bowtie>)" using sym by auto
+  assume r: ?r
+  fix X assume XA: "X \<subseteq> A" and X0: "X \<noteq> {}"
+  show "\<exists>x\<in>X. \<forall>y\<in>X. \<not> (r \<restriction> B) y x"
+  proof (cases "X \<subseteq> B")
+    case True
+    with r[THEN well_founded.nonempty_imp_ex_extremal, of X] XA X0
+    have "\<exists>z\<in>X. \<forall>y\<in>X. \<not> r y z" by auto
+    then show ?thesis by auto
+  next
+    case False
+    then obtain x where x: "x \<in> X - B" by auto
+    then have "\<forall>y\<in>X. \<not> (r \<restriction> B) y x" by auto
+    with x show ?thesis by auto
+  qed
 qed
 
-proposition irreflexive_transitive_symmetric_is_empty:
-  assumes "irreflexive r" and "transitive r" and "symmetric r"
-  shows "r = (\<lambda>x y. False)"
-proof(intro ext iffI)
-  interpret strict_order r using assms by (unfold strict_order_def, auto)
-  interpret symmetric r using assms by auto
-  fix x y
-  assume "r x y"
-  also note sym[OF this]
-  finally have "r x x".
-  then show False by auto
-qed auto
-
-subsection \<open>Totality\<close>
-
-locale total = less_syntax + assumes total: "x \<sqsubset> y \<or> x = y \<or> y \<sqsubset> x"
+lemma (in well_founded) well_founded_subset:
+  assumes "B \<subseteq> A" shows "well_founded B (\<sqsubset>)"
+  using assms well_founded_axioms by (auto simp: well_founded_iff_ex_extremal)
+
+lemma well_founded_extend:
+  fixes less (infix "\<sqsubset>" 50)
+  assumes A: "well_founded A (\<sqsubset>)"
+  assumes B: "well_founded B (\<sqsubset>)"
+  assumes AB: "\<forall>a \<in> A. \<forall>b \<in> B. \<not>b \<sqsubset> a"
+  shows "well_founded (A \<union> B) (\<sqsubset>)"
+proof (intro well_foundedI_extremal)
+  interpret A: well_founded A "(\<sqsubset>)" using A.
+  interpret B: well_founded B "(\<sqsubset>)" using B.
+  fix X assume XAB: "X \<subseteq> A \<union> B" and X0: "X \<noteq> {}"
+  show "\<exists>x\<in>X. \<forall>y\<in>X. \<not> y \<sqsubset> x"
+  proof (cases "X \<inter> A = {}")
+    case True
+    with XAB have XB: "X \<subseteq> B" by auto
+    from B.nonempty_imp_ex_extremal[OF XB X0] show ?thesis.
+  next
+    case False
+    with A.nonempty_imp_ex_extremal[OF _ this]
+    obtain e where XAe: "e \<in> X \<inter> A" "\<forall>y\<in>X \<inter> A. \<not> y \<sqsubset> e" by auto
+    then have eX: "e \<in> X" and eA: "e \<in> A" by auto
+    { fix x assume xX: "x \<in> X"
+      have "\<not>x \<sqsubset> e"
+      proof (cases "x \<in> A")
+        case True with XAe xX show ?thesis by auto
+      next
+        case False
+        with xX XAB have "x \<in> B" by auto
+        with AB eA show ?thesis by auto
+      qed
+    }
+    with eX show ?thesis by auto
+  qed
+qed
+
+lemma closed_UN_well_founded:
+  fixes r (infix "\<sqsubset>" 50)
+  assumes XX: "\<forall>X\<in>XX. well_founded X (\<sqsubset>) \<and> (\<forall>x\<in>X. \<forall>y\<in>\<Union>XX. y \<sqsubset> x \<longrightarrow> y \<in> X)"
+  shows "well_founded (\<Union>XX) (\<sqsubset>)"
+proof (intro well_foundedI_extremal)
+  have *: "X \<in> XX \<Longrightarrow> x\<in>X \<Longrightarrow> y \<in> \<Union>XX \<Longrightarrow> y \<sqsubset> x \<Longrightarrow> y \<in> X" for X x y using XX by blast
+  fix S
+  assume S: "S \<subseteq> \<Union>XX" and S0: "S \<noteq> {}"
+  from S0 obtain x where xS: "x \<in> S" by auto
+  with S obtain X where X: "X \<in> XX" and xX: "x \<in> X" by auto
+  from xS xX have Sx0: "S \<inter> X \<noteq> {}" by auto
+  from X XX interpret well_founded X "(\<sqsubset>)" by auto
+  from nonempty_imp_ex_extremal[OF _ Sx0]
+  obtain z where zS: "z \<in> S" and zX: "z \<in> X" and min: "\<forall>y \<in> S \<inter> X. \<not> y \<sqsubset> z" by auto
+  show "\<exists>x\<in>S. \<forall>y\<in>S. \<not> y \<sqsubset> x"
+  proof (intro bexI[OF _ zS] ballI notI)
+    fix y
+    assume yS: "y \<in> S" and yz: "y \<sqsubset> z"
+    have yXX: "y \<in> \<Union> XX" using S yS by auto
+    from *[OF X zX yXX yz] yS have "y \<in> X \<inter> S" by auto
+    with min yz show False by auto
+  qed
+qed
+
+lemma well_founded_cmono:
+  assumes r': "r' \<le> r" and wf: "well_founded A r"
+  shows "well_founded A r'"
+proof (intro well_foundedI_extremal)
+  fix X assume "X \<subseteq> A" and "X \<noteq> {}"
+  from well_founded.nonempty_imp_ex_extremal[OF wf this]
+  show "\<exists>x\<in>X. \<forall>y\<in>X. \<not> r' y x" using r' by auto
+qed
+
+locale well_founded_ordered_set = well_founded + transitive _ "(\<sqsubset>)"
 begin
 
-lemma cases[case_names less eq greater]:
-  assumes "x \<sqsubset> y \<Longrightarrow> P" and "x = y \<Longrightarrow> P" and "y \<sqsubset> x \<Longrightarrow> P"
-  shows "P" using total assms by auto
-
-lemma neqE: "x \<noteq> y \<Longrightarrow> (x \<sqsubset> y \<Longrightarrow> P) \<Longrightarrow> (y \<sqsubset> x \<Longrightarrow> P) \<Longrightarrow> P" by (cases x y rule: cases, auto)
+sublocale strict_ordered_set..
+
+interpretation Restrp: strict_ordered_set UNIV "(\<sqsubset>)\<restriction>A" + Restrp: well_founded UNIV "(\<sqsubset>)\<restriction>A"
+  using Restrp_strict_order Restrp_well_founded .
+
+lemma Restrp_well_founded_order: "well_founded_ordered_set UNIV ((\<sqsubset>)\<restriction>A)"..
+
+lemma well_founded_ordered_subset: "B \<subseteq> A \<Longrightarrow> well_founded_ordered_set B (\<sqsubset>)"
+  apply intro_locales
+  using well_founded_subset transitive_subset by auto
 
 end
-lemmas totalI[intro] = total.intro
-
-text \<open>Totality is negated antisymmetry \cite[Proposition 2.2.4]{Schmidt1993}.\<close>
-proposition total_iff_neg_antisymmetric:
-  fixes less (infix "\<sqsubset>" 50)
-  shows "total (\<sqsubset>) \<longleftrightarrow> antisymmetric (\<lambda>x y. \<not> x \<sqsubset> y)" (is "?l \<longleftrightarrow> ?r")
-proof (intro iffI totalI antisymmetricI)
-  assume ?l
-  then interpret total.
-  fix x y
-  assume "\<not> x \<sqsubset> y" and "\<not> y \<sqsubset> x"
-  then show "x = y" by (cases x y rule: cases, auto)
-next
-  assume ?r
-  then interpret neg: antisymmetric "(\<lambda>x y. \<not> x \<sqsubset> y)".
-  fix x y
-  show "x \<sqsubset> y \<or> x = y \<or> y \<sqsubset> x" using neg.antisym by auto
+
+lemma (in well_founded) Restrp_tranclp_well_founded_ordered: "well_founded_ordered_set UNIV ((\<sqsubset>)\<restriction>A)\<^sup>+\<^sup>+"
+  using Restrp_tranclp_well_founded tranclp_transitive by intro_locales
+
+locale well_related_set = related_set +
+  assumes nonempty_imp_ex_extreme: "X \<subseteq> A \<Longrightarrow> X \<noteq> {} \<Longrightarrow> \<exists>e. extreme X (\<sqsubseteq>)\<^sup>- e"
+begin
+
+sublocale connex
+proof
+  fix x y assume "x \<in> A" and "y \<in> A"
+  with nonempty_imp_ex_extreme[of "{x,y}"] show "x \<sqsubseteq> y \<or> y \<sqsubseteq> x" by auto 
 qed
 
-locale total_irreflexive = total + irreflexive
-begin
-
-lemma neq_iff: "x \<noteq> y \<longleftrightarrow> x \<sqsubset> y \<or> y \<sqsubset> x" by (auto elim:neqE)
-
-end
-
-locale total_reflexive = reflexive + weak: total "(\<sqsubseteq>)"
-begin
-
-lemma comparable: "x \<sqsubseteq> y \<or> y \<sqsubseteq> x" by (cases x y rule:weak.cases, auto)
-
-lemma comparable_cases[case_names le ge]:
-  assumes "x \<sqsubseteq> y \<Longrightarrow> P" and "y \<sqsubseteq> x \<Longrightarrow> P" shows "P" using assms comparable by auto
-
-lemma chain_UNIV: "chain (\<sqsubseteq>) UNIV" by (intro chainI comparable)
+lemmas connex_axioms = connex_axioms
+
+interpretation less_eq_notations.
+
+sublocale asym: well_founded A "(\<sqsubset>)"
+proof (unfold well_founded_iff_ex_extremal, intro allI impI)
+  fix X
+  assume XA: "X \<subseteq> A" and X0: "X \<noteq> {}"
+  from nonempty_imp_ex_extreme[OF XA X0] obtain e where "extreme X (\<sqsubseteq>)\<^sup>- e" by auto
+  then show "\<exists>x\<in>X. \<forall>z\<in>X. \<not>z \<sqsubset> x" by (auto intro!: bexI[of _ e])
+qed
+
+lemma well_related_subset: "B \<subseteq> A \<Longrightarrow> well_related_set B (\<sqsubseteq>)"
+  by (auto intro!: well_related_set.intro nonempty_imp_ex_extreme)
 
 end
 
 context
   fixes less_eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
 begin
 
-lemma total_reflexiveI[intro]:
-  assumes "\<And>x y. x \<sqsubseteq> y \<or> y \<sqsubseteq> x" shows "total_reflexive (\<sqsubseteq>)"
-  using assms by (unfold_locales, auto)
-
-lemma total_reflexive_def': "total_reflexive (\<sqsubseteq>) \<equiv> \<forall>x y. x \<sqsubseteq> y \<or> y \<sqsubseteq> x"
-  by (unfold atomize_eq, auto dest: total_reflexive.comparable)
-
-end
-
-locale total_pseudo_order = total_reflexive + antisymmetric
-begin
-
-sublocale pseudo_order ..
-
-lemma not_weak_iff: "\<not> y \<sqsubseteq> x \<longleftrightarrow> x \<sqsubseteq> y \<and> x \<noteq> y" by (cases x y rule:comparable_cases, auto)
+lemma well_related_iff_neg_well_founded:
+  "well_related_set A (\<sqsubseteq>) \<longleftrightarrow> well_founded A (\<lambda>x y. \<not> y \<sqsubseteq> x)"
+  by (simp add: well_related_set_def well_founded_iff_ex_extremal extreme_def Bex_def)
+
+lemma well_related_singleton_refl: 
+  assumes "x \<sqsubseteq> x" shows "well_related_set {x} (\<sqsubseteq>)"
+  by (intro well_related_set.intro exI[of _ x], auto simp: subset_singleton_iff assms)
+
+lemma closed_UN_well_related:
+  assumes XX: "\<forall>X\<in>XX. well_related_set X (\<sqsubseteq>) \<and> (\<forall>x\<in>X. \<forall>y\<in>\<Union>XX. \<not>x \<sqsubseteq> y \<longrightarrow> y \<in> X)"
+  shows "well_related_set (\<Union>XX) (\<sqsubseteq>)"
+  using XX
+  apply (unfold well_related_iff_neg_well_founded)
+  using closed_UN_well_founded[of _ "\<lambda>x y. \<not> y \<sqsubseteq> x"].
 
 end
 
-locale total_quasi_order = total_reflexive + transitive
+lemma well_related_extend:
+  fixes r (infix "\<sqsubseteq>" 50)
+  assumes "well_related_set A (\<sqsubseteq>)" and "well_related_set B (\<sqsubseteq>)" and "\<forall>a \<in> A. \<forall>b \<in> B. a \<sqsubseteq> b"
+  shows "well_related_set (A \<union> B) (\<sqsubseteq>)"
+  using well_founded_extend[of _ "\<lambda>x y. \<not> y \<sqsubseteq> x", folded well_related_iff_neg_well_founded]
+  using assms by auto
+
+locale pre_well_ordered_set = semiattractive + well_related_set
 begin
 
-sublocale quasi_order ..
+interpretation less_eq_notations.
+
+sublocale transitive
+proof
+  fix x y z assume xy: "x \<sqsubseteq> y" and yz: "y \<sqsubseteq> z" and x: "x \<in> A" and y: "y \<in> A" and z: "z \<in> A"
+  from x y z have "\<exists>e. extreme {x,y,z} (\<sqsupseteq>) e" (is "\<exists>e. ?P e") by (auto intro!: nonempty_imp_ex_extreme)
+  then have "?P x \<or> ?P y \<or> ?P z" by auto
+  then show "x \<sqsubseteq> z"
+  proof (elim disjE)
+    assume "?P x"
+    then show ?thesis by auto
+  next
+    assume "?P y"
+    then have "y \<sqsubseteq> x" by auto
+    from attract[OF xy this yz] x y z show ?thesis by auto
+  next
+    assume "?P z"
+    then have zx: "z \<sqsubseteq> x" and zy: "z \<sqsubseteq> y" by auto
+    from attract[OF yz zy zx] x y z have yx: "y \<sqsubseteq> x" by auto
+    from attract[OF xy yx yz] x y z show ?thesis by auto
+  qed
+qed
+
+sublocale total_quasi_ordered_set..
+
+lemmas connex_axioms = connex_axioms
+
+lemma strict_weak_trans[trans]:
+  assumes xy: "x \<sqsubset> y" and yz: "y \<sqsubseteq> z" and x: "x \<in> A" and y: "y \<in> A" and z: "z \<in> A"
+  shows "x \<sqsubset> z"
+proof (intro asympartpI notI)
+  from trans xy yz x y z show "x \<sqsubseteq> z" by auto
+  assume "z \<sqsubseteq> x"
+  from trans[OF yz this] y z x have "y \<sqsubseteq> x" by auto
+  with xy show False by auto
+qed
+
+lemma weak_strict_trans[trans]:
+  assumes xy: "x \<sqsubseteq> y" and yz: "y \<sqsubset> z" and x: "x \<in> A" and y: "y \<in> A" and z: "z \<in> A"
+  shows "x \<sqsubset> z"
+proof (intro asympartpI notI)
+  from trans xy yz x y z show "x \<sqsubseteq> z" by auto
+  assume "z \<sqsubseteq> x"
+  from trans[OF this xy] z x y have "z \<sqsubseteq> y" by auto
+  with yz show False by auto
+qed
 
 end
 
-locale total_order = total_quasi_order + antisymmetric
+lemma pre_well_ordered_iff:
+  "pre_well_ordered_set A r \<longleftrightarrow> total_quasi_ordered_set A r \<and> well_founded A (asympartp r)"
+  (is "?p \<longleftrightarrow> ?t \<and> ?w")
+proof safe
+  assume ?p
+  then interpret pre_well_ordered_set A r.
+  show ?t ?w by unfold_locales
+next
+  assume ?t
+  then interpret total_quasi_ordered_set A r.
+  assume ?w
+  then have "well_founded UNIV (asympartp r \<restriction> A)" by simp
+  also have "asympartp r \<restriction> A = (\<lambda>x y. \<not> r y x) \<restriction> A" by (intro ext, auto simp: not_iff_asym)
+  finally have "well_related_set A r" by (simp add: well_related_iff_neg_well_founded)
+  then show ?p by intro_locales
+qed
+
+lemma (in semiattractive) pre_well_ordered_iff_well_related:
+  assumes XA: "X \<subseteq> A"
+  shows "pre_well_ordered_set X (\<sqsubseteq>) \<longleftrightarrow> well_related_set X (\<sqsubseteq>)" (is "?l \<longleftrightarrow> ?r")
+proof
+  interpret X: semiattractive X using semiattractive_subset[OF XA].
+  { assume ?l
+    then interpret X: pre_well_ordered_set X.
+    show ?r by unfold_locales
+  }
+  assume ?r
+  then interpret X: well_related_set X.
+  show ?l by unfold_locales
+qed
+
+lemma semiattractive_extend:
+  fixes r (infix "\<sqsubseteq>" 50)
+  assumes A: "semiattractive A (\<sqsubseteq>)" and B: "semiattractive B (\<sqsubseteq>)"
+    and AB: "\<forall>a \<in> A. \<forall>b \<in> B. a \<sqsubseteq> b \<and> \<not> b \<sqsubseteq> a"
+  shows "semiattractive (A \<union> B) (\<sqsubseteq>)"
+proof-
+  interpret A: semiattractive A "(\<sqsubseteq>)" using A.
+  interpret B: semiattractive B "(\<sqsubseteq>)" using B.
+  {
+    fix x y z
+    assume yB: "y \<in> B" and zA: "z \<in> A" and yz: "y \<sqsubseteq> z"
+    have False using AB[rule_format, OF zA yB] yz by auto
+  }
+  note * = this
+  show ?thesis 
+    by (auto intro!: semiattractive.intro dest:* AB[rule_format] A.attract B.attract)
+qed
+
+lemma pre_well_order_extend:
+  fixes r (infix "\<sqsubseteq>" 50)
+  assumes A: "pre_well_ordered_set A (\<sqsubseteq>)" and B: "pre_well_ordered_set B (\<sqsubseteq>)"
+    and AB: "\<forall>a \<in> A. \<forall>b \<in> B. a \<sqsubseteq> b \<and> \<not> b \<sqsubseteq> a"
+  shows "pre_well_ordered_set (A\<union>B) (\<sqsubseteq>)"
+proof-
+  interpret A: pre_well_ordered_set A "(\<sqsubseteq>)" using A.
+  interpret B: pre_well_ordered_set B "(\<sqsubseteq>)" using B.
+  show ?thesis
+    apply (intro pre_well_ordered_set.intro well_related_extend semiattractive_extend)
+    apply unfold_locales
+    by (auto dest: AB[rule_format])
+qed
+
+locale well_ordered_set = antisymmetric + well_related_set
 begin
 
-sublocale partial_order + total_pseudo_order ..
+sublocale pre_well_ordered_set..
+
+sublocale total_ordered_set..
+
+lemma well_ordered_subset: "B \<subseteq> A \<Longrightarrow> well_ordered_set B (\<sqsubseteq>)"
+  using well_related_subset antisymmetric_subset by (intro well_ordered_set.intro)
+
+lemmas connex_axioms = connex_axioms
 
 end
 
-text \<open>A strict total order defines a total weak order, so we will formalize
-it after giving locales for pair of weak and strict parts.\<close>
+lemma (in antisymmetric) well_ordered_iff_well_related:
+  assumes XA: "X \<subseteq> A"
+  shows "well_ordered_set X (\<sqsubseteq>) \<longleftrightarrow> well_related_set X (\<sqsubseteq>)" (is "?l \<longleftrightarrow> ?r")
+proof
+  interpret X: antisymmetric X using antisymmetric_subset[OF XA].
+  { assume ?l
+    then interpret X: well_ordered_set X.
+    show ?r by unfold_locales
+  }
+  assume ?r
+  then interpret X: well_related_set X.
+  show ?l by unfold_locales
+qed
+
+context
+  fixes A and less_eq (infix "\<sqsubseteq>" 50)
+  assumes A: "\<forall>a \<in> A. \<forall>b \<in> A. a \<sqsubseteq> b"
+begin
+
+interpretation well_related_set A "(\<sqsubseteq>)"
+  apply unfold_locales
+  using A by blast
+
+lemmas trivial_well_related = well_related_set_axioms
+
+lemma trivial_pre_well_order: "pre_well_ordered_set A (\<sqsubseteq>)"
+  apply unfold_locales
+  using A by blast
+
+end
+
+context
+  fixes less_eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
+begin
+
+interpretation less_eq_notations.
+
+lemma well_order_extend:
+  assumes A: "well_ordered_set A (\<sqsubseteq>)" and B: "well_ordered_set B (\<sqsubseteq>)"
+    and ABa: "\<forall>a \<in> A. \<forall>b \<in> B. a \<sqsubseteq> b \<longrightarrow> b \<sqsubseteq> a \<longrightarrow> a = b"
+    and AB: "\<forall>a \<in> A. \<forall>b \<in> B. a \<sqsubseteq> b"
+  shows "well_ordered_set (A\<union>B) (\<sqsubseteq>)"
+proof-
+  interpret A: well_ordered_set A "(\<sqsubseteq>)" using A.
+  interpret B: well_ordered_set B "(\<sqsubseteq>)" using B.
+  show ?thesis
+    apply (intro well_ordered_set.intro antisymmetric_union well_related_extend ABa AB)
+    by unfold_locales
+qed
+
+interpretation singleton: antisymmetric "{a}" "(\<sqsubseteq>)" for a apply unfold_locales by auto
+
+lemmas singleton_antisymmetric[intro!] = singleton.antisymmetric_axioms
+
+lemma singleton_well_ordered[intro!]: "a \<sqsubseteq> a \<Longrightarrow> well_ordered_set {a} (\<sqsubseteq>)"
+  apply unfold_locales by auto
+
+lemma closed_UN_well_ordered:
+  assumes anti: "antisymmetric (\<Union> XX) (\<sqsubseteq>)"
+    and XX: "\<forall>X\<in>XX. well_ordered_set X (\<sqsubseteq>) \<and> (\<forall>x\<in>X. \<forall>y\<in>\<Union>XX. \<not> x \<sqsubseteq> y \<longrightarrow> y \<in> X)"
+  shows "well_ordered_set (\<Union>XX) (\<sqsubseteq>)"
+  apply (intro well_ordered_set.intro closed_UN_well_related anti)
+  using XX well_ordered_set.axioms by fast
+
+end
+
+text \<open>Directed sets:\<close>
+
+definition "directed A r \<equiv> \<forall>x \<in> A. \<forall>y \<in> A. \<exists>z \<in> A. r x z \<and> r y z"
+
+lemmas directedI[intro] = directed_def[unfolded atomize_eq, THEN iffD2, rule_format]
+
+lemmas directedD = directed_def[unfolded atomize_eq, THEN iffD1, rule_format]
+
+context
+  fixes less_eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
+begin
+
+lemma directedE:
+  assumes "directed A (\<sqsubseteq>)" and "x \<in> A" and "y \<in> A"
+    and "\<And>z. z \<in> A \<Longrightarrow> x \<sqsubseteq> z \<Longrightarrow> y \<sqsubseteq> z \<Longrightarrow> thesis"
+  shows "thesis"
+  using assms by (auto dest: directedD)
+
+lemma directed_empty[simp]: "directed {} (\<sqsubseteq>)" by auto
+
+lemma directed_union:
+  assumes dX: "directed X (\<sqsubseteq>)" and dY: "directed Y (\<sqsubseteq>)"
+    and XY: "\<forall>x\<in>X. \<forall>y\<in>Y. \<exists>z \<in> X \<union> Y. x \<sqsubseteq> z \<and> y \<sqsubseteq> z"
+  shows "directed (X \<union> Y) (\<sqsubseteq>)"
+  using directedD[OF dX] directedD[OF dY] XY
+  apply (intro directedI) by blast
+
+lemma directed_extend:
+  assumes X: "directed X (\<sqsubseteq>)" and Y: "directed Y (\<sqsubseteq>)" and XY: "\<forall>x\<in>X. \<forall>y\<in>Y. x \<sqsubseteq> y"
+  shows "directed (X \<union> Y) (\<sqsubseteq>)"
+proof -
+  { fix x y
+    assume xX: "x \<in> X" and yY: "y \<in> Y"
+    let ?g = "\<exists>z\<in>X \<union> Y. x \<sqsubseteq> z \<and> y \<sqsubseteq> z"
+    from directedD[OF Y yY yY] obtain z where zY: "z \<in> Y" and yz: "y \<sqsubseteq> z" by auto
+    from xX XY zY yz have ?g by auto
+  }
+  then show ?thesis by (auto intro!: directed_union[OF X Y])
+qed
+
+end
+
+context connex begin
+
+lemma directed: "directed A (\<sqsubseteq>)"
+proof
+  fix x y
+  assume x: "x \<in> A" and y: "y \<in> A"
+  then show "\<exists>z\<in>A. x \<sqsubseteq> z \<and> y \<sqsubseteq> z"
+  proof (cases rule: comparable_cases)
+    case le
+    with refl[OF y] y show ?thesis by (intro bexI[of _ y], auto)
+  next
+    case ge
+    with refl[OF x] x show ?thesis by (intro bexI[of _ x], auto)
+  qed
+qed
+
+end
+
+context
+  fixes ir :: "'i \<Rightarrow> 'i \<Rightarrow> bool" (infix "\<preceq>" 50)
+  fixes r :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
+begin
+
+lemma monotone_connex_image:
+  assumes mono: "monotone_on I (\<preceq>) (\<sqsubseteq>) f"
+  assumes connex: "connex I (\<preceq>)"
+  shows "connex (f ` I) (\<sqsubseteq>)"
+proof (rule connexI)
+  fix x y
+  assume "x \<in> f ` I" and "y \<in> f ` I"
+  then obtain i j where ij: "i \<in> I" "j \<in> I" and [simp]: "x = f i" "y = f j" by auto
+  from connex ij have "i \<preceq> j \<or> j \<preceq> i" by (auto elim: connexE)
+  with ij mono show "x \<sqsubseteq> y \<or> y \<sqsubseteq> x" by (elim disjE, auto dest: monotone_onD) 
+qed
+
+lemma monotone_directed_image:
+  assumes mono: "monotone_on I (\<preceq>) (\<sqsubseteq>) f"
+  assumes dir: "directed I (\<preceq>)" shows "directed (f ` I) (\<sqsubseteq>)"
+proof (rule directedI, safe)
+  fix x y assume x: "x \<in> I" and y: "y \<in> I"
+  with dir obtain z where z: "z \<in> I" and "x \<preceq> z" and "y \<preceq> z" by (auto elim: directedE)
+  with mono x y have "f x \<sqsubseteq> f z" and "f y \<sqsubseteq> f z" by (auto dest: monotone_onD)
+  with z show "\<exists>fz \<in> f ` I. f x \<sqsubseteq> fz \<and> f y \<sqsubseteq> fz" by auto
+qed
+
+end
 
 subsection \<open>Order Pairs\<close>
 
-locale compatible_ordering = less_eq_syntax + less_syntax + reflexive "(\<sqsubseteq>)" + irreflexive "(\<sqsubset>)" +
-  assumes weak_strict_trans[trans]: "x \<sqsubseteq> y \<Longrightarrow> y \<sqsubset> z \<Longrightarrow> x \<sqsubset> z"
-  assumes strict_weak_trans[trans]: "x \<sqsubset> y \<Longrightarrow> y \<sqsubseteq> z \<Longrightarrow> x \<sqsubset> z"
-  assumes strict_implies_weak: "x \<sqsubset> y \<Longrightarrow> x \<sqsubseteq> y"
+locale compatible = related_set + related_set A "(\<sqsubset>)" for less (infix "\<sqsubset>" 50) +
+  assumes compat_right[trans]: "x \<sqsubseteq> y \<Longrightarrow> y \<sqsubset> z \<Longrightarrow> x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> z \<in> A \<Longrightarrow> x \<sqsubset> z"
+  assumes compat_left[trans]: "x \<sqsubset> y \<Longrightarrow> y \<sqsubseteq> z \<Longrightarrow> x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> z \<in> A \<Longrightarrow> x \<sqsubset> z"
+
+locale compatible_ordering = reflexive + irreflexive + compatible +
+  assumes strict_implies_weak: "x \<sqsubset> y \<Longrightarrow> x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> x \<sqsubseteq> y"
 begin
 
 text \<open>The strict part is necessarily transitive.\<close>
 
-sublocale strict: transitive "(\<sqsubset>)"
-  using weak_strict_trans[OF strict_implies_weak] by unfold_locales
-
 text \<open>The following sequence of declarations are in order to obtain fact names in a manner
 similar to the Isabelle/HOL facts of orders.\<close>
 
-interpretation strict_order "(\<sqsubset>)" ..
-
-sublocale strict: near_order "(\<sqsubset>)" by unfold_locales
-
-sublocale asymmetric "(\<sqsubset>)" by unfold_locales
-
-sublocale strict_order "(\<sqsubset>)" ..
-
-thm strict.antisym strict.trans asym irrefl
-
-lemma strict_implies_not_weak: "x \<sqsubset> y \<Longrightarrow> \<not> y \<sqsubseteq> x" by (auto dest: strict_weak_trans)
+sublocale strict: transitive A "(\<sqsubset>)"
+  using compat_right[OF strict_implies_weak] by unfold_locales
+
+sublocale strict_ordered_set A "(\<sqsubset>)" ..
+
+thm strict.trans asym irrefl
+
+lemma strict_implies_not_weak: "x \<sqsubset> y \<Longrightarrow> x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> \<not> y \<sqsubseteq> x"
+  using irrefl compat_left by blast
+
+end
+
+context transitive begin
+
+interpretation less_eq_notations.
+
+lemma asym_trans[trans]:
+  shows "x \<sqsubset> y \<Longrightarrow> y \<sqsubseteq> z \<Longrightarrow> x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> z \<in> A \<Longrightarrow> x \<sqsubset> z"
+    and "x \<sqsubseteq> y \<Longrightarrow> y \<sqsubset> z \<Longrightarrow> x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> z \<in> A \<Longrightarrow> x \<sqsubset> z"
+  by (auto 0 3 dest: trans)
 
 end
 
 locale attractive_ordering = compatible_ordering + attractive
 
-locale pseudo_ordering = compatible_ordering + antisymmetric
+locale pseudo_ordering = compatible_ordering + pseudo_ordered_set
 begin
 
-sublocale pseudo_order + attractive_ordering ..
+sublocale attractive_ordering ..
 
 end
 
-locale quasi_ordering = compatible_ordering + transitive
+locale quasi_ordering = compatible_ordering + quasi_ordered_set
 begin
 
-sublocale quasi_order + attractive_ordering ..
+sublocale attractive_ordering ..
 
 end
 
-locale partial_ordering = compatible_ordering + near_order
+locale partial_ordering = compatible_ordering + partially_ordered_set
 begin
 
-sublocale partial_order + pseudo_ordering + quasi_ordering ..
+sublocale pseudo_ordering + quasi_ordering ..
 
 end
 
 locale well_founded_ordering = quasi_ordering + well_founded
 
-locale total_ordering = compatible_ordering + total_order
+locale total_ordering = compatible_ordering + total_ordered_set
 begin
 
 sublocale partial_ordering ..
 
 end
 
-locale strict_total_ordering = partial_ordering + total "(\<sqsubset>)"
+locale strict_total_ordering = partial_ordering + semiconnex A "(\<sqsubset>)"
 begin
 
-sublocale total_irreflexive "(\<sqsubset>)" ..
-
-sublocale total_reflexive "(\<sqsubseteq>)"
+sublocale semiconnex_irreflexive ..
+
+sublocale connex
 proof
-  fix x y show "x \<sqsubseteq> y \<or> y \<sqsubseteq> x" by (cases x y rule: cases, auto dest: strict_implies_weak)
+  fix x y assume x: "x \<in> A" and y: "y \<in> A"
+  then show "x \<sqsubseteq> y \<or> y \<sqsubseteq> x"
+    apply (cases rule: cases[OF x y])
+    by (auto dest: strict_implies_weak)
 qed
 
 sublocale total_ordering ..
-
+(*
 sublocale old: ordering "(\<sqsubseteq>)" "(\<sqsubset>)"
 proof-
   have "a \<sqsubseteq> b \<Longrightarrow> a \<noteq> b \<Longrightarrow> a \<sqsubset> b" for a b
     by (cases a b rule: cases, auto dest: strict_implies_weak)
   then show "ordering (\<sqsubseteq>) (\<sqsubset>)"
     by (unfold_locales, auto dest:strict_implies_weak trans)
 qed
-
-lemma not_weak[simp]: "\<not> x \<sqsubseteq> y \<longleftrightarrow> y \<sqsubset> x" by (simp add: not_weak_iff old.strict_iff_order)
-
-lemma not_strict[simp]: "\<not> x \<sqsubset> y \<longleftrightarrow> y \<sqsubseteq> x" by (auto simp: old.strict_iff_order)
-
-end
-
-
-text \<open>A locale which defines an equivalence relation. Be careful when declaring simp rules etc.,
-as the equivalence will often be rewritten to equality.\<close>
-
-locale quasi_order_equivalence = quasi_order + equivalence_syntax +
-  assumes equiv_def: "x \<sim> y \<longleftrightarrow> x \<sqsubseteq> y \<and> y \<sqsubseteq> x"
-begin
-
-sublocale equiv: equivalence by (unfold_locales, auto simp: equiv_def dest: trans)
-
-lemma [trans]:
-  shows equiv_weak_trans: "x \<sim> y \<Longrightarrow> y \<sqsubseteq> z \<Longrightarrow> x \<sqsubseteq> z"
-    and weak_equiv_trans: "x \<sqsubseteq> y \<Longrightarrow> y \<sim> z \<Longrightarrow> x \<sqsubseteq> z"
-  by (auto simp: equiv_def dest: trans)
-
-lemma extreme_order_iff_equiv[simp]: "extreme (\<sqsubseteq>) {x. x \<sqsubseteq> e} y \<longleftrightarrow> e \<sim> y"
-  by (auto simp: equiv_def intro!: extremeI dest: trans)
-
-lemma extreme_bound_iff_equiv:
-  assumes bX: "extreme_bound (\<sqsubseteq>) X b" shows "extreme_bound (\<sqsubseteq>) X c \<longleftrightarrow> b \<sim> c"
-proof(rule iffI)
-  from bX have bX: "bound (\<sqsubseteq>) X b" and leastb: "\<And>x. bound (\<sqsubseteq>) X x \<Longrightarrow> b \<sqsubseteq> x" by auto
-  { fix c assume "extreme_bound (\<sqsubseteq>) X c"
-    then have cbounds: "bound (\<sqsubseteq>) X c" and leastc: "\<And>b. bound (\<sqsubseteq>) X b \<Longrightarrow> c \<sqsubseteq> b" by auto
-    from leastb[OF cbounds] leastc[OF bX] show "b \<sim> c" by (auto simp: equiv_def)
-  }
-  { fix c assume bc: "b \<sim> c"
-    show "extreme_bound (\<sqsubseteq>) X c"
-    proof(intro extreme_boundI)
-      fix x assume "x \<in> X"
-      with bX have "x \<sqsubseteq> b" by auto
-      with bc show "x \<sqsubseteq> c" by (auto dest: trans simp: equiv_def)
-    next
-      fix x assume "bound (\<sqsubseteq>) X x"
-      from leastb[OF this] bc show "c \<sqsubseteq> x" by (auto dest: trans simp: equiv_def)
-    qed
-  }
-qed
-
-lemma extremes_are_equiv: "extreme (\<sqsubseteq>) X x \<Longrightarrow> extreme (\<sqsubseteq>) X y \<Longrightarrow> x \<sim> y"
-  by (auto simp: equiv_def)
-
-end
-
-locale quasi_ordering_equivalence = compatible_ordering + quasi_order_equivalence
-begin
-
-lemma [trans]:
-  shows equiv_strict_trans: "x \<sim> y \<Longrightarrow> y \<sqsubset> z \<Longrightarrow> x \<sqsubset> z"
-    and strict_equiv_trans: "x \<sqsubset> y \<Longrightarrow> y \<sim> z \<Longrightarrow> x \<sqsubset> z"
-  by (auto simp: equiv_def dest: weak_strict_trans strict_weak_trans)
+*)
+
+lemma not_weak[simp]:
+  assumes "x \<in> A" and "y \<in> A" shows "\<not> x \<sqsubseteq> y \<longleftrightarrow> y \<sqsubset> x"
+  using assms by (cases rule:cases, auto simp: strict_implies_not_weak dest: strict_implies_weak)
+
+lemma not_strict[simp]: "x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> \<not> x \<sqsubset> y \<longleftrightarrow> y \<sqsubseteq> x"
+  using not_weak by blast
 
 end
 
 subsection \<open>Relating to Classes\<close>
 
-text \<open>In Isabelle 2019 (and earlier), we should declare sublocales in class before declaring dual
+text \<open>In Isabelle 2020, we should declare sublocales in class before declaring dual
 sublocales, since otherwise facts would be prefixed by ``dual.dual.''\<close>
 
 context ord begin
 
-abbreviation upper_bound where "upper_bound \<equiv> bound (\<le>)"
-
-abbreviation least where "least \<equiv> extreme (\<lambda>x y. y \<le> x)"
-
-abbreviation lower_bound where "lower_bound \<equiv> bound (\<lambda>x y. y \<le> x)"
-
-abbreviation greatest where "greatest \<equiv> extreme (\<le>)"
-
-abbreviation supremum where "supremum \<equiv> extreme_bound (\<le>)"
-
-abbreviation infimum where "infimum \<equiv> extreme_bound (\<lambda>x y. y \<le> x)"
+abbreviation least where "least X \<equiv> extreme X (\<lambda>x y. y \<le> x)"
+
+abbreviation greatest where "greatest X \<equiv> extreme X (\<le>)"
+
+abbreviation supremum where "supremum X \<equiv> least (Collect (bound X (\<le>)))"
+
+abbreviation infimum where "infimum X \<equiv> greatest (Collect (bound X (\<lambda>x y. y \<le> x)))"
 
 lemma Least_eq_The_least: "Least P = The (least {x. P x})"
   by (auto simp: Least_def extreme_def[unfolded atomize_eq, THEN ext])
 
 lemma Greatest_eq_The_greatest: "Greatest P = The (greatest {x. P x})"
   by (auto simp: Greatest_def extreme_def[unfolded atomize_eq, THEN ext])
 
 end
 
-lemma fun_ord_le: "fun_ord (\<le>) = (\<le>)" by (intro ext, simp add: fun_ord_def le_fun_def)
-lemma fun_ord_ge: "fun_ord (\<ge>) = (\<ge>)" by (intro ext, simp add: fun_ord_def le_fun_def)
-
-lemmas fun_supremum_iff = fun_extreme_bound_iff[of "(\<le>)", unfolded fun_ord_le]
-lemmas fun_infimum_iff = fun_extreme_bound_iff[of "(\<ge>)", unfolded fun_ord_ge]
-
-class compat = ord + assumes "compatible_ordering (\<le>) (<)"
+lemma Ball_UNIV[simp]: "Ball UNIV = All" by auto
+lemma Bex_UNIV[simp]: "Bex UNIV = Ex" by auto
+
+class compat = ord + assumes "compatible_ordering UNIV (\<le>) (<)"
 begin
 
-sublocale order: compatible_ordering using compat_axioms unfolding class.compat_def.
+sublocale order: compatible_ordering UNIV
+  rewrites "\<And>x. x \<in> UNIV \<equiv> True"
+    and "\<And>X. X \<subseteq> UNIV \<equiv> True"
+    and "\<And>r. r \<restriction> UNIV \<equiv> r"
+    and "\<And>P. True \<and> P \<equiv> P"
+    and "Ball UNIV \<equiv> All"
+    and "Bex UNIV \<equiv> Ex"
+    and "sympartp (\<le>)\<^sup>- \<equiv> sympartp (\<le>)"
+    and "\<And>P1. (True \<Longrightarrow> PROP P1) \<equiv> PROP P1"
+    and "\<And>P1. (True \<Longrightarrow> P1) \<equiv> Trueprop P1"
+    and "\<And>P1 P2. (True \<Longrightarrow> PROP P1 \<Longrightarrow> PROP P2) \<equiv> (PROP P1 \<Longrightarrow> PROP P2)"
+  using compat_axioms unfolding class.compat_def by (auto 0 4 simp:atomize_eq)
 
 end
 
 text \<open>We should have imported locale-based facts in classes, e.g.:\<close>
 thm order.trans order.strict.trans order.refl order.irrefl order.asym order.extreme_bound_singleton
 
-class attractive_order = ord + assumes "attractive_ordering (\<le>) (<)"
+class attractive_order = ord + assumes "attractive_ordering UNIV (\<le>) (<)"
 begin
 
-interpretation order: attractive_ordering
+text \<open>We need to declare subclasses before sublocales in order to preserve facts for superclasses.\<close>
+
+interpretation attractive_ordering UNIV
   using attractive_order_axioms unfolding class.attractive_order_def.
 
 subclass compat ..
 
-sublocale order: attractive_ordering ..
+sublocale order: attractive_ordering UNIV
+  rewrites "\<And>x. x \<in> UNIV \<equiv> True"
+    and "\<And>X. X \<subseteq> UNIV \<equiv> True"
+    and "\<And>r. r \<restriction> UNIV \<equiv> r"
+    and "\<And>P. True \<and> P \<equiv> P"
+    and "Ball UNIV \<equiv> All"
+    and "Bex UNIV \<equiv> Ex"
+    and "sympartp (\<le>)\<^sup>- \<equiv> sympartp (\<le>)"
+    and "\<And>P1. (True \<Longrightarrow> PROP P1) \<equiv> PROP P1"
+    and "\<And>P1. (True \<Longrightarrow> P1) \<equiv> Trueprop P1"
+    and "\<And>P1 P2. (True \<Longrightarrow> PROP P1 \<Longrightarrow> PROP P2) \<equiv> (PROP P1 \<Longrightarrow> PROP P2)"
+  apply unfold_locales by (auto simp:atomize_eq)
 
 end
 
 thm order.extreme_bound_quasi_const
 
-class psorder = ord + assumes "pseudo_ordering (\<le>) (<)"
+class psorder = ord + assumes "pseudo_ordering UNIV (\<le>) (<)"
 begin
 
-text \<open>We need to declare subclasses before sublocales in order to preserve facts for superclasses.\<close>
-
-interpretation order: pseudo_ordering using psorder_axioms unfolding class.psorder_def.
+interpretation pseudo_ordering UNIV using psorder_axioms unfolding class.psorder_def.
 
 subclass attractive_order ..
 
-sublocale order: pseudo_ordering ..
+sublocale order: pseudo_ordering UNIV
+  rewrites "\<And>x. x \<in> UNIV \<equiv> True"
+    and "\<And>X. X \<subseteq> UNIV \<equiv> True"
+    and "\<And>r. r \<restriction> UNIV \<equiv> r"
+    and "\<And>P. True \<and> P \<equiv> P"
+    and "Ball UNIV \<equiv> All"
+    and "Bex UNIV \<equiv> Ex"
+    and "sympartp (\<le>)\<^sup>- \<equiv> sympartp (\<le>)"
+    and "\<And>P1. (True \<Longrightarrow> PROP P1) \<equiv> PROP P1"
+    and "\<And>P1. (True \<Longrightarrow> P1) \<equiv> Trueprop P1"
+    and "\<And>P1 P2. (True \<Longrightarrow> PROP P1 \<Longrightarrow> PROP P2) \<equiv> (PROP P1 \<Longrightarrow> PROP P2)"
+  apply unfold_locales by (auto simp:atomize_eq)
 
 end
 
-class qorder = ord + assumes "quasi_ordering (\<le>) (<)"
+class qorder = ord + assumes "quasi_ordering UNIV (\<le>) (<)"
 begin
 
-interpretation order: quasi_ordering using qorder_axioms unfolding class.qorder_def.
+interpretation quasi_ordering UNIV using qorder_axioms unfolding class.qorder_def.
 
 subclass attractive_order ..
 
-sublocale order: quasi_ordering ..
+sublocale order: quasi_ordering UNIV
+  rewrites "\<And>x. x \<in> UNIV \<equiv> True"
+    and "\<And>X. X \<subseteq> UNIV \<equiv> True"
+    and "\<And>r. r \<restriction> UNIV \<equiv> r"
+    and "\<And>P. True \<and> P \<equiv> P"
+    and "Ball UNIV \<equiv> All"
+    and "Bex UNIV \<equiv> Ex"
+    and "sympartp (\<le>)\<^sup>- \<equiv> sympartp (\<le>)"
+    and "\<And>P1. (True \<Longrightarrow> PROP P1) \<equiv> PROP P1"
+    and "\<And>P1. (True \<Longrightarrow> P1) \<equiv> Trueprop P1"
+    and "\<And>P1 P2. (True \<Longrightarrow> PROP P1 \<Longrightarrow> PROP P2) \<equiv> (PROP P1 \<Longrightarrow> PROP P2)"
+  apply unfold_locales by (auto simp:atomize_eq)
 
 end
 
-class porder = ord + assumes "partial_ordering (\<le>) (<)"
+class porder = ord + assumes "partial_ordering UNIV (\<le>) (<)"
 begin
 
-interpretation order: partial_ordering using porder_axioms unfolding class.porder_def.
+interpretation partial_ordering UNIV
+  using porder_axioms unfolding class.porder_def.
 
 subclass psorder ..
 subclass qorder ..
 
-sublocale order: partial_ordering ..
+sublocale order: partial_ordering UNIV
+  rewrites "\<And>x. x \<in> UNIV \<equiv> True"
+    and "\<And>X. X \<subseteq> UNIV \<equiv> True"
+    and "\<And>r. r \<restriction> UNIV \<equiv> r"
+    and "\<And>P. True \<and> P \<equiv> P"
+    and "Ball UNIV \<equiv> All"
+    and "Bex UNIV \<equiv> Ex"
+    and "sympartp (\<le>)\<^sup>- \<equiv> sympartp (\<le>)"
+    and "\<And>P1. (True \<Longrightarrow> PROP P1) \<equiv> PROP P1"
+    and "\<And>P1. (True \<Longrightarrow> P1) \<equiv> Trueprop P1"
+    and "\<And>P1 P2. (True \<Longrightarrow> PROP P1 \<Longrightarrow> PROP P2) \<equiv> (PROP P1 \<Longrightarrow> PROP P2)"
+  apply unfold_locales by (auto simp:atomize_eq)
 
 end
 
-class wf_qorder = ord + assumes "well_founded_ordering (\<le>) (<)"
+class wf_qorder = ord + assumes "well_founded_ordering UNIV (\<le>) (<)"
 begin
 
-interpretation order: well_founded_ordering using wf_qorder_axioms unfolding class.wf_qorder_def.
+interpretation well_founded_ordering UNIV
+  using wf_qorder_axioms unfolding class.wf_qorder_def.
 
 subclass qorder ..
 
-sublocale order: well_founded_ordering ..
+sublocale order: well_founded_ordering UNIV
+  rewrites "\<And>x. x \<in> UNIV \<equiv> True"
+    and "\<And>X. X \<subseteq> UNIV \<equiv> True"
+    and "\<And>r. r \<restriction> UNIV \<equiv> r"
+    and "\<And>P. True \<and> P \<equiv> P"
+    and "Ball UNIV \<equiv> All"
+    and "Bex UNIV \<equiv> Ex"
+    and "sympartp (\<le>)\<^sup>- \<equiv> sympartp (\<le>)"
+    and "\<And>P1. (True \<Longrightarrow> PROP P1) \<equiv> PROP P1"
+    and "\<And>P1. (True \<Longrightarrow> P1) \<equiv> Trueprop P1"
+    and "\<And>P1 P2. (True \<Longrightarrow> PROP P1 \<Longrightarrow> PROP P2) \<equiv> (PROP P1 \<Longrightarrow> PROP P2)"
+  apply unfold_locales by (auto simp:atomize_eq)
 
 end
 
-class totalorder = ord + assumes "total_ordering (\<le>) (<)"
+class totalorder = ord + assumes "total_ordering UNIV (\<le>) (<)"
 begin
 
-interpretation order: total_ordering using totalorder_axioms unfolding class.totalorder_def.
+interpretation total_ordering UNIV
+  using totalorder_axioms unfolding class.totalorder_def.
 
 subclass porder ..
 
-sublocale order: total_ordering ..
+sublocale order: total_ordering UNIV
+  rewrites "\<And>x. x \<in> UNIV \<equiv> True"
+    and "\<And>X. X \<subseteq> UNIV \<equiv> True"
+    and "\<And>r. r \<restriction> UNIV \<equiv> r"
+    and "\<And>P. True \<and> P \<equiv> P"
+    and "Ball UNIV \<equiv> All"
+    and "Bex UNIV \<equiv> Ex"
+    and "sympartp (\<le>)\<^sup>- \<equiv> sympartp (\<le>)"
+    and "\<And>P1. (True \<Longrightarrow> PROP P1) \<equiv> PROP P1"
+    and "\<And>P1. (True \<Longrightarrow> P1) \<equiv> Trueprop P1"
+    and "\<And>P1 P2. (True \<Longrightarrow> PROP P1 \<Longrightarrow> PROP P2) \<equiv> (PROP P1 \<Longrightarrow> PROP P2)"
+  apply unfold_locales by (auto simp:atomize_eq)
 
 end
 
 text \<open>Isabelle/HOL's @{class preorder} belongs to @{class qorder}, but not vice versa.\<close>
 
 subclass (in preorder) qorder
   apply unfold_locales
-  apply (fact order_refl)
+  using order_refl apply assumption
   apply simp
-  apply (fact le_less_trans)
-  apply (fact less_le_trans)
-  apply (fact less_imp_le)
-  apply (fact order_trans)
+  using le_less_trans apply assumption
+  using less_le_trans apply assumption
+  using less_imp_le apply assumption
+  using  order_trans apply assumption
   done
 
 subclass (in order) porder by (unfold_locales, auto)
 
-subclass (in wellorder) wf_qorder by (unfold_locales, fact less_induct)
+subclass (in wellorder) wf_qorder
+  apply (unfold_locales)
+  using less_induct by auto
 
 text \<open>Isabelle/HOL's @{class linorder} is equivalent to our locale @{locale strict_total_ordering}.\<close>
 
 context linorder begin
 
-interpretation order: strict_total_ordering by (unfold_locales, auto)
+interpretation strict_total_ordering UNIV
+  apply unfold_locales by auto
 
 subclass totalorder ..
 
-sublocale order: strict_total_ordering ..
+sublocale order: strict_total_ordering UNIV
+  rewrites "\<And>x. x \<in> UNIV \<equiv> True"
+    and "\<And>X. X \<subseteq> UNIV \<equiv> True"
+    and "\<And>r. r \<restriction> UNIV \<equiv> r"
+    and "\<And>P. True \<and> P \<equiv> P"
+    and "Ball UNIV \<equiv> All"
+    and "Bex UNIV \<equiv> Ex"
+    and "sympartp (\<le>)\<^sup>- \<equiv> sympartp (\<le>)"
+    and "\<And>P1. (True \<Longrightarrow> PROP P1) \<equiv> PROP P1"
+    and "\<And>P1. (True \<Longrightarrow> P1) \<equiv> Trueprop P1"
+    and "\<And>P1 P2. (True \<Longrightarrow> PROP P1 \<Longrightarrow> PROP P2) \<equiv> (PROP P1 \<Longrightarrow> PROP P2)"
+  apply unfold_locales by (auto simp:atomize_eq)
 
 end
 
 text \<open>Tests: facts should be available in the most general classes.\<close>
 
 thm order.strict.trans[where 'a="'a::compat"]
 thm order.extreme_bound_quasi_const[where 'a="'a::attractive_order"]
 thm order.extreme_bound_singleton_eq[where 'a="'a::psorder"]
 thm order.trans[where 'a="'a::qorder"]
 thm order.comparable_cases[where 'a="'a::totalorder"]
 thm order.cases[where 'a="'a::linorder"]
 
 subsection \<open>Declaring Duals\<close>
 
-text \<open>At this point, we declare dual as sublocales.\<close>
-
-sublocale less_eq_syntax \<subseteq> dual: less_eq_syntax "(\<sqsubseteq>)\<^sup>-".
-
-sublocale reflexive \<subseteq> dual: reflexive "(\<sqsubseteq>)\<^sup>-" by auto
-
-sublocale attractive \<subseteq> dual: attractive "(\<sqsubseteq>)\<^sup>-" by unfold_locales
-
-sublocale irreflexive \<subseteq> dual: irreflexive "(\<sqsubset>)\<^sup>-" by (unfold_locales, auto)
-
-sublocale transitive \<subseteq> dual: transitive "(\<sqsubseteq>)\<^sup>-" by (unfold_locales, erule trans)
-
-sublocale antisymmetric \<subseteq> dual: antisymmetric "(\<sqsubseteq>)\<^sup>-" by auto
-
-sublocale asymmetric \<subseteq> dual: asymmetric "(\<sqsubset>)\<^sup>-" by unfold_locales
-
-sublocale total \<subseteq> dual: total "(\<sqsubset>)\<^sup>-" using total by auto
-
-sublocale total_reflexive \<subseteq> dual: total_reflexive "(\<sqsubseteq>)\<^sup>-" by unfold_locales
-
-sublocale total_irreflexive \<subseteq> dual: total_irreflexive "(\<sqsubset>)\<^sup>-" by unfold_locales
-
-sublocale pseudo_order \<subseteq> dual: pseudo_order "(\<sqsubseteq>)\<^sup>-" by unfold_locales
-
-sublocale quasi_order \<subseteq> dual: quasi_order "(\<sqsubseteq>)\<^sup>-" by unfold_locales
-
-sublocale partial_order \<subseteq> dual: partial_order "(\<sqsubseteq>)\<^sup>-" by unfold_locales
-
-text \<open>In the following dual sublocale declaration, ``rewrites'' eventually cleans up redundant
-facts.\<close>
-
-sublocale symmetric \<subseteq> dual: symmetric "(\<sim>)\<^sup>-" rewrites "(\<sim>)\<^sup>- = (\<sim>)"
-  using symmetric_axioms by (auto simp: dual_sym)
-
-sublocale equivalence \<subseteq> dual: equivalence "(\<sim>)\<^sup>-" rewrites "(\<sim>)\<^sup>- = (\<sim>)"
-  by (unfold_locales, auto simp: dual_sym sym)
-
-sublocale total_pseudo_order \<subseteq> dual: total_pseudo_order "(\<sqsubseteq>)\<^sup>-" by unfold_locales
-
-sublocale total_quasi_order \<subseteq> dual: total_quasi_order "(\<sqsubseteq>)\<^sup>-" by unfold_locales
-
-sublocale compatible_ordering \<subseteq> dual: compatible_ordering "(\<sqsubseteq>)\<^sup>-" "(\<sqsubset>)\<^sup>-"
-  using weak_strict_trans strict_weak_trans strict_implies_weak by unfold_locales
-
-sublocale attractive_ordering \<subseteq> dual: attractive_ordering "(\<sqsubseteq>)\<^sup>-" "(\<sqsubset>)\<^sup>-" by unfold_locales
-
-sublocale pseudo_ordering \<subseteq> dual: pseudo_ordering "(\<sqsubseteq>)\<^sup>-" "(\<sqsubset>)\<^sup>-" by unfold_locales
-
-sublocale quasi_ordering \<subseteq> dual: quasi_ordering "(\<sqsubseteq>)\<^sup>-" "(\<sqsubset>)\<^sup>-" by unfold_locales
-
-sublocale partial_ordering \<subseteq> dual: partial_ordering "(\<sqsubseteq>)\<^sup>-" "(\<sqsubset>)\<^sup>-" by unfold_locales
-
-sublocale total_ordering \<subseteq> dual: total_ordering "(\<sqsubseteq>)\<^sup>-" "(\<sqsubset>)\<^sup>-" by unfold_locales
-
+sublocale reflexive \<subseteq> sym: reflexive A "sympartp (\<sqsubseteq>)"
+  rewrites "sympartp (\<sqsubseteq>)\<^sup>- \<equiv> sympartp (\<sqsubseteq>)"
+    and "\<And>r. sympartp (sympartp r) \<equiv> sympartp r"
+    and "\<And>r. sympartp r \<restriction> A \<equiv> sympartp (r \<restriction> A)"
+  by (auto 0 4 simp:atomize_eq)
+
+sublocale quasi_ordered_set \<subseteq> sym: quasi_ordered_set A "sympartp (\<sqsubseteq>)"
+  rewrites "sympartp (\<sqsubseteq>)\<^sup>- = sympartp (\<sqsubseteq>)"
+    and "sympartp (sympartp (\<sqsubseteq>)) = sympartp (\<sqsubseteq>)"
+   apply unfold_locales by (auto 0 4 dest: trans)
+  
+text \<open>At this point, we declare dual as sublocales.
+In the following, ``rewrites'' eventually cleans up redundant facts.\<close>
+
+sublocale reflexive \<subseteq> dual: reflexive A "(\<sqsubseteq>)\<^sup>-"
+  rewrites "sympartp (\<sqsubseteq>)\<^sup>- \<equiv> sympartp (\<sqsubseteq>)"
+    and "\<And>r. sympartp (r \<restriction> A) \<equiv> sympartp r \<restriction> A"
+    and "(\<sqsubseteq>)\<^sup>- \<restriction> A \<equiv> ((\<sqsubseteq>) \<restriction> A)\<^sup>-"
+  by (auto simp: atomize_eq)
+
+context attractive begin
+
+interpretation less_eq_notations.
+
+sublocale dual: attractive A "(\<sqsupseteq>)"
+  rewrites "sympartp (\<sqsupseteq>) = (\<sim>)"
+    and "equivpartp (\<sqsupseteq>) \<equiv> (\<simeq>)"
+    and "\<And>r. sympartp (r \<restriction> A) \<equiv> sympartp r \<restriction> A"
+    and "\<And>r. sympartp (sympartp r) \<equiv> sympartp r"
+    and "(\<sqsubseteq>)\<^sup>- \<restriction> A \<equiv> ((\<sqsubseteq>) \<restriction> A)\<^sup>-"
+  apply unfold_locales by (auto intro!: ext dest: attract dual.attract simp: atomize_eq)
+
+end
+
+context irreflexive begin
+
+sublocale dual: irreflexive A "(\<sqsubset>)\<^sup>-"
+  rewrites "(\<sqsubset>)\<^sup>- \<restriction> A \<equiv> ((\<sqsubset>) \<restriction> A)\<^sup>-"
+  apply unfold_locales by (auto dest: irrefl simp: atomize_eq)
+
+end
+
+sublocale transitive \<subseteq> dual: transitive A "(\<sqsubseteq>)\<^sup>-"
+  rewrites "(\<sqsubseteq>)\<^sup>- \<restriction> A \<equiv> ((\<sqsubseteq>) \<restriction> A)\<^sup>-"
+    and "sympartp (\<sqsubseteq>)\<^sup>- = sympartp (\<sqsubseteq>)"
+    and "asympartp (\<sqsubseteq>)\<^sup>- = (asympartp (\<sqsubseteq>))\<^sup>-"
+  apply unfold_locales by (auto dest: trans simp: atomize_eq intro!:ext)
+
+sublocale antisymmetric \<subseteq> dual: antisymmetric A "(\<sqsubseteq>)\<^sup>-"
+  rewrites "(\<sqsubseteq>)\<^sup>- \<restriction> A \<equiv> ((\<sqsubseteq>) \<restriction> A)\<^sup>-"
+    and "sympartp (\<sqsubseteq>)\<^sup>- = sympartp (\<sqsubseteq>)"
+  by (auto dest: antisym simp: atomize_eq)
+
+sublocale semiconnex \<subseteq> dual: semiconnex A "(\<sqsubset>)\<^sup>-"
+  rewrites "sympartp (\<sqsubset>)\<^sup>- = sympartp (\<sqsubset>)"
+  using semiconnex by auto
+
+sublocale connex \<subseteq> dual: connex A "(\<sqsubseteq>)\<^sup>-"
+  rewrites "sympartp (\<sqsubseteq>)\<^sup>- = sympartp (\<sqsubseteq>)"
+  by (auto intro!: chainI dest:comparable)
+
+sublocale semiconnex_irreflexive \<subseteq> dual: semiconnex_irreflexive A "(\<sqsubset>)\<^sup>-"
+  rewrites "sympartp (\<sqsubset>)\<^sup>- = sympartp (\<sqsubset>)"
+  by unfold_locales auto
+
+sublocale pseudo_ordered_set \<subseteq> dual: pseudo_ordered_set A "(\<sqsubseteq>)\<^sup>-"
+  rewrites "sympartp (\<sqsubseteq>)\<^sup>- = sympartp (\<sqsubseteq>)"
+  by unfold_locales (auto 0 4)
+
+sublocale quasi_ordered_set \<subseteq> dual: quasi_ordered_set A "(\<sqsubseteq>)\<^sup>-"
+  rewrites "sympartp (\<sqsubseteq>)\<^sup>- = sympartp (\<sqsubseteq>)"
+  by unfold_locales auto
+
+sublocale partially_ordered_set \<subseteq> dual: partially_ordered_set A "(\<sqsubseteq>)\<^sup>-"
+  rewrites "sympartp (\<sqsubseteq>)\<^sup>- = sympartp (\<sqsubseteq>)"
+  by unfold_locales (auto 0 4)
+
+sublocale total_pseudo_ordered_set \<subseteq> dual: total_pseudo_ordered_set A "(\<sqsubseteq>)\<^sup>-"
+  rewrites "sympartp (\<sqsubseteq>)\<^sup>- = sympartp (\<sqsubseteq>)"
+  by unfold_locales (auto 0 4)
+
+sublocale total_quasi_ordered_set \<subseteq> dual: total_quasi_ordered_set A "(\<sqsubseteq>)\<^sup>-"
+  rewrites "sympartp (\<sqsubseteq>)\<^sup>- = sympartp (\<sqsubseteq>)"
+  by unfold_locales auto
+
+sublocale compatible_ordering \<subseteq> dual: compatible_ordering A "(\<sqsubseteq>)\<^sup>-" "(\<sqsubset>)\<^sup>-"
+  rewrites "sympartp (\<sqsubseteq>)\<^sup>- = sympartp (\<sqsubseteq>)"
+  apply unfold_locales
+  by (auto dest: compat_left compat_right strict_implies_weak)
+
+sublocale attractive_ordering \<subseteq> dual: attractive_ordering A "(\<sqsubseteq>)\<^sup>-" "(\<sqsubset>)\<^sup>-"
+  rewrites "sympartp (\<sqsubseteq>)\<^sup>- = sympartp (\<sqsubseteq>)"
+  by unfold_locales auto
+
+sublocale pseudo_ordering \<subseteq> dual: pseudo_ordering A "(\<sqsubseteq>)\<^sup>-" "(\<sqsubset>)\<^sup>-"
+  rewrites "sympartp (\<sqsubseteq>)\<^sup>- = sympartp (\<sqsubseteq>)"
+  by unfold_locales (auto 0 4)
+
+sublocale quasi_ordering \<subseteq> dual: quasi_ordering A "(\<sqsubseteq>)\<^sup>-" "(\<sqsubset>)\<^sup>-"
+  rewrites "sympartp (\<sqsubseteq>)\<^sup>- = sympartp (\<sqsubseteq>)"
+  by unfold_locales auto
+
+sublocale partial_ordering \<subseteq> dual: partial_ordering A "(\<sqsubseteq>)\<^sup>-" "(\<sqsubset>)\<^sup>-"
+  rewrites "sympartp (\<sqsubseteq>)\<^sup>- = sympartp (\<sqsubseteq>)"
+  by unfold_locales (auto 0 4)
+
+sublocale total_ordering \<subseteq> dual: total_ordering A "(\<sqsubseteq>)\<^sup>-" "(\<sqsubset>)\<^sup>-"
+  rewrites "sympartp (\<sqsubseteq>)\<^sup>- = sympartp (\<sqsubseteq>)"
+  by unfold_locales (auto 0 4)
 
 lemma(in antisymmetric) monotone_extreme_imp_extreme_bound_iff:
   fixes ir (infix "\<preceq>" 50)
-  assumes "monotone (\<preceq>) (\<sqsubseteq>) f" and i: "extreme (\<preceq>) C i"
-  shows "extreme_bound (\<sqsubseteq>) (f ` C) x \<longleftrightarrow> f i = x"
+  assumes "f ` C \<subseteq> A" and "monotone_on C (\<preceq>) (\<sqsubseteq>) f" and i: "extreme C (\<preceq>) i"
+  shows "extreme_bound A (\<sqsubseteq>) (f ` C) x \<longleftrightarrow> f i = x"
   using dual.extreme_unique monotone_extreme_extreme_boundI[OF assms] by auto
 
 
 subsection \<open>Instantiations\<close>
 
 text \<open>Finally, we instantiate our classes for sanity check.\<close>
 
 instance nat :: linorder ..
 
 text \<open>Pointwise ordering of functions are compatible only if the weak part is transitive.\<close>
 
 instance "fun" :: (type,qorder) compat
 proof (intro_classes, unfold_locales)
   note [simp] = le_fun_def less_fun_def
   fix f g h :: "'a \<Rightarrow> 'b"
   { assume fg: "f \<le> g" and gh: "g < h"
     show "f < h"
     proof (unfold less_fun_def, intro conjI le_funI notI)
       from fg have "f x \<le> g x" for x by auto
       also from gh have "g x \<le> h x" for x by auto
-      finally show "f x \<le> h x" for x.
+      finally (order.trans) show "f x \<le> h x" for x.
       assume hf: "h \<le> f"
       then have "h x \<le> f x" for x by auto
       also from fg have "f x \<le> g x" for x by auto
       finally have "h \<le> g" by auto
       with gh show False by auto
     qed
   }
   { assume fg: "f < g" and gh: "g \<le> h"
     show "f < h"
     proof (unfold less_fun_def, intro conjI le_funI notI)
       from fg have "f x \<le> g x" for x by auto
       also from gh have "g x \<le> h x" for x by auto
       finally show "f x \<le> h x" for x.
-      assume hf: "h \<le> f"
+      from gh have "g x \<le> h x" for x by auto
+      also assume hf: "h \<le> f"
       then have "h x \<le> f x" for x by auto
-      also from gh have "g x \<le> h x" for x by auto
       finally have "g \<le> f" by auto
       with fg show False by auto
     qed
   }
   show "f < g \<Longrightarrow> f \<le> g" by auto
   show "\<not>f < f" by auto
   show "f \<le> f" by auto
 qed
 
 instance "fun" :: (type,qorder) qorder
-  by (intro_classes, unfold_locales, auto simp: le_fun_def dest: order.trans)
+  apply intro_classes
+  apply unfold_locales
+  by (auto simp: le_fun_def dest: order.trans)
 
 instance "fun" :: (type,porder) porder
-  by (intro_classes, unfold_locales, auto simp: less_fun_def le_fun_def)
+  apply intro_classes
+  apply unfold_locales
+proof (intro ext)
+  fix f g :: "'a \<Rightarrow> 'b" and x :: 'a
+  assume fg: "f \<le> g" and gf: "g \<le> f"
+  then have "f x \<le> g x" and "g x \<le> f x" by (auto elim: le_funE)
+  from order.antisym[OF this] show "f x = g x" by auto
+qed
 
 end
diff --git a/thys/Complete_Non_Orders/Complete_Relations.thy b/thys/Complete_Non_Orders/Complete_Relations.thy
--- a/thys/Complete_Non_Orders/Complete_Relations.thy
+++ b/thys/Complete_Non_Orders/Complete_Relations.thy
@@ -1,737 +1,590 @@
 (*
-Author:  Akihisa Yamada (2018-2019)
+Author:  Akihisa Yamada (2018-2021)
 License: LGPL (see file COPYING.LESSER)
 *)
 section \<open> Completeness of Relations \<close>
 
 text \<open>Here we formalize various order-theoretic completeness conditions.\<close>
 
 theory Complete_Relations
-  imports HOL.Real Binary_Relations
+  imports Binary_Relations
 begin
 
 subsection \<open>Completeness Conditions\<close>
 
-text \<open>Order-theoretic completeness demands certain subsets of elements to admit suprema or infima.
+text \<open>Order-theoretic completeness demands certain subsets of elements to admit suprema or infima.\<close>
 
-A related set $\tp{A,\SLE}$ is called \emph{bounded} if there is a ``top'' element $\top \in A$,
+definition complete ("_-complete"[999]1000) where
+ "CC-complete A r \<equiv> \<forall>X \<subseteq> A. X \<in> CC \<longrightarrow> (\<exists>s. extreme_bound A r X s)"
+
+lemmas completeI = complete_def[unfolded atomize_eq, THEN iffD2, rule_format]
+lemmas completeD = complete_def[unfolded atomize_eq, THEN iffD1, rule_format]
+
+lemma complete_cmono: "CC \<subseteq> DD \<Longrightarrow> DD-complete \<le> CC-complete"
+  by (force simp: complete_def)
+
+lemma complete_empty[simp]: "CC-complete {} r \<longleftrightarrow> {} \<notin> CC" by (auto simp: complete_def)
+
+text \<open>
+A related set $\tp{A,\SLE}$ is called \emph{topped} if there is a ``top'' element $\top \in A$,
 a greatest element in $A$.
 Note that there might be multiple tops if $(\SLE)$ is not antisymmetric.\<close>
 
-locale bounded = less_eq_syntax + assumes bounded: "\<exists>t. \<forall>x. x \<sqsubseteq> t"
-begin
-
-lemma ex_bound[intro!]: "Ex (bound (\<sqsubseteq>) X)" using bounded by auto
+definition "extremed A r \<equiv> \<exists>e. extreme A r e"
 
-lemma ex_extreme_UNIV[intro!]: "Ex (extreme (\<sqsubseteq>) UNIV)" using bounded by auto
-
-lemma UNIV_complete[intro!]: "Ex (extreme_bound (\<sqsubseteq>) UNIV)" using bounded by blast
-
-lemma dual_empty_complete[intro!]: "Ex (extreme_bound (\<sqsubseteq>)\<^sup>- {})" by (auto simp: bound_empty)
-
-end
+lemma extremed_imp_ex_bound: "extremed A r \<Longrightarrow> X \<subseteq> A \<Longrightarrow> \<exists>b \<in> A. bound X r b"
+  by (auto simp: extremed_def)
 
 context
   fixes less_eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
 begin
 
-lemma bounded_iff_extreme_UNIV: "bounded (\<sqsubseteq>) \<longleftrightarrow> Ex (extreme (\<sqsubseteq>) UNIV)"
-  by (auto simp:bounded_def)
-
-text\<open>Boundedness can be also seen as a completeness condition,
+text\<open>Toppedness can be also seen as a completeness condition,
 since it is equivalent to saying that the universe has a supremum.\<close>
 
-lemma bounded_iff_UNIV_complete: "bounded (\<sqsubseteq>) \<longleftrightarrow> Ex (extreme_bound (\<sqsubseteq>) UNIV)"
-  by (unfold bounded_def, blast)
+lemma extremed_iff_UNIV_complete: "extremed A (\<sqsubseteq>) \<longleftrightarrow> {A}-complete A (\<sqsubseteq>)" (is "?l \<longleftrightarrow> ?r")
+proof
+  assume ?l
+  then obtain e where "extreme A (\<sqsubseteq>) e" by (auto simp: extremed_def)
+  then have "extreme_bound A (\<sqsubseteq>) A e" by auto
+  then show ?r by (auto intro!: completeI)
+next
+  assume ?r
+  from completeD[OF this] obtain s where "extreme_bound A (\<sqsubseteq>) A s" by auto
+  then have "extreme A (\<sqsubseteq>) s" by auto
+  then show ?l by (auto simp: extremed_def)
+qed
 
-text \<open>The dual notion of bounded is called ``pointed'', equivalently ensuring a supremum
+text \<open>The dual notion of topped is called ``pointed'', equivalently ensuring a supremum
 of the empty set.\<close>
 
-lemma pointed_iff_empty_complete: "bounded (\<sqsubseteq>) \<longleftrightarrow> Ex (extreme_bound (\<sqsubseteq>)\<^sup>- {})"
-  by (auto simp:bounded_def)
+lemma pointed_iff_empty_complete: "extremed A (\<sqsubseteq>) \<longleftrightarrow> {{}}-complete A (\<sqsubseteq>)\<^sup>-"
+  by (auto simp: complete_def extremed_def)
 
 end
 
-
 text \<open>One of the most well-studied notion of completeness would be the semilattice condition:
 every pair of elements $x$ and $y$ has a supremum $x \sqcup y$
 (not necessarily unique if the underlying relation is not antisymmetric).\<close>
 
-locale pair_complete = less_eq_syntax +
-  assumes pair_complete: "Ex (extreme_bound (\<sqsubseteq>) {x,y})"
+definition "pair_complete \<equiv> {{x,y} |. x y :: 'a}-complete"
+
+lemma pair_completeI:
+  assumes "\<And>x y. x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> \<exists>s. extreme_bound A r {x,y} s"
+  shows "pair_complete A r"
+  using assms by (auto simp: pair_complete_def complete_def)
+
+lemma pair_completeD:
+  assumes "pair_complete A r"
+  shows "x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> \<exists>s. extreme_bound A r {x,y} s"
+   by (intro completeD[OF assms[unfolded pair_complete_def]], auto)
+
+
+context
+  fixes less_eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
 begin
 
-lemma directed_UNIV[intro!]: "directed (\<sqsubseteq>) UNIV"
+lemma pair_complete_imp_directed:
+  assumes comp: "pair_complete A (\<sqsubseteq>)" shows "directed A (\<sqsubseteq>)"
 proof
   fix x y :: 'a
-  from pair_complete[of x y] show "\<exists>z \<in> UNIV. x \<sqsubseteq> z \<and> y \<sqsubseteq> z" by auto
+  assume "x \<in> A" "y \<in> A"
+  with pair_completeD[OF comp this] show "\<exists>z \<in> A. x \<sqsubseteq> z \<and> y \<sqsubseteq> z" by auto
 qed
 
 end
 
-sublocale total_reflexive \<subseteq> pair_complete
-proof (unfold_locales)
+lemma (in connex) pair_complete: "pair_complete A (\<sqsubseteq>)"
+proof (safe intro!: pair_completeI)
   fix x y
-  show "Ex (extreme_bound (\<sqsubseteq>) {x, y})" by (cases x y rule:comparable_cases, auto)
+  assume x: "x \<in> A" and y: "y \<in> A"
+  then show "\<exists>s. extreme_bound A (\<sqsubseteq>) {x, y} s"
+  proof (cases rule:comparable_cases)
+    case le
+    with x y show ?thesis by (auto intro!: exI[of _ y])
+  next
+    case ge
+    with x y show ?thesis by (auto intro!: exI[of _ x])
+  qed
 qed
 
 text \<open>The next one assumes that every nonempty finite set has a supremum.\<close>
 
-locale finite_complete = less_eq_syntax +
-  assumes finite_nonempty_complete: "finite X \<Longrightarrow> X \<noteq> {} \<Longrightarrow> Ex (extreme_bound (\<sqsubseteq>) X)"
+abbreviation "finite_complete \<equiv> {X. finite X \<and> X \<noteq> {}}-complete"
 
-sublocale finite_complete \<subseteq> pair_complete
-  by (unfold_locales, intro finite_nonempty_complete, auto)
+lemma finite_complete_le_pair_complete: "finite_complete \<le> pair_complete"
+  by (unfold pair_complete_def, rule complete_cmono, auto)
 
 text \<open>The next one assumes that every nonempty bounded set has a supremum.
 It is also called the Dedekind completeness.\<close>
 
-locale conditionally_complete = less_eq_syntax +
-  assumes bounded_nonempty_complete:
-  "Ex (bound (\<sqsubseteq>) X) \<Longrightarrow> X \<noteq> {} \<Longrightarrow> Ex (extreme_bound (\<sqsubseteq>) X)"
-begin
+abbreviation "conditionally_complete A r \<equiv> {X. \<exists>b \<in> A. bound X r b \<and> X \<noteq> {}}-complete A r"
 
-lemma bounded_nonemptyE[elim!]:
-  assumes "Ex (bound (\<sqsubseteq>) X)" and "X \<noteq> {}"
-    and "Ex (extreme_bound (\<sqsubseteq>) X) \<Longrightarrow> X \<noteq> {} \<Longrightarrow> thesis"
-  shows thesis
-  using assms bounded_nonempty_complete by auto
-
-lemma nonempty_imp_complete_iff_bounded:
-  assumes "X \<noteq> {}" shows "Ex (extreme_bound (\<sqsubseteq>) X) \<longleftrightarrow> Ex (bound (\<sqsubseteq>) X)"
-  using assms by (auto intro: bounded_nonempty_complete)
-
-end
+lemma conditionally_complete_imp_nonempty_imp_ex_extreme_bound_iff_ex_bound:
+  assumes comp: "conditionally_complete A r"
+  assumes "X \<subseteq> A" and "X \<noteq> {}"
+  shows "(\<exists>s. extreme_bound A r X s) \<longleftrightarrow> (\<exists>b\<in>A. bound X r b)"
+  using assms by (auto 0 4 intro!:completeD[OF comp])
 
 text \<open>The $\omega$-completeness condition demands a supremum for an $\omega$-chain,
   $a_1 \sqsubseteq a_2 \sqsubseteq \dots$.
   We model $\omega$-chain as the range of a monotone map $f : i \mapsto a_i$.\<close>
 
-locale omega_complete = less_eq_syntax +
-  assumes monotone_seq_complete:
-    "\<And>f :: nat \<Rightarrow> 'a. monotone (\<le>) (\<sqsubseteq>) f \<Longrightarrow> Ex (extreme_bound (\<sqsubseteq>) (range f))"
-
-locale chain_complete = less_eq_syntax +
-  assumes chain_nonempty_complete: "chain (\<sqsubseteq>) X \<Longrightarrow> X \<noteq> {} \<Longrightarrow> Ex (extreme_bound (\<sqsubseteq>) X)"
-begin
+definition "omega_complete A r \<equiv> {range f | f :: nat \<Rightarrow> 'a. monotone (\<le>) r f}-complete A r"
 
-lemma monotone_chain_complete:
-  assumes C0: "C \<noteq> {}" and chain: "chain r C" and mono: "monotone r (\<sqsubseteq>) f"
-  shows "Ex (extreme_bound (\<sqsubseteq>) (f ` C))"
-  apply (rule chain_nonempty_complete[OF monotone_chain_image[OF mono chain]])
-  using C0 by auto
-
-end
-
-sublocale chain_complete \<subseteq> omega_complete
-  by (unfold_locales, rule monotone_chain_complete, auto intro:chainI)
+lemma (in transitive) local_chain:
+  assumes CA: "range C \<subseteq> A"
+  shows "(\<forall>i::nat. C i \<sqsubseteq> C (Suc i)) \<longleftrightarrow> monotone (<) (\<sqsubseteq>) C"
+proof (intro iffI allI monotoneI)
+  fix i j :: nat
+  assume loc: "\<forall>i. C i \<sqsubseteq> C (Suc i)" and ij: "i < j"
+  have "C i \<sqsubseteq> C (i+k+1)" for k
+  proof (induct k)
+    case 0
+    from loc show ?case by auto
+  next
+    case (Suc k)
+    also have "C (i+k+1) \<sqsubseteq> C (i+k+Suc 1)" using loc by auto
+    finally show ?case using CA by auto
+  qed
+  from this[of "j-i-1"] ij show "C i \<sqsubseteq> C j" by auto
+next
+  fix i
+  assume "monotone (<) (\<sqsubseteq>) C"
+  then show "C i \<sqsubseteq> C (Suc i)" by (auto dest: monotoneD)
+qed
 
 text\<open>\emph{Directed completeness} is an important notion in domain theory~\cite{abramski94},
 asserting that every nonempty directed set has a supremum.
 Here, a set $X$ is \emph{directed} if any pair of two elements in $X$ has a bound in $X$.\<close>
 
-locale directed_complete = less_eq_syntax +
-  assumes directed_nonempty_complete: "directed (\<sqsubseteq>) X \<Longrightarrow> X \<noteq> {} \<Longrightarrow> Ex (extreme_bound (\<sqsubseteq>) X)"
-begin
+definition "directed_complete A r \<equiv> {X. directed X r \<and> X \<noteq> {}}-complete A r"
 
 lemma monotone_directed_complete:
-  assumes dir: "directed r C" and c0: "C \<noteq> {}" and mono: "monotone r (\<sqsubseteq>) f"
-  shows "Ex (extreme_bound (\<sqsubseteq>) (f ` C))"
-  apply (rule directed_nonempty_complete[OF monotone_directed_image[OF mono dir]])
-  using c0 by auto
-
-end
-
-sublocale directed_complete \<subseteq> chain_complete
-  by (unfold_locales, intro directed_nonempty_complete, auto dest: chain_imp_directed)
+  assumes comp: "directed_complete A r"
+  assumes fI: "f ` I \<subseteq> A" and dir: "directed I ri" and I0: "I \<noteq> {}" and mono: "monotone_on I ri r f"
+  shows "\<exists>s. extreme_bound A r (f ` I) s"
+  apply (rule completeD[OF comp[unfolded directed_complete_def], OF fI])
+  using monotone_directed_image[OF mono dir] I0 by auto
 
 text \<open>The next one is quite complete, only the empty set may fail to have a supremum.
 The terminology follows \cite{Bergman2015},
 although there it is defined more generally depending on a cardinal $\alpha$
 such that a nonempty set $X$ of cardinality below $\alpha$ has a supremum.\<close>
 
-locale semicomplete = less_eq_syntax +
-  assumes nonempty_complete: "X \<noteq> {} \<Longrightarrow> Ex (extreme_bound (\<sqsubseteq>) X)"
+abbreviation "semicomplete \<equiv> {X. X \<noteq> {}}-complete"
 
-sublocale semicomplete \<subseteq> conditionally_complete + finite_complete + directed_complete
-  by (unfold_locales, auto intro!: nonempty_complete)
+lemma semicomplete_nonempty_imp_extremed:
+  "semicomplete A r \<Longrightarrow> A \<noteq> {} \<Longrightarrow> extremed A r"
+  unfolding extremed_iff_UNIV_complete
+  using complete_cmono[of "{A}" "{X. X \<noteq> {}}"]
+  by auto
 
-sublocale semicomplete \<subseteq> bounded
-  unfolding bounded_iff_UNIV_complete using nonempty_complete[of UNIV] by auto
+lemma connex_dual_semicomplete: "semicomplete {C. connex C r} (\<supseteq>)"
+proof (intro completeI, elim CollectE)
+  fix X
+  assume "X \<subseteq> {C. connex C r}" and "X \<noteq> {}"
+  then have "connex (\<Inter>X) r" by (auto simp: connex_def)
+  then have "extreme_bound {C. connex C r} (\<supseteq>) X (\<Inter> X)" by auto
+  then show "\<exists>S. extreme_bound {C. connex C r} (\<supseteq>) X S" by auto
+qed
 
 subsection \<open>Pointed Ones\<close>
 
-text \<open>The term `pointed' refers to the dual notion of boundedness, i.e., there is a global least element.
+text \<open>The term `pointed' refers to the dual notion of toppedness, i.e., there is a global least element.
   This serves as the supremum of the empty set.\<close>
 
-locale pointed_chain_complete = chain_complete + dual: bounded "(\<sqsubseteq>)\<^sup>-"
-begin
-
-lemma chain_complete: "chain (\<sqsubseteq>) X \<Longrightarrow> Ex (extreme_bound (\<sqsubseteq>) X)"
-  by (cases "X = {}", auto intro:chain_nonempty_complete)
-
-end
-
-lemma pointed_chain_complete_def':
-  fixes less_eq (infix "\<sqsubseteq>" 50)
-  shows "pointed_chain_complete (\<sqsubseteq>) \<equiv> \<forall>X. chain (\<sqsubseteq>) X \<longrightarrow> Ex (extreme_bound (\<sqsubseteq>) X)" (is "?l \<equiv> ?r")
-  apply (unfold atomize_eq, intro iffI)
-  apply (force intro: pointed_chain_complete.chain_complete)
-  by (unfold_locales, auto intro!: chain_empty simp: pointed_iff_empty_complete[unfolded bounded_def])
+lemma complete_union: "(CC \<union> CC')-complete A r \<longleftrightarrow> CC-complete A r \<and> CC'-complete A r"
+  by (auto simp: complete_def)
 
-locale pointed_directed_complete = directed_complete + dual: bounded "(\<sqsubseteq>)\<^sup>-"
-begin
-
-lemma directed_complete: "directed (\<sqsubseteq>) X \<Longrightarrow> Ex (extreme_bound (\<sqsubseteq>) X)"
-  by (cases "X = {}", auto intro: directed_nonempty_complete)
-
-sublocale pointed_chain_complete ..
-
-end
-
-lemma pointed_directed_complete_def':
-  fixes less_eq (infix "\<sqsubseteq>" 50)
-  shows "pointed_directed_complete (\<sqsubseteq>) \<equiv> \<forall>X. directed (\<sqsubseteq>) X \<longrightarrow> Ex (extreme_bound (\<sqsubseteq>) X)"
-  apply (unfold atomize_eq, intro iffI)
-  apply (force intro: pointed_directed_complete.directed_complete)
-  by (unfold_locales, auto simp: pointed_iff_empty_complete[unfolded bounded_def])
+lemma pointed_directed_complete:
+  "{X. directed X r}-complete A r \<longleftrightarrow> directed_complete A r \<and> extremed A r\<^sup>-"
+proof-
+  have [simp]: "{X. directed X r \<and> X \<noteq> {} \<or> X = {}} = {X. directed X r}" by auto
+  show ?thesis
+    by (auto simp: directed_complete_def pointed_iff_empty_complete complete_union[symmetric] Un_def)
+qed
 
 text \<open>``Bounded complete'' refers to pointed conditional complete,
-but this notion is just the dual of semicompleteness. We prove this later.
-
-Following is the strongest completeness that requires any subset of elements to have suprema
-and infima.\<close>
+but this notion is just the dual of semicompleteness. We prove this later.\<close>
 
-locale complete = less_eq_syntax + assumes complete: "Ex (extreme_bound (\<sqsubseteq>) X)"
-begin
-
-sublocale semicomplete + pointed_directed_complete
-  by (auto simp: pointed_directed_complete_def' intro: semicomplete.intro complete)
-
-end
+abbreviation "bounded_complete A r \<equiv> {X. \<exists>b\<in>A. bound X r b}-complete A r"
 
 subsection \<open>Relations between Completeness Conditions\<close>
 
 context
   fixes less_eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
 begin
 
-interpretation less_eq_dualize.
+interpretation less_eq_notations.
 
 text \<open>Pair-completeness implies that the universe is directed. Thus, with directed completeness
-implies boundedness.\<close>
+implies toppedness.\<close>
 
-proposition directed_complete_pair_complete_imp_bounded:
-  assumes "directed_complete (\<sqsubseteq>)" and "pair_complete (\<sqsubseteq>)"
-  shows "bounded (\<sqsubseteq>)"
+proposition directed_complete_pair_complete_imp_extremed:
+  assumes dc: "directed_complete A (\<sqsubseteq>)" and pc: "pair_complete A (\<sqsubseteq>)" and A: "A \<noteq> {}"
+  shows "extremed A (\<sqsubseteq>)"
 proof-
-  from assms interpret directed_complete + pair_complete by auto
-  have "Ex (extreme_bound (\<sqsubseteq>) UNIV)" by (rule directed_nonempty_complete, auto)
-  then obtain t where "extreme_bound (\<sqsubseteq>) UNIV t" by auto
-  then have "\<forall>x. x \<sqsubseteq> t" by auto
-  then show ?thesis by (unfold_locales, auto)
+  have "\<exists>s. extreme_bound A (\<sqsubseteq>) A s"
+    apply (rule completeD[OF dc[unfolded directed_complete_def]])
+    using pair_complete_imp_directed[OF pc] A by auto
+  then obtain t where "extreme_bound A (\<sqsubseteq>) A t" by auto
+  then have "\<forall>x \<in> A. x \<sqsubseteq> t" and "t \<in> A" by auto
+  then show ?thesis by (auto simp: extremed_def)
 qed
 
-text \<open>Semicomplete is conditional complete and bounded.\<close>
+text \<open>Semicomplete is conditional complete and topped.\<close>
 
-proposition semicomplete_iff_conditionally_complete_bounded:
-  "semicomplete (\<sqsubseteq>) \<longleftrightarrow> conditionally_complete (\<sqsubseteq>) \<and> bounded (\<sqsubseteq>)" (is "?l \<longleftrightarrow> ?r")
-proof
-  assume ?r
-  then interpret conditionally_complete "(\<sqsubseteq>)" + bounded "(\<sqsubseteq>)" by auto
-  show ?l by (unfold_locales, rule bounded_nonempty_complete, auto)
+proposition semicomplete_iff_conditionally_complete_extremed:
+  assumes A: "A \<noteq> {}"
+  shows "semicomplete A (\<sqsubseteq>) \<longleftrightarrow> conditionally_complete A (\<sqsubseteq>) \<and> extremed A (\<sqsubseteq>)" (is "?l \<longleftrightarrow> ?r")
+proof (intro iffI)
+  assume r: "?r"
+  then have cc: "conditionally_complete A (\<sqsubseteq>)" and e: "extremed A (\<sqsubseteq>)" by auto
+  show ?l
+  proof (intro completeI, unfold mem_Collect_eq)
+    fix X
+    assume X: "X \<subseteq> A" and "X \<noteq> {}"
+    with extremed_imp_ex_bound[OF e X]
+    show "\<exists>s. extreme_bound A (\<sqsubseteq>) X s" by (auto intro!: completeD[OF cc X])
+  qed
 next
-  assume ?l
-  then interpret semicomplete.
-  show ?r by (intro conjI, unfold_locales)
+  assume l: ?l
+  with semicomplete_nonempty_imp_extremed[OF l] A
+  show ?r by (auto intro!: completeI dest: completeD)
 qed
 
 proposition complete_iff_pointed_semicomplete:
-  "complete (\<sqsubseteq>) \<longleftrightarrow> semicomplete (\<sqsubseteq>) \<and> bounded (\<sqsupseteq>)" (is "?l \<longleftrightarrow> ?r")
-proof
-  assume "complete (\<sqsubseteq>)"
-  then interpret complete.
-  show ?r by (intro conjI, unfold_locales)
-next
-  assume ?r
-  then interpret semicomplete + bounded "(\<sqsupseteq>)" by auto
-  show ?l
-  proof
-    fix X show "Ex (extreme_bound (\<sqsubseteq>) X)" by (cases "X = {}", auto intro:nonempty_complete)
-  qed
-qed
+  "UNIV-complete A (\<sqsubseteq>) \<longleftrightarrow> semicomplete A (\<sqsubseteq>) \<and> extremed A (\<sqsupseteq>)" (is "?l \<longleftrightarrow> ?r")
+  by (unfold pointed_iff_empty_complete complete_union[symmetric] Un_def, auto)
 
 text \<open>Conditional completeness only lacks top and bottom to be complete.\<close>
 
-proposition complete_iff_conditionally_complete_bounded_pointed:
-  "complete (\<sqsubseteq>) \<longleftrightarrow> conditionally_complete (\<sqsubseteq>) \<and> bounded (\<sqsubseteq>) \<and> bounded (\<sqsupseteq>)"
+proposition complete_iff_conditionally_complete_extremed_pointed:
+  "UNIV-complete A (\<sqsubseteq>) \<longleftrightarrow> conditionally_complete A (\<sqsubseteq>) \<and> extremed A (\<sqsubseteq>) \<and> extremed A (\<sqsupseteq>)"
   unfolding complete_iff_pointed_semicomplete
-    semicomplete_iff_conditionally_complete_bounded by auto
-
-end
+  apply (cases "A = {}")
+   apply (auto intro!: completeI dest: extremed_imp_ex_bound)[1]
+  unfolding semicomplete_iff_conditionally_complete_extremed
+  apply (auto intro:completeI)
+  done
 
 
 text \<open>If the universe is directed, then every pair is bounded, and thus has a supremum.
   On the other hand, supremum gives an upper bound, witnessing directedness.\<close>
 
-proposition (in conditionally_complete) pair_complete_iff_directed:
-  "pair_complete (\<sqsubseteq>) \<longleftrightarrow> directed (\<sqsubseteq>) UNIV"
+proposition conditionally_complete_imp_pair_complete_iff_directed:
+  assumes comp: "conditionally_complete A (\<sqsubseteq>)"
+  shows "pair_complete A (\<sqsubseteq>) \<longleftrightarrow> directed A (\<sqsubseteq>)" (is "?l \<longleftrightarrow> ?r")
 proof(intro iffI)
-  assume "directed (\<sqsubseteq>) UNIV"
-  then show "pair_complete (\<sqsubseteq>)"
-    by (unfold_locales, intro bounded_nonempty_complete, auto elim: directedE)
+  assume ?r
+  then show ?l
+    by (auto intro!: pair_completeI completeD[OF comp] elim: directedE)
 next
-  assume "pair_complete (\<sqsubseteq>)"
-  then interpret pair_complete.
-  show "directed (\<sqsubseteq>) UNIV"
+  assume pc: ?l
+  show ?r
   proof (intro directedI)
-    fix x y
-    from pair_complete obtain z where "extreme_bound (\<sqsubseteq>) {x,y} z" by auto
-    then show "\<exists>z\<in>UNIV. x \<sqsubseteq> z \<and> y \<sqsubseteq> z" by auto
+    fix x y assume "x \<in> A" and "y \<in> A"
+    with pc obtain z where "extreme_bound A (\<sqsubseteq>) {x,y} z" by (auto dest: pair_completeD)
+    then show "\<exists>z\<in>A. x \<sqsubseteq> z \<and> y \<sqsubseteq> z" by auto
   qed
 qed
 
+end
+
+text \<open>Following is a new generalization of (weak) chain-completeness:\<close>
+abbreviation "well_complete A r \<equiv> {X. well_related_set X r}-complete A r"
+
+subsection \<open>Duality of Completeness Conditions\<close>
+
+text \<open>Conditional completeness is symmetric.\<close>
+
+context fixes less_eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
+begin
+
+interpretation less_eq_notations.
+
+lemma conditionally_complete_dual:
+  assumes comp: "conditionally_complete A (\<sqsubseteq>)" shows "conditionally_complete A (\<sqsupseteq>)"
+proof (intro completeI, elim CollectE)
+  fix X assume XA: "X \<subseteq> A"
+  define B where [simp]: "B \<equiv> {b\<in>A. bound X (\<sqsupseteq>) b}"
+  assume bound: "\<exists>b\<in>A. bound X (\<sqsupseteq>) b \<and> X \<noteq> {}"
+  with in_mono[OF XA] have B: "B \<subseteq> A" and "\<exists>b \<in> A. bound B (\<sqsubseteq>) b" and "B \<noteq> {}" by auto
+  from comp[THEN completeD, OF B] this
+  obtain s where "s \<in> A" and "extreme_bound A (\<sqsubseteq>) B s" by auto
+  with in_mono[OF XA] show "\<exists>s. extreme_bound A (\<sqsupseteq>) X s" by (intro exI[of _ s] extremeI, auto)
+qed
+
+text \<open>Full completeness is symmetric.\<close>
+
+lemma complete_dual:
+  "UNIV-complete A (\<sqsubseteq>) \<Longrightarrow> UNIV-complete A (\<sqsupseteq>)"
+  apply (unfold complete_iff_conditionally_complete_extremed_pointed)
+  using conditionally_complete_dual by auto
+
+text \<open>Now we show that bounded completeness is the dual of semicompleteness.\<close>
+
+lemma pointed_conditionally_complete_iff_bounded_complete:
+  assumes A: "A \<noteq> {}"
+  shows "conditionally_complete A (\<sqsubseteq>) \<and> extremed A (\<sqsupseteq>) \<longleftrightarrow> bounded_complete A (\<sqsubseteq>)"
+  apply (unfold pointed_iff_empty_complete)
+  apply (fold complete_union)
+  apply (unfold Un_def)
+  apply (rule arg_cong[of _ _ "\<lambda>CC. CC-complete A (\<sqsubseteq>)"])
+  using A by auto
+
+proposition bounded_complete_iff_dual_semicomplete:
+  "bounded_complete A (\<sqsubseteq>) \<longleftrightarrow> semicomplete A (\<sqsupseteq>)"
+proof (cases "A = {}")
+  case True
+  then show ?thesis by auto
+next
+  case False
+  then show ?thesis
+    apply (fold pointed_conditionally_complete_iff_bounded_complete[OF False])
+    apply (unfold semicomplete_iff_conditionally_complete_extremed)
+    using Complete_Relations.conditionally_complete_dual by auto
+qed
+
+end
+
+lemmas connex_bounded_complete = connex_dual_semicomplete[folded bounded_complete_iff_dual_semicomplete]
 
 subsection \<open>Completeness Results Requiring Order-Like Properties\<close>
 
 text \<open>Above results hold without any assumption on the relation.
 This part demands some order-like properties.\<close>
 
 text \<open>It is well known that in a semilattice, i.e., a pair-complete partial order,
 every finite nonempty subset of elements has a supremum.
 We prove the result assuming transitivity, but only that.\<close>
 
-locale trans_semilattice = transitive + pair_complete
-
-sublocale trans_semilattice \<subseteq> finite_complete
-  apply (unfold_locales)
-  subgoal for X
-  proof (induct X rule:finite_induct)
-    case empty
+lemma (in transitive) pair_complete_iff_finite_complete:
+  "pair_complete A (\<sqsubseteq>) \<longleftrightarrow> finite_complete A (\<sqsubseteq>)" (is "?l \<longleftrightarrow> ?r")
+proof (intro iffI completeI, elim CollectE conjE)
+  fix X
+  assume pc: ?l
+  show "finite X \<Longrightarrow> X \<subseteq> A \<Longrightarrow> X \<noteq> {} \<Longrightarrow> Ex (extreme_bound A (\<sqsubseteq>) X)"
+  proof (induct X rule: finite_induct)
+  case empty
     then show ?case by auto
   next
     case (insert x X)
+    then have x: "x \<in> A" and X: "X \<subseteq> A" by auto
     show ?case
     proof (cases "X = {}")
       case True
-      obtain x' where "extreme_bound (\<sqsubseteq>) {x,x} x'" using pair_complete[of x x] by auto
+      obtain x' where "extreme_bound A (\<sqsubseteq>) {x,x} x'" using pc[THEN pair_completeD, OF x x] by auto
       with True show ?thesis by (auto intro!: exI[of _ x'])
     next
       case False
-      with insert obtain b where b: "extreme_bound (\<sqsubseteq>) X b" by auto
-      from pair_complete obtain c where c: "extreme_bound (\<sqsubseteq>) {x,b} c" by auto
+      with insert obtain b where b: "extreme_bound A (\<sqsubseteq>) X b" by auto
+      with pc[THEN pair_completeD] x obtain c where c: "extreme_bound A (\<sqsubseteq>) {x,b} c" by auto
+      from c have cA: "c \<in> A" and xc: "x \<sqsubseteq> c" and bc: "b \<sqsubseteq> c" by auto
+      from b have bA: "b \<in> A" and bX: "bound X (\<sqsubseteq>) b" by auto
       show ?thesis
       proof (intro exI extreme_boundI)
-        from c have "x \<sqsubseteq> c" and "b \<sqsubseteq> c" by auto
-        with b show "xb \<in> insert x X \<Longrightarrow> xb \<sqsubseteq> c" for xb by (auto dest: trans)
-        fix d assume "bound (\<sqsubseteq>) (insert x X) d"
-        with b have "bound (\<sqsubseteq>) {x,b} d" by auto
-        with c show "c \<sqsubseteq> d" by auto
-      qed
+        fix xb assume xb: "xb \<in> insert x X"
+        from bound_trans[OF bX bc X bA cA] have "bound X (\<sqsubseteq>) c".
+        with xb xc show "xb \<sqsubseteq> c" by auto
+      next
+        fix d assume "bound (insert x X) (\<sqsubseteq>) d" and dA: "d \<in> A"
+        with b have "bound {x,b} (\<sqsubseteq>) d" by auto
+        with c show "c \<sqsubseteq> d" using dA by auto
+      qed (fact cA)
     qed
   qed
-done
+qed (insert finite_complete_le_pair_complete, auto)
 
 
 text \<open>Gierz et al.~\cite{gierz03} showed that a directed complete partial order is semicomplete
 if and only if it is also a semilattice.
 We generalize the claim so that the underlying relation is only transitive.\<close>
 
 proposition(in transitive) semicomplete_iff_directed_complete_pair_complete:
-  "semicomplete (\<sqsubseteq>) \<longleftrightarrow> directed_complete (\<sqsubseteq>) \<and> pair_complete (\<sqsubseteq>)" (is "?l \<longleftrightarrow> ?r")
-proof (intro iffI semicomplete.intro)
-  assume ?l
-  then interpret semicomplete.
-  show ?r by (intro conjI, unfold_locales)
+  "semicomplete A (\<sqsubseteq>) \<longleftrightarrow> directed_complete A (\<sqsubseteq>) \<and> pair_complete A (\<sqsubseteq>)" (is "?l \<longleftrightarrow> ?r")
+proof (intro iffI)
+  assume l: ?l
+  then show ?r by (auto simp: directed_complete_def intro!: completeI pair_completeI completeD[OF l])
 next
   assume ?r
-  then interpret directed_complete + pair_complete by auto
-  interpret trans_semilattice ..
-  fix X :: "'a set"
-  have 1: "directed (\<sqsubseteq>) {x. \<exists>Y \<subseteq> X. finite Y \<and> Y \<noteq> {} \<and> extreme_bound (\<sqsubseteq>) Y x}" (is "directed _ ?B")
-  proof (intro directedI)
-    fix a b assume a: "a \<in> ?B" and b: "b \<in> ?B"
-    from a obtain A where A: "extreme_bound (\<sqsubseteq>) A a" "finite A" "A \<noteq> {}" "A \<subseteq> X" by auto
-    from b obtain B where B: "extreme_bound (\<sqsubseteq>) B b" "finite B" "B \<noteq> {}" "B \<subseteq> X" by auto
-    from A B have AB: "finite (A \<union> B)" "A \<union> B \<noteq> {}" "A \<union> B \<subseteq> X" by auto
-    with finite_nonempty_complete have "Ex (extreme_bound (\<sqsubseteq>) (A \<union> B))" by auto
-    then obtain c where c: "extreme_bound (\<sqsubseteq>) (A \<union> B) c" by auto
-    show "\<exists>c \<in> ?B. a \<sqsubseteq> c \<and> b \<sqsubseteq> c"
-    proof (intro bexI conjI)
-      from A B c show "a \<sqsubseteq> c" and "b \<sqsubseteq> c" by (auto simp: extreme_bound_iff)
-      from AB c show "c \<in> ?B" by (auto intro!: exI[of _ "A \<union> B"])
+  then have dc: "directed_complete A (\<sqsubseteq>)" and pc: "pair_complete A (\<sqsubseteq>)" by auto
+  with pair_complete_iff_finite_complete have fc: "finite_complete A (\<sqsubseteq>)" by auto
+  show ?l
+  proof (intro completeI, elim CollectE)
+    fix X assume XA: "X \<subseteq> A"
+    have 1: "directed {x. \<exists>Y \<subseteq> X. finite Y \<and> Y \<noteq> {} \<and> extreme_bound A (\<sqsubseteq>) Y x} (\<sqsubseteq>)" (is "directed ?B _")
+    proof (intro directedI)
+      fix a b assume a: "a \<in> ?B" and b: "b \<in> ?B"
+      from a obtain Y where Y: "extreme_bound A (\<sqsubseteq>) Y a" "finite Y" "Y \<noteq> {}" "Y \<subseteq> X" by auto
+      from b obtain B where B: "extreme_bound A (\<sqsubseteq>) B b" "finite B" "B \<noteq> {}" "B \<subseteq> X" by auto
+      from XA Y B have AB: "Y \<subseteq> A" "B \<subseteq> A" "finite (Y \<union> B)" "Y \<union> B \<noteq> {}" "Y \<union> B \<subseteq> X" by auto
+      with fc[THEN completeD] have "Ex (extreme_bound A (\<sqsubseteq>) (Y \<union> B))" by auto
+      then obtain c where c: "extreme_bound A (\<sqsubseteq>) (Y \<union> B) c" by auto
+      show "\<exists>c \<in> ?B. a \<sqsubseteq> c \<and> b \<sqsubseteq> c"
+      proof (intro bexI conjI)
+        from Y B c show "a \<sqsubseteq> c" and "b \<sqsubseteq> c" by (auto simp: extreme_bound_iff)
+        from AB c show "c \<in> ?B" by (auto intro!: exI[of _ "Y \<union> B"])
+      qed
     qed
-  qed
-  assume "X \<noteq> {}"
-  then obtain x where xX: "x \<in> X" by auto
-  from finite_nonempty_complete[of "{x}"]
-  obtain x' where "extreme_bound (\<sqsubseteq>) {x} x'" by auto
-  with xX have x'B: "x' \<in> ?B" by (auto intro!: exI[of _ "{x}"] extreme_boundI)
-  then have 2: "?B \<noteq> {}" by auto
-  from directed_nonempty_complete[OF 1 2]
-  obtain b where b: "extreme_bound (\<sqsubseteq>) ?B b" by auto
-  show "Ex (extreme_bound (\<sqsubseteq>) X)"
-  proof (intro exI extreme_boundI UNIV_I)
-    fix x
-    assume xX: "x \<in> X"
-    from finite_nonempty_complete[of "{x}"]
-    obtain c where c: "extreme_bound (\<sqsubseteq>) {x} c" by auto
-    then have xc: "x \<sqsubseteq> c" by auto
-    from c xX have cB: "c \<in> ?B" by (auto intro!: exI[of _ "{x}"] extreme_boundI)
-    with b have cb: "c \<sqsubseteq> b" by auto
-    from xc cb show "x \<sqsubseteq> b" by (rule trans) text\<open> Here transitivity is needed. \<close>
-  next
-    fix x
-    assume Xx: "bound (\<sqsubseteq>) X x"
-    have "bound (\<sqsubseteq>) ?B x"
-    proof (intro boundI UNIV_I, clarify)
-      fix c Y
-      assume "finite Y" and YX: "Y \<subseteq> X" and "Y \<noteq> {}" and c: "extreme_bound (\<sqsubseteq>) Y c"
-      from YX Xx have "bound (\<sqsubseteq>) Y x" by auto
-      with c show "c \<sqsubseteq> x" by auto
-    qed
-    with b show "b \<sqsubseteq> x" by auto
+    have B: "?B \<subseteq> A" by auto
+    assume "X \<noteq> {}"
+    then obtain x where xX: "x \<in> X" by auto
+    with fc[THEN completeD, of "{x}"] XA
+    obtain x' where "extreme_bound A (\<sqsubseteq>) {x} x'" by auto
+    with xX have x'B: "x' \<in> ?B" by (auto intro!: exI[of _ "{x}"] extreme_boundI)
+    then have 2: "?B \<noteq> {}" by auto
+    from dc[unfolded directed_complete_def, THEN completeD, of ?B] 1 2
+    obtain b where b: "extreme_bound A (\<sqsubseteq>) ?B b" by auto
+    then have bA: "b \<in> A" by auto
+    show "Ex (extreme_bound A (\<sqsubseteq>) X)"
+    proof (intro exI extreme_boundI UNIV_I)
+      fix x
+      assume xX: "x \<in> X"
+      with XA fc[THEN completeD, of "{x}"]
+      obtain c where c: "extreme_bound A (\<sqsubseteq>) {x} c" by auto
+      then have cA: "c \<in> A" and xc: "x \<sqsubseteq> c" by auto
+      from c xX have cB: "c \<in> ?B" by (auto intro!: exI[of _ "{x}"] extreme_boundI)
+      with b have bA: "b \<in> A" and cb: "c \<sqsubseteq> b" by auto
+      from xX XA cA bA trans[OF xc cb]
+      show "x \<sqsubseteq> b" by auto text\<open> Here transitivity is needed. \<close>
+    next
+      fix x
+      assume xA: "x \<in> A" and Xx: "bound X (\<sqsubseteq>) x"
+      have "bound ?B (\<sqsubseteq>) x"
+      proof (intro boundI UNIV_I, clarify)
+        fix c Y
+        assume "finite Y" and YX: "Y \<subseteq> X" and "Y \<noteq> {}" and c: "extreme_bound A (\<sqsubseteq>) Y c"
+        from YX Xx have "bound Y (\<sqsubseteq>) x" by auto
+        with c xA show "c \<sqsubseteq> x" by auto
+      qed
+      with b xA show "b \<sqsubseteq> x" by auto
+    qed (fact bA)
   qed
 qed
 
 text\<open>The last argument in the above proof requires transitivity,
 but if we had reflexivity then $x$ itself is a supremum of $\set{x}$
 (see @{thm reflexive.extreme_bound_singleton}) and so $x \SLE s$ would be immediate.
 Thus we can replace transitivity by reflexivity,
 but then pair-completeness does not imply finite completeness.
 We obtain the following result.\<close>
 
 proposition (in reflexive) semicomplete_iff_directed_complete_finite_complete:
-  "semicomplete (\<sqsubseteq>) \<longleftrightarrow> directed_complete (\<sqsubseteq>) \<and> finite_complete (\<sqsubseteq>)" (is "?l \<longleftrightarrow> ?r")
-proof (intro iffI semicomplete.intro)
-  assume ?l
-  then interpret semicomplete.
-  show ?r by (safe, unfold_locales)
+  "semicomplete A (\<sqsubseteq>) \<longleftrightarrow> directed_complete A (\<sqsubseteq>) \<and> finite_complete A (\<sqsubseteq>)" (is "?l \<longleftrightarrow> ?r")
+proof (intro iffI)
+  assume l: ?l
+  then show ?r by (auto simp: directed_complete_def intro!: completeI pair_completeI completeD[OF l])
 next
   assume ?r
-  then interpret directed_complete + finite_complete by auto
-  fix X :: "'a set"
-  have 1: "directed (\<sqsubseteq>) {x. \<exists>Y \<subseteq> X. finite Y \<and> Y \<noteq> {} \<and> extreme_bound (\<sqsubseteq>) Y x}" (is "directed _ ?B")
-  proof (intro directedI)
-    fix a b assume a: "a \<in> ?B" and b: "b \<in> ?B"
-    from a obtain A where A: "extreme_bound (\<sqsubseteq>) A a" "finite A" "A \<noteq> {}" "A \<subseteq> X" by auto
-    from b obtain B where B: "extreme_bound (\<sqsubseteq>) B b" "finite B" "B \<noteq> {}" "B \<subseteq> X" by auto
-    from A B have AB: "finite (A \<union> B)" "A \<union> B \<noteq> {}" "A \<union> B \<subseteq> X" by auto
-    with finite_nonempty_complete have "Ex (extreme_bound (\<sqsubseteq>) (A \<union> B))" by auto
-    then obtain c where c: "extreme_bound (\<sqsubseteq>) (A \<union> B) c" by auto
-    show "\<exists>c \<in> ?B. a \<sqsubseteq> c \<and> b \<sqsubseteq> c"
-    proof (intro bexI conjI)
-      from A B c show "a \<sqsubseteq> c" and "b \<sqsubseteq> c" by (auto simp: extreme_bound_iff)
-      from AB c show "c \<in> ?B" by (auto intro!: exI[of _ "A \<union> B"])
+  then have dc: "directed_complete A (\<sqsubseteq>)" and fc: "finite_complete A (\<sqsubseteq>)" by auto
+  show ?l
+  proof (intro completeI, elim CollectE)
+    fix X assume XA: "X \<subseteq> A"
+    have 1: "directed {x. \<exists>Y \<subseteq> X. finite Y \<and> Y \<noteq> {} \<and> extreme_bound A (\<sqsubseteq>) Y x} (\<sqsubseteq>)" (is "directed ?B _")
+    proof (intro directedI)
+      fix a b assume a: "a \<in> ?B" and b: "b \<in> ?B"
+      from a obtain Y where Y: "extreme_bound A (\<sqsubseteq>) Y a" "finite Y" "Y \<noteq> {}" "Y \<subseteq> X" by auto
+      from b obtain B where B: "extreme_bound A (\<sqsubseteq>) B b" "finite B" "B \<noteq> {}" "B \<subseteq> X" by auto
+      from XA Y B have AB: "Y \<subseteq> A" "B \<subseteq> A" "finite (Y \<union> B)" "Y \<union> B \<noteq> {}" "Y \<union> B \<subseteq> X" by auto
+      with fc[THEN completeD] have "Ex (extreme_bound A (\<sqsubseteq>) (Y \<union> B))" by auto
+      then obtain c where c: "extreme_bound A (\<sqsubseteq>) (Y \<union> B) c" by auto
+      show "\<exists>c \<in> ?B. a \<sqsubseteq> c \<and> b \<sqsubseteq> c"
+      proof (intro bexI conjI)
+        from Y B c show "a \<sqsubseteq> c" and "b \<sqsubseteq> c" by (auto simp: extreme_bound_iff)
+        from AB c show "c \<in> ?B" by (auto intro!: exI[of _ "Y \<union> B"])
+      qed
     qed
-  qed
-  assume "X \<noteq> {}"
-  then obtain x where xX: "x \<in> X" by auto
-  then have "extreme_bound (\<sqsubseteq>) {x} x" by auto
-  with xX have xB: "x \<in> ?B" by (auto intro!: exI[of _ "{x}"])
-  then have 2: "?B \<noteq> {}" by auto
-  from directed_nonempty_complete[OF 1 2]
-  obtain b where b: "extreme_bound (\<sqsubseteq>) ?B b" by auto
-  show "Ex (extreme_bound (\<sqsubseteq>) X)"
-  proof (intro exI extreme_boundI UNIV_I)
-    fix x
-    assume xX: "x \<in> X"
-    have x: "extreme_bound (\<sqsubseteq>) {x} x" by auto
-    from x xX have cB: "x \<in> ?B" by (auto intro!: exI[of _ "{x}"])
-    with b show "x \<sqsubseteq> b" by auto
-  next
-    fix x
-    assume Xx: "bound (\<sqsubseteq>) X x"
-    have "bound (\<sqsubseteq>) ?B x"
-    proof (intro boundI UNIV_I, clarify)
-      fix c Y
-      assume "finite Y" and YX: "Y \<subseteq> X" and "Y \<noteq> {}" and c: "extreme_bound (\<sqsubseteq>) Y c"
-      from YX Xx have "bound (\<sqsubseteq>) Y x" by auto
-      with c show "c \<sqsubseteq> x" by auto
-    qed
-    with b show "b \<sqsubseteq> x" by auto
+    have B: "?B \<subseteq> A" by auto
+    assume "X \<noteq> {}"
+    then obtain x where xX: "x \<in> X" by auto
+    with XA have "extreme_bound A (\<sqsubseteq>) {x} x"
+      by (intro extreme_bound_singleton, auto)
+    with xX have xB: "x \<in> ?B" by (auto intro!: exI[of _ "{x}"])
+    then have 2: "?B \<noteq> {}" by auto
+    from dc[unfolded directed_complete_def, THEN completeD, of ?B] B 1 2
+    obtain b where b: "extreme_bound A (\<sqsubseteq>) ?B b" by auto
+    then have bA: "b \<in> A" by auto
+    show "Ex (extreme_bound A (\<sqsubseteq>) X)"
+    proof (intro exI extreme_boundI UNIV_I)
+      fix x
+      assume xX: "x \<in> X"
+      with XA have x: "extreme_bound A (\<sqsubseteq>) {x} x" by (intro extreme_bound_singleton, auto)
+      from x xX have cB: "x \<in> ?B" by (auto intro!: exI[of _ "{x}"])
+      with b show "x \<sqsubseteq> b" by auto
+    next
+      fix x
+      assume Xx: "bound X (\<sqsubseteq>) x" and xA: "x \<in> A"
+      have "bound ?B (\<sqsubseteq>) x"
+      proof (intro boundI UNIV_I, clarify)
+        fix c Y
+        assume "finite Y" and YX: "Y \<subseteq> X" and "Y \<noteq> {}" and c: "extreme_bound A (\<sqsubseteq>) Y c"
+        from YX Xx have "bound Y (\<sqsubseteq>) x" by auto
+        with YX XA xA c show "c \<sqsubseteq> x" by auto
+      qed
+      with xA b show "b \<sqsubseteq> x" by auto
+    qed (fact bA)
   qed
 qed
 
-locale complete_attractive = complete + attractive
-
-locale complete_antisymmetric = complete + antisymmetric
-
-sublocale complete_antisymmetric \<subseteq> complete_attractive ..
-
-text \<open>Complete pseudo orders are called complete trellises~\cite{trellis},
-but let us reserve the name for introducing classes (in the future).\<close>
-
-locale complete_pseudo_order = complete + pseudo_order
-
-sublocale complete_pseudo_order \<subseteq> complete_antisymmetric ..
-
-text \<open>Finally, we (re)define complete lattices as a complete partial order.\<close>
-
-locale complete_partial_order = complete + partial_order
-
-sublocale complete_partial_order \<subseteq> trans_semilattice + complete_pseudo_order ..
-
 subsection \<open>Relating to Classes\<close>
 
-class ccomplete = ord + assumes "conditionally_complete (\<le>)"
-begin
-
-sublocale order: conditionally_complete using ccomplete_axioms unfolding class.ccomplete_def.
-
-end
+(* HOL.Conditionally_Complete_Lattices imports choice.
 
-class complete_ord = ord + assumes "complete (\<le>)"
-begin
-
-interpretation order: complete using complete_ord_axioms unfolding class.complete_ord_def.
-
-subclass ccomplete ..
-
-sublocale order: complete ..
-
-end
-
-text \<open>Isabelle's class @{class conditionally_complete_lattice} is @{class ccomplete}.
+text \<open>Isabelle's class @{class conditionally_complete_lattice} satisfies @{const conditionally_complete}.
 The other direction does not hold, since for the former,
 @{term "Sup {}"} and @{term "Inf {}"} are arbitrary even if there are top or bottom elements.\<close>
 
-subclass (in conditionally_complete_lattice) ccomplete
-proof
-  fix X
-  assume "Ex (upper_bound X)" and X0: "X \<noteq> {}"
-  from this(1) have "bdd_above X" by auto
-  from cSup_upper[OF _ this] cSup_least[OF X0]
+lemma (in conditionally_complete_lattice) "conditionally_complete UNIV (\<le>)"
+proof (intro completeI, elim CollectE)
+  fix X :: "'a set"
+  assume "\<exists>b\<in>UNIV. bound X (\<le>) b \<and> X \<noteq> {}"
+  then have bdd:"bdd_above X" and X0: "X \<noteq> {}" by (auto 0 3)
+  from cSup_upper[OF _ bdd] cSup_least[OF X0]
   have "supremum X (Sup X)" by (intro extremeI boundI, auto)
-  then show "Ex (supremum X)" by auto
+  then show "\<exists>s. least {b \<in> UNIV. bound X (\<le>) b} s" by auto
 qed
-
-text \<open>Isabelle's class @{class complete_lattice} is precisely @{locale complete_partial_order}.\<close>
-
-context complete_lattice begin
-
-interpretation order: complete_partial_order
-  by (unfold_locales, auto intro!: Sup_upper Sup_least Inf_lower Inf_greatest)
-
-subclass complete_ord ..
-
-sublocale order: complete_partial_order ..
-
-end
-
-
-subsection \<open>Duality of Completeness Conditions\<close>
-
-text \<open>Conditional completeness is symmetric.\<close>
-
-sublocale conditionally_complete \<subseteq> dual: conditionally_complete "(\<sqsubseteq>)\<^sup>-"
-proof
-  interpret less_eq_dualize.
-  fix X :: "'a set"
-  assume bound: "Ex (bound (\<sqsupseteq>) X)" and nonemp: "X \<noteq> {}"
-  then have "Ex (bound (\<sqsubseteq>) {b. bound (\<sqsupseteq>) X b})" and "{b. bound (\<sqsupseteq>) X b} \<noteq> {}" by auto
-  from bounded_nonempty_complete[OF this]
-  obtain s where "extreme_bound (\<sqsubseteq>) {b. bound (\<sqsupseteq>) X b} s" by auto
-  then show "Ex (extreme_bound (\<sqsupseteq>) X)" by (intro exI[of _ s] extremeI, auto)
-qed
-
-text \<open>Full completeness is symmetric.\<close>
-
-sublocale complete \<subseteq> dual: complete "(\<sqsubseteq>)\<^sup>-"
-proof
-  fix X :: "'a set"
-  obtain s where "extreme_bound (\<sqsubseteq>) {b. bound (\<sqsubseteq>)\<^sup>- X b} s" using complete by auto
-  then show "Ex (extreme_bound (\<sqsubseteq>)\<^sup>- X)" by (intro exI[of _ s] extreme_boundI, auto)
-qed
-
-sublocale complete_attractive \<subseteq> dual: complete_attractive "(\<sqsubseteq>)\<^sup>-" ..
+*)
+text \<open>Isabelle's class @{class complete_lattice} is @{term "UNIV-complete"}.\<close>
 
-sublocale complete_antisymmetric \<subseteq> dual: complete_antisymmetric "(\<sqsubseteq>)\<^sup>-" ..
-
-sublocale complete_pseudo_order \<subseteq> dual: complete_pseudo_order "(\<sqsubseteq>)\<^sup>-" ..
-
-sublocale complete_partial_order \<subseteq> dual: complete_partial_order "(\<sqsubseteq>)\<^sup>-" ..
-
-text \<open>Now we show that bounded completeness is the dual of semicompleteness.\<close>
-
-context fixes less_eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
-begin
-
-interpretation less_eq_dualize.
-
-definition "bounded_complete \<equiv> \<forall>X. Ex (bound (\<sqsubseteq>) X) \<longrightarrow> Ex (extreme_bound (\<sqsubseteq>) X)"
+lemma (in complete_lattice) "UNIV-complete UNIV (\<le>)"
+  by (auto intro!: completeI Sup_upper Sup_least Inf_lower Inf_greatest)
 
-lemma pointed_conditionally_complete_iff_bounded_complete:
-  "conditionally_complete (\<sqsubseteq>) \<and> bounded (\<sqsupseteq>) \<longleftrightarrow> bounded_complete"
-proof safe
-  assume "bounded_complete"
-  note * = this[unfolded bounded_complete_def, rule_format]
-  from * show "conditionally_complete (\<sqsubseteq>)" by (unfold_locales, auto)
-  from *[of "{}"] show "bounded (\<sqsupseteq>)" by (unfold_locales, auto simp:bound_empty)
-next
-  assume "conditionally_complete (\<sqsubseteq>)" and "bounded (\<sqsupseteq>)"
-  then interpret conditionally_complete "(\<sqsubseteq>)" + dual: bounded "(\<sqsupseteq>)".
-  show "bounded_complete" unfolding bounded_complete_def
-  proof (intro allI impI)
-    fix X
-    assume X: "Ex (bound (\<sqsubseteq>) X)"
-    show "Ex (extreme_bound (\<sqsubseteq>) X)"
-    proof (cases "X = {}")
-    case True
-    then show ?thesis by auto
-    next
-      case False
-      with bounded_nonempty_complete X show ?thesis by auto
-    qed
+subsection \<open>Set-wise Completeness\<close>
+
+lemma directed_sets_directed_complete:
+  assumes cl: "\<forall>DC. DC \<subseteq> AA \<longrightarrow> (\<forall>X\<in>DC. directed X r) \<longrightarrow> (\<Union>DC) \<in> AA"
+  shows "{DC. directed DC (\<subseteq>)}-complete {X \<in> AA. directed X r} (\<subseteq>)"
+proof (intro completeI, safe)
+  fix XX
+  assume ch: "XX \<subseteq> {X \<in> AA. directed X r}" and dir: "directed XX (\<subseteq>)"
+  with cl have "(\<Union>XX) \<in> AA" by auto
+  moreover have "directed (\<Union>XX) r"
+  proof (intro directedI, elim UnionE)
+    fix x y X Y assume xX: "x \<in> X" and X: "X \<in> XX" and yY: "y \<in> Y" and Y: "Y \<in> XX"
+    from directedD[OF dir X Y]
+    obtain Z where "X \<subseteq> Z" "Y \<subseteq> Z" and Z: "Z \<in> XX" by auto
+    with ch xX yY have "directed Z r" "x \<in> Z" "y \<in> Z" by auto
+    then obtain z where "z \<in> Z" "r x z \<and> r y z" by (auto elim:directedE)
+    with Z show "\<exists>z\<in>\<Union> XX. r x z \<and> r y z" by auto
   qed
-qed
-
-proposition bounded_complete_iff_dual_semicomplete:
-  "bounded_complete \<longleftrightarrow> semicomplete (\<sqsupseteq>)"
-proof (fold pointed_conditionally_complete_iff_bounded_complete, safe)
-  assume "conditionally_complete (\<sqsubseteq>)" and "bounded (\<sqsupseteq>)"
-  then interpret conditionally_complete + bounded "(\<sqsupseteq>)".
-  from dual.conditionally_complete_axioms bounded_axioms
-    semicomplete_iff_conditionally_complete_bounded
-  show "semicomplete (\<sqsupseteq>)" by auto
-next
-  assume "semicomplete (\<sqsupseteq>)"
-  then interpret semicomplete "(\<sqsupseteq>)".
-  show "conditionally_complete (\<sqsubseteq>)" ..
-  show "bounded (\<sqsupseteq>)" ..
+  ultimately have "extreme_bound {X \<in> AA. directed X r} (\<subseteq>) XX (\<Union>XX)" by auto
+  then show "Ex (extreme_bound {X \<in> AA. directed X r} (\<subseteq>) XX)" by auto
 qed
 
-end
-
-
-subsection \<open>Completeness in Function Spaces\<close>
-
-text \<open>Here we lift completeness to functions. As we do not assume an operator to choose suprema,
-we need the axiom of choice for most of the following results. In antisymmetric cases we do not
-need the axiom but we do not formalize this fact.\<close>
-
-lemma (in bounded) bounded_fun[intro!]: "bounded (fun_ord (\<sqsubseteq>))"
-proof-
-  from bounded obtain t where "\<forall>x. x \<sqsubseteq> t" by auto
-  then have "\<forall>f. fun_ord (\<sqsubseteq>) f (\<lambda>x. t)" by (auto intro: fun_ordI)
-  then show ?thesis by (auto intro: bounded.intro)
-qed
-
-lemma (in pair_complete) pair_complete_fun[intro!]:
-  "pair_complete (fun_ord (\<sqsubseteq>) :: ('i \<Rightarrow> _) \<Rightarrow> _)"
-proof
-  fix f g :: "'i \<Rightarrow> _"
-  from pair_complete have "\<forall>x. \<exists>sx. extreme_bound (\<sqsubseteq>) {f x, g x} sx" by auto
-  from choice[OF this]
-  obtain s where "\<forall>x. extreme_bound (\<sqsubseteq>) {f x, g x} (s x)" by auto
-  then show "Ex (extreme_bound (fun_ord (\<sqsubseteq>)) {f, g})"
-    by (unfold fun_extreme_bound_iff, intro exI[of _ s], auto 1 4)
-qed
-
-lemma (in finite_complete) finite_complete_fun[intro!]:
-  "finite_complete (fun_ord (\<sqsubseteq>) :: ('i \<Rightarrow> 'a) \<Rightarrow> _)"
-proof
-  fix F :: "('i \<Rightarrow> 'a) set"
-  assume "finite F" and "F \<noteq> {}"
-  with finite_nonempty_complete
-  have "\<forall>x. \<exists>sx. extreme_bound (\<sqsubseteq>) {f x |. f \<in> F} sx" by auto
-  from choice[OF this]
-  show "Ex (extreme_bound (fun_ord (\<sqsubseteq>)) F)" by (unfold fun_extreme_bound_iff, auto)
-qed
-
-lemma (in omega_complete) omega_complete_fun[intro!]:
-  "omega_complete (fun_ord (\<sqsubseteq>) :: ('i \<Rightarrow> 'a) \<Rightarrow> _)"
-proof
-  fix ff :: "nat \<Rightarrow> 'i \<Rightarrow> 'a"
-  assume ff: "monotone (\<le>) (fun_ord (\<sqsubseteq>)) ff"
-  then have "\<forall>i. Ex (extreme_bound (\<sqsubseteq>) {ff n i |. n})"
-    by (intro allI monotone_seq_complete, auto simp: monotone_def fun_ord_def)
-  from choice[OF this]
-  obtain s where "\<forall>i. extreme_bound (\<sqsubseteq>) {ff n i |. n} (s i)" by auto
-  then have "extreme_bound (fun_ord (\<sqsubseteq>)) (range ff) s"
-    by (auto simp: fun_extreme_bound_iff image_image)
-  then show "Ex (extreme_bound (fun_ord (\<sqsubseteq>)) (range ff))" by auto
-qed
-
-lemma (in chain_complete) chain_complete_fun[intro!]:
-  "chain_complete (fun_ord (\<sqsubseteq>) :: ('i \<Rightarrow> 'a) \<Rightarrow> _)"
-proof
-  fix F :: "('i \<Rightarrow> 'a) set"
-  assume F: "chain (fun_ord (\<sqsubseteq>)) F" and "F \<noteq> {}"
-  then have "\<forall>i. Ex (extreme_bound (\<sqsubseteq>) {f i |. f \<in> F})"
-    by (intro allI chain_nonempty_complete, auto simp: chain_def fun_ord_def)
-  from choice[OF this]
-  obtain s where "\<forall>i. extreme_bound (\<sqsubseteq>) {f i |. f \<in> F} (s i)" by auto
-  then show "Ex (extreme_bound (fun_ord (\<sqsubseteq>)) F)" by (auto simp: fun_extreme_bound_iff)
+lemma connex_directed_Un:
+  assumes ch: "CC \<subseteq> {C. connex C r}" and dir: "directed CC (\<subseteq>)"
+  shows "connex (\<Union>CC) r"
+proof (intro connexI, elim UnionE)
+  fix x y X Y assume xX: "x \<in> X" and X: "X \<in> CC" and yY: "y \<in> Y" and Y: "Y \<in> CC"
+  from directedD[OF dir X Y]
+  obtain Z where "X \<subseteq> Z" "Y \<subseteq> Z" "Z \<in> CC" by auto
+  with xX yY ch have "x \<in> Z" "y \<in> Z" "connex Z r" by auto
+  then show "r x y \<or> r y x" by (auto elim:connexE)
 qed
 
-lemma (in directed_complete) directed_complete_fun[intro!]:
-  "directed_complete (fun_ord (\<sqsubseteq>) :: ('i \<Rightarrow> 'a) \<Rightarrow> _)"
-proof
-  fix F :: "('i \<Rightarrow> 'a) set"
-  assume dir: "directed (fun_ord (\<sqsubseteq>)) F" and F0: "F \<noteq> {}"
-  have "\<forall>i. Ex (extreme_bound (\<sqsubseteq>) {f i |. f \<in> F})"
-  proof (intro allI directed_nonempty_complete directedI, safe)
-    fix i f g assume "f \<in> F" "g \<in> F"
-    with dir obtain h
-      where h: "h \<in> F" and "fun_ord (\<sqsubseteq>) f h" and "fun_ord (\<sqsubseteq>) g h" by (auto elim:directedE)
-    then have "f i \<sqsubseteq> h i" and "g i \<sqsubseteq> h i" by (auto dest: fun_ordD)
-    with h show "\<exists>hi\<in>{f i |. f \<in> F}. f i \<sqsubseteq> hi \<and> g i \<sqsubseteq> hi" by (intro bexI[of _ "h i"], auto)
-  qed (insert F0, auto)
-  from choice[OF this]
-  obtain s where "\<forall>i. extreme_bound (\<sqsubseteq>) {f i |. f \<in> F} (s i)" by auto
-  then show "Ex (extreme_bound (fun_ord (\<sqsubseteq>)) F)" by (auto simp: fun_extreme_bound_iff)
-qed
-
-lemma (in conditionally_complete) conditionally_complete_fun[intro!]:
-  "conditionally_complete (fun_ord (\<sqsubseteq>) :: ('i \<Rightarrow> 'a) \<Rightarrow> _)"
-proof
-  fix F :: "('i \<Rightarrow> 'a) set"
-  assume bF: "Ex (bound (fun_ord (\<sqsubseteq>)) F)" and F: "F \<noteq> {}"
-  from bF obtain b where b: "bound (fun_ord (\<sqsubseteq>)) F b" by auto
-  have "\<forall>x. \<exists>sx. extreme_bound (\<sqsubseteq>) {f x |. f \<in> F} sx"
-  proof
-    fix x
-    from b have "bound (\<sqsubseteq>) {f x |. f \<in> F} (b x)" by (auto simp: fun_ord_def)
-    with bounded_nonempty_complete F
-    show "Ex (extreme_bound (\<sqsubseteq>) {f x |. f \<in> F})" by auto
-  qed
-  from choice[OF this]
-  show "Ex (extreme_bound (fun_ord (\<sqsubseteq>)) F)" by (unfold fun_extreme_bound_iff, auto)
-qed
-
-lemma (in semicomplete) semicomplete_fun[intro!]: "semicomplete (fun_ord (\<sqsubseteq>))"
-  by (auto simp: semicomplete_iff_conditionally_complete_bounded)
-
-lemma (in pointed_chain_complete) pointed_chain_complete_fun[intro!]:
-  "pointed_chain_complete (fun_ord (\<sqsubseteq>))"
-  by (auto intro!: pointed_chain_complete.intro simp: dual_fun_ord)
-
-lemma (in pointed_directed_complete) pointed_directed_complete_fun[intro!]:
-  "pointed_directed_complete (fun_ord (\<sqsubseteq>))"
-  by (auto intro!: pointed_directed_complete.intro simp: dual_fun_ord)
-
-lemma (in complete) complete_fun[intro!]: "complete (fun_ord (\<sqsubseteq>))"
-  by (auto simp: complete_iff_pointed_semicomplete dual_fun_ord)
-
-subsection \<open>Interpretations\<close>
-
-context complete_lattice begin
-
-lemma Sup_eq_The_supremum: "Sup X = The (supremum X)"
-  using order.complete[unfolded order.dual.ex_extreme_iff_ex1]
-  by (rule the1_equality[symmetric], auto intro!: Sup_upper Sup_least)
-
-lemma Inf_eq_The_infimum: "Inf X = The (infimum X)"
-  using order.dual.complete[unfolded order.ex_extreme_iff_ex1]
-  by (rule the1_equality[symmetric], auto intro!: Inf_lower Inf_greatest)
-
-end
-
-instance real :: ccomplete by (intro_classes, unfold_locales)
-
-instance "fun" :: (type, ccomplete) ccomplete by (intro_classes, fold fun_ord_le, auto)
-
-instance "fun" :: (type, complete_ord) complete_ord by (intro_classes, fold fun_ord_le, auto)
+lemma connex_directed_complete: "{DC. directed DC (\<subseteq>)}-complete {C. connex C r} (\<subseteq>)"
+  by (intro completeI, force dest!: connex_directed_Un)
 
 end
\ No newline at end of file
diff --git a/thys/Complete_Non_Orders/Fixed_Points.thy b/thys/Complete_Non_Orders/Fixed_Points.thy
--- a/thys/Complete_Non_Orders/Fixed_Points.thy
+++ b/thys/Complete_Non_Orders/Fixed_Points.thy
@@ -1,714 +1,1236 @@
 (*
-Author:  Jérémy Dubut (2019)
-Author:  Akihisa Yamada (2019)
+Author:  Jérémy Dubut (2019-2021)
+Author:  Akihisa Yamada (2019-2021)
 License: LGPL (see file COPYING.LESSER)
 *)
-section \<open>Knaster--Tarski-Style Fixed-Point Theorem\<close>
 
 theory Fixed_Points
   imports Complete_Relations
 begin
 
-text \<open>Given a monotone map
-$f : A \to A$ on a complete lattice $\tp{A,\SLE}$,
-the Knaster--Tarski theorem~\cite{tarski55} states that
-\begin{enumerate}
-\item $f$ has a fixed point in $A$, and
-\item the set of fixed points forms a complete lattice.
-\end{enumerate}
-Stauti and Maaden \cite{SM13} generalized statement (1) where $\tp{A,\SLE}$
-is a complete \emph{trellis}---a complete pseudo-order---%
-relaxing transitivity.
-They also proved a restricted version of (2),
-namely there exists a least (and by duality a greatest) fixed point in $A$.
+section \<open>Existence of Fixed Points in Complete Related Sets\<close>
+text \<open>\label{sec:qfp-exists}\<close>
 
-In the following Section~\ref{sec:qfp-exists} we further generalize claim (1)
-so that any complete relation
-admits a \emph{quasi-fixed point} $f(x) \sim x$, that is, $f(x) \SLE x$ and $x \SLE f(x)$.
-Quasi-fixed points are fixed points for antisymmetric relations;
-hence the Stauti--Maaden theorem is further generalized by relaxing reflexivity.
+text \<open>The following proof is simplified and generalized from
+  Stouti--Maaden \cite{SM13}. We construct some set whose extreme bounds 
+  -- if they exist, typically when the underlying related set is complete -- 
+  are fixed points of a monotone or inflationary function on any 
+  related set. When the related set is attractive, those are actually the least fixed points.
+  This generalizes \cite{SM13}, relaxing reflexivity and antisymmetry.\<close>
 
-In Section \ref{sec:qfp-complete}
-we also generalize claim (2) so that only a mild condition, which we call \emph{attractivity},
-is assumed. In this attractive setting quasi-fixed points are complete.
-Since attractivity is implied by either of transitivity or antisymmetry,
-in particular fixed points are complete in complete trellis,
-thus completing Stauti and Maaden's result. We then further generalize the result, proving that
-antisymmetry is sufficient for \emph{strict} fixed points
-$f(x) = x$ to be complete.\<close>
-
-subsection \<open>Completeness of a Subset\<close>
-
-text \<open>We start by formalizing what it means for a subset to have an extreme bound inside 
-a set, and for this subset to be complete. We prove that this completeness is also auto-dual.\<close>
-
-context
-  fixes less_eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
+locale fixed_point_proof = related_set +
+  fixes f
+  assumes f: "f ` A \<subseteq> A"
 begin
 
-interpretation less_eq_dualize.
-
-abbreviation "extreme_bound_in S X \<equiv> extreme (\<sqsupseteq>) {b \<in> S. bound (\<sqsubseteq>) X b}"
-
-lemma extreme_bound_inI[intro]:
-  assumes "\<And>b. bound (\<sqsubseteq>) X b \<Longrightarrow> b \<in> S \<Longrightarrow> s \<sqsubseteq> b" and "s \<in> S" and "\<And>x. x \<in> X \<Longrightarrow> x \<sqsubseteq> s"
-  shows "extreme_bound_in S X s"
-  using assms by auto
-
-definition "complete_in S \<equiv> \<forall>X \<subseteq> S. Ex (extreme_bound_in S X)"
+sublocale less_eq_notations.
 
-lemma complete_inE[elim]:
-  assumes "complete_in S" and "(\<And>X. X \<subseteq> S \<Longrightarrow> Ex (extreme_bound_in S X)) \<Longrightarrow> thesis"
-  shows "thesis"
-  using assms by (auto simp: complete_in_def)
+definition AA where "AA \<equiv>
+  {X. X \<subseteq> A \<and> f ` X \<subseteq> X \<and> (\<forall>Y s. Y \<subseteq> X \<longrightarrow> extreme_bound A (\<sqsubseteq>) Y s \<longrightarrow> s \<in> X)}"
 
-lemma complete_inD:
-  shows "complete_in S \<Longrightarrow> X \<subseteq> S \<Longrightarrow> Ex (extreme_bound_in S X)"
-  by (auto simp: complete_in_def)
+lemma AA_I:
+  "X \<subseteq> A \<Longrightarrow> f ` X \<subseteq> X \<Longrightarrow> (\<And>Y s. Y \<subseteq> X \<Longrightarrow> extreme_bound A (\<sqsubseteq>) Y s \<Longrightarrow> s \<in> X) \<Longrightarrow> X \<in> AA"
+  by (unfold AA_def, safe)
 
-lemma complete_inI[intro?]:
-  assumes "\<And>X. X \<subseteq> S \<Longrightarrow> Ex (extreme_bound_in S X)"
-  shows "complete_in S"
-  using assms by (auto simp: complete_in_def)
+lemma AA_E:
+  "X \<in> AA \<Longrightarrow>
+   (X \<subseteq> A \<Longrightarrow> f ` X \<subseteq> X \<Longrightarrow> (\<And>Y s. Y \<subseteq> X \<Longrightarrow> extreme_bound A (\<sqsubseteq>) Y s \<Longrightarrow> s \<in> X) \<Longrightarrow> thesis) \<Longrightarrow> thesis"
+  by (auto simp: AA_def)
 
-end
+definition C where "C \<equiv> \<Inter> AA"
+
+lemma A_AA: "A \<in> AA" by (auto intro!:AA_I f)
+
+lemma C_AA: "C \<in> AA"
+proof (intro AA_I)
+  show "C \<subseteq> A" using C_def A_AA f by auto
+  show "f ` C \<subseteq> C" unfolding C_def AA_def by auto
+  fix B b assume B: "B \<subseteq> C" "extreme_bound A (\<sqsubseteq>) B b"
+  { fix X assume X: "X \<in> AA"
+    with B have "B \<subseteq> X" by (auto simp: C_def)
+    with X B have "b\<in>X" by (auto elim!: AA_E)
+  }
+  then show "b \<in> C" by (auto simp: C_def AA_def)
+qed
+
+lemma CA: "C \<subseteq> A" using A_AA by (auto simp: C_def)
+
+lemma fC: "f ` C \<subseteq> C" using C_AA by (auto elim!: AA_E)
 
 context
-  fixes less_eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
+  fixes c assumes Cc: "extreme_bound A (\<sqsubseteq>) C c"
 begin
 
-interpretation less_eq_dualize.
+private lemma cA: "c \<in> A" using Cc by auto
+private lemma cC: "c \<in> C" using Cc C_AA by (blast elim!:AA_E) 
+private lemma fcC: "f c \<in> C" using cC AA_def C_AA by auto
+private lemma fcA: "f c \<in> A" using fcC CA by auto
 
-lemma complete_in_dual:
-  assumes complete: "complete_in (\<sqsubseteq>) S" shows "complete_in (\<sqsupseteq>) S"
-proof
-  fix A :: "'a set"
-  assume AS: "A \<subseteq> S"
-  define B where "B \<equiv> {b\<in>S. bound (\<sqsupseteq>) A b}"
-  then have "B \<subseteq> S" by auto
-  then obtain b where "extreme_bound_in (\<sqsubseteq>) S B b"
-    using complete by force
-  with AS show "Ex (extreme_bound_in (\<sqsupseteq>) S A)"
-    apply (intro exI[of _ b], unfold extreme_def B_def) by auto
+lemma qfp_as_extreme_bound:
+  assumes infl_mono: "\<forall>x \<in> A. x \<sqsubseteq> f x \<or> (\<forall>y \<in> A. y \<sqsubseteq> x \<longrightarrow> f y \<sqsubseteq> f x)"
+  shows "f c \<sim> c"
+proof (intro conjI bexI sympartpI)
+  show "f c \<sqsubseteq> c" using fcC Cc by auto
+  from infl_mono[rule_format, OF cA]
+  show "c \<sqsubseteq> f c"
+  proof (safe)
+    text \<open>Monotone case:\<close>
+    assume mono: "\<forall>b\<in>A. b \<sqsubseteq> c \<longrightarrow> f b \<sqsubseteq> f c"
+    define D where "D \<equiv> {x \<in> C. x \<sqsubseteq> f c}"
+    have "D \<in> AA"
+    proof (intro AA_I)
+      show "D \<subseteq> A" unfolding D_def C_def using A_AA f by auto
+      have fxC: "x \<in> C \<Longrightarrow> x \<sqsubseteq> f c \<Longrightarrow> f x \<in> C" for x using C_AA by (auto simp: AA_def)
+      show "f ` D \<subseteq> D"
+      proof (unfold D_def, safe intro!: fxC)
+        fix x assume xC: "x \<in> C"
+        have "x \<sqsubseteq> c" "x \<in> A" using Cc xC CA by auto
+        then show "f x \<sqsubseteq> f c" using mono by (auto dest:monotoneD)
+      qed
+      have DC: "D \<subseteq> C" unfolding D_def by auto
+      fix B b assume BD: "B \<subseteq> D" and Bb: "extreme_bound A (\<sqsubseteq>) B b"
+      have "B \<subseteq> C" using DC BD by auto
+      then have bC: "b \<in> C" using C_AA Bb BD by (auto elim!: AA_E)
+      have bfc: "\<forall>a\<in>B. a \<sqsubseteq> f c" using BD unfolding D_def by auto
+      with f cA Bb
+      have "b \<sqsubseteq> f c" by (auto simp: extreme_def image_subset_iff)
+      with bC show "b \<in> D" unfolding D_def by auto
+    qed
+    then have "C \<subseteq> D" unfolding C_def by auto
+    then show "c \<sqsubseteq> f c" using cC unfolding D_def by auto
+  qed
+qed
+
+lemma extreme_qfp:
+  assumes attract: "\<forall>q \<in> A. \<forall>x \<in> A. f q \<sim> q \<longrightarrow> x \<sqsubseteq> f q \<longrightarrow> x \<sqsubseteq> q"
+    and mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
+  shows "extreme {q \<in> A. f q \<sim> q \<or> f q = q} (\<sqsupseteq>) c"
+proof-
+  have fcc: "f c \<sim> c"
+    apply (rule qfp_as_extreme_bound)
+    using mono by (auto elim!: monotone_onE)
+  define L where [simp]: "L \<equiv> {a \<in> A. \<forall>s \<in> A. (f s \<sim> s \<or> f s = s) \<longrightarrow> a \<sqsubseteq> s}"
+  have "L \<in> AA"
+  proof (unfold AA_def, intro CollectI conjI allI impI)
+    show XA: "L \<subseteq> A" by auto  
+    show "f ` L \<subseteq> L"
+    proof safe
+      fix x assume xL: "x \<in> L"
+      show "f x \<in> L"
+      proof (unfold L_def, safe)
+        have xA: "x \<in> A" using xL by auto 
+        then show fxA: "f x \<in> A" using f by auto
+        { fix s assume sA: "s \<in> A" and sf: "f s \<sim> s \<or> f s = s"
+          then have "x \<sqsubseteq> s" using xL sA sf by auto
+          then have "f x \<sqsubseteq> f s" using mono fxA sA xA by (auto elim!:monotone_onE)}
+        note fxfs = this
+        { fix s assume sA: "s \<in> A" and sf: "f s \<sim> s"
+          then show "f x \<sqsubseteq> s" using fxfs attract mono sf fxA sA xA by (auto elim!:monotone_onE)
+        }
+        { fix s assume sA: "s \<in> A" and sf: "f s = s"
+          with fxfs[OF sA] show "f x \<sqsubseteq> s" by simp}
+      qed 
+    qed
+    fix B b assume BL: "B \<subseteq> L" and b: "extreme_bound A (\<sqsubseteq>) B b"
+    then have BA: "B \<subseteq> A" by auto
+    with BL b have bA: "b \<in> A" by auto
+    show "b \<in> L"
+    proof (unfold L_def, safe intro!: bA)
+      { fix s assume sA: "s \<in> A" and sf: "f s \<sim> s \<or> f s = s"
+        have "bound B (\<sqsubseteq>) s" using sA BL b sf by auto
+      }
+      note Bs = this
+      { fix s assume sA: "s \<in> A" and sf: "f s \<sim> s"
+        with b sA Bs show "b \<sqsubseteq> s" by auto
+      }
+      { fix s assume sA: "s \<in> A" and sf: "f s = s"
+        with b sA Bs show "b \<sqsubseteq> s" by auto
+      }
+    qed
+  qed
+  then have "C \<subseteq> L" by (simp add: C_def Inf_lower)
+  with cC have "c \<in> L" by auto
+  with L_def fcc
+  show ?thesis by auto
 qed
 
 end
 
-subsection \<open>Existence of Quasi-Fixed Points\<close>
-text \<open>\label{sec:qfp-exists}\<close>
-
-text \<open>The following proof is simplified and generalized from
-  Stouti--Maaden \cite{SM13}. We generalize so that the underlying 
-relation is not even reflexive or antisymmetric.\<close>
-
-locale fixed_point_proof = less_eq_dualize
-begin
+lemma ex_qfp:
+  assumes comp: "CC-complete A (\<sqsubseteq>)" and C: "C \<in> CC"
+    and infl_mono: "\<forall>a \<in> A. a \<sqsubseteq> f a \<or> (\<forall>b \<in> A. b \<sqsubseteq> a \<longrightarrow> f b \<sqsubseteq> f a)"
+  shows "\<exists>s \<in> A. f s \<sim> s"
+  using qfp_as_extreme_bound[OF _  infl_mono] completeD[OF comp CA C] by auto
 
-context
-  fixes f :: "'a \<Rightarrow> 'a" and S :: "'a set"
-  assumes mono: "monotone (\<sqsubseteq>) (\<sqsubseteq>) f"
-  assumes f_closed_S: "f ` S \<subseteq> S"
-  assumes S_comp: "complete_in (\<sqsubseteq>) S"
-begin
-
-definition AA where "AA \<equiv>
-  {A. A \<subseteq> S \<and> f ` A \<subseteq> A \<and> (\<forall>B \<subseteq> A. \<forall>b. extreme_bound_in (\<sqsubseteq>) S B b \<longrightarrow> b \<in> A)}"
-definition C where "C \<equiv> \<Inter> AA"
+lemma ex_extreme_qfp_fp:
+  assumes comp: "CC-complete A (\<sqsubseteq>)" and C: "C \<in> CC"
+    and attract: "\<forall>q \<in> A. \<forall>x \<in> A. f q \<sim> q \<longrightarrow> x \<sqsubseteq> f q \<longrightarrow> x \<sqsubseteq> q"
+    and mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
+  shows "\<exists>c. extreme {q \<in> A. f q \<sim> q \<or> f q = q} (\<sqsupseteq>) c"
+  using extreme_qfp[OF _ attract mono] completeD[OF comp CA C] by auto
 
-qualified lemma S_AA: "S \<in> AA" by (auto simp: AA_def f_closed_S)
-
-qualified lemma C_AA: "C \<in> AA"
-proof (unfold  AA_def, intro CollectI conjI allI impI)
-  show "C \<subseteq> S" using C_def S_AA f_closed_S by auto
-  show "f ` C \<subseteq> C" unfolding C_def AA_def by auto
-  fix B b assume BC: "B \<subseteq> C" and EBS: "extreme_bound_in (\<sqsubseteq>) S B b"
-  { fix X assume "X \<in> AA"
-    with EBS have "b\<in>X" 
-      apply (unfold AA_def,safe) by (metis BC C_def Inf_lower subset_trans)
-  }
-  then show "b \<in> C" by (auto simp: C_def AA_def)
+lemma ex_extreme_qfp:
+  assumes comp: "CC-complete A (\<sqsubseteq>)" and C: "C \<in> CC"
+    and attract: "\<forall>q \<in> A. \<forall>x \<in> A. f q \<sim> q \<longrightarrow> x \<sqsubseteq> f q \<longrightarrow> x \<sqsubseteq> q"
+    and mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
+  shows "\<exists>c. extreme {q \<in> A. f q \<sim> q} (\<sqsupseteq>) c"
+proof-
+  from completeD[OF comp CA C]
+  obtain c where Cc: "extreme_bound A (\<sqsubseteq>) C c" by auto
+  from extreme_qfp[OF Cc attract mono]
+  have Qc: "bound {q \<in> A. f q \<sim> q} (\<sqsupseteq>) c" by auto
+  have fcc: "f c \<sim> c"
+    apply (rule qfp_as_extreme_bound[OF Cc])
+    using mono by (auto simp: monotone_onD)
+  from Cc CA have cA: "c \<in> A" by auto
+  from Qc fcc cA show ?thesis by (auto intro!: exI[of _ c])
 qed
 
-lemma quasi_fixed_point_in_C: "\<exists>c \<in> C. f c \<sim> c"
+end
+
+context
+  fixes less_eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50) and A :: "'a set" and f
+  assumes f: "f ` A \<subseteq> A"
+begin
+
+interpretation less_eq_notations.
+interpretation fixed_point_proof A "(\<sqsubseteq>)" f using f by unfold_locales
+
+theorem complete_infl_mono_imp_ex_qfp:
+  assumes comp: "UNIV-complete A (\<sqsubseteq>)" and infl_mono: "\<forall>a\<in>A. a \<sqsubseteq> f a \<or> (\<forall>b\<in>A. b \<sqsubseteq> a \<longrightarrow> f b \<sqsubseteq> f a)"
+  shows "\<exists>s\<in>A. f s \<sim> s"
+  apply (rule ex_qfp[OF comp _ infl_mono]) by auto
+
+end
+
+corollary (in antisymmetric) complete_infl_mono_imp_ex_fp:
+  assumes comp: "UNIV-complete A (\<sqsubseteq>)" and f: "f ` A \<subseteq> A"
+    and infl_mono: "\<forall>a\<in>A. a \<sqsubseteq> f a \<or> (\<forall>b\<in>A. b \<sqsubseteq> a \<longrightarrow> f b \<sqsubseteq> f a)"
+  shows "\<exists>s \<in> A. f s = s"
 proof-
-  obtain c where c: "extreme_bound_in (\<sqsubseteq>) S C c" 
-    using S_comp unfolding complete_in_def C_def
-    by (metis InterE S_AA subset_iff)
-  then have cS: "c \<in> S" by auto
-  show "\<exists>c \<in> C. f c \<sim> c"
-  proof (intro conjI bexI)
-    show cCS: "c \<in> C" using AA_def C_AA c by auto
-    then have "f c \<in> C" using AA_def C_AA by auto
-    then show "f c \<sqsubseteq> c" using f_closed_S cS c by auto
-    show "c \<sqsubseteq> f c"
-    proof-
-      define D where "D \<equiv> {x \<in> C. x \<sqsubseteq> f c}"
-      have "D \<in> AA"
-      proof (unfold  AA_def, intro CollectI conjI allI impI)
-        show "D \<subseteq> S"
-          unfolding D_def C_def using S_AA f_closed_S by auto
-        have fxC: "x \<in> C \<Longrightarrow> x \<sqsubseteq> f c \<Longrightarrow> f x \<in> C" for x using C_AA by (auto simp: AA_def)
-        show "f ` D \<subseteq> D"
-        proof (unfold D_def, safe intro!: fxC)
-          fix x assume xC: "x \<in> C"
-          have "x \<sqsubseteq> c" using c xC by auto
-          then show "f x \<sqsubseteq> f c" using mono by (auto dest:monotoneD)
+  interpret less_eq_notations.
+  from complete_infl_mono_imp_ex_qfp[OF f comp infl_mono]
+  obtain s where sA: "s \<in> A" and fss: "f s \<sim> s" by auto
+  from f sA have fsA: "f s \<in> A" by auto
+  have "f s = s" using antisym fsA sA fss by auto
+  with sA show ?thesis by auto
+qed
+
+context semiattractive begin
+
+interpretation less_eq_notations.
+
+theorem complete_mono_imp_ex_extreme_qfp:
+  assumes comp: "UNIV-complete A (\<sqsubseteq>)" and f: "f ` A \<subseteq> A"
+    and mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
+  shows "\<exists>s. extreme {p \<in> A. f p \<sim> p} (\<sqsubseteq>) s"
+proof-
+  interpret dual: fixed_point_proof A "(\<sqsupseteq>)" rewrites "dual.sym = (\<sim>)"
+    using f by unfold_locales (auto intro!:ext)
+  show ?thesis
+    apply (rule dual.ex_extreme_qfp[OF complete_dual[OF comp] _ _ monotone_on_dual[OF mono]])
+    apply simp
+    using f sym_order_trans by blast
+qed
+
+end
+
+corollary (in antisymmetric) complete_mono_imp_ex_extreme_fp:
+  assumes comp: "UNIV-complete A (\<sqsubseteq>)" and f: "f ` A \<subseteq> A"
+    and mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
+  shows "\<exists>s. extreme {s \<in> A. f s = s} (\<sqsubseteq>)\<^sup>- s"
+proof-
+  interpret less_eq_notations.
+  interpret fixed_point_proof A "(\<sqsubseteq>)" f using f by unfold_locales
+  have "\<exists>c. extreme {q \<in> A. f q \<sim> q \<or> f q = q} (\<sqsupseteq>) c"
+    apply (rule ex_extreme_qfp_fp[OF comp _ _ mono])
+    using antisym f by (auto dest: order_sym_trans)
+  then obtain c where c: "extreme {q \<in> A. f q \<sim> q \<or> f q = q} (\<sqsupseteq>) c" by auto
+  then have "f c = c" using antisym f by blast
+  with c have "extreme {q \<in> A. f q = q} (\<sqsupseteq>) c" by auto
+  then show ?thesis by auto
+qed
+
+section \<open>Fixed Points in Well-Complete Antisymmetric Sets\<close>
+text \<open>\label{sec:well-complete}\<close>
+
+text \<open>In this section, we prove that an
+inflationary or monotone map over a well-complete antisymmetric set
+has a fixed point.
+
+In order to formalize such a theorem in Isabelle,
+we followed Grall's~\cite{grall10} elementary proof for Bourbaki--Witt and Markowsky's theorems.
+His idea is to consider well-founded derivation trees over $A$,
+where from a set $C \subseteq A$ of premises
+one can derive $f\:(\bigsqcup C)$ if $C$ is a chain.
+The main observation is as follows:
+Let $D$ be the set of all the derivable elements; that is,
+for each $d \in D$ there exists a well-founded derivation
+whose root is $d$.
+It is shown that $D$ is a chain,
+and hence one can build a derivation yielding $f\:(\bigsqcup D)$,
+and $f\:(\bigsqcup D)$ is shown to be a fixed point.\<close>
+
+lemma bound_monotone_on:
+  assumes mono: "monotone_on A r s f" and XA: "X \<subseteq> A" and aA: "a \<in> A" and rXa: "bound X r a"
+  shows "bound (f`X) s (f a)"
+proof (safe)
+  fix x assume xX: "x \<in> X" 
+  from rXa xX have "r x a" by auto
+  with xX XA mono aA show "s (f x) (f a)" by (auto elim!:monotone_onE)
+qed
+
+context fixed_point_proof begin
+
+text \<open>To avoid the usage of the axiom of choice, we carefully define derivations so that any derivable element
+determines its lower set. This led to the following definition:\<close>
+
+definition "derivation X \<equiv> X \<subseteq> A \<and> well_ordered_set X (\<sqsubseteq>) \<and>
+  (\<forall>x \<in> X. let Y = {y \<in> X. y \<sqsubset> x} in
+    (\<exists>y. extreme Y (\<sqsubseteq>) y \<and> x = f y) \<or>
+    f ` Y \<subseteq> Y \<and> extreme_bound A (\<sqsubseteq>) Y x)"
+
+lemma assumes "derivation P"
+  shows derivation_A: "P \<subseteq> A" and derivation_well_ordered: "well_ordered_set P (\<sqsubseteq>)"
+  using assms by (auto simp: derivation_def)
+
+lemma derivation_cases[consumes 2, case_names suc lim]:
+  assumes "derivation X" and "x \<in> X"
+    and "\<And>Y y. Y = {y \<in> X. y \<sqsubset> x} \<Longrightarrow> extreme Y (\<sqsubseteq>) y \<Longrightarrow> x = f y \<Longrightarrow> thesis"
+    and "\<And>Y. Y = {y \<in> X. y \<sqsubset> x} \<Longrightarrow> f ` Y \<subseteq> Y \<Longrightarrow> extreme_bound A (\<sqsubseteq>) Y x \<Longrightarrow> thesis"
+  shows thesis
+  using assms unfolding derivation_def Let_def by auto
+
+definition "derivable x \<equiv> \<exists>X. derivation X \<and> x \<in> X"
+
+lemma derivableI[intro?]: "derivation X \<Longrightarrow> x \<in> X \<Longrightarrow> derivable x" by (auto simp: derivable_def)
+lemma derivableE: "derivable x \<Longrightarrow> (\<And>P. derivation P \<Longrightarrow> x \<in> P \<Longrightarrow> thesis) \<Longrightarrow> thesis"
+  by (auto simp: derivable_def)
+
+lemma derivable_A: "derivable x \<Longrightarrow> x \<in> A" by (auto elim: derivableE dest:derivation_A)
+
+lemma UN_derivations_eq_derivable: "(\<Union>{P. derivation P}) = {x. derivable x}"
+  by (auto simp: derivable_def)
+
+context
+  assumes ord: "antisymmetric A (\<sqsubseteq>)"
+begin
+
+interpretation antisymmetric using ord.
+
+lemma derivation_lim:
+  assumes P: "derivation P" and fP: "f ` P \<subseteq> P" and Pp: "extreme_bound A (\<sqsubseteq>) P p"
+  shows "derivation (P \<union> {p})"
+proof (cases "p \<in> P")
+  case True
+  with P show ?thesis by (auto simp: insert_absorb)
+next
+  case pP: False
+  interpret P: well_ordered_set P "(\<sqsubseteq>)" using derivation_well_ordered[OF P].
+  have PA: "P \<subseteq> A" using derivation_A[OF P].
+  from Pp have pA: "p \<in> A" by auto
+  have bp: "bound P (\<sqsubseteq>) p" using Pp by auto
+  then have pp: "p \<sqsubseteq> p" using Pp by auto
+  have 1: "y \<in> P \<longrightarrow> {x. (x = p \<or> x \<in> P) \<and> x \<sqsubset> y} = {x \<in> P. x \<sqsubset> y}" for y
+    using Pp by (auto dest:extreme_bound_bound)
+  { fix x assume xP: "x \<in> P" and px: "p \<sqsubseteq> x"
+    from xP Pp have "x \<sqsubseteq> p" by auto
+    with px have "p = x" using xP PA pA by (auto intro!: antisym)
+    with xP pP
+    have "False" by auto
+  }
+  note 2 = this
+  then have 3: "{x. (x = p \<or> x \<in> P) \<and> x \<sqsubset> p} = P" using Pp by (auto intro!: asympartpI)
+  have wr: "well_ordered_set (P \<union> {p}) (\<sqsubseteq>)"
+    apply (rule well_order_extend[OF P.well_ordered_set_axioms])
+    using pp bp pP 2 by auto
+  from P fP Pp
+  show "derivation (P \<union> {p})" by (auto simp: derivation_def pA wr[simplified] 1 3)
+qed
+
+context
+  assumes derivation_infl: "\<forall>X x y. derivation X \<longrightarrow> x \<in> X \<longrightarrow> y \<in> X \<longrightarrow> x \<sqsubseteq> y \<longrightarrow> x \<sqsubseteq> f y"
+    and derivation_f_refl: "\<forall>X x. derivation X \<longrightarrow> x \<in> X \<longrightarrow> f x \<sqsubseteq> f x"
+begin
+
+lemma derivation_suc:
+  assumes P: "derivation P" and Pp: "extreme P (\<sqsubseteq>) p" shows "derivation (P \<union> {f p})"
+proof (cases "f p \<in> P")
+  case True
+  with P show ?thesis by (auto simp: insert_absorb)
+next
+  case fpP: False
+  interpret P: well_ordered_set P "(\<sqsubseteq>)" using derivation_well_ordered[OF P].
+  have PA: "P \<subseteq> A" using derivation_A[OF P].
+  with Pp have pP: "p \<in> P" and pA: "p \<in> A" by auto
+  with f have fpA: "f p \<in> A" by auto 
+  from pP have pp: "p \<sqsubseteq> p" by auto
+  from derivation_infl[rule_format, OF P pP pP pp] have "p \<sqsubseteq> f p".
+  { fix x assume xP: "x \<in> P"
+    then have xA: "x \<in> A" using PA by auto
+    have xp: "x \<sqsubseteq> p" using xP Pp by auto
+    from derivation_infl[rule_format, OF P xP pP this]
+    have "x \<sqsubseteq> f p".
+  }
+  note Pfp = this
+  then have bfp: "bound P (\<sqsubseteq>) (f p)" by auto
+  { fix y assume yP: "y \<in> P"
+    note yfp = Pfp[OF yP]
+    { assume fpy: "f p \<sqsubseteq> y"
+      with yfp have "f p = y" using yP PA pA fpA antisym by auto
+      with yP fpP have "False" by auto
+    }
+    with Pfp yP have "y \<sqsubset> f p" by auto
+  }
+  note Pfp = this
+  have 1: "\<And>y. y \<in> P \<longrightarrow> {x. (x = f p \<or> x \<in> P) \<and> x \<sqsubset> y} = {x \<in> P. x \<sqsubset> y}"
+   and 2: "{x. (x = f p \<or> x \<in> P) \<and> x \<sqsubset> f p} = P" using Pfp by auto
+  have wr: "well_ordered_set (P \<union> {f p}) (\<sqsubseteq>)"
+    apply (rule well_order_extend[OF P.well_ordered_set_axioms singleton_well_ordered])
+    using Pfp derivation_f_refl[rule_format, OF P pP] by auto
+  from P Pp
+  show "derivation (P \<union> {f p})" by (auto simp: derivation_def wr[simplified] 1 2 fpA)
+qed
+
+lemma derivable_closed:
+  assumes x: "derivable x" shows "derivable (f x)"
+proof (insert x, elim derivableE)
+  fix P
+  assume P: "derivation P" and xP: "x \<in> P"
+  note PA = derivation_A[OF P]
+  then have xA: "x \<in> A" using xP by auto
+  interpret P: well_ordered_set P "(\<sqsubseteq>)" using derivation_well_ordered[OF P].
+  interpret P.asympartp: transitive P "(\<sqsubset>)" using P.asympartp_transitive.
+  define Px where "Px \<equiv> {y. y \<in> P \<and> y \<sqsubset> x} \<union> {x}"
+  then have PxP: "Px \<subseteq> P" using xP by auto
+  have "x \<sqsubseteq> x" using xP by auto
+  then have Pxx: "extreme Px (\<sqsubseteq>) x" using xP PA by (auto simp: Px_def)
+  have wr: "well_ordered_set Px (\<sqsubseteq>)" using P.well_ordered_subset[OF PxP].
+  { fix z y assume zPx: "z \<in> Px" and yP: "y \<in> P" and yz: "y \<sqsubset> z"
+    then have zP: "z \<in> P" using PxP by auto
+    have "y \<sqsubset> x"
+    proof (cases "z = x")
+      case True
+      then show ?thesis using yz by auto
+    next
+      case False
+      then have zx: "z \<sqsubset> x" using zPx by (auto simp: Px_def)
+      from P.asympartp.trans[OF yz zx yP zP xP] show ?thesis.
+    qed
+  }
+  then have 1: "\<And>z. z \<in> Px \<longrightarrow> {y \<in> Px. y \<sqsubset> z} = {y \<in> P. y \<sqsubset> z}" using Px_def by blast
+  have Px: "derivation Px" using PxP PA P by (auto simp: wr derivation_def 1)
+  from derivation_suc[OF Px Pxx]
+  show ?thesis by (auto intro!: derivableI)
+qed
+
+text \<open>The following lemma is derived from Grall’s proof. We simplify the claim so that we
+consider two elements from one derivation, instead of two derivations.\<close>
+
+lemma derivation_useful:
+  assumes X: "derivation X" and xX: "x \<in> X" and yX: "y \<in> X" and xy: "x \<sqsubset> y"
+  shows "f x \<sqsubseteq> y"
+proof-
+  interpret X: well_ordered_set X "(\<sqsubseteq>)" using derivation_well_ordered[OF X].
+  note XA = derivation_A[OF X]
+  { fix x y assume xX: "x \<in> X" and yX: "y \<in> X"
+    from xX yX have "(x \<sqsubset> y \<longrightarrow> f x \<sqsubseteq> y \<and> f x \<in> X) \<and> (y \<sqsubset> x \<longrightarrow> f y \<sqsubseteq> x \<and> f y \<in> X)"
+    proof (induct x arbitrary: y)
+      case (less x)
+      note xX = \<open>x \<in> X\<close> and IHx = this(2)
+      with XA have xA: "x \<in> A" by auto
+      from \<open>y \<in> X\<close> show ?case
+      proof (induct y)
+        case (less y)
+        note yX = \<open>y \<in> X\<close> and IHy = this(2)
+        with XA have yA: "y \<in> A" by auto
+        show ?case
+        proof (rule conjI; intro impI)
+          assume xy: "x \<sqsubset> y"
+          from X yX
+          show "f x \<sqsubseteq> y \<and> f x \<in> X"
+          proof (cases rule:derivation_cases)
+            case (suc Z z)
+            with XA have zX: "z \<in> X" and zA: "z \<in> A" and zy: "z \<sqsubset> y" and yfz: "y = f z" by auto
+            from xX zX show ?thesis
+            proof (cases rule: X.comparable_three_cases)
+              case xz: less
+              with IHy[OF zX zy] have fxz: "f x \<sqsubseteq> z" and fxX: "f x \<in> X" by auto
+              from derivation_infl[rule_format, OF X fxX zX fxz] have "f x \<sqsubseteq> y" by (auto simp: yfz)
+              with fxX show ?thesis by auto
+            next
+              case eq
+              with xX zX have "x = z" by auto
+              with yX yfz show ?thesis by auto
+            next
+              case zx: greater
+              with IHy[OF zX zy] yfz xy have False by auto
+              then show ?thesis by auto
+            qed
+          next
+            case (lim Z)
+            note Z = \<open>Z = {z \<in> X. z \<sqsubset> y}\<close> and fZ = \<open>f ` Z \<subseteq> Z\<close>
+            from xX xy have "x \<in> Z" by (auto simp: Z)
+            with fZ have "f x \<in> Z" by auto
+            then have "f x \<sqsubset> y" and "f x \<in> X" by (auto simp: Z)
+            then show ?thesis by auto
+          qed
+        next
+          assume yx: "y \<sqsubset> x"
+          from X xX
+          show "f y \<sqsubseteq> x \<and> f y \<in> X"
+          proof (cases rule:derivation_cases)
+            case (suc Z z)
+            with XA have zX: "z \<in> X" and zA: "z \<in> A" and zx: "z \<sqsubset> x" and xfz: "x = f z" by auto
+            from yX zX show ?thesis
+            proof (cases rule: X.comparable_three_cases)
+              case yz: less
+              with IHx[OF zX zx yX] have fyz: "f y \<sqsubseteq> z" and fyX: "f y \<in> X" by auto
+              from derivation_infl[rule_format, OF X fyX zX fyz] have "f y \<sqsubseteq> x" by (auto simp: xfz)
+              with fyX show ?thesis by auto
+            next
+              case eq
+              with yX zX have "y = z" by auto
+              with xX xfz show ?thesis by auto
+            next
+              case greater
+              with IHx[OF zX zx yX] xfz yx have False by auto
+              then show ?thesis by auto
+            qed
+          next
+            case (lim Z)
+            note Z = \<open>Z = {z \<in> X. z \<sqsubset> x}\<close> and fZ = \<open>f ` Z \<subseteq> Z\<close>
+            from yX yx have "y \<in> Z" by (auto simp: Z)
+            with fZ have "f y \<in> Z" by auto
+            then have "f y \<sqsubset> x" and "f y \<in> X" by (auto simp: Z)
+            then show ?thesis by auto
+          qed
         qed
-        have DC: "D \<subseteq> C" unfolding D_def by auto
-        fix B b assume BD: "B \<subseteq> D" and BS: "extreme_bound_in (\<sqsubseteq>) S B b"
-        have "B \<subseteq> C" using DC BD by auto
-        then have bC: "b \<in> C" using C_AA BS by (auto simp: AA_def)
-        have bfc: "\<forall>a\<in>B. a \<sqsubseteq> f c" using BD unfolding D_def by auto
-        with f_closed_S cS BS
-        have "b \<sqsubseteq> f c" by (auto simp: extreme_def image_subset_iff)
-        with bC show "b \<in> D" unfolding D_def by auto
       qed
-      then have "C \<subseteq> D" unfolding C_def by auto
-      then show "c \<sqsubseteq> f c" using cCS unfolding D_def by auto
+    qed
+  }
+  with assms show "f x \<sqsubseteq> y" by auto
+qed
+
+text \<open>Next one is the main lemma of this section, stating that elements from two possibly different 
+derivations are comparable, and moreover the lower one is in the derivation of the upper one. 
+The latter claim, not found in Grall’s proof, is crucial in proving that the union of all 
+derivations is well-related.\<close>
+
+lemma derivations_cross_compare:
+  assumes X: "derivation X" and Y: "derivation Y" and xX: "x \<in> X" and yY: "y \<in> Y"
+  shows "(x \<sqsubset> y \<and> x \<in> Y) \<or> x = y \<or> (y \<sqsubset> x \<and> y \<in> X)" 
+proof-
+  { fix X Y x y
+    assume X: "derivation X" and Y: "derivation Y" and xX: "x \<in> X" and yY: "y \<in> Y"
+    interpret X: well_ordered_set X "(\<sqsubseteq>)" using derivation_well_ordered[OF X].
+    interpret X.asympartp: transitive X "(\<sqsubset>)" using X.asympartp_transitive.
+    interpret Y: well_ordered_set Y "(\<sqsubseteq>)" using derivation_well_ordered[OF Y].
+    have XA: "X \<subseteq> A" using derivation_A[OF X].
+    then have xA: "x \<in> A" using xX by auto
+    with f have fxA: "f x \<in> A" by auto
+    have YA: "Y \<subseteq> A" using derivation_A[OF Y].
+    then have yA: "y \<in> A" using yY by auto
+    with f have fyA: "f y \<in> A" by auto
+    { fix Z
+      assume Z: "Z = {z \<in> X. z \<sqsubset> x}"
+        and fZ: "f ` Z \<subseteq> Z"
+        and Zx: "extreme_bound A (\<sqsubseteq>) Z x"
+        and IHx: "\<forall>z \<in> X. z \<sqsubset> x \<longrightarrow> (z \<sqsubset> y \<and> z \<in> Y) \<or> z = y \<or> (y \<sqsubset> z \<and> y \<in> X)"
+      have "(y \<sqsubset> x \<and> y \<in> X) \<or> x \<sqsubseteq> y"
+      proof (cases "\<exists>z \<in> Z. y \<sqsubset> z")
+        case True
+        then obtain z where zZ: "z \<in> Z" and yz: "y \<sqsubset> z" by auto
+        from zZ Z have zX: "z \<in> X" and zx: "z \<sqsubset> x" by auto
+        from IHx[rule_format, OF zX zx] yz have yX: "y \<in> X" by auto
+        from X.asympartp.trans[OF yz zx yX zX xX] have "y \<sqsubset> x".
+        with yX show ?thesis by auto
+      next
+        case False
+        have "bound Z (\<sqsubseteq>) y"
+        proof
+          fix z assume "z \<in> Z"
+          then have zX: "z \<in> X" and zx: "z \<sqsubset> x" and nyz: "\<not> y \<sqsubset> z" using Z False by auto
+          with IHx[rule_format, OF zX zx] X show "z \<sqsubseteq> y" by auto
+        qed
+        with yA Zx have xy: "x \<sqsubseteq> y" by auto
+        then show ?thesis by auto
+      qed
+    }
+    note lim_any = this
+    { fix z Z
+      assume Z: "Z = {z \<in> X. z \<sqsubset> x}"
+        and Zz: "extreme Z (\<sqsubseteq>) z"
+        and xfz: "x = f z"
+        and IHx: "(z \<sqsubset> y \<and> z \<in> Y) \<or> z = y \<or> (y \<sqsubset> z \<and> y \<in> X)"
+      have zX: "z \<in> X" and zx: "z \<sqsubset> x" using Zz Z by (auto simp: extreme_def)
+      then have zA: "z \<in> A" using XA by auto
+      from IHx have "(y \<sqsubset> x \<and> y \<in> X) \<or> x \<sqsubseteq> y"
+      proof (elim disjE conjE)
+        assume zy: "z \<sqsubset> y" and zY: "z \<in> Y"
+        from derivation_useful[OF Y zY yY zy] xfz have xy: "x \<sqsubseteq> y" by auto
+        then show ?thesis by auto
+      next
+        assume zy: "z = y"
+        then have "y \<sqsubset> x" using zx by auto
+        with zy zX show ?thesis by auto
+      next
+        assume yz: "y \<sqsubset> z" and yX: "y \<in> X"
+        from X.asympartp.trans[OF yz zx yX zX xX] have "y \<sqsubset> x".
+        with yX show ?thesis by auto
+      qed
+    }
+    note lim_any this
+  }
+  note lim_any = this(1) and suc_any = this(2)
+  interpret X: well_ordered_set X "(\<sqsubseteq>)" using derivation_well_ordered[OF X].
+  interpret Y: well_ordered_set Y "(\<sqsubseteq>)" using derivation_well_ordered[OF Y].
+  have XA: "X \<subseteq> A" using derivation_A[OF X].
+  have YA: "Y \<subseteq> A" using derivation_A[OF Y].
+  from xX yY show ?thesis
+  proof (induct x arbitrary: y)
+    case (less x)
+    note xX = \<open>x \<in> X\<close> and IHx = this(2)
+    from xX XA f have xA: "x \<in> A" and fxA: "f x \<in> A" by auto
+    from \<open>y \<in> Y\<close>
+    show ?case
+    proof (induct y)
+      case (less y)
+      note yY = \<open>y \<in> Y\<close> and IHy = less(2)
+      from yY YA f have yA: "y \<in> A" and fyA: "f y \<in> A" by auto
+      from X xX show ?case
+      proof (cases rule: derivation_cases)
+        case (suc Z z)
+        note Z = \<open>Z = {z \<in> X. z \<sqsubset> x}\<close> and Zz = \<open>extreme Z (\<sqsubseteq>) z\<close> and xfz = \<open>x = f z\<close>
+        then have zx: "z \<sqsubset> x" and zX: "z \<in> X" by auto
+        note IHz = IHx[OF zX zx yY]
+        have 1: "y \<sqsubset> x \<and> y \<in> X \<or> x \<sqsubseteq> y" using suc_any[OF X Y xX yY Z Zz xfz IHz] IHy by auto
+        from Y yY show ?thesis
+        proof (cases rule: derivation_cases)
+          case (suc W w)
+          note W = \<open>W = {w \<in> Y. w \<sqsubset> y}\<close> and Ww = \<open>extreme W (\<sqsubseteq>) w\<close> and yfw = \<open>y = f w\<close> 
+          then have wY: "w \<in> Y" and wy: "w \<sqsubset> y" by auto
+          have IHw: "w \<sqsubset> x \<and> w \<in> X \<or> w = x  \<or> x \<sqsubset> w \<and> x \<in> Y" using IHy[OF wY wy] by auto
+          have "x \<sqsubset> y \<and> x \<in> Y \<or> y \<sqsubseteq> x" using suc_any[OF Y X yY xX W Ww yfw IHw] by auto
+          with 1 show ?thesis using antisym xA yA by auto
+        next
+          case (lim W)
+          note W = \<open>W = {w \<in> Y. w \<sqsubset> y}\<close> and fW = \<open>f ` W \<subseteq> W\<close> and Wy = \<open>extreme_bound A (\<sqsubseteq>) W y\<close>
+          have "x \<sqsubset> y \<and> x \<in> Y \<or> y \<sqsubseteq> x" using lim_any[OF Y X yY xX W fW Wy] IHy by auto
+          with 1 show ?thesis using antisym xA yA by auto
+        qed
+      next
+        case (lim Z)
+        note Z = \<open>Z = {z \<in> X. z \<sqsubset> x}\<close> and fZ = \<open>f ` Z \<subseteq> Z\<close> and Zx = \<open>extreme_bound A (\<sqsubseteq>) Z x\<close>
+        have 1: "y \<sqsubset> x \<and> y \<in> X \<or> x \<sqsubseteq> y" using lim_any[OF X Y xX yY Z fZ Zx] IHx[OF _ _ yY] by auto
+        from Y yY show ?thesis
+        proof (cases rule: derivation_cases)
+          case (suc W w)
+          note W = \<open>W = {w \<in> Y. w \<sqsubset> y}\<close> and Ww = \<open>extreme W (\<sqsubseteq>) w\<close> and yfw = \<open>y = f w\<close>
+          then have wY: "w \<in> Y" and wy: "w \<sqsubset> y" by auto
+          have IHw: "w \<sqsubset> x \<and> w \<in> X \<or>  w = x  \<or>  x \<sqsubset> w \<and> x \<in> Y" using IHy[OF wY wy] by auto
+          have "x \<sqsubset> y \<and> x \<in> Y \<or> y \<sqsubseteq> x" using suc_any[OF Y X yY xX W Ww yfw IHw] by auto
+          with 1 show ?thesis using antisym xA yA by auto
+        next
+          case (lim W)
+          note W = \<open>W = {w \<in> Y. w \<sqsubset> y}\<close> and fW = \<open>f ` W \<subseteq> W\<close> and Wy = \<open>extreme_bound A (\<sqsubseteq>) W y\<close>
+          have "x \<sqsubset> y \<and> x \<in> Y \<or> y \<sqsubseteq> x" using lim_any[OF Y X yY xX W fW Wy] IHy by auto
+          with 1 show ?thesis using antisym xA yA by auto
+        qed
+      qed
     qed
   qed
 qed
 
-lemma quasi_fixed_point: "\<exists>s \<in> S. f s \<sim> s" using quasi_fixed_point_in_C S_AA C_def by auto
+interpretation derivable: well_ordered_set "{x. derivable x}" "(\<sqsubseteq>)"
+proof (rule well_ordered_set.intro)
+  show "antisymmetric {x. derivable x} (\<sqsubseteq>)"
+    apply unfold_locales by (auto dest: derivable_A antisym)
+  show "well_related_set {x. derivable x} (\<sqsubseteq>)"
+  apply (fold UN_derivations_eq_derivable)
+  apply (rule closed_UN_well_related)
+  by (auto dest: derivation_well_ordered derivations_cross_compare well_ordered_set.axioms)
+qed
 
-lemma ex_extreme_quasi_fixed_point:
-  assumes attract: "\<forall>q x. f q \<sim> q \<longrightarrow> x \<sqsubseteq> f q \<longrightarrow> x \<sqsubseteq> q"
-  shows "Ex (extreme (\<sqsupseteq>) {q \<in> S. f q \<sim> q})"
+lemmas derivable_well_ordered = derivable.well_ordered_set_axioms
+lemmas derivable_total_ordered = derivable.total_ordered_set_axioms
+lemmas derivable_well_related = derivable.well_related_set_axioms
+
+lemma pred_unique:
+  assumes X: "derivation X" and xX: "x \<in> X"
+  shows "{z \<in> X. z \<sqsubset> x} = {z. derivable z \<and> z \<sqsubset> x}"
+proof
+  { fix z assume "z \<in> X" and "z \<sqsubset> x"
+    then have "derivable z \<and> z \<sqsubset> x" using X by (auto simp: derivable_def)
+  }
+  then show "{z \<in> X. z \<sqsubset> x} \<subseteq> {z. derivable z \<and> z \<sqsubset> x}" by auto
+  { fix z assume "derivable z" and zx: "z \<sqsubset> x"
+    then obtain Y where Y: "derivation Y" and zY: "z \<in> Y" by (auto simp: derivable_def)
+    then have "z \<in> X" using derivations_cross_compare[OF X Y xX zY] zx by auto
+  }
+  then show "{z \<in> X. z \<sqsubset> x} \<supseteq> {z. derivable z \<and> z \<sqsubset> x}" by auto
+qed
+
+text \<open>The set of all derivable elements is itself a derivation.\<close>
+
+lemma derivation_derivable: "derivation {x. derivable x}"
+  apply (unfold derivation_def)
+  apply (safe intro!: derivable_A derivable.well_ordered_set_axioms elim!: derivableE)
+  apply (unfold mem_Collect_eq pred_unique[symmetric])
+  by (auto simp: derivation_def)
+
+text \<open>Finally, if the set of all derivable elements admits a supremum, then it is a fixed point.\<close>
+
+lemma
+  assumes p: "extreme_bound A (\<sqsubseteq>) {x. derivable x} p"
+  shows sup_derivable_qfp: "f p \<sim> p" and sup_derivable_fp: "f p = p"
+proof (intro antisym sympartpI)
+  define P where "P \<equiv> {x. derivable x}"
+  have pA: "p \<in> A" using p by auto
+  have P: "derivation P" using derivation_derivable by (simp add: P_def)
+  from derivable_closed have fP: "f ` P \<subseteq> P" by (auto simp: P_def)
+  from derivation_lim[OF P fP] p
+  have pP: "p \<in> P" by (auto simp: P_def intro:derivableI)
+  with fP have "f p \<in> P" by auto
+  with p show fpp: "f p \<sqsubseteq> p" by (auto simp: P_def)
+  show pfp: "p \<sqsubseteq> f p" apply (rule derivation_infl[rule_format, OF P]) using pP by (auto simp: P_def)
+  from fpp pfp p f show "f p = p" by (auto intro!: antisym)
+qed
+
+end
+
+text "The assumptions are satisfied by monotone functions."
+
+context
+  assumes mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
+begin
+
+lemma mono_imp_derivation_infl:
+  "\<forall>X x y. derivation X \<longrightarrow> x \<in> X \<longrightarrow> y \<in> X \<longrightarrow> x \<sqsubseteq> y \<longrightarrow> x \<sqsubseteq> f y"
+proof (intro allI impI)
+  fix X x y
+  assume X: "derivation X" and xX: "x \<in> X" and yX: "y \<in> X" and xy: "x \<sqsubseteq> y"
+  interpret X: well_ordered_set X "(\<sqsubseteq>)" using derivation_well_ordered[OF X].
+  note XA = derivation_A[OF X]
+  from xX yX xy show "x \<sqsubseteq> f y"
+  proof (induct x)
+    case (less x)
+    note IH = this(2) and xX = \<open>x \<in> X\<close> and yX = \<open>y \<in> X\<close> and xy = \<open>x \<sqsubseteq> y\<close>
+    from xX yX XA have xA: "x \<in> A" and yA: "y \<in> A" by auto
+    from X xX show ?case
+    proof (cases rule: derivation_cases)
+      case (suc Z z)
+      then have zX: "z \<in> X" and zsx: "z \<sqsubset> x" and xfz: "x = f z" by auto
+      then have zx: "z \<sqsubseteq> x" by auto
+      from X.trans[OF zx xy zX xX yX] have zy: "z \<sqsubseteq> y".
+      from zX XA have zA: "z \<in> A" by auto
+      from zy monotone_onD[OF mono] zA yA xfz show "x \<sqsubseteq> f y" by auto
+    next
+      case (lim Z)
+      note Z = \<open>Z = {z \<in> X. z \<sqsubset> x}\<close> and Zx = \<open>extreme_bound A (\<sqsubseteq>) Z x\<close>
+      from f yA have fyA: "f y \<in> A" by auto
+      have "bound Z (\<sqsubseteq>) (f y)"
+      proof
+        fix z assume zZ: "z \<in> Z"
+        with Z xX have zsx: "z \<sqsubset> x" and zX: "z \<in> X" by auto
+        then have zx: "z \<sqsubseteq> x" by auto
+        from X.trans[OF zx xy zX xX yX] have zy: "z \<sqsubseteq> y".
+        from IH[OF zX zsx yX] zy show "z \<sqsubseteq> f y" by auto
+      qed
+      with Zx fyA show ?thesis by auto
+    qed
+  qed
+qed
+
+lemma mono_imp_derivation_f_refl:
+  "\<forall>X x. derivation X \<longrightarrow> x \<in> X \<longrightarrow> f x \<sqsubseteq> f x"
+proof (intro allI impI)
+  fix X x
+  assume X: "derivation X" and xX: "x \<in> X"
+  interpret X: well_ordered_set X "(\<sqsubseteq>)" using derivation_well_ordered[OF X].
+  note XA = derivation_A[OF X]
+  from xX have "x \<sqsubseteq> x" by auto
+  from monotone_onD[OF mono this] xX XA show "f x \<sqsubseteq> f x" by auto
+qed
+
+corollary mono_imp_sup_derivable_fp:
+  assumes p: "extreme_bound A (\<sqsubseteq>) {x. derivable x} p"
+  shows "f p = p"
+  by (simp add: sup_derivable_fp[OF mono_imp_derivation_infl mono_imp_derivation_f_refl p])
+
+lemma mono_imp_sup_derivable_lfp:
+  assumes p: "extreme_bound A (\<sqsubseteq>) {x. derivable x} p"
+  shows "extreme {q \<in> A. f q = q} (\<sqsupseteq>) p"
+proof (safe intro!: extremeI)
+  from p show "p \<in> A" by auto
+  from sup_derivable_fp[OF mono_imp_derivation_infl mono_imp_derivation_f_refl p]
+  show "f p = p".
+  fix q assume qA: "q \<in> A" and fqq: "f q = q"
+  have "bound {x. derivable x} (\<sqsubseteq>) q"
+  proof (safe intro!: boundI elim!:derivableE)
+    fix x X
+    assume X: "derivation X" and xX: "x \<in> X"
+    from X interpret well_ordered_set X "(\<sqsubseteq>)" by (rule derivation_well_ordered)
+    from xX show "x \<sqsubseteq> q"
+    proof (induct x)
+      case (less x)
+      note xP = this(1) and IH = this(2)
+      with X show ?case
+      proof (cases rule: derivation_cases)
+        case (suc Z z)
+        with IH[of z] have zq: "z \<sqsubseteq> q" and zX: "z \<in> X" by auto
+        from monotone_onD[OF mono zq] zX qA derivation_A[OF X]
+        show ?thesis by (auto simp: fqq suc)
+      next
+        case lim
+        with IH have "bound {z \<in> X. z \<sqsubset> x} (\<sqsubseteq>) q" by auto
+        with lim qA show ?thesis by auto
+      qed
+    qed
+  qed
+  with p qA show "p \<sqsubseteq> q" by auto
+qed
+
+lemma mono_imp_ex_least_fp:
+  assumes comp: "well_complete A (\<sqsubseteq>)"
+  shows "\<exists>p. extreme {q \<in> A. f q = q} (\<sqsupseteq>) p"
 proof-
-  define A where "A \<equiv> {a \<in> S. \<forall>s \<in> S. f s \<sim> s \<longrightarrow> a \<sqsubseteq> s}"
-  have "A \<in> AA" 
-  proof (unfold AA_def, intro CollectI conjI allI impI)
-    show AS: "A \<subseteq> S" unfolding A_def by auto  
-    { fix x assume xA: "x \<in> A"
-      have "f x \<in> A"
-      proof (unfold A_def, intro CollectI conjI)
-        have "x \<in> S" using xA unfolding A_def by auto 
-        then show "f x \<in> S" using f_closed_S by auto
-        { fix s assume sS: "s \<in> S" and sf: "f s \<sim> s"
-          then have "x \<sqsubseteq> s" using xA sS sf A_def by auto
-          then have "f x \<sqsubseteq> s" using attract mono  
-            unfolding A_def by (meson monotoneD sf)
-        }
-        then show "\<forall>s\<in>S. f s \<sim> s \<longrightarrow> f x \<sqsubseteq> s" by auto
-      qed 
-    }
-    then show "f ` A \<subseteq> A" by auto
-    fix B b assume BA: "B \<subseteq> A" and b: "extreme_bound_in (\<sqsubseteq>) S B b"
-    then have "B \<subseteq> S" unfolding A_def using BA AS by auto
-    with BA b have bS: "b \<in> S" by auto
-    { fix s assume sS: "s \<in> S" and sf: "f s \<sim> s"
-      have "bound (\<sqsubseteq>) B s"  using sS BA b A_def sf by auto
-    }
-    with b have "\<forall>s\<in>S. f s \<sim> s \<longrightarrow> b \<sqsubseteq> s" by auto
-    then show "b \<in> A" using bS by (auto simp: A_def)
-  qed
-  then have "C \<subseteq> A" by (simp add: C_def Inf_lower)
-  then have "\<exists>a \<in> A. f a \<sim> a" 
-    using quasi_fixed_point_in_C by auto
-  then obtain a where aA: "a \<in> A" and faa: "f a \<sim> a" by auto
-  with aA A_def have "extreme (\<sqsupseteq>) {q \<in> S. f q \<sim> q} a" by (auto simp: extreme_def)
-  then show ?thesis by auto
+  interpret fixed_point_proof using f by unfold_locales
+  note as = antisymmetric_axioms
+  note infl = mono_imp_derivation_infl
+  note refl = mono_imp_derivation_f_refl
+  have wr: "well_related_set {x. derivable x} (\<sqsubseteq>)"
+    using derivable_well_related[OF infl refl].
+  have "\<exists>p. extreme_bound A (\<sqsubseteq>) {x. derivable x} p"
+    apply (rule completeD[OF comp])
+    using derivable_A wr by auto
+  then obtain p where p: "extreme_bound A (\<sqsubseteq>) {x. derivable x} p" by auto
+  from p mono_imp_sup_derivable_lfp[OF p] sup_derivable_qfp[OF infl refl p]
+  show ?thesis by auto
 qed
 
 end
 
 end
 
-
-context complete begin
-
-lemma complete_in_UNIV[intro!]: "complete_in (\<sqsubseteq>) UNIV"
-  unfolding complete_in_def using complete by auto
-
-interpretation fixed_point_proof.
+end
 
-theorem monotone_imp_ex_quasi_fixed_point:
-  assumes mono: "monotone (\<sqsubseteq>) (\<sqsubseteq>) f"
-  shows "\<exists>s. f s \<sim> s"
+text \<open>Bourbaki-Witt Theorem on well-complete pseudo-ordered set:\<close>
+theorem (in pseudo_ordered_set) well_complete_infl_imp_ex_fp:
+  assumes comp: "well_complete A (\<sqsubseteq>)"
+    and f: "f ` A \<subseteq> A" and infl: "\<forall>x \<in> A. \<forall>y \<in> A. x \<sqsubseteq> y \<longrightarrow> x \<sqsubseteq> f y"
+  shows "\<exists>p \<in> A. f p = p"
 proof-
-  have Ucl: "f ` UNIV \<subseteq> UNIV" by auto
-  obtain s where sC: "s \<in> C f UNIV" and fss: "f s \<sim> s" 
-    using quasi_fixed_point_in_C[OF mono Ucl complete_in_UNIV] by auto
-  show "\<exists>s. f s \<sim> s" using fss by auto
+  note as = antisymmetric_axioms
+  interpret fixed_point_proof using f by unfold_locales
+  have dinfl: "\<forall>X x y. derivation X \<longrightarrow> x \<in> X \<longrightarrow> y \<in> X \<longrightarrow> x \<sqsubseteq> y \<longrightarrow> x \<sqsubseteq> f y"
+    using infl by (auto dest!:derivation_A)
+  have drefl: "\<forall>X x. derivation X \<longrightarrow> x \<in> X \<longrightarrow> f x \<sqsubseteq> f x" using f by (auto dest!: derivation_A)
+  have "\<exists>p. extreme_bound A (\<sqsubseteq>) {x. derivable x} p"
+    apply (rule completeD[OF comp])
+    using derivable_well_related[OF as dinfl drefl] derivable_A by auto
+  with sup_derivable_fp[OF as dinfl drefl]
+  show ?thesis by auto
 qed
 
-end
-
-context complete_antisymmetric begin
-
-corollary monotone_imp_ex_fixed_point:
-  assumes mono: "monotone (\<sqsubseteq>) (\<sqsubseteq>) f"
-  shows "\<exists>s. f s = s"
-  using monotone_imp_ex_quasi_fixed_point[OF mono] by auto
 
-end
-
-subsection \<open>Completeness of Quasi-Fixed Points\<close>
-text \<open>\label{sec:qfp-complete}\<close>
+section \<open>Completeness of (Quasi-)Fixed Points\<close>
 
-text \<open>We now show that fixed points are complete in a complete trellis,
-which strengthens the existing result by Stouti and Maaden who showed the existence of
-the least fixed point. Below we derive an even more general result by dropping reflexivity.\<close>
+text \<open>We now prove that, under attractivity, the set of quasi-fixed points is complete.\<close>
 
-text \<open>We first prove that, under attractivity, the set of quasi-fixed points is complete.\<close>
+definition setwise where "setwise r X Y \<equiv> \<forall>x\<in>X. \<forall>y\<in>Y. r x y"
+
+lemmas setwiseI[intro] = setwise_def[unfolded atomize_eq, THEN iffD2, rule_format]
+lemmas setwiseE[elim] = setwise_def[unfolded atomize_eq, THEN iffD1, elim_format, rule_format]
 
 context fixed_point_proof begin
 
-lemma attract_imp_qfp_complete:
-  assumes comp: "complete (\<sqsubseteq>)"
-  assumes mono: "monotone (\<sqsubseteq>) (\<sqsubseteq>) f"
-  assumes attract: "\<forall>q x. f q \<sim> q \<longrightarrow> x \<sqsubseteq> f q \<longrightarrow> x \<sqsubseteq> q"
-  assumes dual_attract: "\<forall>q x. f q \<sim> q \<longrightarrow> f q \<sqsubseteq> x \<longrightarrow> q \<sqsubseteq> x"
-  shows "complete_in (\<sqsubseteq>) {s. f s \<sim> s}"
-proof (intro complete_inI)
-  interpret complete using comp.
-  fix A assume Afix: "A \<subseteq> {s. f s \<sim> s}"
-  define S where "S \<equiv> {s. \<forall>a \<in> A. a \<sqsubseteq> s}"
-  { fix s a assume as: "\<forall>a \<in> A. a \<sqsubseteq> s" and aA: "a \<in> A"
+abbreviation setwise_less_eq (infix "\<sqsubseteq>\<^sup>s" 50) where "(\<sqsubseteq>\<^sup>s) \<equiv> setwise (\<sqsubseteq>)"
+
+subsection \<open>Least Quasi-Fixed Points for Attractive Relations.\<close>
+
+lemma attract_mono_imp_least_qfp:
+  assumes attract: "attractive A (\<sqsubseteq>)"
+    and comp: "well_complete A (\<sqsubseteq>)"
+    and mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
+  shows "\<exists>c. extreme {p \<in> A. f p \<sim> p \<or> f p = p} (\<sqsupseteq>) c \<and> f c \<sim> c"
+proof-
+  interpret attractive using attract by auto
+  interpret sym: transitive A "(\<sim>)" using sym_transitive.
+  define ecl ("[_]\<^sub>\<sim>") where "[x]\<^sub>\<sim> \<equiv> {y \<in> A. x \<sim> y} \<union> {x}" for x
+  define Q where "Q \<equiv> {[x]\<^sub>\<sim> |. x \<in> A}"
+  { fix X x assume XQ: "X \<in> Q" and xX: "x \<in> X"
+    then have XA: "X \<subseteq> A" by (auto simp: Q_def ecl_def)
+    then have xA: "x \<in> A" using xX by auto
+    obtain q where qA: "q \<in> A" and X: "X = [q]\<^sub>\<sim>" using XQ by (auto simp: Q_def)
+    have xqqx: "x \<sim> q \<or> x = q" using X xX by (auto simp: ecl_def)
+    {fix y assume yX: "y \<in> X"
+      then have yA: "y \<in> A" using XA by auto
+      have "y \<sim> q \<or> y = q" using yX X by (auto simp: ecl_def)
+      then have "x \<sim> y \<or> y = x" using sym_order_trans xqqx xA qA yA by blast
+    }
+    then have 1: "X \<subseteq> [x]\<^sub>\<sim>" using X qA by (auto simp: ecl_def)
+    { fix y assume "y \<in> A" and "x \<sim> y \<or> y = x"
+      then have "q \<sim> y \<or> y = q" using sym_order_trans xqqx xA qA by blast
+    }
+    then have 2: "X \<supseteq> [x]\<^sub>\<sim>" using X xX by (auto simp: ecl_def)
+    from 1 2 have "X = [x]\<^sub>\<sim>" by auto
+  }
+  then have XQx: "\<forall>X \<in> Q. \<forall>x \<in> X. X = [x]\<^sub>\<sim>" by auto
+  have RSLE_eq: "X \<in> Q \<Longrightarrow> Y \<in> Q \<Longrightarrow> x \<in> X \<Longrightarrow> y \<in> Y \<Longrightarrow> x \<sqsubseteq> y \<Longrightarrow> X \<sqsubseteq>\<^sup>s Y" for X Y x y
+  proof-
+    assume XQ: "X \<in> Q" and YQ: "Y \<in> Q" and xX: "x \<in> X" and yY: "y \<in> Y" and xy: "x \<sqsubseteq> y"
+    then have XA: "X \<subseteq> A" and YA: "Y \<subseteq> A" by (auto simp: Q_def ecl_def)
+    then have xA: "x \<in> A" and yA: "y \<in> A" using xX yY by auto
+    { fix xp yp assume xpX: "xp \<in> X" and ypY: "yp \<in> Y"
+      then have xpA: "xp \<in> A" and ypA: "yp \<in> A" using XA YA by auto
+      then have "xp \<sim> x \<or> xp = x" using xpX XQx xX XQ by (auto simp: ecl_def)
+      then have xpy: "xp \<sqsubseteq> y" using attract[OF _ _ xy xpA xA yA] xy by blast
+      have "yp \<sim> y \<or> yp = y" using ypY XQx yY YQ by (auto simp: ecl_def)
+      then have "xp \<sqsubseteq> yp" using dual.attract[OF _ _ xpy ypA yA xpA] xpy by blast
+    }
+    then show "X \<sqsubseteq>\<^sup>s Y" using XQ YQ XA YA by auto
+  qed
+  have compQ: "well_complete Q (\<sqsubseteq>\<^sup>s)"
+  proof (intro completeI, safe)
+    fix XX assume XXQ: "XX \<subseteq> Q" and XX: "well_related_set XX (\<sqsubseteq>\<^sup>s)"
+    have BA: "\<Union>XX \<subseteq> A" using XXQ by (auto simp: Q_def ecl_def)
+    from XX interpret XX: well_related_set XX "(\<sqsubseteq>\<^sup>s)".
+    interpret UXX: semiattractive "\<Union>XX" "(\<sqsubseteq>)" by (rule semiattractive_subset[OF BA])
+    have "well_related_set (\<Union>XX) (\<sqsubseteq>)"
+    proof(unfold_locales)
+      fix Y assume YXX: "Y \<subseteq> \<Union>XX" and Y0: "Y \<noteq> {}"
+      have "{X \<in> XX. X \<inter> Y \<noteq> {}} \<noteq> {}" using YXX Y0 by auto
+      from XX.nonempty_imp_ex_extreme[OF _ this]
+      obtain E where E: "extreme {X \<in> XX. X \<inter> Y \<noteq> {}} (\<sqsubseteq>\<^sup>s)\<^sup>- E" by auto
+      then have "E \<inter> Y \<noteq> {}" by auto
+      then obtain e where eE: "e \<in> E" and eX: "e \<in> Y" by auto
+      have "extreme Y (\<sqsupseteq>) e"
+      proof (intro extremeI eX)
+        fix x assume xY: "x \<in> Y"
+        with YXX obtain X where XXX: "X \<in> XX" and xX: "x \<in> X" by auto
+        with xY E XXX have "E \<sqsubseteq>\<^sup>s X" by auto
+        with eE xX show "e \<sqsubseteq> x" by auto
+      qed
+      then show "\<exists>e. extreme Y (\<sqsupseteq>) e" by auto
+    qed
+    with completeD[OF comp BA]
+    obtain b where extb: "extreme_bound A (\<sqsubseteq>) (\<Union>XX) b" by auto
+    then have bb: "b \<sqsubseteq> b" using extreme_def bound_def by auto
+    have bA: "b \<in> A" using extb extreme_def by auto
+    then have XQ: "[b]\<^sub>\<sim> \<in> Q" using Q_def bA by auto
+    have bX: "b \<in> [b]\<^sub>\<sim>" by (auto simp: ecl_def)
+    have "extreme_bound Q (\<sqsubseteq>\<^sup>s) XX [b]\<^sub>\<sim>"
+    proof(intro extreme_boundI)
+      show "[b]\<^sub>\<sim> \<in> Q" using XQ.
+    next
+      fix Y assume YXX: "Y \<in> XX"
+      then have YQ: "Y \<in> Q" using XXQ by auto
+      then obtain y where yA: "y \<in> A" and Yy: "Y = [y]\<^sub>\<sim>" by (auto simp: Q_def)
+      then have yY: "y \<in> Y" by (auto simp: ecl_def)
+      then have "y \<in> \<Union>XX" using yY YXX by auto
+      then have "y \<sqsubseteq> b" using extb by auto
+      then show "Y \<sqsubseteq>\<^sup>s [b]\<^sub>\<sim>" using RSLE_eq[OF YQ XQ yY bX] by auto
+    next
+      fix Z assume boundZ: "bound XX (\<sqsubseteq>\<^sup>s) Z" and ZQ: "Z \<in> Q"
+      then obtain z where zA: "z \<in> A" and Zz: "Z = [z]\<^sub>\<sim>" by (auto simp: Q_def)
+      then have zZ: "z \<in> Z" by (auto simp: ecl_def)
+      { fix y assume "y \<in> \<Union>XX"
+        then obtain Y where yY: "y \<in> Y" and YXX: "Y \<in> XX" by auto
+        then have YA: "Y \<subseteq> A" using XXQ Q_def by (auto simp: ecl_def)
+        then have "Y \<sqsubseteq>\<^sup>s Z" using YXX boundZ bound_def by auto
+        then have "y \<sqsubseteq> z" using yY zZ by auto
+      }
+      then have "bound (\<Union>XX) (\<sqsubseteq>) z" by auto
+      then have "b \<sqsubseteq> z" using extb zA by auto
+      then show "[b]\<^sub>\<sim> \<sqsubseteq>\<^sup>s Z" using RSLE_eq[OF XQ ZQ bX zZ] by auto
+    qed
+    then show "Ex (extreme_bound Q (\<sqsubseteq>\<^sup>s) XX)" by auto
+  qed
+  interpret Q: antisymmetric Q "(\<sqsubseteq>\<^sup>s)"
+  proof
+    fix X Y assume XY: "X \<sqsubseteq>\<^sup>s Y" and YX: "Y \<sqsubseteq>\<^sup>s X" and XQ: "X \<in> Q" and YQ: "Y \<in> Q"
+    then obtain q where qA: "q \<in> A" and X: "X = [q]\<^sub>\<sim>" using Q_def by auto
+    then have qX: "q \<in> X" using X by (auto simp: ecl_def)
+    then obtain p where pA: "p \<in> A" and Y: "Y = [p]\<^sub>\<sim>" using YQ Q_def by auto
+    then have pY: "p \<in> Y" using X by (auto simp: ecl_def)
+    have pq: "p \<sqsubseteq> q" using  XQ YQ YX qX pY by auto
+    have "q \<sqsubseteq> p" using XQ YQ XY qX pY by auto
+    then have "p \<in> X" using pq X pA by (auto simp: ecl_def)
+    then have "X = [p]\<^sub>\<sim>" using XQ XQx by auto
+    then show "X = Y" using Y by (auto simp: ecl_def)
+  qed
+  define F where "F X \<equiv> {y \<in> A. \<exists>x \<in> X. y \<sim> f x} \<union> f ` X" for X
+  have XQFXQ: "\<And>X. X \<in> Q \<Longrightarrow> F X \<in> Q"
+  proof-
+    fix X assume XQ: "X \<in> Q"
+    then obtain x where xA: "x \<in> A" and X: "X = [x]\<^sub>\<sim>" using Q_def by auto
+    then have xX: "x \<in> X" by (auto simp: ecl_def)
+    have fxA: "f x \<in> A" using xA f by auto
+    have FXA: "F X \<subseteq> A" using f fxA X by (auto simp: F_def ecl_def)
+    have "F X = [f x]\<^sub>\<sim>"
+    proof (unfold X, intro equalityI subsetI)
+      fix z assume zFX: "z \<in> F [x]\<^sub>\<sim>"
+      then obtain y where yX: "y \<in> [x]\<^sub>\<sim>" and zfy: "z \<sim> f y \<or> z = f y" by (auto simp: F_def)
+      have yA: "y \<in> A" using yX xA by (auto simp: ecl_def)
+      with f have fyA: "f y \<in> A" by auto
+      have zA: "z \<in> A" using zFX FXA by (auto simp: X)
+      have "y \<sim> x \<or> y = x" using X yX by (auto simp: ecl_def)
+      then have "f y \<sim> f x \<or> f y = f x" using mono xA yA by (auto simp: monotone_on_def)
+      then have "z \<sim> f x \<or> z = f x" using zfy sym.trans[OF _ _ zA fyA fxA] by (auto simp:)
+      with zA show "z \<in> [f x]\<^sub>\<sim>" by (auto simp: ecl_def)
+    qed (auto simp: xX F_def ecl_def)
+    with FXA show "F X \<in> Q" by (auto simp: Q_def ecl_def)
+  qed
+  then have F: "F ` Q \<subseteq> Q" by auto
+  then interpret Q: fixed_point_proof Q "(\<sqsubseteq>\<^sup>s)" F by unfold_locales
+  have monoQ: "monotone_on Q (\<sqsubseteq>\<^sup>s) (\<sqsubseteq>\<^sup>s) F" 
+  proof (intro monotone_onI)
+    fix X Y assume XQ: "X \<in> Q" and YQ: "Y \<in> Q" and XY: "X \<sqsubseteq>\<^sup>s Y"
+    then obtain x y where xX: "x \<in> X" and yY: "y \<in> Y" using Q_def by (auto simp: ecl_def)
+    then have xA: "x \<in> A" and yA: "y \<in> A" using XQ YQ by (auto simp: Q_def ecl_def)
+    have "x \<sqsubseteq> y" using XY xX yY by auto
+    then have fxfy: "f x \<sqsubseteq> f y" using monotone_on_def[of A "(\<sqsubseteq>)" "(\<sqsubseteq>)" f] xA yA mono by auto
+    have fxgX: "f x \<in> F X" using xX F_def by blast
+    have fygY: "f y \<in> F Y" using yY F_def by blast
+    show "F X \<sqsubseteq>\<^sup>s F Y" using RSLE_eq[OF XQFXQ[OF XQ] XQFXQ[OF YQ] fxgX fygY fxfy].
+  qed
+  have QdA: "{x. Q.derivable x} \<subseteq> Q" using Q.derivable_A by auto
+  note asQ = Q.antisymmetric_axioms
+  note infl = Q.mono_imp_derivation_infl[OF asQ monoQ]
+  note f_refl = Q.mono_imp_derivation_f_refl[OF asQ monoQ]
+  from Q.mono_imp_ex_least_fp[OF asQ monoQ compQ]
+  obtain P where P: "extreme {q \<in> Q. F q = q} (\<sqsubseteq>\<^sup>s)\<^sup>- P" by auto
+  then have PQ: "P \<in> Q" by (auto simp: extreme_def)
+  from P have FPP: "F P = P" using PQ by auto
+  with P have PP: "P \<sqsubseteq>\<^sup>s P" by auto
+  from P obtain p where pA: "p \<in> A" and Pp: "P = [p]\<^sub>\<sim>" using Q_def by auto
+  then have pP: "p \<in> P" by (auto simp: ecl_def)
+  then have fpA: "f p \<in> A" using pA f by auto
+  have "f p \<in> F P" using pP F_def fpA by auto
+  then have "F P = [f p]\<^sub>\<sim>" using XQx XQFXQ[OF PQ] by auto
+  then have fp: "f p \<sim> p \<or> f p = p" using pP FPP by (auto simp: ecl_def)
+  have "p \<sqsubseteq> p" using PP pP by auto
+  with fp have fpp: "f p \<sim> p" by auto
+  have e: "extreme {p \<in> A. f p \<sim> p \<or> f p = p} (\<sqsupseteq>) p"
+  proof (intro extremeI CollectI conjI pA fp, elim CollectE conjE)
+    fix q assume qA: "q \<in> A" and fq: "f q \<sim> q \<or> f q = q"
+    define Z where "Z \<equiv> {z \<in> A. q \<sim> z}\<union>{q}"
+    then have qZ: "q \<in> Z" using qA by auto
+    then have ZQ: "Z \<in> Q" using qA by (auto simp: Z_def Q_def ecl_def)
+    have fqA: "f q \<in> A" using qA f by auto
+    then have "f q \<in> Z" using fq by (auto simp: Z_def)
+    then have 1: "Z = [f q]\<^sub>\<sim>" using XQx ZQ by auto
+    then have "f q \<in> F Z" using qZ fqA by (auto simp: F_def)
+    then have "F Z = [f q]\<^sub>\<sim>" using XQx XQFXQ[OF ZQ] by auto
+    with 1 have "Z = F Z" by auto
+    then have "P \<sqsubseteq>\<^sup>s Z" using P ZQ by auto
+    then show "p \<sqsubseteq> q" using pP qZ by auto
+  qed
+  with fpp show ?thesis using e by auto
+qed
+
+subsection \<open>General Completeness\<close>
+
+lemma attract_mono_imp_fp_qfp_complete:
+  assumes attract: "attractive A (\<sqsubseteq>)"
+    and comp: "CC-complete A (\<sqsubseteq>)"
+    and wr_CC: "\<forall>C \<subseteq> A. well_related_set C (\<sqsubseteq>) \<longrightarrow> C \<in> CC"
+    and extend: "\<forall>X \<in> CC. \<forall>Y \<in> CC. X \<sqsubseteq>\<^sup>s Y \<longrightarrow> X \<union> Y \<in> CC"
+    and mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
+    and P: "P \<subseteq> {x \<in> A. f x = x}"
+  shows "CC-complete ({q \<in> A. f q \<sim> q} \<union> P) (\<sqsubseteq>)"
+proof (intro completeI)
+  interpret attractive using attract.
+  fix X assume Xfix: "X \<subseteq> {q \<in> A. f q \<sim> q} \<union> P" and XCC: "X \<in> CC"
+  with P have XA: "X \<subseteq> A" by auto
+  define B where "B \<equiv> {b \<in> A. \<forall>a \<in> X. a \<sqsubseteq> b}"
+  { fix s a assume sA: "s \<in> A" and as: "\<forall>a \<in> X. a \<sqsubseteq> s" and aX: "a \<in> X"
+    then have aA: "a \<in> A" using XA by auto
+    then have fafs: "f a \<sqsubseteq> f s" using mono f aX sA as by (auto elim!: monotone_onE)
     have "a \<sqsubseteq> f s"
-    proof (rule dual_attract[rule_format])
-      have "a \<sqsubseteq> s" using as aA by auto
-      then show "f a \<sqsubseteq> f s" using mono by (simp add: monotone_def)
-      show "f a \<sim> a" using Afix aA by auto
+    proof (cases "f a = a")
+      case True
+      then show ?thesis using fafs by auto
+    next
+      case False
+      then have "a \<sim> f a" using P aX Xfix by auto
+      also from fafs have "f a \<sqsubseteq> f s" by auto
+      finally show ?thesis using f aA sA by auto
     qed
   }
-  then have f_closed_S: "f ` S \<subseteq> S" unfolding S_def by auto
-  have comp_S_dual: "complete_in (\<sqsupseteq>) S"
-  proof (unfold complete_in_def, intro allI impI)
-    fix B assume BS: "B \<subseteq> S"
-    then obtain b where bB: "extreme_bound (\<sqsupseteq>) B b" using dual.complete by auto
-    show "Ex (extreme_bound_in (\<sqsupseteq>) S B)"
-    proof (intro exI extreme_bound_inI)
-      { fix a assume aA: "a \<in> A"
-        then have "\<forall>c \<in> B. a \<sqsubseteq> c" using BS aA S_def by auto
-        then have "a \<sqsubseteq> b" using bB by blast
+  with f have fBB: "f ` B \<subseteq> B" unfolding B_def by auto
+  have BA: "B \<subseteq> A" by (auto simp: B_def)
+  have compB: "CC-complete B (\<sqsubseteq>)"
+  proof (unfold complete_def, intro allI impI)
+    fix Y assume YS: "Y \<subseteq> B" and YCC: "Y \<in> CC"
+    with BA have YA: "Y \<subseteq> A" by auto
+    define C where "C \<equiv> X\<union>Y"
+    then have CA: "C \<subseteq> A" using XA YA C_def by auto
+    have XY: "X \<sqsubseteq>\<^sup>s Y" using B_def YS by auto
+    then have CCC: "C \<in> CC" using extend XA YA XCC YCC C_def by auto
+    then obtain s where s: "extreme_bound A (\<sqsubseteq>) C s"
+      using completeD[OF comp CA CCC] by auto
+    then have sA: "s \<in> A" by auto
+    show "Ex (extreme_bound B (\<sqsubseteq>) Y)"
+    proof (intro exI extreme_boundI)
+      { fix x assume "x \<in> X"
+        then have "x \<sqsubseteq> s" using s C_def by auto
       }
-      then show "b \<in> S" unfolding S_def by auto
-      show "x \<in> B \<Longrightarrow> b \<sqsubseteq> x" for x using bB by auto
-      fix c assume "bound (\<sqsupseteq>) B c"
-      then show "c \<sqsubseteq> b" using bB by blast
+      then show "s \<in> B" using sA B_def by auto
+    next
+      fix y assume "y \<in> Y"
+      then show "y \<sqsubseteq> s" using s C_def using extremeD by auto
+    next
+      fix c assume cS: "c \<in> B" and "bound Y (\<sqsubseteq>) c"
+      then have "bound C (\<sqsubseteq>) c" using C_def B_def by auto
+      then show "s \<sqsubseteq> c" using s BA cS by auto
     qed
   qed
-  then have comp_S: "complete_in (\<sqsubseteq>) S" using complete_in_dual by auto
-  then obtain L where LefpS: "extreme (\<sqsupseteq>) {q \<in> S. f q \<sim> q} L"
-    using ex_extreme_quasi_fixed_point[OF mono f_closed_S comp_S attract]
-    by auto
-  show "Ex (extreme_bound_in (\<sqsubseteq>) {s. f s \<sim> s} A)"
-  proof (intro exI extreme_bound_inI)
-    show "L \<in> {s. f s \<sim> s}" using LefpS by auto
-    fix a assume "a \<in> A"
-    with LefpS show "a \<sqsubseteq> L" by (auto simp: S_def)
+  from fBB interpret B: fixed_point_proof B "(\<sqsubseteq>)" f by unfold_locales
+  from BA have *: "{x \<in> A. f x \<sim> x} \<inter> B = {x \<in> B. f x \<sim> x}" by auto
+  have asB: "attractive B (\<sqsubseteq>)" using attractive_subset[OF BA] by auto
+  have monoB: "monotone_on B (\<sqsubseteq>) (\<sqsubseteq>) f" using monotone_on_cmono[OF BA] mono by (auto dest!: le_funD)
+  have compB: "well_complete B (\<sqsubseteq>)"
+    using wr_CC compB BA by (simp add: complete_def) 
+  from B.attract_mono_imp_least_qfp[OF asB compB monoB]
+  obtain l where "extreme {p \<in> B. f p \<sim> p \<or> f p = p} (\<sqsupseteq>) l" and fll: "f l \<sim> l" by auto
+  with P have l: "extreme ({p \<in> B. f p \<sim> p} \<union> P \<inter> B) (\<sqsupseteq>) l" by auto
+  show "Ex (extreme_bound ({q \<in> A. f q \<sim> q} \<union> P) (\<sqsubseteq>) X)"
+  proof (intro exI extreme_boundI)
+    show "l \<in> {q \<in> A. f q \<sim> q} \<union> P" using l BA by auto
+    fix a assume "a \<in> X"
+    with l show "a \<sqsubseteq> l" by (auto simp: B_def)
   next
-    fix c assume c: "bound (\<sqsubseteq>) A c" and cfix: "c \<in> {s. f s \<sim> s}"
-    from c have "c \<in> S" by (auto simp: S_def)
-    with cfix show "L \<sqsubseteq> c" using LefpS c by auto
+    fix c assume c: "bound X (\<sqsubseteq>) c" and cfix: "c \<in> {q \<in> A. f q \<sim> q} \<union> P"
+    with P have cA: "c \<in> A" by auto
+    with c have "c \<in> B" by (auto simp: B_def)
+    with cfix l show "l \<sqsubseteq> c" by auto
   qed
 qed
 
-end
-
-context complete_attractive begin
-
-interpretation fixed_point_proof.
-
-theorem monotone_imp_quasi_fixed_points_complete:
-  assumes mono: "monotone (\<sqsubseteq>) (\<sqsubseteq>) f"
-  shows "complete_in (\<sqsubseteq>) {s. f s \<sim> s}"
-  by (rule attract_imp_qfp_complete[OF complete_axioms mono], auto dest: attract dual.attract)
+lemma attract_mono_imp_qfp_complete:
+  assumes "attractive A (\<sqsubseteq>)"
+    and "CC-complete A (\<sqsubseteq>)"
+    and "\<forall>C \<subseteq> A. well_related_set C (\<sqsubseteq>) \<longrightarrow> C \<in> CC"
+    and "\<forall>X \<in> CC. \<forall>Y \<in> CC. X \<sqsubseteq>\<^sup>s Y \<longrightarrow> X \<union> Y \<in> CC"
+    and "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
+  shows "CC-complete {p \<in> A. f p \<sim> p} (\<sqsubseteq>)"
+  using attract_mono_imp_fp_qfp_complete[OF assms, of "{}"] by simp
 
-end
-
-
-text \<open>The next lemma shows that in a complete relation, two related sets of
-strict fixed points have a quasi-fixed point in between.\<close>
-
-context fixed_point_proof begin
-
-lemma qfp_interpolant:
-  assumes comp: "complete (\<sqsubseteq>)" and mono: "monotone (\<sqsubseteq>) (\<sqsubseteq>) f"
-    and AB: "\<forall>a \<in> A. \<forall>b \<in> B. a \<sqsubseteq> b"
-    and Afp: "\<forall>a \<in> A. f a = a"
-    and Bfp: "\<forall>b \<in> B. f b = b"
-  shows "\<exists>t. (f t \<sim> t) \<and> (\<forall>a \<in> A. a \<sqsubseteq> t) \<and> (\<forall>b \<in> B. t \<sqsubseteq> b)"
+lemma antisym_mono_imp_fp_complete:
+  assumes anti: "antisymmetric A (\<sqsubseteq>)"
+    and comp: "CC-complete A (\<sqsubseteq>)"
+    and wr_CC: "\<forall>C \<subseteq> A. well_related_set C (\<sqsubseteq>) \<longrightarrow> C \<in> CC"
+    and extend: "\<forall>X \<in> CC. \<forall>Y \<in> CC. X \<sqsubseteq>\<^sup>s Y \<longrightarrow> X \<union> Y \<in> CC"
+    and mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
+  shows "CC-complete {p \<in> A. f p = p} (\<sqsubseteq>)"
 proof-
-  interpret complete using comp. 
-  define T where "T \<equiv> {t. (\<forall>a \<in> A. a \<sqsubseteq> t) \<and> (\<forall>b \<in> B. t \<sqsubseteq> b)}"
-  have f_closed_T: "f ` T \<subseteq> T"
-  proof safe
-    fix t assume tT: "t \<in> T"
-    show "f t \<in> T"
-    proof (unfold T_def, safe)
-      fix a assume aA: "a \<in> A"
-      with tT monotoneD[OF mono]
-      have "f a \<sqsubseteq> f t" by (auto simp: T_def)
-      with Afp aA show "a \<sqsubseteq> f t" by auto
-    next
-      fix b assume bB: "b \<in> B"
-      with tT monotoneD[OF mono]
-      have "f t \<sqsubseteq> f b" by (auto simp: T_def)
-      with Bfp bB show "f t \<sqsubseteq> b" by auto
-    qed
-  qed
-  have T_comp: "complete_in (\<sqsubseteq>) T"
-  proof
-    fix U assume UT: "U \<subseteq> T"
-    obtain k where k: "extreme_bound (\<sqsubseteq>) (U \<union> A) k" using complete by auto
-    have "extreme_bound_in (\<sqsubseteq>) T U k"
-    proof (intro extreme_bound_inI)
-      { fix b assume "b \<in> B"
-        with AB T_def UT have "\<forall>x \<in> U \<union> A. x \<sqsubseteq> b" by auto
-        with k have "k \<sqsubseteq> b" by auto
-      }
-      with k T_def show "k \<in> T" by auto
-    next
-      fix x assume "x \<in> U"
-      with k show "x \<sqsubseteq> k" by auto
-    next
-      fix l
-      assume "bound (\<sqsubseteq>) U l" and "l \<in> T"
-      then have "\<forall>a \<in> U \<union> A. a \<sqsubseteq> l" by (auto simp: T_def)
-      with k show "k \<sqsubseteq> l" by auto
-    qed
-    then show "Ex (extreme_bound_in (\<sqsubseteq>) T U)" by auto
-  qed
-  obtain t where "t \<in> T" and "f t \<sim> t"
-    using quasi_fixed_point 
-    by (meson T_comp f_closed_T mono)
-  then show ?thesis by (auto simp: T_def)
+  interpret antisymmetric using anti.
+  have *: "{q \<in> A. f q \<sim> q} \<subseteq> {p \<in> A. f p = p}" using f by (auto intro!: antisym)
+  from * attract_mono_imp_fp_qfp_complete[OF attractive_axioms comp wr_CC extend mono, of "{p\<in>A. f p = p}"]
+  show ?thesis by (auto simp: subset_Un_eq)
 qed
 
 end
 
-text \<open>From this, we deduce that the set of strict fixed-points is also complete, assuming
-only antisymmetry and attractivity.\<close>
-
-context complete_antisymmetric begin
-
-interpretation fixed_point_proof.
-
-context
-  fixes f assumes mono: "monotone (\<sqsubseteq>) (\<sqsubseteq>) f"
-begin
+subsection \<open>Instances\<close>
 
-theorem monotone_imp_fixed_points_complete:
-  shows "complete_in (\<sqsubseteq>) {s. f s = s}"
-proof
-  fix A assume "A \<subseteq> {s. f s = s}"
-  then have Afp: "\<forall>a\<in>A. f a = a" by auto
-  define S where "S \<equiv> {s. \<forall>a \<in> A. a \<sqsubseteq> s}"
-  have f_closed_S: "f ` S \<subseteq> S"
-  proof safe
-    fix s assume sS: "s \<in> S"
-    show "f s \<in> S"
-    proof(unfold S_def, safe)
-      fix a assume aA: "a \<in> A"
-      then have "f a \<sqsubseteq> f s" using S_def sS mono by (auto dest:monotoneD)
-      then show "a \<sqsubseteq> f s" using Afp aA by auto
-    qed
-  qed
-  have "complete_in (\<sqsupseteq>) S"
-  proof
-    fix B assume BS: "B \<subseteq> S"
-    obtain L where BL: "extreme_bound (\<sqsupseteq>) B L" using  dual.complete by blast
-    have "extreme_bound_in (\<sqsupseteq>) S B L"
-    proof (intro extreme_bound_inI)
-      { fix a assume aA: "a \<in> A"
-        then have "\<forall>s \<in> B. a \<sqsubseteq> s" using BS S_def by auto
-      }
-      then have "\<forall>a \<in> A. a \<sqsubseteq> L" using BL by (simp add: extreme_bound_iff)
-      then show "L \<in> S" using S_def by auto
-      show "b \<in> B \<Longrightarrow> L \<sqsubseteq> b" for b using BL by auto
-      show "\<And>c. bound (\<sqsupseteq>) B c \<Longrightarrow> c \<sqsubseteq> L" using BL by (auto elim!: boundE)
-    qed
-    then show "Ex (extreme_bound_in (\<sqsupseteq>) S B)" by auto
-  qed
-  then have comp_S: "complete_in (\<sqsubseteq>) S" using complete_in_dual by auto
-  have "Ex (extreme (\<sqsupseteq>) {q \<in> S. f q \<sim> q})"
-    apply (rule ex_extreme_quasi_fixed_point[OF mono f_closed_S comp_S])
-    by auto
-  then obtain q where q: "extreme (\<sqsupseteq>) {q \<in> S. f q \<sqsubseteq> q \<and> q \<sqsubseteq> f q} q" by auto
-  have "extreme_bound_in (\<sqsubseteq>) {s. f s = s} A q"
-  proof (intro extreme_bound_inI)
-    show qfp: "q \<in> {s. f s = s}" using q by auto
-    show Aq: "\<And>a. a \<in> A \<Longrightarrow> a \<sqsubseteq> q" using q S_def by auto
-    fix c assume "bound (\<sqsubseteq>) A c" and "c \<in> {s. f s = s}"
-    then have cfp: "f c = c" and Ac: "\<forall>a \<in> A. a \<sqsubseteq> c" by auto
-    define D where [simp]: "D \<equiv> {c,q}"
-    have AD: "\<forall>a \<in> A. \<forall>d \<in> D. a \<sqsubseteq> d" using Aq Ac by auto
-    then have Dfp: "\<forall>d\<in>D. f d = d" using qfp cfp by auto 
-    then obtain t where t: "(f t \<sim> t) \<and> (\<forall>a \<in> A. a \<sqsubseteq> t) \<and> (\<forall>d \<in> D. t \<sqsubseteq> d)"
-      using qfp_interpolant[OF complete_axioms mono AD Afp Dfp]
-      by auto
-    then have tq: "t \<sqsubseteq> q" by auto
-    have "q \<sqsubseteq> t" using t q by (auto simp: S_def)
-    with tq have "q = t" by auto
-    also have "t \<sqsubseteq> c" using t by auto
-    finally show "q \<sqsubseteq> c".
-  qed
-  then show "Ex (extreme_bound_in (\<sqsubseteq>) {s. f s = s} A)" by auto
-qed
+subsubsection \<open>Instances under attractivity\<close>
 
-corollary monotone_imp_ex_extreme_fixed_point:
-  shows "Ex (extreme (\<sqsupseteq>) {s. f s = s})"
-  using complete_inD[OF monotone_imp_fixed_points_complete, of "{}"]
-  by auto
+context attractive begin
 
-end
+interpretation less_eq_notations.
+
+text \<open>Full completeness\<close>
+theorem mono_imp_qfp_UNIV_complete:
+  assumes comp: "UNIV-complete A (\<sqsubseteq>)" and f: "f ` A \<subseteq> A" and mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
+  shows "UNIV-complete {p \<in> A. f p \<sim> p} (\<sqsubseteq>)"
+  apply (intro fixed_point_proof.attract_mono_imp_qfp_complete comp mono)
+    apply unfold_locales
+  by (auto simp: f)
+
+text \<open>Connex completeness\<close>
+theorem mono_imp_qfp_connex_complete:
+  assumes comp: "{X. connex X (\<sqsubseteq>)}-complete A (\<sqsubseteq>)"
+    and f: "f ` A \<subseteq> A" and mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
+  shows "{X. connex X (\<sqsubseteq>)}-complete {p \<in> A. f p \<sim> p} (\<sqsubseteq>)"
+  apply (intro fixed_point_proof.attract_mono_imp_qfp_complete mono comp)
+    apply unfold_locales
+  by (auto simp: f intro: connex_union well_related_set.connex_axioms)
+
+text \<open>Directed completeness\<close>
+theorem mono_imp_qfp_directed_complete:
+  assumes comp: "{X. directed X (\<sqsubseteq>)}-complete A (\<sqsubseteq>)"
+    and f: "f ` A \<subseteq> A" and mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
+  shows "{X. directed X (\<sqsubseteq>)}-complete {p \<in> A. f p \<sim> p} (\<sqsubseteq>)"
+  apply (intro fixed_point_proof.attract_mono_imp_qfp_complete mono comp)
+    apply unfold_locales
+  by (auto simp: f intro!: directed_extend intro: well_related_set.connex_axioms connex.directed)
+
+text \<open>Well Completeness\<close>
+theorem mono_imp_qfp_well_complete:
+  assumes comp: "well_complete A (\<sqsubseteq>)"
+    and f: "f ` A \<subseteq> A" and mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
+  shows "well_complete {p \<in> A. f p \<sim> p} (\<sqsubseteq>)"
+  apply (intro fixed_point_proof.attract_mono_imp_qfp_complete mono comp)
+    apply unfold_locales
+  by (auto simp: f well_related_extend)
 
 end
 
-section \<open>Kleene-Style Fixed Point Theorem\<close>
-
-text \<open>Kleene's fixed-point theorem states that,
-for a pointed directed complete partial order $\tp{A,\SLE}$
-and a Scott-continuous map $f: A \to A$,
-the supremum of $\set{f^n(\bot) \mid n\in\Nat}$ exists in $A$ and is a least 
-fixed point.
-Mashburn \cite{mashburn83} generalized the result so that
-$\tp{A,\SLE}$ is a $\omega$-complete partial order
-and $f$ is $\omega$-continuous.
-
-In this section we further generalize the result and show that
-for $\omega$-complete relation $\tp{A,\SLE}$
-and for every bottom element $\bot \in A$,
-the set $\set{f^n(\bot) \mid n\in\Nat}$ has suprema (not necessarily unique, of 
-course) and, 
-they are quasi-fixed points.
-Moreover, if $(\SLE)$ is attractive, then the suprema are precisely the least 
-quasi-fixed points.\<close>
-
-subsection \<open>Scott Continuity, $\omega$-Completeness, $\omega$-Continuity\<close>
-
-text \<open>In this Section, we formalize $\omega$-completeness, Scott continuity and $\omega$-continuity.
-We then prove that a Scott continuous map is $\omega$-continuous and that an $\omega$-continuous 
-map is ``nearly'' monotone.\<close>
-
-context
-  fixes less_eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
-begin
-
-definition "omega_continuous f \<equiv> \<forall>c :: nat \<Rightarrow> 'a. \<forall> b.
-  monotone (\<le>) (\<sqsubseteq>) c \<longrightarrow>
-  extreme_bound (\<sqsubseteq>) (range c) b \<longrightarrow> extreme_bound (\<sqsubseteq>) (f ` range c) (f b)"
-
-lemma omega_continuousI[intro?]:
-  assumes "\<And>c :: nat \<Rightarrow> 'a. \<And> b.
-   monotone (\<le>) (\<sqsubseteq>) c \<Longrightarrow>
-   extreme_bound (\<sqsubseteq>) (range c) b \<Longrightarrow> extreme_bound (\<sqsubseteq>) (f ` range c) (f b)"
-  shows "omega_continuous f"
-  using assms by (auto simp: omega_continuous_def)
+subsubsection \<open>Usual instances under antisymmetry \<close>
 
-lemma omega_continuousE[elim]:
-  assumes "omega_continuous f"
-    and "(\<And>c :: nat \<Rightarrow> 'a. \<And> b. monotone (\<le>) (\<sqsubseteq>) c \<Longrightarrow>
-         extreme_bound (\<sqsubseteq>) (range c) b \<Longrightarrow> extreme_bound (\<sqsubseteq>) (f ` range c) (f b)
-         ) \<Longrightarrow> thesis"
-  shows "thesis"
-  using assms by (auto simp: omega_continuous_def)
-
-lemma omega_continuous_imp_mono_refl:
-  assumes cont: "omega_continuous f"
-    and xy: "x \<sqsubseteq> y" and xx: "x \<sqsubseteq> x" and yy: "y \<sqsubseteq> y"
-  shows "f x \<sqsubseteq> f y"
-proof-
-  define c :: "nat \<Rightarrow> 'a" where "c \<equiv> \<lambda>i. if i = 0 then x else y"
-  from xx xy yy have monoc: "monotone (\<le>) (\<sqsubseteq>) c"
-    by (auto simp: c_def intro!: monotoneI)
-  have "extreme_bound (\<sqsubseteq>) (range c) y" using xy yy by (auto simp: c_def)
-  then have fboy: "extreme_bound (\<sqsubseteq>) (f ` range c) (f y)" using monoc cont by auto
-  then show "f x \<sqsubseteq> f y" by (auto simp: c_def)
-qed
-
-definition "scott_continuous f \<equiv>
-  \<forall>D b. directed (\<sqsubseteq>) D \<longrightarrow> extreme_bound (\<sqsubseteq>) D b \<longrightarrow> extreme_bound (\<sqsubseteq>) (f ` D) (f b)"
+context antisymmetric begin
 
-lemma scott_continuousI[intro?]:
-  assumes "\<And>D b. directed (\<sqsubseteq>) D \<Longrightarrow> extreme_bound (\<sqsubseteq>) D b \<Longrightarrow> extreme_bound (\<sqsubseteq>) (f ` D) (f b)"
-  shows "scott_continuous f"
-  using assms by (auto simp: scott_continuous_def)
-
-lemma scott_continuousE[elim]:
-  assumes "scott_continuous f"
-    and "(\<And>D b. directed (\<sqsubseteq>) D \<Longrightarrow>
-         extreme_bound (\<sqsubseteq>) D b \<Longrightarrow> extreme_bound (\<sqsubseteq>) (f ` D) (f b)) \<Longrightarrow> thesis"
-  shows "thesis"
-  using assms by (auto simp: scott_continuous_def)
-
-lemma scott_continuous_imp_mono_refl:
-  assumes scott: "scott_continuous f"
-    and xy: "x \<sqsubseteq> y" and yy: "y \<sqsubseteq> y"
-  shows "f x \<sqsubseteq> f y"
+text \<open>Knaster--Tarski\<close>
+theorem mono_imp_fp_complete:
+  assumes comp: "UNIV-complete A (\<sqsubseteq>)"
+    and f: "f ` A \<subseteq> A" and mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
+  shows "UNIV-complete {p \<in> A. f p = p} (\<sqsubseteq>)"
 proof-
-  define D where "D \<equiv> {x,y}"
-  from xy yy have dir_D
-: "directed (\<sqsubseteq>) D" by (auto simp: D_def intro!: bexI[of _ y])
-  have "extreme_bound (\<sqsubseteq>) D y" using xy yy by (auto simp: D_def)
-  then have fboy: "extreme_bound (\<sqsubseteq>) (f ` D) (f y)" using dir_D scott by auto
-  then show "f x \<sqsubseteq> f y" by (auto simp: D_def)
-qed
-
-lemma scott_continuous_imp_omega_continuous:
-  assumes scott: "scott_continuous f" shows "omega_continuous f"
-proof
-  fix c :: "nat \<Rightarrow> 'a"
-  assume "monotone (\<le>) (\<sqsubseteq>) c"
-  from monotone_directed_image[OF this order.dual.dual.directed_UNIV] scott
-  show "extreme_bound (\<sqsubseteq>) (range c) b \<Longrightarrow> extreme_bound (\<sqsubseteq>) (f ` range c) (f b)" for b
+  interpret fixed_point_proof using f by unfold_locales
+  show ?thesis
+    apply (intro antisym_mono_imp_fp_complete mono antisymmetric_axioms comp)
     by auto
 qed
 
-end
-
-subsection \<open>Kleene's Fixed-Point Theorem\<close>
-
-text \<open>The first part of Kleene's theorem demands to prove that the set 
-$\set{f^n(\bot) \mid n \in \Nat}$ has a supremum and 
-that all such are quasi-fixed points. We prove this claim without assuming 
-anything on the relation $\SLE$ besides $\omega$-completeness and one bottom element.\<close>
-
-context fixed_point_proof begin
-
-context
-  fixes f
-  assumes comp: "omega_complete (\<sqsubseteq>)"
-  assumes cont: "omega_continuous (\<sqsubseteq>) f"
-  fixes bot ("\<^bold>\<bottom>")
-  assumes bot: "\<forall>q. \<^bold>\<bottom> \<sqsubseteq> q"
-begin
-
-interpretation omega_complete "(\<sqsubseteq>)" using comp.
-
-abbreviation(input) fn where "fn n \<equiv> (f ^^ n) \<^bold>\<bottom>"
-
-abbreviation(input) "Fn \<equiv> range fn"
-
-lemma fn_ref: "fn n \<sqsubseteq> fn n"
-  using omega_continuous_imp_mono_refl[OF cont] bot by (induct n, auto)
-
-lemma fn_monotone: "monotone (\<le>) (\<sqsubseteq>) fn"
-proof
-  fix n m :: nat
-  assume "n \<le> m"
-  from le_Suc_ex[OF this] obtain k where m: "m = n + k" by auto
-  from bot fn_ref omega_continuous_imp_mono_refl[OF cont]
-  show "fn n \<sqsubseteq> fn m" by (unfold m, induct n, auto)
+text \<open>Markowsky 1976\<close>
+theorem mono_imp_fp_connex_complete:
+  assumes comp: "{X. connex X (\<sqsubseteq>)}-complete A (\<sqsubseteq>)"
+    and f: "f ` A \<subseteq> A" and mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
+  shows "{X. connex X (\<sqsubseteq>)}-complete {p \<in> A. f p = p} (\<sqsubseteq>)"
+proof-
+  interpret fixed_point_proof using f by unfold_locales
+  show ?thesis
+    apply (intro antisym_mono_imp_fp_complete antisymmetric_axioms mono comp)
+    by (auto intro: connex_union well_related_set.connex_axioms)
 qed
 
-lemma ex_kleene_fixed_point:
-  shows "Ex (extreme_bound (\<sqsubseteq>) Fn)" 
-  using monotone_seq_complete[OF fn_monotone] by auto
-
-lemma kleene_fixed_point_is_fixed:
-  assumes q: "extreme_bound (\<sqsubseteq>) Fn q"
-  shows "f q \<sim> q"
-proof
-  have fq: "extreme_bound (\<sqsubseteq>) (f ` Fn) (f q)"
-    using q cont fn_monotone by auto
-  with bot have nq: "fn n \<sqsubseteq> f q" for n
-    by(induct n, auto simp: extreme_bound_iff)
-  then show "q \<sqsubseteq> f q" using q by blast
-  have "f (fn n) \<in> range fn" for n by (auto intro!: range_eqI[of _ _ "Suc n"])
-  then have "f ` Fn \<subseteq> Fn" by auto
-  then show "f q \<sqsubseteq> q" using q fq
-    by (metis (no_types, lifting) bound_cmono extreme_def mem_Collect_eq)
+text \<open>Pataraia\<close>
+theorem mono_imp_fp_directed_complete:
+  assumes comp: "{X. directed X (\<sqsubseteq>)}-complete A (\<sqsubseteq>)"
+    and f: "f ` A \<subseteq> A" and mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
+  shows "{X. directed X (\<sqsubseteq>)}-complete {p \<in> A. f p = p} (\<sqsubseteq>)"
+proof-
+  interpret fixed_point_proof using f by unfold_locales
+  show ?thesis
+    apply (intro antisym_mono_imp_fp_complete mono antisymmetric_axioms comp)
+     by (auto intro: directed_extend connex.directed well_related_set.connex_axioms)
 qed
 
-lemma kleene_fixed_point_is_dual_extreme:
-  assumes attract: "\<forall>q x. f q \<sim> q \<longrightarrow> x \<sqsubseteq> f q \<longrightarrow> x \<sqsubseteq> q"
-  assumes q: "extreme_bound (\<sqsubseteq>) Fn q"
-  shows "extreme (\<sqsupseteq>) {s. f s \<sim> s} q"
-proof(intro extremeI, unfold mem_Collect_eq, intro kleene_fixed_point_is_fixed[OF q])
-  fix c assume cqfp: "f c \<sim> c"
-  {
-    fix n::nat
-    have "fn n \<sqsubseteq> c"
-    proof(induct n)
-      case 0
-      show ?case using bot by auto
-    next
-      case IH: (Suc n)
-      have "c \<sqsubseteq> c" using attract cqfp by blast
-      with IH have "fn (Suc n) \<sqsubseteq> f c"
-        using omega_continuous_imp_mono_refl[OF cont] fn_ref by auto
-      then show ?case using attract cqfp by blast 
-    qed
-  }
-  then show "q \<sqsubseteq> c" using q by blast
-qed
-
-lemma kleene_fixed_point_iff_dual_extreme:
-  assumes attract: "\<forall>q x. f q \<sim> q \<longrightarrow> x \<sqsubseteq> f q \<longrightarrow> x \<sqsubseteq> q"
-  assumes dual_attract: "\<forall>p q x. p \<sim> q \<longrightarrow> q \<sqsubseteq> x \<longrightarrow> p \<sqsubseteq> x"
-  shows "extreme_bound (\<sqsubseteq>) Fn = extreme (\<sqsupseteq>) {s. f s \<sim> s}"
-proof (intro ext iffI kleene_fixed_point_is_dual_extreme[OF attract])
-  fix q
-  assume q: "extreme (\<sqsupseteq>) {s. f s \<sim> s} q"
-  from q have fqq: "f q \<sim> q" by auto
-  from ex_kleene_fixed_point obtain k where k: "extreme_bound (\<sqsubseteq>) Fn k" by auto
-  have qk: "q \<sim> k"
-  proof
-    from kleene_fixed_point_is_fixed[OF k] q
-    show "q \<sqsubseteq> k" by auto
-    from kleene_fixed_point_is_dual_extreme[OF _ k] q attract
-    show "k \<sqsubseteq> q" by blast
-  qed
-  show "extreme_bound (\<sqsubseteq>) Fn q"
-  proof (intro extreme_boundI,safe)
-    fix n
-    show "(f ^^ n) \<^bold>\<bottom> \<sqsubseteq> q"
-      apply (induct n, auto intro: bot[rule_format])
-      by (meson attract fn_ref fqq omega_continuous_imp_mono_refl[OF cont])
-  next
-    fix x
-    assume "bound (\<sqsubseteq>) Fn x"
-    with k have kx: "k \<sqsubseteq> x" by auto
-    with dual_attract[rule_format, OF qk]
-    show "q \<sqsubseteq> x" by auto
-  qed
+text \<open>Bhatta \& George 2011\<close>
+theorem mono_imp_fp_well_complete:
+  assumes comp: "well_complete A (\<sqsubseteq>)"
+    and f: "f ` A \<subseteq> A" and mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
+  shows "well_complete {p \<in> A. f p = p} (\<sqsubseteq>)"
+proof-
+  interpret fixed_point_proof using f by unfold_locales
+  show ?thesis
+    apply (intro antisym_mono_imp_fp_complete mono antisymmetric_axioms comp)
+    by (auto intro!: antisym well_related_extend)
 qed
 
 end
 
 end
-
-context omega_complete begin
-
-interpretation fixed_point_proof.
-
-theorem kleene_quasi_fixed_point:
-  assumes "omega_continuous (\<sqsubseteq>) f" and "\<forall>x. bo \<sqsubseteq> x"
-  shows "\<exists>p. extreme_bound (\<sqsubseteq>) {(f ^^ n) bo |. n :: nat} p"
-    and "extreme_bound (\<sqsubseteq>) {(f ^^ n) bo |. n :: nat} p \<Longrightarrow> f p \<sim> p"
-  using ex_kleene_fixed_point[OF omega_complete_axioms assms]
-  using kleene_fixed_point_is_fixed[OF omega_complete_axioms assms].
-
-end
-
-text \<open>Kleene's theorem also states that the quasi-fixed point found this way is a least one.
-Again, attractivity is needed to prove this statement.\<close>
-
-context attractive begin
-
-interpretation fixed_point_proof.
-
-corollary kleene_quasi_fixed_point_dual_extreme:
-  assumes "omega_complete (\<sqsubseteq>)" and "omega_continuous (\<sqsubseteq>) f" and "\<forall>x. bo \<sqsubseteq> x"
-  shows "extreme_bound (\<sqsubseteq>) {(f ^^ n) bo |. n :: nat} = extreme (\<sqsupseteq>) {s. f s \<sim> s}"
-  apply (rule kleene_fixed_point_iff_dual_extreme[OF assms])
-  by (auto dest: attract dual.attract)
-
-end
-
-context antisymmetric begin
-
-interpretation fixed_point_proof.
-
-corollary kleene_fixed_point_is_fixed:
-  assumes "omega_complete (\<sqsubseteq>)" and "omega_continuous (\<sqsubseteq>) f" and "\<forall>x. bo \<sqsubseteq> x"
-    and "extreme_bound (\<sqsubseteq>) {(f ^^ n) bo |. n :: nat} p"
-  shows "f p = p"
-  using kleene_fixed_point_is_fixed[OF assms] by auto
-
-end
-
-end
\ No newline at end of file
diff --git a/thys/Complete_Non_Orders/Kleene_Fixed_Point.thy b/thys/Complete_Non_Orders/Kleene_Fixed_Point.thy
new file mode 100644
--- /dev/null
+++ b/thys/Complete_Non_Orders/Kleene_Fixed_Point.thy
@@ -0,0 +1,291 @@
+theory Kleene_Fixed_Point
+  imports Complete_Relations
+begin
+
+
+section \<open>Iterative Fixed Point Theorem\<close>
+
+text \<open>Kleene's fixed-point theorem states that,
+for a pointed directed complete partial order $\tp{A,\SLE}$
+and a Scott-continuous map $f: A \to A$,
+the supremum of $\set{f^n(\bot) \mid n\in\Nat}$ exists in $A$ and is a least 
+fixed point.
+Mashburn \cite{mashburn83} generalized the result so that
+$\tp{A,\SLE}$ is a $\omega$-complete partial order
+and $f$ is $\omega$-continuous.
+
+In this section we further generalize the result and show that
+for $\omega$-complete relation $\tp{A,\SLE}$
+and for every bottom element $\bot \in A$,
+the set $\set{f^n(\bot) \mid n\in\Nat}$ has suprema (not necessarily unique, of 
+course) and, 
+they are quasi-fixed points.
+Moreover, if $(\SLE)$ is attractive, then the suprema are precisely the least 
+quasi-fixed points.\<close>
+
+subsection \<open>Scott Continuity, $\omega$-Completeness, $\omega$-Continuity\<close>
+
+text \<open>In this Section, we formalize $\omega$-completeness, Scott continuity and $\omega$-continuity.
+We then prove that a Scott continuous map is $\omega$-continuous and that an $\omega$-continuous 
+map is ``nearly'' monotone.\<close>
+
+context
+  fixes A :: "'a set" and less_eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
+begin
+
+definition "omega_continuous f \<equiv>
+  f ` A \<subseteq> A \<and>
+  (\<forall>c :: nat \<Rightarrow> 'a. \<forall> b \<in> A.
+  range c \<subseteq> A \<longrightarrow>
+  monotone (\<le>) (\<sqsubseteq>) c \<longrightarrow>
+  extreme_bound A (\<sqsubseteq>) (range c) b \<longrightarrow> extreme_bound A (\<sqsubseteq>) (f ` range c) (f b))"
+
+lemmas omega_continuousI[intro?] =
+  omega_continuous_def[unfolded atomize_eq, THEN iffD2, unfolded conj_imp_eq_imp_imp, rule_format]
+
+lemmas omega_continuousDdom =
+  omega_continuous_def[unfolded atomize_eq, THEN iffD1, unfolded conj_imp_eq_imp_imp, THEN conjunct1]
+
+lemmas omega_continuousD =
+  omega_continuous_def[unfolded atomize_eq, THEN iffD1, unfolded conj_imp_eq_imp_imp, THEN conjunct2, rule_format]
+
+lemmas omega_continuousE[elim] =
+  omega_continuous_def[unfolded atomize_eq, THEN iffD1, elim_format, unfolded conj_imp_eq_imp_imp, rule_format]
+
+lemma omega_continuous_imp_mono_refl:
+  assumes cont: "omega_continuous f"
+    and x: "x \<in> A" and y: "y \<in> A"
+    and xy: "x \<sqsubseteq> y" and xx: "x \<sqsubseteq> x" and yy: "y \<sqsubseteq> y"
+  shows "f x \<sqsubseteq> f y"
+proof-
+  define c :: "nat \<Rightarrow> 'a" where "c \<equiv> \<lambda>i. if i = 0 then x else y"
+  from x y xx xy yy have c: "range c \<subseteq> A" "monotone (\<le>) (\<sqsubseteq>) c"
+    by (auto simp: c_def intro!: monotoneI)
+  have "extreme_bound A (\<sqsubseteq>) (range c) y" using xy yy x y by (auto simp: c_def)
+  then have fboy: "extreme_bound A (\<sqsubseteq>) (f ` range c) (f y)" using c cont y by auto
+  then show "f x \<sqsubseteq> f y" by (auto simp: c_def)
+qed
+
+definition "scott_continuous f \<equiv>
+  f ` A \<subseteq> A \<and>
+  (\<forall>X s. X \<subseteq> A \<longrightarrow> directed X (\<sqsubseteq>) \<longrightarrow> X \<noteq> {} \<longrightarrow> extreme_bound A (\<sqsubseteq>) X s \<longrightarrow> extreme_bound A (\<sqsubseteq>) (f ` X) (f s))"
+
+lemmas scott_continuousI[intro?] =
+  scott_continuous_def[unfolded atomize_eq, THEN iffD2, unfolded conj_imp_eq_imp_imp, rule_format]
+
+lemmas scott_continuousE =
+  scott_continuous_def[unfolded atomize_eq, THEN iffD1, elim_format, unfolded conj_imp_eq_imp_imp, rule_format]
+
+lemma scott_continuous_imp_mono_refl:
+  assumes scott: "scott_continuous f"
+    and x: "x \<in> A" and y: "y \<in> A" and xy: "x \<sqsubseteq> y" and yy: "y \<sqsubseteq> y"
+  shows "f x \<sqsubseteq> f y"
+proof-
+  define D where "D \<equiv> {x,y}"
+  from x y xy yy have dir_D: "D \<subseteq> A" "directed D (\<sqsubseteq>)" "D \<noteq> {}"
+    by (auto simp: D_def intro!: bexI[of _ y] directedI)
+  have "extreme_bound A (\<sqsubseteq>) D y" using xy yy x y by (auto simp: D_def)
+  then have fboy: "extreme_bound A (\<sqsubseteq>) (f ` D) (f y)" using dir_D scott by (auto elim!: scott_continuousE)
+  then show "f x \<sqsubseteq> f y" by (auto simp: D_def)
+qed
+
+lemma scott_continuous_imp_omega_continuous:
+  assumes scott: "scott_continuous f" shows "omega_continuous f"
+proof
+  from scott show "f ` A \<subseteq> A" by (auto elim!: scott_continuousE)
+  fix c :: "nat \<Rightarrow> 'a"
+  assume mono: "monotone (\<le>) (\<sqsubseteq>) c" and c: "range c \<subseteq> A"
+  from monotone_directed_image[OF mono[folded monotone_on_UNIV] order.directed] scott c
+  show "extreme_bound A (\<sqsubseteq>) (range c) b \<Longrightarrow> extreme_bound A (\<sqsubseteq>) (f ` range c) (f b)" for b
+    by (auto elim!: scott_continuousE)
+qed
+
+end
+
+subsection \<open>Existence of Iterative Fixed Points\<close>
+
+text \<open>The first part of Kleene's theorem demands to prove that the set 
+$\set{f^n(\bot) \mid n \in \Nat}$ has a supremum and 
+that all such are quasi-fixed points. We prove this claim without assuming 
+anything on the relation $\SLE$ besides $\omega$-completeness and one bottom element.\<close>
+
+(*
+no_notation power (infixr "^" 80)
+*)
+notation compower ("_^_"[1000,1000]1000)
+
+lemma mono_funpow: assumes f: "f ` A \<subseteq> A" and mono: "monotone_on A r r f"
+  shows "monotone_on A r r (f^n)"
+proof (induct n)
+  case 0
+  show ?case using monotone_on_id by (auto simp: id_def)
+next
+  case (Suc n)
+  with funpow_dom[OF f] show ?case
+    by (auto intro!: monotone_onI monotone_onD[OF mono] elim!:monotone_onE)
+qed
+
+no_notation bot ("\<bottom>")
+
+context
+  fixes A and less_eq (infix "\<sqsubseteq>" 50) and bot ("\<bottom>") and f
+  assumes bot: "\<bottom> \<in> A" "\<forall>q \<in> A. \<bottom> \<sqsubseteq> q"
+  assumes cont: "omega_continuous A (\<sqsubseteq>) f"
+begin
+
+interpretation less_eq_notations.
+
+private lemma f: "f ` A \<subseteq> A" using cont by auto
+
+private abbreviation(input) "Fn \<equiv> {f^n \<bottom> |. n :: nat}"
+
+private lemma fn_ref: "f^n \<bottom> \<sqsubseteq> f^n \<bottom>" and fnA: "f^n \<bottom> \<in> A"
+proof (atomize(full), induct n)
+  case 0
+  from bot show ?case by simp
+next
+  case (Suc n)
+  then have fn: "f^n \<bottom> \<in> A" and fnfn: "f^n \<bottom> \<sqsubseteq> f^n \<bottom>" by auto
+  from f fn omega_continuous_imp_mono_refl[OF cont fn fn fnfn fnfn fnfn]
+  show ?case by auto
+qed
+
+private lemma FnA: "Fn \<subseteq> A" using fnA by auto
+
+private lemma fn_monotone: "monotone (\<le>) (\<sqsubseteq>) (\<lambda>n. f^n \<bottom>)"
+proof
+  fix n m :: nat
+  assume "n \<le> m"
+  from le_Suc_ex[OF this] obtain k where m: "m = n + k" by auto
+  from bot fn_ref fnA omega_continuous_imp_mono_refl[OF cont]
+  show "f^n \<bottom> \<sqsubseteq> f^m \<bottom>" by (unfold m, induct n, auto)
+qed
+
+private lemma Fn: "Fn = range (\<lambda>n. f^n \<bottom>)" by auto
+
+theorem kleene_qfp:
+  assumes q: "extreme_bound A (\<sqsubseteq>) Fn q"
+  shows "f q \<sim> q"
+proof
+  have fq: "extreme_bound A (\<sqsubseteq>) (f ` Fn) (f q)"
+    apply (unfold Fn)
+    apply (rule omega_continuousD[OF cont])
+    using FnA fn_monotone q by (unfold Fn, auto)
+  with bot have nq: "f^n \<bottom> \<sqsubseteq> f q" for n
+    by(induct n, auto simp: extreme_bound_iff)
+  then show "q \<sqsubseteq> f q" using f q by blast
+  have "f (f^n \<bottom>) \<in> Fn" for n by (auto intro!: exI[of _ "Suc n"])
+  then have "f ` Fn \<subseteq> Fn" by auto
+  from extreme_bound_mono[OF this fq q]
+  show "f q \<sqsubseteq> q".
+qed
+
+lemma ex_kleene_qfp:
+  assumes comp: "omega_complete A (\<sqsubseteq>)"
+  shows "\<exists>p. extreme_bound A (\<sqsubseteq>) Fn p" 
+  using fn_monotone
+  apply (intro comp[unfolded omega_complete_def, THEN completeD, OF FnA])
+  by fast
+
+subsection \<open>Iterative Fixed Points are Least.\<close>
+text \<open>Kleene's theorem also states that the quasi-fixed point found this way is a least one.
+Again, attractivity is needed to prove this statement.\<close>
+
+lemma kleene_qfp_is_least:
+  assumes attract: "\<forall>q \<in> A. \<forall>x \<in> A. f q \<sim> q \<longrightarrow> x \<sqsubseteq> f q \<longrightarrow> x \<sqsubseteq> q"
+  assumes q: "extreme_bound A (\<sqsubseteq>) Fn q"
+  shows "extreme {s \<in> A. f s \<sim> s} (\<sqsupseteq>) q"
+proof(safe intro!: extremeI kleene_qfp[OF q])
+  from q
+  show "q \<in> A" by auto
+  fix c assume c: "c \<in> A" and cqfp: "f c \<sim> c"
+  {
+    fix n::nat
+    have "f^n \<bottom> \<sqsubseteq> c"
+    proof(induct n)
+      case 0
+      show ?case using bot c by auto
+    next
+      case IH: (Suc n)
+      have "c \<sqsubseteq> c" using attract cqfp c by auto
+      with IH have "f^(Suc n) \<bottom> \<sqsubseteq> f c"
+        using omega_continuous_imp_mono_refl[OF cont] fn_ref fnA c by auto
+      then show ?case using attract cqfp c fnA by blast
+    qed
+  }
+  then show "q \<sqsubseteq> c" using q c by auto
+qed
+
+lemma kleene_qfp_iff_least:
+  assumes comp: "omega_complete A (\<sqsubseteq>)"
+  assumes attract: "\<forall>q \<in> A. \<forall>x \<in> A. f q \<sim> q \<longrightarrow> x \<sqsubseteq> f q \<longrightarrow> x \<sqsubseteq> q"
+  assumes dual_attract: "\<forall>p \<in> A. \<forall>q \<in> A. \<forall>x \<in> A. p \<sim> q \<longrightarrow> q \<sqsubseteq> x \<longrightarrow> p \<sqsubseteq> x"
+  shows "extreme_bound A (\<sqsubseteq>) Fn = extreme {s \<in> A. f s \<sim> s} (\<sqsupseteq>)"
+proof (intro ext iffI kleene_qfp_is_least[OF attract])
+  fix q
+  assume q: "extreme {s \<in> A. f s \<sim> s} (\<sqsupseteq>) q"
+  from q have qA: "q \<in> A" by auto
+  from q have qq: "q \<sqsubseteq> q" by auto
+  from q have fqq: "f q \<sim> q" by auto
+  from ex_kleene_qfp[OF comp]
+  obtain k where k: "extreme_bound A (\<sqsubseteq>) Fn k" by auto
+  have qk: "q \<sim> k"
+  proof
+    from kleene_qfp[OF k] q k
+    show "q \<sqsubseteq> k" by auto
+    from kleene_qfp_is_least[OF _ k] q attract
+    show "k \<sqsubseteq> q" by blast
+  qed
+  show "extreme_bound A (\<sqsubseteq>) Fn q"
+  proof (intro extreme_boundI,safe)
+    fix n
+    show "f^n \<bottom> \<sqsubseteq> q"
+    proof (induct n)
+      case 0
+      from bot q show ?case by auto 
+    next
+      case S:(Suc n)
+      from fnA f have fsnbA: "f (f^n \<bottom>) \<in> A" by auto
+      have fnfn: "f^n \<bottom> \<sqsubseteq> f^n \<bottom>" using fn_ref by auto
+      have "f (f^n \<bottom>) \<sqsubseteq> f q"
+        using omega_continuous_imp_mono_refl[OF cont fnA qA S fnfn qq] by auto
+      then show ?case using fsnbA qA attract fqq by auto
+    qed
+  next
+    fix x
+    assume "bound Fn (\<sqsubseteq>) x" and x: "x \<in> A"
+    with k have kx: "k \<sqsubseteq> x" by auto
+    with dual_attract[rule_format, OF _ _ x qk] q k
+    show "q \<sqsubseteq> x" by auto
+  next
+    from q show "q \<in> A" by auto
+  qed
+qed
+
+end
+
+context attractive begin
+
+interpretation less_eq_notations.
+
+theorem kleene_qfp_is_dual_extreme:
+  assumes comp: "omega_complete A (\<sqsubseteq>)"
+    and cont: "omega_continuous A (\<sqsubseteq>) f" and bA: "b \<in> A" and bot: "\<forall>x \<in> A. b \<sqsubseteq> x"
+  shows "extreme_bound A (\<sqsubseteq>) {f^n b |. n :: nat} = extreme {s \<in> A. f s \<sim> s} (\<sqsupseteq>)"
+  apply (rule kleene_qfp_iff_least[OF bA bot cont comp])
+  using cont[THEN omega_continuousDdom]
+  by (auto dest: sym_order_trans order_sym_trans)
+
+end
+
+corollary(in antisymmetric) kleene_fp:
+  assumes cont: "omega_continuous A (\<sqsubseteq>) f"
+    and b: "b \<in> A" "\<forall>x \<in> A. b \<sqsubseteq> x"
+    and p: "extreme_bound A (\<sqsubseteq>) {f^n b |. n :: nat} p"
+  shows "f p = p"
+  using kleene_qfp[OF b cont] p cont[THEN omega_continuousDdom]
+  by (auto 2 3 intro!:antisym)
+
+no_notation compower ("_^_"[1000,1000]1000)
+
+end
\ No newline at end of file
diff --git a/thys/Complete_Non_Orders/ROOT b/thys/Complete_Non_Orders/ROOT
--- a/thys/Complete_Non_Orders/ROOT
+++ b/thys/Complete_Non_Orders/ROOT
@@ -1,10 +1,10 @@
 chapter AFP
 
 session Complete_Non_Orders (AFP) = HOL +
-  description "Theory of Complete Non-Orders and their Fixed-Points Theorems"
+  description "Fixed-Point Theorems for Non-Transitive Relations"
   options [timeout = 300]
   theories
-    Fixed_Points
+    Fixed_Points Kleene_Fixed_Point
   document_files
     "root.tex"
     "root.bib"
diff --git a/thys/FOL_Seq_Calc1/Common.thy b/thys/FOL_Seq_Calc1/Common.thy
--- a/thys/FOL_Seq_Calc1/Common.thy
+++ b/thys/FOL_Seq_Calc1/Common.thy
@@ -1,14 +1,18 @@
 (*
-    Author: Asta Halkjær From, DTU Compute, 2019
+    Author: Asta Halkjær From, DTU Compute, 2019-2021
     Contributors: Alexander Birch Jensen, Anders Schlichtkrull & Jørgen Villadsen
-    See also the Natural Deduction Assistant: https://nadea.compute.dtu.dk/
+
+    See also the Natural Deduction Assistant (NaDeA) and the Sequent Calculus Verifier (SeCaV):
+
+      https://nadea.compute.dtu.dk/
+      https://secav.compute.dtu.dk/
 *)
 
 section \<open>Common Notation\<close>
 
 theory Common imports "FOL-Fitting.FOL_Fitting" begin
 
 notation FF (\<open>\<bottom>\<close>)
 notation TT (\<open>\<top>\<close>)
 
 end
diff --git a/thys/FOL_Seq_Calc1/Sequent.thy b/thys/FOL_Seq_Calc1/Sequent.thy
--- a/thys/FOL_Seq_Calc1/Sequent.thy
+++ b/thys/FOL_Seq_Calc1/Sequent.thy
@@ -1,205 +1,209 @@
 (*
-    Author: Asta Halkjær From, DTU Compute, 2019
+    Author: Asta Halkjær From, DTU Compute, 2019-2021
     Contributors: Alexander Birch Jensen, Anders Schlichtkrull & Jørgen Villadsen
-    See also the Natural Deduction Assistant: https://nadea.compute.dtu.dk/
+
+    See also the Natural Deduction Assistant (NaDeA) and the Sequent Calculus Verifier (SeCaV):
+
+      https://nadea.compute.dtu.dk/
+      https://secav.compute.dtu.dk/
 *)
 
 section \<open>Sequent Calculus\<close>
 
 theory Sequent imports Tableau begin
 
 inductive SC :: \<open>('a, 'b) form list \<Rightarrow> bool\<close> (\<open>\<turnstile> _\<close> 0) where
   Basic: \<open>\<turnstile> Pred i l # Neg (Pred i l) # G\<close>
 | BasicNegFF: \<open>\<turnstile> Neg \<bottom> # G\<close>
 | BasicTT: \<open>\<turnstile> \<top> # G\<close>
 | AlphaNegNeg: \<open>\<turnstile> A # G \<Longrightarrow> \<turnstile> Neg (Neg A) # G\<close>
 | AlphaNegAnd: \<open>\<turnstile> Neg A # Neg B # G \<Longrightarrow> \<turnstile> Neg (And A B) # G\<close>
 | AlphaOr: \<open>\<turnstile> A # B # G \<Longrightarrow> \<turnstile> Or A B # G\<close>
 | AlphaImpl: \<open>\<turnstile> Neg A # B # G \<Longrightarrow> \<turnstile> Impl A B # G\<close>
 | BetaAnd: \<open>\<turnstile> A # G \<Longrightarrow> \<turnstile> B # G \<Longrightarrow> \<turnstile> And A B # G\<close>
 | BetaNegOr: \<open>\<turnstile> Neg A # G \<Longrightarrow> \<turnstile> Neg B # G \<Longrightarrow> \<turnstile> Neg (Or A B) # G\<close>
 | BetaNegImpl: \<open>\<turnstile> A # G \<Longrightarrow> \<turnstile> Neg B # G \<Longrightarrow> \<turnstile> Neg (Impl A B) # G\<close>
 | GammaExists: \<open>\<turnstile> subst A t 0 # G \<Longrightarrow> \<turnstile> Exists A # G\<close>
 | GammaNegForall: \<open>\<turnstile> Neg (subst A t 0) # G \<Longrightarrow> \<turnstile> Neg (Forall A) # G\<close>
 | DeltaForall: \<open>\<turnstile> subst A (App n []) 0 # G \<Longrightarrow> news n (A # G) \<Longrightarrow> \<turnstile> Forall A # G\<close>
 | DeltaNegExists: \<open>\<turnstile> Neg (subst A (App n []) 0) # G \<Longrightarrow> news n (A # G) \<Longrightarrow> \<turnstile> Neg (Exists A) # G\<close>
 | Order: \<open>\<turnstile> G \<Longrightarrow> set G = set G' \<Longrightarrow> \<turnstile> G'\<close>
 
 lemma Shift: \<open>\<turnstile> rotate1 G \<Longrightarrow> \<turnstile> G\<close>
   by (simp add: Order)
 
 lemma Swap: \<open>\<turnstile> B # A # G \<Longrightarrow> \<turnstile> A # B # G\<close>
   by (simp add: Order insert_commute)
 
 lemma \<open>\<turnstile> [Neg (Pred ''A'' []), Pred ''A'' []]\<close>
   by (rule Shift, simp) (rule Basic)
 
 lemma \<open>\<turnstile> [And (Pred ''A'' []) (Pred ''B'' []), Neg (And (Pred ''B'' []) (Pred ''A'' []))]\<close>
   apply (rule BetaAnd)
    apply (rule Swap)
    apply (rule AlphaNegAnd)
    apply (rule Shift, simp, rule Swap)
    apply (rule Basic)
   apply (rule Swap)
   apply (rule AlphaNegAnd)
   apply (rule Shift, rule Shift, simp)
   apply (rule Basic)
   done
 
 subsection \<open>Soundness\<close>
 
 lemma SC_soundness: \<open>\<turnstile> G \<Longrightarrow> \<exists>p \<in> set G. eval e f g p\<close>
 proof (induct G arbitrary: f rule: SC.induct)
   case (DeltaForall A n G)
   then consider
     \<open>\<forall>x. eval e (f(n := \<lambda>w. x)) g (subst A (App n []) 0)\<close> |
     \<open>\<exists>x. \<exists>p \<in> set G. eval e (f(n := \<lambda>w. x)) g p\<close>
     by fastforce
   then show ?case
   proof cases
     case 1
     then have \<open>\<forall>x. eval (shift e 0 x) (f(n := \<lambda>w. x)) g A\<close>
       by simp
     then have \<open>\<forall>x. eval (shift e 0 x) f g A\<close>
       using \<open>news n (A # G)\<close> by simp
     then show ?thesis
       by simp
   next
     case 2
     then have \<open>\<exists>p \<in> set G. eval e f g p\<close>
       using \<open>news n (A # G)\<close> using Ball_set insert_iff list.set(2) upd_lemma by metis
     then show ?thesis
       by simp
   qed
 next
   case (DeltaNegExists A n G)
   then consider
     \<open>\<forall>x. eval e (f(n := \<lambda>w. x)) g (Neg (subst A (App n []) 0))\<close> |
     \<open>\<exists>x. \<exists>p \<in> set G. eval e (f(n := \<lambda>w. x)) g p\<close>
     by fastforce
   then show ?case
   proof cases
     case 1
     then have \<open>\<forall>x. eval (shift e 0 x) (f(n := \<lambda>w. x)) g (Neg A)\<close>
       by simp
     then have \<open>\<forall>x. eval (shift e 0 x) f g (Neg A)\<close>
       using \<open>news n (A # G)\<close> by simp
     then show ?thesis
       by simp
   next
     case 2
     then have \<open>\<exists>p \<in> set G. eval e f g p\<close>
       using \<open>news n (A # G)\<close> using Ball_set insert_iff list.set(2) upd_lemma by metis
     then show ?thesis
       by simp
   qed
 qed auto
 
 subsection \<open>Tableau Calculus Equivalence\<close>
 
 fun compl :: \<open>('a, 'b) form \<Rightarrow> ('a, 'b) form\<close> where
   \<open>compl (Neg p) = p\<close>
 | \<open>compl p = Neg p\<close>
 
 lemma compl: \<open>compl p = Neg p \<or> (\<exists>q. compl p = q \<and> p = Neg q)\<close>
   by (cases p rule: compl.cases) simp_all
 
 lemma new_compl: \<open>new n p \<Longrightarrow> new n (compl p)\<close>
   by (cases p rule: compl.cases) simp_all
 
 lemma news_compl: \<open>news n G \<Longrightarrow> news n (map compl G)\<close>
   using new_compl by (induct G) fastforce+
 
 theorem TC_SC: \<open>\<stileturn> G \<Longrightarrow> \<turnstile> map compl G\<close>
 proof (induct G rule: TC.induct)
   case (Basic i l G)
   then show ?case
     using SC.Basic Swap by fastforce
 next
   case (AlphaNegNeg A G)
   then show ?case
     using SC.AlphaNegNeg compl by (metis compl.simps(1) list.simps(9))
 next
   case (AlphaAnd A B G)
   then have *: \<open>\<turnstile> compl A # compl B # map compl G\<close>
     by simp
   then have \<open>\<turnstile> Neg A # Neg B # map compl G\<close>
     using compl AlphaNegNeg Swap by metis
   then show ?case
     using AlphaNegAnd by simp
 next
   case (AlphaNegImpl A B G)
   then have \<open>\<turnstile> compl A # B # map compl G\<close>
     by simp
   then have \<open>\<turnstile> Neg A # B # map compl G\<close>
     using compl AlphaNegNeg by metis
   then show ?case
     using AlphaImpl by simp
 next
   case (BetaOr A G B)
   then have \<open>\<turnstile> compl A # map compl G\<close> \<open>\<turnstile> compl B # map compl G\<close>
     by simp_all
   then have \<open>\<turnstile> Neg A # map compl G\<close> \<open>\<turnstile> Neg B # map compl G\<close>
     using compl AlphaNegNeg by metis+
   then show ?case
     using BetaNegOr by simp
 next
   case (BetaImpl A G B)
   then have \<open>\<turnstile> A # map compl G\<close> \<open>\<turnstile> compl B # map compl G\<close>
     by simp_all
   then have \<open>\<turnstile> A # map compl G\<close> \<open>\<turnstile> Neg B # map compl G\<close>
     by - (assumption, metis compl AlphaNegNeg)
   then have \<open>\<turnstile> Neg (Impl A B) # map compl G\<close>
     using BetaNegImpl by blast
   then have \<open>\<turnstile> compl (Impl A B) # map compl G\<close>
     using \<open>\<turnstile> A # map compl G\<close> compl by simp
   then show ?case
     by simp
 next
   case (GammaForall A t G)
   then have \<open>\<turnstile> compl (subst A t 0) # map compl G\<close>
     by simp
   then have \<open>\<turnstile> Neg (subst A t 0) # map compl G\<close>
     using compl AlphaNegNeg by metis
   then show ?case
     using GammaNegForall by simp
 next
   case (DeltaExists A n G)
   then have \<open>\<turnstile> compl (subst A (App n []) 0) # map compl G\<close>
     by simp
   then have \<open>\<turnstile> Neg (subst A (App n []) 0) # map compl G\<close>
     using compl AlphaNegNeg by metis
   moreover have \<open>news n (A # map compl G)\<close>
     using DeltaExists news_compl by fastforce
   ultimately show ?case
     using DeltaNegExists by simp
 next
   case (DeltaNegForall A n G)
   then have \<open>\<turnstile> subst A (App n []) 0 # map compl G\<close>
     by simp
   moreover have \<open>news n (A # map compl G)\<close>
     using DeltaNegForall news_compl by fastforce
   ultimately show ?case
     using DeltaForall by simp
 qed (simp_all add: SC.intros)
 
 subsection \<open>Completeness\<close>
 
 theorem SC_completeness:
   fixes p :: \<open>(nat, nat) form\<close>
   assumes \<open>\<forall>(e :: nat \<Rightarrow> nat hterm) f g. list_all (eval e f g) ps \<longrightarrow> eval e f g p\<close>
   shows \<open>\<turnstile> p # map compl ps\<close>
 proof -
   have \<open>\<stileturn> Neg p # ps\<close>
     using assms tableau_completeness unfolding tableauproof_def by simp
   then show ?thesis
     using TC_SC by fastforce
 qed
 
 corollary
   fixes p :: \<open>(nat, nat) form\<close>
   assumes \<open>\<forall>(e :: nat \<Rightarrow> nat hterm) f g. eval e f g p\<close>
   shows \<open>\<turnstile> [p]\<close>
   using assms SC_completeness list.map(1) by metis
 
 end
diff --git a/thys/FOL_Seq_Calc1/Tableau.thy b/thys/FOL_Seq_Calc1/Tableau.thy
--- a/thys/FOL_Seq_Calc1/Tableau.thy
+++ b/thys/FOL_Seq_Calc1/Tableau.thy
@@ -1,851 +1,855 @@
 (*
-    Author: Asta Halkjær From, DTU Compute, 2019
+    Author: Asta Halkjær From, DTU Compute, 2019-2021
     Contributors: Alexander Birch Jensen, Anders Schlichtkrull & Jørgen Villadsen
-    See also the Natural Deduction Assistant: https://nadea.compute.dtu.dk/
+
+    See also the Natural Deduction Assistant (NaDeA) and the Sequent Calculus Verifier (SeCaV):
+
+      https://nadea.compute.dtu.dk/
+      https://secav.compute.dtu.dk/
 *)
 
 section \<open>Tableau Calculus\<close>
 
 theory Tableau imports Common begin
 
 inductive TC :: \<open>('a, 'b) form list \<Rightarrow> bool\<close> (\<open>\<stileturn> _\<close> 0) where
   Basic: \<open>\<stileturn> Pred i l # Neg (Pred i l) # G\<close>
 | BasicFF: \<open>\<stileturn> \<bottom> # G\<close>
 | BasicNegTT: \<open>\<stileturn> Neg \<top> # G\<close>
 | AlphaNegNeg: \<open>\<stileturn> A # G \<Longrightarrow> \<stileturn> Neg (Neg A) # G\<close>
 | AlphaAnd: \<open>\<stileturn> A # B # G \<Longrightarrow> \<stileturn> And A B # G\<close>
 | AlphaNegOr: \<open>\<stileturn> Neg A # Neg B # G \<Longrightarrow> \<stileturn> Neg (Or A B) # G\<close>
 | AlphaNegImpl: \<open>\<stileturn> A # Neg B # G \<Longrightarrow> \<stileturn> Neg (Impl A B) # G\<close>
 | BetaNegAnd: \<open>\<stileturn> Neg A # G \<Longrightarrow> \<stileturn> Neg B # G \<Longrightarrow> \<stileturn> Neg (And A B) # G\<close>
 | BetaOr: \<open>\<stileturn> A # G \<Longrightarrow> \<stileturn> B # G \<Longrightarrow> \<stileturn> Or A B # G\<close>
 | BetaImpl: \<open>\<stileturn> Neg A # G \<Longrightarrow> \<stileturn> B # G \<Longrightarrow> \<stileturn> Impl A B # G\<close>
 | GammaForall: \<open>\<stileturn> subst A t 0 # G \<Longrightarrow> \<stileturn> Forall A # G\<close>
 | GammaNegExists: \<open>\<stileturn> Neg (subst A t 0) # G \<Longrightarrow> \<stileturn> Neg (Exists A) # G\<close>
 | DeltaExists: \<open>\<stileturn> subst A (App n []) 0 # G \<Longrightarrow> news n (A # G) \<Longrightarrow> \<stileturn> Exists A # G\<close>
 | DeltaNegForall: \<open>\<stileturn> Neg (subst A (App n []) 0) # G \<Longrightarrow> news n (A # G) \<Longrightarrow> \<stileturn> Neg (Forall A) # G\<close>
 | Order: \<open>\<stileturn> G \<Longrightarrow> set G = set G' \<Longrightarrow> \<stileturn> G'\<close>
 
 lemma Shift: \<open>\<stileturn> rotate1 G \<Longrightarrow> \<stileturn> G\<close>
   by (simp add: Order)
 
 lemma Swap: \<open>\<stileturn> B # A # G \<Longrightarrow> \<stileturn> A # B # G\<close>
   by (simp add: Order insert_commute)
 
 definition tableauproof :: \<open>('a, 'b) form list \<Rightarrow> ('a, 'b) form \<Rightarrow> bool\<close> where
   \<open>tableauproof ps p \<equiv> (\<stileturn> Neg p # ps)\<close>
 
 theorem tableauNotAA: \<open>\<stileturn> [Neg (Pred ''A'' []), Pred ''A'' []]\<close>
   by (rule Shift, simp) (rule Basic)
 
 theorem AndAnd:
   \<open>\<stileturn> [And (Pred ''A'' []) (Pred ''B'' []), Neg (And (Pred ''B'' []) (Pred ''A'' []))]\<close>
   apply (rule AlphaAnd)
   apply (rule Shift, rule Shift, simp)
   apply (rule BetaNegAnd)
    apply (rule Shift, rule Shift, simp)
    apply (rule Basic)
   apply (rule Swap)
   apply (rule Basic)
   done
 
 subsection \<open>Soundness\<close>
 
 lemma TC_soundness:
   \<open>\<stileturn> G \<Longrightarrow> \<exists>p \<in> set G. \<not> eval e f g p\<close>
 proof (induct G arbitrary: f rule: TC.induct)
   case (DeltaExists A n G)
   show ?case
   proof (rule ccontr)
     assume \<open>\<not> (\<exists>p \<in> set (Exists A # G). \<not> eval e f g p)\<close>
     then have *: \<open>\<forall>p \<in> set (Exists A # G). eval e f g p\<close>
       by simp
 
     then obtain x where \<open>eval (shift e 0 x) (f(n := \<lambda>w. x)) g A\<close>
       using \<open>news n (A # G)\<close> by auto
     then have **: \<open>eval e (f(n := \<lambda>w. x)) g (subst A (App n []) 0)\<close>
       by simp
 
     have \<open>\<exists>p \<in> set (subst A (App n []) 0 # G). \<not> eval e (f(n := \<lambda>w. x)) g p\<close>
       using DeltaExists by fast
     then consider
       \<open>\<not> eval e (f(n := \<lambda>w. x)) g (subst A (App n []) 0)\<close> |
       \<open>\<exists>p \<in> set G. \<not> eval e (f(n := \<lambda>w. x)) g p\<close>
       by auto
     then show False
     proof cases
       case 1
       then show ?thesis
         using ** ..
     next
       case 2
       then obtain p where \<open>\<not> eval e (f(n := \<lambda>w. x)) g p\<close> \<open>p \<in> set G\<close>
         by blast
       then have \<open>\<not> eval e f g p\<close>
         using \<open>news n (A # G)\<close> by (metis Ball_set set_subset_Cons subsetCE upd_lemma)
       then show ?thesis
         using * \<open>p \<in> set G\<close> by simp
     qed
   qed
 next
   case (DeltaNegForall A n G)
   show ?case
   proof (rule ccontr)
     assume \<open>\<not> (\<exists>p \<in> set (Neg (Forall A) # G). \<not> eval e f g p)\<close>
     then have *: \<open>\<forall>p \<in> set (Neg (Forall A) # G). eval e f g p\<close>
       by simp
 
     then obtain x where \<open>eval (shift e 0 x) (f(n := \<lambda>w. x)) g (Neg A)\<close>
       using \<open>news n (A # G)\<close> by auto
     then have **: \<open>eval e (f(n := \<lambda>w. x)) g (Neg (subst A (App n []) 0))\<close>
       by simp
 
     have \<open>\<exists>p \<in> set (Neg (subst A (App n []) 0) # G). \<not> eval e (f(n := \<lambda>w. x)) g p\<close>
       using DeltaNegForall by fast
     then consider
       \<open>\<not> eval e (f(n := \<lambda>w. x)) g (Neg (subst A (App n []) 0))\<close> |
       \<open>\<exists>p \<in> set G. \<not> eval e (f(n := \<lambda>w. x)) g p\<close>
       by auto
     then show False
     proof cases
       case 1
       then show ?thesis
         using ** ..
     next
       case 2
       then obtain p where \<open>\<not> eval e (f(n := \<lambda>w. x)) g p\<close> \<open>p \<in> set G\<close>
         by blast
       then have \<open>\<not> eval e f g p\<close>
         using \<open>news n (A # G)\<close> by (metis Ball_set set_subset_Cons subsetCE upd_lemma)
       then show ?thesis
         using * \<open>p \<in> set G\<close> by simp
     qed
   qed
 qed auto
 
 theorem tableau_soundness:
   \<open>tableauproof ps p \<Longrightarrow> list_all (eval e f g) ps \<Longrightarrow> eval e f g p\<close>
   using TC_soundness unfolding tableauproof_def list_all_def by fastforce
 
 subsection \<open>Completeness for Closed Formulas\<close>
 
 theorem infinite_nonempty: \<open>infinite A \<Longrightarrow> \<exists>x. x \<in> A\<close>
   by (simp add: ex_in_conv infinite_imp_nonempty)
 
 theorem TCd_consistency:
   assumes inf_param: \<open>infinite (UNIV::'a set)\<close>
   shows \<open>consistency {S::('a, 'b) form set. \<exists>G. S = set G \<and> \<not> (\<stileturn> G)}\<close>
   unfolding consistency_def
 proof (intro conjI allI impI notI)
   fix S :: \<open>('a, 'b) form set\<close>
   assume \<open>S \<in> {set G | G. \<not> (\<stileturn> G)}\<close> (is \<open>S \<in> ?C\<close>)
   then obtain G :: \<open>('a, 'b) form list\<close>
     where *: \<open>S = set G\<close> and \<open>\<not> (\<stileturn> G)\<close>
     by blast
 
   { fix p ts
     assume \<open>Pred p ts \<in> S \<and> Neg (Pred p ts) \<in> S\<close>
     then show False
       using * Basic Order \<open>\<not> (\<stileturn> G)\<close> by fastforce }
 
   { assume \<open>\<bottom> \<in> S\<close>
     then show False
       using * BasicFF Order \<open>\<not> (\<stileturn> G)\<close> by fastforce }
 
   { assume \<open>Neg \<top> \<in> S\<close>
     then show False
       using * BasicNegTT Order \<open>\<not> (\<stileturn> G)\<close> by fastforce }
 
   { fix Z
     assume \<open>Neg (Neg Z) \<in> S\<close>
     then have \<open>\<not> (\<stileturn> Z # G)\<close>
       using * AlphaNegNeg Order \<open>\<not> (\<stileturn> G)\<close>
       by (metis insert_absorb list.set(2))
     moreover have \<open>S \<union> {Z} = set (Z # G)\<close>
       using * by simp
     ultimately show \<open>S \<union> {Z} \<in> ?C\<close>
       by blast }
 
   { fix A B
     assume \<open>And A B \<in> S\<close>
     then have \<open>\<not> (\<stileturn> A # B # G)\<close>
       using * AlphaAnd Order \<open>\<not> (\<stileturn> G)\<close>
       by (metis insert_absorb list.set(2))
     moreover have \<open>S \<union> {A, B} = set (A # B # G)\<close>
       using * by simp
     ultimately show \<open>S \<union> {A, B} \<in> ?C\<close>
       by blast }
 
   { fix A B
     assume \<open>Neg (Or A B) \<in> S\<close>
     then have \<open>\<not> (\<stileturn> Neg A # Neg B # G)\<close>
       using * AlphaNegOr Order \<open>\<not> (\<stileturn> G)\<close>
       by (metis insert_absorb list.set(2))
     moreover have \<open>S \<union> {Neg A, Neg B} = set (Neg A # Neg B # G)\<close>
       using * by simp
     ultimately show \<open>S \<union> {Neg A, Neg B} \<in> ?C\<close>
       by blast }
 
   { fix A B
     assume \<open>Neg (Impl A B) \<in> S\<close>
     then have \<open>\<not> (\<stileturn> A # Neg B # G)\<close>
       using * AlphaNegImpl Order \<open>\<not> (\<stileturn> G)\<close>
       by (metis insert_absorb list.set(2))
     moreover have \<open>{A, Neg B} \<union> S = set (A # Neg B # G)\<close>
       using * by simp
     ultimately show \<open>S \<union> {A, Neg B} \<in> ?C\<close>
       by blast }
 
   { fix A B
     assume \<open>Or A B \<in> S\<close>
     then have \<open>\<not> (\<stileturn> A # G) \<or> \<not> (\<stileturn> B # G)\<close>
       using * BetaOr Order \<open>\<not> (\<stileturn> G)\<close>
       by (metis insert_absorb list.set(2))
     then show \<open>S \<union> {A} \<in> ?C \<or> S \<union> {B} \<in> ?C\<close>
       using * by auto }
 
   { fix A B
     assume \<open>Neg (And A B) \<in> S\<close>
     then have \<open>\<not> (\<stileturn> Neg A # G) \<or> \<not> (\<stileturn> Neg B # G)\<close>
       using * BetaNegAnd Order \<open>\<not> (\<stileturn> G)\<close>
       by (metis insert_absorb list.set(2))
     then show \<open>S \<union> {Neg A} \<in> ?C \<or> S \<union> {Neg B} \<in> ?C\<close>
       using * by auto }
 
   { fix A B
     assume \<open>Impl A B \<in> S\<close>
     then have \<open>\<not> (\<stileturn> Neg A # G) \<or> \<not> (\<stileturn> B # G)\<close>
       using * BetaImpl Order \<open>\<not> (\<stileturn> G)\<close>
       by (metis insert_absorb list.set(2))
     then show \<open>S \<union> {Neg A} \<in> ?C \<or> S \<union> {B} \<in> ?C\<close>
       using * by auto }
 
   { fix P and t :: \<open>'a term\<close>
     assume \<open>Forall P \<in> S\<close>
     then have \<open>\<not> (\<stileturn> subst P t 0 # G)\<close>
       using * GammaForall Order\<open>\<not> (\<stileturn> G)\<close>
       by (metis insert_absorb list.set(2))
     moreover have \<open>S \<union> {subst P t 0} = set (subst P t 0 # G)\<close>
       using * by simp
     ultimately show \<open>S \<union> {subst P t 0} \<in> ?C\<close>
       by blast }
 
   { fix P and t :: \<open>'a term\<close>
     assume \<open>Neg (Exists P) \<in> S\<close>
     then have \<open>\<not> (\<stileturn> Neg (subst P t 0) # G)\<close>
       using * GammaNegExists Order \<open>\<not> (\<stileturn> G)\<close>
       by (metis insert_absorb list.set(2))
     moreover have \<open>S \<union> {Neg (subst P t 0)} = set (Neg (subst P t 0) # G)\<close>
       using * by simp
     ultimately show \<open>S \<union> {Neg (subst P t 0)} \<in> ?C\<close>
       by blast }
 
   { fix P
     assume \<open>Exists P \<in> S\<close>
     have \<open>finite ((\<Union>p \<in> set G. params p) \<union> params P)\<close>
       by simp
     then have \<open>infinite (- ((\<Union>p \<in> set G. params p) \<union> params P))\<close>
       using inf_param Diff_infinite_finite finite_compl infinite_UNIV_listI by blast
     then obtain x where **: \<open>x \<in> - ((\<Union>p \<in> set G. params p) \<union> params P)\<close>
       using infinite_imp_nonempty by blast
     then have \<open>news x (P # G)\<close>
       using Ball_set_list_all by auto
     then have \<open>\<not> (\<stileturn> subst P (App x []) 0 # G)\<close>
       using * \<open>Exists P \<in> S\<close> Order DeltaExists \<open>\<not> (\<stileturn> G)\<close>
       by (metis insert_absorb list.set(2))
     moreover have \<open>S \<union> {subst P (App x []) 0} = set (subst P (App x []) 0 # G)\<close>
       using * by simp
     ultimately show \<open>\<exists>x. S \<union> {subst P (App x []) 0} \<in> ?C\<close>
       by blast }
 
   { fix P
     assume \<open>Neg (Forall P) \<in> S\<close>
     have \<open>finite ((\<Union>p \<in> set G. params p) \<union> params P)\<close>
       by simp
     then have \<open>infinite (- ((\<Union>p \<in> set G. params p) \<union> params P))\<close>
       using inf_param Diff_infinite_finite finite_compl infinite_UNIV_listI by blast
     then obtain x where **: \<open>x \<in> - ((\<Union>p \<in> set G. params p) \<union> params P)\<close>
       using infinite_imp_nonempty by blast
     then have \<open>news x (P # G)\<close>
       using Ball_set_list_all by auto
     then have \<open>\<not> (\<stileturn> Neg (subst P (App x []) 0) # G)\<close>
       using * \<open>Neg (Forall P) \<in> S\<close> Order DeltaNegForall \<open>\<not> (\<stileturn> G)\<close>
       by (metis insert_absorb list.set(2))
     moreover have \<open>S \<union> {Neg (subst P (App x []) 0)} = set (Neg (subst P (App x []) 0) # G)\<close>
       using * by simp
     ultimately show \<open>\<exists>x. S \<union> {Neg (subst P (App x []) 0)} \<in> ?C\<close>
       by blast }
 qed
 
 theorem tableau_completeness':
   fixes p :: \<open>(nat, nat) form\<close>
   assumes \<open>closed 0 p\<close>
     and \<open>list_all (closed 0) ps\<close>
     and mod: \<open>\<forall>(e :: nat \<Rightarrow> nat hterm) f g. list_all (eval e f g) ps \<longrightarrow> eval e f g p\<close>
   shows \<open>tableauproof ps p\<close>
 proof (rule ccontr)
   fix e
   assume \<open>\<not> tableauproof ps p\<close>
 
   let ?S = \<open>set (Neg p # ps)\<close>
   let ?C = \<open>{set (G :: (nat, nat) form list) | G. \<not> (\<stileturn> G)}\<close>
   let ?f = HApp
   let ?g = \<open>(\<lambda>a ts. Pred a (terms_of_hterms ts) \<in> Extend ?S
               (mk_finite_char (mk_alt_consistency (close ?C))) from_nat)\<close>
 
   from \<open>list_all (closed 0) ps\<close>
   have \<open>\<forall>p \<in> set ps. closed 0 p\<close>
     by (simp add: list_all_iff)
 
   { fix x
     assume \<open>x \<in> ?S\<close>
     moreover have \<open>consistency ?C\<close>
       using TCd_consistency by blast
     moreover have \<open>?S \<in> ?C\<close>
       using \<open>\<not> tableauproof ps p\<close> unfolding tableauproof_def by blast
     moreover have \<open>infinite (- (\<Union>p \<in> ?S. params p))\<close>
       by (simp add: Compl_eq_Diff_UNIV infinite_UNIV_listI)
     moreover note \<open>closed 0 p\<close> \<open>\<forall>p \<in> set ps. closed 0 p\<close> \<open>x \<in> ?S\<close>
     then have \<open>closed 0 x\<close> by auto
     ultimately have \<open>eval e ?f ?g x\<close>
       using model_existence by blast }
   then have \<open>list_all (eval e ?f ?g) (Neg p # ps)\<close>
     by (simp add: list_all_iff)
   moreover have \<open>eval e ?f ?g (Neg p)\<close>
     using calculation by simp
   moreover have \<open>list_all (eval e ?f ?g) ps\<close>
     using calculation by simp
   then have \<open>eval e ?f ?g p\<close>
     using mod by blast
   ultimately show False by simp
 qed
 
 subsection \<open>Open Formulas\<close>
 
 lemma TC_psubst:
   fixes f :: \<open>'a \<Rightarrow> 'a\<close>
   assumes inf_params: \<open>infinite (UNIV :: 'a set)\<close>
   shows \<open>\<stileturn> G \<Longrightarrow> \<stileturn> map (psubst f) G\<close>
 proof (induct G arbitrary: f rule: TC.induct)
   case (DeltaExists A n G)
   let ?params = \<open>params A \<union> (\<Union>p \<in> set G. params p)\<close>
 
   have \<open>finite ?params\<close>
     by simp
   then obtain fresh where *: \<open>fresh \<notin> ?params \<union> {n} \<union> image f ?params\<close>
     using ex_new_if_finite inf_params
     by (metis finite.emptyI finite.insertI finite_UnI finite_imageI)
 
   let ?f = \<open>f(n := fresh)\<close>
 
   have \<open>news n (A # G)\<close>
     using DeltaExists by blast
   then have \<open>new fresh (psubst ?f A)\<close> \<open>news fresh (map (psubst ?f) G)\<close>
     using * new_psubst_image news_psubst by (fastforce simp add: image_Un)+
   then have G: \<open>map (psubst ?f) G = map (psubst f) G\<close>
     using DeltaExists
     by (metis (mono_tags, lifting) Ball_set insertCI list.set(2) map_eq_conv psubst_upd)
 
   have \<open>\<stileturn> psubst ?f (subst A (App n []) 0) # map (psubst ?f) G\<close>
     using DeltaExists by (metis list.simps(9))
   then have \<open>\<stileturn> subst (psubst ?f A) (App fresh []) 0 # map (psubst ?f) G\<close>
     by simp
   moreover have \<open>news fresh (map (psubst ?f) (A # G))\<close>
     using \<open>new fresh (psubst ?f A)\<close> \<open>news fresh (map (psubst ?f) G)\<close> by simp
   then have \<open>news fresh (psubst ?f A # map (psubst ?f) G)\<close>
     by simp
   ultimately have \<open>\<stileturn> map (psubst ?f) (Exists A # G)\<close>
     using TC.DeltaExists by fastforce
   then show ?case
     using DeltaExists G by simp
 next
   case (DeltaNegForall A n G)
   let ?params = \<open>params A \<union> (\<Union>p \<in> set G. params p)\<close>
 
   have \<open>finite ?params\<close>
     by simp
   then obtain fresh where *: \<open>fresh \<notin> ?params \<union> {n} \<union> image f ?params\<close>
     using ex_new_if_finite inf_params
     by (metis finite.emptyI finite.insertI finite_UnI finite_imageI)
 
   let ?f = \<open>f(n := fresh)\<close>
 
   have \<open>news n (A # G)\<close>
     using DeltaNegForall by blast
   then have \<open>new fresh (psubst ?f A)\<close> \<open>news fresh (map (psubst ?f) G)\<close>
     using * new_psubst_image news_psubst by (fastforce simp add: image_Un)+
   then have G: \<open>map (psubst ?f) G = map (psubst f) G\<close>
     using DeltaNegForall
     by (metis (mono_tags, lifting) Ball_set insertCI list.set(2) map_eq_conv psubst_upd)
 
   have \<open>\<stileturn> psubst ?f (Neg (subst A (App n []) 0)) # map (psubst ?f) G\<close>
     using DeltaNegForall by (metis list.simps(9))
   then have \<open>\<stileturn> Neg (subst (psubst ?f A) (App fresh []) 0) # map (psubst ?f) G\<close>
     by simp
   moreover have \<open>news fresh (map (psubst ?f) (A # G))\<close>
     using \<open>new fresh (psubst ?f A)\<close> \<open>news fresh (map (psubst ?f) G)\<close> by simp
   then have \<open>news fresh (psubst ?f A # map (psubst ?f) G)\<close>
     by simp
   ultimately have \<open>\<stileturn> map (psubst ?f) (Neg (Forall A) # G)\<close>
     using TC.DeltaNegForall by fastforce
   then show ?case
     using DeltaNegForall G by simp
 next
   case (Order G G')
   then show ?case
     using Order TC.Order set_map by metis
 qed (auto intro: TC.intros)
 
 lemma subcs_map: \<open>subcs c s G = map (subc c s) G\<close>
   by (induct G) simp_all
 
 lemma TC_subcs:
   fixes G :: \<open>('a, 'b) form list\<close>
   assumes inf_params: \<open>infinite (UNIV :: 'a set)\<close>
   shows \<open>\<stileturn> G \<Longrightarrow> \<stileturn> subcs c s G\<close>
 proof (induct G arbitrary: c s rule: TC.induct)
   case (GammaForall A t G)
   let ?params = \<open>params A \<union> (\<Union>p \<in> set G. params p) \<union> paramst s \<union> paramst t \<union> {c}\<close>
 
   have \<open>finite ?params\<close>
     by simp
   then obtain fresh where fresh: \<open>fresh \<notin> ?params\<close>
     using ex_new_if_finite inf_params by metis
 
   let ?f = \<open>id(c := fresh)\<close>
   let ?g = \<open>id(fresh := c)\<close>
   let ?s = \<open>psubstt ?f s\<close>
 
   have s: \<open>psubstt ?g ?s = s\<close>
     using fresh psubst_new_away' by simp
   have \<open>subc (?g c) (psubstt ?g ?s) (psubst ?g (Forall A)) = subc c s (Forall A)\<close>
     using fresh by simp
   then have A: \<open>psubst ?g (subc c ?s (Forall A)) = subc c s (Forall A)\<close>
     using fun_upd_apply id_def subc_psubst UnCI fresh params.simps(8) by metis
   have \<open>\<forall>x \<in> (\<Union>p \<in> set (Forall A # G). params p). x \<noteq> c \<longrightarrow> ?g x \<noteq> ?g c\<close>
     using fresh by auto
   moreover have \<open>map (psubst ?g) (Forall A # G) = Forall A # G\<close>
     using fresh by (induct G) simp_all
   ultimately have G: \<open>map (psubst ?g) (subcs c ?s (Forall A # G)) = subcs c s (Forall A # G)\<close>
     using s A by (simp add: subcs_psubst)
 
   have \<open>new_term c ?s\<close>
     using fresh psubst_new_free' by fast
   then have \<open>\<stileturn> subc c ?s (subst A (subc_term c ?s t) 0) # subcs c ?s G\<close>
     using GammaForall by (metis new_subc_put subcs.simps(2))
   moreover have \<open>new_term c (subc_term c ?s t)\<close>
     using \<open>new_term c ?s\<close> new_subc_same' by simp
   ultimately have \<open>\<stileturn> subst (subc c (liftt ?s) A) (subc_term c ?s t) 0 # subcs c ?s G\<close>
     by simp
   moreover have \<open>Forall (subc c (liftt ?s) A) \<in> set (subcs c ?s (Forall A # G))\<close>
     by simp
   ultimately have \<open>\<stileturn> subcs c ?s (Forall A # G)\<close>
     using TC.GammaForall by simp
   then have \<open>\<stileturn> map (psubst ?g) (subcs c ?s (Forall A # G))\<close>
     using TC_psubst inf_params by blast
   then show \<open>\<stileturn> subcs c s (Forall A # G)\<close>
     using G by simp
 next
   case (GammaNegExists A t G)
   let ?params = \<open>params A \<union> (\<Union>p \<in> set G. params p) \<union> paramst s \<union> paramst t \<union> {c}\<close>
 
   have \<open>finite ?params\<close>
     by simp
   then obtain fresh where fresh: \<open>fresh \<notin> ?params\<close>
     using ex_new_if_finite inf_params by metis
 
   let ?f = \<open>id(c := fresh)\<close>
   let ?g = \<open>id(fresh := c)\<close>
   let ?s = \<open>psubstt ?f s\<close>
 
   have s: \<open>psubstt ?g ?s = s\<close>
     using fresh psubst_new_away' by simp
   have \<open>subc (?g c) (psubstt ?g ?s) (psubst ?g (Neg (Exists A))) = subc c s (Neg (Exists A))\<close>
     using fresh by simp
   then have A: \<open>psubst ?g (subc c ?s (Neg (Exists A))) = subc c s (Neg (Exists A))\<close>
     using fun_upd_apply id_def subc_psubst UnCI fresh params.simps(7,9) by metis
 
   have \<open>\<forall>x \<in> (\<Union>p \<in> set (Neg (Exists A) # G). params p). x \<noteq> c \<longrightarrow> ?g x \<noteq> ?g c\<close>
     using fresh by auto
   moreover have \<open>map (psubst ?g) (Neg (Exists A) # G) = Neg (Exists A) # G\<close>
     using fresh by (induct G) simp_all
   ultimately have G: \<open>map (psubst ?g) (subcs c ?s (Neg (Exists A) # G)) =
       subcs c s (Neg (Exists A) # G)\<close>
     using s A by (simp add: subcs_psubst)
 
   have \<open>new_term c ?s\<close>
     using fresh psubst_new_free' by fast
   then have \<open>\<stileturn> Neg (subc c ?s (subst A (subc_term c ?s t) 0)) # subcs c ?s G\<close>
     using GammaNegExists by (metis new_subc_put subc.simps(4) subcs.simps(2))
   moreover have \<open>new_term c (subc_term c ?s t)\<close>
     using \<open>new_term c ?s\<close> new_subc_same' by simp
   ultimately have \<open>\<stileturn> Neg (subst (subc c (liftt ?s) A) (subc_term c ?s t) 0) # subcs c ?s G\<close>
     by simp
   moreover have \<open>Neg (Exists (subc c (liftt ?s) A)) \<in> set (subcs c ?s (Neg (Exists A) # G))\<close>
     by simp
   ultimately have \<open>\<stileturn> subcs c ?s (Neg (Exists A) # G)\<close>
     using TC.GammaNegExists by simp
   then have \<open>\<stileturn> map (psubst ?g) (subcs c ?s (Neg (Exists A) # G))\<close>
     using TC_psubst inf_params by blast
   then show \<open>\<stileturn> subcs c s (Neg (Exists A) # G)\<close>
     using G by simp
 next
   case (DeltaExists A n G)
   then show ?case
   proof (cases \<open>c = n\<close>)
     case True
     then have \<open>\<stileturn> Exists A # G\<close>
       using DeltaExists TC.DeltaExists by metis
     moreover have \<open>new c A\<close> and \<open>news c G\<close>
       using DeltaExists True by simp_all
     ultimately show ?thesis
       by (simp add: subcs_news)
   next
     case False
     let ?params = \<open>params A \<union> (\<Union>p \<in> set G. params p) \<union> paramst s \<union> {c} \<union> {n}\<close>
 
     have \<open>finite ?params\<close>
       by simp
     then obtain fresh where fresh: \<open>fresh \<notin> ?params\<close>
       using ex_new_if_finite inf_params by metis
 
     let ?s = \<open>psubstt (id(n := fresh)) s\<close>
     let ?f = \<open>id(n := fresh, fresh := n)\<close>
 
     have f: \<open>\<forall>x \<in> ?params. x \<noteq> c \<longrightarrow> ?f x \<noteq> ?f c\<close>
       using fresh by simp
 
     have \<open>new_term n ?s\<close>
       using fresh psubst_new_free' by fast
     then have \<open>psubstt ?f ?s = psubstt (id(fresh := n)) ?s\<close>
       by (metis fun_upd_twist psubstt_upd(1))
     then have psubst_s: \<open>psubstt ?f ?s = s\<close>
       using fresh psubst_new_away' by simp
 
     have \<open>?f c = c\<close> and \<open>new_term c (App fresh [])\<close>
       using False fresh by auto
 
     have \<open>psubst ?f (subc c ?s (subst A (App n []) 0)) =
       subc (?f c) (psubstt ?f ?s) (psubst ?f (subst A (App n []) 0))\<close>
       by (simp add: subc_psubst)
     also have \<open>\<dots> = subc c s (subst (psubst ?f A) (App fresh []) 0)\<close>
       using \<open>?f c = c\<close> psubst_subst psubst_s by simp
     also have \<open>\<dots> = subc c s (subst A (App fresh []) 0)\<close>
       using DeltaExists fresh by simp
     finally have psubst_A: \<open>psubst ?f (subc c ?s (subst A (App n []) 0)) =
         subst (subc c (liftt s) A) (App fresh []) 0\<close>
       using \<open>new_term c (App fresh [])\<close> by simp
 
     have \<open>news n G\<close>
       using DeltaExists by simp
     moreover have \<open>news fresh G\<close>
       using fresh by (induct G) simp_all
     ultimately have \<open>map (psubst ?f) G = G\<close>
       by (induct G) simp_all
     moreover have \<open>\<forall>x \<in> \<Union>p \<in> set G. params p. x \<noteq> c \<longrightarrow> ?f x \<noteq> ?f c\<close>
       by auto
     ultimately have psubst_G: \<open>map (psubst ?f) (subcs c ?s G) = subcs c s G\<close>
       using \<open>?f c = c\<close> psubst_s by (simp add: subcs_psubst)
 
     have \<open>\<stileturn> subc c ?s (subst A (App n []) 0) # subcs c ?s G\<close>
       using DeltaExists by simp
     then have \<open>\<stileturn> psubst ?f (subc c ?s (subst A (App n []) 0)) # map (psubst ?f) (subcs c ?s G)\<close>
       using TC_psubst inf_params DeltaExists.hyps(3) by fastforce
     then have \<open>\<stileturn> psubst ?f (subc c ?s (subst A (App n []) 0)) # subcs c s G\<close>
       using psubst_G by simp
     then have sub_A: \<open>\<stileturn> subst (subc c (liftt s) A) (App fresh []) 0 # subcs c s G\<close>
       using psubst_A by simp
 
     have \<open>new_term fresh s\<close>
       using fresh by simp
     then have \<open>new_term fresh (liftt s)\<close>
       by simp
     then have \<open>new fresh (subc c (liftt s) A)\<close>
       using fresh new_subc by simp
     moreover have \<open>news fresh (subcs c s G)\<close>
       using \<open>news fresh G\<close> \<open>new_term fresh s\<close> news_subcs by fast
     ultimately show \<open>\<stileturn> subcs c s (Exists A # G)\<close>
       using TC.DeltaExists sub_A by fastforce
   qed
 next
   case (DeltaNegForall A n G)
   then show ?case
   proof (cases \<open>c = n\<close>)
     case True
     then have \<open>\<stileturn> Neg (Forall A) # G\<close>
       using DeltaNegForall TC.DeltaNegForall by metis
     moreover have \<open>new c A\<close> and \<open>news c G\<close>
       using DeltaNegForall True by simp_all
     ultimately show ?thesis
       by (simp add: subcs_news)
   next
     case False
     let ?params = \<open>params A \<union> (\<Union>p \<in> set G. params p) \<union> paramst s \<union> {c} \<union> {n}\<close>
 
     have \<open>finite ?params\<close>
       by simp
     then obtain fresh where fresh: \<open>fresh \<notin> ?params\<close>
       using ex_new_if_finite inf_params by metis
 
     let ?s = \<open>psubstt (id(n := fresh)) s\<close>
     let ?f = \<open>id(n := fresh, fresh := n)\<close>
 
     have f: \<open>\<forall>x \<in> ?params. x \<noteq> c \<longrightarrow> ?f x \<noteq> ?f c\<close>
       using fresh by simp
 
     have \<open>new_term n ?s\<close>
       using fresh psubst_new_free' by fast
     then have \<open>psubstt ?f ?s = psubstt (id(fresh := n)) ?s\<close>
       using fun_upd_twist psubstt_upd(1) by metis
     then have psubst_s: \<open>psubstt ?f ?s = s\<close>
       using fresh psubst_new_away' by simp
 
     have \<open>?f c = c\<close> and \<open>new_term c (App fresh [])\<close>
       using False fresh by auto
 
     have \<open>psubst ?f (subc c ?s (Neg (subst A (App n []) 0))) =
       subc (?f c) (psubstt ?f ?s) (psubst ?f (Neg (subst A (App n []) 0)))\<close>
       by (simp add: subc_psubst)
     also have \<open>\<dots> = subc c s (Neg (subst (psubst ?f A)(App fresh []) 0))\<close>
       using \<open>?f c = c\<close> psubst_subst psubst_s by simp
     also have \<open>\<dots> = subc c s (Neg (subst A (App fresh []) 0))\<close>
       using DeltaNegForall fresh by simp
     finally have psubst_A: \<open>psubst ?f (subc c ?s (Neg (subst A (App n []) 0))) =
         Neg (subst (subc c (liftt s) A) (App fresh []) 0)\<close>
       using \<open>new_term c (App fresh [])\<close> by simp
 
     have \<open>news n G\<close>
       using DeltaNegForall by simp
     moreover have \<open>news fresh G\<close>
       using fresh by (induct G) simp_all
     ultimately have \<open>map (psubst ?f) G = G\<close>
       by (induct G) simp_all
     moreover have \<open>\<forall>x \<in> \<Union>p \<in> set G. params p. x \<noteq> c \<longrightarrow> ?f x \<noteq> ?f c\<close>
       by auto
     ultimately have psubst_G: \<open>map (psubst ?f) (subcs c ?s G) = subcs c s G\<close>
       using \<open>?f c = c\<close> psubst_s by (simp add: subcs_psubst)
 
     have \<open>\<stileturn> subc c ?s (Neg (subst A (App n []) 0)) # subcs c ?s G\<close>
       using DeltaNegForall by simp
     then have \<open>\<stileturn> psubst ?f (subc c ?s (Neg (subst A (App n []) 0)))
                 # map (psubst ?f) (subcs c ?s G)\<close>
       using TC_psubst inf_params DeltaNegForall.hyps(3) by fastforce
     then have \<open>\<stileturn> psubst ?f (subc c ?s (Neg (subst A (App n []) 0))) # subcs c s G\<close>
       using psubst_G by simp
     then have sub_A: \<open>\<stileturn> Neg (subst (subc c (liftt s) A) (App fresh []) 0) # subcs c s G\<close>
       using psubst_A by simp
 
     have \<open>new_term fresh s\<close>
       using fresh by simp
     then have \<open>new_term fresh (liftt s)\<close>
       by simp
     then have \<open>new fresh (subc c (liftt s) A)\<close>
       using fresh new_subc by simp
     moreover have \<open>news fresh (subcs c s G)\<close>
       using \<open>news fresh G\<close> \<open>new_term fresh s\<close> news_subcs by fast
     ultimately show \<open>\<stileturn> subcs c s (Neg (Forall A) # G)\<close>
       using TC.DeltaNegForall sub_A by fastforce
   qed
 next
   case (Order G G')
   then show ?case
     using TC.Order set_map subcs_map by metis
 qed (auto intro: TC.intros)
 
 lemma TC_map_subc:
   fixes G :: \<open>('a, 'b) form list\<close>
   assumes inf_params: \<open>infinite (UNIV :: 'a set)\<close>
   shows \<open>\<stileturn> G \<Longrightarrow> \<stileturn> map (subc c s) G\<close>
   using assms TC_subcs subcs_map by metis
 
 lemma ex_all_closed: \<open>\<exists>m. list_all (closed m) G\<close>
 proof (induct G)
   case Nil
   then show ?case
     by simp
 next
   case (Cons a G)
   then show ?case
     unfolding list_all_def
     using ex_closed closed_mono
     by (metis Ball_set list_all_simps(1) nat_le_linear)
 qed
 
 primrec sub_consts :: \<open>'a list \<Rightarrow> ('a, 'b) form \<Rightarrow> ('a, 'b) form\<close> where
   \<open>sub_consts [] p = p\<close>
 | \<open>sub_consts (c # cs) p = sub_consts cs (subst p (App c []) (length cs))\<close>
 
 lemma valid_sub_consts:
   assumes \<open>\<forall>(e :: nat \<Rightarrow> 'a) f g. eval e f g p\<close>
   shows \<open>eval (e :: nat => 'a) f g (sub_consts cs p)\<close>
   using assms by (induct cs arbitrary: p) simp_all
 
 lemma closed_sub' [simp]:
   assumes \<open>k \<le> m\<close> shows
     \<open>closedt (Suc m) t = closedt m (substt t (App c []) k)\<close>
     \<open>closedts (Suc m) l = closedts m (substts l (App c []) k)\<close>
   using assms by (induct t and l rule: closedt.induct closedts.induct) auto
 
 lemma closed_sub: \<open>k \<le> m \<Longrightarrow> closed (Suc m) p = closed m (subst p (App c []) k)\<close>
   by (induct p arbitrary: m k) simp_all
 
 lemma closed_sub_consts: \<open>length cs = k \<Longrightarrow> closed m (sub_consts cs p) = closed (m + k) p\<close>
 proof (induct cs arbitrary: k p)
   case Nil
   then show ?case
     by simp
 next
   case (Cons c cs)
   then show ?case
     using closed_sub by fastforce
 qed
 
 lemma map_sub_consts_Nil: \<open>map (sub_consts []) G = G\<close>
   by (induct G) simp_all
 
 primrec conjoin :: \<open>('a, 'b) form list \<Rightarrow> ('a, 'b) form\<close> where
   \<open>conjoin [] = Neg \<bottom>\<close>
 | \<open>conjoin (p # ps) = And p (conjoin ps)\<close>
 
 lemma eval_conjoin: \<open>list_all (eval e f g) G = eval e f g (conjoin G)\<close>
   by (induct G) simp_all
 
 lemma valid_sub:
   fixes e :: \<open>nat \<Rightarrow> 'a\<close>
   assumes \<open>\<forall>(e :: nat \<Rightarrow> 'a) f g. eval e f g p \<longrightarrow> eval e f g q\<close>
   shows \<open>eval e f g (subst p t m) \<longrightarrow> eval e f g (subst q t m)\<close>
   using assms by simp
 
 lemma eval_sub_consts:
   fixes e :: \<open>nat \<Rightarrow> 'a\<close>
   assumes \<open>\<forall>(e :: nat \<Rightarrow> 'a) f g. eval e f g p \<longrightarrow> eval e f g q\<close>
     and \<open>eval e f g (sub_consts cs p)\<close>
   shows \<open>eval e f g (sub_consts cs q)\<close>
   using assms
 proof (induct cs arbitrary: p q)
   case Nil
   then show ?case
     by simp
 next
   case (Cons c cs)
   then show ?case
     by (metis sub_consts.simps(2) subst_lemma)
 qed
 
 lemma sub_consts_And [simp]: \<open>sub_consts cs (And p q) = And (sub_consts cs p) (sub_consts cs q)\<close>
   by (induct cs arbitrary: p q) simp_all
 
 lemma sub_consts_conjoin:
   \<open>eval e f g (sub_consts cs (conjoin G)) = eval e f g (conjoin (map (sub_consts cs) G))\<close>
 proof (induct G)
   case Nil
   then show ?case
     by (induct cs) simp_all
 next
   case (Cons p G)
   then show ?case
     using sub_consts_And by simp
 qed
 
 lemma all_sub_consts_conjoin:
   \<open>list_all (eval e f g) (map (sub_consts cs) G) = eval e f g (sub_consts cs (conjoin G))\<close>
   by (induct G) (simp_all add: valid_sub_consts)
 
 lemma valid_all_sub_consts:
   fixes e :: \<open>nat \<Rightarrow> 'a\<close>
   assumes \<open>\<forall>(e :: nat \<Rightarrow> 'a) f g. list_all (eval e f g) G \<longrightarrow> eval e f g p\<close>
   shows \<open>list_all (eval e f g) (map (sub_consts cs) G) \<longrightarrow> eval e f g (sub_consts cs p)\<close>
   using assms eval_conjoin eval_sub_consts all_sub_consts_conjoin by metis
 
 lemma TC_vars_for_consts:
   fixes G :: \<open>('a, 'b) form list\<close>
   assumes \<open>infinite (UNIV :: 'a set)\<close>
   shows \<open>\<stileturn> G \<Longrightarrow> \<stileturn> map (\<lambda>p. vars_for_consts p cs) G\<close>
 proof (induct cs)
   case Nil
   then show ?case
     by simp
 next
   case (Cons c cs)
   have \<open>(\<stileturn> map (\<lambda>p. vars_for_consts p (c # cs)) G) =
       (\<stileturn> map (\<lambda>p. subc c (Var (length cs)) (vars_for_consts p cs)) G)\<close>
     by simp
   also have \<open>\<dots> = (\<stileturn> map (subc c (Var (length cs)) o (\<lambda>p. vars_for_consts p cs)) G)\<close>
     unfolding comp_def by simp
   also have \<open>\<dots> = (\<stileturn> map (subc c (Var (length cs))) (map (\<lambda>p. vars_for_consts p cs) G))\<close>
     by simp
   finally show ?case
     using Cons TC_map_subc assms by metis
 qed
 
 lemma vars_for_consts_sub_consts:
   \<open>closed (length cs) p \<Longrightarrow> list_all (\<lambda>c. new c p) cs \<Longrightarrow> distinct cs \<Longrightarrow>
    vars_for_consts (sub_consts cs p) cs = p\<close>
 proof (induct cs arbitrary: p)
   case (Cons c cs)
   then show ?case
     using subst_new_all closed_sub by force
 qed simp
 
 lemma all_vars_for_consts_sub_consts:
   \<open>list_all (closed (length cs)) G \<Longrightarrow> list_all (\<lambda>c. list_all (new c) G) cs \<Longrightarrow> distinct cs \<Longrightarrow>
    map (\<lambda>p. vars_for_consts p cs) (map (sub_consts cs) G) = G\<close>
   using vars_for_consts_sub_consts unfolding list_all_def
   by (induct G) fastforce+
 
 lemma new_conjoin: \<open>new c (conjoin G) \<Longrightarrow> list_all (new c) G\<close>
   by (induct G) simp_all
 
 lemma all_fresh_constants:
   fixes G :: \<open>('a, 'b) form list\<close>
   assumes \<open>infinite (UNIV :: 'a set)\<close>
   shows \<open>\<exists>cs. length cs = m \<and> list_all (\<lambda>c. list_all (new c) G) cs \<and> distinct cs\<close>
 proof -
   obtain cs where \<open>length cs = m\<close> \<open>list_all (\<lambda>c. new c (conjoin G)) cs\<close> \<open>distinct cs\<close>
     using assms fresh_constants by blast
   then show ?thesis
     using new_conjoin unfolding list_all_def by metis
 qed
 
 lemma sub_consts_Neg: \<open>sub_consts cs (Neg p) = Neg (sub_consts cs p)\<close>
   by (induct cs arbitrary: p) simp_all
 
 subsection \<open>Completeness\<close>
 
 theorem tableau_completeness:
   fixes G :: \<open>(nat, nat) form list\<close>
   assumes \<open>\<forall>(e :: nat \<Rightarrow> nat hterm) f g. list_all (eval e f g) G \<longrightarrow> eval e f g p\<close>
   shows \<open>tableauproof G p\<close>
 proof -
   obtain m where *: \<open>list_all (closed m) (p # G)\<close>
     using ex_all_closed by blast
   moreover obtain cs where **:
     \<open>length cs = m\<close>
     \<open>distinct cs\<close>
     \<open>list_all (\<lambda>c. list_all (new c) (p # G)) cs\<close>
     using all_fresh_constants by blast
   ultimately have \<open>closed 0 (sub_consts cs p)\<close>
     using closed_sub_consts by fastforce
   moreover have \<open>list_all (closed 0) (map (sub_consts cs) G)\<close>
     using closed_sub_consts * \<open>length cs = m\<close> by (induct G) fastforce+
 
   moreover have \<open>\<forall>(e :: nat \<Rightarrow> nat hterm) f g. list_all (eval e f g) (map (sub_consts cs) G) \<longrightarrow>
     eval e f g (sub_consts cs p)\<close>
     using assms valid_all_sub_consts by blast
   ultimately have \<open>\<stileturn> Neg (sub_consts cs p) # map (sub_consts cs) G\<close>
     using tableau_completeness' unfolding tableauproof_def by simp
   then have \<open>\<stileturn> map (sub_consts cs) (Neg p # G)\<close>
     by (simp add: sub_consts_Neg)
   then have \<open>\<stileturn> map (\<lambda>p. vars_for_consts p cs) (map (sub_consts cs) (Neg p # G))\<close>
     using TC_vars_for_consts by blast
   then show ?thesis
     unfolding tableauproof_def
     using all_vars_for_consts_sub_consts[where G=\<open>Neg p # G\<close>] * ** by simp
 qed
 
 corollary
   fixes p :: \<open>(nat, nat) form\<close>
   assumes \<open>\<forall>(e :: nat \<Rightarrow> nat hterm) f g. eval e f g p\<close>
   shows \<open>\<stileturn> [Neg p]\<close>
   using assms tableau_completeness unfolding tableauproof_def by simp
 
 end
diff --git a/thys/Jacobson_Basic_Algebra/Set_Theory.thy b/thys/Jacobson_Basic_Algebra/Set_Theory.thy
--- a/thys/Jacobson_Basic_Algebra/Set_Theory.thy
+++ b/thys/Jacobson_Basic_Algebra/Set_Theory.thy
@@ -1,495 +1,496 @@
 (*
   Copyright (c) 2014-2019 by Clemens Ballarin
   This file is licensed under the 3-clause BSD license.
 *)
 
 theory Set_Theory imports "HOL-Library.FuncSet" begin
 
 hide_const map
 hide_const partition
 
 no_notation divide (infixl "'/" 70)
 no_notation inverse_divide (infixl "'/" 70)
 
 text \<open>
   Each statement in the formal text is annotated with the location of the originating statement
   in Jacobson's text @{cite Jacobson1985}.  Each fact that Jacobson states explicitly is marked
   as @{command theorem} unless it is translated to a @{command sublocale} declaration.
   Literal quotations from Jacobson's text are reproduced in double quotes.
 
   Auxiliary results needed for the formalisation that cannot be found in Jacobson's text are marked
   as @{command lemma} or are @{command interpretation}s.  Such results are annotated with the
   location of a related statement.  For example, the introduction rule of a constant is annotated
   with the location of the definition of the corresponding operation.
 \<close>
 
 
 section \<open>Concepts from Set Theory.  The Integers\<close>
 
 subsection \<open>The Cartesian Product Set.  Maps\<close>
 
 text \<open>Maps as extensional HOL functions\<close>
 text \<open>p 5, ll 21--25\<close>
 locale map =
   fixes \<alpha> and S and T
   assumes graph [intro, simp]: "\<alpha> \<in> S \<rightarrow>\<^sub>E T"
 begin
 
 text \<open>p 5, ll 21--25\<close>
 lemma map_closed [intro, simp]:
   "a \<in> S \<Longrightarrow> \<alpha> a \<in> T"
 using graph by fast
   
 text \<open>p 5, ll 21--25\<close>
 lemma map_undefined [intro]:
   "a \<notin> S \<Longrightarrow> \<alpha> a = undefined"
 using graph by fast
 
 end (* map *)
 
 text \<open>p 7, ll 7--8\<close>
 locale surjective_map = map + assumes surjective [intro]: "\<alpha> ` S = T"
 
 text \<open>p 7, ll 8--9\<close>
 locale injective_map = map + assumes injective [intro, simp]: "inj_on \<alpha> S"
 
 text \<open>Enables locale reasoning about the inverse @{term "restrict (inv_into S \<alpha>) T"} of @{term \<alpha>}.\<close>
 text \<open>p 7, ll 9--10\<close>
 locale bijective =
   fixes \<alpha> and S and T
   assumes bijective [intro, simp]: "bij_betw \<alpha> S T"
 
 text \<open>
   Exploit existing knowledge about @{term bij_betw} rather than extending @{locale surjective_map}
   and @{locale injective_map}.
 \<close>
 text \<open>p 7, ll 9--10\<close>
 locale bijective_map = map + bijective begin
 
 text \<open>p 7, ll 9--10\<close>
 sublocale surjective_map by unfold_locales (simp add: bij_betw_imp_surj_on)
 
 text \<open>p 7, ll 9--10\<close>
 sublocale injective_map using bij_betw_def by unfold_locales fast
 
 text \<open>p 9, ll 12--13\<close>
 sublocale inverse: map "restrict (inv_into S \<alpha>) T" T S
   by unfold_locales (simp add: inv_into_into surjective)
 
 text \<open>p 9, ll 12--13\<close>
 sublocale inverse: bijective "restrict (inv_into S \<alpha>) T" T S
   by unfold_locales (simp add: bij_betw_inv_into surjective)
 
 end (* bijective_map *)
 
 text \<open>p 8, ll 14--15\<close>
 abbreviation "identity S \<equiv> (\<lambda>x \<in> S. x)"
 
 context map begin
 
 text \<open>p 8, ll 18--20; p 9, ll 1--8\<close>
 theorem bij_betw_iff_has_inverse:
   "bij_betw \<alpha> S T \<longleftrightarrow> (\<exists>\<beta> \<in> T \<rightarrow>\<^sub>E S. compose S \<beta> \<alpha> = identity S \<and> compose T \<alpha> \<beta> = identity T)"
     (is "_ \<longleftrightarrow> (\<exists>\<beta> \<in> T \<rightarrow>\<^sub>E S. ?INV \<beta>)")
 proof
   let ?inv = "restrict (inv_into S \<alpha>) T"
   assume "bij_betw \<alpha> S T"
   then have "?INV ?inv" and "?inv \<in> T \<rightarrow>\<^sub>E S"
     by (simp_all add: compose_inv_into_id bij_betw_imp_surj_on compose_id_inv_into bij_betw_imp_funcset bij_betw_inv_into)
   then show "\<exists>\<beta> \<in> T \<rightarrow>\<^sub>E S. ?INV \<beta>" ..
 next
   assume "\<exists>\<beta> \<in> T \<rightarrow>\<^sub>E S. ?INV \<beta>"
   then obtain \<beta> where "\<alpha> \<in> S \<rightarrow> T" "\<beta> \<in> T \<rightarrow> S" "\<And>x. x \<in> S \<Longrightarrow> \<beta> (\<alpha> x) = x" "\<And>y. y \<in> T \<Longrightarrow> \<alpha> (\<beta> y) = y"
     by (metis PiE_restrict compose_eq graph restrict_PiE restrict_apply)
   then show "bij_betw \<alpha> S T" by (rule bij_betwI) 
 qed
 
 end (* map *)
 
 
 subsection \<open>Equivalence Relations.  Factoring a Map Through an Equivalence Relation\<close>
 
 text \<open>p 11, ll 6--11\<close>
 locale equivalence =
   fixes S and E
   assumes closed [intro, simp]: "E \<subseteq> S \<times> S"
     and reflexive [intro, simp]: "a \<in> S \<Longrightarrow> (a, a) \<in> E"
     and symmetric [sym]: "(a, b) \<in> E \<Longrightarrow> (b, a) \<in> E"
     and transitive [trans]: "\<lbrakk> (a, b) \<in> E; (b, c) \<in> E \<rbrakk> \<Longrightarrow> (a, c) \<in> E"
 begin
 
 text \<open>p 11, ll 6--11\<close>
 lemma left_closed [intro]: (* inefficient as a simp rule *)
   "(a, b) \<in> E \<Longrightarrow> a \<in> S"
   using closed by blast
   
 text \<open>p 11, ll 6--11\<close>
 lemma right_closed [intro]: (* inefficient as a simp rule *)
   "(a, b) \<in> E \<Longrightarrow> b \<in> S"
   using closed by blast
 
 end (* equivalence *)
 
 text \<open>p 11, ll 16--20\<close>
 locale partition =
   fixes S and P
   assumes subset: "P \<subseteq> Pow S"
     and non_vacuous: "{} \<notin> P"
     and complete: "\<Union>P = S"
     and disjoint: "\<lbrakk> A \<in> P; B \<in> P; A \<noteq> B \<rbrakk> \<Longrightarrow> A \<inter> B = {}"
 
 context equivalence begin
 
 text \<open>p 11, ll 24--26\<close>
 definition "Class = (\<lambda>a \<in> S. {b \<in> S. (b, a) \<in> E})"
 
 text \<open>p 11, ll 24--26\<close>
 lemma Class_closed [dest]:
   "\<lbrakk> a \<in> Class b; b \<in> S \<rbrakk> \<Longrightarrow> a \<in> S"
   unfolding Class_def by auto
 
 text \<open>p 11, ll 24--26\<close>
 lemma Class_closed2 [intro, simp]:
   "a \<in> S \<Longrightarrow> Class a \<subseteq> S"
   unfolding Class_def by auto
 
 text \<open>p 11, ll 24--26\<close>
 lemma Class_undefined [intro, simp]:
   "a \<notin> S \<Longrightarrow> Class a = undefined"
   unfolding Class_def by simp
 
 text \<open>p 11, ll 24--26\<close>
 lemma ClassI [intro, simp]:
   "(a, b) \<in> E \<Longrightarrow> a \<in> Class b"
   unfolding Class_def by (simp add: left_closed right_closed)
   
 text \<open>p 11, ll 24--26\<close>
 lemma Class_revI [intro, simp]:
   "(a, b) \<in> E \<Longrightarrow> b \<in> Class a"
   by (blast intro: symmetric)
 
 text \<open>p 11, ll 24--26\<close>
 lemma ClassD [dest]:
   "\<lbrakk> b \<in> Class a; a \<in> S \<rbrakk> \<Longrightarrow> (b, a) \<in> E"
   unfolding Class_def by simp
 
 text \<open>p 11, ll 30--31\<close>
 theorem Class_self [intro, simp]:
   "a \<in> S \<Longrightarrow> a \<in> Class a"
   unfolding Class_def by simp
 
 text \<open>p 11, l 31; p 12, l 1\<close>
 theorem Class_Union [simp]:
   "(\<Union>a\<in>S. Class a) = S"
   by blast
 
 text \<open>p 11, ll 2--3\<close>
 theorem Class_subset:
   "(a, b) \<in> E \<Longrightarrow> Class a \<subseteq> Class b"
 proof
   fix a and b and c
   assume "(a, b) \<in> E" and "c \<in> Class a"
   then have "(c, a) \<in> E" by auto
   also note \<open>(a, b) \<in> E\<close>
   finally have "(c, b) \<in> E" by simp
   then show "c \<in> Class b" by auto
 qed
 
 text \<open>p 11, ll 3--4\<close>
 theorem Class_eq:
   "(a, b) \<in> E \<Longrightarrow> Class a = Class b"
   by (auto intro!: Class_subset intro: symmetric)
 
 text \<open>p 12, ll 1--5\<close>
 theorem Class_equivalence:
   "\<lbrakk> a \<in> S; b \<in> S \<rbrakk> \<Longrightarrow> Class a = Class b \<longleftrightarrow> (a, b) \<in> E"
 proof
   fix a and b
   assume "a \<in> S" "b \<in> S" "Class a = Class b"
   then have "a \<in> Class a" by auto
   also note \<open>Class a = Class b\<close>
   finally show "(a, b) \<in> E" by (fast intro: \<open>b \<in> S\<close>)
 qed (rule Class_eq)
 
 text \<open>p 12, ll 5--7\<close>
 theorem not_disjoint_implies_equal:
   assumes not_disjoint: "Class a \<inter> Class b \<noteq> {}"
   assumes closed: "a \<in> S" "b \<in> S"
   shows "Class a = Class b"
 proof -
   from not_disjoint and closed obtain c where witness: "c \<in> Class a \<inter> Class b" by fast
   with closed have "(a, c) \<in> E" by (blast intro: symmetric)
   also from witness and closed have "(c, b) \<in> E" by fast
   finally show ?thesis by (rule Class_eq)
 qed
 
 text \<open>p 12, ll 7--8\<close>
-definition "Partition = {Class a | a. a \<in> S}"
+definition "Partition = Class ` S"
 
 text \<open>p 12, ll 7--8\<close>
 lemma Class_in_Partition [intro, simp]:
   "a \<in> S \<Longrightarrow> Class a \<in> Partition"
   unfolding Partition_def by fast
 
 text \<open>p 12, ll 7--8\<close>
 theorem partition:
   "partition S Partition"
 proof
   fix A and B
   assume closed: "A \<in> Partition" "B \<in> Partition"
   then obtain a and b where eq: "A = Class a" "B = Class b" and ab: "a \<in> S" "b \<in> S"
   unfolding Partition_def by auto
   assume distinct: "A \<noteq> B"
   then show "A \<inter> B = {}"
   proof (rule contrapos_np)
     assume not_disjoint: "A \<inter> B \<noteq> {}"
     then show "A = B" by (simp add: eq) (metis not_disjoint_implies_equal ab)
   qed
 qed (auto simp: Partition_def)
 
 end (* equivalence *)
 
 context partition begin
 
 text \<open>p 12, ll 9--10\<close>
 theorem block_exists:
   "a \<in> S \<Longrightarrow> \<exists>A. a \<in> A \<and> A \<in> P"
   using complete by blast
 
 text \<open>p 12, ll 9--10\<close>
 theorem block_unique:
   "\<lbrakk> a \<in> A; A \<in> P; a \<in> B; B \<in> P \<rbrakk> \<Longrightarrow> A = B"
   using disjoint by blast
 
 text \<open>p 12, ll 9--10\<close>
 lemma block_closed [intro]: (* inefficient as a simp rule *)
   "\<lbrakk> a \<in> A; A \<in> P \<rbrakk> \<Longrightarrow> a \<in> S"
   using complete by blast
 
 text \<open>p 12, ll 9--10\<close>
 lemma element_exists:
   "A \<in> P \<Longrightarrow> \<exists>a \<in> S. a \<in> A"
   by (metis non_vacuous block_closed all_not_in_conv)
 
 text \<open>p 12, ll 9--10\<close>
 definition "Block = (\<lambda>a \<in> S. THE A. a \<in> A \<and> A \<in> P)"
 
 text \<open>p 12, ll 9--10\<close>
 lemma Block_closed [intro, simp]:
   assumes [intro]: "a \<in> S" shows "Block a \<in> P"
 proof -
   obtain A where "a \<in> A" "A \<in> P" using block_exists by blast
   then show ?thesis
     apply (auto simp: Block_def)
     apply (rule theI2)
       apply (auto dest: block_unique)
     done
 qed
   
 text \<open>p 12, ll 9--10\<close>
 lemma Block_undefined [intro, simp]:
   "a \<notin> S \<Longrightarrow> Block a = undefined"
   unfolding Block_def by simp
 
 text \<open>p 12, ll 9--10\<close>
 lemma Block_self:
   "\<lbrakk> a \<in> A; A \<in> P \<rbrakk> \<Longrightarrow> Block a = A"
   apply (simp add: Block_def block_closed)
   apply (rule the_equality)
    apply (auto dest: block_unique)
   done
 
 text \<open>p 12, ll 10--11\<close>
 definition "Equivalence = {(a, b) . \<exists>A \<in> P. a \<in> A \<and> b \<in> A}"
 
 text \<open>p 12, ll 11--12\<close>
 theorem equivalence: "equivalence S Equivalence"
 proof
   show "Equivalence \<subseteq> S \<times> S" unfolding Equivalence_def using subset by auto
 next
   fix a
   assume "a \<in> S"
   then show "(a, a) \<in> Equivalence" unfolding Equivalence_def using complete by auto
 next
   fix a and b
   assume "(a, b) \<in> Equivalence"
   then show "(b, a) \<in> Equivalence" unfolding Equivalence_def by auto
 next
   fix a and b and c
   assume "(a, b) \<in> Equivalence" "(b, c) \<in> Equivalence"
   then show "(a, c) \<in> Equivalence" unfolding Equivalence_def using disjoint by auto
 qed
 
 text \<open>Temporarily introduce equivalence associated to partition.\<close>
 text \<open>p 12, ll 12--14\<close>
 interpretation equivalence S Equivalence by (rule equivalence)
 
 text \<open>p 12, ll 12--14\<close>
 theorem Class_is_Block:
   assumes "a \<in> S" shows "Class a = Block a"
 proof -
   from \<open>a \<in> S\<close> and block_exists obtain A where block: "a \<in> A \<and> A \<in> P" by blast
   show ?thesis
     apply (simp add: Block_def Class_def)
     apply (rule theI2)
       apply (rule block)
      apply (metis block block_unique)
     apply (auto dest: block_unique simp: Equivalence_def)
     done
 qed
 
 text \<open>p 12, l 14\<close>
 lemma Class_equals_Block:
   "Class = Block"
 proof
   fix x show "Class x = Block x"
   by (cases "x \<in> S") (auto simp: Class_is_Block)
 qed
 
 text \<open>p 12, l 14\<close>
 theorem partition_of_equivalence:
   "Partition = P"
-  by (auto simp add: Partition_def Class_equals_Block) (metis Block_self element_exists)
+  by (auto simp add: Partition_def Class_equals_Block image_iff) (metis Block_self element_exists)
 
 end (* partition *)
 
 context equivalence begin
 
 text \<open>p 12, ll 14--17\<close>
 interpretation partition S Partition by (rule partition)
 
 text \<open>p 12, ll 14--17\<close>
 theorem equivalence_of_partition:
   "Equivalence = E"
   unfolding Equivalence_def unfolding Partition_def by auto (metis ClassD Class_closed Class_eq)
 
 end (* equivalence *)
 
 text \<open>p 12, l 14\<close>
 sublocale partition \<subseteq> equivalence S Equivalence
   rewrites "equivalence.Partition S Equivalence = P" and "equivalence.Class S Equivalence = Block"
     apply (rule equivalence)
    apply (rule partition_of_equivalence)
   apply (rule Class_equals_Block)
   done
 
 text \<open>p 12, ll 14--17\<close>
 sublocale equivalence \<subseteq> partition S Partition
   rewrites "partition.Equivalence Partition = E" and "partition.Block S Partition = Class"
     apply (rule partition)
    apply (rule equivalence_of_partition)
   apply (metis equivalence_of_partition partition partition.Class_equals_Block)
   done
 
 text \<open>Unfortunately only effective on input\<close>
 text \<open>p 12, ll 18--20\<close>
 notation equivalence.Partition (infixl "'/" 75)
 
 context equivalence begin
 
 text \<open>p 12, ll 18--20\<close>
 lemma representant_exists [dest]: "A \<in> S / E \<Longrightarrow> \<exists>a\<in>S. a \<in> A \<and> A = Class a"
   by (metis Block_self element_exists)
 
 text \<open>p 12, ll 18--20\<close>
 lemma quotient_ClassE: "A \<in> S / E \<Longrightarrow> (\<And>a. a \<in> S \<Longrightarrow> P (Class a)) \<Longrightarrow> P A"
   using representant_exists by blast
 
 end (* equivalence *)
 
 text \<open>p 12, ll 21--23\<close>
 sublocale equivalence \<subseteq> natural: surjective_map Class S "S / E"
   by unfold_locales force+
 
 text \<open>Technical device to achieve Jacobson's syntax; context where @{text \<alpha>} is not a parameter.\<close>
 text \<open>p 12, ll 25--26\<close>
 locale fiber_relation_notation = fixes S :: "'a set" begin
 
 text \<open>p 12, ll 25--26\<close>
 definition Fiber_Relation ("E'(_')") where "Fiber_Relation \<alpha> = {(x, y). x \<in> S \<and> y \<in> S \<and> \<alpha> x = \<alpha> y}"
 
 end (* fiber_relation_notation *)
 
 text \<open>
   Context where classes and the induced map are defined through the fiber relation.
   This will be the case for monoid homomorphisms but not group homomorphisms.
 \<close>
 text \<open>Avoids infinite interpretation chain.\<close>
 text \<open>p 12, ll 25--26\<close>
 locale fiber_relation = map begin
 
 text \<open>Install syntax\<close>
 text \<open>p 12, ll 25--26\<close>
 sublocale fiber_relation_notation .
 
 text \<open>p 12, ll 26--27\<close>
 sublocale equivalence where E = "E(\<alpha>)"
   unfolding Fiber_Relation_def by unfold_locales auto
 
 text \<open>``define $\bar{\alpha}$ by $\bar{\alpha}(\bar{a}) = \alpha(a)$''\<close>
 text \<open>p 13, ll 8--9\<close>
 definition "induced = (\<lambda>A \<in> S / E(\<alpha>). THE b. \<exists>a \<in> A. b = \<alpha> a)"
 
 text \<open>p 13, l 10\<close>
 theorem Fiber_equality:
   "\<lbrakk> a \<in> S; b \<in> S \<rbrakk> \<Longrightarrow> Class a = Class b \<longleftrightarrow> \<alpha> a = \<alpha> b"
   unfolding Class_equivalence unfolding Fiber_Relation_def by simp
 
 text \<open>p 13, ll 8--9\<close>
 theorem induced_Fiber_simp [simp]:
   assumes [intro, simp]: "a \<in> S" shows "induced (Class a) = \<alpha> a"
 proof -
   have "(THE b. \<exists>a\<in>Class a. b = \<alpha> a) = \<alpha> a"
     by (rule the_equality) (auto simp: Fiber_equality [symmetric] Block_self block_closed)
   then show ?thesis unfolding induced_def by simp
 qed
 
 text \<open>p 13, ll 10--11\<close>
 interpretation induced: map induced "S / E(\<alpha>)" T
 proof (unfold_locales, rule)
   fix A
   assume [intro, simp]: "A \<in> S / E(\<alpha>)"
   obtain a where a: "a \<in> S" "a \<in> A" using element_exists by auto
   have "(THE b. \<exists>a\<in>A. b = \<alpha> a) \<in> T"
     apply (rule theI2)
     using a apply (auto simp: Fiber_equality [symmetric] Block_self block_closed)
     done
   then show "induced A \<in> T" unfolding induced_def by simp
 qed (simp add: induced_def)
 
 text \<open>p 13, ll 12--13\<close>
 sublocale induced: injective_map induced "S / E(\<alpha>)" T
-  apply unfold_locales
-  apply (rule inj_onI)
-  apply (metis Fiber_equality Block_self element_exists induced_Fiber_simp)
-  done
+proof
+  show "inj_on induced Partition"
+    unfolding inj_on_def
+    by (metis Fiber_equality Block_self element_exists induced_Fiber_simp)
+qed
 
 text \<open>p 13, ll 16--19\<close>
 theorem factorization_lemma:
   "a \<in> S \<Longrightarrow> compose S induced Class a = \<alpha> a"
   by (simp add: compose_eq)
 
 text \<open>p 13, ll 16--19\<close>
 theorem factorization [simp]: "compose S induced Class = \<alpha>"
   by (rule ext) (simp add: compose_def map_undefined)
 
 text \<open>p 14, ll 2--4\<close>
 theorem uniqueness:
   assumes map: "\<beta> \<in> S / E(\<alpha>) \<rightarrow>\<^sub>E T"
     and factorization: "compose S \<beta> Class = \<alpha>"
   shows "\<beta> = induced"
 proof
   fix A
   show "\<beta> A = induced A"
   proof (cases "A \<in> S / E(\<alpha>)")
     case True
     then obtain a where [simp]: "A = Class a" "a \<in> S" by fast
     then have "\<beta> (Class a) = \<alpha> a" by (metis compose_eq factorization)
     also have "\<dots> = induced (Class a)" by simp
     finally show ?thesis by simp
   qed (simp add: induced_def PiE_arb [OF map])
 qed
 
 end (* fiber_relation *)
 
 end
diff --git a/tools/afp_check_roots.scala b/tools/afp_check_roots.scala
--- a/tools/afp_check_roots.scala
+++ b/tools/afp_check_roots.scala
@@ -1,134 +1,134 @@
 // DESCRIPTION: check ROOT files of AFP sessions
 
 object AFP_Check_Roots extends isabelle.Isabelle_Tool.Body {
 
   import isabelle._
 
   val afp_dir = Path.explode("$AFP").expand
   val excludes = List("ROOTS", "LICENSE", "LICENSE.LGPL", ".DS_Store")
 
   def print_good(string: String): Unit =
     println(Console.BOLD + Console.GREEN + string + Console.RESET)
 
   def print_bad(string: String): Unit =
     println(Console.BOLD + Console.RED + string + Console.RESET)
 
   class Check[T](
     run: (Sessions.Structure, List[String]) => List[T],
     failure_msg: String,
     failure_format: T => String)
   {
     def apply(tree: Sessions.Structure, selected: List[String]): Boolean =
       run(tree, selected) match {
         case Nil =>
           true
         case offenders =>
           print_bad(failure_msg)
           offenders.foreach(offender => println("  " + failure_format(offender)))
           false
       }
   }
 
   val check_timeout = new Check[(String, List[String])](
     run = { (tree, selected) =>
       selected.flatMap { name =>
         val info = tree(name)
         val entry = info.dir.base.implode
         val timeout = info.options.real("timeout")
         if (timeout == 0 || timeout % 300 != 0)
           Some((entry, name))
         else
           None
-      }.groupBy(_._1).mapValues(_.map(_._2)).toList
+      }.groupBy(_._1).view.mapValues(_.map(_._2)).toList
     },
     failure_msg = "The following entries contain sessions without timeouts or with timeouts not divisible by 300:",
     failure_format = { case (entry, sessions) => s"""$entry ${sessions.mkString("(", ", ", ")")}""" }
   )
 
   val check_paths = new Check[(String, Path)](
     run = { (tree, selected) =>
       selected.flatMap { name =>
         val info = tree(name)
         val dir = info.dir
         if (dir.dir.expand.file != afp_dir.file)
           Some((name, dir))
         else
           None
       }
     },
     failure_msg = "The following sessions are in the wrong directory:",
     failure_format = { case (session, dir) => s"""$session ($dir)""" }
   )
 
   val check_chapter = new Check[String](
     run = { (tree, selected) =>
       selected.flatMap { name =>
         val info = tree(name)
         val entry = info.dir.base.implode
         if (info.chapter != "AFP")
           Some(entry)
         else
           None
       }.distinct
     },
     failure_msg = "The following entries are not in the AFP chapter:",
     failure_format = identity
   )
 
   val check_groups = new Check[(String, List[String])](
     run = { (tree, selected) =>
       selected.flatMap { name =>
         val info = tree(name)
         if (!info.groups.toSet.subsetOf(AFP.groups.keySet + "AFP") ||
             !info.groups.contains("AFP"))
           Some((name, info.groups))
         else
           None
       }
     },
     failure_msg = "The following sessions have wrong groups:",
     failure_format = { case (session, groups) => s"""$session ${groups.mkString("{", ", ", "}")}""" }
   )
 
   val check_presence = new Check[String](
     run = { (tree, selected) =>
       val fs_entries = File.read_dir(afp_dir).filterNot(excludes.contains)
 
       fs_entries.flatMap { name =>
         if (!selected.contains(name) || tree(name).dir.base.implode != name)
           Some(name)
         else
           None
       }
     },
     failure_msg = "The following entries (according to the file system) are not registered in ROOTS, or registered in the wrong ROOT:",
     failure_format = identity
   )
 
   def apply(args: List[String]): Unit =
   {
     val full_tree = Sessions.load_structure(Options.init(), Nil, List(afp_dir))
     val selected = full_tree.build_selection(Sessions.Selection.empty)
 
     val checks = List(
       check_timeout,
       // check_paths,
       check_chapter,
       check_groups,
       check_presence)
 
     val bad = checks.exists(check => !check(full_tree, selected))
 
     if (bad)
     {
       print_bad("Errors found.")
       System.exit(1)
     }
     else
     {
       print_good(s"${selected.length} sessions have been checked")
       print_good(s"${checks.length} checks have found no errors")
     }
   }
 
 }