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,2246 +1,2366 @@
 (*
 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
 (* To verify that we don't use the axiom of choice, import
     HOL.Complete_Partial_Order HOL.Wellfounded
-   instead of *) Main
+   instead of *)
+    Main
 begin
 
+unbundle lattice_syntax
+
+lemma conj_iff_conj_iff_imp_iff: "Trueprop (x \<and> y \<longleftrightarrow> x \<and> z) \<equiv> (x \<Longrightarrow> (y \<longleftrightarrow> z))"
+  by (auto intro!: equal_intr_rule)
+
 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)
 
+lemma image_subsetD: "f ` A \<subseteq> B \<Longrightarrow> a \<in> A \<Longrightarrow> f a \<in> B" by auto
+
 text \<open>Below we introduce an Isabelle-notation for $\{ \ldots x\ldots \mid x \in X \}$.\<close>
 
 syntax
   "_range" :: "'a \<Rightarrow> idts \<Rightarrow> 'a set" ("(1{_ /|./ _})")
   "_image" :: "'a \<Rightarrow> pttrn \<Rightarrow> 'a set \<Rightarrow> 'a set"  ("(1{_ /|./ (_/ \<in> _)})")
 translations
   "{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_is_dual[simp]: "conversep = dual" by auto
 
+lemma dual_inf: "(r \<sqinter> s)\<^sup>- = r\<^sup>- \<sqinter> s\<^sup>-" by (auto intro!: ext)
+
 text \<open>Monotonicity is already defined in the library, but we want one restricted to a domain.\<close>
 
-definition monotone_on where
-  "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 sympartp_sympartp[simp]: "sympartp (sympartp r) = sympartp r" by (auto intro!:ext)
+
 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)
 
+lemma asympartp_dual: "asympartp r\<^sup>- = (asympartp r)\<^sup>-" by auto
+
 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_simp[simp]: "a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> (r \<restriction> A) a b \<longleftrightarrow> r a b" by auto
+
 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"
+definition "bound X (\<sqsubseteq>) b \<equiv> \<forall>x \<in> X. x \<sqsubseteq> b" for r (infix "\<sqsubseteq>" 50)
 
 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"
+    and boundD: "bound X (\<sqsubseteq>) b \<Longrightarrow> a \<in> X \<Longrightarrow> a \<sqsubseteq> b"
   by (auto simp: bound_def)
 
 lemma bound_empty: "bound {} = (\<lambda>r x. True)" by auto
 
+lemma bound_cmono: assumes "X \<subseteq> Y" shows "bound Y \<le> bound X"
+  using assms by auto
+
+lemmas bound_subset = bound_cmono[THEN le_funD, THEN le_funD, THEN le_boolD, folded atomize_imp]
+
+lemma bound_un: "bound (A \<union> B) = bound A \<sqinter> bound B"
+  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
 
+lemma bound_cong:
+  assumes "A = A'"
+    and "b = b'"
+    and "\<And>a. a \<in> A' \<Longrightarrow> le a b' = le' a b'"
+  shows "bound A le b = bound A' le' b'"
+  by (auto simp: assms)
+
+lemma bound_subsel: "le \<le> le' \<Longrightarrow> bound A le \<le> bound A le'"
+  by (auto simp add: bound_def)
+
 text \<open>Extreme (greatest) elements in a set:\<close>
-definition "extreme X r e \<equiv> e \<in> X \<and> (\<forall>x \<in> X. r x e)"
+definition "extreme X (\<sqsubseteq>) e \<equiv> e \<in> X \<and> (\<forall>x \<in> X. x \<sqsubseteq> e)" for r (infix "\<sqsubseteq>" 50)
 
 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
   fixes r (infix "\<sqsubseteq>" 50)
   shows extreme_UNIV[simp]: "extreme UNIV (\<sqsubseteq>) t \<longleftrightarrow> (\<forall>x. x \<sqsubseteq> t)" by auto
 
+lemma extreme_iff_bound: "extreme X r e \<longleftrightarrow> bound X r e \<and> e \<in> X" by auto
+
+lemma extreme_imp_bound: "extreme X r x \<Longrightarrow> bound X r x" by auto
+
+lemma extreme_inf: "extreme X (r \<sqinter> s) x \<longleftrightarrow> extreme X r x \<and> extreme X s x" 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)
+lemma extreme_cong:
+  assumes "A = A'"
+    and "b = b'"
+    and "\<And>a. a \<in> A' \<Longrightarrow> b' \<in> A' \<Longrightarrow> le a b' = le' a b'"
+  shows "extreme A le b = extreme A' le' b'"
+  by (auto simp: assms extreme_def)
+
+lemma extreme_subset: "X \<subseteq> Y \<Longrightarrow> extreme X r x \<Longrightarrow> extreme Y r y \<Longrightarrow> r x y" by blast
+
+lemma extreme_subrel:
+  "le \<le> le' \<Longrightarrow> extreme A le \<le> extreme A le'" by (auto simp: extreme_def)
 
 text \<open>Now suprema and infima are given uniformly as follows.
   The definition is restricted to a given set.
 \<close>
+
+definition
+  "extreme_bound A (\<sqsubseteq>) X \<equiv> extreme {b \<in> A. bound X (\<sqsubseteq>) b} (\<sqsubseteq>)\<^sup>-" for r (infix "\<sqsubseteq>" 50)
+
+lemmas extreme_boundI_extreme = extreme_bound_def[unfolded atomize_eq, THEN fun_cong, THEN iffD2]
+
+lemmas extreme_boundD_extreme = extreme_bound_def[unfolded atomize_eq, THEN fun_cong, THEN iffD1]
+
 context
   fixes A :: "'a set" and less_eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
 begin
 
-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 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:
+  shows "extreme_bound A (\<sqsubseteq>) X s"
+  using assms by (auto simp: extreme_bound_def)
+
+lemma extreme_boundD:
+  assumes "extreme_bound A (\<sqsubseteq>) X s"
+  shows "x \<in> X \<Longrightarrow> x \<sqsubseteq> s"
+    and "bound X (\<sqsubseteq>) b \<Longrightarrow> b \<in> A \<Longrightarrow> s \<sqsubseteq> b"
+    and extreme_bound_in: "s \<in> A"
+  using assms by (auto simp: extreme_bound_def)
+
+lemma extreme_boundE[elim]:
+  assumes "extreme_bound A (\<sqsubseteq>) X s"
+    and "s \<in> A \<Longrightarrow> bound X (\<sqsubseteq>) s \<Longrightarrow> (\<And>b. bound X (\<sqsubseteq>) b \<Longrightarrow> b \<in> A \<Longrightarrow> s \<sqsubseteq> b) \<Longrightarrow> thesis"
+  shows thesis
+  using assms by (auto simp: extreme_bound_def)
+
+lemma extreme_bound_imp_bound: "extreme_bound A (\<sqsubseteq>) X s \<Longrightarrow> bound X (\<sqsubseteq>) s" by auto
+
+lemma extreme_imp_extreme_bound:
+  assumes Xs: "extreme X (\<sqsubseteq>) s" and XA: "X \<subseteq> A" shows "extreme_bound A (\<sqsubseteq>) X s"
+  using assms by force
+
+lemma extreme_bound_subset_bound:
   assumes XY: "X \<subseteq> Y"
-    and sX: "extreme_bound X sX"
-    and sY: "extreme_bound Y sY"
+    and sX: "extreme_bound A (\<sqsubseteq>) X s"
+    and b: "bound Y (\<sqsubseteq>) b" and bA: "b \<in> A"
+  shows "s \<sqsubseteq> b"
+  using bound_subset[OF XY b] sX bA by auto
+
+lemma extreme_bound_subset:
+  assumes XY: "X \<subseteq> Y"
+    and sX: "extreme_bound A (\<sqsubseteq>) X sX"
+    and sY: "extreme_bound A (\<sqsubseteq>) Y sY"
   shows "sX \<sqsubseteq> sY"
-proof-
-  have "bound X (\<sqsubseteq>) sY" using XY sY by force
-  with sX sY show ?thesis by (auto 0 4)
-qed
+  using extreme_bound_subset_bound[OF XY sX] sY by auto
 
 lemma extreme_bound_iff:
-  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)
+  "extreme_bound A (\<sqsubseteq>) 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_bound_def extreme_def)
+
+lemma extreme_bound_empty: "extreme_bound A (\<sqsubseteq>) {} x \<longleftrightarrow> extreme A (\<sqsubseteq>)\<^sup>- x"
+  by auto
 
 lemma extreme_bound_singleton_refl[simp]:
-  "extreme_bound {x} x \<longleftrightarrow> x \<in> A \<and> x \<sqsubseteq> x" by auto
+  "extreme_bound A (\<sqsubseteq>) {x} x \<longleftrightarrow> x \<in> A \<and> x \<sqsubseteq> x" by auto
 
 lemma extreme_bound_image_const:
-  "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"
+  "x \<sqsubseteq> x \<Longrightarrow> I \<noteq> {} \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> f i = x) \<Longrightarrow> x \<in> A \<Longrightarrow> extreme_bound A (\<sqsubseteq>) (f ` I) x"
   by (auto simp: image_constant)
 
 lemma extreme_bound_UN_const:
   "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"
+  extreme_bound A (\<sqsubseteq>) (\<Union>i\<in>I. {y. P i y}) x"
   by auto
 
+lemma extreme_bounds_equiv:
+  assumes s: "extreme_bound A (\<sqsubseteq>) X s" and s': "extreme_bound A (\<sqsubseteq>) X s'"
+  shows "sympartp (\<sqsubseteq>) s s'"
+  using s s'
+  apply (unfold extreme_bound_def)
+  apply (subst sympartp_dual)
+  by (rule extremes_equiv)
+
+lemma extreme_bound_sqweeze:
+  assumes XY: "X \<subseteq> Y" and YZ: "Y \<subseteq> Z"
+    and Xs: "extreme_bound A (\<sqsubseteq>) X s" and Zs: "extreme_bound A (\<sqsubseteq>) Z s"
+  shows "extreme_bound A (\<sqsubseteq>) Y s"
+proof
+  from Xs show "s \<in> A" by auto
+  fix b assume Yb: "bound Y (\<sqsubseteq>) b" and bA: "b \<in> A"
+  from bound_subset[OF XY Yb] have "bound X (\<sqsubseteq>) b".
+  with Xs bA
+  show "s \<sqsubseteq> b" by auto
+next
+  fix y assume yY: "y \<in> Y"
+  with YZ have "y \<in> Z" by auto
+  with Zs show "y \<sqsubseteq> s" by auto
+qed
+
+lemma bound_closed_imp_extreme_bound_eq_extreme:
+  assumes closed: "\<forall>b \<in> A. bound X (\<sqsubseteq>) b \<longrightarrow> b \<in> X" and XA: "X \<subseteq> A"
+  shows "extreme_bound A (\<sqsubseteq>) X = extreme X (\<sqsubseteq>)"
+proof (intro ext iffI extreme_boundI extremeI)
+  fix e
+  assume "extreme_bound A (\<sqsubseteq>) X e"
+  then have Xe: "bound X (\<sqsubseteq>) e" and "e \<in> A" by auto
+  with closed show "e \<in> X" by auto
+  fix x assume "x \<in> X"
+  with Xe show "x \<sqsubseteq> e" by auto
+next
+  fix e
+  assume Xe: "extreme X (\<sqsubseteq>) e"
+  then have eX: "e \<in> X" by auto
+  with XA show "e \<in> A" by auto
+  { fix b assume Xb: "bound X (\<sqsubseteq>) b" and "b \<in> A"
+    from eX Xb show "e \<sqsubseteq> b" by auto
+  }
+  fix x assume xX: "x \<in> X" with Xe show "x \<sqsubseteq> e" by auto
+qed
+
+end
+
+lemma extreme_bound_cong:
+  assumes "A = A'"
+    and "X = X'"
+    and "\<And>a b. a \<in> A' \<Longrightarrow> b \<in> A' \<Longrightarrow> le a b \<longleftrightarrow> le' a b"
+    and "\<And>a b. a \<in> X' \<Longrightarrow> b \<in> A' \<Longrightarrow> le a b \<longleftrightarrow> le' a b"
+  shows "extreme_bound A le X s = extreme_bound A le' X s"
+  apply (unfold extreme_bound_def)
+  apply (rule extreme_cong)
+  by (auto simp: assms)
+
+
+text \<open>Maximal or Minimal\<close>
+
+definition "extremal X (\<sqsubseteq>) x \<equiv> x \<in> X \<and> (\<forall>y \<in> X. x \<sqsubseteq> y \<longrightarrow> y \<sqsubseteq> x)" for r (infix "\<sqsubseteq>" 50)
+
+context
+  fixes r :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
+begin
+
+lemma extremalI:
+  assumes "x \<in> X" "\<And>y. y \<in> X \<Longrightarrow> x \<sqsubseteq> y \<Longrightarrow> y \<sqsubseteq> x"
+  shows "extremal X (\<sqsubseteq>) x"
+  using assms by (auto simp: extremal_def)
+
+lemma extremalE:
+  assumes "extremal X (\<sqsubseteq>) x"
+    and "x \<in> X \<Longrightarrow> (\<And>y. y \<in> X \<Longrightarrow> x \<sqsubseteq> y \<Longrightarrow> y \<sqsubseteq> x) \<Longrightarrow> thesis"
+  shows thesis
+  using assms by (auto simp: extremal_def)
+
+lemma extremalD:
+  assumes "extremal X (\<sqsubseteq>) x" shows "x \<in> X" "y \<in> X \<Longrightarrow> x \<sqsubseteq> y \<Longrightarrow> y \<sqsubseteq> x"
+  using assms by (auto elim!: extremalE)
+
+end
+
+context
+  fixes ir (infix "\<preceq>" 50) and r (infix "\<sqsubseteq>" 50) and I f
+  assumes mono: "monotone_on I (\<preceq>) (\<sqsubseteq>) f"
+begin
+
+lemma monotone_image_bound:
+  assumes "X \<subseteq> I" and "b \<in> I" and "bound X (\<preceq>) b"
+  shows "bound (f ` X) (\<sqsubseteq>) (f b)"
+  using assms monotone_onD[OF mono]
+  by (auto simp: bound_def)
+
+lemma monotone_image_extreme:
+  assumes e: "extreme I (\<preceq>) e"
+  shows "extreme (f ` I) (\<sqsubseteq>) (f e)"
+  using e[unfolded extreme_iff_bound] monotone_image_bound[of I e] by auto
+
 end
 
 context
   fixes ir :: "'i \<Rightarrow> 'i \<Rightarrow> bool" (infix "\<preceq>" 50)
     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:
   "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 A (\<sqsubseteq>) (f ` I) x"
   using monotone_extreme_imp_extreme_bound by auto
 
 end
 
 subsection \<open>Locales for Binary Relations\<close>
 
 text \<open>We now define basic properties of binary relations,
-in form of \emph{locales}~\<^cite>\<open>"Kammuller00" and "locale"\<close>.\<close>
+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)
 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_notations = less_eq_syntax
+locale less_eq_dualize = less_eq_syntax
 begin
 
 abbreviation (input) greater_eq (infix "\<sqsupseteq>" 50) where "x \<sqsupseteq> y \<equiv> y \<sqsubseteq> x"
+
+end
+
+locale less_eq_symmetrize = less_eq_dualize
+begin
+
 abbreviation sym (infix "\<sim>" 50) where "(\<sim>) \<equiv> sympartp (\<sqsubseteq>)"
+abbreviation equiv (infix "(\<simeq>)" 50) where "(\<simeq>) \<equiv> equivpartp (\<sqsubseteq>)"
+
+end
+
+locale less_eq_asymmetrize = less_eq_symmetrize
+begin
+
 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_notations = less_syntax
+locale less_dualize = 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>
 
 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 \<in> A \<Longrightarrow> x \<sqsubseteq> y" by auto
 
+lemma reflexive_subset: "B \<subseteq> A \<Longrightarrow> reflexive B (\<sqsubseteq>)" apply unfold_locales 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
+lemma extreme_bound_cone: "x \<in> A \<Longrightarrow> extreme_bound A (\<sqsubseteq>) {a \<in> A. a \<sqsubseteq> x} x" by auto
 
 end
 
-declare reflexive.intro[intro!]
+lemmas reflexiveI[intro!] = reflexive.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
 
 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
 
-declare irreflexive.intro[intro!]
+lemmas irreflexiveI[intro!] = irreflexive.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)
 
+context reflexive begin
+
+interpretation less_eq_asymmetrize.
+
+lemma asympartp_irreflexive: "irreflexive A (\<sqsubset>)" by auto
+
+end
+
 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 extreme_bound_mono:
+  assumes XY: "\<forall>x\<in>X. \<exists>y\<in>Y. x \<sqsubseteq> y" and XA: "X \<subseteq> A" and YA: "Y \<subseteq> A"
+    and sX: "extreme_bound A (\<sqsubseteq>) X sX"
+    and sY: "extreme_bound A (\<sqsubseteq>) Y sY"
+  shows "sX \<sqsubseteq> sY"
+proof (intro extreme_boundD(2)[OF sX] CollectI conjI boundI)
+  from sY show sYA: "sY \<in> A" by auto
+  from sY have "bound Y (\<sqsubseteq>) sY" by auto
+  fix x assume xX: "x \<in> X" with XY obtain y where yY: "y \<in> Y" and xy: "x \<sqsubseteq> y" by auto
+  from yY sY have "y \<sqsubseteq> sY" by auto
+  from trans[OF xy this] xX XA yY YA sYA show "x \<sqsubseteq> sY" by auto
+qed
+
 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>)"
+lemma asympartp_transitive: "transitive A (asympartp (\<sqsubseteq>))"
   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?]
+lemmas transitiveI = transitive.intro
+
+lemma transitive_ball[code]:
+  "transitive A (\<sqsubseteq>) \<longleftrightarrow> (\<forall>x \<in> A. \<forall>y \<in> A. \<forall>z \<in> A. x \<sqsubseteq> y \<longrightarrow> y \<sqsubseteq> z \<longrightarrow> x \<sqsubseteq> z)"
+  for less_eq (infix "\<sqsubseteq>" 50)
+  by (auto simp: transitive_def)
 
 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 transitive_empty[intro!]: "transitive {} r" by (auto intro!: transitive.intro)
+
 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]
+lemmas symmetricI[intro] = symmetric.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)
 
+lemma symmetric_empty[intro!]: "symmetric {} r" by auto
 
 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.
+interpretation less_eq_symmetrize.
 
 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 eq_The_extreme: "X \<subseteq> A \<Longrightarrow> extreme X (\<sqsubseteq>) x \<Longrightarrow> x = The (extreme X (\<sqsubseteq>))"
+  by (rule the1_equality[symmetric], auto simp: ex_extreme_iff_ex1[symmetric])
+
 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]
+lemmas antisymmetricI[intro] = antisymmetric.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_empty[intro!]: "antisymmetric {} r" by auto
+
 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 = 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_notations.
+interpretation less_eq_symmetrize.
 
 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 \<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 \<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 y: "extreme_bound A (\<sqsubseteq>) C y"
   note x = extreme_bound_quasi_const[OF C x C0 const]
-  from extremes_equiv[OF y x]
+  from extreme_bounds_equiv[OF y x]
   show "x \<sim> y" by auto
 next
   assume xy: "x \<sim> y"
   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
 
+lemmas semiattractiveI = semiattractive.intro
+
 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
 
+lemma semiattractive_empty[intro!]: "semiattractive {} r"
+  by (auto intro!: semiattractiveI)
+
 locale attractive = semiattractive +
   assumes "semiattractive A (\<sqsubseteq>)\<^sup>-"
 begin
 
-interpretation less_eq_notations.
+interpretation less_eq_symmetrize.
 
 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
 
+lemma extreme_bound_sym_trans:
+  assumes XA: "X \<subseteq> A" and Xx: "extreme_bound A (\<sqsubseteq>) X x"
+    and xy: "x \<sim> y" and yA: "y \<in> A"
+  shows "extreme_bound A (\<sqsubseteq>) X y"
+proof (intro extreme_boundI yA)
+  from Xx have xA: "x \<in> A" by auto
+  {
+    fix b assume Xb: "bound X (\<sqsubseteq>) b" and bA: "b \<in> A"
+    with Xx have xb: "x \<sqsubseteq> b" by auto
+    from sym_order_trans[OF _ xb yA xA bA] xy show "y \<sqsubseteq> b" by auto
+  }
+  fix a assume aX: "a \<in> X"
+  with Xx have ax: "a \<sqsubseteq> x" by auto
+  from aX XA have aA: "a \<in> A" by auto
+  from order_sym_trans[OF ax xy aA xA yA] show "a \<sqsubseteq> y" by auto
+qed
+
 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
 
+lemmas attractiveI = attractive.intro[OF _ attractive_axioms.intro]
+
 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)
 
+lemma attractive_empty[intro!]: "attractive {} r"
+  by (auto intro!: attractiveI)
+
 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
 
+lemmas asymmetricI = asymmetric.intro
+
 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)
+  show ?l by (auto intro!:asymmetricI 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)
 
+lemma asymmetric_empty: "asymmetric {} r"
+  by (auto simp: asymmetric_iff_irreflexive_antisymmetric)
+
 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
 
+lemmas quasi_ordered_setI = quasi_ordered_set.intro
+
 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)
 
+lemma quasi_ordered_set_empty[intro!]: "quasi_ordered_set {} r"
+  by (auto intro!: quasi_ordered_set.intro)
+
+lemma rtranclp_quasi_ordered: "quasi_ordered_set A (rtranclp r)"
+  by (unfold_locales, auto)
+
 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
 
+lemmas near_ordered_setI = near_ordered_set.intro
+
 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)
 
+lemma near_ordered_set_empty[intro!]: "near_ordered_set {} r"
+  by (auto intro!: near_ordered_set.intro)
+
 locale pseudo_ordered_set = reflexive + antisymmetric
 begin
 
-interpretation less_eq_notations.
+interpretation less_eq_symmetrize.
 
 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
 
+lemmas pseudo_ordered_setI = pseudo_ordered_set.intro
+
 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)
 
+lemma pseudo_ordered_set_empty[intro!]: "pseudo_ordered_set {} r"
+  by (auto intro!: pseudo_ordered_setI)
+
 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
 
+lemmas partially_ordered_setI = partially_ordered_set.intro
+
 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)
 
+lemma partially_ordered_set_empty[intro!]: "partially_ordered_set {} r"
+  by (auto intro!: partially_ordered_setI)
+
 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
 
+lemmas strict_ordered_setI = strict_ordered_set.intro
+
 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)
 
+lemma strict_ordered_set_empty[intro!]: "strict_ordered_set {} r"
+  by (auto intro!: strict_ordered_set.intro)
+
 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
 
+lemmas toleranceI = tolerance.intro
+
 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)
 
+lemma tolerance_empty[intro!]: "tolerance {} r" by (auto intro!: toleranceI)
+
 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
 
+lemmas partial_equivalenceI = partial_equivalence.intro[OF _ partial_equivalence_axioms.intro]
+
 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)
 
+lemma partial_equivalence_empty[intro!]: "partial_equivalence {} r"
+  by (auto intro!: partial_equivalenceI)
+
 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
 
+lemmas equivalenceI = equivalence.intro
+
 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
 
 subsection \<open>Totality\<close>
 
-locale semiconnex = related_set A "(\<sqsubset>)" for A and less (infix "\<sqsubset>" 50) +
+locale semiconnex = related_set _ "(\<sqsubset>)" + less_syntax +
   assumes semiconnex: "x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> x \<sqsubset> y \<or> x = y \<or> y \<sqsubset> x"
 begin
 
 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>\<open>\<open>Proposition 2.2.4\<close> in "Schmidt1993"\<close>.\<close>
+lemmas semiconnexI[intro] = semiconnex.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)
+proof (intro iffI semiconnexI antisymmetricI)
   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
 
+lemmas semiconnex_irreflexiveI = semiconnex_irreflexive.intro
+
 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.
+interpretation less_eq_asymmetrize.
 
 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"
+    and not_asym_iff: "\<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)
 
+interpretation less_eq_asymmetrize.
+
 end
 
+lemmas connexI[intro] = connex.intro
+
 lemmas connexE = connex.comparable_cases
 
-lemmas connexI[intro] = connex.intro
+lemma connex_empty: "connex {} A" by auto
 
 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
 
+interpretation less_eq_asymmetrize.
+
+interpretation asympartp: semiconnex_irreflexive A "(\<sqsubset>)"
+proof (intro semiconnex_irreflexive.intro asympartp_irreflexive semiconnexI)
+  fix x y assume xA: "x \<in> A" and yA: "y \<in> A"
+  with comparable antisym
+  show "x \<sqsubset> y \<or> x = y \<or> y \<sqsubset> x" by (auto simp: asympartp_def)
+qed
+
+lemmas asympartp_semiconnex = asympartp.semiconnex_axioms
+lemmas asympartp_semiconnex_irreflexive = asympartp.semiconnex_irreflexive_axioms
+
 end
 
+lemmas total_pseudo_ordered_setI = total_pseudo_ordered_set.intro
+
 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
 
+lemmas total_quasi_ordered_setI = total_quasi_ordered_set.intro
+
 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)
 
+lemma weak_semiconnex: "semiconnex A (\<sqsubseteq>)"
+  using connex_axioms by (simp add: connex_iff_semiconnex_reflexive)
+
+interpretation less_eq_asymmetrize.
+
 end
 
+lemmas total_ordered_setI = total_ordered_set.intro[OF total_quasi_ordered_setI]
+
 lemma total_ordered_set_cong:
   assumes r: "\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> r a b \<longleftrightarrow> r' a b"
   shows "total_ordered_set A r \<longleftrightarrow> total_ordered_set A r'"
   by (simp add: total_ordered_set_def r cong: total_quasi_ordered_set_cong antisymmetric_cong)
 
