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_minimal:
+  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_min:
+  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_minimal:
+  "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_minimal well_foundedI_min 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_min)
+    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_minimal[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_min)
+    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_minimal[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_minimal)
+
+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_min)
+  assume l: ?l
+  fix X assume XAB: "X \<subseteq> A \<inter> B" and X0: "X \<noteq> {}"
+  with l[THEN well_founded.nonempty_imp_ex_minimal]
+  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_minimal, 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_minimal)
+
+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_min)
+  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_minimal[OF XB X0] show ?thesis.
+  next
+    case False
+    with A.nonempty_imp_ex_minimal[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 lower_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_min)
+  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_minimal[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_min)
+  fix X assume "X \<subseteq> A" and "X \<noteq> {}"
+  from well_founded.nonempty_imp_ex_minimal[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_minimal, 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_minimal 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 lower_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 lower_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 lower_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 lower_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\:(\SUP 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\:(\SUP D)$,
+and $f\:(\SUP 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 lower_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> 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[elim] =
+  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>)"
+    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
+  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
+  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
+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"
   options [timeout = 300]
   theories
-    Fixed_Points
+    Fixed_Points Kleene_Fixed_Point
   document_files
     "root.tex"
     "root.bib"