-subsection \<open>Well-Foundedness\<close>
-
-locale well_founded = related_set A "(\<sqsubset>)" for A and less (infix "\<sqsubset>" 50) +
-  assumes induct[consumes 1, case_names less, induct set]:
-    "a \<in> A \<Longrightarrow> (\<And>x. x \<in> A \<Longrightarrow> (\<And>y. y \<in> A \<Longrightarrow> y \<sqsubset> x \<Longrightarrow> P y) \<Longrightarrow> P x) \<Longrightarrow> P a"
-begin
-
-sublocale asymmetric
-proof (intro asymmetric.intro notI)
-  fix x y
-  assume xA: "x \<in> A"
-  then show "y \<in> A \<Longrightarrow> x \<sqsubset> y \<Longrightarrow> y \<sqsubset> x \<Longrightarrow> False"
-    by (induct arbitrary: y rule: induct, auto)
-qed
-
-lemma prefixed_Imagep_imp_empty:
-  assumes a: "X \<subseteq> ((\<sqsubset>) ``` X) \<inter> A" shows "X = {}"
-proof -
-  from a have XA: "X \<subseteq> A" by auto
-  have "x \<in> A \<Longrightarrow> x \<notin> X" for x
-  proof (induct x rule: induct)
-    case (less x)
-    with a show ?case by (auto simp: Imagep_def)
-  qed
-  with XA show ?thesis by auto
-qed
-
-lemma nonempty_imp_ex_extremal:
-  assumes QA: "Q \<subseteq> A" and Q: "Q \<noteq> {}"
-  shows "\<exists>z \<in> Q. \<forall>y \<in> Q. \<not> y \<sqsubset> z"
-  using Q prefixed_Imagep_imp_empty[of Q] QA by (auto simp: Imagep_def)
-
-interpretation Restrp: well_founded UNIV "(\<sqsubset>)\<restriction>A"
-  rewrites "\<And>x. x \<in> UNIV \<equiv> True"
-    and "(\<sqsubset>)\<restriction>A\<restriction>UNIV = (\<sqsubset>)\<restriction>A"
-    and "\<And>P1. (True \<Longrightarrow> PROP P1) \<equiv> PROP P1"
-    and "\<And>P1. (True \<Longrightarrow> P1) \<equiv> Trueprop P1"
-    and "\<And>P1 P2. (True \<Longrightarrow> PROP P1 \<Longrightarrow> PROP P2) \<equiv> (PROP P1 \<Longrightarrow> PROP P2)"
-proof -
-  have "(\<And>x. (\<And>y. ((\<sqsubset>) \<restriction> A) y x \<Longrightarrow> P y) \<Longrightarrow> P x) \<Longrightarrow> P a" for a P
-    using induct[of a P] by (auto simp: Restrp_def)
-  then show "well_founded UNIV ((\<sqsubset>)\<restriction>A)" apply unfold_locales by auto
-qed auto
-
-lemmas Restrp_well_founded = Restrp.well_founded_axioms
-lemmas Restrp_induct[consumes 0, case_names less] = Restrp.induct
-
-interpretation Restrp.tranclp: well_founded UNIV "((\<sqsubset>)\<restriction>A)\<^sup>+\<^sup>+"
-  rewrites "\<And>x. x \<in> UNIV \<equiv> True"
-    and "((\<sqsubset>)\<restriction>A)\<^sup>+\<^sup>+ \<restriction> UNIV = ((\<sqsubset>)\<restriction>A)\<^sup>+\<^sup>+"
-    and "(((\<sqsubset>)\<restriction>A)\<^sup>+\<^sup>+)\<^sup>+\<^sup>+ = ((\<sqsubset>)\<restriction>A)\<^sup>+\<^sup>+"
-    and "\<And>P1. (True \<Longrightarrow> PROP P1) \<equiv> PROP P1"
-    and "\<And>P1. (True \<Longrightarrow> P1) \<equiv> Trueprop P1"
-    and "\<And>P1 P2. (True \<Longrightarrow> PROP P1 \<Longrightarrow> PROP P2) \<equiv> (PROP P1 \<Longrightarrow> PROP P2)"
-proof-
-  { fix P x
-    assume induct_step: "\<And>x. (\<And>y. ((\<sqsubset>)\<restriction>A)\<^sup>+\<^sup>+ y x \<Longrightarrow> P y) \<Longrightarrow> P x"
-    have "P x"
-    proof (rule induct_step)
-      show "\<And>y. ((\<sqsubset>)\<restriction>A)\<^sup>+\<^sup>+ y x \<Longrightarrow> P y"
-      proof (induct x rule: Restrp_induct)
-        case (less x)
-        from \<open>((\<sqsubset>)\<restriction>A)\<^sup>+\<^sup>+ y x\<close>
-        show ?case
-        proof (cases rule: tranclp.cases)
-          case r_into_trancl
-          with induct_step less show ?thesis by auto
-        next
-          case (trancl_into_trancl b)
-          with less show ?thesis by auto
-        qed
-      qed
-    qed
-  }
-  then show "well_founded UNIV ((\<sqsubset>)\<restriction>A)\<^sup>+\<^sup>+" by unfold_locales auto
-qed auto
-
-lemmas Restrp_tranclp_well_founded = Restrp.tranclp.well_founded_axioms
-lemmas Restrp_tranclp_induct[consumes 0, case_names less] = Restrp.tranclp.induct
-
-end
-
-context
-  fixes A :: "'a set" and less :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubset>" 50)
-begin
-
-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
-
-lemma well_foundedI_extremal:
-  assumes a: "\<And>X. X \<subseteq> A \<Longrightarrow> X \<noteq> {} \<Longrightarrow> \<exists>x \<in> X. \<forall>y \<in> X. \<not> y \<sqsubset> x"
-  shows "well_founded A (\<sqsubset>)"
-proof (rule well_foundedI_pf)
-  fix X assume XA: "X \<subseteq> A" and pf: "X \<subseteq> ((\<sqsubset>) ``` X) \<inter> A"
-  from a[OF XA] pf show "X = {}" by (auto simp: Imagep_def)
-qed
-
-lemma well_founded_iff_ex_extremal:
-  "well_founded A (\<sqsubset>) \<longleftrightarrow> (\<forall>X \<subseteq> A. X \<noteq> {} \<longrightarrow> (\<exists>x \<in> X. \<forall>z \<in> X. \<not> z \<sqsubset> x))"
-  using well_founded.nonempty_imp_ex_extremal well_foundedI_extremal by blast
-
-end
-
-lemma well_founded_cong:
-  assumes r: "\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> r a b \<longleftrightarrow> r' a b"
-    and A: "\<And>a b. r' a b \<Longrightarrow> a \<in> A \<longleftrightarrow> a \<in> A'"
-    and B: "\<And>a b. r' a b \<Longrightarrow> b \<in> A \<longleftrightarrow> b \<in> A'"
-  shows "well_founded A r \<longleftrightarrow> well_founded A' r'"
-proof (intro iffI)
-  assume wf: "well_founded A r"
-  show "well_founded A' r'"
-  proof (intro well_foundedI_extremal)
-    fix X
-    assume X: "X \<subseteq> A'" and X0: "X \<noteq> {}"
-    show "\<exists>x\<in>X. \<forall>y\<in>X. \<not> r' y x"
-    proof (cases "X \<inter> A = {}")
-      case True
-      from X0 obtain x where xX: "x \<in> X" by auto
-      with True have "x \<notin> A" by auto
-      with xX X have "\<forall>y\<in>X. \<not> r' y x" by (auto simp: B)
-      with xX show ?thesis by auto
-    next
-      case False
-      from well_founded.nonempty_imp_ex_extremal[OF wf _ this]
-      obtain x where x: "x \<in> X \<inter> A" and Ar: "\<And>y. y \<in> X \<Longrightarrow> y \<in> A \<Longrightarrow> \<not> r y x" by auto
-      have "\<forall>y \<in> X. \<not> r' y x"
-      proof (intro ballI notI)
-        fix y assume yX: "y \<in> X" and yx: "r' y x"
-        from yX X have yA': "y \<in> A'" by auto
-        show False
-        proof (cases "y \<in> A")
-          case True with x Ar[OF yX] yx r show ?thesis by auto
-        next
-          case False with yA' x A[OF yx] r X show ?thesis by (auto simp:)
-        qed
-      qed
-      with x show "\<exists>x \<in> X. \<forall>y \<in> X. \<not> r' y x" by auto
-    qed
-  qed
-next
-  assume wf: "well_founded A' r'"
-  show "well_founded A r"
-  proof (intro well_foundedI_extremal)
-    fix X
-    assume X: "X \<subseteq> A" and X0: "X \<noteq> {}"
-    show "\<exists>x\<in>X. \<forall>y\<in>X. \<not> r y x"
-    proof (cases "X \<inter> A' = {}")
-      case True
-      from X0 obtain x where xX: "x \<in> X" by auto
-      with True have "x \<notin> A'" by auto
-      with xX X B have "\<forall>y\<in>X. \<not> r y x" by (auto simp: r in_mono)
-      with xX show ?thesis by auto
-    next
-      case False
-      from well_founded.nonempty_imp_ex_extremal[OF wf _ this]
-      obtain x where x: "x \<in> X \<inter> A'" and Ar: "\<And>y. y \<in> X \<Longrightarrow> y \<in> A' \<Longrightarrow> \<not> r' y x" by auto
-      have "\<forall>y \<in> X. \<not> r y x"
-      proof (intro ballI notI)
-        fix y assume yX: "y \<in> X" and yx: "r y x"
-        from yX X have y: "y \<in> A" by auto
-        show False
-        proof (cases "y \<in> A'")
-          case True with x Ar[OF yX] yx r X y show ?thesis by auto
-        next
-          case False with y x A yx r X show ?thesis by auto
-        qed
-      qed
-      with x show "\<exists>x \<in> X. \<forall>y \<in> X. \<not> r y x" by auto
-    qed
-  qed
-qed
-
-lemma wfP_iff_well_founded_UNIV: "wfP r \<longleftrightarrow> well_founded UNIV r"
-  by (auto simp: wfP_def wf_def well_founded_def)
-
-lemma well_founded_singleton:
-  assumes "\<not>r x x" shows "well_founded {x} r"
-  using assms by (auto simp: well_founded_iff_ex_extremal)
-
-lemma well_founded_Restrp[simp]: "well_founded A (r\<restriction>B) \<longleftrightarrow> well_founded (A\<inter>B) r" (is "?l \<longleftrightarrow> ?r")
-proof (intro iffI well_foundedI_extremal)
-  assume l: ?l
-  fix X assume XAB: "X \<subseteq> A \<inter> B" and X0: "X \<noteq> {}"
-  with l[THEN well_founded.nonempty_imp_ex_extremal]
-  have "\<exists>x\<in>X. \<forall>z\<in>X. \<not> (r \<restriction> B) z x" by auto
-  with XAB show "\<exists>x\<in>X. \<forall>y\<in>X. \<not> r y x" by (auto simp: Restrp_def)
-next
-  assume r: ?r
-  fix X assume XA: "X \<subseteq> A" and X0: "X \<noteq> {}"
-  show "\<exists>x\<in>X. \<forall>y\<in>X. \<not> (r \<restriction> B) y x"
-  proof (cases "X \<subseteq> B")
-    case True
-    with r[THEN well_founded.nonempty_imp_ex_extremal, of X] XA X0
-    have "\<exists>z\<in>X. \<forall>y\<in>X. \<not> r y z" by auto
-    then show ?thesis by auto
-  next
-    case False
-    then obtain x where x: "x \<in> X - B" by auto
-    then have "\<forall>y\<in>X. \<not> (r \<restriction> B) y x" by auto
-    with x show ?thesis by auto
-  qed
-qed
-
-lemma (in well_founded) well_founded_subset:
-  assumes "B \<subseteq> A" shows "well_founded B (\<sqsubset>)"
-  using assms well_founded_axioms by (auto simp: well_founded_iff_ex_extremal)
-
-lemma well_founded_extend:
-  fixes less (infix "\<sqsubset>" 50)
-  assumes A: "well_founded A (\<sqsubset>)"
-  assumes B: "well_founded B (\<sqsubset>)"
-  assumes AB: "\<forall>a \<in> A. \<forall>b \<in> B. \<not>b \<sqsubset> a"
-  shows "well_founded (A \<union> B) (\<sqsubset>)"
-proof (intro well_foundedI_extremal)
-  interpret A: well_founded A "(\<sqsubset>)" using A.
-  interpret B: well_founded B "(\<sqsubset>)" using B.
-  fix X assume XAB: "X \<subseteq> A \<union> B" and X0: "X \<noteq> {}"
-  show "\<exists>x\<in>X. \<forall>y\<in>X. \<not> y \<sqsubset> x"
-  proof (cases "X \<inter> A = {}")
-    case True
-    with XAB have XB: "X \<subseteq> B" by auto
-    from B.nonempty_imp_ex_extremal[OF XB X0] show ?thesis.
-  next
-    case False
-    with A.nonempty_imp_ex_extremal[OF _ this]
-    obtain e where XAe: "e \<in> X \<inter> A" "\<forall>y\<in>X \<inter> A. \<not> y \<sqsubset> e" by auto
-    then have eX: "e \<in> X" and eA: "e \<in> A" by auto
-    { fix x assume xX: "x \<in> X"
-      have "\<not>x \<sqsubset> e"
-      proof (cases "x \<in> A")
-        case True with XAe xX show ?thesis by auto
-      next
-        case False
-        with xX XAB have "x \<in> B" by auto
-        with AB eA show ?thesis by auto
-      qed
-    }
-    with eX show ?thesis by auto
-  qed
-qed
-
-lemma closed_UN_well_founded:
-  fixes r (infix "\<sqsubset>" 50)
-  assumes XX: "\<forall>X\<in>XX. well_founded X (\<sqsubset>) \<and> (\<forall>x\<in>X. \<forall>y\<in>\<Union>XX. y \<sqsubset> x \<longrightarrow> y \<in> X)"
-  shows "well_founded (\<Union>XX) (\<sqsubset>)"
-proof (intro well_foundedI_extremal)
-  have *: "X \<in> XX \<Longrightarrow> x\<in>X \<Longrightarrow> y \<in> \<Union>XX \<Longrightarrow> y \<sqsubset> x \<Longrightarrow> y \<in> X" for X x y using XX by blast
-  fix S
-  assume S: "S \<subseteq> \<Union>XX" and S0: "S \<noteq> {}"
-  from S0 obtain x where xS: "x \<in> S" by auto
-  with S obtain X where X: "X \<in> XX" and xX: "x \<in> X" by auto
-  from xS xX have Sx0: "S \<inter> X \<noteq> {}" by auto
-  from X XX interpret well_founded X "(\<sqsubset>)" by auto
-  from nonempty_imp_ex_extremal[OF _ Sx0]
-  obtain z where zS: "z \<in> S" and zX: "z \<in> X" and min: "\<forall>y \<in> S \<inter> X. \<not> y \<sqsubset> z" by auto
-  show "\<exists>x\<in>S. \<forall>y\<in>S. \<not> y \<sqsubset> x"
-  proof (intro bexI[OF _ zS] ballI notI)
-    fix y
-    assume yS: "y \<in> S" and yz: "y \<sqsubset> z"
-    have yXX: "y \<in> \<Union> XX" using S yS by auto
-    from *[OF X zX yXX yz] yS have "y \<in> X \<inter> S" by auto
-    with min yz show False by auto
-  qed
-qed
-
-lemma well_founded_cmono:
-  assumes r': "r' \<le> r" and wf: "well_founded A r"
-  shows "well_founded A r'"
-proof (intro well_foundedI_extremal)
-  fix X assume "X \<subseteq> A" and "X \<noteq> {}"
-  from well_founded.nonempty_imp_ex_extremal[OF wf this]
-  show "\<exists>x\<in>X. \<forall>y\<in>X. \<not> r' y x" using r' by auto
-qed
-
-locale well_founded_ordered_set = well_founded + transitive _ "(\<sqsubset>)"
-begin
-
-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
-
-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
-
-lemmas connex_axioms = connex_axioms
-
-interpretation less_eq_notations.
-
-sublocale asym: well_founded A "(\<sqsubset>)"
-proof (unfold well_founded_iff_ex_extremal, intro allI impI)
-  fix X
-  assume XA: "X \<subseteq> A" and X0: "X \<noteq> {}"
-  from nonempty_imp_ex_extreme[OF XA X0] obtain e where "extreme X (\<sqsubseteq>)\<^sup>- e" by auto
-  then show "\<exists>x\<in>X. \<forall>z\<in>X. \<not>z \<sqsubset> x" by (auto intro!: bexI[of _ e])
-qed
-
-lemma well_related_subset: "B \<subseteq> A \<Longrightarrow> well_related_set B (\<sqsubseteq>)"
-  by (auto intro!: well_related_set.intro nonempty_imp_ex_extreme)
-
-end
-
-context
-  fixes less_eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
-begin
-
-lemma well_related_iff_neg_well_founded:
-  "well_related_set A (\<sqsubseteq>) \<longleftrightarrow> well_founded A (\<lambda>x y. \<not> y \<sqsubseteq> x)"
-  by (simp add: well_related_set_def well_founded_iff_ex_extremal extreme_def Bex_def)
-
-lemma well_related_singleton_refl: 
-  assumes "x \<sqsubseteq> x" shows "well_related_set {x} (\<sqsubseteq>)"
-  by (intro well_related_set.intro exI[of _ x], auto simp: subset_singleton_iff assms)
-
-lemma closed_UN_well_related:
-  assumes XX: "\<forall>X\<in>XX. well_related_set X (\<sqsubseteq>) \<and> (\<forall>x\<in>X. \<forall>y\<in>\<Union>XX. \<not>x \<sqsubseteq> y \<longrightarrow> y \<in> X)"
-  shows "well_related_set (\<Union>XX) (\<sqsubseteq>)"
-  using XX
-  apply (unfold well_related_iff_neg_well_founded)
-  using closed_UN_well_founded[of _ "\<lambda>x y. \<not> y \<sqsubseteq> x"].
-
-end
-
-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
-
-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
-
-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 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
-
-lemma (in antisymmetric) well_ordered_iff_well_related:
-  assumes XA: "X \<subseteq> A"
-  shows "well_ordered_set X (\<sqsubseteq>) \<longleftrightarrow> well_related_set X (\<sqsubseteq>)" (is "?l \<longleftrightarrow> ?r")
-proof
-  interpret X: antisymmetric X using antisymmetric_subset[OF XA].
-  { assume ?l
-    then interpret X: well_ordered_set X.
-    show ?r by unfold_locales
-  }
-  assume ?r
-  then interpret X: well_related_set X.
-  show ?l by unfold_locales
-qed
-
-context
-  fixes A and less_eq (infix "\<sqsubseteq>" 50)
-  assumes A: "\<forall>a \<in> A. \<forall>b \<in> A. a \<sqsubseteq> b"
-begin
-
-interpretation well_related_set A "(\<sqsubseteq>)"
-  apply unfold_locales
-  using A by blast
-
-lemmas trivial_well_related = well_related_set_axioms
-
-lemma trivial_pre_well_order: "pre_well_ordered_set A (\<sqsubseteq>)"
-  apply unfold_locales
-  using A by blast
-
-end
-
-context
-  fixes less_eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
-begin
-
-interpretation less_eq_notations.
-
-lemma well_order_extend:
-  assumes A: "well_ordered_set A (\<sqsubseteq>)" and B: "well_ordered_set B (\<sqsubseteq>)"
-    and ABa: "\<forall>a \<in> A. \<forall>b \<in> B. a \<sqsubseteq> b \<longrightarrow> b \<sqsubseteq> a \<longrightarrow> a = b"
-    and AB: "\<forall>a \<in> A. \<forall>b \<in> B. a \<sqsubseteq> b"
-  shows "well_ordered_set (A\<union>B) (\<sqsubseteq>)"
-proof-
-  interpret A: well_ordered_set A "(\<sqsubseteq>)" using A.
-  interpret B: well_ordered_set B "(\<sqsubseteq>)" using B.
-  show ?thesis
-    apply (intro well_ordered_set.intro antisymmetric_union well_related_extend ABa AB)
-    by unfold_locales
-qed
-
-interpretation singleton: antisymmetric "{a}" "(\<sqsubseteq>)" for a apply unfold_locales by auto
-
-lemmas singleton_antisymmetric[intro!] = singleton.antisymmetric_axioms
-
-lemma singleton_well_ordered[intro!]: "a \<sqsubseteq> a \<Longrightarrow> well_ordered_set {a} (\<sqsubseteq>)"
-  apply unfold_locales by auto
-
-lemma closed_UN_well_ordered:
-  assumes anti: "antisymmetric (\<Union> XX) (\<sqsubseteq>)"
-    and XX: "\<forall>X\<in>XX. well_ordered_set X (\<sqsubseteq>) \<and> (\<forall>x\<in>X. \<forall>y\<in>\<Union>XX. \<not> x \<sqsubseteq> y \<longrightarrow> y \<in> X)"
-  shows "well_ordered_set (\<Union>XX) (\<sqsubseteq>)"
-  apply (intro well_ordered_set.intro closed_UN_well_related anti)
-  using XX well_ordered_set.axioms by fast
-
-end
-
-text \<open>Directed sets:\<close>
-
-definition "directed A r \<equiv> \<forall>x \<in> A. \<forall>y \<in> A. \<exists>z \<in> A. r x z \<and> r y z"
-
-lemmas directedI[intro] = directed_def[unfolded atomize_eq, THEN iffD2, rule_format]
-
-lemmas directedD = directed_def[unfolded atomize_eq, THEN iffD1, rule_format]
-
-context
-  fixes less_eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
-begin
-
-lemma directedE:
-  assumes "directed A (\<sqsubseteq>)" and "x \<in> A" and "y \<in> A"
-    and "\<And>z. z \<in> A \<Longrightarrow> x \<sqsubseteq> z \<Longrightarrow> y \<sqsubseteq> z \<Longrightarrow> thesis"
-  shows "thesis"
-  using assms by (auto dest: directedD)
-
-lemma directed_empty[simp]: "directed {} (\<sqsubseteq>)" by auto
-
-lemma directed_union:
-  assumes dX: "directed X (\<sqsubseteq>)" and dY: "directed Y (\<sqsubseteq>)"
-    and XY: "\<forall>x\<in>X. \<forall>y\<in>Y. \<exists>z \<in> X \<union> Y. x \<sqsubseteq> z \<and> y \<sqsubseteq> z"
-  shows "directed (X \<union> Y) (\<sqsubseteq>)"
-  using directedD[OF dX] directedD[OF dY] XY
-  apply (intro directedI) by blast
-
-lemma directed_extend:
-  assumes X: "directed X (\<sqsubseteq>)" and Y: "directed Y (\<sqsubseteq>)" and XY: "\<forall>x\<in>X. \<forall>y\<in>Y. x \<sqsubseteq> y"
-  shows "directed (X \<union> Y) (\<sqsubseteq>)"
-proof -
-  { fix x y
-    assume xX: "x \<in> X" and yY: "y \<in> Y"
-    let ?g = "\<exists>z\<in>X \<union> Y. x \<sqsubseteq> z \<and> y \<sqsubseteq> z"
-    from directedD[OF Y yY yY] obtain z where zY: "z \<in> Y" and yz: "y \<sqsubseteq> z" by auto
-    from xX XY zY yz have ?g by auto
-  }
-  then show ?thesis by (auto intro!: directed_union[OF X Y])
-qed
-
-end
-
-context connex begin
-
-lemma directed: "directed A (\<sqsubseteq>)"
-proof
-  fix x y
-  assume x: "x \<in> A" and y: "y \<in> A"
-  then show "\<exists>z\<in>A. x \<sqsubseteq> z \<and> y \<sqsubseteq> z"
-  proof (cases rule: comparable_cases)
-    case le
-    with refl[OF y] y show ?thesis by (intro bexI[of _ y], auto)
-  next
-    case ge
-    with refl[OF x] x show ?thesis by (intro bexI[of _ x], auto)
-  qed
-qed
-
-end
-
-context
-  fixes ir :: "'i \<Rightarrow> 'i \<Rightarrow> bool" (infix "\<preceq>" 50)
-  fixes r :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
-begin
 
 lemma monotone_connex_image:
-  assumes mono: "monotone_on I (\<preceq>) (\<sqsubseteq>) f"
-  assumes connex: "connex I (\<preceq>)"
+  fixes ir (infix "\<preceq>" 50) and r (infix "\<sqsubseteq>" 50)
+  assumes mono: "monotone_on I (\<preceq>) (\<sqsubseteq>) f" and 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 = 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 +
+text \<open>We pair a relation (weak part) with a well-behaving ``strict'' part. Here no assumption is
+ put on the ``weak'' part.\<close>
+
+locale compatible_ordering =
+  related_set + irreflexive +
   assumes strict_implies_weak: "x \<sqsubset> y \<Longrightarrow> x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> x \<sqsubseteq> y"
+  assumes weak_strict_trans[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 strict_weak_trans[trans]: "x \<sqsubset> y \<Longrightarrow> y \<sqsubseteq> z \<Longrightarrow> x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> z \<in> A \<Longrightarrow> x \<sqsubset> z"
 begin
 
-text \<open>The strict part is necessarily transitive.\<close>
-
 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>
 
+text \<open>The strict part is necessarily transitive.\<close>
+
 sublocale strict: transitive A "(\<sqsubset>)"
-  using compat_right[OF strict_implies_weak] by unfold_locales
+  using weak_strict_trans[OF strict_implies_weak] by unfold_locales
 
 sublocale strict_ordered_set A "(\<sqsubset>)" ..
 
 thm strict.trans asym irrefl
 
+lemma Restrp_compatible_ordering: "compatible_ordering UNIV ((\<sqsubseteq>)\<restriction>A) ((\<sqsubset>)\<restriction>A)"
+  apply (unfold_locales)
+  by (auto dest: weak_strict_trans strict_weak_trans strict_implies_weak)
+
 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
+  using irrefl weak_strict_trans by blast
+
+lemma weak_implies_not_strict:
+  assumes xy: "x \<sqsubseteq> y" and [simp]: "x \<in> A" "y \<in> A"
+  shows "\<not>y \<sqsubset> x"
+proof 
+  assume "y \<sqsubset> x"
+  also note xy
+  finally show False using irrefl by auto
+qed
+
+lemma compatible_ordering_subset: assumes "X \<subseteq> A" shows "compatible_ordering X (\<sqsubseteq>) (\<sqsubset>)"
+  apply unfold_locales
+  using assms strict_implies_weak by (auto intro: strict_weak_trans weak_strict_trans)
 
 end
 
 context transitive begin
 
-interpretation less_eq_notations.
+interpretation less_eq_asymmetrize.
 
 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 + pseudo_ordered_set
-begin
-
-sublocale attractive_ordering ..
-
-end
-
-locale quasi_ordering = compatible_ordering + quasi_ordered_set
-begin
-
-sublocale attractive_ordering ..
+lemma asympartp_compatible_ordering: "compatible_ordering A (\<sqsubseteq>) (\<sqsubset>)"
+  apply unfold_locales
+  by (auto dest: asym_trans)
 
 end
 
-locale partial_ordering = compatible_ordering + partially_ordered_set
+locale reflexive_ordering = reflexive + compatible_ordering
+
+locale reflexive_attractive_ordering = reflexive_ordering + attractive
+
+locale pseudo_ordering = pseudo_ordered_set + compatible_ordering
 begin
 
-sublocale pseudo_ordering + quasi_ordering ..
+sublocale reflexive_attractive_ordering..
 
 end
 
-locale well_founded_ordering = quasi_ordering + well_founded
-
-locale total_ordering = compatible_ordering + total_ordered_set
+locale quasi_ordering = quasi_ordered_set + compatible_ordering
 begin
 
-sublocale partial_ordering ..
+sublocale reflexive_attractive_ordering..
+
+lemma quasi_ordering_subset: assumes "X \<subseteq> A" shows "quasi_ordering X (\<sqsubseteq>) (\<sqsubset>)"
+  by (intro quasi_ordering.intro quasi_ordered_subset compatible_ordering_subset assms)
 
 end
 
-locale strict_total_ordering = partial_ordering + semiconnex A "(\<sqsubset>)"
+context quasi_ordered_set begin
+
+interpretation less_eq_asymmetrize.
+
+lemma asympartp_quasi_ordering: "quasi_ordering A (\<sqsubseteq>) (\<sqsubset>)"
+  by (intro quasi_ordering.intro quasi_ordered_set_axioms asympartp_compatible_ordering)
+
+end
+
+locale partial_ordering = partially_ordered_set + compatible_ordering
+begin
+
+sublocale quasi_ordering + pseudo_ordering..
+
+lemma partial_ordering_subset: assumes "X \<subseteq> A" shows "partial_ordering X (\<sqsubseteq>) (\<sqsubset>)"
+  by (intro partial_ordering.intro partially_ordered_subset compatible_ordering_subset assms)
+
+end
+
+context partially_ordered_set begin
+
+interpretation less_eq_asymmetrize.
+
+lemma asympartp_partial_ordering: "partial_ordering A (\<sqsubseteq>) (\<sqsubset>)"
+  by (intro partial_ordering.intro partially_ordered_set_axioms asympartp_compatible_ordering)
+
+end
+
+locale total_quasi_ordering = total_quasi_ordered_set + compatible_ordering
+begin
+
+sublocale quasi_ordering..
+
+lemma total_quasi_ordering_subset: assumes "X \<subseteq> A" shows "total_quasi_ordering X (\<sqsubseteq>) (\<sqsubset>)"
+  by (intro total_quasi_ordering.intro total_quasi_ordered_subset compatible_ordering_subset assms)
+
+end
+
+context total_quasi_ordered_set begin
+
+interpretation less_eq_asymmetrize.
+
+lemma asympartp_total_quasi_ordering: "total_quasi_ordering A (\<sqsubseteq>) (\<sqsubset>)"
+  by (intro total_quasi_ordering.intro total_quasi_ordered_set_axioms asympartp_compatible_ordering)
+
+end
+
+
+text \<open>Fixing the definition of the strict part is very common, though it looks restrictive
+to the author.\<close>
+locale strict_quasi_ordering = quasi_ordered_set + less_syntax +
+  assumes strict_iff: "x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> x \<sqsubset> y \<longleftrightarrow> x \<sqsubseteq> y \<and> \<not>y \<sqsubseteq> x"
+begin
+
+sublocale compatible_ordering
+proof unfold_locales
+  fix x y z
+  show "x \<in> A \<Longrightarrow> \<not> x \<sqsubset> x" by (auto simp: strict_iff)
+  { assume xy: "x \<sqsubseteq> y" and yz: "y \<sqsubset> z" and x: "x \<in> A" and y: "y \<in> A" and z: "z \<in> A"
+    from yz y z have ywz: "y \<sqsubseteq> z" and zy: "\<not>z \<sqsubseteq> y" by (auto simp: strict_iff)
+    from trans[OF xy ywz]x y z have xz: "x \<sqsubseteq> z" by auto
+    from trans[OF _ xy] x y z zy have zx: "\<not>z \<sqsubseteq> x" by auto 
+    from xz zx x z show "x \<sqsubset> z" by (auto simp: strict_iff)
+  }
+  { assume xy: "x \<sqsubset> y" and yz: "y \<sqsubseteq> z" and x: "x \<in> A" and y: "y \<in> A" and z: "z \<in> A"
+    from xy x y have xwy: "x \<sqsubseteq> y" and yx: "\<not>y \<sqsubseteq> x" by (auto simp: strict_iff)
+    from trans[OF xwy yz]x y z have xz: "x \<sqsubseteq> z" by auto
+    from trans[OF yz] x y z yx have zx: "\<not>z \<sqsubseteq> x" by auto 
+    from xz zx x z show "x \<sqsubset> z" by (auto simp: strict_iff)
+  }
+  { show "x \<sqsubset> y \<Longrightarrow> x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> x \<sqsubseteq> y" by (auto simp: strict_iff) }
+qed
+
+end
+
+locale strict_partial_ordering = strict_quasi_ordering + antisymmetric
+begin
+
+sublocale partial_ordering..
+
+lemma strict_iff_neq: "x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> x \<sqsubset> y \<longleftrightarrow> x \<sqsubseteq> y \<and> x \<noteq> y"
+  by (auto simp: strict_iff antisym)
+
+end
+
+locale total_ordering = reflexive + compatible_ordering + semiconnex A "(\<sqsubset>)"
 begin
 
 sublocale semiconnex_irreflexive ..
 
 sublocale connex
 proof
   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)
+    by (cases rule: cases, 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]:
+lemma not_weak:
   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"
+lemma not_strict: "x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> \<not> x \<sqsubset> y \<longleftrightarrow> y \<sqsubseteq> x"
   using not_weak by blast
 
+sublocale strict_partial_ordering
+proof
+  fix a b
+  assume a: "a \<in> A" and b: "b \<in> A"
+  then show "a \<sqsubset> b \<longleftrightarrow> a \<sqsubseteq> b \<and> \<not> b \<sqsubseteq> a" by (auto simp: not_strict[symmetric] dest: asym)
+next
+  fix x y z assume xy: "x \<sqsubseteq> y" and yz: "y \<sqsubseteq> z" and xA: "x \<in> A" and yA: "y \<in> A" and zA: "z \<in> A"
+  with weak_strict_trans[OF yz] show "x \<sqsubseteq> z" by (auto simp: not_strict[symmetric])
+next
+  fix x y assume xy: "x \<sqsubseteq> y" and yx: "y \<sqsubseteq> x" and xA: "x \<in> A" and yA: "y \<in> A"
+  with semiconnex show "x = y" by (auto dest: weak_implies_not_strict)
+qed
+
+sublocale total_ordered_set..
+
+context
+  fixes s
+  assumes s: "\<forall>x \<in> A. x \<sqsubset> s \<longrightarrow> (\<exists>z \<in> A. x \<sqsubset> z \<and> z \<sqsubset> s)" and sA: "s \<in> A"
+begin
+
+lemma dense_weakI:
+  assumes bound: "\<And>x. x \<sqsubset> s \<Longrightarrow> x \<in> A \<Longrightarrow> x \<sqsubseteq> y" and yA: "y \<in> A"
+  shows "s \<sqsubseteq> y"
+proof (rule ccontr)
+  assume "\<not> ?thesis"
+  with yA sA have "y \<sqsubset> s" by (simp add: not_weak)
+  from s[rule_format, OF yA this]
+  obtain x where xA: "x \<in> A" and xs: "x \<sqsubset> s" and yx: "y \<sqsubset> x" by safe
+  have xy: "x \<sqsubseteq> y" using bound[OF xs xA] .
+  from yx xy xA yA
+  show False by (simp add: weak_implies_not_strict)
+qed
+
+lemma dense_bound_iff:
+  assumes bA: "b \<in> A" shows "bound {x\<in>A. x \<sqsubset> s} (\<sqsubseteq>) b \<longleftrightarrow> s \<sqsubseteq> b"
+  using assms sA
+  by (auto simp: bound_def intro: strict_implies_weak strict_weak_trans dense_weakI)
+
+lemma dense_extreme_bound:
+  "extreme_bound A (\<sqsubseteq>) {x \<in> A. x \<sqsubset> s} s"
+  by (auto intro!: extreme_boundI intro: strict_implies_weak simp: dense_bound_iff sA)
+
 end
 
+lemma ordinal_cases[consumes 1, case_names suc lim]:
+  assumes aA: "a \<in> A"
+    and suc: "\<And>p. extreme {x \<in> A. x \<sqsubset> a} (\<sqsubseteq>) p \<Longrightarrow> thesis"
+    and lim: "extreme_bound A (\<sqsubseteq>) {x \<in> A. x \<sqsubset> a} a \<Longrightarrow> thesis"
+  shows "thesis"
+proof (cases "\<exists>p. extreme {x \<in> A. x \<sqsubset> a} (\<sqsubseteq>) p")
+  case True
+  with suc show ?thesis by auto
+next
+  case False
+  show ?thesis
+  proof (rule lim, rule dense_extreme_bound, safe intro!: aA)
+    fix x assume xA: "x \<in> A" and xa: "x \<sqsubset> a"
+    show "\<exists>z\<in>A. x \<sqsubset> z \<and> z \<sqsubset> a"
+    proof (rule ccontr)
+      assume "\<not>?thesis"
+      with xA xa have "extreme {x \<in> A. x \<sqsubset> a} (\<sqsubseteq>) x" by (auto simp: not_strict)
+      with False show False by auto
+    qed
+  qed
+qed
+
+end
+
+context total_ordered_set begin
+
+interpretation less_eq_asymmetrize.
+
+lemma asympartp_total_ordering: "total_ordering A (\<sqsubseteq>) (\<sqsubset>)"
+  by (intro total_ordering.intro reflexive_axioms asympartp_compatible_ordering asympartp_semiconnex)
+
+end
+
+subsection \<open>Functions\<close>
+
+definition "pointwise I r f g \<equiv> \<forall>i \<in> I. r (f i) (g i)"
+
+lemmas pointwiseI = pointwise_def[unfolded atomize_eq, THEN iffD2, rule_format]
+
+lemmas pointwiseD[simp] = pointwise_def[unfolded atomize_eq, THEN iffD1, rule_format]
+
+lemma pointwise_cong:
+  assumes "r = r'" "\<And>i. i \<in> I \<Longrightarrow> f i = f' i" "\<And>i. i \<in> I \<Longrightarrow> g i = g' i"
+  shows "pointwise I r f g = pointwise I r' f' g'"
+  using assms by (auto simp: pointwise_def)
+
+lemma pointwise_empty[simp]: "pointwise {} = \<top>" by (auto intro!: ext pointwiseI)
+
+lemma dual_pointwise[simp]: "(pointwise I r)\<^sup>- = pointwise I r\<^sup>-"
+  by (auto intro!: ext pointwiseI dest: pointwiseD)
+
+lemma pointwise_dual: "pointwise I r\<^sup>- f g \<Longrightarrow> pointwise I r g f" by (auto simp: pointwise_def)
+
+lemma pointwise_un: "pointwise (I\<union>J) r = pointwise I r \<sqinter> pointwise J r"
+  by (auto intro!: ext pointwiseI)
+
+lemma pointwise_unI[intro!]: "pointwise I r f g \<Longrightarrow> pointwise J r f g \<Longrightarrow> pointwise (I \<union> J) r f g"
+  by (auto simp: pointwise_un)
+
+lemma pointwise_bound: "bound F (pointwise I r) f \<longleftrightarrow> (\<forall>i \<in> I. bound {f i |. f \<in> F} r (f i))"
+  by (auto intro!:pointwiseI elim!: boundE)
+
+lemma pointwise_extreme:
+  shows "extreme F (pointwise X r) e \<longleftrightarrow> e \<in> F \<and> (\<forall>x \<in> X. extreme {f x |. f \<in> F} r (e x))"
+  by (auto intro!: pointwiseI extremeI elim!: extremeE)
+
+lemma pointwise_extreme_bound:
+  fixes r (infix "\<sqsubseteq>" 50)
+  assumes F: "F \<subseteq> {f. f ` X \<subseteq> A}"
+  shows "extreme_bound {f. f ` X \<subseteq> A} (pointwise X (\<sqsubseteq>)) F s \<longleftrightarrow>
+    (\<forall>x \<in> X. extreme_bound A (\<sqsubseteq>) {f x |. f \<in> F} (s x))" (is "?p \<longleftrightarrow> ?a")
+proof (safe intro!: extreme_boundI pointwiseI)
+  fix x
+  assume s: ?p and xX: "x \<in> X"
+  { fix b
+    assume b: "bound {f x |. f \<in> F} (\<sqsubseteq>) b" and bA: "b \<in> A"
+    have "pointwise X (\<sqsubseteq>) s (s(x:=b))"
+    proof (rule extreme_boundD(2)[OF s], safe intro!: pointwiseI)
+      fix f y
+      assume fF: "f \<in> F" and yX: "y \<in> X"
+      show "f y \<sqsubseteq> (s(x:=b)) y"
+      proof (cases "x = y")
+        case True
+        with b fF show "?thesis" by auto
+      next
+        case False
+        with s[THEN extreme_bound_imp_bound] fF yX show ?thesis by (auto dest: boundD)
+      qed
+    next
+      fix y assume "y \<in> X" with bA s show "(s(x := b)) y \<in> A" by auto
+    qed
+    with xX show "s x \<sqsubseteq> b" by (auto dest: pointwiseD)
+  next
+    fix f assume "f \<in> F"
+    from extreme_boundD(1)[OF s this] F xX
+    show "f x \<sqsubseteq> s x" by auto
+  next
+    show "s x \<in> A" using s xX by auto
+  }
+next
+  fix x
+  assume s: ?a and xX: "x \<in> X"
+  { from s xX show "s x \<in> A" by auto
+  next
+    fix b assume b: "bound F (pointwise X (\<sqsubseteq>)) b" and bA: "b ` X \<subseteq> A"
+    with xX have "bound {f x |. f \<in> F} (\<sqsubseteq>) (b x)" by (auto simp: pointwise_bound)
+    with s[rule_format, OF xX] bA xX show "s x \<sqsubseteq> b x" by auto
+  next
+    fix f assume "f \<in> F"
+    with s[rule_format, OF xX] show "f x \<sqsubseteq> s x" by auto
+  }
+qed
+
+lemma dual_pointwise_extreme_bound:
+  "extreme_bound FA (pointwise X r)\<^sup>- F = extreme_bound FA (pointwise X r\<^sup>-) F"
+  by (simp)
+
+lemma pointwise_monotone_on:
+  fixes less_eq (infix "\<sqsubseteq>" 50) and prec_eq (infix "\<preceq>" 50)
+  shows "monotone_on I (\<preceq>) (pointwise A (\<sqsubseteq>)) f \<longleftrightarrow>
+   (\<forall>a \<in> A. monotone_on I (\<preceq>) (\<sqsubseteq>) (\<lambda>i. f i a))" (is "?l \<longleftrightarrow> ?r")
+proof (safe intro!: monotone_onI pointwiseI)
+  fix a i j assume aA: "a \<in> A" and *: ?l "i \<preceq> j" "i \<in> I" "j \<in> I"
+  then
+  show "f i a \<sqsubseteq> f j a" by (auto dest: monotone_onD)
+next
+  fix a i j assume ?r and "a \<in> A" and ij: "i \<preceq> j" "i \<in> I" "j \<in> I"
+  then have "monotone_on I (\<preceq>) (\<sqsubseteq>) (\<lambda>i. f i a)" by auto
+  from monotone_onD[OF this]ij
+  show "f i a \<sqsubseteq> f j a" by auto
+qed
+
+lemmas pointwise_monotone = pointwise_monotone_on[of UNIV]
+
+lemma (in reflexive) pointwise_reflexive: "reflexive {f. f ` I \<subseteq> A} (pointwise I (\<sqsubseteq>))"
+  apply unfold_locales by (auto intro!: pointwiseI simp: subsetD[OF _ imageI])
+
+lemma (in irreflexive) pointwise_irreflexive:
+  assumes I0: "I \<noteq> {}" shows "irreflexive {f. f ` I \<subseteq> A} (pointwise I (\<sqsubset>))"
+proof (safe intro!: irreflexive.intro)
+  fix f
+  assume f: "f ` I \<subseteq> A" and ff: "pointwise I (\<sqsubset>) f f"
+  from I0 obtain i where i: "i \<in> I" by auto
+  with ff have "f i \<sqsubset> f i" by auto
+  with f i show False by auto
+qed
+
+lemma (in semiattractive) pointwise_semiattractive: "semiattractive {f. f ` I \<subseteq> A} (pointwise I (\<sqsubseteq>))"
+proof (unfold_locales, safe intro!: pointwiseI)
+  fix f g h i
+  assume fg: "pointwise I (\<sqsubseteq>) f g" and gf: "pointwise I (\<sqsubseteq>) g f" and gh: "pointwise I (\<sqsubseteq>) g h"
+    and [simp]: "i \<in> I" and f: "f ` I \<subseteq> A" and g: "g ` I \<subseteq> A" and h: "h ` I \<subseteq> A"
+  show "f i \<sqsubseteq> h i"
+  proof (rule attract)
+    from fg show "f i \<sqsubseteq> g i" by auto
+    from gf show "g i \<sqsubseteq> f i" by auto
+    from gh show "g i \<sqsubseteq> h i" by auto
+  qed (insert f g h, auto simp: subsetD[OF _ imageI])
+qed
+
+lemma (in attractive) pointwise_attractive: "attractive {f. f ` I \<subseteq> A} (pointwise I (\<sqsubseteq>))"
+  apply (intro attractive.intro attractive_axioms.intro)
+  using pointwise_semiattractive dual.pointwise_semiattractive by auto
+
+text \<open>Antisymmetry will not be preserved by pointwise extension over restricted domain.\<close>
+lemma (in antisymmetric) pointwise_antisymmetric:
+  "antisymmetric {f. f ` I \<subseteq> A} (pointwise I (\<sqsubseteq>))"
+  oops
+
+lemma (in transitive) pointwise_transitive: "transitive {f. f ` I \<subseteq> A} (pointwise I (\<sqsubseteq>))"
+proof (unfold_locales, safe intro!: pointwiseI)
+  fix f g h i
+  assume fg: "pointwise I (\<sqsubseteq>) f g" and gh: "pointwise I (\<sqsubseteq>) g h"
+    and [simp]: "i \<in> I" and f: "f ` I \<subseteq> A" and g: "g ` I \<subseteq> A" and h: "h ` I \<subseteq> A"
+  from fg have "f i \<sqsubseteq> g i" by auto
+  also from gh have "g i \<sqsubseteq> h i" by auto
+  finally show "f i \<sqsubseteq> h i" using f g h by (auto simp: subsetD[OF _ imageI])
+qed
+
+lemma (in quasi_ordered_set) pointwise_quasi_order:
+  "quasi_ordered_set {f. f ` I \<subseteq> A} (pointwise I (\<sqsubseteq>))"
+  by (intro quasi_ordered_setI pointwise_transitive pointwise_reflexive)
+
+lemma (in compatible_ordering) pointwise_compatible_ordering:
+  assumes I0: "I \<noteq> {}"
+  shows "compatible_ordering {f. f ` I \<subseteq> A} (pointwise I (\<sqsubseteq>)) (pointwise I (\<sqsubset>))"
+proof (intro compatible_ordering.intro compatible_ordering_axioms.intro pointwise_irreflexive[OF I0], safe intro!: pointwiseI)
+  fix f g h i
+  assume fg: "pointwise I (\<sqsubseteq>) f g" and gh: "pointwise I (\<sqsubset>) g h"
+    and [simp]: "i \<in> I" and f: "f ` I \<subseteq> A" and g: "g ` I \<subseteq> A" and h: "h ` I \<subseteq> A"
+  from fg have "f i \<sqsubseteq> g i" by auto
+  also from gh have "g i \<sqsubset> h i" by auto
+  finally show "f i \<sqsubset> h i" using f g h by (auto simp: subsetD[OF _ imageI])
+next
+  fix f g h i
+  assume fg: "pointwise I (\<sqsubset>) f g" and gh: "pointwise I (\<sqsubseteq>) g h"
+    and [simp]: "i \<in> I" and f: "f ` I \<subseteq> A" and g: "g ` I \<subseteq> A" and h: "h ` I \<subseteq> A"
+  from fg have "f i \<sqsubset> g i" by auto
+  also from gh have "g i \<sqsubseteq> h i" by auto
+  finally show "f i \<sqsubset> h i" using f g h by (auto simp: subsetD[OF _ imageI])
+next
+  fix f g i
+  assume fg: "pointwise I (\<sqsubset>) f g"
+    and [simp]: "i \<in> I"
+    and f: "f ` I \<subseteq> A" and g: "g ` I \<subseteq> A"
+  from fg have "f i \<sqsubset> g i" by auto
+  with f g show "f i \<sqsubseteq> g i" by (auto simp: subsetD[OF _ imageI] strict_implies_weak)
+qed
+
 subsection \<open>Relating to Classes\<close>
 
 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 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 supremumI: "bound X (\<le>) s \<Longrightarrow> (\<And>b. bound X (\<le>) b \<Longrightarrow> s \<le> b) \<Longrightarrow> supremum X s"
+  and infimumI: "bound X (\<ge>) i \<Longrightarrow> (\<And>b. bound X (\<ge>) b \<Longrightarrow> b \<le> i) \<Longrightarrow> infimum X i"
+  by (auto intro!: extremeI)
+
+lemma supremumE: "supremum X s \<Longrightarrow>
+    (bound X (\<le>) s \<Longrightarrow> (\<And>b. bound X (\<le>) b \<Longrightarrow> s \<le> b) \<Longrightarrow> thesis) \<Longrightarrow> thesis"
+  and infimumE: "infimum X i \<Longrightarrow>
+    (bound X (\<ge>) i \<Longrightarrow> (\<And>b. bound X (\<ge>) b \<Longrightarrow> b \<le> i) \<Longrightarrow> thesis) \<Longrightarrow> thesis"
+  by (auto)
+
+lemma extreme_bound_supremum[simp]: "extreme_bound UNIV (\<le>) = supremum" by (auto intro!: ext)
+lemma extreme_bound_infimum[simp]: "extreme_bound UNIV (\<ge>) = infimum" by (auto intro!: ext)
+
 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 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>) (<)"
+lemma pointwise_UNIV_le[simp]: "pointwise UNIV (\<le>) = (\<le>)" by (intro ext, simp add: pointwise_def le_fun_def)
+lemma pointwise_UNIV_ge[simp]: "pointwise UNIV (\<ge>) = (\<ge>)" by (intro ext, simp add: pointwise_def le_fun_def)
+
+lemma fun_supremum_iff: "supremum F e \<longleftrightarrow> (\<forall>x. supremum {f x |. f \<in> F} (e x))"
+  using pointwise_extreme_bound[of F UNIV UNIV "(\<le>)"] by simp
+
+lemma fun_infimum_iff: "infimum F e \<longleftrightarrow> (\<forall>x. infimum {f x |. f \<in> F} (e x))"
+  using pointwise_extreme_bound[of F UNIV UNIV "(\<ge>)"] by simp
+
+
+class reflorder = ord + assumes "reflexive_ordering UNIV (\<le>) (<)"
 begin
 
-sublocale order: compatible_ordering UNIV
+sublocale order: reflexive_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)
+  using reflorder_axioms unfolding class.reflorder_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 UNIV (\<le>) (<)"
+class attrorder = ord +
+  assumes "reflexive_attractive_ordering UNIV (\<le>) (<)"
 begin
 
 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 UNIV
+subclass reflorder
+proof-
+  interpret reflexive_attractive_ordering UNIV
+    using attrorder_axioms unfolding class.attrorder_def by auto
+  show "class.reflorder (\<le>) (<)"..
+qed
+
+sublocale order: reflexive_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)
+  using attrorder_axioms unfolding class.attrorder_def
+  by (auto simp:atomize_eq)
 
 end
 
 thm order.extreme_bound_quasi_const
 
 class psorder = ord + assumes "pseudo_ordering UNIV (\<le>) (<)"
 begin
 
-interpretation pseudo_ordering UNIV using psorder_axioms unfolding class.psorder_def.
-
-subclass attractive_order ..
+subclass attrorder
+proof-
+  interpret pseudo_ordering UNIV
+    using psorder_axioms unfolding class.psorder_def by auto
+  show "class.attrorder (\<le>) (<)"..
+qed
 
 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)
+  using psorder_axioms unfolding class.psorder_def by (auto simp:atomize_eq)
 
 end
 
 class qorder = ord + assumes "quasi_ordering UNIV (\<le>) (<)"
 begin
 
-interpretation quasi_ordering UNIV using qorder_axioms unfolding class.qorder_def.
-
-subclass attractive_order ..
+subclass attrorder
+proof-
+  interpret quasi_ordering UNIV
+    using qorder_axioms unfolding class.qorder_def by auto
+  show "class.attrorder (\<le>) (<)"..
+qed
 
 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)
+  using qorder_axioms unfolding class.qorder_def by (auto simp:atomize_eq)
+
+lemmas [intro!] = order.quasi_ordered_subset
 
 end
 
 class porder = ord + assumes "partial_ordering UNIV (\<le>) (<)"
 begin
 
 interpretation partial_ordering UNIV
-  using porder_axioms unfolding class.porder_def.
-
-subclass psorder ..
-subclass qorder ..
+  using porder_axioms unfolding class.porder_def by auto
+
+subclass psorder..
+
+subclass qorder..
 
 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 UNIV (\<le>) (<)"
+class linqorder = ord + assumes "total_quasi_ordering UNIV (\<le>) (<)"
 begin
 
-interpretation well_founded_ordering UNIV
-  using wf_qorder_axioms unfolding class.wf_qorder_def.
-
-subclass qorder ..
-
-sublocale order: well_founded_ordering UNIV
+interpretation total_quasi_ordering UNIV
+  using linqorder_axioms unfolding class.linqorder_def by auto
+
+subclass qorder..
+
+sublocale order: total_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)
+    using linqorder_axioms unfolding class.linqorder_def
+    by (auto simp:atomize_eq)
+
+lemmas asympartp_le = order.not_iff_asym[symmetric, abs_def]
 
 end
 
-class totalorder = ord + assumes "total_ordering UNIV (\<le>) (<)"
-begin
-
-interpretation total_ordering UNIV
-  using totalorder_axioms unfolding class.totalorder_def.
-
-subclass porder ..
+
+text \<open>Isabelle/HOL's @{class preorder} belongs to @{class qorder}, but not vice versa.\<close>
+
+context preorder begin
+
+text \<open>The relation @{term "(<)"} is defined as the antisymmetric part of @{term "(\<le>)"}.\<close>
+lemma [simp]:
+  shows asympartp_le: "asympartp (\<le>) = (<)"
+    and asympartp_ge: "asympartp (\<ge>) = (>)"
+  by (intro ext, auto simp: asympartp_def less_le_not_le)
+
+interpretation strict_quasi_ordering UNIV "(\<le>)" "(<)"
+  apply unfold_locales
+  using order_refl apply assumption
+  using order_trans apply assumption
+  using less_le_not_le apply assumption
+  done
+
+subclass qorder..
+
+sublocale order: strict_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
+
+context order begin
+
+interpretation strict_partial_ordering UNIV "(\<le>)" "(<)"
+  apply unfold_locales
+  using order_antisym by assumption
+
+subclass porder..
+
+sublocale order: strict_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
+
+text \<open>Isabelle/HOL's @{class linorder} is equivalent to our locale @{locale total_ordering}.\<close>
+
+context linorder begin
+
+subclass linqorder apply unfold_locales by auto
 
 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
-  using order_refl apply assumption
-  apply simp
-  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
-  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 strict_total_ordering UNIV
-  apply unfold_locales by auto
-
-subclass totalorder ..
-
-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.strict.trans[where 'a="'a::reflorder"]
+thm order.extreme_bound_quasi_const[where 'a="'a::attrorder"]
 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.comparable_cases[where 'a="'a::linqorder"]
 thm order.cases[where 'a="'a::linorder"]
 
 subsection \<open>Declaring Duals\<close>
 
 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.
+interpretation less_eq_symmetrize.
 
 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)
 
+context antisymmetric begin
+
+lemma extreme_bound_unique:
+  "extreme_bound A (\<sqsubseteq>) X x \<Longrightarrow> extreme_bound A (\<sqsubseteq>) X y \<longleftrightarrow> x = y"
+  apply (unfold extreme_bound_def)
+  apply (rule dual.extreme_unique) by auto
+
+lemma ex_extreme_bound_iff_ex1:
+  "Ex (extreme_bound A (\<sqsubseteq>) X) \<longleftrightarrow> Ex1 (extreme_bound A (\<sqsubseteq>) X)"
+  apply (unfold extreme_bound_def)
+  apply (rule dual.ex_extreme_iff_ex1) by auto
+
+lemma ex_extreme_bound_iff_the:
+   "Ex (extreme_bound A (\<sqsubseteq>) X) \<longleftrightarrow> extreme_bound A (\<sqsubseteq>) X (The (extreme_bound A (\<sqsubseteq>) X))"
+  apply (rule iffI)
+  apply (rule theI')
+  using extreme_bound_unique by auto
+
+end
+
 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>-"
+  by (auto dest: strict_implies_weak strict_weak_trans weak_strict_trans)
+
+lemmas(in qorder) [intro!] = order.dual.quasi_ordered_subset
+
+sublocale reflexive_ordering \<subseteq> dual: reflexive_ordering A "(\<sqsubseteq>)\<^sup>-" "(\<sqsubset>)\<^sup>-"
+  rewrites "sympartp (\<sqsubseteq>)\<^sup>- = sympartp (\<sqsubseteq>)"
+  by unfold_locales auto
+
+sublocale reflexive_attractive_ordering \<subseteq> dual: reflexive_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)
+  by unfold_locales auto
 
 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)
+  by unfold_locales auto
+
+sublocale total_quasi_ordering \<subseteq> dual: total_quasi_ordering A "(\<sqsubseteq>)\<^sup>-" "(\<sqsubset>)\<^sup>-"
+  rewrites "sympartp (\<sqsubseteq>)\<^sup>- = sympartp (\<sqsubseteq>)"
+  by unfold_locales auto
 
 sublocale total_ordering \<subseteq> dual: total_ordering A "(\<sqsubseteq>)\<^sup>-" "(\<sqsubset>)\<^sup>-"
   rewrites "sympartp (\<sqsubseteq>)\<^sup>- = sympartp (\<sqsubseteq>)"
-  by unfold_locales (auto 0 4)
+  by unfold_locales auto
+
+sublocale strict_quasi_ordering \<subseteq> dual: strict_quasi_ordering A "(\<sqsubseteq>)\<^sup>-" "(\<sqsubset>)\<^sup>-"
+  rewrites "sympartp (\<sqsubseteq>)\<^sup>- = sympartp (\<sqsubseteq>)"
+  by unfold_locales (auto simp: strict_iff)
+
+sublocale strict_partial_ordering \<subseteq> dual: strict_partial_ordering A "(\<sqsubseteq>)\<^sup>-" "(\<sqsubset>)\<^sup>-"
+  rewrites "sympartp (\<sqsubseteq>)\<^sup>- = sympartp (\<sqsubseteq>)"
+  by unfold_locales auto
+
+sublocale total_ordering \<subseteq> dual: total_ordering A "(\<sqsubseteq>)\<^sup>-" "(\<sqsubset>)\<^sup>-"
+  rewrites "sympartp (\<sqsubseteq>)\<^sup>- = sympartp (\<sqsubseteq>)"
+  by unfold_locales auto
 
 lemma(in antisymmetric) monotone_extreme_imp_extreme_bound_iff:
   fixes ir (infix "\<preceq>" 50)
   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
-
+  using dual.extreme_unique monotone_extreme_extreme_boundI[OF assms]
+  by (auto simp: extreme_bound_def)
 
 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
+instance "fun" :: (type,qorder) reflorder
 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 (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.
       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
       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
   apply intro_classes
   apply unfold_locales
   by (auto simp: le_fun_def dest: order.trans)
 
 instance "fun" :: (type,porder) porder
   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,590 +1,822 @@
 (*
 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 Binary_Relations
+  imports Well_Relations Directedness
 begin
 
 subsection \<open>Completeness Conditions\<close>
 
 text \<open>Order-theoretic completeness demands certain subsets of elements to admit suprema or infima.\<close>
 
 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)"
+ "\<C>-complete A (\<sqsubseteq>) \<equiv> \<forall>X \<subseteq> A. \<C> X (\<sqsubseteq>) \<longrightarrow> (\<exists>s. extreme_bound A (\<sqsubseteq>) X s)" for less_eq (infix "\<sqsubseteq>" 50)
 
 lemmas completeI = complete_def[unfolded atomize_eq, THEN iffD2, rule_format]
 lemmas completeD = complete_def[unfolded atomize_eq, THEN iffD1, rule_format]
+lemmas completeE = complete_def[unfolded atomize_eq, THEN iffD1, rule_format, THEN exE]
 
-lemma complete_cmono: "CC \<subseteq> DD \<Longrightarrow> DD-complete \<le> CC-complete"
+lemma complete_cmono: "CC \<le> 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)
+lemma complete_subclass:
+  fixes less_eq (infix "\<sqsubseteq>" 50)
+  assumes "\<C>-complete A (\<sqsubseteq>)" and "\<forall>X \<subseteq> A. \<D> X (\<sqsubseteq>) \<longrightarrow> \<C> X (\<sqsubseteq>)"
+  shows "\<D>-complete A (\<sqsubseteq>)"
+  using assms 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>
 
-definition "extremed A r \<equiv> \<exists>e. extreme A r e"
-
-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)
+lemma complete_empty[simp]: "\<C>-complete {} r \<longleftrightarrow> \<not> \<C> {} r" by (auto simp: complete_def)
 
 context
   fixes less_eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
 begin
 
 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 extremed_iff_UNIV_complete: "extremed A (\<sqsubseteq>) \<longleftrightarrow> {A}-complete A (\<sqsubseteq>)" (is "?l \<longleftrightarrow> ?r")
+lemma extremed_iff_UNIV_complete: "extremed A (\<sqsubseteq>) \<longleftrightarrow> (\<lambda>X r. X = 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 obtain e where "extreme A (\<sqsubseteq>) e" by (erule extremedE)
   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 topped is called ``pointed'', equivalently ensuring a supremum
 of the empty set.\<close>
 
-lemma pointed_iff_empty_complete: "extremed A (\<sqsubseteq>) \<longleftrightarrow> {{}}-complete A (\<sqsubseteq>)\<^sup>-"
+lemma pointed_iff_empty_complete: "extremed A (\<sqsubseteq>) \<longleftrightarrow> (\<lambda>X r. X = {})-complete A (\<sqsubseteq>)\<^sup>-"
   by (auto simp: complete_def extremed_def)
 
+text \<open>Downward closure is topped.\<close>
+lemma dual_closure_is_extremed:
+  assumes bA: "b \<in> A" and "b \<sqsubseteq> b"
+  shows "extremed {a \<in> A. a \<sqsubseteq> b} (\<sqsubseteq>)"
+  using assms by (auto intro!: extremedI[of _ _ b])
+
+text \<open>Downward closure preserves completeness.\<close>
+lemma dual_closure_is_complete:
+  assumes A: "\<C>-complete A (\<sqsubseteq>)" and bA: "b \<in> A"
+  shows "\<C>-complete {x\<in>A. x \<sqsubseteq> b} (\<sqsubseteq>)"
+proof (intro completeI)
+  fix X assume XAb:"X \<subseteq> {x \<in> A. x \<sqsubseteq> b}" and X: "\<C> X (\<sqsubseteq>)"
+  with completeD[OF A] obtain x where x: "extreme_bound A (\<sqsubseteq>) X x" by auto
+  then have xA: "x \<in> A" by auto
+  from XAb have "x \<sqsubseteq> b" by (auto intro!: extreme_boundD[OF x] bA)
+  with xA x show "\<exists>x. extreme_bound {x \<in> A. x \<sqsubseteq> b} (\<sqsubseteq>) X x" by (auto intro!: exI[of _ x])
+qed
+
+interpretation less_eq_dualize.
+
+text \<open>Upward closure preserves completeness, under a condition.\<close>
+lemma closure_is_complete:
+  assumes A: "\<C>-complete A (\<sqsubseteq>)" and bA: "b \<in> A"
+    and Cb: "\<forall>X \<subseteq> A. \<C> X (\<sqsubseteq>) \<longrightarrow> bound X (\<sqsupseteq>) b \<longrightarrow> \<C> (X \<union> {b}) (\<sqsubseteq>)"
+  shows "\<C>-complete {x\<in>A. b \<sqsubseteq> x} (\<sqsubseteq>)"
+proof (intro completeI)
+  fix X assume XAb:"X \<subseteq> {x \<in> A. b \<sqsubseteq> x}" and X: "\<C> X (\<sqsubseteq>)"
+  with Cb have XbC: "\<C> (X \<union> {b}) (\<sqsubseteq>)" by auto
+  from XAb bA have XbA: "X \<union> {b} \<subseteq> A" by auto
+  with completeD[OF A XbA] XbC
+  obtain x where x: "extreme_bound A (\<sqsubseteq>) (X\<union>{b}) x" by auto
+  then show "\<exists>x. extreme_bound {x \<in> A. b \<sqsubseteq> x} (\<sqsubseteq>) X x"
+    by (auto intro!: exI[of _ x] extreme_boundI)
+qed
+
+lemma biclosure_is_complete:
+  assumes A: "\<C>-complete A (\<sqsubseteq>)" and aA: "a \<in> A" and bA: "b \<in> A" and ab: "a \<sqsubseteq> b"
+    and Ca: "\<forall>X \<subseteq> A. \<C> X (\<sqsubseteq>) \<longrightarrow> bound X (\<sqsupseteq>) a \<longrightarrow> \<C> (X \<union> {a}) (\<sqsubseteq>)"
+  shows "\<C>-complete {x\<in>A. a \<sqsubseteq> x \<and> x \<sqsubseteq> b} (\<sqsubseteq>)"
+proof-
+  note closure_is_complete[OF A aA Ca]
+  from dual_closure_is_complete[OF this, of b] bA ab show ?thesis by auto
+qed
+
 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>
 
-definition "pair_complete \<equiv> {{x,y} |. x y :: 'a}-complete"
+definition "pair_complete \<equiv> (\<lambda>X r. \<exists>x y. X = {x,y})-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 pair_complete_imp_directed:
   assumes comp: "pair_complete A (\<sqsubseteq>)" shows "directed A (\<sqsubseteq>)"
 proof
   fix x y :: 'a
   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
 
 lemma (in connex) pair_complete: "pair_complete A (\<sqsubseteq>)"
 proof (safe intro!: pair_completeI)
   fix x y
   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>
 
-abbreviation "finite_complete \<equiv> {X. finite X \<and> X \<noteq> {}}-complete"
+abbreviation "finite_complete \<equiv> (\<lambda>X r. finite X \<and> X \<noteq> {})-complete"
 
 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>
 
-abbreviation "conditionally_complete A r \<equiv> {X. \<exists>b \<in> A. bound X r b \<and> X \<noteq> {}}-complete A r"
+abbreviation "conditionally_complete A \<equiv> (\<lambda>X r. \<exists>b \<in> A. bound X r b \<and> X \<noteq> {})-complete A"
 
 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>
-
-definition "omega_complete A r \<equiv> {range f | f :: nat \<Rightarrow> 'a. monotone (\<le>) r f}-complete A r"
+text \<open>The $\omega$-completeness condition demands a supremum for an $\omega$-chain.\<close>
 
-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>\<open>"abramski94"\<close>,
+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>
 
-definition "directed_complete A r \<equiv> {X. directed X r \<and> X \<noteq> {}}-complete A r"
+definition "directed_complete \<equiv> (\<lambda>X r. directed X r \<and> X \<noteq> {})-complete"
 
 lemma monotone_directed_complete:
   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
 
+lemma (in reflexive) dual_closure_is_directed_complete:
+  assumes comp: "directed-complete A (\<sqsubseteq>)" and bA: "b \<in> A"
+  shows "directed-complete {X \<in> A. b \<sqsubseteq> X} (\<sqsubseteq>)"
+  apply (rule closure_is_complete[OF comp bA])
+proof (intro allI impI directedI CollectI)
+  interpret less_eq_dualize.
+  fix X x y assume Xdir: "directed X (\<sqsubseteq>)" and X: "X \<subseteq> A"
+    and bX: "bound X (\<sqsupseteq>) b" and x: "x \<in> X \<union> {b}" and y: "y \<in> X \<union> {b}"
+  from x y X bA have xA: "x \<in> A" and yA: "y \<in> A" by auto
+  show "\<exists>z\<in>X \<union> {b}. x \<sqsubseteq> z \<and> y \<sqsubseteq> z"
+  proof (cases "x = b")
+    case [simp]: True
+    with y bX bA have "b \<sqsubseteq> y" by auto
+    with y yA bA show ?thesis by (auto intro!: bexI[of _ y])
+  next
+    case False
+    with x have x: "x \<in> X" by auto
+    show ?thesis
+    proof (cases "y = b")
+      case [simp]: True
+      with x bX have "b \<sqsubseteq> x" by auto
+      with x xA bA show ?thesis by (auto intro!: bexI[of _ x])
+    next
+      case False
+      with y have y: "y \<in> X" by auto
+      from directedD[OF Xdir x y] show ?thesis by simp
+    qed
+  qed
+qed
+
+
 text \<open>The next one is quite complete, only the empty set may fail to have a supremum.
-The terminology follows \<^cite>\<open>"Bergman2015"\<close>,
+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>
 
-abbreviation "semicomplete \<equiv> {X. X \<noteq> {}}-complete"
+abbreviation "semicomplete \<equiv> (\<lambda>X r. X \<noteq> {})-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> {}}"]
+  using complete_cmono[of "\<lambda>X r. X = A" "\<lambda>X r. X \<noteq> {}"]
   by auto
 
 lemma connex_dual_semicomplete: "semicomplete {C. connex C r} (\<supseteq>)"
-proof (intro completeI, elim CollectE)
+proof (intro completeI)
   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 toppedness, i.e., there is a global least element.
   This serves as the supremum of the empty set.\<close>
 
-lemma complete_union: "(CC \<union> CC')-complete A r \<longleftrightarrow> CC-complete A r \<and> CC'-complete A r"
+lemma complete_sup: "(CC \<squnion> CC')-complete A r \<longleftrightarrow> CC-complete A r \<and> CC'-complete A r"
   by (auto simp: complete_def)
 
 lemma pointed_directed_complete:
-  "{X. directed X r}-complete A r \<longleftrightarrow> directed_complete A r \<and> extremed A r\<^sup>-"
+  "directed-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
+  have [simp]: "(\<lambda>X r. directed X r \<and> X \<noteq> {} \<or> X = {}) = directed" by auto
   show ?thesis
-    by (auto simp: directed_complete_def pointed_iff_empty_complete complete_union[symmetric] Un_def)
+    by (auto simp: directed_complete_def pointed_iff_empty_complete complete_sup[symmetric]
+        sup_fun_def)
 qed
 
 text \<open>``Bounded complete'' refers to pointed conditional complete,
 but this notion is just the dual of semicompleteness. We prove this later.\<close>
 
-abbreviation "bounded_complete A r \<equiv> {X. \<exists>b\<in>A. bound X r b}-complete A r"
+abbreviation "bounded_complete A \<equiv> (\<lambda>X r. \<exists>b\<in>A. bound X r b)-complete A"
 
 subsection \<open>Relations between Completeness Conditions\<close>
 
 context
   fixes less_eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
 begin
 
-interpretation less_eq_notations.
+interpretation less_eq_dualize.
 
 text \<open>Pair-completeness implies that the universe is directed. Thus, with directed completeness
 implies toppedness.\<close>
 
 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-
   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 topped.\<close>
 
 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)
+  proof (intro completeI)
     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: ?l
   with semicomplete_nonempty_imp_extremed[OF l] A
   show ?r by (auto intro!: completeI dest: completeD)
 qed
 
 proposition complete_iff_pointed_semicomplete:
-  "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)
+  "\<top>-complete A (\<sqsubseteq>) \<longleftrightarrow> semicomplete A (\<sqsubseteq>) \<and> extremed A (\<sqsupseteq>)" (is "?l \<longleftrightarrow> ?r")
+  by (unfold pointed_iff_empty_complete complete_sup[symmetric], auto simp: sup_fun_def top_fun_def)
 
 text \<open>Conditional completeness only lacks top and bottom to be complete.\<close>
 
 proposition complete_iff_conditionally_complete_extremed_pointed:
-  "UNIV-complete A (\<sqsubseteq>) \<longleftrightarrow> conditionally_complete A (\<sqsubseteq>) \<and> extremed A (\<sqsubseteq>) \<and> extremed A (\<sqsupseteq>)"
+  "\<top>-complete A (\<sqsubseteq>) \<longleftrightarrow> conditionally_complete A (\<sqsubseteq>) \<and> extremed A (\<sqsubseteq>) \<and> extremed A (\<sqsupseteq>)"
   unfolding complete_iff_pointed_semicomplete
   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 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 ?r
   then show ?l
     by (auto intro!: pair_completeI completeD[OF comp] elim: directedE)
 next
   assume pc: ?l
   show ?r
   proof (intro directedI)
     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.
+interpretation less_eq_dualize.
 
 lemma conditionally_complete_dual:
   assumes comp: "conditionally_complete A (\<sqsubseteq>)" shows "conditionally_complete A (\<sqsupseteq>)"
-proof (intro completeI, elim CollectE)
+proof (intro completeI)
   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)
+  with in_mono[OF XA] show "\<exists>s. extreme_bound A (\<sqsupseteq>) X s"
+    by (intro exI[of _ s] extreme_boundI, auto)
 qed
 
 text \<open>Full completeness is symmetric.\<close>
 
 lemma complete_dual:
-  "UNIV-complete A (\<sqsubseteq>) \<Longrightarrow> UNIV-complete A (\<sqsupseteq>)"
+  "\<top>-complete A (\<sqsubseteq>) \<Longrightarrow> \<top>-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:
+lemma bounded_complete_iff_pointed_conditionally_complete:
   assumes A: "A \<noteq> {}"
-  shows "conditionally_complete A (\<sqsubseteq>) \<and> extremed A (\<sqsupseteq>) \<longleftrightarrow> bounded_complete A (\<sqsubseteq>)"
+  shows "bounded_complete A (\<sqsubseteq>) \<longleftrightarrow> conditionally_complete A (\<sqsubseteq>) \<and> extremed A (\<sqsupseteq>)"
   apply (unfold pointed_iff_empty_complete)
-  apply (fold complete_union)
-  apply (unfold Un_def)
+  apply (fold complete_sup)
+  apply (unfold sup_fun_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 bounded_complete_iff_pointed_conditionally_complete[OF False])
     apply (unfold semicomplete_iff_conditionally_complete_extremed)
     using Complete_Relations.conditionally_complete_dual by auto
 qed
 
+lemma bounded_complete_imp_conditionally_complete:
+  assumes "bounded_complete A (\<sqsubseteq>)" shows "conditionally_complete A (\<sqsubseteq>)"
+  using assms by (cases "A = {}", auto simp:bounded_complete_iff_pointed_conditionally_complete)
+
+text \<open>Completeness in downward-closure:\<close>
+lemma conditionally_complete_imp_semicomplete_in_dual_closure:
+  assumes A: "conditionally_complete A (\<sqsubseteq>)" and bA: "b \<in> A"
+  shows "semicomplete {a \<in> A. a \<sqsubseteq> b} (\<sqsubseteq>)"
+proof (intro completeI)
+  fix X assume X: "X \<subseteq> {a \<in> A. a \<sqsubseteq> b}" and X0: "X \<noteq> {}"
+  then have "X \<subseteq> A" and Xb: "bound X (\<sqsubseteq>) b" by auto
+  with bA completeD[OF A] X0 obtain s where Xs: "extreme_bound A (\<sqsubseteq>) X s" by auto
+  with Xb bA have sb: "s \<sqsubseteq> b" by auto
+  with Xs have "extreme_bound {a \<in> A. a \<sqsubseteq> b} (\<sqsubseteq>) X s"
+    by (intro extreme_boundI, auto)
+  then show "\<exists>s. extreme_bound {a \<in> A. a \<sqsubseteq> b} (\<sqsubseteq>) X s" by auto
+qed
+
 end
 
+text \<open>Completeness in intervals:\<close>
+lemma conditionally_complete_imp_complete_in_interval:
+  fixes less_eq (infix "\<sqsubseteq>" 50)
+  assumes comp: "conditionally_complete A (\<sqsubseteq>)" and aA: "a \<in> A" and bA: "b \<in> A"
+    and aa: "a \<sqsubseteq> a" and ab: "a \<sqsubseteq> b"
+  shows "\<top>-complete {x \<in> A. a \<sqsubseteq> x \<and> x \<sqsubseteq> b} (\<sqsubseteq>)"
+proof (intro completeI)
+  fix X assume X: "X \<subseteq> {x \<in> A. a \<sqsubseteq> x \<and> x \<sqsubseteq> b}"
+  note conditionally_complete_imp_semicomplete_in_dual_closure[OF comp bA]
+  from closure_is_complete[OF this, of a,simplified] aA ab
+  have semi: "semicomplete {x \<in> A. a \<sqsubseteq> x \<and> x \<sqsubseteq> b} (\<sqsubseteq>)" by (simp add: conj_commute cong: Collect_cong)
+  show "Ex (extreme_bound {x \<in> A. a \<sqsubseteq> x \<and> x \<sqsubseteq> b} (\<sqsubseteq>) X)"
+  proof (cases "X = {}")
+    case True
+    with aA aa ab have "extreme_bound {x \<in> A. a \<sqsubseteq> x \<and> x \<sqsubseteq> b} (\<sqsubseteq>) X a" by (auto simp: bound_empty)
+    then show ?thesis by auto
+  next
+    case False
+    with completeD[OF semi X] show ?thesis by simp
+  qed
+qed
+
 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>
 
 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 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 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)
         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
 qed (insert finite_complete_le_pair_complete, auto)
 
 
-text \<open>Gierz et al.~\<^cite>\<open>"gierz03"\<close> showed that a directed complete partial order is semicomplete
+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 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 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)
+  proof (intro completeI)
     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
     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 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 have dc: "directed_complete A (\<sqsubseteq>)" and fc: "finite_complete A (\<sqsubseteq>)" by auto
   show ?l
-  proof (intro completeI, elim CollectE)
+  proof (intro completeI)
     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
     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
 
+
 subsection \<open>Relating to Classes\<close>
 
 (* HOL.Conditionally_Complete_Lattices imports choice.
 
 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>
 
 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 "\<exists>s. least {b \<in> UNIV. bound X (\<le>) b} s" by auto
 qed
 *)
-text \<open>Isabelle's class @{class complete_lattice} is @{term "UNIV-complete"}.\<close>
+text \<open>Isabelle's class @{class complete_lattice} is @{term "\<top>-complete"}.\<close>
 
-lemma (in complete_lattice) "UNIV-complete UNIV (\<le>)"
-  by (auto intro!: completeI Sup_upper Sup_least Inf_lower Inf_greatest)
+lemma (in complete_lattice) "\<top>-complete UNIV (\<le>)"
+  by (auto intro!: completeI extreme_boundI Sup_upper Sup_least Inf_lower Inf_greatest)
 
 subsection \<open>Set-wise Completeness\<close>
 
+lemma Pow_extreme_bound: "X \<subseteq> Pow A \<Longrightarrow> extreme_bound (Pow A) (\<subseteq>) X (\<Union>X)"
+  by (intro extreme_boundI, auto 2 3)
+
+lemma Pow_complete: "\<C>-complete (Pow A) (\<subseteq>)"
+  by (auto intro!: completeI dest: Pow_extreme_bound)
+
+lemma directed_directed_Un:
+assumes ch: "XX \<subseteq> {X. directed X r}" and dir: "directed XX (\<subseteq>)"
+    shows "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
+
+lemmas directed_connex_Un = directed_directed_Un[OF _ connex.directed]
+
 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)
+  shows "directed-complete {X \<in> AA. directed X r} (\<subseteq>)"
+proof (intro completeI)
   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
-  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
+    apply (rule directed_directed_Un) using ch by (auto simp: dir)
+  ultimately show "Ex (extreme_bound {X \<in> AA. directed X r} (\<subseteq>) XX)"
+    by (auto intro!: exI[of _ "\<Union>XX"])
 qed
 
 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 connex_directed_complete: "{DC. directed DC (\<subseteq>)}-complete {C. connex C r} (\<subseteq>)"
-  by (intro completeI, force dest!: connex_directed_Un)
+lemma connex_is_directed_complete: "directed-complete {C. C \<subseteq> A \<and> connex C r} (\<subseteq>)"
+proof (intro completeI)
+  fix CC assume CC: "CC \<subseteq> {C. C \<subseteq> A \<and> connex C r}" and "directed CC (\<subseteq>)"
+  with connex_directed_Un have Scon: "connex (\<Union>CC) r" by auto
+  from CC have SA: "\<Union>CC \<subseteq> A" by auto
+  from Scon SA show "\<exists>S. extreme_bound {C. C \<subseteq> A \<and> connex C r} (\<subseteq>) CC S"
+    by (auto intro!: exI[of _ "\<Union>CC"] extreme_boundI)
+qed
+
+lemma (in well_ordered_set) well_ordered_set_insert:
+  assumes aA: "total_ordered_set (insert a A) (\<sqsubseteq>)"
+  shows "well_ordered_set (insert a A) (\<sqsubseteq>)"
+proof-
+  interpret less_eq_asymmetrize.
+  interpret aA: total_ordered_set "insert a A" "(\<sqsubseteq>)" using aA.
+  show ?thesis
+  proof (intro well_ordered_set.intro aA.antisymmetric_axioms well_related_setI)
+    fix X assume XaA: "X \<subseteq> insert a A" and X0: "X \<noteq> {}"
+    show "\<exists>e. extreme X (\<sqsupseteq>) e"
+    proof (cases "a \<in> X")
+      case False
+      with XaA have "X \<subseteq> A" by auto
+      from nonempty_imp_ex_extreme[OF this X0] show ?thesis.
+    next
+      case aX: True
+      show ?thesis
+      proof (cases "X - {a} = {}")
+        case True
+        with aX XaA have Xa: "X = {a}" by auto
+        from aA.refl[of a]
+        have "a \<sqsubseteq> a" by auto
+        then show ?thesis by (auto simp: Xa)
+      next
+        case False
+        from nonempty_imp_ex_extreme[OF _ False] XaA
+        obtain e where Xae: "extreme (X-{a}) (\<sqsupseteq>) e" by auto
+        with Xae XaA have eaA: "e \<in> insert a A" by auto
+        then have "e \<sqsubseteq> a \<or> a \<sqsubseteq> e" by (intro aA.comparable, auto)
+        then show ?thesis
+        proof (elim disjE)
+          assume ea: "e \<sqsubseteq> a"
+          with Xae show ?thesis by (auto intro!:exI[of _ e])
+        next
+          assume ae: "a \<sqsubseteq> e"
+          show ?thesis
+          proof (intro exI[of _ a] extremeI aX)
+            fix x assume xX: "x \<in> X"
+            show "a \<sqsubseteq> x"
+            proof (cases "a = x")
+              case True with aA.refl[of a] show ?thesis by auto
+            next
+              case False
+              with xX have "x \<in> X - {a}" by auto
+              with Xae have "e \<sqsubseteq> x" by auto
+              from aA.trans[OF ae this _ eaA] xX XaA
+              show ?thesis by auto
+            qed
+          qed
+        qed
+      qed
+    qed
+  qed
+qed
+
+text \<open>The following should be true in general, but here we use antisymmetry to avoid
+  the axiom of choice.\<close>
+
+lemma (in antisymmetric) pointwise_connex_complete:
+  assumes comp: "connex-complete A (\<sqsubseteq>)"
+  shows "connex-complete {f. f ` X \<subseteq> A} (pointwise X (\<sqsubseteq>))"
+proof (safe intro!: completeI exI)
+  fix F
+  assume FXA: "F \<subseteq> {f. f ` X \<subseteq> A}" and F: "connex F (pointwise X (\<sqsubseteq>))"
+  show "extreme_bound {f. f ` X \<subseteq> A} (pointwise X (\<sqsubseteq>)) F (\<lambda>x. The (extreme_bound A (\<sqsubseteq>) {f x |. f \<in> F}))"
+  proof (unfold pointwise_extreme_bound[OF FXA], safe)
+    fix x assume xX: "x \<in> X"
+    from FXA xX have FxA: "{f x |. f \<in> F} \<subseteq> A" by auto
+    have "Ex (extreme_bound A (\<sqsubseteq>) {f x |. f \<in> F})"
+    proof (intro completeD[OF comp] FxA CollectI connexI, elim imageE, fold atomize_eq)
+      fix f g assume fF: "f \<in> F" and gF: "g \<in> F"
+      from connex.comparable[OF F this] xX show "f x \<sqsubseteq> g x \<or> g x \<sqsubseteq> f x" by auto
+    qed
+    also note ex_extreme_bound_iff_the
+    finally
+    show "extreme_bound A (\<sqsubseteq>) {f x |. f \<in> F} (The (extreme_bound A (\<sqsubseteq>) {f x |. f \<in> F}))".
+  qed
+qed
+
+text \<open>Our supremum/infimum coincides with those of Isabelle's @{class complete_lattice}.\<close>
+
+lemma complete_UNIV: "\<top>-complete (UNIV::'a::complete_lattice set) (\<le>)"
+proof-
+  have "Ex (supremum X)" for X :: "'a set"
+    by (auto intro!: exI[of _ "\<Squnion>X"] supremumI simp:Sup_upper Sup_least)
+  then show ?thesis by (auto intro!: completeI )
+qed
+
+context
+  fixes X :: "'a :: complete_lattice set"
+begin
+
+lemma supremum_Sup: "supremum X (\<Squnion>X)"
+proof-
+  define it where "it \<equiv> The (supremum X)"
+  note completeD[OF complete_UNIV,simplified, of X]
+  from this[unfolded order.dual.ex_extreme_iff_the]
+  have 1: "supremum X it" by (simp add: it_def)
+  then have "\<Squnion>X = it" by (intro Sup_eqI, auto)
+  with 1 show ?thesis by auto
+qed
+
+lemmas Sup_eq_The_supremum = order.dual.eq_The_extreme[OF supremum_Sup]
+
+lemma supremum_eq_Sup: "supremum X x \<longleftrightarrow> \<Squnion>X = x"
+  using order.dual.eq_The_extreme supremum_Sup by auto
+
+lemma infimum_Inf:
+  shows "infimum X (\<Sqinter>X)"
+proof-
+  define it where "it \<equiv> The (infimum X)"
+  note completeD[OF complete_dual[OF complete_UNIV],simplified, of X]
+  from this[unfolded order.ex_extreme_iff_the]
+  have 1: "infimum X it" by (simp add: it_def)
+  then have "\<Sqinter>X = it" by (intro Inf_eqI, auto)
+  with 1 show ?thesis by auto
+qed
+
+lemmas Inf_eq_The_infimum = order.eq_The_extreme[OF infimum_Inf]
+
+lemma infimum_eq_Inf: "infimum X x \<longleftrightarrow> \<Sqinter>X = x"
+  using order.eq_The_extreme infimum_Inf by auto
+
+end
 
 end
\ No newline at end of file
diff --git a/thys/Complete_Non_Orders/Continuity.thy b/thys/Complete_Non_Orders/Continuity.thy
new file mode 100755
--- /dev/null
+++ b/thys/Complete_Non_Orders/Continuity.thy
@@ -0,0 +1,166 @@
+theory Continuity
+  imports Complete_Relations
+begin
+
+subsection \<open>Scott Continuity, $\omega$-Continuity\<close>
+
+text \<open>In this Section, we formalize 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>
+
+definition continuous ("_-continuous" [1000]1000) where
+  "\<C>-continuous A (\<sqsubseteq>) B (\<unlhd>) f \<equiv>
+   f ` A \<subseteq> B \<and>
+   (\<forall>X s. \<C> X (\<sqsubseteq>) \<longrightarrow> X \<noteq> {} \<longrightarrow> X \<subseteq> A \<longrightarrow> extreme_bound A (\<sqsubseteq>) X s \<longrightarrow> extreme_bound B (\<unlhd>) (f`X) (f s))"
+  for leA (infix "\<sqsubseteq>" 50) and leB (infix "\<unlhd>" 50)
+
+lemmas continuousI[intro?] =
+  continuous_def[unfolded atomize_eq, THEN iffD2, unfolded conj_imp_eq_imp_imp, rule_format]
+
+lemmas continuousE =
+  continuous_def[unfolded atomize_eq, THEN iffD1, elim_format, unfolded conj_imp_eq_imp_imp, rule_format]
+
+lemma
+  fixes prec_eq (infix "\<preceq>" 50) and less_eq (infix "\<sqsubseteq>" 50)
+  assumes "\<C>-continuous I (\<preceq>) A (\<sqsubseteq>) f"
+  shows continuous_carrierD[dest]: "f ` I \<subseteq> A"
+    and continuousD: "\<C> X (\<preceq>) \<Longrightarrow> X \<noteq> {} \<Longrightarrow> X \<subseteq> I \<Longrightarrow> extreme_bound I (\<preceq>) X b \<Longrightarrow> extreme_bound A (\<sqsubseteq>) (f ` X) (f b)"
+  using assms by (auto elim!: continuousE)
+
+lemma continuous_comp:
+  fixes leA (infix "\<sqsubseteq>\<^sub>A" 50) and leB (infix "\<sqsubseteq>\<^sub>B" 50) and leC (infix "\<sqsubseteq>\<^sub>C" 50)
+  assumes KfL: "\<forall>X \<subseteq> A. \<K> X (\<sqsubseteq>\<^sub>A) \<longrightarrow> \<L> (f ` X) (\<sqsubseteq>\<^sub>B)"
+  assumes f: "\<K>-continuous A (\<sqsubseteq>\<^sub>A) B (\<sqsubseteq>\<^sub>B) f" and g: "\<L>-continuous B (\<sqsubseteq>\<^sub>B) C (\<sqsubseteq>\<^sub>C) g"
+  shows "\<K>-continuous A (\<sqsubseteq>\<^sub>A) C (\<sqsubseteq>\<^sub>C) (g \<circ> f)"
+  apply (intro continuousI)
+proof -
+  from f g have fAB: "f ` A \<subseteq> B" and gBC: "g ` B \<subseteq> C" by auto
+  then show "(g \<circ> f) ` A \<subseteq> C" by auto
+  fix X s
+  assume XA: "X \<subseteq> A" and X0: "X \<noteq> {}" and XK: "\<K> X (\<sqsubseteq>\<^sub>A)" and Xs: "extreme_bound A (\<sqsubseteq>\<^sub>A) X s"
+  from fAB XA have fXB: "f ` X \<subseteq> B" by auto
+  from X0 have fX0: "f ` X \<noteq> {}" by auto
+  from KfL XA XK have fXL: "\<L> (f ` X) (\<sqsubseteq>\<^sub>B)" by auto
+  from continuousD[OF f XK X0 XA Xs]
+  have "extreme_bound B (\<sqsubseteq>\<^sub>B) (f ` X) (f s)".
+  from continuousD[OF g fXL fX0 fXB this]
+  show "extreme_bound C (\<sqsubseteq>\<^sub>C) ((g\<circ>f)`X) ((g\<circ>f) s)" by (auto simp: image_comp)
+qed
+
+lemma continuous_comp_top:
+  fixes leA (infix "\<sqsubseteq>\<^sub>A" 50) and leB (infix "\<sqsubseteq>\<^sub>B" 50) and leC (infix "\<sqsubseteq>\<^sub>C" 50)
+  assumes f: "\<K>-continuous A (\<sqsubseteq>\<^sub>A) B (\<sqsubseteq>\<^sub>B) f" and g: "\<top>-continuous B (\<sqsubseteq>\<^sub>B) C (\<sqsubseteq>\<^sub>C) g"
+  shows "\<K>-continuous A (\<sqsubseteq>\<^sub>A) C (\<sqsubseteq>\<^sub>C) (g \<circ> f)"
+  by (rule continuous_comp[OF _ f g], auto)
+
+lemma id_continuous:
+  fixes leA (infix "\<sqsubseteq>\<^sub>A" 50)
+  shows "\<K>-continuous A (\<sqsubseteq>\<^sub>A) A (\<sqsubseteq>\<^sub>A) (\<lambda>x. x)"
+  by (auto intro: continuousI)
+
+lemma cst_continuous:
+  fixes leA (infix "\<sqsubseteq>\<^sub>A" 50) and leB (infix "\<sqsubseteq>\<^sub>B" 50)
+  assumes "b \<in> B" and bb: "b \<sqsubseteq>\<^sub>B b"
+  shows "\<K>-continuous A (\<sqsubseteq>\<^sub>A) B (\<sqsubseteq>\<^sub>B) (\<lambda>x. b)"
+  apply (intro continuousI)
+  using assms(1) apply auto
+  using assms extreme_bound_singleton_refl[of B "(\<sqsubseteq>\<^sub>B)" b] by blast
+
+
+lemma continuous_cmono:
+  assumes CD: "\<C> \<le> \<D>" shows "\<D>-continuous \<le> \<C>-continuous"
+proof (safe intro!: le_funI le_boolI)
+  fix I A f and prec_eq (infix "\<preceq>" 50) and less_eq (infix "\<sqsubseteq>" 50)
+  assume cont: "\<D>-continuous I (\<preceq>) A (\<sqsubseteq>) f"
+  show "\<C>-continuous I (\<preceq>) A (\<sqsubseteq>) f"
+  proof (rule continuousI)
+    from cont show "f ` I \<subseteq> A" by auto
+    fix X s assume X: "\<C> X (\<preceq>)" and X0: "X \<noteq> {}" and XI: "X \<subseteq> I" and Xs: "extreme_bound I (\<preceq>) X s"
+    from CD X have "\<D> X (\<preceq>)" by auto
+    from continuousD[OF cont, OF this X0 XI Xs]
+    show "extreme_bound A (\<sqsubseteq>) (f ` X) (f s)".
+  qed
+qed
+
+context
+  fixes prec_eq :: "'i \<Rightarrow> 'i \<Rightarrow> bool" (infix "\<preceq>" 50) and less_eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
+begin
+
+lemma continuous_subclass:
+  assumes CD: "\<forall>X\<subseteq>I. X \<noteq> {} \<longrightarrow> \<C> X (\<preceq>) \<longrightarrow> \<D> X (\<preceq>)" and cont: "\<D>-continuous I (\<preceq>) A (\<sqsubseteq>) f"
+  shows "\<C>-continuous I (\<preceq>) A (\<sqsubseteq>) f"
+  using cont by (auto simp: continuous_def CD[rule_format])
+
+lemma chain_continuous_imp_well_continuous:
+  assumes cont: "connex-continuous I (\<preceq>) A (\<sqsubseteq>) f"
+  shows "well_related_set-continuous I (\<preceq>) A (\<sqsubseteq>) f"
+  by (rule continuous_subclass[OF _ cont], auto simp: well_related_set.connex)
+
+lemma well_continuous_imp_omega_continous:
+  assumes cont: "well_related_set-continuous I (\<preceq>) A (\<sqsubseteq>) f"
+  shows "omega_chain-continuous I (\<preceq>) A (\<sqsubseteq>) f"
+  by (rule continuous_subclass[OF _ cont], auto simp: omega_chain_imp_well_related)
+
+end
+
+abbreviation "scott_continuous I (\<preceq>) \<equiv> directed_set-continuous I (\<preceq>)"
+  for prec_eq (infix "\<preceq>" 50)
+
+lemma scott_continuous_imp_well_continuous:
+  fixes prec_eq :: "'i \<Rightarrow> 'i \<Rightarrow> bool" (infix "\<preceq>" 50) and less_eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
+  assumes cont: "scott_continuous I (\<preceq>) A (\<sqsubseteq>) f"
+  shows "well_related_set-continuous I (\<preceq>) A (\<sqsubseteq>) f"
+  by (rule continuous_subclass[OF _ cont], auto simp: well_related_set.directed_set)
+
+lemmas scott_continuous_imp_omega_continuous =
+  scott_continuous_imp_well_continuous[THEN well_continuous_imp_omega_continous]
+
+
+subsubsection \<open>Continuity implies monotonicity\<close>
+
+lemma continuous_imp_mono_refl:
+  fixes prec_eq (infix "\<preceq>" 50) and less_eq (infix "\<sqsubseteq>" 50)
+  assumes cont: "\<C>-continuous I (\<preceq>) A (\<sqsubseteq>) f" and xyC: "\<C> {x,y} (\<preceq>)"
+    and xy: "x \<preceq> y" and yy: "y \<preceq> y"
+    and x: "x \<in> I" and y: "y \<in> I"
+  shows "f x \<sqsubseteq> f y"
+proof-
+  have fboy: "extreme_bound A (\<sqsubseteq>) (f ` {x,y}) (f y)"
+  proof (intro continuousD[OF cont] xyC)
+    from x y show CI: "{x,y} \<subseteq> I" by auto
+    show Cy: "extreme_bound I (\<preceq>) {x,y} y" using xy yy x y by auto
+  qed auto
+  then show ?thesis by auto
+qed
+
+lemma omega_continuous_imp_mono_refl:
+  fixes prec_eq (infix "\<preceq>" 50) and less_eq (infix "\<sqsubseteq>" 50)
+  assumes cont: "omega_chain-continuous I (\<preceq>) A (\<sqsubseteq>) f"
+    and xx: "x \<preceq> x" and xy: "x \<preceq> y" and yy: "y \<preceq> y"
+    and x: "x \<in> I" and y: "y \<in> I"
+  shows "f x \<sqsubseteq> f y"
+  apply (rule continuous_imp_mono_refl[OF cont, OF pair_omega_chain])
+  using assms by auto
+
+context reflexive begin
+
+lemma continuous_imp_monotone_on:
+  fixes leB (infix "\<unlhd>" 50)
+  assumes cont: "\<C>-continuous A (\<sqsubseteq>) B (\<unlhd>) f"
+    and II: "\<forall>i \<in> A. \<forall> j \<in> A. i \<sqsubseteq> j \<longrightarrow> \<C> {i,j} (\<sqsubseteq>)"
+  shows "monotone_on A (\<sqsubseteq>) (\<unlhd>) f"
+proof-
+  show ?thesis
+    apply (intro monotone_onI continuous_imp_mono_refl[OF cont])
+    using II by auto
+qed
+
+lemma well_complete_imp_monotone_on:
+  fixes leB (infix "\<unlhd>" 50)
+  assumes cont: "well_related_set-continuous A (\<sqsubseteq>) B (\<unlhd>) f"
+  shows "monotone_on A (\<sqsubseteq>) (\<unlhd>) f"                       
+  by (auto intro!: continuous_imp_monotone_on cont pair_well_related)
+
+end
+
+end
\ No newline at end of file
diff --git a/thys/Complete_Non_Orders/Directedness.thy b/thys/Complete_Non_Orders/Directedness.thy
new file mode 100755
--- /dev/null
+++ b/thys/Complete_Non_Orders/Directedness.thy
@@ -0,0 +1,261 @@
+theory Directedness
+  imports Binary_Relations Well_Relations
+begin
+
+text \<open>Directed sets:\<close>
+
+locale directed =
+  fixes A and less_eq (infix "\<sqsubseteq>" 50)
+  assumes pair_bounded: "x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> \<exists>z \<in> A. x \<sqsubseteq> z \<and> y \<sqsubseteq> z"
+
+lemmas directedI[intro] = directed.intro
+
+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
+
+sublocale connex \<subseteq> directed
+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
+
+lemmas(in connex) directed = directed_axioms
+
+lemma monotone_directed_image:
+  fixes ir (infix "\<preceq>" 50) and r (infix "\<sqsubseteq>" 50)
+  assumes mono: "monotone_on I (\<preceq>) (\<sqsubseteq>) f" and 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
+
+
+definition "directed_set A (\<sqsubseteq>) \<equiv> \<forall>X \<subseteq> A. finite X \<longrightarrow> (\<exists>b \<in> A. bound X (\<sqsubseteq>) b)"
+  for less_eq (infix "\<sqsubseteq>" 50)
+
+lemmas directed_setI = directed_set_def[unfolded atomize_eq, THEN iffD2, rule_format]
+lemmas directed_setD = directed_set_def[unfolded atomize_eq, THEN iffD1, rule_format]
+
+lemma directed_imp_nonempty:
+  fixes less_eq (infix "\<sqsubseteq>" 50)
+  shows "directed_set A (\<sqsubseteq>) \<Longrightarrow> A \<noteq> {}"
+  by (auto simp: directed_set_def)
+
+lemma directedD2:
+  fixes less_eq (infix "\<sqsubseteq>" 50)
+  assumes dir: "directed_set A (\<sqsubseteq>)" and xA: "x \<in> A" and yA: "y \<in> A"
+  shows "\<exists>z \<in> A. x \<sqsubseteq> z \<and> y \<sqsubseteq> z"
+  using directed_setD[OF dir, of "{x,y}"] xA yA by auto
+
+lemma monotone_directed_set_image:
+  fixes ir (infix "\<preceq>" 50) and r (infix "\<sqsubseteq>" 50)
+  assumes mono: "monotone_on I (\<preceq>) (\<sqsubseteq>) f" and dir: "directed_set I (\<preceq>)"
+  shows "directed_set (f ` I) (\<sqsubseteq>)"
+proof (rule directed_setI)
+  fix X assume "finite X" and "X \<subseteq> f ` I"
+  from finite_subset_image[OF this]
+  obtain J where JI: "J \<subseteq> I" and Jfin: "finite J" and X: "X = f ` J" by auto
+  from directed_setD[OF dir JI Jfin]
+  obtain b where bI: "b \<in> I" and Jb: "bound J (\<preceq>) b" by auto
+  from monotone_image_bound[OF mono JI bI Jb] bI
+  show "Bex (f ` I) (bound X (\<sqsubseteq>))" by (auto simp: X)
+qed
+
+
+lemma directed_set_iff_extremed:
+  fixes less_eq (infix "\<sqsubseteq>" 50)
+  assumes Dfin: "finite D"
+  shows "directed_set D (\<sqsubseteq>) \<longleftrightarrow> extremed D (\<sqsubseteq>)"
+proof (intro iffI directed_setI conjI)
+  assume "directed_set D (\<sqsubseteq>)"
+  from directed_setD[OF this order.refl Dfin]
+  show "extremed D (\<sqsubseteq>)" by (auto intro: extremedI)
+next
+  fix X assume XD: "X \<subseteq> D" and Xfin: "finite X"
+  assume "extremed D (\<sqsubseteq>)"
+  then obtain b where "b \<in> D" and "extreme D (\<sqsubseteq>) b" by (auto elim!: extremedE)
+  with XD show "\<exists>b \<in> D. bound X (\<sqsubseteq>) b" by auto
+qed
+
+lemma (in transitive) directed_iff_nonempty_pair_bounded:
+  "directed_set A (\<sqsubseteq>) \<longleftrightarrow> A \<noteq> {} \<and> (\<forall>x\<in>A. \<forall>y\<in>A. \<exists>z\<in>A. x \<sqsubseteq> z \<and> y \<sqsubseteq> z)"
+  (is "?l \<longleftrightarrow> _ \<and> ?r")
+proof (safe intro!: directed_setI del: notI subset_antisym)
+  assume dir: ?l
+  from directed_imp_nonempty[OF dir] show "A \<noteq> {}".
+  fix x y assume "x \<in> A" "y \<in> A"
+  with directed_setD[OF dir, of "{x,y}"]
+  show "\<exists>z\<in>A. x \<sqsubseteq> z \<and> y \<sqsubseteq> z" by auto
+next
+  fix X
+  assume A0: "A \<noteq> {}" and r: ?r
+  assume "finite X" and "X \<subseteq> A"
+  then show "Bex A (bound X (\<sqsubseteq>))"
+  proof (induct)
+    case empty
+    with A0 show ?case by (auto simp: bound_empty ex_in_conv)
+  next
+    case (insert x X)
+    then obtain y where xA: "x \<in> A" and XA: "X \<subseteq> A" and yA: "y \<in> A" and Xy: "bound X (\<sqsubseteq>) y" by auto
+    from r yA xA obtain z where zA: "z \<in> A" and xz: "x \<sqsubseteq> z" and yz: "y \<sqsubseteq> z" by auto
+    from bound_trans[OF Xy yz XA yA zA] xz zA
+    show ?case by auto
+  qed
+qed
+
+lemma (in transitive) directed_set_iff_nonempty_directed:
+  "directed_set A (\<sqsubseteq>) \<longleftrightarrow> A \<noteq> {} \<and> directed A (\<sqsubseteq>)"
+  apply (unfold directed_iff_nonempty_pair_bounded)
+  by (auto simp: directed_def)
+
+lemma (in well_related_set) finite_sets_extremed:
+  assumes fin: "finite X" and X0: "X \<noteq> {}" and XA: "X \<subseteq> A"
+  shows "extremed X (\<sqsubseteq>)"
+proof-
+  interpret less_eq_asymmetrize.
+  from fin X0 XA show ?thesis
+  proof (induct "card X" arbitrary: X)
+    case 0
+    then show ?case by auto
+  next
+    case (Suc n)
+    note XA = \<open>X \<subseteq> A\<close> and X0 = \<open>X \<noteq> {}\<close> and Sn = \<open>Suc n = card X\<close> and finX = \<open>finite X\<close>
+    note IH = Suc(1)
+    from nonempty_imp_ex_extreme[OF XA X0]
+    obtain l where l: "extreme X (\<sqsupseteq>) l" by auto
+    from l have lX: "l \<in> X" by auto
+    with XA have lA: "l \<in> A" by auto
+    from Sn lX have n: "n = card (X-{l})" by auto
+    show ?case
+    proof (cases "X - {l} = {}")
+      case True
+      with lA lX show ?thesis by (auto intro!: extremedI)
+    next
+      case False
+      from IH[OF n _ this] finX XA
+      obtain e where e: "extreme (X - {l}) (\<sqsubseteq>) e" by (auto elim!: extremedE)
+      with l show ?thesis by (auto intro!: extremedI[of _ _ e] extremeI)
+    qed
+  qed
+qed
+
+lemma (in well_related_set) directed_set:
+  assumes A0: "A \<noteq> {}" shows "directed_set A (\<sqsubseteq>)"
+proof (intro directed_setI)
+  fix X assume XA: "X \<subseteq> A" and Xfin: "finite X"
+  show "Bex A (bound X (\<sqsubseteq>))"
+  proof (cases "X = {}")
+    case True
+    with A0 show ?thesis by (auto simp: bound_empty ex_in_conv)
+  next
+    case False
+    from finite_sets_extremed[OF Xfin this] XA
+    show ?thesis by (auto elim!: extremedE)
+  qed
+qed
+
+lemma prod_directed:
+  fixes leA (infix "\<sqsubseteq>\<^sub>A" 50) and leB (infix "\<sqsubseteq>\<^sub>B" 50)
+  assumes dir: "directed X (rel_prod (\<sqsubseteq>\<^sub>A) (\<sqsubseteq>\<^sub>B))"
+  shows "directed (fst ` X) (\<sqsubseteq>\<^sub>A)" and "directed (snd ` X) (\<sqsubseteq>\<^sub>B)"
+proof (safe intro!: directedI)
+  fix a b x y assume "(a,x) \<in> X" and "(b,y) \<in> X"
+  from directedD[OF dir this]
+  obtain c z where cz: "(c,z) \<in> X" and ac: "a \<sqsubseteq>\<^sub>A c" and bc: "b \<sqsubseteq>\<^sub>A c" and "x \<sqsubseteq>\<^sub>B z" and "y \<sqsubseteq>\<^sub>B z" by auto
+  then show "\<exists>z\<in>fst ` X. fst (a,x) \<sqsubseteq>\<^sub>A z \<and> fst (b,y) \<sqsubseteq>\<^sub>A z"
+    and "\<exists>z\<in>snd ` X. snd (a,x) \<sqsubseteq>\<^sub>B z \<and> snd (b,y) \<sqsubseteq>\<^sub>B z"
+    by (auto intro!: bexI[OF _ cz])
+qed
+
+class dir = ord + assumes "directed UNIV (\<le>)"
+begin
+
+sublocale order: directed UNIV "(\<le>)"
+  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 dir_axioms[unfolded class.dir_def]
+  by (auto simp: atomize_eq)
+
+end
+
+class filt = ord +
+  assumes "directed UNIV (\<ge>)"
+begin
+
+sublocale order.dual: directed UNIV "(\<ge>)"
+  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 filt_axioms[unfolded class.filt_def]
+  by (auto simp: atomize_eq)
+
+end
+
+subclass (in linqorder) dir..
+
+subclass (in linqorder) filt..
+
+thm order.directed_axioms[where 'a = "'a ::dir"]
+
+thm order.dual.directed_axioms[where 'a = "'a ::filt"]
+
+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,1236 +1,1258 @@
 (*
 Author:  Jérémy Dubut (2019-2021)
 Author:  Akihisa Yamada (2019-2021)
 License: LGPL (see file COPYING.LESSER)
 *)
 
 theory Fixed_Points
-  imports Complete_Relations
+  imports Complete_Relations Directedness
 begin
 
 section \<open>Existence of Fixed Points in Complete Related Sets\<close>
 text \<open>\label{sec:qfp-exists}\<close>
 
 text \<open>The following proof is simplified and generalized from
-  Stouti--Maaden \<^cite>\<open>"SM13"\<close>. We construct some set whose extreme bounds 
+  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>\<open>"SM13"\<close>, relaxing reflexivity and antisymmetry.\<close>
+  This generalizes \cite{SM13}, relaxing reflexivity and antisymmetry.\<close>
 
 locale fixed_point_proof = related_set +
   fixes f
   assumes f: "f ` A \<subseteq> A"
 begin
 
-sublocale less_eq_notations.
+sublocale less_eq_asymmetrize.
 
 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 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 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)
 
 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 c assumes Cc: "extreme_bound A (\<sqsubseteq>) C c"
 begin
 
 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 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
 
 lemma ex_qfp:
-  assumes comp: "CC-complete A (\<sqsubseteq>)" and C: "C \<in> CC"
+  assumes comp: "CC-complete A (\<sqsubseteq>)" and C: "CC C (\<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"
-  using qfp_as_extreme_bound[OF _  infl_mono] completeD[OF comp CA C] by auto
+  using qfp_as_extreme_bound[OF _  infl_mono] completeD[OF comp CA, OF C] by auto
 
 lemma ex_extreme_qfp_fp:
-  assumes comp: "CC-complete A (\<sqsubseteq>)" and C: "C \<in> CC"
+  assumes comp: "CC-complete A (\<sqsubseteq>)" and C: "CC C (\<sqsubseteq>)"
     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
+  using extreme_qfp[OF _ attract mono] completeD[OF comp CA, OF C] by auto
 
 lemma ex_extreme_qfp:
-  assumes comp: "CC-complete A (\<sqsubseteq>)" and C: "C \<in> CC"
+  assumes comp: "CC-complete A (\<sqsubseteq>)" and C: "CC C (\<sqsubseteq>)"
     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]
+  from completeD[OF comp CA, OF 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
 
 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 less_eq_symmetrize.
 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)"
+  assumes comp: "\<top>-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"
+  assumes comp: "\<top>-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-
-  interpret less_eq_notations.
+  interpret less_eq_symmetrize.
   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.
+interpretation less_eq_symmetrize.
 
 theorem complete_mono_imp_ex_extreme_qfp:
-  assumes comp: "UNIV-complete A (\<sqsubseteq>)" and f: "f ` A \<subseteq> A"
+  assumes comp: "\<top>-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"
+  assumes comp: "\<top>-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 less_eq_symmetrize.
   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>\<open>"grall10"\<close> elementary proof for Bourbaki--Witt and Markowsky's theorems.
+we followed Grall's~\cite{grall10} elementary proof for Bourbaki--Witt and Markowsky's theorems.
 His idea is to consider well-founded derivation trees over $A$,
 where from a set $C \subseteq A$ of premises
 one can derive $f\:(\bigsqcup C)$ if $C$ is a chain.
 The main observation is as follows:
 Let $D$ be the set of all the derivable elements; that is,
 for each $d \in D$ there exists a well-founded derivation
 whose root is $d$.
 It is shown that $D$ is a chain,
 and hence one can build a derivation yielding $f\:(\bigsqcup D)$,
 and $f\:(\bigsqcup D)$ is shown to be a fixed point.\<close>
 
 lemma bound_monotone_on:
   assumes mono: "monotone_on A r s f" and XA: "X \<subseteq> A" and aA: "a \<in> A" and rXa: "bound X r a"
   shows "bound (f`X) s (f a)"
 proof (safe)
   fix x assume xX: "x \<in> X" 
   from rXa xX have "r x a" by auto
   with xX XA mono aA show "s (f x) (f a)" by (auto elim!:monotone_onE)
 qed
 
 context fixed_point_proof begin
 
 text \<open>To avoid the usage of the axiom of choice, we carefully define derivations so that any derivable element
 determines its lower set. This led to the following definition:\<close>
 
 definition "derivation X \<equiv> X \<subseteq> A \<and> well_ordered_set X (\<sqsubseteq>) \<and>
   (\<forall>x \<in> X. let Y = {y \<in> X. y \<sqsubset> x} in
     (\<exists>y. extreme Y (\<sqsubseteq>) y \<and> x = f y) \<or>
     f ` Y \<subseteq> Y \<and> extreme_bound A (\<sqsubseteq>) Y x)"
 
+lemma empty_derivation: "derivation {}" by (auto simp: derivation_def)
+
 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>)"
+end
+
+locale fixed_point_proof2 = fixed_point_proof + antisymmetric +
+  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
 
-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)
+    using Pp by (auto dest!: extreme_bound_imp_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.
+      from P.asym.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
+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
       qed
     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 
+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".
+        from X.asym.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".
+        from X.asym.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
 
-interpretation derivable: well_ordered_set "{x. derivable x}" "(\<sqsubseteq>)"
+sublocale derivable: well_ordered_set "{x. derivable x}" "(\<sqsubseteq>)"
 proof (rule well_ordered_set.intro)
   show "antisymmetric {x. derivable x} (\<sqsubseteq>)"
     apply unfold_locales by (auto dest: derivable_A antisym)
   show "well_related_set {x. derivable x} (\<sqsubseteq>)"
   apply (fold UN_derivations_eq_derivable)
   apply (rule closed_UN_well_related)
   by (auto dest: derivation_well_ordered derivations_cross_compare well_ordered_set.axioms)
 qed
 
-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
+context
+  fixes p
   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
+begin
+
+lemma sup_derivable_derivable: "derivable p"
+  using derivation_lim[OF derivation_derivable _ p] derivable_closed
+  by (auto intro: derivableI)
+
+private lemmas sucp = sup_derivable_derivable[THEN derivable_closed]
+
+lemma sup_derivable_prefixed: "f p \<sqsubseteq> p" using sucp p by auto
+
+lemma sup_derivable_postfixed: "p \<sqsubseteq> f p"
+  apply (rule derivation_infl[rule_format, OF derivation_derivable])
+  using sup_derivable_derivable by auto
+
+lemma sup_derivable_qfp: "f p \<sim> p"
+  using sup_derivable_prefixed sup_derivable_postfixed by auto
+
+lemma sup_derivable_fp: "f p = p"
+  using sup_derivable_derivable sucp
+  by (auto intro!: antisym sup_derivable_prefixed sup_derivable_postfixed simp: derivable_A)
+
+end
 
 end
 
 text "The assumptions are satisfied by monotone functions."
 
+context fixed_point_proof begin
+
+context
+  assumes ord: "antisymmetric A (\<sqsubseteq>)"
+begin
+
+interpretation antisymmetric using ord.
+
 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
+interpretation fixed_point_proof2
+proof
+  show 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 IH[OF zX zsx yX] zy show "z \<sqsubseteq> f y" by auto
+        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
-      with Zx fyA show ?thesis by auto
     qed
   qed
+  show 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 monotone_onD[OF mono] xX XA show "f x \<sqsubseteq> f x" by auto
+  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
+lemmas mono_imp_fixed_point_proof2 = fixed_point_proof2_axioms
 
 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])
+  by (simp add: sup_derivable_fp[OF 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]
+  from sup_derivable_fp[OF 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]
+        from monotone_onD[OF mono _ qA zq] zX 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>)"
+  assumes comp: "well_related_set-complete A (\<sqsubseteq>)"
   shows "\<exists>p. extreme {q \<in> A. f q = q} (\<sqsupseteq>) p"
 proof-
   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
+    using derivable_A derivable.well_related_set_axioms 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]
+  from p mono_imp_sup_derivable_lfp[OF p] sup_derivable_qfp[OF p]
   show ?thesis by auto
 qed
 
 end
 
 end
 
 end
 
 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>)"
+theorem (in pseudo_ordered_set) well_complete_infl'_imp_ex_fp:
+  assumes comp: "well_related_set-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-
-  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)
+  interpret fixed_point_proof2
+  proof
+    show 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)
+    show drefl: "\<forall>X x. derivation X \<longrightarrow> x \<in> X \<longrightarrow> f x \<sqsubseteq> f x"
+      using f by (auto dest!: derivation_A)
+  qed
   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]
+    using derivable.well_related_set_axioms derivable_A by auto
+  with sup_derivable_fp
   show ?thesis by auto
 qed
 
+text \<open>Bourbaki-Witt Theorem on posets:\<close>
+corollary (in partially_ordered_set) well_complete_infl_imp_ex_fp:
+  assumes comp: "well_related_set-complete A (\<sqsubseteq>)"
+    and f: "f ` A \<subseteq> A" and infl: "\<forall>x \<in> A. x \<sqsubseteq> f x"
+  shows "\<exists>p \<in> A. f p = p"
+proof (intro well_complete_infl'_imp_ex_fp[OF comp f] ballI impI)
+  fix x y assume x: "x \<in> A" and y: "y \<in> A" and xy: "x \<sqsubseteq> y"
+  from y infl have "y \<sqsubseteq> f y" by auto
+  from trans[OF xy this x y] f y show "x \<sqsubseteq> f y" by auto
+qed
 
 section \<open>Completeness of (Quasi-)Fixed Points\<close>
 
 text \<open>We now 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
 
 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 comp: "well_related_set-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)
+  have compQ: "well_related_set-complete Q (\<sqsubseteq>\<^sup>s)"
+  proof (intro completeI)
     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]
+  interpret Q: fixed_point_proof2 Q "(\<sqsubseteq>\<^sup>s)" F
+    using Q.mono_imp_fixed_point_proof2[OF Q.antisymmetric_axioms monoQ].
+  from Q.mono_imp_ex_least_fp[OF Q.antisymmetric_axioms 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 wr_CC: "\<forall>C \<subseteq> A. well_related_set C (\<sqsubseteq>) \<longrightarrow> CC C (\<sqsubseteq>)"
+    and extend: "\<forall>X Y. CC X (\<sqsubseteq>) \<longrightarrow> CC Y (\<sqsubseteq>) \<longrightarrow> X \<sqsubseteq>\<^sup>s Y \<longrightarrow> CC (X \<union> Y) (\<sqsubseteq>)"
     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"
+  fix X assume Xfix: "X \<subseteq> {q \<in> A. f q \<sim> q} \<union> P" and XCC: "CC X (\<sqsubseteq>)"
   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 (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
   }
   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"
+    fix Y assume YS: "Y \<subseteq> B" and YCC: "CC Y (\<sqsubseteq>)"
     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 have CCC: "CC C (\<sqsubseteq>)" 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
+      using completeD[OF comp CA, OF 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 "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
   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>)"
+  have compB: "well_related_set-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 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
 
 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 "\<forall>C \<subseteq> A. well_related_set C (\<sqsubseteq>) \<longrightarrow> CC C (\<sqsubseteq>)"
+    and "\<forall>X Y. CC X (\<sqsubseteq>) \<longrightarrow> CC Y (\<sqsubseteq>) \<longrightarrow> X \<sqsubseteq>\<^sup>s Y \<longrightarrow> CC (X \<union> Y) (\<sqsubseteq>)"
     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
 
 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 wr_CC: "\<forall>C \<subseteq> A. well_related_set C (\<sqsubseteq>) \<longrightarrow> CC C (\<sqsubseteq>)"
+    and extend: "\<forall>X Y. CC X (\<sqsubseteq>) \<longrightarrow> CC Y (\<sqsubseteq>) \<longrightarrow> X \<sqsubseteq>\<^sup>s Y \<longrightarrow> CC (X \<union> Y) (\<sqsubseteq>)"
     and mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
   shows "CC-complete {p \<in> A. f p = p} (\<sqsubseteq>)"
 proof-
   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
 
 subsection \<open>Instances\<close>
 
 subsubsection \<open>Instances under attractivity\<close>
 
 context attractive begin
 
-interpretation less_eq_notations.
+interpretation less_eq_symmetrize.
 
 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>)"
+theorem mono_imp_qfp_complete:
+  assumes comp: "\<top>-complete A (\<sqsubseteq>)" and f: "f ` A \<subseteq> A" and mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
+  shows "\<top>-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>)"
+  assumes comp: "connex-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>)"
+  shows "connex-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)
+  by (auto simp: f intro: connex_union well_related_set.connex)
 
 text \<open>Directed completeness\<close>
 theorem mono_imp_qfp_directed_complete:
-  assumes comp: "{X. directed X (\<sqsubseteq>)}-complete A (\<sqsubseteq>)"
+  assumes comp: "directed-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>)"
+  shows "directed-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)
+  by (auto simp: f intro!: directed_extend intro: well_related_set.connex connex.directed)
 
 text \<open>Well Completeness\<close>
 theorem mono_imp_qfp_well_complete:
-  assumes comp: "well_complete A (\<sqsubseteq>)"
+  assumes comp: "well_related_set-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>)"
+  shows "well_related_set-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
 
 subsubsection \<open>Usual instances under antisymmetry \<close>
 
 context antisymmetric begin
 
 text \<open>Knaster--Tarski\<close>
 theorem mono_imp_fp_complete:
-  assumes comp: "UNIV-complete A (\<sqsubseteq>)"
+  assumes comp: "\<top>-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>)"
+  shows "\<top>-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
 qed
 
 text \<open>Markowsky 1976\<close>
 theorem mono_imp_fp_connex_complete:
-  assumes comp: "{X. connex X (\<sqsubseteq>)}-complete A (\<sqsubseteq>)"
+  assumes comp: "connex-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>)"
+  shows "connex-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)
+    by (auto intro: connex_union well_related_set.connex)
 qed
 
 text \<open>Pataraia\<close>
 theorem mono_imp_fp_directed_complete:
-  assumes comp: "{X. directed X (\<sqsubseteq>)}-complete A (\<sqsubseteq>)"
+  assumes comp: "directed-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>)"
+  shows "directed-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)
+     by (auto intro: directed_extend connex.directed well_related_set.connex)
 qed
 
 text \<open>Bhatta \& George 2011\<close>
 theorem mono_imp_fp_well_complete:
-  assumes comp: "well_complete A (\<sqsubseteq>)"
+  assumes comp: "well_related_set-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>)"
+  shows "well_related_set-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
diff --git a/thys/Complete_Non_Orders/Kleene_Fixed_Point.thy b/thys/Complete_Non_Orders/Kleene_Fixed_Point.thy
--- a/thys/Complete_Non_Orders/Kleene_Fixed_Point.thy
+++ b/thys/Complete_Non_Orders/Kleene_Fixed_Point.thy
@@ -1,291 +1,210 @@
 theory Kleene_Fixed_Point
-  imports Complete_Relations
+  imports Complete_Relations Continuity
 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>\<open>"mashburn83"\<close> generalized the result so that
+Mashburn \cite{mashburn83} generalized the result so that
 $\tp{A,\SLE}$ is a $\omega$-complete partial order
 and $f$ is $\omega$-continuous.
 
 In this section we further generalize the result and show that
 for $\omega$-complete relation $\tp{A,\SLE}$
 and for every bottom element $\bot \in A$,
 the set $\set{f^n(\bot) \mid n\in\Nat}$ has suprema (not necessarily unique, of 
 course) and, 
 they are quasi-fixed points.
 Moreover, if $(\SLE)$ is attractive, then the suprema are precisely the least 
 quasi-fixed points.\<close>
 
-subsection \<open>Scott Continuity, $\omega$-Completeness, $\omega$-Continuity\<close>
-
-text \<open>In this Section, we formalize $\omega$-completeness, Scott continuity and $\omega$-continuity.
-We then prove that a Scott continuous map is $\omega$-continuous and that an $\omega$-continuous 
-map is ``nearly'' monotone.\<close>
-
-context
-  fixes A :: "'a set" and less_eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
-begin
-
-definition "omega_continuous f \<equiv>
-  f ` A \<subseteq> A \<and>
-  (\<forall>c :: nat \<Rightarrow> 'a. \<forall> b \<in> A.
-  range c \<subseteq> A \<longrightarrow>
-  monotone (\<le>) (\<sqsubseteq>) c \<longrightarrow>
-  extreme_bound A (\<sqsubseteq>) (range c) b \<longrightarrow> extreme_bound A (\<sqsubseteq>) (f ` range c) (f b))"
-
-lemmas omega_continuousI[intro?] =
-  omega_continuous_def[unfolded atomize_eq, THEN iffD2, unfolded conj_imp_eq_imp_imp, rule_format]
-
-lemmas omega_continuousDdom =
-  omega_continuous_def[unfolded atomize_eq, THEN iffD1, unfolded conj_imp_eq_imp_imp, THEN conjunct1]
-
-lemmas omega_continuousD =
-  omega_continuous_def[unfolded atomize_eq, THEN iffD1, unfolded conj_imp_eq_imp_imp, THEN conjunct2, rule_format]
-
-lemmas omega_continuousE[elim] =
-  omega_continuous_def[unfolded atomize_eq, THEN iffD1, elim_format, unfolded conj_imp_eq_imp_imp, rule_format]
-
-lemma omega_continuous_imp_mono_refl:
-  assumes cont: "omega_continuous f"
-    and x: "x \<in> A" and y: "y \<in> A"
-    and xy: "x \<sqsubseteq> y" and xx: "x \<sqsubseteq> x" and yy: "y \<sqsubseteq> y"
-  shows "f x \<sqsubseteq> f y"
-proof-
-  define c :: "nat \<Rightarrow> 'a" where "c \<equiv> \<lambda>i. if i = 0 then x else y"
-  from x y xx xy yy have c: "range c \<subseteq> A" "monotone (\<le>) (\<sqsubseteq>) c"
-    by (auto simp: c_def intro!: monotoneI)
-  have "extreme_bound A (\<sqsubseteq>) (range c) y" using xy yy x y by (auto simp: c_def)
-  then have fboy: "extreme_bound A (\<sqsubseteq>) (f ` range c) (f y)" using c cont y by auto
-  then show "f x \<sqsubseteq> f y" by (auto simp: c_def)
-qed
-
-definition "scott_continuous f \<equiv>
-  f ` A \<subseteq> A \<and>
-  (\<forall>X s. X \<subseteq> A \<longrightarrow> directed X (\<sqsubseteq>) \<longrightarrow> X \<noteq> {} \<longrightarrow> extreme_bound A (\<sqsubseteq>) X s \<longrightarrow> extreme_bound A (\<sqsubseteq>) (f ` X) (f s))"
-
-lemmas scott_continuousI[intro?] =
-  scott_continuous_def[unfolded atomize_eq, THEN iffD2, unfolded conj_imp_eq_imp_imp, rule_format]
-
-lemmas scott_continuousE =
-  scott_continuous_def[unfolded atomize_eq, THEN iffD1, elim_format, unfolded conj_imp_eq_imp_imp, rule_format]
-
-lemma scott_continuous_imp_mono_refl:
-  assumes scott: "scott_continuous f"
-    and x: "x \<in> A" and y: "y \<in> A" and xy: "x \<sqsubseteq> y" and yy: "y \<sqsubseteq> y"
-  shows "f x \<sqsubseteq> f y"
-proof-
-  define D where "D \<equiv> {x,y}"
-  from x y xy yy have dir_D: "D \<subseteq> A" "directed D (\<sqsubseteq>)" "D \<noteq> {}"
-    by (auto simp: D_def intro!: bexI[of _ y] directedI)
-  have "extreme_bound A (\<sqsubseteq>) D y" using xy yy x y by (auto simp: D_def)
-  then have fboy: "extreme_bound A (\<sqsubseteq>) (f ` D) (f y)" using dir_D scott by (auto elim!: scott_continuousE)
-  then show "f x \<sqsubseteq> f y" by (auto simp: D_def)
-qed
-
-lemma scott_continuous_imp_omega_continuous:
-  assumes scott: "scott_continuous f" shows "omega_continuous f"
-proof
-  from scott show "f ` A \<subseteq> A" by (auto elim!: scott_continuousE)
-  fix c :: "nat \<Rightarrow> 'a"
-  assume mono: "monotone (\<le>) (\<sqsubseteq>) c" and c: "range c \<subseteq> A"
-  from monotone_directed_image[OF mono[folded monotone_on_UNIV] order.directed] scott c
-  show "extreme_bound A (\<sqsubseteq>) (range c) b \<Longrightarrow> extreme_bound A (\<sqsubseteq>) (f ` range c) (f b)" for b
-    by (auto elim!: scott_continuousE)
-qed
-
-end
-
 subsection \<open>Existence of Iterative Fixed Points\<close>
 
 text \<open>The first part of Kleene's theorem demands to prove that the set 
 $\set{f^n(\bot) \mid n \in \Nat}$ has a supremum and 
 that all such are quasi-fixed points. We prove this claim without assuming 
 anything on the relation $\SLE$ besides $\omega$-completeness and one bottom element.\<close>
 
-(*
-no_notation power (infixr "^" 80)
-*)
 notation compower ("_^_"[1000,1000]1000)
 
-lemma mono_funpow: assumes f: "f ` A \<subseteq> A" and mono: "monotone_on A r r f"
+lemma monotone_on_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"
+  assumes cont: "omega_chain-continuous A (\<sqsubseteq>) A (\<sqsubseteq>) f"
 begin
 
-interpretation less_eq_notations.
+interpretation less_eq_symmetrize.
 
 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]
+  from f fn omega_continuous_imp_mono_refl[OF cont 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_chain: "omega_chain Fn (\<sqsubseteq>)"
+proof (intro omega_chainI)
+  show 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
+qed auto
 
 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)
+    apply (rule continuousD[OF cont _ _ FnA q])
+    using Fn_chain by 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]
+  from extreme_bound_subset[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
+  assumes comp: "omega_chain-complete A (\<sqsubseteq>)"
+  shows "\<exists>p. extreme_bound A (\<sqsubseteq>) Fn p"
+  apply (intro comp[THEN completeD, OF FnA])
+  using Fn_chain
+  by auto
 
 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 comp: "omega_chain-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
+        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.
+interpretation less_eq_dualize + less_eq_symmetrize.
 
 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"
+  assumes comp: "omega_chain-complete A (\<sqsubseteq>)"
+    and cont: "omega_chain-continuous A (\<sqsubseteq>) 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]
+  using continuous_carrierD[OF cont]
   by (auto dest: sym_order_trans order_sym_trans)
 
 end
 
 corollary(in antisymmetric) kleene_fp:
-  assumes cont: "omega_continuous A (\<sqsubseteq>) f"
+  assumes cont: "omega_chain-continuous A (\<sqsubseteq>) 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]
+  using kleene_qfp[OF b cont] p cont[THEN continuous_carrierD]
   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,12 @@
 chapter AFP
 
 session Complete_Non_Orders (AFP) = HOL +
   description "Fixed-Point Theorems for Non-Transitive Relations"
   options [timeout = 300]
+  sessions
+    "HOL-Library"
   theories
     Fixed_Points Kleene_Fixed_Point
   document_files
     "root.tex"
     "root.bib"
diff --git a/thys/Complete_Non_Orders/Well_Relations.thy b/thys/Complete_Non_Orders/Well_Relations.thy
new file mode 100755
--- /dev/null
+++ b/thys/Complete_Non_Orders/Well_Relations.thy
@@ -0,0 +1,845 @@
+theory Well_Relations
+  imports Binary_Relations
+begin
+
+section \<open>Well-Relations\<close>
+
+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>
+
+definition "extremed A r \<equiv> \<exists>e. extreme A r e"
+
+lemma extremedI: "extreme A r e \<Longrightarrow> extremed A r"
+  by (auto simp: extremed_def)
+
+lemma extremedE: "extremed A r \<Longrightarrow> (\<And>e. extreme A r e \<Longrightarrow> thesis) \<Longrightarrow> thesis"
+  by (auto simp: extremed_def)
+
+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)
+
+locale well_founded = related_set _ "(\<sqsubset>)" + less_syntax +
+  assumes induct[consumes 1, case_names less, induct set]:
+    "a \<in> A \<Longrightarrow> (\<And>x. x \<in> A \<Longrightarrow> (\<And>y. y \<in> A \<Longrightarrow> y \<sqsubset> x \<Longrightarrow> P y) \<Longrightarrow> P x) \<Longrightarrow> P a"
+begin
+
+sublocale asymmetric
+proof (intro asymmetric.intro notI)
+  fix x y
+  assume xA: "x \<in> A"
+  then show "y \<in> A \<Longrightarrow> x \<sqsubset> y \<Longrightarrow> y \<sqsubset> x \<Longrightarrow> False"
+    by (induct arbitrary: y rule: induct, auto)
+qed
+
+lemma prefixed_Imagep_imp_empty:
+  assumes a: "X \<subseteq> ((\<sqsubset>) ``` X) \<inter> A" shows "X = {}"
+proof -
+  from a have XA: "X \<subseteq> A" by auto
+  have "x \<in> A \<Longrightarrow> x \<notin> X" for x
+  proof (induct x rule: induct)
+    case (less x)
+    with a show ?case by (auto simp: Imagep_def)
+  qed
+  with XA show ?thesis by auto
+qed
+
+lemma nonempty_imp_ex_extremal:
+  assumes QA: "Q \<subseteq> A" and Q: "Q \<noteq> {}"
+  shows "\<exists>z \<in> Q. \<forall>y \<in> Q. \<not> y \<sqsubset> z"
+  using Q prefixed_Imagep_imp_empty[of Q] QA by (auto simp: Imagep_def)
+
+interpretation Restrp: well_founded UNIV "(\<sqsubset>)\<restriction>A"
+  rewrites "\<And>x. x \<in> UNIV \<equiv> True"
+    and "(\<sqsubset>)\<restriction>A\<restriction>UNIV = (\<sqsubset>)\<restriction>A"
+    and "\<And>P1. (True \<Longrightarrow> PROP P1) \<equiv> PROP P1"
+    and "\<And>P1. (True \<Longrightarrow> P1) \<equiv> Trueprop P1"
+    and "\<And>P1 P2. (True \<Longrightarrow> PROP P1 \<Longrightarrow> PROP P2) \<equiv> (PROP P1 \<Longrightarrow> PROP P2)"
+proof -
+  have "(\<And>x. (\<And>y. ((\<sqsubset>) \<restriction> A) y x \<Longrightarrow> P y) \<Longrightarrow> P x) \<Longrightarrow> P a" for a P
+    using induct[of a P] by (auto simp: Restrp_def)
+  then show "well_founded UNIV ((\<sqsubset>)\<restriction>A)" apply unfold_locales by auto
+qed auto
+
+lemmas Restrp_well_founded = Restrp.well_founded_axioms
+lemmas Restrp_induct[consumes 0, case_names less] = Restrp.induct
+
+interpretation Restrp.tranclp: well_founded UNIV "((\<sqsubset>)\<restriction>A)\<^sup>+\<^sup>+"
+  rewrites "\<And>x. x \<in> UNIV \<equiv> True"
+    and "((\<sqsubset>)\<restriction>A)\<^sup>+\<^sup>+ \<restriction> UNIV = ((\<sqsubset>)\<restriction>A)\<^sup>+\<^sup>+"
+    and "(((\<sqsubset>)\<restriction>A)\<^sup>+\<^sup>+)\<^sup>+\<^sup>+ = ((\<sqsubset>)\<restriction>A)\<^sup>+\<^sup>+"
+    and "\<And>P1. (True \<Longrightarrow> PROP P1) \<equiv> PROP P1"
+    and "\<And>P1. (True \<Longrightarrow> P1) \<equiv> Trueprop P1"
+    and "\<And>P1 P2. (True \<Longrightarrow> PROP P1 \<Longrightarrow> PROP P2) \<equiv> (PROP P1 \<Longrightarrow> PROP P2)"
+proof-
+  { fix P x
+    assume induct_step: "\<And>x. (\<And>y. ((\<sqsubset>)\<restriction>A)\<^sup>+\<^sup>+ y x \<Longrightarrow> P y) \<Longrightarrow> P x"
+    have "P x"
+    proof (rule induct_step)
+      show "\<And>y. ((\<sqsubset>)\<restriction>A)\<^sup>+\<^sup>+ y x \<Longrightarrow> P y"
+      proof (induct x rule: Restrp_induct)
+        case (less x)
+        from \<open>((\<sqsubset>)\<restriction>A)\<^sup>+\<^sup>+ y x\<close>
+        show ?case
+        proof (cases rule: tranclp.cases)
+          case r_into_trancl
+          with induct_step less show ?thesis by auto
+        next
+          case (trancl_into_trancl b)
+          with less show ?thesis by auto
+        qed
+      qed
+    qed
+  }
+  then show "well_founded UNIV ((\<sqsubset>)\<restriction>A)\<^sup>+\<^sup>+" by unfold_locales auto
+qed auto
+
+lemmas Restrp_tranclp_well_founded = Restrp.tranclp.well_founded_axioms
+lemmas Restrp_tranclp_induct[consumes 0, case_names less] = Restrp.tranclp.induct
+
+end
+
+context
+  fixes A :: "'a set" and less :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubset>" 50)
+begin
+
+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
+
+lemma well_foundedI_extremal:
+  assumes a: "\<And>X. X \<subseteq> A \<Longrightarrow> X \<noteq> {} \<Longrightarrow> \<exists>x \<in> X. \<forall>y \<in> X. \<not> y \<sqsubset> x"
+  shows "well_founded A (\<sqsubset>)"
+proof (rule well_foundedI_pf)
+  fix X assume XA: "X \<subseteq> A" and pf: "X \<subseteq> ((\<sqsubset>) ``` X) \<inter> A"
+  from a[OF XA] pf show "X = {}" by (auto simp: Imagep_def)
+qed
+
+lemma well_founded_iff_ex_extremal:
+  "well_founded A (\<sqsubset>) \<longleftrightarrow> (\<forall>X \<subseteq> A. X \<noteq> {} \<longrightarrow> (\<exists>x \<in> X. \<forall>z \<in> X. \<not> z \<sqsubset> x))"
+  using well_founded.nonempty_imp_ex_extremal well_foundedI_extremal by blast
+
+end
+
+lemma well_founded_cong:
+  assumes r: "\<And>a b. a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> r a b \<longleftrightarrow> r' a b"
+    and A: "\<And>a b. r' a b \<Longrightarrow> a \<in> A \<longleftrightarrow> a \<in> A'"
+    and B: "\<And>a b. r' a b \<Longrightarrow> b \<in> A \<longleftrightarrow> b \<in> A'"
+  shows "well_founded A r \<longleftrightarrow> well_founded A' r'"
+proof (intro iffI)
+  assume wf: "well_founded A r"
+  show "well_founded A' r'"
+  proof (intro well_foundedI_extremal)
+    fix X
+    assume X: "X \<subseteq> A'" and X0: "X \<noteq> {}"
+    show "\<exists>x\<in>X. \<forall>y\<in>X. \<not> r' y x"
+    proof (cases "X \<inter> A = {}")
+      case True
+      from X0 obtain x where xX: "x \<in> X" by auto
+      with True have "x \<notin> A" by auto
+      with xX X have "\<forall>y\<in>X. \<not> r' y x" by (auto simp: B)
+      with xX show ?thesis by auto
+    next
+      case False
+      from well_founded.nonempty_imp_ex_extremal[OF wf _ this]
+      obtain x where x: "x \<in> X \<inter> A" and Ar: "\<And>y. y \<in> X \<Longrightarrow> y \<in> A \<Longrightarrow> \<not> r y x" by auto
+      have "\<forall>y \<in> X. \<not> r' y x"
+      proof (intro ballI notI)
+        fix y assume yX: "y \<in> X" and yx: "r' y x"
+        from yX X have yA': "y \<in> A'" by auto
+        show False
+        proof (cases "y \<in> A")
+          case True with x Ar[OF yX] yx r show ?thesis by auto
+        next
+          case False with yA' x A[OF yx] r X show ?thesis by (auto simp:)
+        qed
+      qed
+      with x show "\<exists>x \<in> X. \<forall>y \<in> X. \<not> r' y x" by auto
+    qed
+  qed
+next
+  assume wf: "well_founded A' r'"
+  show "well_founded A r"
+  proof (intro well_foundedI_extremal)
+    fix X
+    assume X: "X \<subseteq> A" and X0: "X \<noteq> {}"
+    show "\<exists>x\<in>X. \<forall>y\<in>X. \<not> r y x"
+    proof (cases "X \<inter> A' = {}")
+      case True
+      from X0 obtain x where xX: "x \<in> X" by auto
+      with True have "x \<notin> A'" by auto
+      with xX X B have "\<forall>y\<in>X. \<not> r y x" by (auto simp: r in_mono)
+      with xX show ?thesis by auto
+    next
+      case False
+      from well_founded.nonempty_imp_ex_extremal[OF wf _ this]
+      obtain x where x: "x \<in> X \<inter> A'" and Ar: "\<And>y. y \<in> X \<Longrightarrow> y \<in> A' \<Longrightarrow> \<not> r' y x" by auto
+      have "\<forall>y \<in> X. \<not> r y x"
+      proof (intro ballI notI)
+        fix y assume yX: "y \<in> X" and yx: "r y x"
+        from yX X have y: "y \<in> A" by auto
+        show False
+        proof (cases "y \<in> A'")
+          case True with x Ar[OF yX] yx r X y show ?thesis by auto
+        next
+          case False with y x A yx r X show ?thesis by auto
+        qed
+      qed
+      with x show "\<exists>x \<in> X. \<forall>y \<in> X. \<not> r y x" by auto
+    qed
+  qed
+qed
+
+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_empty[intro!]: "well_founded {} r"
+  by (auto simp: well_founded_iff_ex_extremal)
+
+lemma well_founded_singleton:
+  assumes "\<not>r x x" shows "well_founded {x} r"
+  using assms by (auto simp: well_founded_iff_ex_extremal)
+
+lemma well_founded_Restrp[simp]: "well_founded A (r\<restriction>B) \<longleftrightarrow> well_founded (A\<inter>B) r" (is "?l \<longleftrightarrow> ?r")
+proof (intro iffI well_foundedI_extremal)
+  assume l: ?l
+  fix X assume XAB: "X \<subseteq> A \<inter> B" and X0: "X \<noteq> {}"
+  with l[THEN well_founded.nonempty_imp_ex_extremal]
+  have "\<exists>x\<in>X. \<forall>z\<in>X. \<not> (r \<restriction> B) z x" by auto
+  with XAB show "\<exists>x\<in>X. \<forall>y\<in>X. \<not> r y x" by (auto simp: Restrp_def)
+next
+  assume r: ?r
+  fix X assume XA: "X \<subseteq> A" and X0: "X \<noteq> {}"
+  show "\<exists>x\<in>X. \<forall>y\<in>X. \<not> (r \<restriction> B) y x"
+  proof (cases "X \<subseteq> B")
+    case True
+    with r[THEN well_founded.nonempty_imp_ex_extremal, of X] XA X0
+    have "\<exists>z\<in>X. \<forall>y\<in>X. \<not> r y z" by auto
+    then show ?thesis by auto
+  next
+    case False
+    then obtain x where x: "x \<in> X - B" by auto
+    then have "\<forall>y\<in>X. \<not> (r \<restriction> B) y x" by auto
+    with x show ?thesis by auto
+  qed
+qed
+
+lemma Restrp_tranclp_well_founded_iff:
+  fixes less (infix "\<sqsubset>" 50)
+  shows "well_founded UNIV ((\<sqsubset>) \<restriction> A)\<^sup>+\<^sup>+ \<longleftrightarrow> well_founded A (\<sqsubset>)" (is "?l \<longleftrightarrow> ?r")
+proof (rule iffI)
+  show "?r \<Longrightarrow> ?l" by (fact well_founded.Restrp_tranclp_well_founded)
+  assume ?l
+  then interpret well_founded UNIV "((\<sqsubset>) \<restriction> A)\<^sup>+\<^sup>+".
+  show ?r
+  proof (unfold well_founded_iff_ex_extremal, intro allI impI)
+    fix X assume XA: "X \<subseteq> A" and X0: "X \<noteq> {}"
+    from nonempty_imp_ex_extremal[OF _ X0]
+    obtain z where zX: "z \<in> X" and Xz: "\<forall>y\<in>X. \<not> ((\<sqsubset>) \<restriction> A)\<^sup>+\<^sup>+ y z" by auto
+    show "\<exists>z \<in> X. \<forall>y \<in> X. \<not> y \<sqsubset> z"
+    proof (intro bexI[OF _ zX] ballI notI)
+      fix y assume yX: "y \<in> X" and yz: "y \<sqsubset> z"
+      from yX yz zX XA have "((\<sqsubset>) \<restriction> A) y z" by auto
+      with yX Xz show False by auto
+    qed
+  qed
+qed
+
+lemma (in well_founded) well_founded_subset:
+  assumes "B \<subseteq> A" shows "well_founded B (\<sqsubset>)"
+  using assms well_founded_axioms by (auto simp: well_founded_iff_ex_extremal)
+
+lemma well_founded_extend:
+  fixes less (infix "\<sqsubset>" 50)
+  assumes A: "well_founded A (\<sqsubset>)"
+  assumes B: "well_founded B (\<sqsubset>)"
+  assumes AB: "\<forall>a \<in> A. \<forall>b \<in> B. \<not>b \<sqsubset> a"
+  shows "well_founded (A \<union> B) (\<sqsubset>)"
+proof (intro well_foundedI_extremal)
+  interpret A: well_founded A "(\<sqsubset>)" using A.
+  interpret B: well_founded B "(\<sqsubset>)" using B.
+  fix X assume XAB: "X \<subseteq> A \<union> B" and X0: "X \<noteq> {}"
+  show "\<exists>x\<in>X. \<forall>y\<in>X. \<not> y \<sqsubset> x"
+  proof (cases "X \<inter> A = {}")
+    case True
+    with XAB have XB: "X \<subseteq> B" by auto
+    from B.nonempty_imp_ex_extremal[OF XB X0] show ?thesis.
+  next
+    case False
+    with A.nonempty_imp_ex_extremal[OF _ this]
+    obtain e where XAe: "e \<in> X \<inter> A" "\<forall>y\<in>X \<inter> A. \<not> y \<sqsubset> e" by auto
+    then have eX: "e \<in> X" and eA: "e \<in> A" by auto
+    { fix x assume xX: "x \<in> X"
+      have "\<not>x \<sqsubset> e"
+      proof (cases "x \<in> A")
+        case True with XAe xX show ?thesis by auto
+      next
+        case False
+        with xX XAB have "x \<in> B" by auto
+        with AB eA show ?thesis by auto
+      qed
+    }
+    with eX show ?thesis by auto
+  qed
+qed
+
+lemma closed_UN_well_founded:
+  fixes r (infix "\<sqsubset>" 50)
+  assumes XX: "\<forall>X\<in>XX. well_founded X (\<sqsubset>) \<and> (\<forall>x\<in>X. \<forall>y\<in>\<Union>XX. y \<sqsubset> x \<longrightarrow> y \<in> X)"
+  shows "well_founded (\<Union>XX) (\<sqsubset>)"
+proof (intro well_foundedI_extremal)
+  have *: "X \<in> XX \<Longrightarrow> x\<in>X \<Longrightarrow> y \<in> \<Union>XX \<Longrightarrow> y \<sqsubset> x \<Longrightarrow> y \<in> X" for X x y using XX by blast
+  fix S
+  assume S: "S \<subseteq> \<Union>XX" and S0: "S \<noteq> {}"
+  from S0 obtain x where xS: "x \<in> S" by auto
+  with S obtain X where X: "X \<in> XX" and xX: "x \<in> X" by auto
+  from xS xX have Sx0: "S \<inter> X \<noteq> {}" by auto
+  from X XX interpret well_founded X "(\<sqsubset>)" by auto
+  from nonempty_imp_ex_extremal[OF _ Sx0]
+  obtain z where zS: "z \<in> S" and zX: "z \<in> X" and min: "\<forall>y \<in> S \<inter> X. \<not> y \<sqsubset> z" by auto
+  show "\<exists>x\<in>S. \<forall>y\<in>S. \<not> y \<sqsubset> x"
+  proof (intro bexI[OF _ zS] ballI notI)
+    fix y
+    assume yS: "y \<in> S" and yz: "y \<sqsubset> z"
+    have yXX: "y \<in> \<Union> XX" using S yS by auto
+    from *[OF X zX yXX yz] yS have "y \<in> X \<inter> S" by auto
+    with min yz show False by auto
+  qed
+qed
+
+lemma well_founded_cmono:
+  assumes r': "r' \<le> r" and wf: "well_founded A r"
+  shows "well_founded A r'"
+proof (intro well_foundedI_extremal)
+  fix X assume "X \<subseteq> A" and "X \<noteq> {}"
+  from well_founded.nonempty_imp_ex_extremal[OF wf this]
+  show "\<exists>x\<in>X. \<forall>y\<in>X. \<not> r' y x" using r' by auto
+qed
+
+locale well_founded_ordered_set = well_founded + transitive _ "(\<sqsubset>)"
+begin
+
+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 well_founded_ordered_setI = well_founded_ordered_set.intro
+
+lemma well_founded_ordered_set_empty[intro!]: "well_founded_ordered_set {} r"
+  by (auto intro!: well_founded_ordered_setI)
+
+
+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
+
+lemmas connex = connex_axioms(* I'd like to access well_related_set.connex_axioms,
+  but it's not visible without interpretation. *)
+
+interpretation less_eq_asymmetrize.
+
+sublocale asym: well_founded A "(\<sqsubset>)"
+proof (unfold well_founded_iff_ex_extremal, intro allI impI)
+  fix X
+  assume XA: "X \<subseteq> A" and X0: "X \<noteq> {}"
+  from nonempty_imp_ex_extreme[OF XA X0] obtain e where "extreme X (\<sqsubseteq>)\<^sup>- e" by auto
+  then show "\<exists>x\<in>X. \<forall>z\<in>X. \<not>z \<sqsubset> x" by (auto intro!: bexI[of _ e])
+qed
+
+lemma well_related_subset: "B \<subseteq> A \<Longrightarrow> well_related_set B (\<sqsubseteq>)"
+  by (auto intro!: well_related_set.intro nonempty_imp_ex_extreme)
+
+lemma monotone_image_well_related:
+  fixes leB (infix "\<unlhd>" 50)
+  assumes mono: "monotone_on A (\<sqsubseteq>) (\<unlhd>) f" shows "well_related_set (f ` A) (\<unlhd>)"
+proof (intro well_related_set.intro)
+  interpret less_eq_dualize.
+  fix X' assume X'fA: "X' \<subseteq> f ` A" and X'0: "X' \<noteq> {}"
+  then obtain X where XA: "X \<subseteq> A" and X': "X' = f ` X" and X0: "X \<noteq> {}"
+    by (auto elim!: subset_imageE)
+  from nonempty_imp_ex_extreme[OF XA X0]
+  obtain e where Xe: "extreme X (\<sqsupseteq>) e" by auto
+  note monotone_on_subset[OF mono XA]
+  note monotone_on_dual[OF this]
+  from monotone_image_extreme[OF this Xe]
+  show "\<exists>e'. extreme X' (\<unlhd>)\<^sup>- e'" by (auto simp: X')
+qed
+
+end
+
+sublocale well_related_set \<subseteq> reflexive using local.reflexive_axioms.
+
+lemmas well_related_setI = well_related_set.intro
+
+lemmas well_related_iff_ex_extreme = well_related_set_def
+
+lemma well_related_set_empty[intro!]: "well_related_set {} r"
+  by (auto intro!: well_related_setI)
+
+context
+  fixes less_eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
+begin
+
+lemma well_related_iff_neg_well_founded:
+  "well_related_set A (\<sqsubseteq>) \<longleftrightarrow> well_founded A (\<lambda>x y. \<not> y \<sqsubseteq> x)"
+  by (simp add: well_related_set_def well_founded_iff_ex_extremal extreme_def Bex_def)
+
+lemma well_related_singleton_refl: 
+  assumes "x \<sqsubseteq> x" shows "well_related_set {x} (\<sqsubseteq>)"
+  by (intro well_related_set.intro exI[of _ x], auto simp: subset_singleton_iff assms)
+
+lemma closed_UN_well_related:
+  assumes XX: "\<forall>X\<in>XX. well_related_set X (\<sqsubseteq>) \<and> (\<forall>x\<in>X. \<forall>y\<in>\<Union>XX. \<not>x \<sqsubseteq> y \<longrightarrow> y \<in> X)"
+  shows "well_related_set (\<Union>XX) (\<sqsubseteq>)"
+  using XX
+  apply (unfold well_related_iff_neg_well_founded)
+  using closed_UN_well_founded[of _ "\<lambda>x y. \<not> y \<sqsubseteq> x"].
+
+end
+
+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
+
+lemma pair_well_related:
+  fixes less_eq (infix "\<sqsubseteq>" 50)
+  assumes "i \<sqsubseteq> i" and "i \<sqsubseteq> j" and "j \<sqsubseteq> j"
+  shows "well_related_set {i, j} (\<sqsubseteq>)"
+proof (intro well_related_setI)
+  fix X assume "X \<subseteq> {i,j}" and "X \<noteq> {}"
+  then have "X = {i,j} \<or> X = {i} \<or> X = {j}" by auto
+  with assms show "\<exists>e. extreme X (\<sqsubseteq>)\<^sup>- e" by auto
+qed
+
+locale pre_well_ordered_set = semiattractive + well_related_set
+begin
+
+interpretation less_eq_asymmetrize.
+
+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..
+
+end
+
+lemmas pre_well_ordered_iff_semiattractive_well_related =
+  pre_well_ordered_set_def[unfolded atomize_eq]
+
+lemma pre_well_ordered_set_empty[intro!]: "pre_well_ordered_set {} r"
+  by (auto simp: pre_well_ordered_iff_semiattractive_well_related)
+
+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
+
+lemma (in well_related_set) monotone_image_pre_well_ordered:
+  fixes leB (infix "\<sqsubseteq>''" 50)
+  assumes mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>') f"
+    and image: "semiattractive (f ` A) (\<sqsubseteq>')"
+  shows "pre_well_ordered_set (f ` A) (\<sqsubseteq>')"
+  by (intro pre_well_ordered_set.intro monotone_image_well_related[OF mono] image)
+
+locale well_ordered_set = antisymmetric + well_related_set
+begin
+
+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)
+
+sublocale asym: well_founded_ordered_set A "asympartp (\<sqsubseteq>)"
+  by (intro well_founded_ordered_set.intro asym.well_founded_axioms asympartp_transitive)
+
+end
+
+lemmas well_ordered_iff_antisymmetric_well_related = well_ordered_set_def[unfolded atomize_eq]
+
+lemma well_ordered_set_empty[intro!]: "well_ordered_set {} r"
+  by (auto simp: well_ordered_iff_antisymmetric_well_related)
+
+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 :: "'a set" and less_eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
+begin
+
+context
+  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
+
+interpretation less_eq_asymmetrize.
+
+lemma well_ordered_iff_well_founded_total_ordered:
+  "well_ordered_set A (\<sqsubseteq>) \<longleftrightarrow> total_ordered_set A (\<sqsubseteq>) \<and> well_founded A (\<sqsubset>)"
+proof (safe)
+  assume "well_ordered_set A (\<sqsubseteq>)"
+  then interpret well_ordered_set A "(\<sqsubseteq>)".
+  show "total_ordered_set A (\<sqsubseteq>)" "well_founded A (\<sqsubset>)" by unfold_locales
+next
+  assume "total_ordered_set A (\<sqsubseteq>)" and "well_founded A (\<sqsubset>)"
+  then interpret total_ordered_set A "(\<sqsubseteq>)" + asympartp: well_founded A "(\<sqsubset>)".
+  show "well_ordered_set A (\<sqsubseteq>)"
+  proof
+    fix X assume XA: "X \<subseteq> A" and "X \<noteq> {}"
+    from XA asympartp.nonempty_imp_ex_extremal[OF this] 
+    show "\<exists>e. extreme X (\<sqsupseteq>) e" by (auto simp: not_asym_iff subsetD)
+  qed
+qed
+
+end
+
+context
+  fixes less_eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50)
+begin
+
+lemma well_order_extend:
+  assumes A: "well_ordered_set A (\<sqsubseteq>)" and B: "well_ordered_set B (\<sqsubseteq>)"
+    and ABa: "\<forall>a \<in> A. \<forall>b \<in> B. a \<sqsubseteq> b \<longrightarrow> b \<sqsubseteq> a \<longrightarrow> a = b"
+    and AB: "\<forall>a \<in> A. \<forall>b \<in> B. a \<sqsubseteq> b"
+  shows "well_ordered_set (A\<union>B) (\<sqsubseteq>)"
+proof-
+  interpret A: well_ordered_set A "(\<sqsubseteq>)" using A.
+  interpret B: well_ordered_set B "(\<sqsubseteq>)" using B.
+  show ?thesis
+    apply (intro well_ordered_set.intro antisymmetric_union well_related_extend ABa AB)
+    by unfold_locales
+qed
+
+interpretation singleton: antisymmetric "{a}" "(\<sqsubseteq>)" for a apply unfold_locales by auto
+
+lemmas singleton_antisymmetric[intro!] = singleton.antisymmetric_axioms
+
+lemma singleton_well_ordered[intro!]: "a \<sqsubseteq> a \<Longrightarrow> well_ordered_set {a} (\<sqsubseteq>)"
+  apply unfold_locales by auto
+
+lemma closed_UN_well_ordered:
+  assumes anti: "antisymmetric (\<Union> XX) (\<sqsubseteq>)"
+    and XX: "\<forall>X\<in>XX. well_ordered_set X (\<sqsubseteq>) \<and> (\<forall>x\<in>X. \<forall>y\<in>\<Union>XX. \<not> x \<sqsubseteq> y \<longrightarrow> y \<in> X)"
+  shows "well_ordered_set (\<Union>XX) (\<sqsubseteq>)"
+  apply (intro well_ordered_set.intro closed_UN_well_related anti)
+  using XX well_ordered_set.axioms by fast
+
+end
+
+lemma (in well_related_set) monotone_image_well_ordered:
+  fixes leB (infix "\<sqsubseteq>''" 50)
+  assumes mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>') f"
+    and image: "antisymmetric (f ` A) (\<sqsubseteq>')"
+  shows "well_ordered_set (f ` A) (\<sqsubseteq>')"
+  by (intro well_ordered_set.intro monotone_image_well_related[OF mono] image)
+
+
+subsection \<open>Relating to Classes\<close>
+
+locale well_founded_quasi_ordering = quasi_ordering + well_founded
+begin
+
+lemma well_founded_quasi_ordering_subset:
+  assumes "X \<subseteq> A" shows "well_founded_quasi_ordering X (\<sqsubseteq>) (\<sqsubset>)"
+  by (intro well_founded_quasi_ordering.intro quasi_ordering_subset well_founded_subset assms)
+
+end
+
+class wf_qorder = ord +
+  assumes "well_founded_quasi_ordering UNIV (\<le>) (<)"
+begin
+
+interpretation well_founded_quasi_ordering UNIV
+  using wf_qorder_axioms unfolding class.wf_qorder_def by auto
+
+subclass qorder ..
+
+sublocale order: well_founded_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
+
+context wellorder begin
+
+subclass wf_qorder
+  apply (unfold_locales)
+  using less_induct by auto
+
+sublocale order: well_ordered_set 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 well_ordered_iff_well_founded_total_ordered)
+  apply (intro conjI order.total_ordered_set_axioms)
+  by (auto simp: order.well_founded_axioms atomize_eq)
+
+end
+
+thm order.nonempty_imp_ex_extreme
+
+subsection \<open>omega-Chains\<close>
+
+definition "omega_chain A r \<equiv> \<exists>f :: nat \<Rightarrow> 'a. monotone (\<le>) r f \<and> range f = A"
+
+lemma omega_chainI:
+  fixes f :: "nat \<Rightarrow> 'a"
+  assumes "monotone (\<le>) r f" "range f = A" shows "omega_chain A r"
+  using assms by (auto simp: omega_chain_def)
+
+lemma omega_chainE:
+  assumes "omega_chain A r"
+    and "\<And>f :: nat \<Rightarrow> 'a. monotone (\<le>) r f \<Longrightarrow> range f = A \<Longrightarrow> thesis"
+  shows thesis
+  using assms by (auto simp: omega_chain_def)
+
+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
+
+lemma pair_omega_chain:
+  assumes "r a a" "r b b" "r a b" shows "omega_chain {a,b} r"
+  using assms by (auto intro!: omega_chainI[of r "\<lambda>i. if i = 0 then a else b"] monotoneI)
+
+text \<open>Every omega-chain is a well-order.\<close>
+
+lemma omega_chain_imp_well_related:
+  fixes less_eq (infix "\<sqsubseteq>" 50)
+  assumes A: "omega_chain A (\<sqsubseteq>)" shows "well_related_set A (\<sqsubseteq>)"
+proof
+  interpret less_eq_dualize.
+  from A obtain f :: "nat \<Rightarrow> 'a" where mono: "monotone_on UNIV (\<le>) (\<sqsubseteq>) f" and A: "A = range f"
+    by (auto elim!: omega_chainE)
+  fix X assume XA: "X \<subseteq> A" and "X \<noteq> {}"
+  then obtain I where X: "X = f ` I" and I0: "I \<noteq> {}" by (auto simp: A subset_image_iff)
+  from order.nonempty_imp_ex_extreme[OF I0]
+  obtain i where "least I i" by auto
+  with mono 
+  show "\<exists>e. extreme X (\<sqsupseteq>) e" by (auto intro!: exI[of _ "f i"] extremeI simp: X monotoneD)
+qed
+
+lemma (in semiattractive) omega_chain_imp_pre_well_ordered:
+  assumes "omega_chain A (\<sqsubseteq>)" shows "pre_well_ordered_set A (\<sqsubseteq>)"
+  apply (intro pre_well_ordered_set.intro omega_chain_imp_well_related assms)..
+
+lemma (in antisymmetric) omega_chain_imp_well_ordered:
+  assumes "omega_chain A (\<sqsubseteq>)" shows "well_ordered_set A (\<sqsubseteq>)"
+  by (intro well_ordered_set.intro omega_chain_imp_well_related assms antisymmetric_axioms)
+
+subsubsection \<open>Relation image that preserves well-orderedness.\<close>
+
+definition "well_image f A (\<sqsubseteq>) fa fb \<equiv>
+  \<forall>a b. extreme {x\<in>A. fa = f x} (\<sqsubseteq>)\<^sup>- a \<longrightarrow> extreme {y\<in>A. fb = f y} (\<sqsubseteq>)\<^sup>- b \<longrightarrow> a \<sqsubseteq> b"
+  for less_eq (infix "\<sqsubseteq>" 50)
+
+lemmas well_imageI = well_image_def[unfolded atomize_eq, THEN iffD2, rule_format]
+lemmas well_imageD = well_image_def[unfolded atomize_eq, THEN iffD1, rule_format]
+
+lemma (in pre_well_ordered_set)
+  well_image_well_related: "pre_well_ordered_set (f`A) (well_image f A (\<sqsubseteq>))"
+proof-
+  interpret less_eq_dualize.
+  interpret im: transitive "f`A" "well_image f A (\<sqsubseteq>)"
+  proof (safe intro!: transitiveI well_imageI)
+    interpret less_eq_dualize.
+    fix x y z a c
+    assume fxfy: "well_image f A (\<sqsubseteq>) (f x) (f y)"
+      and fyfz: "well_image f A (\<sqsubseteq>) (f y) (f z)"
+      and xA: "x \<in> A" and yA: "y \<in> A" and zA: "z \<in> A"
+      and a: "extreme {a \<in> A. f x = f a} (\<sqsupseteq>) a"
+      and c: "extreme {c \<in> A. f z = f c} (\<sqsupseteq>) c"
+    have "\<exists>b. extreme {b \<in> A. f y = f b} (\<sqsupseteq>) b"
+      apply (rule nonempty_imp_ex_extreme) using yA by auto
+    then obtain b where b: "extreme {b \<in> A. f y = f b} (\<sqsupseteq>) b" by auto
+    from trans[OF well_imageD[OF fxfy a b] well_imageD[OF fyfz b c]] a b c
+    show "a \<sqsubseteq> c" by auto
+  qed
+  interpret im: well_related_set "f`A" "well_image f A (\<sqsubseteq>)"
+  proof
+    fix fX
+    assume fXfA: "fX \<subseteq> f ` A" and fX0: "fX \<noteq> {}"
+    define X where "X \<equiv> {x\<in>A. f x \<in> fX}"
+    with fXfA fX0 have XA: "X \<subseteq> A" and "X \<noteq> {}" by (auto simp: ex_in_conv[symmetric])
+    from nonempty_imp_ex_extreme[OF this] obtain e where Xe: "extreme X (\<sqsupseteq>) e" by auto
+    with XA have eA: "e \<in> A" by auto
+    from fXfA have fX: "f ` X = fX" by (auto simp: X_def intro!: equalityI)
+    show "\<exists>fe. extreme fX (well_image f A (\<sqsubseteq>))\<^sup>- fe"
+    proof (safe intro!: exI extremeI elim!: subset_imageE)
+      from Xe fX show fefX: "f e \<in> fX" by auto
+      fix fx assume fxfX: "fx \<in> fX"
+      show "well_image f A (\<sqsubseteq>) (f e) fx"
+      proof (intro well_imageI)
+        fix a b
+        assume fea: "extreme {a \<in> A. f e = f a} (\<sqsupseteq>) a"
+          and feb: "extreme {b \<in> A. fx = f b} (\<sqsupseteq>) b"
+        from fea eA have aA: "a \<in> A" and ae: "a \<sqsubseteq> e" by auto
+        from feb fxfX have bA: "b \<in> A" and bX: "b \<in> X" by (auto simp: X_def)
+        with Xe have eb: "e \<sqsubseteq> b" by auto
+        from trans[OF ae eb aA eA bA]
+        show "a \<sqsubseteq> b".
+      qed
+    qed
+  qed
+  show ?thesis by unfold_locales
+qed
+
+
+end
\ No newline at end of file
diff --git a/thys/Complete_Non_Orders/document/root.bib b/thys/Complete_Non_Orders/document/root.bib
--- a/thys/Complete_Non_Orders/document/root.bib
+++ b/thys/Complete_Non_Orders/document/root.bib
@@ -1,319 +1,426 @@
 %% This BibTeX bibliography file was created using BibDesk.
-%% http://bibdesk.sourceforge.net/
+%% https://bibdesk.sourceforge.io/
 
-%% Created for Jeremy Dubut at 2019-03-29 18:38:21 +0900 
+%% Created for Jeremy Dubut at 2023-05-15 08:45:25 +0900 
 
 
 %% Saved with string encoding Unicode (UTF-8) 
 
-@InProceedings{YamadaD2019,
-  author =  {Akihisa Yamada and J{\'e}r{\'e}my Dubut},
-  title =   {{Complete Non-Orders and Fixed Points}},
-  booktitle =   {10th International Conference on Interactive Theorem Proving (ITP 2019)},
-  pages =   {30:1--30:16},
-  series =  {Leibniz International Proceedings in Informatics (LIPIcs)},
-  ISBN =    {978-3-95977-122-1},
-  ISSN =    {1868-8969},
-  year =    {2019},
-  volume =  {141},
-  editor =  {John Harrison and John O'Leary and Andrew Tolmach},
-  publisher =   {Schloss Dagstuhl--Leibniz-Zentrum fuer Informatik},
-  address = {Dagstuhl, Germany},
-  URL =     {http://drops.dagstuhl.de/opus/volltexte/2019/11085},
-  URN =     {urn:nbn:de:0030-drops-110852},
-  doi =     {10.4230/LIPIcs.ITP.2019.30},
-  annote =  {Keywords: Order Theory, Lattice Theory, Fixed-Points, Isabelle/HOL}
-}
-@Inbook{Bergman2015,
-author="Bergman, George M.",
-title="Lattices, Closure Operators, and Galois Connections",
-bookTitle="An Invitation to General Algebra and Universal Constructions",
-year="2015",
-publisher="Springer International Publishing",
-address="Cham",
-pages="173--212",
-isbn="978-3-319-11478-1",
-doi="10.1007/978-3-319-11478-1_6",
-url="https://doi.org/10.1007/978-3-319-11478-1_6"
-}
+
+
+@inproceedings{yamada23,
+	author = {Akihisa Yamada and J\'{e}r\'{e}my Dubut},
+	booktitle = {Proceedings of the fourteenth conference on Interactive Theorem Proving (ITP'23)},
+	date-added = {2023-05-15 08:42:28 +0900},
+	date-modified = {2023-05-15 08:45:25 +0900},
+	title = {{F}ormalizing {R}esults on {D}irected {S}ets in {I}sabelle/{HOL}},
+	year = {2023}}
+
+@article{DubutY21,
+	author = {J\'{e}r\'{e}my Dubut and Akihisa Yamada},
+	date-added = {2021-01-14 11:30:49 +0900},
+	date-modified = {2023-05-15 08:41:50 +0900},
+	journal = {Logical Methods in Computer Science},
+	number = {1},
+	title = {Fixed {P}oints {T}heorems for {N}on-{T}ransitive {R}elations},
+	volume = {18},
+	year = {2021}}
+
+@inbook{granas03,
+	author = {Andrzej Granas and James Dugundji},
+	booktitle = {Fixed Point Theory},
+	doi = {10.1007/978-0-387-21593-8_2},
+	publisher = {Springer},
+	series = {Monographs in Mathematics},
+	title = {Elementary Fixed Point Theorems},
+	year = 2003,
+	bdsk-url-1 = {https://doi.org/10.1007/978-0-387-21593-8_2}}
+
+@article{kantorovitch39,
+	author = {L. Kantorovitch},
+	doi = {doi:10.1007/BF02547750},
+	journal = {Acta Math.},
+	pages = {63-97},
+	title = {The method of successive approximations for functional equations},
+	volume = {71},
+	year = {1939},
+	bdsk-url-1 = {https://doi.org/10.1007/BF02547750}}
+
+@article{jachymski00,
+	author = {Jacek Jachymski and Leslaw Gajek and Piotr Pokarowski},
+	date-added = {2020-09-11 15:07:37 +0900},
+	date-modified = {2020-09-11 15:09:39 +0900},
+	journal = {Bulletin of the Australian Mathematical Society},
+	number = {2},
+	pages = {247--261},
+	title = {The {T}arski--{K}antorovitch prinicple and the theory of iterated function systems},
+	volume = {61},
+	year = {2000}}
+
+@techreport{scott71,
+	author = {Dana Scott and Christopher Strachey},
+	date-added = {2020-09-09 15:50:30 +0900},
+	date-modified = {2020-09-09 15:53:17 +0900},
+	institution = {Oxford Programming Research Group},
+	number = {PRG-6},
+	title = {Toward a mathematical semantics for computer languages},
+	type = {Technical Monograph},
+	year = {1971}}
+
+@inproceedings{cousot77,
+	author = {Patrick Cousot and Radhia Cousot},
+	booktitle = {Proceedings of the 4th ACM Symposium on Principles of Programming Languages (POPL'77)},
+	date-added = {2020-09-09 15:42:54 +0900},
+	date-modified = {2020-09-09 15:45:38 +0900},
+	pages = {238--252},
+	publisher = {ACM Press},
+	title = {{A}bstract {I}nterpretation: {A} {U}nified {L}attice {M}odel for {S}tatic {A}nalysis of {P}rograms by {C}onstruction or {A}pproximation of {F}ixpoints},
+	year = {1977}}
+
+@inproceedings{yamada19,
+	author = {Akihisa Yamada and J\'{e}r\'{e}my Dubut},
+	booktitle = {Proceedings of the 10th International Conference on Interactive Theorem Proving (ITP 2019)},
+	date-added = {2020-08-31 14:39:28 +0900},
+	date-modified = {2020-08-31 14:58:11 +0900},
+	pages = {30:1--30:16},
+	publisher = {Leibniz-Zentrum f{\"u}r Informatik},
+	series = {Leibniz International Proceedings in Informatics},
+	title = {Complete {N}on-{O}rders and {F}ixed {P}oints},
+	volume = {141},
+	year = {2019}}
+
+@inproceedings{grall10,
+	author = {Herv\'e Grall},
+	booktitle = {Fixed Points in Computer Science 2010},
+	pages = {41-46},
+	title = {Proving fixed points},
+	year = 2010}
+
+@article{bourbaki49,
+	author = {Nicolas Bourbaki},
+	journal = {Archiv der Mathematik},
+	number = 6,
+	pages = {434--437},
+	title = {Sur le th\'eor\`eme de Zorn},
+	volume = 2,
+	year = 1949}
+
+@misc{pataraia97,
+	author = {Dito Pataraia},
+	date-added = {2020-08-19 11:52:38 +0900},
+	date-modified = {2020-08-19 11:54:15 +0900},
+	howpublished = {Presented in the 65th Peripatetic Seminar on Sheaves and Logic, in Aarhus, Denmark},
+	title = {A constructive proof of {T}arski's fixed-point theorem for dcpo's},
+	year = {1997}}
+
+@article{markowsky76,
+	author = {George Markowsky},
+	date-added = {2020-08-19 11:47:04 +0900},
+	date-modified = {2020-08-19 11:49:10 +0900},
+	journal = {Algebra Universalis},
+	pages = {53--68},
+	title = {Chain{-}complete posets and directed sets with applications},
+	volume = {6},
+	year = {1976}}
+
+@book{Bergman2015,
+	address = {Cham},
+	author = {Bergman, George M.},
+	doi = {10.1007/978-3-319-11478-1},
+	isbn = {978-3-319-11478-1},
+	publisher = {Springer International Publishing},
+	title = {An Invitation to General Algebra and Universal Constructions},
+	year = {2015},
+	bdsk-url-1 = {https://doi.org/10.1007/978-3-319-11478-1}}
 
 @book{Schmidt1993,
-author="Schmidt, Gunther
-and Str{\"o}hlein, Thomas",
-title="Relations and Graphs: Discrete Mathematics for Computer Scientists",
-year="1993",
-publisher="Springer Berlin Heidelberg",
-address="Berlin, Heidelberg",
-pages="5--27",
-}
+	address = {Berlin, Heidelberg},
+	author = {Schmidt, Gunther and Str{\"o}hlein, Thomas},
+	pages = {5--27},
+	publisher = {Springer Berlin Heidelberg},
+	title = {Relations and Graphs: Discrete Mathematics for Computer Scientists},
+	year = {1993}}
 
 @book{gierz03,
-	Author = {G. Gierz and K. H. Hofmann and K. Keimel and J. D. Lawson and M. W. Mislove and D. S. Scott},
-	Date-Added = {2019-03-29 18:36:56 +0900},
-	Date-Modified = {2019-03-29 18:38:15 +0900},
-	Publisher = {Cambridge University Press},
-	Title = {Continuous Lattices and Domains},
-	Year = {2003}}
+	author = {G. Gierz and K. H. Hofmann and K. Keimel and J. D. Lawson and M. W. Mislove and D. S. Scott},
+	date-added = {2019-03-29 18:36:56 +0900},
+	date-modified = {2019-03-29 18:38:15 +0900},
+	doi = {10.1017/CBO9780511542725},
+	publisher = {Cambridge University Press},
+	title = {Continuous Lattices and Domains},
+	year = {2003},
+	bdsk-url-1 = {https://doi.org/10.1017/CBO9780511542725}}
 
 @book{abramski94,
-	Author = {Samson Abramsky and Achim Jung},
-	Date-Added = {2019-03-29 18:27:24 +0900},
-	Date-Modified = {2019-03-29 18:30:21 +0900},
-	Number = {III},
-	Publisher = {Oxford University Press},
-	Series = {Handbook of Logic in Computer Science},
-	Title = {Domain Theory},
-	Year = {1994}}
+	author = {Samson Abramsky and Achim Jung},
+	date-added = {2019-03-29 18:27:24 +0900},
+	date-modified = {2019-03-29 18:30:21 +0900},
+	number = {III},
+	publisher = {Oxford University Press},
+	series = {Handbook of Logic in Computer Science},
+	title = {Domain Theory},
+	year = {1994}}
 
 @book{davey02,
-	Author = {B. A. Davey and H. A. Priestley},
-	Date-Added = {2019-03-29 18:24:39 +0900},
-	Date-Modified = {2019-03-29 18:25:37 +0900},
-	Publisher = {Cambridge University Press},
-	Title = {Introduction to Lattices and Order},
-	Year = {2002}}
+	author = {B. A. Davey and H. A. Priestley},
+	date-added = {2019-03-29 18:24:39 +0900},
+	date-modified = {2019-03-29 18:25:37 +0900},
+	doi = {10.1017/CBO9780511809088},
+	publisher = {Cambridge University Press},
+	title = {Introduction to Lattices and Order},
+	year = {2002},
+	bdsk-url-1 = {https://doi.org/10.1017/CBO9780511809088}}
 
 @article{mashburn83,
-	Author = {J. D. Mashburn},
-	Date-Added = {2019-03-27 22:36:00 +0900},
-	Date-Modified = {2019-03-27 22:38:19 +0900},
-	Journal = {Houston Journal of Mathematics},
-	Number = {2},
-	Pages = {231--244},
-	Title = {The least fixed point property for omega-chain continuous functions},
-	Volume = {9},
-	Year = {1983}}
+	author = {J. D. Mashburn},
+	date-added = {2019-03-27 22:36:00 +0900},
+	date-modified = {2019-03-27 22:38:19 +0900},
+	journal = {Houston Journal of Mathematics},
+	number = {2},
+	pages = {231--244},
+	title = {The least fixed point property for omega-chain continuous functions},
+	volume = {9},
+	year = {1983}}
 
 @article{tarski55,
-	Author = {Alfred Tarski},
-	Date-Added = {2019-03-27 11:16:30 +0900},
-	Date-Modified = {2019-03-27 11:17:45 +0900},
-	Journal = {Pacific Journal of Mathematics},
-	Number = {2},
-	Pages = {285--309},
-	Title = {A lattice-theoretical fixpoint theorem and its applications},
-	Volume = {5},
-	Year = {1955}}
+	author = {Alfred Tarski},
+	date-added = {2019-03-27 11:16:30 +0900},
+	date-modified = {2019-03-27 11:17:45 +0900},
+	journal = {Pacific Journal of Mathematics},
+	number = {2},
+	pages = {285--309},
+	title = {A lattice-theoretical fixpoint theorem and its applications},
+	volume = {5},
+	year = {1955}}
 
 @article{trellis,
-	Author = {Skala, H.L.},
-	Doi = {10.1007/BF02944982},
-	Issue = 1,
-	Journal = {Algebra Univ.},
-	Pages = {218--233},
-	Title = {Trellis theory},
-	Volume = 1,
-	Year = 1971,
-	Bdsk-Url-1 = {https://doi.org/10.1007/BF02944982}}
+	author = {Skala, H.L.},
+	doi = {10.1007/BF02944982},
+	issue = 1,
+	journal = {Algebra Univ.},
+	pages = {218--233},
+	publisher = {Birkh{\"a}user-Verlag},
+	title = {Trellis theory},
+	volume = 1,
+	year = 1971,
+	bdsk-url-1 = {https://doi.org/10.1007/BF02944982}}
 
 @article{SM13,
-	Author = {Stouti, Abdelkader and Maaden, Abdelhakim},
-	Doi = {10.4067/S0716-09172013000400008},
-	Journal = {Proyecciones. Revista de Matem{\'a}tica},
-	Number = {4},
-	Pages = {409-418},
-	Title = {Fixed points and common fixed points theorems in pseudo-ordered sets},
-	Volume = {32},
-	Year = {2013},
-	Bdsk-Url-1 = {https://doi.org/10.4067/S0716-09172013000400008}}
+	author = {Stouti, Abdelkader and Maaden, Abdelhakim},
+	doi = {10.4067/S0716-09172013000400008},
+	journal = {Proyecciones},
+	number = {4},
+	pages = {409-418},
+	publisher = {Universidad Cat{\'o}lica del Norte, Departamento de Matem{\'a}ticas},
+	title = {Fixed points and common fixed points theorems in pseudo-ordered sets},
+	volume = {32},
+	year = {2013},
+	bdsk-url-1 = {https://doi.org/10.4067/S0716-09172013000400008}}
 
 @article{LN83,
-	Author = {Leutola, K and Nieminen, J},
-	Journal = {Algebra Universalis},
-	Number = {1},
-	Pages = {344--354},
-	Publisher = {Springer},
-	Title = {Posets and generalized lattices},
-	Volume = {16},
-	Year = {1983}}
+	author = {Leutola, K. and Nieminen, J.},
+	journal = {Algebra Universalis},
+	number = {1},
+	pages = {344--354},
+	publisher = {Springer},
+	title = {Posets and generalized lattices},
+	volume = {16},
+	year = {1983}}
 
 @article{Bhatta05,
-	Author = {Bhatta, S Parameshwara},
-	Journal = {Czechoslovak Mathematical Journal},
-	Number = {2},
-	Pages = {365--369},
-	Publisher = {Springer},
-	Title = {Weak chain-completeness and fixed point property for pseudo-ordered sets},
-	Volume = {55},
-	Year = {2005}}
+	author = {Bhatta, S. Parameshwara},
+	journal = {Czechoslovak Mathematical Journal},
+	number = {2},
+	pages = {365--369},
+	publisher = {Springer},
+	title = {Weak chain-completeness and fixed point property for pseudo-ordered sets},
+	volume = {55},
+	year = {2005}}
 
-@article{PG11,
-	Author = {Parameshwara Bhatta, S and George, Shiju},
-	Journal = {Algebra and Discrete Mathematics},
-	Number = {1},
-	Pages = {17--22},
-	Publisher = {Луганский национальный университет им. Т. Шевченко},
-	Title = {Some fixed point theorems for pseudo ordered sets},
-	Volume = {11},
-	Year = {2011}}
+@article{BG11,
+	author = {Bhatta, S. Parameshwara and George, Shiju},
+	date-modified = {2020-09-09 14:15:07 +0900},
+	journal = {Algebra and Discrete Mathematics},
+	number = {1},
+	pages = {17--22},
+	publisher = {Луганский национальный университет им. Т. Шевченко},
+	title = {Some fixed point theorems for pseudo ordered sets},
+	volume = {11},
+	year = {2011}}
 
 @article{flyspeck,
-	Author = {Hales, Thomas and Adams, Mark and Bauer, Gertrud and Dang, Tat Dat and Harrison, John and Le Truong, Hoang and Kaliszyk, Cezary and Magron, Victor and McLaughlin, Sean and Nguyen, Tat Thang and others},
-	Journal = {Forum of Mathematics, Pi},
-	Publisher = {Cambridge University Press},
-	Title = {A formal proof of the {K}epler conjecture},
-	Volume = {5},
-	Year = {2017}}
+	author = {Hales, Thomas and Adams, Mark and Bauer, Gertrud and Dang, Tat Dat and Harrison, John and Le Truong, Hoang and Kaliszyk, Cezary and Magron, Victor and McLaughlin, Sean and Nguyen, Tat Thang and others},
+	doi = {10.1017/fmp.2017.1},
+	journal = {Forum of Mathematics, Pi},
+	pages = {e2},
+	publisher = {Cambridge University Press},
+	title = {A formal proof of the {K}epler conjecture},
+	volume = {5},
+	year = {2017},
+	bdsk-url-1 = {https://doi.org/10.1017/fmp.2017.1}}
 
 @article{4color,
-	Author = {Gonthier, Georges},
-	Journal = {Notices of the AMS},
-	Number = {11},
-	Pages = {1382--1393},
-	Title = {Formal proof -- the four-color theorem},
-	Volume = {55},
-	Year = {2008}}
+	author = {Gonthier, Georges},
+	journal = {Notices of the AMS},
+	number = {11},
+	pages = {1382--1393},
+	title = {Formal proof -- the four-color theorem},
+	volume = {55},
+	year = {2008}}
 
 @inproceedings{sel4,
-	Author = {Klein, Gerwin and Elphinstone, Kevin and Heiser, Gernot and Andronick, June and Cock, David and Derrin, Philip and Elkaduwe, Dhammika and Engelhardt, Kai and Kolanski, Rafal and Norrish, Michael and others},
-	Booktitle = {Proceedings of the ACM SIGOPS 22nd Symposium on Operating Systems principles},
-	Organization = {ACM},
-	Pages = {207--220},
-	Title = {se{L}4: Formal verification of an {OS} kernel},
-	Year = {2009}}
+	author = {Klein, Gerwin and Elphinstone, Kevin and Heiser, Gernot and Andronick, June and Cock, David and Derrin, Philip and Elkaduwe, Dhammika and Engelhardt, Kai and Kolanski, Rafal and Norrish, Michael and Sewell, Thomas and Tuch, Harvey and Wiwood, Simon},
+	booktitle = {Proceedings of the ACM SIGOPS 22nd Symposium on Operating Systems Principles (SOSP 2009)},
+	doi = {10.1145/1629575.1629596},
+	organization = {ACM},
+	pages = {207--220},
+	title = {se{L}4: Formal verification of an {OS} kernel},
+	year = {2009},
+	bdsk-url-1 = {https://doi.org/10.1145/1629575.1629596}}
 
 @inproceedings{isabelle/jedit,
-	Author = {Wenzel, Makarius},
-	Booktitle = {International Conference on Intelligent Computer Mathematics},
-	Organization = {Springer},
-	Pages = {468--471},
-	Title = {{I}sabelle/j{E}dit--a Prover {IDE} within the {PIDE} framework},
-	Year = {2012}}
+	author = {Wenzel, Makarius},
+	booktitle = {Proceedings of the 5th Conferences on Intelligent Computer Mathematics (CICM 2012)},
+	doi = {10.1007/978-3-642-31374-5_38},
+	pages = {468--471},
+	publisher = {Springer Berlin Heidelberg},
+	series = {LNCS},
+	title = {{I}sabelle/j{E}dit -- a Prover {IDE} within the {PIDE} framework},
+	volume = 7362,
+	year = {2012},
+	bdsk-url-1 = {https://doi.org/10.1007/978-3-642-31374-5_38}}
 
 @inproceedings{quickcheck,
-	Acmid = {1030056},
-	Address = {Washington, DC, USA},
-	Author = {Berghofer, Stefan and Nipkow, Tobias},
-	Booktitle = {Proceedings of the Software Engineering and Formal Methods, Second International Conference},
-	Doi = {10.1109/SEFM.2004.36},
-	OPIsbn = {0-7695-2222-X},
-	Numpages = {10},
-	Pages = {230--239},
-	Publisher = {IEEE Computer Society},
-	Series = {SEFM '04},
-	Title = {Random Testing in {I}sabelle/{HOL}},
-	Year = {2004},
-	Bdsk-Url-1 = {http://dx.doi.org/10.1109/SEFM.2004.36}}
+	acmid = {1030056},
+	author = {Berghofer, Stefan and Nipkow, Tobias},
+	booktitle = {Proceedings of the 2nd International Conference on Software Engineering and Formal Methods (SEFM 2004)},
+	doi = {10.1109/SEFM.2004.36},
+	numpages = {10},
+	opaddress = {Washington, DC, USA},
+	opisbn = {0-7695-2222-X},
+	pages = {230--239},
+	publisher = {IEEE Computer Society},
+	title = {Random Testing in {I}sabelle/{HOL}},
+	year = {2004},
+	bdsk-url-1 = {https://doi.org/10.1109/SEFM.2004.36}}
 
 @inproceedings{nitpick,
-	Address = {Berlin, Heidelberg},
-	Author = {Blanchette, Jasmin Christian and Nipkow, Tobias},
-	Booktitle = {Interactive Theorem Proving},
-	Editor = {Kaufmann, Matt and Paulson, Lawrence C.},
-	OPIsbn = {978-3-642-14052-5},
-	Pages = {131--146},
-	Publisher = {Springer Berlin Heidelberg},
-	Title = {Nitpick: A Counterexample Generator for Higher-Order Logic Based on a Relational Model Finder},
-	Year = {2010}}
+	author = {Blanchette, Jasmin Christian and Nipkow, Tobias},
+	booktitle = {Proceedings of the 1st International Conference on Interactive Theorem Proving (ITP 2010)},
+	doi = {10.1007/978-3-642-14052-5_11},
+	editor = {Kaufmann, Matt and Paulson, Lawrence C.},
+	opaddress = {Berlin, Heidelberg},
+	pages = {131--146},
+	publisher = {Springer Berlin Heidelberg},
+	series = {LNCS},
+	title = {Nitpick: A Counterexample Generator for Higher-Order Logic Based on a Relational Model Finder},
+	volume = 6172,
+	year = {2010},
+	bdsk-url-1 = {https://doi.org/10.1007/978-3-642-14052-5_11}}
 
 @inproceedings{codegen,
-	Author = {Haftmann, Florian and Nipkow, Tobias},
-	Booktitle = {Theorem Proving in Higher Order Logics (TPHOLs 2007)},
-	Pages = {128--143},
-	Series = {Lecture Notes in Computer Science},
-	Title = {A code generator framework for {I}sabelle/{HOL}},
-	Volume = {4732},
-	Year = {2007}}
+	author = {Haftmann, Florian and Nipkow, Tobias},
+	booktitle = {Theorem Proving in Higher Order Logics: Emerging Trends},
+	editor = {Klaus Schneider and Jens Brandt},
+	opnumber = {364/07},
+	pages = {128--143},
+	publisher = {Department of Computer Science, University of Kaiserslautern},
+	title = {A code generator framework for {I}sabelle/{HOL}},
+	year = {2007}}
 
 @inproceedings{locale,
-	Address = {Berlin, Heidelberg},
-	Author = {Ballarin, Clemens},
-	Booktitle = {Mathematical Knowledge Management},
-	Doi = {10.1007/11812289_4},
-	Editor = {Borwein, Jonathan M. and Farmer, William M.},
-	OPIsbn = {978-3-540-37106-9},
-	Pages = {31--43},
-	Publisher = {Springer Berlin Heidelberg},
-	Title = {Interpretation of Locales in {I}sabelle: Theories and Proof Contexts},
-	Year = {2006},
-	Bdsk-Url-1 = {https://doi.org/10.1007/11812289_4}}
+	author = {Ballarin, Clemens},
+	booktitle = {Proceedings of the 5th International Conference on Mathematical Knowledge Management (MKM 2006)},
+	doi = {10.1007/11812289_4},
+	editor = {Borwein, Jonathan M. and Farmer, William M.},
+	opaddress = {Berlin, Heidelberg},
+	opisbn = {978-3-540-37106-9},
+	pages = {31--43},
+	publisher = {Springer Berlin Heidelberg},
+	series = {LNCS},
+	title = {Interpretation of Locales in {I}sabelle: Theories and Proof Contexts},
+	volume = 4108,
+	year = {2006},
+	bdsk-url-1 = {https://doi.org/10.1007/11812289_4}}
 
 @inproceedings{Kammuller00,
-	Address = {Berlin, Heidelberg},
-	Author = {Kamm{\"u}ller, Florian},
-	Booktitle = {Automated Deduction - CADE-17},
-	Doi = {10.1007/10721959_7},
-	Editor = {McAllester, David},
-	OPIsbn = {978-3-540-45101-3},
-	Pages = {99--114},
-	Publisher = {Springer Berlin Heidelberg},
-	Title = {Modular Reasoning in {I}sabelle},
-	Year = {2000},
-	Bdsk-Url-1 = {https://doi.org/10.1007/10721959_7}}
+	author = {Kamm{\"u}ller, Florian},
+	booktitle = {Proceedings of the 17th International Conference on Automated Deduction (CADE-17)},
+	doi = {10.1007/10721959_7},
+	editor = {McAllester, David},
+	opaddress = {Berlin, Heidelberg},
+	pages = {99--114},
+	publisher = {Springer Berlin Heidelberg},
+	series = {LNCS},
+	title = {Modular Reasoning in {I}sabelle},
+	volume = 1831,
+	year = {2000},
+	bdsk-url-1 = {https://doi.org/10.1007/10721959_7}}
+
 @inproceedings{isafor,
-  title={Certification of termination proofs using {CeTA}},
-  author={Thiemann, Ren{\'e} and Sternagel, Christian},
-  booktitle={International Conference on Theorem Proving in Higher Order Logics},
-  pages={452--468},
-  year={2009},
-  organization={Springer}
-}
+	author = {Thiemann, Ren{\'e} and Sternagel, Christian},
+	booktitle = {International Conference on Theorem Proving in Higher Order Logics},
+	organization = {Springer},
+	pages = {452--468},
+	title = {Certification of termination proofs using {CeTA}},
+	year = {2009}}
+
 @book{Isabelle,
-	Author = {T.~Nipkow and L.C.~Paulson and M.~Wenzel},
-	Publisher = {Springer},
-	Series = {LNCS},
-	Title = {{Isabelle/HOL} -- A Proof Assistant for Higher-Order Logic},
-	Volume = 2283,
-	Year = 2002
-}
+	author = {T.~Nipkow and L.C.~Paulson and M.~Wenzel},
+	doi = {10.1007/3-540-45949-9},
+	publisher = {Springer},
+	series = {LNCS},
+	title = {{Isabelle/HOL} -- A Proof Assistant for Higher-Order Logic},
+	volume = 2283,
+	year = 2002,
+	bdsk-url-1 = {https://doi.org/10.1007/3-540-45949-9}}
+
 @inproceedings{hol4,
-  title={A brief overview of {HOL4}},
-  author={Slind, Konrad and Norrish, Michael},
-  booktitle={International Conference on Theorem Proving in Higher Order Logics},
-  pages={28--32},
-  year={2008},
-  organization={Springer}
-}
+	author = {Slind, Konrad and Norrish, Michael},
+	booktitle = {International Conference on Theorem Proving in Higher Order Logics},
+	organization = {Springer},
+	pages = {28--32},
+	title = {A brief overview of {HOL4}},
+	year = {2008}}
+
 @inproceedings{hol-light,
-  title={{HOL} light: An overview},
-  author={Harrison, John},
-  booktitle={International Conference on Theorem Proving in Higher Order Logics},
-  pages={60--66},
-  year={2009},
-  organization={Springer}
-}
+	author = {Harrison, John},
+	booktitle = {International Conference on Theorem Proving in Higher Order Logics},
+	organization = {Springer},
+	pages = {60--66},
+	title = {{HOL} light: An overview},
+	year = {2009}}
+
 @inproceedings{agda,
-  title={A brief overview of {A}gda -- a functional language with dependent types},
-  author={Bove, Ana and Dybjer, Peter and Norell, Ulf},
-  booktitle={International Conference on Theorem Proving in Higher Order Logics},
-  pages={73--78},
-  year={2009},
-  organization={Springer}
-}
+	author = {Bove, Ana and Dybjer, Peter and Norell, Ulf},
+	booktitle = {International Conference on Theorem Proving in Higher Order Logics},
+	organization = {Springer},
+	pages = {73--78},
+	title = {A brief overview of {A}gda -- a functional language with dependent types},
+	year = {2009}}
+
 @book{coq,
-  title={Certified programming with dependent types: a pragmatic introduction to the Coq proof assistant},
-  author={Chlipala, Adam},
-  year={2013},
-  publisher={MIT Press}
-}
+	author = {Chlipala, Adam},
+	publisher = {MIT Press},
+	title = {Certified programming with dependent types: a pragmatic introduction to the {C}oq proof assistant},
+	year = {2013}}
+
 @inproceedings{compcert,
-  title={Formal {C} semantics: {C}omp{C}ert and the {C} standard},
-  author={Krebbers, Robbert and Leroy, Xavier and Wiedijk, Freek},
-  booktitle={International Conference on Interactive Theorem Proving},
-  pages={543--548},
-  year={2014},
-  organization={Springer}
-}
+	author = {Krebbers, Robbert and Leroy, Xavier and Wiedijk, Freek},
+	booktitle = {International Conference on Interactive Theorem Proving},
+	organization = {Springer},
+	pages = {543--548},
+	title = {Formal {C} semantics: {C}omp{C}ert and the {C} standard},
+	year = {2014}}
+
 @inproceedings{sledgehammer,
-  title={Sledgehammer: judgement day},
-  author={B{\"o}hme, Sascha and Nipkow, Tobias},
-  booktitle={International Joint Conference on Automated Reasoning},
-  pages={107--121},
-  year={2010},
-  organization={Springer}
-}
-
-@inproceedings{grall10,
-  author    = {Herv{\'{e}} Grall},
-  editor    = {Luigi Santocanale},
-  title     = {Proving Fixed Points},
-  booktitle = {7th Workshop on Fixed Points in Computer Science, {FICS} 2010, Brno,
-               Czech Republic, August 21-22, 2010},
-  pages     = {41--46},
-  publisher = {Laboratoire d'Informatique Fondamentale de Marseille},
-  year      = {2010},
-  url       = {https://hal.archives-ouvertes.fr/hal-00512377/document\#page=42},
-  timestamp = {Tue, 21 Jul 2020 00:40:32 +0200},
-  biburl    = {https://dblp.org/rec/conf/fics/Grall10.bib},
-  bibsource = {dblp computer science bibliography, https://dblp.org}
-}
+	author = {B{\"o}hme, Sascha and Nipkow, Tobias},
+	booktitle = {Proceedings of the 5th International Joint Conference on Automated Reasoning (IJCAR 2010)},
+	doi = {10.1007/978-3-642-14203-1_9},
+	pages = {107--121},
+	publisher = {Springer Berlin Heidelberg},
+	series = {LNCS},
+	title = {Sledgehammer: Judgement Day},
+	volume = 6173,
+	year = {2010},
+	bdsk-url-1 = {https://doi.org/10.1007/978-3-642-14203-1_9}}
diff --git a/thys/Complete_Non_Orders/document/root.tex b/thys/Complete_Non_Orders/document/root.tex
--- a/thys/Complete_Non_Orders/document/root.tex
+++ b/thys/Complete_Non_Orders/document/root.tex
@@ -1,196 +1,210 @@
 \documentclass[11pt,a4paper]{article}
-\usepackage[T1]{fontenc}
 \usepackage{isabelle,isabellesym}
 \usepackage{amssymb,amsmath,stmaryrd}
 \usepackage{tikz}
 \usetikzlibrary{backgrounds}
 \usetikzlibrary{positioning}
 \usetikzlibrary{shapes}
 
 % this should be the last package used
 \usepackage{pdfsetup}
 
 % urls in roman style, theory text in math-similar italics
 \urlstyle{rm}
 \isabellestyle{it}
 
 \newcommand\SLE{\sqsubseteq}
 \newcommand\Nat{\mathbb{N}}
+\newcommand\SLT{\sqsubset}
+\newcommand\SUP{\bigsqcup}
 
 
 \makeatletter
 
 \def\tp@#1#2{\@ifnextchar[{\tp@@{#1}{#2}}{\tp@@@{#1}{#2}}}
 \def\tp@@#1#2[#3]#4{#3#1\def\mid{\mathrel{#3|}}#4#3#2}
 \def\tp@@@#1#2#3{\bgroup\left#1\def\mid{\;\middle|\;}#3\right#2\egroup}
 \def\pa{\tp@()}
 \def\tp{\tp@\langle\rangle}
 \def\set{\tp@\{\}}
 
 \makeatother
 
 
 \begin{document}
 
 \title{Complete Non-Orders and Fixed Points}
-\author{Akihisa Yamada and Jérémy Dubut}
+\author{Akihisa Yamada and J\'er\'emy Dubut}
 \maketitle
 
 \begin{abstract}
-  We develop an Isabelle/HOL library of order-theoretic concepts, such as various completeness conditions and
-   fixed-point theorems. We keep our formalization as general as possible: we reprove several well-known results 
-   about complete orders, often without any properties of ordering, thus complete non-orders. In particular, we 
-   generalize the Knaster--Tarski theorem so that we ensure the existence of a quasi-fixed point of monotone maps 
-   over complete non-orders, and show that the set of quasi-fixed points is complete under a mild condition---%
-   attractivity---which is implied by either antisymmetry or transitivity. This result generalizes and strengthens a result
-    by Stauti and Maaden. Finally, we recover Kleene's fixed-point theorem for omega-complete non-orders, again 
-    using attractivity to prove that Kleene's fixed points are least quasi-fixed points.
+We develop an Isabelle/HOL library
+of order-theoretic concepts, such as various completeness conditions and
+fixed-point theorems.
+We keep our formalization as general as possible:
+we reprove several well-known results about complete orders,
+often with only antisymmetry or attractivity, a mild condition implied by either 
+antisymmetry or transitivity.
+In particular, we generalize various theorems ensuring
+the existence of a quasi-fixed point of monotone maps over complete relations,
+and show that the set of (quasi-)fixed points is itself complete.
+This result generalizes and strengthens theorems of Knaster--Tarski, Bourbaki--Witt, Kleene, Markowsky, Pataraia, Mashburn, Bhatta--George, and Stouti--Maaden.
 \end{abstract}
 
 \tableofcontents
 
 \section{Introduction}
 
 The main driving force towards mechanizing mathematics using proof assistants
+% For a journal version:
+%such as Coq~\cite{coq}, Agda~\cite{agda}, HOL-Light~\cite{hol-light}, and Isabelle/HOL~\cite{isabelle},
 has been the reliability they offer,
+%Once a theorem is formally proved using a proof assistant,
+%we can certainly trust the theorem without understanding how it is proved,
+%provided the claim itself is correctly formalized.
+%The most prominent of such examples are
+%the four-color theorem proved using Coq~\cite{4color}, and
+%the Kepler theorem proved with HOL-Light and Isabelle/HOL~\cite{flyspeck}.
+%Moreover the reliability of proof assistants is utilized for
+%developing bug-free software, for instance,
+%the CompCert C compliler~\cite{compcert},
+%the seL4 OS kernel~\cite{sel4},
+%the IsaFoR/CeTA certifier for validating program analyzers~\cite{isafor},
+%...
+%
 exemplified prominently by~\cite{4color},~\cite{flyspeck},~\cite{sel4}, etc.
-In this work, we utilize another aspect of Isabelle/JEdit~\cite{isabelle/jedit}
-as engineering tools for developing mathematical theories.
-We formalize order-theoretic concepts and results,
-adhering to an \emph{as-general-as-possible} approach:
-most results concerning order-theoretic completeness and fixed-point theorems
-are proved without assuming the underlying relations to be orders (non-orders).
+In this work, we utilize another aspect of proof assistants:
+they are also engineering tools for developing mathematical theories.
+
+\emph{Fixed-point theorems} are important in computer science, such as 
+in denotational semantics \cite{scott71} and
+in abstract interpretation \cite{cousot77}, as they allow the definition 
+of semantics of loops and recursive functions.
+The Knaster--Tarski theorem~\cite{tarski55}
+shows that
+any monotone map $f : A \to A$ over complete lattice $(A,\SLE)$ has a fixed point,
+and the set of fixed points forms also a complete lattice.
+The result was generalized in various ways:
+Markowsky~\cite{markowsky76}
+showed a corresponding result for \emph{chain-complete} posets.
+The proof uses
+the Bourbaki--Witt theorem~\cite{bourbaki49},
+stating that any inflationary map over a chain-complete poset has a fixed point.
+The original proof of the latter is non-elementary in
+the sense that it relies on ordinals and Hartogs' theorem.
+Pataraia~\cite{pataraia97}
+gave an elementary proof that
+monotone maps over \emph{pointed directed-complete} poset
+has a fixed point.
+Fixed points are studied also for \emph{pseudo-orders}~\cite{trellis},
+relaxing transitivity.
+Stouti and Maaden~\cite{SM13} showed that every monotone map over a complete pseudo-order has a (least) fixed point.
+Markowsky's result was also generalized to
+\emph{weak} chain-complete pseudo-orders by Bhatta and George~\cite{Bhatta05,BG11}.
+
+Another line of order-theoretic fixed points is the \emph{iterative} approach.
+Kantorovitch showed that
+for \emph{$\omega$-continuous} map $f$
+over a complete lattice,\footnote{
+More precisely,
+he assumes a conditionally complete lattice defined over vectors and that
+$\bot \SLE f\:\bot$ and $f\:v' \SLE v'$.
+Hence $f$, which is monotone,
+is a map over the complete lattice $\{v \mid \bot \SLE v \SLE v'\}$.
+}
+the
+iteration $\bot, f\:\bot,f^2\:\bot,\dots$ converges to a fixed point
+\cite[Theorem I]{kantorovitch39}.
+Tarski~\cite{tarski55} also claimed a similar result for a
+\emph{countably distributive} map over a
+\emph{countably complete Boolean algebra}.
+Kleene's fixed-point theorem states that,
+for \emph{Scott-continuous} maps over pointed directed-complete posets,
+the iteration converges to the least fixed point.
+Finally, Mashburn~\cite{mashburn83} proved a version for 
+$\omega$-continuous maps over $\omega$-complete posets,
+which covers Kantorovitch's, Tarski's and Kleene's claims.
+
+
+
+%In this paper,
+%we formalize these fixed-point theorems in Isabelle/HOL.
+%Here we adopt an \emph{as-general-as-possible} approach:
+%all theorems
+%are proved without assuming the underlying relations to be orders.
+%One can easily find several formalizations of complete partial orders or lattices in Isabelle's standard library.
+%They are, however, defined on partial orders
+%and thus not directly reusable for general relations.
+
 In particular, we provide the following:
 \begin{itemize}
-\item
-A locale-based library for binary relations,
-as partly depicted in Figure~\ref{fig:non-orders}.
-\item
-Various completeness results that generalize known theorems in order theory:
-Actually most relationships and duality of completeness conditions are proved without
-\emph{any} properties of the underlying relations.
+\item Several \emph{locales} that help organizing the different order-theoretic conditions, 
+such as reflexivity, transitivity, antisymmetry, and their combination, as well as concepts such as connex and well-related sets, analogues of chains 
+and well-ordered sets in a non-ordered context.
+%(\prettyref{sec:prelim}).
 \item Existence of fixed points:
-We show that a relation-preserving mapping $f : A \to A$
-over a complete non-order $\tp{A,\SLE}$
-admits a \emph{quasi-fixed point} $f(x) \sim x$,
-meaning $x \SLE f(x) \wedge f(x) \SLE x$.
-Clearly if $\SLE$ is antisymmetric then this implies the existence of fixed points $f(x) = x$.
+We provide two proof schemes to prove that monotone or inflationary mapping 
+$f : A \to A$ over a complete related set $\tp{A,\SLE}$
+has a \emph{quasi-fixed point} $f\:x \sim x$,
+meaning $x \SLE f\:x \mathrel\land f\:x \SLE x$, for various notions of completeness.
+The first one,
+%(\prettyref{sec:knaster-tarski})
+similar to the original proof by Tarski \cite{tarski55}, 
+does not require any ordering assumptions,
+but relies on completeness with respect to all subsets.
+The second one,
+%(\prettyref{sec:weak_chain}),
+inspired by a \emph{constructive} approach by Grall \cite{grall10},
+is a proof scheme based on the notion of derivations.
+Here we demand antisymmetry (to avoid the necessity of the axiom of choice),
+but can be instantiated to \emph{well-complete} sets,
+a generalization of weak chain-completeness.
+This also allows us to generalize Bourbaki--Witt theorem \cite{bourbaki49} to pseudo-orders.
 \item Completeness of the set of fixed points:
-We further show that
-if $\SLE$ satisfies a mild condition, which we call \emph{attractivity} and
+%(\prettyref{sec:completeness}): We further show that
+if $(A,\SLE)$ satisfies a mild condition, which we call \emph{attractivity} and
 which is implied by either transitivity or antisymmetry,
-then the set of quasi-fixed points is complete.
-Furthermore, we also show that if $\SLE$ is antisymmetric,
-then the set of \emph{strict} fixed points $f(x) = x$ is complete.
-\item Kleene-style fixed-point theorems:
-For an $\omega$-complete non-order $\tp{A,\SLE}$ with a bottom element $\bot \in A$ (not necessarily unique)
-and for every $\omega$-continuous map $f : A \to A$,
-a supremum exists for the set $\set{ f^n(\bot) \mid n \in \Nat}$,
-and it is a quasi-fixed point.
-If $\SLE$ is attractive, then
-the quasi-fixed points obtained this way are precisely the least quasi-fixed points.
+then the set of quasi-fixed points inherits the completeness class from
+$(A,\SLE)$, if it is at least well-complete.
+The result instantiates to
+the full completeness (generalizing Knaster--Tarski and \cite{SM13}), 
+directed-completeness \cite{pataraia97},
+chain-completeness \cite{markowsky76}, 
+and weak chain-completeness \cite{BG11}.
+\item Iterative construction:
+% (\prettyref{sec:kleene}):
+For an $\omega$-continuous map over an $\omega$-complete related set,
+we show that suprema of $\set{f^n\:\bot \mid n\in\Nat}$ are quasi-fixed points.
+Under attractivity, the quasi-fixed points obtained from this scheme 
+are precisely the least quasi-fixed points of $f$.
+This generalizes Mashburn's result, and thus ones by
+Kantorovitch, Tarski and Kleene.
 \end{itemize}
 We remark that all these results would have required much more effort than we spent
 (if possible at all),
-if we were not with the smart assistance by Isabelle.
-Our workflow was often the following: first we formalize existing proofs, try relaxing assumptions, see where proof breaks,
-and at some point ask for a counterexample.
+if we were not with the aforementioned smart assistance by Isabelle.
+Our workflow was often the following: first we formalize existing proofs, try relaxing assumptions, 
+see where proof breaks, and at some point ask for a counterexample.
 
-\begin{figure}
-\small
-\centering
-\def\isa#1{\textsf{#1}}
-\def\t{-1.8}
-\def\a{3.6}
-\def\at{1.8}
-\def\s{-3.6}
-\def\st{-5.4}
-\begin{tikzpicture}
-\tikzstyle{every node}=[draw,ellipse]
-\tikzstyle{every edge}=[draw]
-\draw
- (0,0) node[fill] (rel) {}
- (\t,1) node (trans) {\isa{transitive}}
- (0,-2) node (refl) {\isa{reflexive}}
- (0,2) node (irr) {\isa{irreflexive}}
- (\s,0) node (sym) {\isa{symmetric}}
- (\a,0) node (anti) {\isa{antisymmetric}}
- (\at,1) node (near) {\isa{near\_order}}
- (\a,2) node (asym) {\isa{asymmetric}}
- (\a,-2) node (pso) {\isa{pseudo\_order}}
- (\at,-1) node (po) {\isa{partial\_order}}
- (\t,-1) node (qo) {\isa{quasi\_order}}
- (0,3) node (str) {\hspace{3em}\isa{strict\_order}\mbox{\hspace{3em}}}
- (\st,-1) node (equiv) {\isa{equivalence}}
- (\st,1) node (peq) {\hspace{-.8em}\isa{partial\_equivalence}\mbox{\hspace{-.8em}}}
- (\st,3) node (emp) {$\emptyset$}
- (\s,-2) node (tol) {\isa{tolerance}}
- (\s,2) node (ntol) {$\neg$\isa{tolerance}}
- ;
-\draw[->]
- (near) edge[color=blue] ([xshift=51,yshift=-7]str)
- (irr) edge[color=red] ([xshift=-46,yshift=-8]str)
- (trans) edge[color=blue] ([xshift=-51,yshift=-7]str)
- (asym) edge[color=red] ([xshift=55,yshift=-7]str)
- (trans) edge[color=green] (near)
- (anti) edge[color=red] (near)
- (irr) edge[color=green] (asym)
- (anti) edge[color=blue] (asym)
- (anti) edge[color=blue] (pso)
- (near) edge[color=blue] (po)
- (pso) edge[color=red] (po)
- (refl) edge[color=green] (pso)
- (trans) edge[color=blue] (qo)
- (refl) edge[color=red] (qo)
- (qo) edge[color=green] (po)
- (qo) edge[color=green] (equiv)
- (peq) edge[color=blue] (equiv)
- (trans) edge[color=green] (peq)
- (peq) edge[color=blue] (emp)
- (str) edge[color=green] (emp)
- (sym) edge[color=red] (peq)
- (sym) edge[color=blue] (tol)
- (sym) edge[color=blue] (ntol)
- (irr) edge[color=green] (ntol)
- (refl) edge[color=green] (tol)
- (ntol) edge[color=red] (emp)
- (tol) edge[color=red] (equiv)
- (rel) edge[color=red, line width=1.5pt] (trans)
- (rel) edge[color=blue, line width=1.5pt] (irr)
- (rel) edge[color=blue, line width=1.5pt] (refl)
- (rel) edge[color=green, line width=1.5pt] (sym)
- (rel) edge[color=green, line width=1.5pt] (anti)
- ;
-\end{tikzpicture}
-\caption{\label{fig:non-orders}
-Combinations of basic properties.
-The black dot around the center represents arbitrary binary relations,
-and the five outgoing arrows indicate atomic assumptions.
-We do not present the combination
-of \isa{reflexive} and \isa{irreflexive}, which is empty,
-and one of \isa{symmetric} and \isa{antisymmetric},
-which is a subset of equality.
-Node ``$\neg$\isa{tolerance}'' indicates the negated relation is \isa{tolerance},
-and ``$\emptyset$'' is the empty relation.
-}
-\end{figure}
+Concerning Isabelle formalization, one can easily find several formalizations 
+of complete partial orders or lattices in Isabelle?s standard library. They are, 
+however, defined on partial orders, either in form of classes or locales, and 
+thus not directly reusable for non-orders. Nevertheless we tried to make our 
+formalization compatible with the existing ones, and various
+correspondences are ensured.
 
-\paragraph*{Related Work}
-Many attempts have been made to generalize the notion of completeness for lattices, conducted in different directions: by relaxing the notion of order itself, removing transitivity (pseudo-orders \cite{trellis}); by relaxing the notion of lattice, considering minimal upper bounds instead of least upper bounds ($\chi$-posets \cite{LN83}); by relaxing the notion of completeness, requiring the existence of least upper bounds for restricted classes of subsets (e.g., directed complete and $\omega$-complete, see \cite{davey02} for a textbook). Considering those generalizations, it was natural to prove new versions of classical fixed-point theorems for maps preserving those structures, e.g., existence of least fixed points for monotone maps on (weak chain) complete pseudo-orders \cite{Bhatta05, SM13}, construction of least fixed points for $\omega$-continuous functions for $\omega$-complete lattices \cite{mashburn83}, (weak chain) completeness of the set of fixed points for monotone functions on (weak chain) complete pseudo-orders \cite{PG11}.
-
-Concerning Isabelle formalization,
-one can easily find several formalizations of complete partial orders or lattices in Isabelle's standard library.
-They are, however, defined on partial orders, either in form of classes or locales,
-and thus not directly reusable for non-orders.
-Nevertheless we tried to make our formalization compatible with the existing ones,
-and various correspondences are ensured.
-
-This work has been published in the conference paper \cite{YamadaD2019}.
+This archive is the third version of this work.
+The first version has been published in
+the conference paper \cite{yamada19}.
+The second version has been published in the 
+journal paper \cite{DubutY21}.
+The third version is a restructuration of the second version
+for future formalizations, including \cite{yamada23}.
 
 % include generated text of all theories
 \input{session}
 
 \bibliographystyle{abbrv}
 \bibliography{root}
 
 \end{document}