diff --git a/.github/workflows/main.yml b/.github/workflows/main.yml
index 36cb3bb33..9a7e3f467 100644
--- a/.github/workflows/main.yml
+++ b/.github/workflows/main.yml
@@ -13,7 +13,22 @@ jobs:
     if: github.event.pull_request.draft == false
     steps:
     - name: "Clone repository"
-      uses: actions/checkout@v2
+      uses: actions/checkout@v4
+
+    - name: "Print environment information"
+      shell: bash
+      run: |
+        echo "github.ref_name = ${{ github.ref_name }}"
+        echo "github.sha = ${{ github.sha }}"
+        echo "github.event.before = ${{ github.event.before }}"
+
+    - name: "Restore cached .agdai files"
+      id: cache-agdai-restore
+      uses: actions/cache/restore@v4
+      with:
+        path: _build
+        key: ${{ runner.os }}-agdai-cache-${{ github.ref_name }}-${{ github.event.before }}
+
     - name: Run Agda
       id: typecheck
       uses: ayberkt/agda-github-action@v3.4
@@ -21,6 +36,14 @@ jobs:
         main-file: AllModulesIndex.lagda
         source-dir: source
         unsafe: true
+
+    - name: "Save .agdai files"
+      id: cache-agdai-save
+      uses: actions/cache/save@v4
+      with:
+        path: _build
+        key: ${{ runner.os }}-agdai-cache-${{ github.ref_name }}-${{ github.sha }}
+
     - name: Upload HTML
       id: html-upload
       if: github.ref == 'refs/heads/master'
diff --git a/imports.sh b/imports.sh
new file mode 100755
index 000000000..f3ef03fe3
--- /dev/null
+++ b/imports.sh
@@ -0,0 +1,133 @@
+#!/usr/bin/env bash
+set -Eeo pipefail
+
+# Created by Tom de Jong in September 2024.
+
+
+# Ensure we have GNU-style sed
+# See https://stackoverflow.com/questions/4247068/sed-command-with-i-option-failing-on-mac-but-works-on-linux
+if [[ "$OSTYPE" == "darwin"* ]]; then
+  # Require gnu-sed.
+  if ! [ -x "$(command -v gsed)" ]; then
+    echo "Error: 'gsed' is not istalled." >&2
+    echo "If you are using Homebrew, install with 'brew install gnu-sed'." >&2
+    exit 1
+  fi
+  sed_cmd=gsed
+else
+  sed_cmd=sed
+fi
+
+
+# "catch exit status 1" grep wrapper
+# https://stackoverflow.com/questions/6550484/prevent-grep-returning-an-error-when-input-doesnt-match/49627999#49627999
+c1grep() { grep "$@" || test $? = 1; }
+
+
+print_usage() {
+  printf "From TypeTopology/source, run this script as
+  ./imports.sh UF/Embeddings.lagda
+to report redundant imports in UF/Embeddings.lagda.
+
+Alternatively, use the -d (directory) flag to report redundant
+imports in all .lagda files in the UF/ directory, e.g.
+  ./imports.sh -d UF/
+NB: The forward slash at the end of the directory is important.
+
+Use the -r flag to remove redundant imports (without reporting them), e.g.
+  ./imports.sh -d -r UF/
+  ./imports.sh -r UF/Embeddings.lagda
+
+Wrong flags, or the -h (help) flag, displays this message.
+"
+}
+
+
+# Implement option flags
+# https://stackoverflow.com/questions/7069682/how-to-get-arguments-with-flags-in-bash
+dir_flag=false
+rem_flag=false
+
+OPTIND=1
+while getopts 'drh' flag; do
+  case "${flag}" in
+    d) dir_flag=true ;;
+    r) rem_flag=true ;;
+    h) print_usage
+       exit 0 ;;
+    *) print_usage
+       exit 1 ;;
+  esac
+done
+
+
+# Discard options so we can get the file/directory name next
+shift "$((OPTIND-1))"
+if [ $# -ge 1 ] && [ -n "$1" ]; then
+  input=$1
+else
+  print_usage
+  exit 1
+fi
+
+
+check_imports() {
+  unused=()
+  local file=$1
+
+  # Get all line numbers that have 'open import ...'
+  imports=$(c1grep -n "open import" $file | cut -d ':' -f1)
+
+  # Get the cluster, e.g. 'UF' or 'DomainTheory/Lifting'
+  cluster=$(dirname $file)
+
+  # And with '.' instead of '/'
+  clustermod=$(echo $cluster | ${sed_cmd} 's/\//./')
+
+  # Get the (relative) module name
+  modname=$(basename $file | ${sed_cmd} 's/.lagda$//')
+
+  # Set up a temporary file for testing
+  temp="UnusedImportTesting"
+  fulltemp="${cluster}/${temp}.lagda"
+
+  local i
+  for i in $imports;
+  do
+    ${sed_cmd} "$i s/^/-- /" $file > $fulltemp # Comment out an import
+
+    # Replace module name to match the temporary file
+    oldmod="module ${clustermod}.${modname}"
+    newmod="module ${clustermod}.${temp}"
+    ${sed_cmd} -i "s/${oldmod}/${newmod}/" $fulltemp
+
+    # Try to scope-check and save (line numbers of) any redundant imports
+    agda --only-scope-checking $fulltemp > /dev/null &&
+      {
+        unused+=( $i )
+      }
+
+    rm $fulltemp
+  done
+
+  if $rem_flag; then
+      ${sed_cmd} -i "${unused[*]/%/d;}" $file # Remove redundant imports
+  else # Report redundant imports
+      for i in $unused;
+      do
+	import=$(${sed_cmd} -n "${i}p" $file | awk -F 'open import ' '{print $2}')
+	echo "Importing $import was not necessary"
+      done
+  fi
+}
+
+
+if $dir_flag; then # Check all *.lagda files in given directory
+  for i in ${input}*.lagda
+  do
+    check_imports $i
+    echo "Done with $(basename $i)"
+  done
+else
+  check_imports $input # Check a single file
+fi
\ No newline at end of file
diff --git a/source/AllModulesIndex.lagda b/source/AllModulesIndex.lagda
index af6dd0921..06b0ec9be 100644
--- a/source/AllModulesIndex.lagda
+++ b/source/AllModulesIndex.lagda
@@ -4,7 +4,7 @@
    constructive univalent mathematics
    written in Agda
 
-   Tested with Agda 2.6.4.3
+   Tested with Agda 2.6.4.3 and 2.7.0
 
    Martin Escardo and collaborators, 2010--2024--∞
    Continuously evolving.
diff --git a/source/Apartness/Definition.lagda b/source/Apartness/Definition.lagda
new file mode 100644
index 000000000..f318bcd27
--- /dev/null
+++ b/source/Apartness/Definition.lagda
@@ -0,0 +1,205 @@
+Martin Escardo, 26 January 2018.
+
+Moved from the file TotallySeparated 22 August 2024.
+
+Definition of apartness relation and basic general facts.
+
+\begin{code}
+
+{-# OPTIONS --safe --without-K #-}
+
+module Apartness.Definition where
+
+open import MLTT.Spartan
+open import UF.DiscreteAndSeparated hiding (tight)
+open import UF.FunExt
+open import UF.Lower-FunExt
+open import UF.NotNotStablePropositions
+open import UF.PropTrunc
+open import UF.Sets
+open import UF.Sets-Properties
+open import UF.Subsingletons
+open import UF.Subsingletons-FunExt
+
+is-prop-valued
+ is-irreflexive
+ is-symmetric
+ is-strongly-cotransitive
+ is-tight
+ is-strong-apartness
+  : {X : 𝓤 ̇ } → (X → X → 𝓥 ̇ ) → 𝓤 ⊔ 𝓥 ̇
+
+is-prop-valued           _♯_ = ∀ x y → is-prop (x ♯ y)
+is-irreflexive           _♯_ = ∀ x → ¬ (x ♯ x)
+is-symmetric             _♯_ = ∀ x y → x ♯ y → y ♯ x
+is-strongly-cotransitive _♯_ = ∀ x y z → x ♯ y → (x ♯ z) + (y ♯ z)
+is-tight                 _♯_ = ∀ x y → ¬ (x ♯ y) → x ＝ y
+is-strong-apartness      _♯_ = is-prop-valued _♯_
+                             × is-irreflexive _♯_
+                             × is-symmetric _♯_
+                             × is-strongly-cotransitive _♯_
+
+Strong-Apartness : 𝓤 ̇ → (𝓥 : Universe) → 𝓥 ⁺ ⊔ 𝓤 ̇
+Strong-Apartness X 𝓥 = Σ _♯_ ꞉ (X → X → 𝓥 ̇) , is-strong-apartness _♯_
+
+\end{code}
+
+Not-not equal elements are not apart, and hence, in the presence of
+tightness, they are equal. It follows that tight apartness types are
+sets.
+
+\begin{code}
+
+double-negation-of-equality-gives-negation-of-apartness
+ : {X : 𝓤 ̇ } (x y : X) (_♯_ : X → X → 𝓥 ̇ )
+ → is-irreflexive _♯_
+ → ¬¬ (x ＝ y)
+ → ¬ (x ♯ y)
+double-negation-of-equality-gives-negation-of-apartness x y _♯_ i
+ = contrapositive f
+ where
+  f : x ♯ y → ¬ (x ＝ y)
+  f a refl = i y a
+
+tight-types-are-¬¬-separated' : {X : 𝓤 ̇ } (_♯_ : X → X → 𝓥 ̇ )
+                              → is-irreflexive _♯_
+                              → is-tight _♯_
+                              → is-¬¬-separated X
+tight-types-are-¬¬-separated' _♯_ i t = f
+ where
+  f : ∀ x y → ¬¬ (x ＝ y) → x ＝ y
+  f x y φ = t x y (double-negation-of-equality-gives-negation-of-apartness
+                    x y _♯_ i φ)
+
+tight-types-are-sets' : {X : 𝓤 ̇ } (_♯_ : X → X → 𝓥 ̇ )
+                      → funext 𝓤 𝓤₀
+                      → is-irreflexive _♯_
+                      → is-tight _♯_
+                      → is-set X
+tight-types-are-sets' _♯_ fe i t =
+ ¬¬-separated-types-are-sets fe (tight-types-are-¬¬-separated' _♯_ i t)
+
+\end{code}
+
+To define apartness we need to define (weak) cotransitivity, and for
+this we need to assume the existence of propositional truncations.
+
+\begin{code}
+
+module Apartness (pt : propositional-truncations-exist) where
+
+ open PropositionalTruncation pt
+
+ is-cotransitive is-apartness : {X : 𝓤 ̇ } → (X → X → 𝓥 ̇ ) → 𝓤 ⊔ 𝓥 ̇
+
+ is-cotransitive _♯_ = ∀ x y z → x ♯ y → x ♯ z ∨ y ♯ z
+ is-apartness    _♯_ = is-prop-valued _♯_
+                     × is-irreflexive _♯_
+                     × is-symmetric _♯_
+                     × is-cotransitive _♯_
+
+ Apartness : 𝓤 ̇ → (𝓥 : Universe) → 𝓥 ⁺ ⊔ 𝓤 ̇
+ Apartness X 𝓥 = Σ _♯_ ꞉ (X → X → 𝓥 ̇) , is-apartness _♯_
+
+ apartness-is-prop-valued : {X : 𝓤 ̇ } (_♯_ : X → X → 𝓥 ̇ )
+                          → is-apartness _♯_
+                          → is-prop-valued _♯_
+ apartness-is-prop-valued _♯_ (p , i , s , c) = p
+
+ apartness-is-irreflexive : {X : 𝓤 ̇ } (_♯_ : X → X → 𝓥 ̇ )
+                          → is-apartness _♯_
+                          → is-irreflexive _♯_
+ apartness-is-irreflexive _♯_ (p , i , s , c) = i
+
+ apartness-is-symmetric : {X : 𝓤 ̇ } (_♯_ : X → X → 𝓥 ̇ )
+                        → is-apartness _♯_
+                        → is-symmetric _♯_
+ apartness-is-symmetric _♯_ (p , i , s , c) = s
+
+ apartness-is-cotransitive : {X : 𝓤 ̇ } (_♯_ : X → X → 𝓥 ̇ )
+                           → is-apartness _♯_
+                           → is-cotransitive _♯_
+ apartness-is-cotransitive _♯_ (p , i , s , c) = c
+
+ not-not-equal-not-apart : {X : 𝓤 ̇ } (x y : X) (_♯_ : X → X → 𝓥 ̇ )
+                         → is-apartness _♯_
+                         → ¬¬ (x ＝ y)
+                         → ¬ (x ♯ y)
+ not-not-equal-not-apart x y _♯_ (_ , i , _ , _) =
+  double-negation-of-equality-gives-negation-of-apartness x y _♯_ i
+
+ tight-types-are-¬¬-separated : {X : 𝓤 ̇ } (_♯_ : X → X → 𝓥 ̇ )
+                              → is-apartness _♯_
+                              → is-tight _♯_
+                              → is-¬¬-separated X
+ tight-types-are-¬¬-separated _♯_ (_ , i , _ , _) =
+  tight-types-are-¬¬-separated' _♯_ i
+
+ tight-types-are-sets : {X : 𝓤 ̇ } (_♯_ : X → X → 𝓥 ̇ )
+                      → funext 𝓤 𝓤₀
+                      → is-apartness _♯_
+                      → is-tight _♯_
+                      → is-set X
+ tight-types-are-sets _♯_ fe (_ , i , _ , _) = tight-types-are-sets' _♯_ fe i
+
+\end{code}
+
+The above use apartness data, but its existence is enough, because
+being a ¬¬-separated type and being a set are propositions.
+
+\begin{code}
+
+ tight-separated' : funext 𝓤 𝓤
+                  → {X : 𝓤 ̇ }
+                  → (∃ _♯_ ꞉ (X → X → 𝓤 ̇ ), is-apartness _♯_ × is-tight _♯_)
+                  → is-¬¬-separated X
+ tight-separated' {𝓤} fe {X} = ∥∥-rec (being-¬¬-separated-is-prop fe) f
+   where
+    f : (Σ _♯_ ꞉ (X → X → 𝓤 ̇ ), is-apartness _♯_ × is-tight _♯_)
+      → is-¬¬-separated X
+    f (_♯_ , a , t) = tight-types-are-¬¬-separated _♯_ a t
+
+ tight-types-are-sets'' : funext 𝓤 𝓤
+                        → {X : 𝓤 ̇ }
+                        → (∃ _♯_ ꞉ (X → X → 𝓤 ̇ ), is-apartness _♯_ × is-tight _♯_)
+                        → is-set X
+ tight-types-are-sets'' {𝓤} fe {X} = ∥∥-rec (being-set-is-prop fe) f
+   where
+    f : (Σ _♯_ ꞉ (X → X → 𝓤 ̇ ), is-apartness _♯_ × is-tight _♯_) → is-set X
+    f (_♯_ , a , t) = tight-types-are-sets _♯_ (lower-funext 𝓤 𝓤 fe) a t
+
+\end{code}
+
+The following is the standard equivalence relation induced by an
+apartness relation. The tightness axiom defined above says that this
+equivalence relation is equality.
+
+\begin{code}
+
+ is-equiv-rel : {X : 𝓤 ̇ } → (X → X → 𝓥 ̇ ) → 𝓤 ⊔ 𝓥 ̇
+ is-equiv-rel _≈_ = is-prop-valued _≈_
+                  × reflexive _≈_
+                  × symmetric _≈_
+                  × transitive _≈_
+
+ negation-of-apartness-is-equiv-rel : {X : 𝓤 ̇ }
+                                    → funext 𝓤 𝓤₀
+                                    → (_♯_ : X → X → 𝓤 ̇ )
+                                    → is-apartness _♯_
+                                    → is-equiv-rel (λ x y → ¬ (x ♯ y))
+ negation-of-apartness-is-equiv-rel {𝓤} {X} fe _♯_ (♯p , ♯i , ♯s , ♯c)
+  = p , ♯i , s , t
+  where
+   p : (x y : X) → is-prop (¬ (x ♯ y))
+   p x y = negations-are-props fe
+
+   s : (x y : X) → ¬ (x ♯ y) → ¬ (y ♯ x)
+   s x y u a = u (♯s y x a)
+
+   t : (x y z : X) → ¬ (x ♯ y) → ¬ (y ♯ z) → ¬ (x ♯ z)
+   t x y z u v a = v (♯s z y (left-fails-gives-right-holds (♯p z y) b u))
+    where
+     b : (x ♯ y) ∨ (z ♯ y)
+     b = ♯c x z y a
+
+\end{code}
diff --git a/source/Apartness/Examples.lagda b/source/Apartness/Examples.lagda
new file mode 100644
index 000000000..b5aeac10a
--- /dev/null
+++ b/source/Apartness/Examples.lagda
@@ -0,0 +1,57 @@
+Martin Escardo, 26 January 2018.
+
+Moved from the file TotallySeparated 22 August 2024.
+
+\begin{code}
+
+{-# OPTIONS --safe --without-K #-}
+
+open import UF.PropTrunc
+
+module Apartness.Examples
+        (pt : propositional-truncations-exist)
+       where
+
+open import Apartness.Definition
+open import MLTT.Spartan
+open import UF.SubtypeClassifier
+
+open PropositionalTruncation pt
+open Apartness pt
+
+\end{code}
+
+I don't think there is a tight apartness relation on Ω without
+constructive taboos. The natural apartness relation seems to be the
+following, but it isn't cotransitive unless excluded middle holds.
+
+\begin{code}
+
+_♯Ω_ : Ω 𝓤 → Ω 𝓤 → 𝓤 ̇
+(P , i) ♯Ω (Q , j) = (P × ¬ Q) + (¬ P × Q)
+
+♯Ω-irrefl : is-irreflexive (_♯Ω_ {𝓤})
+♯Ω-irrefl (P , i) (inl (p , nq)) = nq p
+♯Ω-irrefl (P , i) (inr (np , q)) = np q
+
+♯Ω-sym : is-symmetric (_♯Ω_ {𝓤})
+♯Ω-sym (P , i) (Q , j) (inl (p , nq)) = inr (nq , p)
+♯Ω-sym (P , i) (Q , j) (inr (np , q)) = inl (q , np)
+
+♯Ω-cotran-taboo : is-cotransitive (_♯Ω_ {𝓤})
+                → (p : Ω 𝓤)
+                → p holds ∨ ¬ (p holds)
+♯Ω-cotran-taboo c p = ∥∥-functor II I
+ where
+  I : (⊥ ♯Ω p) ∨ (⊤ ♯Ω p)
+  I = c ⊥ ⊤ p (inr (𝟘-elim , ⋆))
+
+  II : (⊥ ♯Ω p) + (⊤ ♯Ω p) → (p holds) + ¬ (p holds)
+  II (inl (inr (a , b))) = inl b
+  II (inr (inl (a , b))) = inr b
+  II (inr (inr (a , b))) = inl b
+
+\end{code}
+
+TODO. Show that *any* apartness relation on Ω gives weak excluded
+middle.
diff --git a/source/Apartness/Morphisms.lagda b/source/Apartness/Morphisms.lagda
new file mode 100644
index 000000000..d6f6e7c34
--- /dev/null
+++ b/source/Apartness/Morphisms.lagda
@@ -0,0 +1,43 @@
+Martin Escardo, 26 January 2018.
+
+Moved from the file TotallySeparated 22 August 2024.
+
+\begin{code}
+
+{-# OPTIONS --safe --without-K #-}
+
+module Apartness.Morphisms where
+
+open import Apartness.Definition
+open import MLTT.Spartan
+open import UF.FunExt
+open import UF.Subsingletons
+open import UF.Subsingletons-FunExt
+
+\end{code}
+
+A map is called strongly extensional if it reflects apartness. In the
+category of apartness types, the morphisms are the strongly
+extensional maps.
+
+\begin{code}
+
+is-strongly-extensional : ∀ {𝓣} {X : 𝓤 ̇ } {Y : 𝓥 ̇ }
+                        → (X → X → 𝓦 ̇ ) → (Y → Y → 𝓣 ̇ ) → (X → Y) → 𝓤 ⊔ 𝓦 ⊔ 𝓣 ̇
+is-strongly-extensional _♯_ _♯'_ f = ∀ x x' → f x ♯' f x' → x ♯ x'
+
+being-strongly-extensional-is-prop : Fun-Ext
+                                   → {X : 𝓤 ̇ } {Y : 𝓥 ̇ }
+                                   → (_♯_ : X → X → 𝓦 ̇ )
+                                   → (_♯'_ : Y → Y → 𝓣 ̇ )
+                                   → is-prop-valued _♯_
+                                   → (f : X → Y)
+                                   → is-prop (is-strongly-extensional _♯_ _♯'_ f)
+being-strongly-extensional-is-prop fe _♯_ _♯'_ ♯p f =
+ Π₃-is-prop  fe (λ x x' a → ♯p x  x')
+
+preserves : ∀ {𝓣} {X : 𝓤 ̇ } {Y : 𝓥 ̇ }
+          → (X → X → 𝓦 ̇ ) → (Y → Y → 𝓣 ̇ ) → (X → Y) → 𝓤 ⊔ 𝓦 ⊔ 𝓣 ̇
+preserves R S f = ∀ {x x'} → R x x' → S (f x) (f x')
+
+\end{code}
diff --git a/source/Apartness/NegationOfApartness.lagda b/source/Apartness/NegationOfApartness.lagda
new file mode 100644
index 000000000..416ba77ca
--- /dev/null
+++ b/source/Apartness/NegationOfApartness.lagda
@@ -0,0 +1,76 @@
+Martin Escardo, 12 Feb 2018.
+
+Moved from the file TotallySeparated 22 August 2024.
+
+We give a positive characterization of the negation of apartness.
+
+See also
+https://nforum.ncatlab.org/discussion/8282/points-of-the-localic-quotient-with-respect-to-an-apartness-relation/
+
+\begin{code}
+
+{-# OPTIONS --safe --without-K #-}
+
+open import UF.PropTrunc
+
+module Apartness.NegationOfApartness
+        (pt : propositional-truncations-exist)
+       where
+
+open import Apartness.Definition
+open import MLTT.Spartan
+
+open PropositionalTruncation pt
+open Apartness pt
+
+\end{code}
+
+The following positive formulation of ¬ (x ♯ y), which says that two
+elements have the same elements apart from them iff they are not
+apart, gives another way to see that it is an equivalence relation.
+As far as we know, this positive characterization of the negation of
+apartness is a new observation.
+
+Notice the irreflexivity is not use in the following, but
+irreflexivity is the only assumption about _♯_ used in the converse.
+
+\begin{code}
+
+elements-that-are-not-apart-have-the-same-apartness-class
+ : {X : 𝓤 ̇ } (x y : X) (_♯_ : X → X → 𝓥 ̇ )
+ → is-apartness _♯_
+ → ¬ (x ♯ y)
+ → ((z : X) → x ♯ z ↔ y ♯ z)
+elements-that-are-not-apart-have-the-same-apartness-class
+ {𝓤} {𝓥} {X} x y _♯_ (p , _ , s , c) = g
+ where
+  g : ¬ (x ♯ y) → (z : X) → x ♯ z ↔ y ♯ z
+  g n z = g₁ , g₂
+   where
+    g₁ : x ♯ z → y ♯ z
+    g₁ a = s z y (left-fails-gives-right-holds (p z y) b n)
+     where
+      b : (x ♯ y) ∨ (z ♯ y)
+      b = c x z y a
+
+    n' : ¬ (y ♯ x)
+    n' a = n (s y x a)
+
+    g₂ : y ♯ z → x ♯ z
+    g₂ a = s z x (left-fails-gives-right-holds (p z x) b n')
+     where
+      b : (y ♯ x) ∨ (z ♯ x)
+      b = c y z x a
+
+elements-with-the-same-apartness-class-are-not-apart
+ : {X : 𝓤 ̇ } (x y : X) (_♯_ : X → X → 𝓥 ̇ )
+ → is-irreflexive _♯_
+ → ((z : X) → x ♯ z ↔ y ♯ z)
+ → ¬ (x ♯ y)
+elements-with-the-same-apartness-class-are-not-apart
+ {𝓤} {𝓥} {X} x y _♯_ i = f
+ where
+  f : ((z : X) → x ♯ z ↔ y ♯ z) → ¬ (x ♯ y)
+  f φ a = i y (pr₁(φ y) a)
+
+\end{code}
diff --git a/source/Apartness/Properties.lagda b/source/Apartness/Properties.lagda
new file mode 100644
index 000000000..d4be617ad
--- /dev/null
+++ b/source/Apartness/Properties.lagda
@@ -0,0 +1,124 @@
+Martin Escardo and Tom de Jong, August 2024
+
+Moved from the file InjectiveTypes.CounterExamples on 12 September 2024.
+
+\begin{code}
+
+{-# OPTIONS --safe --without-K #-}
+
+open import UF.PropTrunc
+
+module Apartness.Properties
+        (pt : propositional-truncations-exist)
+       where
+
+open import MLTT.Spartan
+open import Apartness.Definition
+open import UF.ClassicalLogic
+open import UF.FunExt
+open import UF.Size
+open import UF.Subsingletons
+open import UF.Subsingletons-FunExt
+
+open Apartness pt
+open PropositionalTruncation pt
+
+\end{code}
+
+We define an apartness relation to be nontrivial if it tells two points apart.
+
+\begin{code}
+
+has-two-points-apart : {X : 𝓤 ̇ } → Apartness X 𝓥 → 𝓥 ⊔ 𝓤 ̇
+has-two-points-apart {𝓤} {𝓥} {X} (_♯_ , α) = Σ (x , y) ꞉ X × X , (x ♯ y)
+
+Nontrivial-Apartness : 𝓤 ̇ → (𝓥 : Universe) → 𝓥 ⁺ ⊔ 𝓤 ̇
+Nontrivial-Apartness X 𝓥 = Σ a ꞉ Apartness X 𝓥 , has-two-points-apart a
+
+\end{code}
+
+Assuming weak excluded middle, every type with two distinct points can be
+equipped with a nontrivial apartness relation.
+
+\begin{code}
+
+WEM-gives-that-type-with-two-distinct-points-has-nontrivial-apartness
+ : funext 𝓤 𝓤₀
+ → {X : 𝓤 ̇ }
+ → has-two-distinct-points X
+ → WEM 𝓤
+ → Nontrivial-Apartness X 𝓤
+WEM-gives-that-type-with-two-distinct-points-has-nontrivial-apartness
+ {𝓤} fe {X} htdp wem = γ
+ where
+  s : (x y z : X) → x ≠ y → (x ≠ z) + (y ≠ z)
+  s x y z d =
+   Cases (wem (x ≠ z))
+    (λ (a : ¬ (x ≠ z))  → inr (λ {refl → a d}))
+    (λ (b : ¬¬ (x ≠ z)) → inl (three-negations-imply-one b))
+
+  c : is-cotransitive _≠_
+  c x y z d = ∣ s x y z d ∣
+
+  γ : Nontrivial-Apartness X 𝓤
+  γ = (_≠_ ,
+      ((λ x y → negations-are-props fe) ,
+       ≠-is-irrefl ,
+       (λ x y → ≠-sym) , c)) ,
+      htdp
+
+WEM-gives-that-type-with-two-distinct-points-has-nontrivial-apartness⁺
+ : funext 𝓤 𝓤₀
+ → {X : 𝓤 ⁺ ̇ }
+ → is-locally-small X
+ → has-two-distinct-points X
+ → WEM 𝓤
+ → Nontrivial-Apartness X 𝓤
+WEM-gives-that-type-with-two-distinct-points-has-nontrivial-apartness⁺
+ {𝓤} fe {X} ls ((x₀ , x₁) , d) wem = γ
+ where
+  _♯_ : X → X → 𝓤 ̇
+  x ♯ y = x ≠⟦ ls ⟧ y
+
+  s : (x y z : X) → x ♯ y → (x ♯ z) + (y ♯ z)
+  s x y z a = Cases (wem (x ♯ z)) (inr ∘ f) (inl ∘ g)
+   where
+    f : ¬ (x ♯ z) → y ♯ z
+    f = contrapositive
+         (λ (e : y ＝⟦ ls ⟧ z) → transport (x ♯_) (＝⟦ ls ⟧-gives-＝ e) a)
+
+    g : ¬¬ (x ♯ z) → x ♯ z
+    g = three-negations-imply-one
+
+  c : is-cotransitive _♯_
+  c x y z d = ∣ s x y z d ∣
+
+  γ : Nontrivial-Apartness X 𝓤
+  γ = (_♯_ ,
+       (λ x y → negations-are-props fe) ,
+       (λ x → ≠⟦ ls ⟧-irrefl) ,
+       (λ x y → ≠⟦ ls ⟧-sym) ,
+       c) ,
+      (x₀ , x₁) , ≠-gives-≠⟦ ls ⟧ d
+
+\end{code}
+
+In particular, weak excluded middle yields a nontrivial apartness relation on
+any universe.
+
+\begin{code}
+
+WEM-gives-non-trivial-apartness-on-universe
+ : funext (𝓤 ⁺) 𝓤₀
+ → WEM (𝓤 ⁺)
+ → Nontrivial-Apartness (𝓤 ̇ ) (𝓤 ⁺)
+WEM-gives-non-trivial-apartness-on-universe fe =
+ WEM-gives-that-type-with-two-distinct-points-has-nontrivial-apartness
+  fe
+  universe-has-two-distinct-points
+
+\end{code}
+
+Further properties of apartness relations can be found in the following file
+InjectiveTypes.CounterExamples. In particular, it is shown that the universe
+can't have any nontrivial apartness unless weak excluded middle holds.
\ No newline at end of file
diff --git a/source/Apartness/TightReflection.lagda b/source/Apartness/TightReflection.lagda
new file mode 100644
index 000000000..190cb10cc
--- /dev/null
+++ b/source/Apartness/TightReflection.lagda
@@ -0,0 +1,528 @@
+Martin Escardo, 26 January 2018.
+
+Moved from the file TotallySeparated 22 August 2024.
+
+Every apartness relation has a tight reflection, in the categorical
+sense of reflection, where the morphisms are strongly extensional
+functions.
+
+\begin{code}
+
+{-# OPTIONS --safe --without-K #-}
+
+open import UF.PropTrunc
+
+module Apartness.TightReflection
+        (pt : propositional-truncations-exist)
+       where
+
+open import Apartness.Definition
+open import Apartness.Morphisms
+open import Apartness.NegationOfApartness pt
+open import MLTT.Spartan
+open import UF.Base
+open import UF.Embeddings
+open import UF.Equiv
+open import UF.FunExt
+open import UF.ImageAndSurjection pt
+open import UF.Powerset hiding (𝕋)
+open import UF.Sets
+open import UF.Sets-Properties
+open import UF.SubtypeClassifier
+open import UF.Subsingletons
+open import UF.Subsingletons-FunExt
+
+open PropositionalTruncation pt
+open Apartness pt
+
+module tight-reflection
+        (fe : Fun-Ext)
+        (pe : propext 𝓥)
+        (X : 𝓤 ̇ )
+        (_♯_ : X → X → 𝓥 ̇ )
+        (♯p : is-prop-valued _♯_)
+        (♯i : is-irreflexive _♯_)
+        (♯s : is-symmetric _♯_)
+        (♯c : is-cotransitive _♯_)
+      where
+
+\end{code}
+
+We now name the standard equivalence relation induced by _♯_.
+
+\begin{code}
+
+ _~_ : X → X → 𝓥 ̇
+ x ~ y = ¬ (x ♯ y)
+
+\end{code}
+
+ For certain purposes we need the apartness axioms packed into a
+ single axiom.
+
+\begin{code}
+
+ ♯a : is-apartness _♯_
+ ♯a = (♯p , ♯i , ♯s , ♯c)
+
+\end{code}
+
+Initially we tried to work with the function apart : X → (X → 𝓥 ̇ )
+defined by apart = _♯_. However, at some point in the development
+below it was difficult to proceed, when we need that the identity
+type apart x = apart y is a proposition. This should be the case
+because _♯_ is is-prop-valued. The most convenient way to achieve this
+is to restrict the codomain of apart from 𝓥 to Ω, so that the
+codomain of apart is a set.
+
+\begin{code}
+
+ α : X → (X → Ω 𝓥)
+ α x y = x ♯ y , ♯p x y
+
+\end{code}
+
+The following is an immediate consequence of the fact that two
+equivalent elements have the same apartness class, using functional
+and propositional extensionality.
+
+\begin{code}
+
+ α-lemma : (x y : X) → x ~ y → α x ＝ α y
+ α-lemma x y na = dfunext fe h
+  where
+   f : (z : X) → x ♯ z ↔ y ♯ z
+   f = elements-that-are-not-apart-have-the-same-apartness-class x y _♯_ ♯a na
+
+   g : (z : X) → x ♯ z ＝ y ♯ z
+   g z = pe (♯p x z) (♯p y z) (pr₁ (f z)) (pr₂ (f z))
+
+   h : (z : X) → α x z ＝ α y z
+   h z = to-subtype-＝ (λ _ → being-prop-is-prop fe) (g z)
+
+\end{code}
+
+We now construct the tight reflection of (X,♯) to get (X',♯')
+together with a universal strongly extensional map from X into tight
+apartness types. We take X' to be the image of the map α.
+
+\begin{code}
+
+ X' : 𝓤 ⊔ 𝓥 ⁺ ̇
+ X' = image α
+
+\end{code}
+
+The type X may or may not be a set, but its tight reflection is
+necessarily a set, and we can see this before we define a tight
+apartness on it.
+
+\begin{code}
+
+ X'-is-set : is-set X'
+ X'-is-set = subsets-of-sets-are-sets (X → Ω 𝓥) _
+              (powersets-are-sets'' fe fe pe) ∥∥-is-prop
+
+ η : X → X'
+ η = corestriction α
+
+\end{code}
+
+The following induction principle is our main tool. Its uses look
+convoluted at times by the need to show that the property one is
+doing induction over is proposition valued. Typically this involves
+the use of the fact the propositions form an exponential ideal, and,
+ more generally, are closed under products.
+
+\begin{code}
+
+ η-is-surjection : is-surjection η
+ η-is-surjection = corestrictions-are-surjections α
+
+ η-induction : (P : X' → 𝓦 ̇ )
+             → ((x' : X') → is-prop (P x'))
+             → ((x : X) → P (η x))
+             → (x' : X') → P x'
+ η-induction = surjection-induction η η-is-surjection
+
+\end{code}
+
+The apartness relation _♯'_ on X' is defined as follows.
+
+\begin{code}
+
+ _♯'_ : X' → X' → 𝓤 ⊔ 𝓥 ⁺ ̇
+ (u , _) ♯' (v , _) = ∃ x ꞉ X , Σ y ꞉ X , (x ♯ y) × (α x ＝ u) × (α y ＝ v)
+
+\end{code}
+
+Then η preserves and reflects apartness.
+
+\begin{code}
+
+ η-preserves-apartness : preserves _♯_ _♯'_ η
+ η-preserves-apartness {x} {y} a = ∣ x , y , a , refl , refl ∣
+
+ η-is-strongly-extensional : is-strongly-extensional _♯_ _♯'_ η
+ η-is-strongly-extensional x y = ∥∥-rec (♯p x y) g
+  where
+   g : (Σ x' ꞉ X , Σ y' ꞉ X , (x' ♯ y') × (α x' ＝ α x) × (α y' ＝ α y))
+     → x ♯ y
+   g (x' , y' , a , p , q) = ♯s _ _ (j (♯s _ _ (i a)))
+    where
+     i : x' ♯ y' → x ♯ y'
+     i = idtofun _ _ (ap pr₁ (happly p y'))
+
+     j : y' ♯ x → y ♯ x
+     j = idtofun _ _ (ap pr₁ (happly q x))
+
+\end{code}
+
+Of course, we must check that _♯'_ is indeed an apartness
+relation. We do this by η-induction. These proofs by induction need
+routine proofs that some things are propositions.
+
+\begin{code}
+
+ ♯'p : is-prop-valued _♯'_
+ ♯'p _ _ = ∥∥-is-prop
+
+ ♯'i : is-irreflexive _♯'_
+ ♯'i = by-induction
+  where
+   induction-step : ∀ x → ¬ (η x ♯' η x)
+   induction-step x a = ♯i x (η-is-strongly-extensional x x a)
+
+   by-induction = η-induction (λ x' → ¬ (x' ♯' x'))
+                   (λ _ → Π-is-prop fe (λ _ → 𝟘-is-prop))
+                   induction-step
+
+ ♯'s : is-symmetric _♯'_
+ ♯'s = by-nested-induction
+  where
+   induction-step : ∀ x y → η x ♯' η y → η y ♯' η x
+   induction-step x y a = η-preserves-apartness
+                           (♯s x y (η-is-strongly-extensional x y a))
+
+   by-nested-induction =
+     η-induction (λ x' → ∀ y' → x' ♯' y' → y' ♯' x')
+      (λ x' → Π₂-is-prop fe (λ y' _ → ♯'p y' x'))
+      (λ x → η-induction (λ y' → η x ♯' y' → y' ♯' η x)
+               (λ y' → Π-is-prop fe (λ _ → ♯'p y' (η x)))
+               (induction-step x))
+
+ ♯'c : is-cotransitive _♯'_
+ ♯'c = by-nested-induction
+  where
+   induction-step : ∀ x y z → η x ♯' η y → η x ♯' η z ∨ η y ♯' η z
+   induction-step x y z a = ∥∥-functor c b
+    where
+     a' : x ♯ y
+     a' = η-is-strongly-extensional x y a
+
+     b : x ♯ z ∨ y ♯ z
+     b = ♯c x y z a'
+
+     c : (x ♯ z) + (y ♯ z) → (η x ♯' η z) + (η y ♯' η z)
+     c (inl e) = inl (η-preserves-apartness e)
+     c (inr f) = inr (η-preserves-apartness f)
+
+   by-nested-induction =
+     η-induction (λ x' → ∀ y' z' → x' ♯' y' → (x' ♯' z') ∨ (y' ♯' z'))
+      (λ _ → Π₃-is-prop fe (λ _ _ _ → ∥∥-is-prop))
+      (λ x → η-induction (λ y' → ∀ z' → η x ♯' y' → (η x ♯' z') ∨ (y' ♯' z'))
+               (λ _ → Π₂-is-prop fe (λ _ _ → ∥∥-is-prop))
+               (λ y → η-induction (λ z' → η x ♯' η y → (η x ♯' z') ∨ (η y ♯' z'))
+                        (λ _ → Π-is-prop fe (λ _ → ∥∥-is-prop))
+                        (induction-step x y)))
+
+ ♯'a : is-apartness _♯'_
+ ♯'a = (♯'p , ♯'i , ♯'s , ♯'c)
+
+\end{code}
+
+The tightness of _♯'_ cannot by proved by induction by reduction to
+properties of _♯_, as above, because _♯_ is not (necessarily)
+tight. We need to work with the definitions of X' and _♯'_ directly.
+
+\begin{code}
+
+ ♯'t : is-tight _♯'_
+ ♯'t (u , e) (v , f) n = ∥∥-rec X'-is-set (λ σ → ∥∥-rec X'-is-set (h σ) f) e
+  where
+   h : (Σ x ꞉ X , α x ＝ u) → (Σ y ꞉ X , α y ＝ v) → (u , e) ＝ (v , f)
+   h (x , p) (y , q) = to-Σ-＝ (t , ∥∥-is-prop _ _)
+    where
+     remark : ¬∃ x ꞉ X , Σ y ꞉ X , (x ♯ y) × (α x ＝ u) × (α y ＝ v)
+     remark = n
+
+     r : ¬ (x ♯ y)
+     r a = n ∣ x , y , a , p , q ∣
+
+     t : u ＝ v
+     t = u   ＝⟨ p ⁻¹ ⟩
+         α x ＝⟨ α-lemma x y r ⟩
+         α y ＝⟨ q ⟩
+         v   ∎
+
+\end{code}
+
+The tightness of _♯'_ gives that η maps equivalent elements to equal
+elements, and its irreflexity gives that elements with the same η
+image are equivalent.
+
+\begin{code}
+
+ η-equiv-gives-equal : {x y : X} → x ~ y → η x ＝ η y
+ η-equiv-gives-equal = ♯'t _ _ ∘ contrapositive (η-is-strongly-extensional _ _)
+
+ η-equal-gives-equiv : {x y : X} → η x ＝ η y → x ~ y
+ η-equal-gives-equiv {x} {y} p a = ♯'i
+                                    (η y)
+                                    (transport (λ - → - ♯' η y)
+                                    p
+                                    (η-preserves-apartness a))
+
+\end{code}
+
+We now show that the above data provide the tight reflection, or
+universal strongly extensional map from X to tight apartness types,
+where unique existence is expressed by saying that a Σ type is a
+singleton, as usual in univalent mathematics and homotopy type
+theory. Notice the use of η-induction to avoid dealing directly with
+the details of the constructions performed above.
+
+\begin{code}
+
+ module _
+         {𝓦 𝓣 : Universe}
+         (A : 𝓦 ̇ )
+         (_♯ᴬ_ : A → A → 𝓣 ̇ )
+         (♯ᴬa : is-apartness _♯ᴬ_)
+         (♯ᴬt : is-tight _♯ᴬ_)
+         (f : X → A)
+         (f-is-strongly-extensional : is-strongly-extensional _♯_ _♯ᴬ_ f)
+        where
+
+  private
+   A-is-set : is-set A
+   A-is-set = tight-types-are-sets _♯ᴬ_ fe ♯ᴬa ♯ᴬt
+
+   f-transforms-~-into-= : {x y : X} → x ~ y → f x ＝ f y
+   f-transforms-~-into-= = ♯ᴬt _ _ ∘ contrapositive (f-is-strongly-extensional _ _)
+
+  tr-lemma : (x' : X') → is-prop (Σ a ꞉ A , ∃ x ꞉ X , (η x ＝ x') × (f x ＝ a))
+  tr-lemma = η-induction _ p induction-step
+    where
+     p : (x' : X')
+       → is-prop (is-prop (Σ a ꞉ A , ∃ x ꞉ X , (η x ＝ x') × (f x ＝ a)))
+     p x' = being-prop-is-prop fe
+
+     induction-step : (y : X)
+                    → is-prop (Σ a ꞉ A , ∃ x ꞉ X , (η x ＝ η y) × (f x ＝ a))
+     induction-step x (a , d) (b , e) = to-Σ-＝ (IV , ∥∥-is-prop _ _)
+      where
+       I : (Σ x' ꞉ X , (η x' ＝ η x) × (f x' ＝ a))
+         → (Σ y' ꞉ X , (η y' ＝ η x) × (f y' ＝ b))
+         → a ＝ b
+       I (x' , r , s) (y' , t , u) =
+        a    ＝⟨ s ⁻¹ ⟩
+        f x' ＝⟨ f-transforms-~-into-= III ⟩
+        f y' ＝⟨ u ⟩
+        b    ∎
+         where
+           II : η x' ＝ η y'
+           II = η x' ＝⟨ r ⟩
+                η x  ＝⟨ t ⁻¹ ⟩
+                η y' ∎
+
+           III : x' ~ y'
+           III = η-equal-gives-equiv II
+
+       IV : a ＝ b
+       IV = ∥∥-rec A-is-set (λ σ → ∥∥-rec A-is-set (I σ) e) d
+
+  tr-construction : (x' : X') → Σ a ꞉ A , ∃ x ꞉ X , (η x ＝ x') × (f x ＝ a)
+  tr-construction = η-induction _ tr-lemma induction-step
+   where
+    induction-step : (y : X) → Σ a ꞉ A , ∃ x ꞉ X , (η x ＝ η y) × (f x ＝ a)
+    induction-step x = f x , ∣ x , refl , refl ∣
+
+  mediating-map : X' → A
+  mediating-map x' = pr₁ (tr-construction x')
+
+  private
+   f⁻ = mediating-map
+
+  mediating-map-property : (y : X) → ∃ x ꞉ X , (η x ＝ η y) × (f x ＝ f⁻ (η y))
+  mediating-map-property y = pr₂ (tr-construction (η y))
+
+  mediating-triangle : f⁻ ∘ η ＝ f
+  mediating-triangle = dfunext fe II
+   where
+    I : (y : X) → (Σ x ꞉ X , (η x ＝ η y) × (f x ＝ f⁻ (η y))) → f⁻ (η y) ＝ f y
+    I y (x , p , q) =
+     f⁻ (η y) ＝⟨ q ⁻¹ ⟩
+     f x      ＝⟨ f-transforms-~-into-= (η-equal-gives-equiv p) ⟩
+     f y      ∎
+
+    II : (y : X) → f⁻ (η y) ＝ f y
+    II y = ∥∥-rec A-is-set (I y) (mediating-map-property y)
+
+  private
+   c' : is-central
+          (Σ f⁻ ꞉ (X' → A) , (f⁻ ∘ η ＝ f))
+          (f⁻ , mediating-triangle)
+   c' (f⁺ , f⁺-triangle) = IV
+     where
+      I : f⁻ ∘ η ∼ f⁺ ∘ η
+      I = happly (f⁻ ∘ η  ＝⟨ mediating-triangle ⟩
+                  f       ＝⟨ f⁺-triangle ⁻¹ ⟩
+                  f⁺ ∘ η  ∎)
+
+      II : f⁻ ＝ f⁺
+      II = dfunext fe (η-induction _ (λ _ → A-is-set) I)
+
+      triangle : f⁺ ∘ η ＝ f
+      triangle = transport (λ - → - ∘ η ＝ f) II mediating-triangle
+
+      III : triangle ＝ f⁺-triangle
+      III = Π-is-set fe (λ _ → A-is-set) triangle f⁺-triangle
+
+      IV : (f⁻ , mediating-triangle) ＝ (f⁺ , f⁺-triangle)
+      IV = to-subtype-＝ (λ h → Π-is-set fe (λ _ → A-is-set)) II
+
+  pre-tight-reflection : ∃! f⁻ ꞉ (X' → A) , (f⁻ ∘ η ＝ f)
+  pre-tight-reflection = (f⁻ , mediating-triangle) , c'
+
+  mediating-map-is-strongly-extensional : is-strongly-extensional _♯'_ _♯ᴬ_ f⁻
+  mediating-map-is-strongly-extensional = V
+   where
+    I : (x y : X) → f⁻ (η x) ♯ᴬ f⁻ (η y) → η x ♯' η y
+    I x y a = IV
+     where
+      II : f x ♯ᴬ f y
+      II = transport₂ (_♯ᴬ_)
+            (happly mediating-triangle x)
+            (happly mediating-triangle y) a
+
+      III : x ♯ y
+      III = f-is-strongly-extensional x y II
+
+      IV : η x ♯' η y
+      IV = η-preserves-apartness III
+
+    V : ∀ x' y' → f⁻ x' ♯ᴬ f⁻ y' → x' ♯' y'
+    V = η-induction (λ x' → (y' : X') → f⁻ x' ♯ᴬ f⁻ y' → x' ♯' y')
+          (λ x' → Π₂-is-prop fe (λ y' _ → ♯'p x' y'))
+          (λ x → η-induction (λ y' → f⁻ (η x) ♯ᴬ f⁻ y' → η x ♯' y')
+                  (λ y' → Π-is-prop fe (λ _ → ♯'p (η x) y'))
+                  (I x))
+
+  private
+   c : is-central
+        (Σ f⁻ ꞉ (X' → A) , (is-strongly-extensional _♯'_ _♯ᴬ_ f⁻) × (f⁻ ∘ η ＝ f))
+        (f⁻ , mediating-map-is-strongly-extensional , mediating-triangle)
+   c (f⁺ , f⁺-is-strongly-extensional , f⁺-triangle) =
+    to-subtype-＝
+      (λ h → ×-is-prop
+               (being-strongly-extensional-is-prop fe _♯'_ _♯ᴬ_ ♯'p h)
+               (Π-is-set fe (λ _ → A-is-set)))
+      (ap pr₁ (c' (f⁺ , f⁺-triangle)))
+
+
+  tight-reflection : ∃! f⁻ ꞉ (X' → A)
+                           , (is-strongly-extensional _♯'_ _♯ᴬ_ f⁻)
+                           × (f⁻ ∘ η ＝ f)
+  tight-reflection = (f⁻ , mediating-map-is-strongly-extensional ,
+                     mediating-triangle) ,
+                     c
+
+\end{code}
+
+The following is an immediate consequence of the tight reflection,
+by the usual categorical argument, using the fact that the identity
+map is strongly extensional (with the identity function as the
+proof). Notice that our construction of the reflection produces a
+result in a universe higher than those where the starting data are,
+to avoid impredicativity (aka propositional resizing). Nevertheless,
+the usual categorical argument is applicable.
+
+A direct proof that doesn't rely on the tight reflection is equally
+short in this case, and is also included.
+
+What the following construction says is that if _♯_ is tight, then
+any element of X is uniquely determined by the set of elements apart
+from it.
+
+\begin{code}
+
+ tight-η-equiv-abstract-nonsense : is-tight _♯_ → X ≃ X'
+ tight-η-equiv-abstract-nonsense ♯t = η , (θ , happly p₄) , (θ , happly p₀)
+  where
+   u : ∃! θ ꞉ (X' → X), θ ∘ η ＝ id
+   u = pre-tight-reflection X _♯_ ♯a ♯t id (λ _ _ a → a)
+
+   v : ∃! ζ ꞉ (X' → X'), ζ ∘ η ＝ η
+   v = pre-tight-reflection X' _♯'_ ♯'a ♯'t η η-is-strongly-extensional
+
+   θ : X' → X
+   θ = ∃!-witness u
+
+   ζ : X' → X'
+   ζ = ∃!-witness v
+
+   φ : (ζ' : X' → X') → ζ' ∘ η ＝ η → ζ ＝ ζ'
+   φ ζ' p = ap pr₁ (∃!-uniqueness' v (ζ' , p))
+
+   p₀ : θ ∘ η ＝ id
+   p₀ = ∃!-is-witness u
+
+   p₁ : η ∘ θ ∘ η ＝ η
+   p₁ = ap (η ∘_) p₀
+
+   p₂ : ζ ＝ η ∘ θ
+   p₂ = φ (η ∘ θ) p₁
+
+   p₃ : ζ ＝ id
+   p₃ = φ id refl
+
+   p₄ = η ∘ θ ＝⟨ p₂ ⁻¹ ⟩
+        ζ     ＝⟨ p₃ ⟩
+        id    ∎
+
+ tight-η-equiv-direct : is-tight _♯_ → X ≃ X'
+ tight-η-equiv-direct t = (η , vv-equivs-are-equivs η cm)
+  where
+   lc : left-cancellable η
+   lc {x} {y} p = j h
+    where
+     j : ¬ (η x ♯' η y) → x ＝ y
+     j = t x y ∘ contrapositive (η-preserves-apartness {x} {y})
+
+     h : ¬ (η x ♯' η y)
+     h a = ♯'i (η y) (transport (λ - → - ♯' η y) p a)
+
+   e : is-embedding η
+   e = lc-maps-into-sets-are-embeddings η lc X'-is-set
+
+   cm : is-vv-equiv η
+   cm = surjective-embeddings-are-vv-equivs η e η-is-surjection
+
+\end{code}
+
+TODO.
+
+* The tight reflection has the universal property of the quotient by
+  _~_. Conversely, the quotient by _~_ gives the tight reflection.
+
+* The tight reflection of ♯₂ has the universal property of the totally
+  separated reflection.
+
+* If a type Y has an apartness with y₀ ♯ y₁, then
+  the function type (X → Y) has an apartness
+
+    f ♯ g := ∃ x ꞉ X , f x ♯ g x
+
+  that tells apart the constant functions with values y₀ and y₁
+  respectively.
diff --git a/source/Apartness/index.lagda b/source/Apartness/index.lagda
new file mode 100644
index 000000000..9bc770ce9
--- /dev/null
+++ b/source/Apartness/index.lagda
@@ -0,0 +1,19 @@
+Martin Escardo, 26 January 2018
+
+Moved from the file TotallySeparated 22 August 2024, and split into
+the following modules.
+
+\begin{code}
+
+{-# OPTIONS --safe --without-K #-}
+
+module Apartness.index where
+
+import Apartness.Definition
+import Apartness.Examples
+import Apartness.Morphisms
+import Apartness.NegationOfApartness
+import Apartness.Properties
+import Apartness.TightReflection
+
+\end{code}
diff --git a/source/BinarySystems/InitialBinarySystem.lagda b/source/BinarySystems/InitialBinarySystem.lagda
index 0d2c87fb8..c794db0a1 100644
--- a/source/BinarySystems/InitialBinarySystem.lagda
+++ b/source/BinarySystems/InitialBinarySystem.lagda
@@ -1151,7 +1151,6 @@ We now need to assume function extensionality.
 
 open import UF.Base
 open import UF.FunExt
-open import UF.Subsingletons-FunExt
 
 module _ (fe  : Fun-Ext) where
 
diff --git a/source/BinarySystems/InitialBinarySystem2.lagda b/source/BinarySystems/InitialBinarySystem2.lagda
index e0b24c85c..bb1a93af8 100644
--- a/source/BinarySystems/InitialBinarySystem2.lagda
+++ b/source/BinarySystems/InitialBinarySystem2.lagda
@@ -773,7 +773,6 @@ We now need to assume function extensionality.
 
 open import UF.Base
 open import UF.FunExt
-open import UF.Subsingletons-FunExt
 
 module _ (fe  : Fun-Ext) where
 
diff --git a/source/CantorSchroederBernstein/CSB-TheoryLabLunch.lagda b/source/CantorSchroederBernstein/CSB-TheoryLabLunch.lagda
index 976c11957..090418356 100644
--- a/source/CantorSchroederBernstein/CSB-TheoryLabLunch.lagda
+++ b/source/CantorSchroederBernstein/CSB-TheoryLabLunch.lagda
@@ -167,7 +167,6 @@ module CantorSchroederBernstein.CSB-TheoryLabLunch where
 open import CoNaturals.Type
 open import MLTT.Plus-Properties
 open import MLTT.Spartan
-open import NotionsOfDecidability.Decidable
 open import TypeTopology.CompactTypes
 open import TypeTopology.GenericConvergentSequenceCompactness
 open import UF.Embeddings
diff --git a/source/CantorSchroederBernstein/CSB.lagda b/source/CantorSchroederBernstein/CSB.lagda
index 6078f3960..b9479c30f 100644
--- a/source/CantorSchroederBernstein/CSB.lagda
+++ b/source/CantorSchroederBernstein/CSB.lagda
@@ -49,7 +49,6 @@ open import CoNaturals.Type
 open import MLTT.Plus-Properties
 open import MLTT.Spartan
 open import Naturals.Properties
-open import NotionsOfDecidability.Decidable
 open import TypeTopology.CompactTypes
 open import TypeTopology.GenericConvergentSequenceCompactness
 open import UF.Base
diff --git a/source/Cardinals/Preorder.lagda b/source/Cardinals/Preorder.lagda
index eda4c0d9c..86f4c04ff 100644
--- a/source/Cardinals/Preorder.lagda
+++ b/source/Cardinals/Preorder.lagda
@@ -6,14 +6,10 @@ Jon Sterling, 25th March 2023.
 
 open import MLTT.Spartan
 open import UF.Base
-open import UF.Equiv
 open import UF.FunExt
 open import UF.PropTrunc
-open import UF.Retracts
 open import UF.SetTrunc
-open import UF.Size
 open import UF.Subsingletons
-import Various.LawvereFPT as LFTP
 
 module Cardinals.Preorder
  (fe : FunExt)
@@ -23,7 +19,12 @@ module Cardinals.Preorder
  where
 
 open import UF.Embeddings
+open import UF.Sets
+open import UF.Sets-Properties
 open import UF.Subsingletons-FunExt
+open import UF.Subsingletons-Properties
+open import UF.SubtypeClassifier
+open import UF.SubtypeClassifier-Properties
 open import Cardinals.Type st
 
 import UF.Logic
@@ -118,12 +119,8 @@ module _ {A : hSet 𝓤} {B : hSet 𝓥} where
 
 
 module _ {𝓤} where
- ⊥ : Ω 𝓤
- pr₁ ⊥ = 𝟘
- pr₂ ⊥ = 𝟘-is-prop
-
  Ω¬_ : Ω 𝓤 → Ω 𝓤
- Ω¬ ϕ = ϕ ⇒ ⊥
+ Ω¬ ϕ = ϕ ⇒ ⊥ {𝓤}
 
 _<_ : Card 𝓤 → Card 𝓥 → Ω (𝓤 ⊔ 𝓥)
 α < β = (α ≤ β) ∧ (Ω¬ (β ≤ α))
diff --git a/source/Cardinals/Successor.lagda b/source/Cardinals/Successor.lagda
index 41bc78f73..cd32bcac7 100644
--- a/source/Cardinals/Successor.lagda
+++ b/source/Cardinals/Successor.lagda
@@ -1,7 +1,7 @@
 Jon Sterling, 25th March 2023.
 
 The HoTT book shows that under excluded middle, there are weak successor
-cardinals.  I show that under suitable propositional resizing assumptions, this
+cardinals. I show that under suitable propositional resizing assumptions, this
 holds constructively.
 
 \begin{code}
@@ -11,14 +11,11 @@ holds constructively.
 open import MLTT.Spartan
 open import UF.Base
 open import UF.Equiv
-open import UF.Equiv-FunExt
 open import UF.FunExt
 open import UF.PropTrunc
-open import UF.Retracts
 open import UF.SetTrunc
 open import UF.Size
 open import UF.Subsingletons
-import Various.LawvereFPT as LFTP
 
 module Cardinals.Successor
  (fe : FunExt)
@@ -29,9 +26,15 @@ module Cardinals.Successor
  where
 
 open import UF.Embeddings
+open import UF.Sets
+open import UF.Sets-Properties
 open import UF.Subsingletons-FunExt
+open import UF.Subsingletons-Properties
+open import UF.SubtypeClassifier
+open import UF.SubtypeClassifier-Properties
 open import Cardinals.Type st
 open import Cardinals.Preorder fe pe st pt
+open import Various.CantorTheoremForEmbeddings
 
 import UF.Logic
 
@@ -114,7 +117,7 @@ pr₂ (pr₂ ([weak-successor] A)) H =
  where
   main : ((underlying-set A → Ω 𝓤) ↪ underlying-set A) → 𝟘
   main ι =
-   LFTP.retract-version.cantor-theorem-for-embeddings fe pe psz
+   cantor-theorem-for-embeddings fe pe psz
     (underlying-set A)
     ι'
     ι'-emb
diff --git a/source/Cardinals/Type.lagda b/source/Cardinals/Type.lagda
index ff67a3e6b..7a6c75e7a 100644
--- a/source/Cardinals/Type.lagda
+++ b/source/Cardinals/Type.lagda
@@ -6,12 +6,10 @@ Jon Sterling, 25th March 2023.
 
 open import MLTT.Spartan
 open import UF.SetTrunc
-open import UF.Subsingletons
 
 module Cardinals.Type (st : set-truncations-exist) where
 
-open import UF.Embeddings
-open import UF.Subsingletons-FunExt
+open import UF.Sets
 
 import UF.Logic
 
diff --git a/source/Categories/Adjunction.lagda b/source/Categories/Adjunction.lagda
index 7f7f3b017..29eea28d6 100644
--- a/source/Categories/Adjunction.lagda
+++ b/source/Categories/Adjunction.lagda
@@ -9,12 +9,7 @@ open import UF.FunExt
 module Categories.Adjunction (fe : Fun-Ext) where
 
 open import MLTT.Spartan
-open import UF.Base
-open import UF.Equiv
-open import UF.Retracts
 open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
-open import UF.Equiv-FunExt
 
 open import Categories.Category fe
 open import Categories.Functor fe
diff --git a/source/Categories/Functor.lagda b/source/Categories/Functor.lagda
index 408475a07..95fb88812 100644
--- a/source/Categories/Functor.lagda
+++ b/source/Categories/Functor.lagda
@@ -9,11 +9,9 @@ open import UF.FunExt
 module Categories.Functor (fe : Fun-Ext) where
 
 open import MLTT.Spartan
-open import UF.Base
 open import UF.Equiv
 open import UF.Subsingletons
 open import UF.Subsingletons-FunExt
-open import UF.Equiv-FunExt
 
 open import Categories.Category fe
 
diff --git a/source/Circle/Integers-Properties.lagda b/source/Circle/Integers-Properties.lagda
index feb4e5a19..a52aa0742 100644
--- a/source/Circle/Integers-Properties.lagda
+++ b/source/Circle/Integers-Properties.lagda
@@ -9,7 +9,6 @@ Earlier version: 18 September 2020
 open import Circle.Integers
 
 open import MLTT.Spartan
-open import UF.Base
 open import UF.DiscreteAndSeparated
 open import UF.Equiv
 open import UF.Sets
diff --git a/source/Circle/Integers-SymmetricInduction.lagda b/source/Circle/Integers-SymmetricInduction.lagda
index 51a70dde0..075b62393 100644
--- a/source/Circle/Integers-SymmetricInduction.lagda
+++ b/source/Circle/Integers-SymmetricInduction.lagda
@@ -18,7 +18,6 @@ open import Circle.Integers
 open import Circle.Integers-Properties
 
 open import MLTT.Spartan
-open import UF.Base
 open import UF.Embeddings
 open import UF.Equiv
 open import UF.EquivalenceExamples
diff --git a/source/Circle/Integers.lagda b/source/Circle/Integers.lagda
index 03e7a2769..c4653fc48 100644
--- a/source/Circle/Integers.lagda
+++ b/source/Circle/Integers.lagda
@@ -15,7 +15,6 @@ the type of integers.
 {-# OPTIONS --safe --without-K #-}
 
 open import MLTT.Spartan
-open import UF.Base
 
 module Circle.Integers where
 
diff --git a/source/CoNaturals/Arithmetic.lagda b/source/CoNaturals/Arithmetic.lagda
index 8a41362cb..4d14b3247 100644
--- a/source/CoNaturals/Arithmetic.lagda
+++ b/source/CoNaturals/Arithmetic.lagda
@@ -37,7 +37,6 @@ open import CoNaturals.Type renaming (min to min')
 open import CoNaturals.UniversalProperty fe
 open import Notation.Order
 open import Notation.CanonicalMap
-open import UF.Base
 
 \end{code}
 
diff --git a/source/CoNaturals/Cantor.lagda b/source/CoNaturals/Cantor.lagda
deleted file mode 100644
index b909c37e9..000000000
--- a/source/CoNaturals/Cantor.lagda
+++ /dev/null
@@ -1,17 +0,0 @@
-Martin Escardo.
-
-This short module is to avoid a chain of imports.
-
-\begin{code}
-
-{-# OPTIONS --safe --without-K #-}
-
-module CoNaturals.Cantor where
-
-open import MLTT.Spartan
-
-cons : 𝟚 → (ℕ → 𝟚) → (ℕ → 𝟚)
-cons b α 0        = b
-cons b α (succ n) = α n
-
-\end{code}
diff --git a/source/CoNaturals/Equivalence.lagda b/source/CoNaturals/Equivalence.lagda
index 70e9c4cf0..b36a7007c 100644
--- a/source/CoNaturals/Equivalence.lagda
+++ b/source/CoNaturals/Equivalence.lagda
@@ -18,7 +18,6 @@ Notice that the condition on α can be expressed as "is-prop (fiber α ₁)".
 
 module CoNaturals.Equivalence where
 
-open import CoNaturals.Cantor
 open import CoNaturals.GenericConvergentSequence
 open import CoNaturals.GenericConvergentSequence2
 open import MLTT.Spartan
@@ -27,6 +26,7 @@ open import Naturals.Order
 open import Naturals.Properties
 open import Notation.CanonicalMap
 open import Notation.Order
+open import TypeTopology.Cantor
 open import UF.Equiv
 open import UF.FunExt
 open import UF.Subsingletons
@@ -205,7 +205,7 @@ a suitable induction hypothesis.
 γ-lemma β π n p 0 l = w
  where
   w : complement (β 0) ＝ ₁
-  w = complement-intro₀ (at-most-one-₁-Lemma₁ β π (positive-not-zero n) p)
+  w = complement₁-back (at-most-one-₁-Lemma₁ β π (positive-not-zero n) p)
 
 γ-lemma β π 0 p (succ k) ()
 γ-lemma β π (succ n) p (succ k) l = w
diff --git a/source/CoNaturals/GenericConvergentSequence.lagda b/source/CoNaturals/GenericConvergentSequence.lagda
index baf100e3d..0b6d204b3 100644
--- a/source/CoNaturals/GenericConvergentSequence.lagda
+++ b/source/CoNaturals/GenericConvergentSequence.lagda
@@ -14,13 +14,12 @@ lemmas. More additions after that date.
 
 module CoNaturals.GenericConvergentSequence where
 
-open import CoNaturals.Cantor
 open import MLTT.Spartan
 open import MLTT.Two-Properties
-open import Naturals.Order hiding (max)
 open import Notation.CanonicalMap
 open import Notation.Order
 open import Ordinals.Notions
+open import TypeTopology.Cantor
 open import TypeTopology.Density
 open import TypeTopology.TotallySeparated
 open import UF.Base
@@ -138,7 +137,6 @@ force-decreasing-is-not-much-smaller β (succ n) p = f c
                               (ℕ∞-retract-of-Cantor fe)
                               (Cantor-is-totally-separated fe)
 
-
 Zero : ℕ∞
 Zero = (λ i → ₀) , (λ i → ≤₂-refl {₀})
 
@@ -214,7 +212,7 @@ unique-fixed-point-of-Succ fe u r = ℕ∞-to-ℕ→𝟚-lc fe claim
   lemma 0        = fact 0
   lemma (succ i) = ι u (succ i)        ＝⟨ fact (succ i) ⟩
                    ι (Succ u) (succ i) ＝⟨ lemma i ⟩
-                   ₁                  ∎
+                   ₁                   ∎
 
   claim : ι u ＝ ι ∞
   claim = dfunext fe lemma
@@ -226,7 +224,7 @@ Pred-Zero-is-Zero : Pred Zero ＝ Zero
 Pred-Zero-is-Zero = refl
 
 Pred-Zero-is-Zero' : (u : ℕ∞) → u ＝ Zero → Pred u ＝ u
-Pred-Zero-is-Zero' u p = transport (λ - → Pred - ＝ -) (p ⁻¹) Pred-Zero-is-Zero
+Pred-Zero-is-Zero' u refl = Pred-Zero-is-Zero
 
 Pred-Succ : {u : ℕ∞} → Pred (Succ u) ＝ u
 Pred-Succ {u} = refl
@@ -248,7 +246,7 @@ instance
 _≣_ : ℕ∞ → ℕ → 𝓤₀ ̇
 u ≣ n = u ＝ ι n
 
-ℕ-to-ℕ∞-lc : left-cancellable ι
+ℕ-to-ℕ∞-lc : left-cancellable ℕ-to-ℕ∞
 ℕ-to-ℕ∞-lc {0}      {0}      r = refl
 ℕ-to-ℕ∞-lc {0}      {succ n} r = 𝟘-elim (Zero-not-Succ r)
 ℕ-to-ℕ∞-lc {succ m} {0}      r = 𝟘-elim (Zero-not-Succ (r ⁻¹))
@@ -281,7 +279,8 @@ is-Zero-equal-Zero fe {u} base = ℕ∞-to-ℕ→𝟚-lc fe (dfunext fe lemma)
   lemma (succ i) = [a＝₁→b＝₁]-gives-[b＝₀→a＝₀]
                     (≤₂-criterion-converse (pr₂ u i)) (lemma i)
 
-same-positivity : funext₀ → (u v : ℕ∞)
+same-positivity : funext₀
+                → (u v : ℕ∞)
                 → (u ＝ Zero → v ＝ Zero)
                 → (v ＝ Zero → u ＝ Zero)
                 → positivity u ＝ positivity v
@@ -327,6 +326,37 @@ is-Succ u = Σ w ꞉ ℕ∞ , u ＝ Succ w
 Zero+Succ : funext₀ → (u : ℕ∞) → (u ＝ Zero) + is-Succ u
 Zero+Succ fe₀ u = Cases (Zero-or-Succ fe₀ u) inl (λ p → inr (Pred u , p))
 
+module _ (fe : funext₀)
+         {X : 𝓤 ̇ }
+         (x₀ : X)
+         (f : ℕ∞ → X)
+       where
+
+ private
+  φ : (x : ℕ∞) → (x ＝ Zero) + is-Succ x → X
+  φ x (inl _)        = x₀
+  φ x (inr (x' , _)) = f x'
+
+  φ-property-Zero : (c : (Zero ＝ Zero) + is-Succ Zero)
+                  → φ Zero c ＝ x₀
+  φ-property-Zero (inl p) = refl
+  φ-property-Zero (inr (x , p)) = 𝟘-elim (Succ-not-Zero (p ⁻¹))
+
+  φ-property-Succ : (u : ℕ∞)
+                    (c : (Succ u ＝ Zero) + is-Succ (Succ u))
+                   → φ (Succ u) c ＝ f u
+  φ-property-Succ u (inl p)       = 𝟘-elim (Succ-not-Zero p)
+  φ-property-Succ u (inr (x , p)) = ap f (Succ-lc (p ⁻¹))
+
+ ℕ∞-cases : ℕ∞ → X
+ ℕ∞-cases u = φ u (Zero+Succ fe u)
+
+ ℕ∞-cases-Zero : ℕ∞-cases Zero ＝ x₀
+ ℕ∞-cases-Zero = φ-property-Zero (Zero+Succ fe Zero)
+
+ ℕ∞-cases-Succ : (u : ℕ∞) → ℕ∞-cases (Succ u) ＝ f u
+ ℕ∞-cases-Succ u = φ-property-Succ u (Zero+Succ fe (Succ u))
+
 Succ-criterion : funext₀
                → {u : ℕ∞} {n : ℕ}
                → n ⊏ u
@@ -632,12 +662,81 @@ max (α , r) (β , s) = (λ i → max𝟚 (α i) (β i)) , t
   t : is-decreasing (λ i → max𝟚 (α i) (β i))
   t i = max𝟚-preserves-≤ (r i) (s i)
 
+max-comm : funext₀ → (u v : ℕ∞) → max u v ＝ max v u
+max-comm fe u v = ℕ∞-to-ℕ→𝟚-lc fe (dfunext fe (λ i → max𝟚-comm (ι u i) (ι v i)))
+
+max0-property : (u : ℕ∞) → max Zero u ＝ u
+max0-property u = refl
+
+max0-property' : funext₀ → (u : ℕ∞) → max u Zero ＝ u
+max0-property' fe u = max u Zero ＝⟨ max-comm fe u Zero ⟩
+                      max Zero u ＝⟨ max0-property u ⟩
+                      u       ∎
+
+max∞-property : (u : ℕ∞) → max ∞ u ＝ ∞
+max∞-property u = refl
+
+max∞-property' : funext₀ → (u : ℕ∞) → max u ∞ ＝ ∞
+max∞-property' fe u = max u ∞ ＝⟨ max-comm fe u ∞ ⟩
+                      max ∞ u ＝⟨ max∞-property u ⟩
+                      ∞       ∎
+
+open import Naturals.Order renaming (max to maxℕ ; max-idemp to maxℕ-idemp)
+
+max-Succ : funext₀ → (u v : ℕ∞) → Succ (max u v) ＝ max (Succ u) (Succ v)
+max-Succ fe u v = ℕ∞-to-ℕ→𝟚-lc fe (dfunext fe f)
+ where
+  f : (i : ℕ)
+    → cons ₁ (λ j → max𝟚 (ι u j) (ι v j)) i
+    ＝ max𝟚 (cons ₁ (ι u) i) (cons ₁ (ι v) i)
+  f 0        = refl
+  f (succ i) = refl
+
+max-succ : funext₀ → (m : ℕ) → max (ι m) (ι (succ m)) ＝ ι (succ m)
+max-succ fe 0        = refl
+max-succ fe (succ m) =
+ max (ι (succ m)) (ι (succ (succ m))) ＝⟨ (max-Succ fe (ι m) (ι (succ m)))⁻¹ ⟩
+ Succ (max (ι m) (ι (succ m)))        ＝⟨ ap Succ (max-succ fe m) ⟩
+ Succ (ι (succ m))                    ＝⟨ refl ⟩
+ ι (succ (succ m))                    ∎
+
+max-fin : funext₀ → (m n : ℕ) → ι (maxℕ m n) ＝ max (ι m) (ι n)
+max-fin fe 0 n = (max0-property (ι n))⁻¹
+max-fin fe (succ m) 0 = max0-property' fe (ι (succ m)) ⁻¹
+max-fin fe (succ m) (succ n) =
+ ι (maxℕ (succ m) (succ n))    ＝⟨ refl ⟩
+ ι (succ (maxℕ m n))           ＝⟨ refl ⟩
+ Succ (ι (maxℕ m n))           ＝⟨ ap Succ (max-fin fe m n) ⟩
+ Succ (max (ι m) (ι n))        ＝⟨ max-Succ fe (ι m) (ι n) ⟩
+ max (Succ (ι m)) (Succ (ι n)) ＝⟨ refl ⟩
+ max (ι (succ m)) (ι (succ n)) ∎
+
+max-idemp : funext₀ → (u : ℕ∞) → max u u ＝ u
+max-idemp fe₀ u = ℕ∞-to-ℕ→𝟚-lc fe₀ (dfunext fe₀ (λ i → max𝟚-idemp (ι u i)))
+
 min : ℕ∞ → ℕ∞ → ℕ∞
 min (α , r) (β , s) = (λ i → min𝟚 (α i) (β i)) , t
  where
   t : is-decreasing (λ i → min𝟚 (α i) (β i))
   t i = min𝟚-preserves-≤ (r i) (s i)
 
+min∞-property : (u : ℕ∞) → min ∞ u ＝ u
+min∞-property u = refl
+
+min-comm : funext₀ → (u v : ℕ∞) → min u v ＝ min v u
+min-comm fe u v = ℕ∞-to-ℕ→𝟚-lc fe (dfunext fe (λ i → min𝟚-comm (ι u i) (ι v i)))
+
+min-idemp : funext₀ → (u : ℕ∞) → min u u ＝ u
+min-idemp fe₀ u = ℕ∞-to-ℕ→𝟚-lc fe₀ (dfunext fe₀ (λ i → min𝟚-idemp (ι u i)))
+
+min0-property : (u : ℕ∞) → min Zero u ＝ Zero
+min0-property u = refl
+
+min0-property' : funext₀ → (u : ℕ∞) → min u Zero ＝ Zero
+min0-property' fe u = min u Zero ＝⟨ min-comm fe u Zero ⟩
+                      min Zero u ＝⟨ min0-property u ⟩
+                      Zero       ∎
+
 \end{code}
 
 More lemmas about order should be added, but I will do this on demand
@@ -764,7 +863,7 @@ finite-accessible = course-of-values-induction (λ n → is-accessible _≺_ (ι
   γ = ℕ∞-to-ℕ→𝟚-lc fe (dfunext fe h)
 
 ℕ∞-ordinal : funext₀ → is-well-order _≺_
-ℕ∞-ordinal fe = (≺-prop-valued fe) , ≺-well-founded , ≺-extensional fe , ≺-trans
+ℕ∞-ordinal fe = ≺-prop-valued fe , ≺-well-founded , ≺-extensional fe , ≺-trans
 
 \end{code}
 
@@ -899,7 +998,7 @@ stronger fact, proved above, that ≺ is well founded:
 \end{code}
 
 Added 25 June 2018. This may be placed somewhere else in the future.
-Another version of N∞, to be investigated.
+A variation of ℕ∞, to be investigated.
 
 \begin{code}
 
diff --git a/source/CoNaturals/GenericConvergentSequence2.lagda b/source/CoNaturals/GenericConvergentSequence2.lagda
index 0a756b1e5..ad9bb5d6b 100644
--- a/source/CoNaturals/GenericConvergentSequence2.lagda
+++ b/source/CoNaturals/GenericConvergentSequence2.lagda
@@ -9,13 +9,10 @@ The isomorphism is proved in CoNaturals.Equivalence.
 
 module CoNaturals.GenericConvergentSequence2 where
 
-open import CoNaturals.Cantor
 open import MLTT.Spartan
 open import MLTT.Two-Properties
-open import Naturals.Order hiding (max)
-open import Naturals.Properties
 open import Notation.CanonicalMap
-open import Notation.Order
+open import TypeTopology.Cantor
 open import UF.DiscreteAndSeparated
 open import UF.FunExt
 open import UF.NotNotStablePropositions
diff --git a/source/CoNaturals/Sharp.lagda b/source/CoNaturals/Sharp.lagda
index 7069d9054..b40633ba6 100644
--- a/source/CoNaturals/Sharp.lagda
+++ b/source/CoNaturals/Sharp.lagda
@@ -44,7 +44,6 @@ open import NotionsOfDecidability.Decidable
 open import UF.DiscreteAndSeparated
 open import UF.Embeddings
 open import UF.Equiv
-open import UF.FunExt
 open import UF.PropTrunc
 open import UF.Subsingletons-FunExt
 
@@ -313,10 +312,10 @@ only-sharp-is-sharp y@(P , φ , P-is-prop) y-is-sharp = V
   α = indicator-map y-is-sharp'
 
   α-property₀ : (n : ℕ) → α n ＝ ₀ → ¬ (ι n ⊑ y)
-  α-property₀ = indicator₀ y-is-sharp'
+  α-property₀ = indicator-property₀ y-is-sharp'
 
   α-property₁ : (n : ℕ) → α n ＝ ₁ → ι n ⊑ y
-  α-property₁ = indicator₁ y-is-sharp'
+  α-property₁ = indicator-property₁ y-is-sharp'
 
   α-property : (n n' : ℕ) → α n ＝ ₁ → α n' ＝ ₁ → n ＝ n'
   α-property n n' e e' = η-bounded y n n' (α-property₁ n e) (α-property₁ n' e')
diff --git a/source/CoNaturals/Type.lagda b/source/CoNaturals/Type.lagda
index 07ee2b519..99c99ec5e 100644
--- a/source/CoNaturals/Type.lagda
+++ b/source/CoNaturals/Type.lagda
@@ -1,3 +1,7 @@
+Martin Escardo 2024.
+
+Interface file. Please use this rather than the 2012 file imported below.
+
 \begin{code}
 
 {-# OPTIONS --safe --without-K #-}
diff --git a/source/CoNaturals/Type2Properties.lagda b/source/CoNaturals/Type2Properties.lagda
index c45f7e3b8..155bb2d55 100644
--- a/source/CoNaturals/Type2Properties.lagda
+++ b/source/CoNaturals/Type2Properties.lagda
@@ -6,24 +6,17 @@ Martin Escardo, November 2023.
 
 module CoNaturals.Type2Properties where
 
-open import CoNaturals.Cantor
 open import CoNaturals.Type hiding (is-finite')
 open import CoNaturals.GenericConvergentSequence2
 open import CoNaturals.Equivalence
 open import MLTT.Spartan
 open import MLTT.Two-Properties
-open import Naturals.Order hiding (max)
-open import Naturals.Properties
 open import Notation.CanonicalMap
-open import Notation.Order
-open import UF.Base
+open import TypeTopology.Cantor
 open import UF.DiscreteAndSeparated
 open import UF.Equiv
 open import UF.FunExt
-open import UF.NotNotStablePropositions
-open import UF.Sets
 open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 
 private
  T = T-cantor
diff --git a/source/CoNaturals/index.lagda b/source/CoNaturals/index.lagda
index 32f040e50..cf3af3aaa 100644
--- a/source/CoNaturals/index.lagda
+++ b/source/CoNaturals/index.lagda
@@ -7,14 +7,13 @@ Martin Escardo
 module CoNaturals.index where
 
 import CoNaturals.Type                        -- The type of conatural numbers.
-import CoNaturals.UniversalProperty
 import CoNaturals.Type2                       -- An equivalent copy.
+import CoNaturals.UniversalProperty
 import CoNaturals.Equivalence
 import CoNaturals.Type2Properties
 import CoNaturals.BothTypes
 import CoNaturals.Arithmetic
 import CoNaturals.Exercise                    -- With Chuangjie Xu.
-import CoNaturals.Cantor
 import CoNaturals.GenericConvergentSequence   -- Avoid to import directly.
 import CoNaturals.GenericConvergentSequence2  -- Avoid to import directly.
 import CoNaturals.Sharp
diff --git a/source/ContinuityAxiom/ExitingTruncations.lagda b/source/ContinuityAxiom/ExitingTruncations.lagda
index e2bc31c45..703526df1 100644
--- a/source/ContinuityAxiom/ExitingTruncations.lagda
+++ b/source/ContinuityAxiom/ExitingTruncations.lagda
@@ -28,7 +28,6 @@ open import MLTT.Spartan
 open import UF.Base
 open import UF.FunExt
 open import UF.Subsingletons
-open import Naturals.Order using (course-of-values-induction)
 \end{code}
 
 For any P : ℕ → U and n : ℕ, if P(m) is decidable for all m ≤ n, then
diff --git a/source/ContinuityAxiom/FalseWithoutIdentityTypes.lagda b/source/ContinuityAxiom/FalseWithoutIdentityTypes.lagda
index 7c3d7c760..7cac4d270 100644
--- a/source/ContinuityAxiom/FalseWithoutIdentityTypes.lagda
+++ b/source/ContinuityAxiom/FalseWithoutIdentityTypes.lagda
@@ -14,7 +14,6 @@ module ContinuityAxiom.FalseWithoutIdentityTypes where
 
 open import MLTT.Sigma
 open import MLTT.NaturalNumbers
-open import MLTT.Universes
 open import MLTT.Unit
 open import MLTT.Empty
 
diff --git a/source/ContinuityAxiom/Preliminaries.lagda b/source/ContinuityAxiom/Preliminaries.lagda
index 89d4c3c4a..d11155ea1 100644
--- a/source/ContinuityAxiom/Preliminaries.lagda
+++ b/source/ContinuityAxiom/Preliminaries.lagda
@@ -8,7 +8,6 @@ module ContinuityAxiom.Preliminaries where
 
 open import MLTT.Plus-Properties
 open import MLTT.Spartan
-open import NotionsOfDecidability.Decidable
 open import UF.Subsingletons
 
 \end{code}
diff --git a/source/ContinuityAxiom/UniformContinuity.lagda b/source/ContinuityAxiom/UniformContinuity.lagda
index 87c712010..674564645 100644
--- a/source/ContinuityAxiom/UniformContinuity.lagda
+++ b/source/ContinuityAxiom/UniformContinuity.lagda
@@ -21,8 +21,6 @@ open import ContinuityAxiom.ExitingTruncations
 open import ContinuityAxiom.Preliminaries
 open import MLTT.Spartan
 open import MLTT.Two-Properties
-open import Naturals.Properties
-open import NotionsOfDecidability.Decidable
 open import UF.DiscreteAndSeparated
 open import UF.FunExt
 open import UF.Subsingletons
diff --git a/source/CrossedModules/CrossedModules.lagda b/source/CrossedModules/CrossedModules.lagda
index 5f86e8529..e87928a4f 100644
--- a/source/CrossedModules/CrossedModules.lagda
+++ b/source/CrossedModules/CrossedModules.lagda
@@ -13,14 +13,12 @@ Revision July 1, 2022
 
 open import MLTT.Spartan hiding ( ₀ ; ₁)
 open import UF.PropTrunc
-open import UF.ImageAndSurjection
 open import UF.FunExt
 open import UF.Subsingletons
 
 open import Groups.Type
 open import Groups.Homomorphisms
 open import Groups.Kernel
-open import Groups.Image
 open import Groups.Cokernel
 
 open import Quotient.Type
diff --git a/source/DedekindReals/Addition.lagda b/source/DedekindReals/Addition.lagda
index 219efb38a..3f4010b46 100644
--- a/source/DedekindReals/Addition.lagda
+++ b/source/DedekindReals/Addition.lagda
@@ -28,7 +28,6 @@ module DedekindReals.Addition
        where
 
 open import DedekindReals.Type fe pe pt
-open import DedekindReals.Order fe pe pt
 open PropositionalTruncation pt
 
 _+_ : ℝ → ℝ → ℝ
@@ -356,7 +355,6 @@ infixl 35 _+_
         III : (a ℚ+ c) < (x + y)
         III = ∣ (a , c) , a<x , c<y , refl ∣
 
-open import Rationals.Multiplication renaming (_*_ to _ℚ*_)
 
 -_ : ℝ → ℝ
 -_ x = (L , R) , inhabited-left-z , inhabited-right-z , rounded-left-z , rounded-right-z , disjoint-z , located-z
diff --git a/source/DedekindReals/Functions.lagda b/source/DedekindReals/Functions.lagda
index 4cf0e8c9b..5a02248fc 100644
--- a/source/DedekindReals/Functions.lagda
+++ b/source/DedekindReals/Functions.lagda
@@ -31,7 +31,6 @@ module DedekindReals.Functions
 
 open PropositionalTruncation pt
 
-open import DedekindReals.Properties fe pe pt
 open import DedekindReals.Type fe pe pt
 open import DedekindReals.Extension fe pe pt
 
diff --git a/source/DedekindReals/Multiplication.lagda b/source/DedekindReals/Multiplication.lagda
index 0882322b2..f708039ed 100644
--- a/source/DedekindReals/Multiplication.lagda
+++ b/source/DedekindReals/Multiplication.lagda
@@ -3,16 +3,11 @@ Andrew Sneap
 \begin{code}
 {-# OPTIONS --safe --without-K #-}
 
-open import MLTT.Spartan renaming (_+_ to _∔_)
 
-open import Notation.Order
 open import UF.PropTrunc
 open import UF.Subsingletons
 open import UF.FunExt
-open import UF.Powerset
 
-open import Rationals.Type
-open import Rationals.Order
 
 module DedekindReals.Multiplication
          (fe : Fun-Ext)
@@ -20,9 +15,6 @@ module DedekindReals.Multiplication
          (pt : propositional-truncations-exist)
        where
 
-open import Rationals.Multiplication renaming (_*_ to _ℚ*_)
-open import Rationals.MinMax
-open import DedekindReals.Type fe pe pt
 open PropositionalTruncation pt
 
 
diff --git a/source/DedekindReals/Properties.lagda b/source/DedekindReals/Properties.lagda
index 7683ca8a7..4096f6d4b 100644
--- a/source/DedekindReals/Properties.lagda
+++ b/source/DedekindReals/Properties.lagda
@@ -9,16 +9,11 @@ In this file, I prove that the Reals are arithmetically located.
 open import MLTT.Spartan renaming (_+_ to _∔_)
 
 open import Notation.Order
-open import UF.Base
 open import UF.PropTrunc
 open import UF.FunExt
 open import UF.Powerset
 open import UF.Subsingletons
-open import Naturals.Properties
-open import Naturals.Order
 open import Rationals.Type
-open import Rationals.Abs
-open import Rationals.Addition
 open import Rationals.Multiplication
 open import Rationals.Negation
 open import Rationals.Order
@@ -30,7 +25,6 @@ module DedekindReals.Properties
   (pt : propositional-truncations-exist)
  where
 open import DedekindReals.Type fe pe pt
-open import MetricSpaces.Rationals fe pe pt
 open import Rationals.Limits fe pe pt
 
 open PropositionalTruncation pt
diff --git a/source/DedekindReals/Type.lagda b/source/DedekindReals/Type.lagda
index d29be8d41..c662698a6 100644
--- a/source/DedekindReals/Type.lagda
+++ b/source/DedekindReals/Type.lagda
@@ -21,7 +21,6 @@ open import UF.Powerset
 open import UF.PropTrunc
 open import UF.Sets
 open import UF.Sets-Properties
-open import UF.SubtypeClassifier-Properties
 open import UF.Subsingletons
 open import UF.Subsingletons-FunExt
 open import UF.Subsingletons-Properties
@@ -179,7 +178,6 @@ disjoint-from-real ((L , R) , _ , _ , _ , _ , disjoint , _) = disjoint
 ℚ-rounded-right₂ : (y : ℚ) (x : ℚ) → Σ q ꞉ ℚ , (q < x) × (y < q) → y < x
 ℚ-rounded-right₂ y x (q , l₁ , l₂) = ℚ<-trans y q x l₂ l₁
 
-open import Notation.Order
 
 _ℚ<ℝ_  : ℚ → ℝ → 𝓤₀ ̇
 p ℚ<ℝ x = p ∈ lower-cut-of x
diff --git a/source/DiscreteGraphicMonoids/AffineMonad.lagda b/source/DiscreteGraphicMonoids/AffineMonad.lagda
index 7447266e2..6a34ec1b6 100644
--- a/source/DiscreteGraphicMonoids/AffineMonad.lagda
+++ b/source/DiscreteGraphicMonoids/AffineMonad.lagda
@@ -96,7 +96,7 @@ module _ {X : 𝓤 ̇ }
        where
         ⦅1⦆ = ap (ι ∘ 𝑓) (·-lemma x xs a)
         ⦅2⦆ = ap ι (homs-preserve-mul (List⁻-DGM X) (List⁻-DGM Y) 𝑓
-                      (extension-is-hom (List⁻-DGM Y) (ι ∘ f)) (η⁻ x) 𝔁𝓼)
+                   (extension-is-hom (List⁻-DGM Y) (ι ∘ f)) (η⁻ x) 𝔁𝓼)
         ⦅3⦆ = ap (λ - → ι (- · 𝑓 𝔁𝓼)) (triangle (List⁻-DGM Y) (ι ∘ f) x)
         ⦅4⦆ = ρ-◦ (ι (f x)) (ι (𝑓 𝔁𝓼))
 
@@ -110,6 +110,13 @@ module _ {X : 𝓤 ̇ }
  unit⁻⁺ : (f : X → List⁻⁺ Y) → ext⁻⁺ f ∘ η⁻⁺ ∼ f
  unit⁻⁺ f x = to-List⁻⁺-＝ (unit⁻ (ι ∘ f) x)
 
+module _ {X : 𝓤 ̇ }
+         {{X-is-discrete' : is-discrete' X}}
+       where
+
+ ext-η⁻⁺ : ext⁻⁺ (η⁻⁺ {𝓤} {X}) ∼ 𝑖𝑑 (List⁻⁺ X)
+ ext-η⁻⁺ 𝑥𝑠 = to-List⁻⁺-＝ (ext⁻-η⁻ (underlying-list⁻ 𝑥𝑠))
+
 module _ {X : 𝓤 ̇ }
          {{X-is-discrete' : is-discrete' X}}
          {Y : 𝓥 ̇ }
diff --git a/source/DiscreteGraphicMonoids/Free.lagda b/source/DiscreteGraphicMonoids/Free.lagda
index 26ecfddbe..d41abc488 100644
--- a/source/DiscreteGraphicMonoids/Free.lagda
+++ b/source/DiscreteGraphicMonoids/Free.lagda
@@ -73,7 +73,7 @@ module free-discrete-graphic-monoid-development
        where
 
  M-is-discrete : is-discrete M
- M-is-discrete = discrete'-gives-discrete M-is-discrete'
+ M-is-discrete = discrete'-gives-discrete
 
  f' : List X → M
  f' []       = e
diff --git a/source/DiscreteGraphicMonoids/LWRDGM.lagda b/source/DiscreteGraphicMonoids/LWRDGM.lagda
index 32ecf158a..101ae7dcf 100644
--- a/source/DiscreteGraphicMonoids/LWRDGM.lagda
+++ b/source/DiscreteGraphicMonoids/LWRDGM.lagda
@@ -31,7 +31,7 @@ module _
 
  private
   d : is-discrete X
-  d = discrete'-gives-discrete d'
+  d = discrete'-gives-discrete
 
  graphical⁻ : graphical (_·_ {𝓤} {X})
  graphical⁻ (xs , a) (ys , b) =
diff --git a/source/DiscreteGraphicMonoids/ListsWithoutRepetitions.lagda b/source/DiscreteGraphicMonoids/ListsWithoutRepetitions.lagda
index add283082..4311eecd8 100644
--- a/source/DiscreteGraphicMonoids/ListsWithoutRepetitions.lagda
+++ b/source/DiscreteGraphicMonoids/ListsWithoutRepetitions.lagda
@@ -21,7 +21,6 @@ open import MLTT.Spartan
 open import Naturals.Order
 open import Notation.CanonicalMap
 open import Notation.Order
-open import NotionsOfDecidability.Decidable
 open import UF.Base
 open import UF.DiscreteAndSeparated
 open import UF.Embeddings
@@ -34,7 +33,7 @@ module _
 
  private
   d : is-discrete X
-  d = discrete'-gives-discrete d'
+  d = discrete'-gives-discrete
 
 \end{code}
 
@@ -395,7 +394,7 @@ module _ {X : 𝓤 ̇ }
 
  private
   d : is-discrete X
-  d = discrete'-gives-discrete d'
+  d = discrete'-gives-discrete
 
  η⁻ : X → List⁻ X
  η⁻ x = (x • []) , refl
@@ -608,7 +607,7 @@ module _ {X : 𝓤 ̇ }
  δ-map : (z : X) (xs : List X)
        → δ (f z) (map f (δ z xs)) ＝ δ (f z) (map f xs)
  δ-map z [] = refl
- δ-map z (x • xs) = h (discrete'-gives-discrete X-is-discrete' z x)
+ δ-map z (x • xs) = h (discrete'-gives-discrete z x)
   where
    h : is-decidable (z ＝ x)
      → δ (f z) (map f (δ z (x • xs))) ＝ δ (f z) (map f (x • xs))
@@ -630,7 +629,7 @@ module _ {X : 𝓤 ̇ }
     δ (f z) (map f (x • xs))       ∎
      where
       I = ap (λ - → δ (f z) (map f -)) (δ-≠ z x xs u)
-      II = g (discrete'-gives-discrete Y-is-discrete' (f z) (f x))
+      II = g (discrete'-gives-discrete (f z) (f x))
        where
         g : is-decidable (f z ＝ f x)
           → δ (f z) (f x • map f (δ z xs)) ＝ δ (f z) (f x • map f xs)
diff --git a/source/DiscreteGraphicMonoids/ListsWithoutRepetitionsMore.lagda b/source/DiscreteGraphicMonoids/ListsWithoutRepetitionsMore.lagda
index 4fcaa900d..004ec847a 100644
--- a/source/DiscreteGraphicMonoids/ListsWithoutRepetitionsMore.lagda
+++ b/source/DiscreteGraphicMonoids/ListsWithoutRepetitionsMore.lagda
@@ -32,7 +32,7 @@ module _
 
  private
   d : is-discrete X
-  d = discrete'-gives-discrete d'
+  d = discrete'-gives-discrete
 
  _∉_ _∈_ : X → List X → 𝓤 ̇
  x ∉ xs = ρ (x • xs) ＝ x • ρ xs
diff --git a/source/DiscreteGraphicMonoids/Monad.lagda b/source/DiscreteGraphicMonoids/Monad.lagda
index 36afa8516..05129de63 100644
--- a/source/DiscreteGraphicMonoids/Monad.lagda
+++ b/source/DiscreteGraphicMonoids/Monad.lagda
@@ -19,7 +19,6 @@ open import DiscreteGraphicMonoids.LWRDGM fe
 open import DiscreteGraphicMonoids.ListsWithoutRepetitions fe
 open import DiscreteGraphicMonoids.Type
 open import MLTT.Spartan
-open import Notation.CanonicalMap
 open import UF.DiscreteAndSeparated
 
 module _ {X : 𝓤 ̇ }
diff --git a/source/DomainTheory/BasesAndContinuity/Bases.lagda b/source/DomainTheory/BasesAndContinuity/Bases.lagda
index ee2f684ad..0c63f67f1 100644
--- a/source/DomainTheory/BasesAndContinuity/Bases.lagda
+++ b/source/DomainTheory/BasesAndContinuity/Bases.lagda
@@ -37,7 +37,6 @@ module DomainTheory.BasesAndContinuity.Bases
 
 open PropositionalTruncation pt
 
-open import UF.Base
 open import UF.Equiv
 open import UF.EquivalenceExamples
 open import UF.Size hiding (is-small ; is-locally-small)
@@ -71,7 +70,7 @@ module _
  ↡-inclusion : (x : ⟨ 𝓓 ⟩) → ↡ᴮ x → ⟨ 𝓓 ⟩
  ↡-inclusion x = β ∘ pr₁
 
- record is-small-basis : 𝓥 ⁺ ⊔ 𝓤 ⊔ 𝓣 ̇  where
+ record is-small-basis : 𝓥 ⁺ ⊔ 𝓤 ⊔ 𝓣 ̇ where
   field
    ≪ᴮ-is-small : (x : ⟨ 𝓓 ⟩) (b : B) → is-small (β b ≪⟨ 𝓓 ⟩ x)
    ↡ᴮ-is-directed : (x : ⟨ 𝓓 ⟩) → is-Directed 𝓓 (↡-inclusion x)
@@ -200,7 +199,7 @@ module _
        where
 
  has-specified-small-basis : 𝓥 ⁺ ⊔ 𝓤 ⊔ 𝓣 ̇
- has-specified-small-basis = Σ B ꞉ 𝓥 ̇  , Σ β ꞉ (B → ⟨ 𝓓 ⟩) , is-small-basis 𝓓 β
+ has-specified-small-basis = Σ B ꞉ 𝓥 ̇ , Σ β ꞉ (B → ⟨ 𝓓 ⟩) , is-small-basis 𝓓 β
 
  has-unspecified-small-basis : 𝓥 ⁺ ⊔ 𝓤 ⊔ 𝓣 ̇
  has-unspecified-small-basis = ∥ has-specified-small-basis ∥
@@ -351,7 +350,7 @@ module _
  ↓-inclusion : (x : ⟨ 𝓓 ⟩) → ↓ᴮ x → ⟨ 𝓓 ⟩
  ↓-inclusion x = β ∘ pr₁
 
- record is-small-compact-basis : 𝓥 ⁺ ⊔ 𝓤 ⊔ 𝓣 ̇  where
+ record is-small-compact-basis : 𝓥 ⁺ ⊔ 𝓤 ⊔ 𝓣 ̇ where
   field
    basis-is-compact : (b : B) → is-compact 𝓓 (β b)
    ⊑ᴮ-is-small : (x : ⟨ 𝓓 ⟩) (b : B) → is-small (β b ⊑⟨ 𝓓 ⟩ x)
@@ -829,7 +828,7 @@ We can refine a small basis to be closed under finite joins.
 
 module _
         (𝓓 : DCPO{𝓤} {𝓣})
-        {B : 𝓥 ̇  }
+        {B : 𝓥 ̇ }
         (β : B → ⟨ 𝓓 ⟩)
         (β-is-basis : is-small-basis 𝓓 β)
         (𝓓-has-finite-joins : has-finite-joins 𝓓)
@@ -837,7 +836,7 @@ module _
 
  open has-finite-joins 𝓓-has-finite-joins
 
- record basis-has-finite-joins : 𝓥 ⊔ 𝓤 ̇  where
+ record basis-has-finite-joins : 𝓥 ⊔ 𝓤 ̇ where
   field
    ⊥ᴮ : B
    _∨ᴮ_ : B → B → B
@@ -866,7 +865,7 @@ module _
 
 module _
         (𝓓 : DCPO{𝓤} {𝓣})
-        {B : 𝓥 ̇  }
+        {B : 𝓥 ̇ }
         (β : B → ⟨ 𝓓 ⟩)
         (β-is-basis : is-small-basis 𝓓 β)
         (𝓓-has-finite-joins : has-finite-joins 𝓓)
@@ -877,7 +876,7 @@ module _
  open has-finite-joins 𝓓-has-finite-joins
 
  refine-basis-to-have-finite-joins :
-  Σ B' ꞉ 𝓥 ̇  , Σ β' ꞉ (B' → ⟨ 𝓓 ⟩) ,
+  Σ B' ꞉ 𝓥 ̇ , Σ β' ꞉ (B' → ⟨ 𝓓 ⟩) ,
   Σ p ꞉ is-small-basis 𝓓 β' , basis-has-finite-joins 𝓓 β' p 𝓓-has-finite-joins
  refine-basis-to-have-finite-joins = B' , β' , p , j
   where
@@ -932,4 +931,4 @@ module _
                       (++-is-binary-sup β l k)
                       (∨-is-sup (β' l) (β' k))
 
-\end{code}
\ No newline at end of file
+\end{code}
diff --git a/source/DomainTheory/BasesAndContinuity/Continuity.lagda b/source/DomainTheory/BasesAndContinuity/Continuity.lagda
index b305223b8..e99ef6e54 100644
--- a/source/DomainTheory/BasesAndContinuity/Continuity.lagda
+++ b/source/DomainTheory/BasesAndContinuity/Continuity.lagda
@@ -24,7 +24,6 @@ module DomainTheory.BasesAndContinuity.Continuity
 
 open PropositionalTruncation pt
 
-open import UF.Base hiding (_≈_)
 open import UF.Equiv
 open import UF.EquivalenceExamples
 
@@ -51,7 +50,7 @@ having to add them as boilerplate.
 
 \begin{code}
 
-record continuity-data  (𝓓 : DCPO {𝓤} {𝓣}) : 𝓥 ⁺ ⊔ 𝓤 ⊔ 𝓣 ̇  where
+record continuity-data  (𝓓 : DCPO {𝓤} {𝓣}) : 𝓥 ⁺ ⊔ 𝓤 ⊔ 𝓣 ̇ where
  field
   index-of-approximating-family : ⟨ 𝓓 ⟩ → 𝓥 ̇
   approximating-family : (x : ⟨ 𝓓 ⟩)
@@ -107,7 +106,7 @@ approximating family is required to consist of compact elements.
 
 \begin{code}
 
-record algebraicity-data (𝓓 : DCPO {𝓤} {𝓣}) : 𝓥 ⁺ ⊔ 𝓤 ⊔ 𝓣 ̇  where
+record algebraicity-data (𝓓 : DCPO {𝓤} {𝓣}) : 𝓥 ⁺ ⊔ 𝓤 ⊔ 𝓣 ̇ where
  field
   index-of-compact-family : ⟨ 𝓓 ⟩ → 𝓥 ̇
   compact-family : (x : ⟨ 𝓓 ⟩) → (index-of-compact-family x) → ⟨ 𝓓 ⟩
@@ -588,4 +587,4 @@ structurally-continuous-+-construction 𝓓 sc =
    eq' : (x : ⟨ 𝓓 ⟩) → ∐ 𝓓 (δ' x) ＝ x
    eq' x = ∐-＝-if-bicofinal 𝓓 lemma₂ lemma₁ (δ' x) (δ x) ∙ eq x
 
-\end{code}
\ No newline at end of file
+\end{code}
diff --git a/source/DomainTheory/BasesAndContinuity/ContinuityDiscussion.lagda b/source/DomainTheory/BasesAndContinuity/ContinuityDiscussion.lagda
index 5cef2544d..648f38837 100644
--- a/source/DomainTheory/BasesAndContinuity/ContinuityDiscussion.lagda
+++ b/source/DomainTheory/BasesAndContinuity/ContinuityDiscussion.lagda
@@ -10,9 +10,9 @@ Johnstone and André Joyal, we discuss the notions
 (1) and (2) are defined in Continuity.lagda and (3) is defined and examined here.
 The notions (1)-(3) have the following shapes:
 
-(1)   Π (x : D) →   Σ I : 𝓥 ̇  , Σ α : I → D , α is-directed × ... × ...
-(2) ∥ Π (x : D) →   Σ I : 𝓥 ̇  , Σ α : I → D , α is-directed × ... × ... ∥
-(3)   Π (x : D) → ∥ Σ I : 𝓥 ̇  , Σ α : I → D , α is-directed × ... × ... ∥
+(1)   Π (x : D) →   Σ I : 𝓥 ̇ , Σ α : I → D , α is-directed × ... × ...
+(2) ∥ Π (x : D) →   Σ I : 𝓥 ̇ , Σ α : I → D , α is-directed × ... × ... ∥
+(3)   Π (x : D) → ∥ Σ I : 𝓥 ̇ , Σ α : I → D , α is-directed × ... × ... ∥
 
 So (2) and (3) are propositions, but (1) isn't. We illustrate (1)-(3) by
 discussion them in terms of left adjoints. In these discussions, the
@@ -76,7 +76,7 @@ using Σ-types.
 structurally-continuous-Σ : (𝓓 : DCPO {𝓤} {𝓣}) → 𝓥 ⁺ ⊔ 𝓤 ⊔ 𝓣 ̇
 structurally-continuous-Σ 𝓓 =
    (x : ⟨ 𝓓 ⟩)
- → Σ I ꞉ 𝓥 ̇  , Σ α ꞉ (I → ⟨ 𝓓 ⟩) , (is-way-upperbound 𝓓 x α)
+ → Σ I ꞉ 𝓥 ̇ , Σ α ꞉ (I → ⟨ 𝓓 ⟩) , (is-way-upperbound 𝓓 x α)
                                  × (Σ δ ꞉ is-Directed 𝓓 α , ∐ 𝓓 δ ＝ x)
 
 
@@ -233,7 +233,7 @@ trying to mimick the proof in Continuity.lagda.
 is-pseudocontinuous-dcpo : (𝓓 : DCPO {𝓤} {𝓣}) → 𝓥 ⁺ ⊔ 𝓤 ⊔ 𝓣 ̇
 is-pseudocontinuous-dcpo 𝓓 =
    (x : ⟨ 𝓓 ⟩)
- → ∥ Σ I ꞉ 𝓥 ̇  , Σ α ꞉ (I → ⟨ 𝓓 ⟩) , (is-way-upperbound 𝓓 x α)
+ → ∥ Σ I ꞉ 𝓥 ̇ , Σ α ꞉ (I → ⟨ 𝓓 ⟩) , (is-way-upperbound 𝓓 x α)
                                    × (Σ δ ꞉ is-Directed 𝓓 α , ∐ 𝓓 δ ＝ x) ∥
 
 being-pseudocontinuous-dcpo-is-prop : (𝓓 : DCPO {𝓤} {𝓣})
@@ -287,7 +287,7 @@ module _
   where
    module construction (x : ⟨ 𝓓 ⟩) where
     str-cont : 𝓥 ⁺ ⊔ 𝓤 ⊔ 𝓣 ̇
-    str-cont = (Σ I ꞉ 𝓥 ̇  , Σ α ꞉ (I → ⟨ 𝓓 ⟩)
+    str-cont = (Σ I ꞉ 𝓥 ̇ , Σ α ꞉ (I → ⟨ 𝓓 ⟩)
                           , is-way-upperbound 𝓓 x α
                           × (Σ δ ꞉ is-Directed 𝓓 α , ∐ 𝓓 δ ＝ x))
     κ : str-cont → Ind
@@ -354,7 +354,7 @@ module _
   ∥∥-functor lemma (η-is-surjection (L x))
    where
     lemma : (Σ σ ꞉ Ind , η σ ＝ L x)
-          → Σ I ꞉ 𝓥 ̇  , Σ α ꞉ (I → ⟨ 𝓓 ⟩) , is-way-upperbound 𝓓 x α
+          → Σ I ꞉ 𝓥 ̇ , Σ α ꞉ (I → ⟨ 𝓓 ⟩) , is-way-upperbound 𝓓 x α
                                           × (Σ δ ꞉ is-Directed 𝓓 α , ∐ 𝓓 δ ＝ x)
     lemma (σ@(I , α , δ) , e) = I , α , pr₂ approx , (δ , pr₁ approx)
      where
diff --git a/source/DomainTheory/BasesAndContinuity/ContinuityImpredicative.lagda b/source/DomainTheory/BasesAndContinuity/ContinuityImpredicative.lagda
index 5b6d373aa..1f17a70d2 100644
--- a/source/DomainTheory/BasesAndContinuity/ContinuityImpredicative.lagda
+++ b/source/DomainTheory/BasesAndContinuity/ContinuityImpredicative.lagda
@@ -27,7 +27,6 @@ module DomainTheory.BasesAndContinuity.ContinuityImpredicative
 
 open PropositionalTruncation pt
 
-open import UF.Base hiding (_≈_)
 open import UF.Equiv
 
 open import UF.Size hiding (is-locally-small; is-small)
diff --git a/source/DomainTheory/BasesAndContinuity/IndCompletion.lagda b/source/DomainTheory/BasesAndContinuity/IndCompletion.lagda
index c5faf772e..0bb9a3bff 100644
--- a/source/DomainTheory/BasesAndContinuity/IndCompletion.lagda
+++ b/source/DomainTheory/BasesAndContinuity/IndCompletion.lagda
@@ -29,7 +29,6 @@ module DomainTheory.BasesAndContinuity.IndCompletion
 
 open PropositionalTruncation pt
 
-open import UF.Base hiding (_≈_)
 open import UF.Equiv
 open import UF.EquivalenceExamples
 open import UF.Subsingletons
@@ -45,7 +44,7 @@ module Ind-completion
        where
 
  Ind : 𝓥 ⁺ ⊔ 𝓤 ⊔ 𝓣 ̇
- Ind = Σ I ꞉ 𝓥 ̇  , Σ α ꞉ (I → ⟨ 𝓓 ⟩) , is-Directed 𝓓 α
+ Ind = Σ I ꞉ 𝓥 ̇ , Σ α ꞉ (I → ⟨ 𝓓 ⟩) , is-Directed 𝓓 α
 
  index-of-underlying-family : Ind → 𝓥 ̇
  index-of-underlying-family = pr₁
diff --git a/source/DomainTheory/BasesAndContinuity/ScottDomain.lagda b/source/DomainTheory/BasesAndContinuity/ScottDomain.lagda
index 2cb09496b..7ce5be4bf 100644
--- a/source/DomainTheory/BasesAndContinuity/ScottDomain.lagda
+++ b/source/DomainTheory/BasesAndContinuity/ScottDomain.lagda
@@ -17,7 +17,6 @@ open import UF.FunExt
 open import UF.Logic
 open import UF.PropTrunc
 open import UF.SubtypeClassifier
-open import UF.Subsingletons
 
 module DomainTheory.BasesAndContinuity.ScottDomain
         (pt : propositional-truncations-exist)
@@ -28,7 +27,6 @@ module DomainTheory.BasesAndContinuity.ScottDomain
 open import Slice.Family
 
 open import DomainTheory.Basics.Dcpo                   pt fe 𝓥
-open import DomainTheory.BasesAndContinuity.Continuity pt fe 𝓥
 open import DomainTheory.BasesAndContinuity.Bases      pt fe 𝓥
 
 open import Locales.Frame hiding (⟨_⟩)
diff --git a/source/DomainTheory/BasesAndContinuity/StepFunctions.lagda b/source/DomainTheory/BasesAndContinuity/StepFunctions.lagda
index 3a79ddaf1..beb93a332 100644
--- a/source/DomainTheory/BasesAndContinuity/StepFunctions.lagda
+++ b/source/DomainTheory/BasesAndContinuity/StepFunctions.lagda
@@ -21,7 +21,6 @@ open import MLTT.Spartan hiding (J)
 open import UF.FunExt
 open import UF.PropTrunc
 
-open import UF.Subsingletons
 
 module DomainTheory.BasesAndContinuity.StepFunctions
         (pt : propositional-truncations-exist)
@@ -31,12 +30,8 @@ module DomainTheory.BasesAndContinuity.StepFunctions
 
 open PropositionalTruncation pt hiding (_∨_)
 
-open import UF.Base hiding (_≈_)
 open import UF.Equiv
-open import UF.EquivalenceExamples
-
 open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 
 open import DomainTheory.Basics.Dcpo pt fe 𝓥
 open import DomainTheory.BasesAndContinuity.Bases pt fe 𝓥
@@ -407,7 +402,7 @@ finite joins.
   𝓔-has-finite-joins : has-finite-joins 𝓔
   𝓔-has-finite-joins = sup-complete-dcpo-has-finite-joins 𝓔 𝓔-is-sup-complete
 
-  refined-basis : Σ B ꞉ 𝓥 ̇  , Σ β ꞉ (B → ⟨ 𝓔 ⟩) ,
+  refined-basis : Σ B ꞉ 𝓥 ̇ , Σ β ꞉ (B → ⟨ 𝓔 ⟩) ,
                   Σ p ꞉ is-small-basis 𝓔 β ,
                   basis-has-finite-joins 𝓔 β p 𝓔-has-finite-joins
   refined-basis = refine-basis-to-have-finite-joins 𝓔 βᴱₚᵣₑ
diff --git a/source/DomainTheory/Basics/Curry.lagda b/source/DomainTheory/Basics/Curry.lagda
index 6f58115cc..3c0c2deb1 100644
--- a/source/DomainTheory/Basics/Curry.lagda
+++ b/source/DomainTheory/Basics/Curry.lagda
@@ -22,7 +22,6 @@ open import DomainTheory.Basics.Dcpo pt fe 𝓥
 open import DomainTheory.Basics.Exponential pt fe 𝓥
 open import DomainTheory.Basics.Miscelanea pt fe 𝓥
 open import DomainTheory.Basics.Pointed pt fe 𝓥
-open import DomainTheory.Basics.FunctionComposition pt fe 𝓥
 open import DomainTheory.Basics.Products pt fe
 open import DomainTheory.Basics.ProductsContinuity pt fe 𝓥
 open import UF.Subsingletons
diff --git a/source/DomainTheory/Basics/Dcpo.lagda b/source/DomainTheory/Basics/Dcpo.lagda
index a2cec67f2..255efa3c1 100644
--- a/source/DomainTheory/Basics/Dcpo.lagda
+++ b/source/DomainTheory/Basics/Dcpo.lagda
@@ -30,7 +30,6 @@ open PropositionalTruncation pt
 open import UF.Subsingletons
 open import UF.Subsingletons-FunExt
 
-open import Naturals.Properties
 open import Naturals.Addition renaming (_+_ to _+'_)
 open import Naturals.Order
 open import Notation.Order
diff --git a/source/DomainTheory/Basics/LeastFixedPoint.lagda b/source/DomainTheory/Basics/LeastFixedPoint.lagda
index fb44a01f2..c054bbf9d 100644
--- a/source/DomainTheory/Basics/LeastFixedPoint.lagda
+++ b/source/DomainTheory/Basics/LeastFixedPoint.lagda
@@ -24,11 +24,7 @@ module DomainTheory.Basics.LeastFixedPoint
 open PropositionalTruncation pt
 
 open import UF.UniverseEmbedding
-open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 
-open import Naturals.Properties
-open import Naturals.Addition renaming (_+_ to _+'_)
 open import Naturals.Order
 open import Notation.Order
 
diff --git a/source/DomainTheory/Basics/Miscelanea.lagda b/source/DomainTheory/Basics/Miscelanea.lagda
index 0f6c75b3e..e5b4ff1f0 100644
--- a/source/DomainTheory/Basics/Miscelanea.lagda
+++ b/source/DomainTheory/Basics/Miscelanea.lagda
@@ -373,7 +373,7 @@ is-embedding-projection-pair 𝓓 𝓔 𝕤@(s , cs) 𝕣@(r , cr) =
 
 record _continuous-retract-of_
         (𝓓 : DCPO {𝓤} {𝓣})
-        (𝓔 : DCPO {𝓤'} {𝓣'}) : 𝓥 ⁺ ⊔ 𝓤 ⊔ 𝓣 ⊔ 𝓤' ⊔ 𝓣' ̇  where
+        (𝓔 : DCPO {𝓤'} {𝓣'}) : 𝓥 ⁺ ⊔ 𝓤 ⊔ 𝓣 ⊔ 𝓤' ⊔ 𝓣' ̇ where
   field
    s : ⟨ 𝓓 ⟩ → ⟨ 𝓔 ⟩
    r : ⟨ 𝓔 ⟩ → ⟨ 𝓓 ⟩
@@ -409,7 +409,7 @@ is-embedding-projection 𝓓 𝓔 ε π =
 
 record embedding-projection-pair-between
         (𝓓 : DCPO {𝓤} {𝓣})
-        (𝓔 : DCPO {𝓤'} {𝓣'}) : 𝓥 ⁺ ⊔ 𝓤 ⊔ 𝓣 ⊔ 𝓤' ⊔ 𝓣' ̇  where
+        (𝓔 : DCPO {𝓤'} {𝓣'}) : 𝓥 ⁺ ⊔ 𝓤 ⊔ 𝓣 ⊔ 𝓤' ⊔ 𝓣' ̇ where
   field
    e : ⟨ 𝓓 ⟩ → ⟨ 𝓔 ⟩
    p : ⟨ 𝓔 ⟩ → ⟨ 𝓓 ⟩
@@ -483,7 +483,7 @@ module _
         (𝓓 : DCPO {𝓤} {𝓣})
        where
 
- record is-locally-small : 𝓥 ⁺ ⊔ 𝓤 ⊔ 𝓣 ̇  where
+ record is-locally-small : 𝓥 ⁺ ⊔ 𝓤 ⊔ 𝓣 ̇ where
   field
    _⊑ₛ_ : ⟨ 𝓓 ⟩ → ⟨ 𝓓 ⟩ → 𝓥 ̇
    ⊑ₛ-≃-⊑ : {x y : ⟨ 𝓓 ⟩} → x ⊑ₛ y ≃ x ⊑⟨ 𝓓 ⟩ y
diff --git a/source/DomainTheory/Basics/ProductsContinuity.lagda b/source/DomainTheory/Basics/ProductsContinuity.lagda
index 7d1e61081..b02b103b8 100644
--- a/source/DomainTheory/Basics/ProductsContinuity.lagda
+++ b/source/DomainTheory/Basics/ProductsContinuity.lagda
@@ -19,8 +19,6 @@ open PropositionalTruncation pt
 open import DomainTheory.Basics.Dcpo pt fe 𝓥
 open import DomainTheory.Basics.Miscelanea pt fe 𝓥
 open import DomainTheory.Basics.Products pt fe
-open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 
 open DcpoProductsGeneral 𝓥
 
diff --git a/source/DomainTheory/Basics/SupComplete.lagda b/source/DomainTheory/Basics/SupComplete.lagda
index bbf3cde08..b5827f216 100644
--- a/source/DomainTheory/Basics/SupComplete.lagda
+++ b/source/DomainTheory/Basics/SupComplete.lagda
@@ -43,7 +43,7 @@ all (small) suprema.
 module _
         (𝓓 : DCPO {𝓤} {𝓣})
        where
- record is-sup-complete : 𝓥 ⁺ ⊔ 𝓤 ⊔ 𝓣 ̇  where
+ record is-sup-complete : 𝓥 ⁺ ⊔ 𝓤 ⊔ 𝓣 ̇ where
   field
    ⋁ : {I : 𝓥 ̇ } (α : I → ⟨ 𝓓 ⟩) → ⟨ 𝓓 ⟩
    ⋁-is-sup : {I : 𝓥 ̇ } (α : I → ⟨ 𝓓 ⟩) → is-sup (underlying-order 𝓓) (⋁ α) α
@@ -72,7 +72,7 @@ module _
  ∨-family x y (inl _) = x
  ∨-family x y (inr _) = y
 
- record has-finite-joins : 𝓤 ⊔ 𝓣 ⊔ 𝓥 ̇  where
+ record has-finite-joins : 𝓤 ⊔ 𝓣 ⊔ 𝓥 ̇ where
   field
    ⊥ : ⟨ 𝓓 ⟩
    ⊥-is-least : is-least (underlying-order 𝓓) ⊥
diff --git a/source/DomainTheory/Examples/IdlDyadics.lagda b/source/DomainTheory/Examples/IdlDyadics.lagda
index 1837accb4..470945ce4 100644
--- a/source/DomainTheory/Examples/IdlDyadics.lagda
+++ b/source/DomainTheory/Examples/IdlDyadics.lagda
@@ -31,7 +31,6 @@ open import DomainTheory.Basics.WayBelow pt fe 𝓤₀
 open import DomainTheory.BasesAndContinuity.Bases pt fe 𝓤₀
 open import DomainTheory.BasesAndContinuity.Continuity pt fe 𝓤₀
 
-open import DomainTheory.IdealCompletion.IdealCompletion pt fe pe 𝓤₀
 open import DomainTheory.IdealCompletion.Properties pt fe pe 𝓤₀
 
 open Ideals-of-small-abstract-basis
diff --git a/source/DomainTheory/Examples/LiftingLargeProposition.lagda b/source/DomainTheory/Examples/LiftingLargeProposition.lagda
index 360d670d7..f6eae9312 100644
--- a/source/DomainTheory/Examples/LiftingLargeProposition.lagda
+++ b/source/DomainTheory/Examples/LiftingLargeProposition.lagda
@@ -18,7 +18,7 @@ module DomainTheory.Examples.LiftingLargeProposition
         (fe : Fun-Ext)
         (pe : Prop-Ext)
         (𝓥 𝓤 : Universe)
-        (P : 𝓤 ̇  )
+        (P : 𝓤 ̇ )
         (P-is-prop : is-prop P)
        where
 
@@ -257,4 +257,4 @@ resizing-gives-small-compact-basis (P₀ , e) =
    scb : has-specified-small-compact-basis (𝓛-DCPO P₀-is-set)
    scb = 𝓛-has-specified-small-compact-basis P₀-is-set
 
-\end{code}
\ No newline at end of file
+\end{code}
diff --git a/source/DomainTheory/Examples/Omega.lagda b/source/DomainTheory/Examples/Omega.lagda
index 1823b3dbf..52dc8c004 100644
--- a/source/DomainTheory/Examples/Omega.lagda
+++ b/source/DomainTheory/Examples/Omega.lagda
@@ -26,19 +26,14 @@ module DomainTheory.Examples.Omega
 open PropositionalTruncation pt
 
 open import MLTT.Plus-Properties
-open import NotionsOfDecidability.Decidable
 
 open import UF.Equiv
-open import UF.EquivalenceExamples
 open import UF.ImageAndSurjection pt
 open import UF.Subsingletons-FunExt
 open import UF.SubtypeClassifier renaming (⊥ to ⊥Ω ; ⊤ to ⊤Ω)
 open import UF.SubtypeClassifier-Properties
-open import UF.Sets
-open import OrderedTypes.Poset fe
 
 open import DomainTheory.Basics.Dcpo pt fe 𝓤
-open import DomainTheory.Basics.Miscelanea pt fe 𝓤
 open import DomainTheory.Basics.Pointed pt fe 𝓤
 open import DomainTheory.Basics.WayBelow pt fe 𝓤
 open import DomainTheory.BasesAndContinuity.Bases pt fe 𝓤
diff --git a/source/DomainTheory/Examples/Ordinals.lagda b/source/DomainTheory/Examples/Ordinals.lagda
index 454ca9873..f905a505b 100644
--- a/source/DomainTheory/Examples/Ordinals.lagda
+++ b/source/DomainTheory/Examples/Ordinals.lagda
@@ -25,7 +25,6 @@ open PropositionalTruncation pt
 
 open import MLTT.List
 
-open import UF.Base
 open import UF.FunExt
 open import UF.Subsingletons
 open import UF.UA-FunExt
@@ -50,7 +49,7 @@ open import DomainTheory.BasesAndContinuity.Bases pt fe 𝓤
 open import DomainTheory.BasesAndContinuity.Continuity pt fe 𝓤
 
 open import Ordinals.Arithmetic fe'
-open import Ordinals.ArithmeticProperties ua
+open import Ordinals.AdditionProperties ua
 open import Ordinals.OrdinalOfOrdinals ua
 open import Ordinals.OrdinalOfOrdinalsSuprema ua
 open import Ordinals.Type
diff --git a/source/DomainTheory/Examples/Powerset.lagda b/source/DomainTheory/Examples/Powerset.lagda
index 2a2c135fb..ba3ae2705 100644
--- a/source/DomainTheory/Examples/Powerset.lagda
+++ b/source/DomainTheory/Examples/Powerset.lagda
@@ -33,11 +33,8 @@ open import UF.Equiv
 open import UF.ImageAndSurjection pt
 open import UF.Powerset
 open import UF.Powerset-Fin pt
-open import UF.Subsingletons-FunExt
 open import UF.SubtypeClassifier
-open import UF.SubtypeClassifier-Properties
 
-open import OrderedTypes.Poset fe
 
 open binary-unions-of-subsets pt
 open canonical-map-from-lists-to-subsets X-is-set
diff --git a/source/DomainTheory/IdealCompletion/IdealCompletion.lagda b/source/DomainTheory/IdealCompletion/IdealCompletion.lagda
index a1f84b17f..e7f49f1e8 100644
--- a/source/DomainTheory/IdealCompletion/IdealCompletion.lagda
+++ b/source/DomainTheory/IdealCompletion/IdealCompletion.lagda
@@ -30,7 +30,6 @@ open import UF.Powerset
 open import UF.Sets
 open import UF.Sets-Properties
 open import UF.SubtypeClassifier
-open import UF.SubtypeClassifier-Properties
 open import UF.Subsingletons-FunExt
 
 open PosetAxioms
diff --git a/source/DomainTheory/IdealCompletion/Properties.lagda b/source/DomainTheory/IdealCompletion/Properties.lagda
index 159593f7b..d747242e2 100644
--- a/source/DomainTheory/IdealCompletion/Properties.lagda
+++ b/source/DomainTheory/IdealCompletion/Properties.lagda
@@ -137,7 +137,7 @@ _≺_ takes values in 𝓥.
 
 \begin{code}
 
-record abstract-basis : 𝓥 ⁺ ̇  where
+record abstract-basis : 𝓥 ⁺ ̇ where
  field
   basis-carrier : 𝓥 ̇
   _≺_ : basis-carrier → basis-carrier → 𝓥 ̇
@@ -147,7 +147,7 @@ record abstract-basis : 𝓥 ⁺ ̇  where
   INT₂ : {y₀ y₁ x : basis-carrier} → y₀ ≺ x → y₁ ≺ x
        → ∃ z ꞉ basis-carrier , y₀ ≺ z × y₁ ≺ z × z ≺ x
 
-record reflexive-abstract-basis : 𝓥 ⁺ ̇  where
+record reflexive-abstract-basis : 𝓥 ⁺ ̇ where
  field
   basis-carrier : 𝓥 ̇
   _≺_ : basis-carrier → basis-carrier → 𝓥 ̇
@@ -603,4 +603,4 @@ Moreover, it is the unique Scott continuous to do so.
                         (to-continuous-function-＝ Idl-DCPO 𝓓
                           (∼-sym (Idl-mediating-map-is-unique' r g c h))))
 
-\end{code}
\ No newline at end of file
+\end{code}
diff --git a/source/DomainTheory/IdealCompletion/Retracts.lagda b/source/DomainTheory/IdealCompletion/Retracts.lagda
index 2d2a7cb18..2f81b16d6 100644
--- a/source/DomainTheory/IdealCompletion/Retracts.lagda
+++ b/source/DomainTheory/IdealCompletion/Retracts.lagda
@@ -53,7 +53,6 @@ open import DomainTheory.Basics.WayBelow pt fe 𝓥
 open import DomainTheory.BasesAndContinuity.Bases pt fe 𝓥
 open import DomainTheory.BasesAndContinuity.Continuity pt fe 𝓥
 
-open import DomainTheory.IdealCompletion.IdealCompletion pt fe pe 𝓥
 open import DomainTheory.IdealCompletion.Properties pt fe pe 𝓥
 
 open PropositionalTruncation pt
diff --git a/source/DomainTheory/Lifting/LiftingDcpo.lagda b/source/DomainTheory/Lifting/LiftingDcpo.lagda
index d7210dbc6..2e6173b20 100644
--- a/source/DomainTheory/Lifting/LiftingDcpo.lagda
+++ b/source/DomainTheory/Lifting/LiftingDcpo.lagda
@@ -28,7 +28,6 @@ open PropositionalTruncation pt
 
 open import UF.Equiv
 open import UF.EquivalenceExamples
-open import UF.ImageAndSurjection pt
 open import UF.Sets
 open import UF.Subsingletons-FunExt
 
diff --git a/source/DomainTheory/Lifting/LiftingSet.lagda b/source/DomainTheory/Lifting/LiftingSet.lagda
index 771e6e91c..b7ae91f99 100644
--- a/source/DomainTheory/Lifting/LiftingSet.lagda
+++ b/source/DomainTheory/Lifting/LiftingSet.lagda
@@ -27,7 +27,6 @@ module DomainTheory.Lifting.LiftingSet
         (pe : propext 𝓣)
        where
 
-open import UF.Base
 open import UF.Equiv
 open import UF.Hedberg
 open import UF.ImageAndSurjection pt
@@ -464,7 +463,7 @@ An equivalence of types induces an isomorphism of pointed dcpos on the liftings.
 
 \begin{code}
 
-𝓛̇-≃ᵈᶜᵖᵒ⊥ : {X : 𝓤 ̇  } {Y : 𝓦 ̇  } (i : is-set X) (j : is-set Y)
+𝓛̇-≃ᵈᶜᵖᵒ⊥ : {X : 𝓤 ̇ } {Y : 𝓦 ̇ } (i : is-set X) (j : is-set Y)
           → X ≃ Y
           → 𝓛-DCPO⊥ i ≃ᵈᶜᵖᵒ⊥ 𝓛-DCPO⊥ j
 𝓛̇-≃ᵈᶜᵖᵒ⊥ i j e = ≃ᵈᶜᵖᵒ-to-≃ᵈᶜᵖᵒ⊥ (𝓛-DCPO⊥ i) (𝓛-DCPO⊥ j) I
@@ -477,9 +476,9 @@ An equivalence of types induces an isomorphism of pointed dcpos on the liftings.
       𝓛̇-continuous i j ⌜ e ⌝ ,
       𝓛̇-continuous j i ⌜ e ⌝⁻¹
 
-𝓛̇-≃ᵈᶜᵖᵒ : {X : 𝓤 ̇  } {Y : 𝓦 ̇  } (i : is-set X) (j : is-set Y)
+𝓛̇-≃ᵈᶜᵖᵒ : {X : 𝓤 ̇ } {Y : 𝓦 ̇ } (i : is-set X) (j : is-set Y)
          → X ≃ Y
          → 𝓛-DCPO i ≃ᵈᶜᵖᵒ 𝓛-DCPO j
 𝓛̇-≃ᵈᶜᵖᵒ i j e = ≃ᵈᶜᵖᵒ⊥-to-≃ᵈᶜᵖᵒ (𝓛-DCPO⊥ i) (𝓛-DCPO⊥ j) (𝓛̇-≃ᵈᶜᵖᵒ⊥ i j e)
 
-\end{code}
\ No newline at end of file
+\end{code}
diff --git a/source/DomainTheory/Lifting/LiftingSetAlgebraic.lagda b/source/DomainTheory/Lifting/LiftingSetAlgebraic.lagda
index 973175671..73ab44146 100644
--- a/source/DomainTheory/Lifting/LiftingSetAlgebraic.lagda
+++ b/source/DomainTheory/Lifting/LiftingSetAlgebraic.lagda
@@ -23,7 +23,6 @@ module DomainTheory.Lifting.LiftingSetAlgebraic
 open import UF.Equiv
 open import UF.ImageAndSurjection pt
 open import UF.Sets
-open import UF.Subsingletons-FunExt
 
 open PropositionalTruncation pt
 
@@ -31,7 +30,6 @@ open import Lifting.Construction 𝓤 hiding (⊥)
 open import Lifting.EmbeddingDirectly 𝓤 hiding (κ)
 open import Lifting.Miscelanea 𝓤
 open import Lifting.Miscelanea-PropExt-FunExt 𝓤 pe fe
-open import Lifting.Monad 𝓤
 
 open import DomainTheory.Basics.Dcpo pt fe 𝓤
 open import DomainTheory.Basics.Miscelanea pt fe 𝓤
@@ -43,7 +41,6 @@ open import DomainTheory.BasesAndContinuity.Continuity pt fe 𝓤
 
 open import DomainTheory.Lifting.LiftingSet pt fe 𝓤 pe
 
-open import OrderedTypes.Poset fe
 
 module _
         {X : 𝓤 ̇ }
diff --git a/source/DomainTheory/Part-I.lagda b/source/DomainTheory/Part-I.lagda
index bbc271d9b..95cdfed2b 100644
--- a/source/DomainTheory/Part-I.lagda
+++ b/source/DomainTheory/Part-I.lagda
@@ -37,7 +37,6 @@ open PropositionalTruncation pt
 open import MLTT.Spartan
 
 open import Naturals.Order hiding (subtraction')
-open import Naturals.Addition renaming (_+_ to _+'_)
 open import Notation.Order hiding (_⊑_ ; _≼_)
 
 open import UF.Base
@@ -59,18 +58,18 @@ Section 2
 
 \begin{code}
 
-Definition-2-1 : (𝓤 : Universe) (X : 𝓥 ̇  ) → 𝓤 ⁺ ⊔ 𝓥 ̇
+Definition-2-1 : (𝓤 : Universe) (X : 𝓥 ̇ ) → 𝓤 ⁺ ⊔ 𝓥 ̇
 Definition-2-1 𝓤 X = X is 𝓤 small
 
 Definition-2-2 : (𝓤 : Universe) → 𝓤 ⁺ ̇
 Definition-2-2 𝓤 = Ω 𝓤
 
-Definition-2-3 : (𝓥 : Universe) (X : 𝓤 ̇  ) → 𝓥 ⁺ ⊔ 𝓤 ̇
+Definition-2-3 : (𝓥 : Universe) (X : 𝓤 ̇ ) → 𝓥 ⁺ ⊔ 𝓤 ̇
 Definition-2-3 𝓥 X = 𝓟 {𝓥} X
 
-Definition-2-4 : (𝓥 : Universe) (X : 𝓤 ̇  )
-               → (X → 𝓟 {𝓥} X → 𝓥 ̇  )
-               × (𝓟 {𝓥} X → 𝓟 {𝓥} X → 𝓥 ⊔ 𝓤 ̇  )
+Definition-2-4 : (𝓥 : Universe) (X : 𝓤 ̇ )
+               → (X → 𝓟 {𝓥} X → 𝓥 ̇ )
+               × (𝓟 {𝓥} X → 𝓟 {𝓥} X → 𝓥 ⊔ 𝓤 ̇ )
 Definition-2-4 𝓥 X = _∈_ , _⊆_
 
 \end{code}
@@ -80,7 +79,7 @@ Section 3
 \begin{code}
 
 module _
-        (P : 𝓤 ̇  ) (_⊑_ : P → P → 𝓣 ̇  )
+        (P : 𝓤 ̇ ) (_⊑_ : P → P → 𝓣 ̇ )
        where
 
  open PosetAxioms
@@ -102,19 +101,19 @@ module _
  module _ (𝓥 : Universe) where
   open import DomainTheory.Basics.Dcpo pt fe 𝓥
 
-  Definition-3-4 : {I : 𝓥 ̇  } → (I → P) → (𝓥 ⊔ 𝓣 ̇  ) × (𝓥 ⊔ 𝓣 ̇  )
+  Definition-3-4 : {I : 𝓥 ̇ } → (I → P) → (𝓥 ⊔ 𝓣 ̇ ) × (𝓥 ⊔ 𝓣 ̇ )
   Definition-3-4 {I} α = is-semidirected _⊑_ α , is-directed _⊑_ α
 
-  Remark-3-5 : {I : 𝓥 ̇  } (α : I → P)
+  Remark-3-5 : {I : 𝓥 ̇ } (α : I → P)
              → is-directed _⊑_ α
              ＝ ∥ I ∥ × ((i j : I) → ∥ Σ k ꞉ I , (α i ⊑ α k) × (α j ⊑ α k) ∥)
   Remark-3-5 α = refl
 
-  Definition-3-6 : {I : 𝓥 ̇  } → P → (I → P) → (𝓥 ⊔ 𝓣 ̇  ) × (𝓤 ⊔ 𝓥 ⊔ 𝓣 ̇  )
+  Definition-3-6 : {I : 𝓥 ̇ } → P → (I → P) → (𝓥 ⊔ 𝓣 ̇ ) × (𝓤 ⊔ 𝓥 ⊔ 𝓣 ̇ )
   Definition-3-6 {I} x α = (is-upperbound _⊑_ x α) , is-sup _⊑_ x α
 
   Definition-3-6-ad : poset-axioms _⊑_
-                    → {I : 𝓥 ̇  } (α : I → P)
+                    → {I : 𝓥 ̇ } (α : I → P)
                     → {x y : P} → is-sup _⊑_ x α → is-sup _⊑_ y α → x ＝ y
   Definition-3-6-ad pa {I} α = sups-are-unique _⊑_ pa α
 
@@ -126,7 +125,7 @@ module _
   Definition-3-7-ad = ∐
 
   Remark-3-8 : poset-axioms _⊑_
-             → {I : 𝓥 ̇  } (α : I → P)
+             → {I : 𝓥 ̇ } (α : I → P)
              → is-prop (has-sup _⊑_ α)
   Remark-3-8 = having-sup-is-prop _⊑_
 
@@ -158,7 +157,7 @@ module _ (𝓥 : Universe) where
  Example-3-14 = Ω-DCPO⊥
 
  module _
-         (X : 𝓤 ̇  )
+         (X : 𝓤 ̇ )
          (X-is-set : is-set X)
         where
 
@@ -168,7 +167,7 @@ module _ (𝓥 : Universe) where
   Example-3-15 = generalized-𝓟-DCPO⊥ 𝓥
 
  module _
-         (X : 𝓥 ̇  )
+         (X : 𝓥 ̇ )
          (X-is-set : is-set X)
         where
 
@@ -245,7 +244,7 @@ Section 4
  Definition-4-8 𝓓 𝓔 f = is-strict 𝓓 𝓔 f
 
  Lemma-4-9 : (𝓓 : DCPO⊥ {𝓤} {𝓣})
-             {I : 𝓥 ̇  } {α : I → ⟪ 𝓓 ⟫}
+             {I : 𝓥 ̇ } {α : I → ⟪ 𝓓 ⟫}
            → is-semidirected (underlying-order (𝓓 ⁻)) α
            → has-sup (underlying-order (𝓓 ⁻)) α
  Lemma-4-9 = semidirected-complete-if-pointed
@@ -321,9 +320,8 @@ Section 5
 
 module _ where
  open import DomainTheory.Basics.Dcpo pt fe 𝓤₀
- open import DomainTheory.Basics.Miscelanea pt fe 𝓤₀
  open import DomainTheory.Taboos.ClassicalLiftingOfNaturalNumbers pt fe
- open import Taboos.LPO (λ 𝓤 𝓥 → fe)
+ open import Taboos.LPO
 
  Proposition-5-1 : is-ω-complete _⊑_ → LPO
  Proposition-5-1 = ℕ⊥-is-ω-complete-gives-LPO
@@ -340,19 +338,19 @@ module _ (𝓥 : Universe) where
  open import Lifting.Monad 𝓥
  open import Lifting.Miscelanea-PropExt-FunExt 𝓥 pe fe
 
- Definition-5-3 : (X : 𝓤 ̇  ) → 𝓥 ⁺ ⊔ 𝓤 ̇
+ Definition-5-3 : (X : 𝓤 ̇ ) → 𝓥 ⁺ ⊔ 𝓤 ̇
  Definition-5-3 X = 𝓛 X
 
- Definition-5-4 : {X : 𝓤 ̇  } → X → 𝓛 X
+ Definition-5-4 : {X : 𝓤 ̇ } → X → 𝓛 X
  Definition-5-4 = η
 
- Definition-5-5 : {X : 𝓤 ̇  } → 𝓛 X
+ Definition-5-5 : {X : 𝓤 ̇ } → 𝓛 X
  Definition-5-5 = ⊥𝓛
 
- Definition-5-6 : {X : 𝓤 ̇  } → 𝓛 X → Ω 𝓥
+ Definition-5-6 : {X : 𝓤 ̇ } → 𝓛 X → Ω 𝓥
  Definition-5-6 l = is-defined l , being-defined-is-prop l
 
- Definition-5-6-ad : {X : 𝓤 ̇  } (l : 𝓛 X) → is-defined l → X
+ Definition-5-6-ad : {X : 𝓤 ̇ } (l : 𝓛 X) → is-defined l → X
  Definition-5-6-ad = value
 
  open import UF.ClassicalLogic
@@ -362,7 +360,7 @@ module _ (𝓥 : Universe) where
  Proposition-5-7-ad : ((X : 𝓤 ̇) → 𝓛 X ≃ 𝟙 + X) → EM 𝓥
  Proposition-5-7-ad = classical-lifting-gives-EM
 
- module _ {X : 𝓤 ̇  } where
+ module _ {X : 𝓤 ̇ } where
 
   Lemma-5-8 : {l m : 𝓛 X} → (l ⋍ m → l ＝ m) × (l ＝ m → l ⋍ m)
   Lemma-5-8 = ⋍-to-＝ , ＝-to-⋍
@@ -371,17 +369,17 @@ module _ (𝓥 : Universe) where
              → (l ＝ m) ≃ (l ⋍· m)
   Remark-5-9 ua = 𝓛-Id· ua fe
 
-  Theorem-5-10 : {Y : 𝓦 ̇  } → (f : X → 𝓛 Y) → 𝓛 X → 𝓛 Y
+  Theorem-5-10 : {Y : 𝓦 ̇ } → (f : X → 𝓛 Y) → 𝓛 X → 𝓛 Y
   Theorem-5-10 f = f ♯
 
   Theorem-5-10-i : η ♯ ∼ id {_} {𝓛 X}
   Theorem-5-10-i l = ⋍-to-＝ (Kleisli-Law₀ l)
 
-  Theorem-5-10-ii : {Y : 𝓦 ̇  } (f : X → 𝓛 Y)
+  Theorem-5-10-ii : {Y : 𝓦 ̇ } (f : X → 𝓛 Y)
                   → f ♯ ∘ η ∼ f
   Theorem-5-10-ii f l = ⋍-to-＝ (Kleisli-Law₁ f l)
 
-  Theorem-5-10-iii : {Y : 𝓦 ̇  } {Z : 𝓣 ̇  }
+  Theorem-5-10-iii : {Y : 𝓦 ̇ } {Z : 𝓣 ̇ }
                      (f : X → 𝓛 Y) (g : Y → 𝓛 Z)
                    → (g ♯ ∘ f) ♯ ∼ g ♯ ∘ f ♯
   Theorem-5-10-iii f g l = (⋍-to-＝ (Kleisli-Law₂ f g l)) ⁻¹
@@ -391,11 +389,11 @@ module _ (𝓥 : Universe) where
 
   -- Remark-5-12: Note that we did not to assume that X is a set in the above.
 
-  Definition-5-13 : {Y : 𝓥 ̇  }
+  Definition-5-13 : {Y : 𝓥 ̇ }
                   → (X → Y) → 𝓛 X → 𝓛 Y
   Definition-5-13 f = 𝓛̇ f
 
-  Definition-5-13-ad : {Y : 𝓥 ̇  } (f : X → Y)
+  Definition-5-13-ad : {Y : 𝓥 ̇ } (f : X → Y)
                      → (η ∘ f) ♯ ∼ 𝓛̇ f
   Definition-5-13-ad f = 𝓛̇-♯-∼ f
 
@@ -422,10 +420,10 @@ module _ (𝓥 : Universe) where
  module _ where
   open import DomainTheory.Lifting.LiftingSet pt fe 𝓥 pe
 
-  Proposition-5-15 : {X : 𝓤 ̇  } → is-set X → DCPO⊥ {𝓥 ⁺ ⊔ 𝓤} {𝓥 ⁺ ⊔ 𝓤}
+  Proposition-5-15 : {X : 𝓤 ̇ } → is-set X → DCPO⊥ {𝓥 ⁺ ⊔ 𝓤} {𝓥 ⁺ ⊔ 𝓤}
   Proposition-5-15 = 𝓛-DCPO⊥
 
-  Proposition-5-15-ad : {X : 𝓥 ̇  } (s : is-set X) → is-locally-small (𝓛-DCPO s)
+  Proposition-5-15-ad : {X : 𝓥 ̇ } (s : is-set X) → is-locally-small (𝓛-DCPO s)
   Proposition-5-15-ad {X} s =
    record { _⊑ₛ_ = _⊑_ ;
             ⊑ₛ-≃-⊑ = λ {l m} → logically-equivalent-props-are-equivalent
@@ -437,14 +435,14 @@ module _ (𝓥 : Universe) where
     open import Lifting.UnivalentPrecategory 𝓥 X
 
  module _
-         {X : 𝓤 ̇  }
+         {X : 𝓤 ̇ }
          (s : is-set X)
         where
 
   open import DomainTheory.Lifting.LiftingSet pt fe 𝓥 pe
 
 
-  Proposition-5-16 : {Y : 𝓦 ̇  } (t : is-set Y)
+  Proposition-5-16 : {Y : 𝓦 ̇ } (t : is-set Y)
                      (f : X → 𝓛 Y)
                   → is-continuous (𝓛-DCPO s) (𝓛-DCPO t) (f ♯)
   Proposition-5-16 t f = ♯-is-continuous s t f
@@ -501,7 +499,6 @@ module _ (𝓥 : Universe) where
 
  open import DomainTheory.Basics.Curry pt fe 𝓥
  open import DomainTheory.Basics.Dcpo pt fe 𝓥
- open import DomainTheory.Basics.FunctionComposition pt fe 𝓥
  open import DomainTheory.Basics.Pointed pt fe 𝓥
  open import DomainTheory.Basics.Products pt fe
  open DcpoProductsGeneral 𝓥
@@ -617,7 +614,6 @@ module _ (𝓥 : Universe) where
 
  open import DomainTheory.Basics.Dcpo pt fe 𝓥
  open import DomainTheory.Basics.Exponential pt fe 𝓥
- open import DomainTheory.Basics.FunctionComposition pt fe 𝓥
  open import DomainTheory.Basics.Miscelanea pt fe 𝓥
 
  Definition-7-1 : (𝓓 : DCPO {𝓤} {𝓣}) → DCPO[ 𝓓 , 𝓓 ] → 𝓤 ⊔ 𝓣 ̇
@@ -667,8 +663,8 @@ module _ (𝓥 : Universe) where
   -- Example-7-3: See the file
   import DomainTheory.Bilimits.Sequential
 
-  Definition-7-4 : Σ 𝓓∞ ꞉ 𝓥 ⊔ 𝓦 ⊔ 𝓤 ̇  ,
-                   Σ _≼_ ꞉ (𝓓∞ → 𝓓∞ → 𝓥 ⊔ 𝓣 ̇  ) ,
+  Definition-7-4 : Σ 𝓓∞ ꞉ 𝓥 ⊔ 𝓦 ⊔ 𝓤 ̇ ,
+                   Σ _≼_ ꞉ (𝓓∞ → 𝓓∞ → 𝓥 ⊔ 𝓣 ̇ ) ,
                    poset-axioms _≼_
   Definition-7-4 = 𝓓∞-carrier , _≼_  , 𝓓∞-poset-axioms
 
@@ -766,7 +762,6 @@ open import DomainTheory.Basics.Miscelanea pt fe 𝓤₀
 open import DomainTheory.Basics.Pointed pt fe 𝓤₀
 
 open import DomainTheory.Bilimits.Dinfinity pt fe pe
-open import DomainTheory.Bilimits.Sequential pt fe 𝓤₁ 𝓤₁
 
 Definition-8-1 : (n : ℕ) → DCPO⊥ {𝓤₁} {𝓤₁}
 Definition-8-1 = 𝓓⊥
@@ -858,4 +853,4 @@ Theorem-8-16 = ε-exp∞-section-of-π-exp∞ ,
 Remark-8-17 : Σ σ₀ ꞉ ⟨ 𝓓∞ ⟩ , σ₀ ≠ ⊥ 𝓓∞⊥
 Remark-8-17 = σ₀ , 𝓓∞⊥-is-nontrivial
 
-\end{code}
\ No newline at end of file
+\end{code}
diff --git a/source/DomainTheory/Part-II.lagda b/source/DomainTheory/Part-II.lagda
index cfe839f67..49b8f222c 100644
--- a/source/DomainTheory/Part-II.lagda
+++ b/source/DomainTheory/Part-II.lagda
@@ -36,15 +36,13 @@ module DomainTheory.Part-II
 open PropositionalTruncation pt
 
 open import MLTT.List
-open import MLTT.Plus-Properties
 open import MLTT.Spartan hiding (J)
 
-open import UF.Base
 open import UF.DiscreteAndSeparated
 open import UF.Equiv
 open import UF.EquivalenceExamples
 open import UF.ImageAndSurjection pt
-open import UF.Powerset-Fin pt hiding (⟨_⟩)
+open import UF.Powerset-Fin pt
 open import UF.Powerset-MultiUniverse renaming (𝓟 to 𝓟-general)
 open import UF.Powerset
 open import UF.Sets
@@ -105,7 +103,7 @@ module _ (𝓥 : Universe) where
   open import Lifting.Construction 𝓥 renaming (⊥ to ⊥𝓛)
   open import DomainTheory.Lifting.LiftingSet pt fe 𝓥 pe
   open import DomainTheory.Lifting.LiftingSetAlgebraic pt pe fe 𝓥 hiding (κ)
-  Example-2-6 : {X : 𝓥 ̇  } (X-set : is-set X) (l : 𝓛 X)
+  Example-2-6 : {X : 𝓥 ̇ } (X-set : is-set X) (l : 𝓛 X)
               → (is-compact (𝓛-DCPO X-set) l ↔ (l ＝ ⊥𝓛) + (Σ x ꞉ X , η x ＝ l))
               × (is-compact (𝓛-DCPO X-set) l ↔ is-decidable (is-defined l))
   Example-2-6 s l = compact-iff-⊥-or-η s l ,
@@ -118,14 +116,14 @@ module _ (𝓥 : Universe) where
  Lemma-2-7 = binary-join-is-compact
 
 
- Definition-2-8 : (X : 𝓤 ̇  ) → 𝓟-general {𝓣} X → 𝓤 ⊔ 𝓣 ̇
+ Definition-2-8 : (X : 𝓤 ̇ ) → 𝓟-general {𝓣} X → 𝓤 ⊔ 𝓣 ̇
  Definition-2-8 X = 𝕋
 
  Definition-2-9 : {X : 𝓤 ̇} → 𝓟 X → 𝓤 ̇
  Definition-2-9 = is-Kuratowski-finite-subset
 
  module _
-         {X : 𝓤 ̇  }
+         {X : 𝓤 ̇ }
          (X-set : is-set X)
         where
 
@@ -169,7 +167,7 @@ universe as the index types for directed completeness.
 \begin{code}
 
  module _
-         {X : 𝓥 ̇  }
+         {X : 𝓥 ̇ }
          (X-set : is-set X)
         where
 
@@ -247,7 +245,7 @@ Section 3
   Lemma-3-4-ad : (α β : Ind) → α ≲ β → ∐-map α ⊑⟨ 𝓓 ⟩ ∐-map β
   Lemma-3-4-ad = ∐-map-is-monotone
 
-  Definition-3-5 : (x : ⟨ 𝓓 ⟩) (α : Ind) → (𝓥 ⁺ ⊔ 𝓤 ⊔ 𝓣 ̇  ) × (𝓥 ⁺ ⊔ 𝓤 ⊔ 𝓣 ̇  )
+  Definition-3-5 : (x : ⟨ 𝓓 ⟩) (α : Ind) → (𝓥 ⁺ ⊔ 𝓤 ⊔ 𝓣 ̇ ) × (𝓥 ⁺ ⊔ 𝓤 ⊔ 𝓣 ̇ )
   Definition-3-5 x α = α approximates x , α is-left-adjunct-to x
 
   Remark-3-6 : (L : ⟨ 𝓓 ⟩ → Ind)
@@ -416,13 +414,13 @@ Section 5
 
  open import DomainTheory.BasesAndContinuity.Bases pt fe 𝓥
 
- Definition-5-1 : (𝓓 : DCPO {𝓤} {𝓣}) {B : 𝓥 ̇  } (β : B → ⟨ 𝓓 ⟩)
+ Definition-5-1 : (𝓓 : DCPO {𝓤} {𝓣}) {B : 𝓥 ̇ } (β : B → ⟨ 𝓓 ⟩)
                 → 𝓥 ⁺ ⊔ 𝓤 ⊔ 𝓣 ̇
  Definition-5-1 = is-small-basis
 
  module _
          (𝓓 : DCPO {𝓤} {𝓣})
-         {B : 𝓥 ̇  }
+         {B : 𝓥 ̇ }
          (β : B → ⟨ 𝓓 ⟩)
          (β-is-small-basis : is-small-basis 𝓓 β)
         where
@@ -444,7 +442,7 @@ Section 5
                is-continuous-dcpo-if-unspecified-small-basis 𝓓
 
  Lemma-5-4 : (𝓓 : DCPO {𝓤} {𝓣})
-             {B : 𝓥 ̇  }
+             {B : 𝓥 ̇ }
              (β : B → ⟨ 𝓓 ⟩)
            → is-small-basis 𝓓 β
            → {x y : ⟨ 𝓓 ⟩}
@@ -466,7 +464,7 @@ Section 5
 
  module _
          (𝓓 : DCPO {𝓤} {𝓣})
-         {B : 𝓥 ̇  }
+         {B : 𝓥 ̇ }
          (β : B → ⟨ 𝓓 ⟩)
          (β-is-small-basis : is-small-basis 𝓓 β)
         where
@@ -501,7 +499,7 @@ Section 5
 
   Theorem-5-10 : (s : DCPO[ 𝓓 , 𝓔 ]) (r : DCPO[ 𝓔 , 𝓓 ])
                → is-continuous-retract 𝓓 𝓔 s r
-               → {B : 𝓥 ̇  } (β : B → ⟨ 𝓔 ⟩)
+               → {B : 𝓥 ̇ } (β : B → ⟨ 𝓔 ⟩)
                → is-small-basis 𝓔 β
                → is-small-basis 𝓓 ([ 𝓔 , 𝓓 ]⟨ r ⟩ ∘ β)
   Theorem-5-10 (s , s-cont) (r , r-cont) s-section-of-r =
@@ -527,13 +525,13 @@ Section 5.1
 
 \begin{code}
 
- Definition-5-12 : (𝓓 : DCPO {𝓤} {𝓣}) {B : 𝓥 ̇  } (β : B → ⟨ 𝓓 ⟩)
+ Definition-5-12 : (𝓓 : DCPO {𝓤} {𝓣}) {B : 𝓥 ̇ } (β : B → ⟨ 𝓓 ⟩)
                  → 𝓥 ⁺ ⊔ 𝓤 ⊔ 𝓣 ̇
  Definition-5-12 = is-small-compact-basis
 
  module _
          (𝓓 : DCPO {𝓤} {𝓣})
-         {B : 𝓥 ̇  }
+         {B : 𝓥 ̇ }
          (β : B → ⟨ 𝓓 ⟩)
          (β-is-small-compact-basis : is-small-compact-basis 𝓓 β)
         where
@@ -581,18 +579,17 @@ Section 5.2
 
  module _ where
 
-  open import Lifting.Construction 𝓥 renaming (⊥ to ⊥𝓛)
   open import DomainTheory.Lifting.LiftingSet pt fe 𝓥 pe
   open import DomainTheory.Lifting.LiftingSetAlgebraic pt pe fe 𝓥
 
-  Example-5-18 : {X : 𝓥 ̇  } (X-set : is-set X)
+  Example-5-18 : {X : 𝓥 ̇ } (X-set : is-set X)
                → is-small-compact-basis (𝓛-DCPO X-set) (κ X-set)
                × is-algebraic-dcpo (𝓛-DCPO X-set)
   Example-5-18 X-set = κ-is-small-compact-basis X-set ,
                        𝓛-is-algebraic-dcpo X-set
 
  module _
-         {X : 𝓥 ̇  }
+         {X : 𝓥 ̇ }
          (X-set : is-set X)
         where
 
@@ -604,7 +601,7 @@ Section 5.2
   Example-5-19 = κ-is-small-compact-basis , 𝓟-is-algebraic-dcpo
 
  module _
-         (P : 𝓤 ̇  )
+         (P : 𝓤 ̇ )
          (P-is-prop : is-prop P)
         where
 
@@ -691,7 +688,6 @@ Section 6
 
 \begin{code}
 
- open import DomainTheory.IdealCompletion.IdealCompletion pt fe pe 𝓥
  open import DomainTheory.IdealCompletion.Properties pt fe pe 𝓥
 
  Definition-6-1 : 𝓥 ⁺ ̇
@@ -705,13 +701,13 @@ Section 6
   open Ideals-of-small-abstract-basis abs-basis
   open unions-of-small-families pt 𝓥 𝓥 B
 
-  Definition-6-2 : (𝓟 B → 𝓥 ̇  ) × (𝓥 ⁺ ̇  )
+  Definition-6-2 : (𝓟 B → 𝓥 ̇ ) × (𝓥 ⁺ ̇ )
   Definition-6-2 = is-ideal , Idl
 
-  Definition-6-3 : {S : 𝓥 ̇  } → (S → 𝓟 B) → 𝓟 B
+  Definition-6-3 : {S : 𝓥 ̇ } → (S → 𝓟 B) → 𝓟 B
   Definition-6-3 = ⋃
 
-  Lemma-6-4 : {S : 𝓥 ̇  } (𝓘 : S → Idl)
+  Lemma-6-4 : {S : 𝓥 ̇ } (𝓘 : S → Idl)
             → is-directed _⊑_ 𝓘
             → is-ideal (⋃ (carrier ∘ 𝓘))
   Lemma-6-4 𝓘 δ = ideality (Idl-∐ 𝓘 δ)
@@ -755,7 +751,7 @@ Section 6.1
 
 \begin{code}
 
- Lemma-6-12 : (B : 𝓥 ̇  ) (_≺_ : B → B → 𝓥 ̇  )
+ Lemma-6-12 : (B : 𝓥 ̇ ) (_≺_ : B → B → 𝓥 ̇ )
             → is-prop-valued _≺_
             → is-transitive _≺_
             → is-reflexive _≺_
@@ -822,10 +818,9 @@ module _ where
  open import DomainTheory.BasesAndContinuity.Continuity pt fe 𝓤₀
  open import DomainTheory.BasesAndContinuity.Bases pt fe 𝓤₀
  open import DomainTheory.Examples.IdlDyadics pt fe pe
- open import DomainTheory.IdealCompletion.IdealCompletion pt fe pe 𝓤₀
  open import DomainTheory.IdealCompletion.Properties pt fe pe 𝓤₀
 
- Definition-6-17 : (𝓤₀ ̇ ) × (𝔻 → 𝔻 → 𝓤₀ ̇  )
+ Definition-6-17 : (𝓤₀ ̇ ) × (𝔻 → 𝔻 → 𝓤₀ ̇ )
  Definition-6-17 = 𝔻 , _≺_
 
  Lemma-6-18 : is-discrete 𝔻 × is-set 𝔻
@@ -878,13 +873,12 @@ module _ (𝓥 : Universe) where
  open import DomainTheory.Basics.WayBelow pt fe 𝓥
  open import DomainTheory.BasesAndContinuity.Continuity pt fe 𝓥
  open import DomainTheory.BasesAndContinuity.Bases pt fe 𝓥
- open import DomainTheory.IdealCompletion.IdealCompletion pt fe pe 𝓥
  open import DomainTheory.IdealCompletion.Properties pt fe pe 𝓥
  open import DomainTheory.IdealCompletion.Retracts pt fe pe 𝓥
 
  module _
          (𝓓 : DCPO {𝓤} {𝓣})
-         {B : 𝓥 ̇  }
+         {B : 𝓥 ̇ }
          (β : B → ⟨ 𝓓 ⟩)
          (β-is-small-basis : is-small-basis 𝓓 β)
         where
@@ -1046,7 +1040,7 @@ Section 7.1
                ε-id π-id ε-comp π-comp
 
   module _
-          {J : I → 𝓥 ̇  }
+          {J : I → 𝓥 ̇ }
           (α : (i : I) → J i → ⟨ 𝓓 i ⟩)
          where
 
@@ -1150,7 +1144,7 @@ Section 7.2
                   → List I → ⟨ 𝓓 ⟩
   Definition-7-10 = directification
 
-  Lemma-7-11 : {I : 𝓦 ̇  } (α : I → ⟨ 𝓓 ⟩)
+  Lemma-7-11 : {I : 𝓦 ̇ } (α : I → ⟨ 𝓓 ⟩)
              → ((i : I) → is-compact 𝓓 (α i))
              → (l : List I) → is-compact 𝓓 (directification α l)
   Lemma-7-11 = directify-is-compact
@@ -1178,7 +1172,7 @@ Section 7.2
 
  module _
          (𝓓 : DCPO{𝓤} {𝓣})
-         {B : 𝓥 ̇  } (β : B → ⟨ 𝓓 ⟩)
+         {B : 𝓥 ̇ } (β : B → ⟨ 𝓓 ⟩)
          (β-is-small-basis : is-small-basis 𝓓 β)
          (𝓓-is-sup-complete : is-sup-complete 𝓓)
         where
@@ -1193,7 +1187,7 @@ Section 7.2
   Definition-7-13 = basis-has-finite-joins
                      𝓓 β β-is-small-basis 𝓓-has-finite-joins
 
-  Lemma-7-14 : Σ B' ꞉ 𝓥 ̇  , Σ β' ꞉ (B' → ⟨ 𝓓 ⟩) ,
+  Lemma-7-14 : Σ B' ꞉ 𝓥 ̇ , Σ β' ꞉ (B' → ⟨ 𝓓 ⟩) ,
                Σ p ꞉ is-small-basis 𝓓 β' ,
                    basis-has-finite-joins 𝓓 β' p 𝓓-has-finite-joins
   Lemma-7-14 = refine-basis-to-have-finite-joins
@@ -1233,4 +1227,4 @@ Theorem-7-17 : has-specified-small-compact-basis 𝓓∞
              × is-algebraic-dcpo 𝓓∞
 Theorem-7-17 = 𝓓∞-has-specified-small-compact-basis , 𝓓∞-is-algebraic-dcpo
 
-\end{code}
\ No newline at end of file
+\end{code}
diff --git a/source/DomainTheory/Taboos/ClassicalLiftingOfNaturalNumbers.lagda b/source/DomainTheory/Taboos/ClassicalLiftingOfNaturalNumbers.lagda
index 3df3487b5..9b20f3cca 100644
--- a/source/DomainTheory/Taboos/ClassicalLiftingOfNaturalNumbers.lagda
+++ b/source/DomainTheory/Taboos/ClassicalLiftingOfNaturalNumbers.lagda
@@ -26,13 +26,11 @@ module DomainTheory.Taboos.ClassicalLiftingOfNaturalNumbers
 open PropositionalTruncation pt
 
 open import DomainTheory.Basics.Dcpo pt fe 𝓤₀
-open import DomainTheory.Basics.Miscelanea pt fe 𝓤₀
 
 open import CoNaturals.Type renaming (ℕ∞-to-ℕ→𝟚 to ε)
 open import MLTT.Two-Properties
 open import MLTT.Plus-Properties
-open import Notation.CanonicalMap
-open import Taboos.LPO (λ 𝓤 𝓥 → fe)
+open import Taboos.LPO
 
 \end{code}
 
diff --git a/source/DomainTheory/Topology/ScottTopology.lagda b/source/DomainTheory/Topology/ScottTopology.lagda
index 45c6d1b46..d48743415 100644
--- a/source/DomainTheory/Topology/ScottTopology.lagda
+++ b/source/DomainTheory/Topology/ScottTopology.lagda
@@ -16,14 +16,11 @@ module DomainTheory.Topology.ScottTopology
 
 open PropositionalTruncation pt
 
-open import OrderedTypes.Poset fe
 open import Slice.Family
 open import UF.ImageAndSurjection pt
 open import UF.Logic
 open import UF.Powerset-MultiUniverse
 open import UF.SubtypeClassifier
-open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 
 open Universal fe
 open Existential pt
diff --git a/source/Dominance/Decidable.lagda b/source/Dominance/Decidable.lagda
index c1c86fcc7..b0ea21947 100644
--- a/source/Dominance/Decidable.lagda
+++ b/source/Dominance/Decidable.lagda
@@ -8,7 +8,6 @@ module Dominance.Decidable where
 
 open import Dominance.Definition
 open import MLTT.Spartan
-open import NotionsOfDecidability.Complemented
 open import NotionsOfDecidability.Decidable
 open import UF.FunExt
 open import UF.Subsingletons
diff --git a/source/Duploids/DeductiveSystem.lagda b/source/Duploids/DeductiveSystem.lagda
index ca583eda4..d0130ea32 100644
--- a/source/Duploids/DeductiveSystem.lagda
+++ b/source/Duploids/DeductiveSystem.lagda
@@ -16,16 +16,11 @@ open import UF.FunExt
 
 module Duploids.DeductiveSystem (fe : Fun-Ext) where
 
-open import UF.Base
 open import UF.Equiv
-open import UF.PropTrunc
 
 open import MLTT.Spartan
-open import UF.Base
 open import UF.Subsingletons
 open import UF.Subsingletons-FunExt
-open import UF.Logic
-open import UF.Lower-FunExt
 
 open import Categories.Category fe
 
diff --git a/source/Duploids/Depolarization.lagda b/source/Duploids/Depolarization.lagda
index 844d39299..850732f87 100644
--- a/source/Duploids/Depolarization.lagda
+++ b/source/Duploids/Depolarization.lagda
@@ -20,8 +20,6 @@ open import MLTT.Spartan
 open import UF.Base
 open import UF.Equiv
 open import UF.PropTrunc
-open import UF.Retracts
-open import UF.HLevels
 open import UF.Subsingletons
 open import UF.Subsingletons-FunExt
 
diff --git a/source/Duploids/Duploid.lagda b/source/Duploids/Duploid.lagda
index ff15491a0..6983bc28d 100644
--- a/source/Duploids/Duploid.lagda
+++ b/source/Duploids/Duploid.lagda
@@ -42,7 +42,6 @@ open PropositionalTruncation pt
 open import MLTT.Spartan
 open import UF.Base
 open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 
 open import Categories.Category fe
 open import Categories.Functor fe
diff --git a/source/Dyadics/Negation.lagda b/source/Dyadics/Negation.lagda
index 65b3aebb9..dac03f18a 100644
--- a/source/Dyadics/Negation.lagda
+++ b/source/Dyadics/Negation.lagda
@@ -9,10 +9,7 @@ open import Dyadics.Type
 open import Integers.Type
 open import Integers.Multiplication
 open import Integers.Negation renaming (-_ to ℤ-_)
-open import Integers.Parity
 open import Naturals.Exponentiation
-open import UF.Base hiding (_≈_)
-open import UF.Subsingletons
 
 module Dyadics.Negation where
 
diff --git a/source/Dyadics/Order.lagda b/source/Dyadics/Order.lagda
index 64157315c..d1621d52f 100644
--- a/source/Dyadics/Order.lagda
+++ b/source/Dyadics/Order.lagda
@@ -11,7 +11,6 @@ open import Integers.Type
 open import Integers.Exponentiation
 open import Integers.Multiplication
 open import Integers.Order
-open import Naturals.Multiplication renaming (_*_ to _ℕ*_)
 open import Notation.Order
 open import UF.Base
 
diff --git a/source/Dyadics/Type.lagda b/source/Dyadics/Type.lagda
index 0104b950a..5fe0fec39 100644
--- a/source/Dyadics/Type.lagda
+++ b/source/Dyadics/Type.lagda
@@ -22,7 +22,6 @@ open import Naturals.Parity
 open import Naturals.Properties
 open import Notation.Order
 open import Rationals.Fractions hiding (_≈_ ; ≈-sym ; ≈-trans ; ≈-refl)
-open import Rationals.Multiplication renaming (_*_ to _ℚ*_)
 open import Rationals.Type
 open import TypeTopology.SigmaDiscreteAndTotallySeparated
 open import UF.Base hiding (_≈_)
diff --git a/source/DyadicsInductive/Dyadics.lagda b/source/DyadicsInductive/Dyadics.lagda
index a4d26cff3..ed56e6797 100644
--- a/source/DyadicsInductive/Dyadics.lagda
+++ b/source/DyadicsInductive/Dyadics.lagda
@@ -14,7 +14,6 @@ open import MLTT.Spartan
 open import MLTT.Unit-Properties
 open import UF.DiscreteAndSeparated
 open import UF.Sets
-open import UF.Subsingletons
 
 \end{code}
 
diff --git a/source/EffectfulForcing/Internal/Correctness.lagda b/source/EffectfulForcing/Internal/Correctness.lagda
index 7f56316eb..88e0a49b8 100644
--- a/source/EffectfulForcing/Internal/Correctness.lagda
+++ b/source/EffectfulForcing/Internal/Correctness.lagda
@@ -22,7 +22,6 @@ open import EffectfulForcing.Internal.External
 open import EffectfulForcing.Internal.SystemT
 open import EffectfulForcing.Internal.Subst
 open import EffectfulForcing.Internal.ExtensionalEquality
-open import UF.Base using (transport₂ ; transport₃ ; ap₂ ; ap₃)
 
 \end{code}
 
diff --git a/source/EffectfulForcing/Internal/Degrees.lagda b/source/EffectfulForcing/Internal/Degrees.lagda
index 26d72c702..83222af0d 100644
--- a/source/EffectfulForcing/Internal/Degrees.lagda
+++ b/source/EffectfulForcing/Internal/Degrees.lagda
@@ -13,10 +13,8 @@ module EffectfulForcing.Internal.Degrees (fe : Fun-Ext) where
 open import MLTT.Spartan
 open import EffectfulForcing.MFPSAndVariations.SystemT
  using (type; ι; _⇒_;〖_〗)
-open import MLTT.NaturalNumbers
 open import Naturals.Order using (max)
 open import EffectfulForcing.Internal.SystemT
-open import EffectfulForcing.Internal.InternalModCont fe
 
 \end{code}
 
diff --git a/source/EffectfulForcing/Internal/FurtherThoughts.lagda b/source/EffectfulForcing/Internal/FurtherThoughts.lagda
index d28793d94..00c195c82 100644
--- a/source/EffectfulForcing/Internal/FurtherThoughts.lagda
+++ b/source/EffectfulForcing/Internal/FurtherThoughts.lagda
@@ -7,12 +7,9 @@ Martin Escardo, Vincent Rahli, Bruno da Rocha Paiva, Ayberk Tosun 20 May 2023
 module EffectfulForcing.Internal.FurtherThoughts where
 
 open import MLTT.Spartan hiding (rec ; _^_) renaming (⋆ to 〈〉)
-open import EffectfulForcing.MFPSAndVariations.Combinators
 open import EffectfulForcing.MFPSAndVariations.Continuity
 open import EffectfulForcing.MFPSAndVariations.Dialogue
 open import EffectfulForcing.MFPSAndVariations.SystemT using (type ; ι ; _⇒_ ; 〖_〗)
-open import EffectfulForcing.MFPSAndVariations.LambdaCalculusVersionOfMFPS
-                              using (B〖_〗 ; Kleisli-extension ; zero' ; succ' ; rec')
 open import EffectfulForcing.MFPSAndVariations.Church
                               hiding (B⋆【_】 ; ⟪⟫⋆ ; _‚‚⋆_ ; B⋆⟦_⟧ ; dialogue-tree⋆)
 open import EffectfulForcing.Internal.Internal hiding (B⋆⟦_⟧ ; dialogue-tree⋆)
@@ -20,7 +17,6 @@ open import EffectfulForcing.Internal.External
 open import EffectfulForcing.Internal.SystemT
 open import EffectfulForcing.Internal.Subst
 open import EffectfulForcing.Internal.Correctness
-open import UF.Base using (transport₂ ; transport₃ ; ap₂ ; ap₃)
 
 \end{code}
 
diff --git a/source/EffectfulForcing/Internal/Internal.lagda b/source/EffectfulForcing/Internal/Internal.lagda
index 935f45967..2812919c6 100644
--- a/source/EffectfulForcing/Internal/Internal.lagda
+++ b/source/EffectfulForcing/Internal/Internal.lagda
@@ -16,7 +16,6 @@ open import MLTT.Spartan
              hiding (rec ; _^_)
              renaming (⋆ to 〈〉)
 open import EffectfulForcing.MFPSAndVariations.Combinators
-open import EffectfulForcing.MFPSAndVariations.Dialogue
 open import EffectfulForcing.MFPSAndVariations.SystemT
              using (type ; ι ; _⇒_ ; 〖_〗)
 open import EffectfulForcing.MFPSAndVariations.Church
diff --git a/source/EffectfulForcing/Internal/InternalModCont.lagda b/source/EffectfulForcing/Internal/InternalModCont.lagda
index ee0a501c0..23c34a376 100644
--- a/source/EffectfulForcing/Internal/InternalModCont.lagda
+++ b/source/EffectfulForcing/Internal/InternalModCont.lagda
@@ -14,12 +14,10 @@ open import UF.FunExt
 module EffectfulForcing.Internal.InternalModCont (fe : Fun-Ext) where
 
 open import MLTT.Spartan hiding (rec; _^_)
-open import MLTT.List
 open import Naturals.Order using (max)
 open import EffectfulForcing.Internal.Internal
 open import EffectfulForcing.MFPSAndVariations.Church
 open import EffectfulForcing.Internal.SystemT
-open import EffectfulForcing.MFPSAndVariations.Combinators
 open import EffectfulForcing.MFPSAndVariations.Dialogue
  using (eloquent; D; dialogue; eloquent-functions-are-continuous;
         dialogue-continuity; generic)
@@ -31,7 +29,6 @@ open import EffectfulForcing.Internal.Correctness
         dialogue-tree-agreement; ⌜dialogue⌝)
 open import EffectfulForcing.Internal.External
  using (eloquence-theorem; dialogue-tree; ⟪⟫; B⟦_⟧; B⟦_⟧₀)
-open import EffectfulForcing.Internal.Subst
 open import EffectfulForcing.Internal.ExtensionalEquality
 open import EffectfulForcing.MFPSAndVariations.SystemT
  using (type; ι; _⇒_;〖_〗)
diff --git a/source/EffectfulForcing/Internal/InternalModUniCont.lagda b/source/EffectfulForcing/Internal/InternalModUniCont.lagda
index b7232ab83..0c9f2355a 100644
--- a/source/EffectfulForcing/Internal/InternalModUniCont.lagda
+++ b/source/EffectfulForcing/Internal/InternalModUniCont.lagda
@@ -12,7 +12,6 @@ Continuation of the development in `InternalModCont` towards uniform continuity.
 {-# OPTIONS --safe --without-K --exact-split #-}
 
 open import UF.FunExt
-open import UF.Equiv hiding (⌜_⌝)
 open import UF.Retracts
 
 module EffectfulForcing.Internal.InternalModUniCont (fe : Fun-Ext) where
@@ -24,10 +23,8 @@ open import EffectfulForcing.Internal.External
 open import EffectfulForcing.Internal.Internal
 open import EffectfulForcing.Internal.InternalModCont fe
  using (maxᵀ; maxᵀ-correct)
-open import EffectfulForcing.Internal.Subst
 open import EffectfulForcing.Internal.SystemT
 open import EffectfulForcing.MFPSAndVariations.Church
-open import EffectfulForcing.MFPSAndVariations.Combinators
 open import EffectfulForcing.MFPSAndVariations.Continuity
  using (is-continuous; _＝⟪_⟫_; C-restriction; Cantor; Baire;
         is-uniformly-continuous; _＝⟦_⟧_; BT; embedding-𝟚-ℕ)
@@ -38,7 +35,6 @@ open import EffectfulForcing.MFPSAndVariations.Dialogue
         restriction-is-eloquent; dialogue-UC)
 open import EffectfulForcing.MFPSAndVariations.SystemT
  using (type; ι; _⇒_;〖_〗)
-open import MLTT.List
 open import MLTT.Spartan hiding (rec; _^_)
 open import Naturals.Order using (max)
 
diff --git a/source/EffectfulForcing/Internal/SystemT.lagda b/source/EffectfulForcing/Internal/SystemT.lagda
index cd2b091db..46e375e5a 100644
--- a/source/EffectfulForcing/Internal/SystemT.lagda
+++ b/source/EffectfulForcing/Internal/SystemT.lagda
@@ -31,17 +31,17 @@ X ^ (succ n) = X ^ n × X
 
 infixr 3 _^_
 
-data Cxt : 𝓤₀ ̇  where
+data Cxt : 𝓤₀ ̇ where
  〈〉 : Cxt
  _,,_ : Cxt → type → Cxt
 
 infixl 6 _,,_
 
-data ∈Cxt (σ : type) : Cxt → 𝓤₀ ̇  where
+data ∈Cxt (σ : type) : Cxt → 𝓤₀ ̇ where
  ∈Cxt0 : (Γ : Cxt) → ∈Cxt σ (Γ ,, σ)
  ∈CxtS : {Γ : Cxt} (τ : type) → ∈Cxt σ Γ → ∈Cxt σ (Γ ,, τ)
 
-data T : (Γ : Cxt) (σ : type) → 𝓤₀ ̇  where
+data T : (Γ : Cxt) (σ : type) → 𝓤₀ ̇ where
  Zero : {Γ : Cxt} → T Γ ι
  Succ : {Γ : Cxt} → T Γ ι → T Γ ι
  Rec  : {Γ : Cxt} {σ : type} → T Γ (ι ⇒ σ ⇒ σ) → T Γ σ → T Γ ι → T Γ σ
diff --git a/source/EffectfulForcing/MFPSAndVariations/CombinatoryT.lagda b/source/EffectfulForcing/MFPSAndVariations/CombinatoryT.lagda
index d3e4f8c84..c3479922a 100644
--- a/source/EffectfulForcing/MFPSAndVariations/CombinatoryT.lagda
+++ b/source/EffectfulForcing/MFPSAndVariations/CombinatoryT.lagda
@@ -10,16 +10,15 @@ semantics.
 module EffectfulForcing.MFPSAndVariations.CombinatoryT where
 
 open import MLTT.Spartan
-open import MLTT.Athenian
 open import EffectfulForcing.MFPSAndVariations.Continuity
 open import EffectfulForcing.MFPSAndVariations.Combinators
 open import UF.Base
 
-data type : 𝓤₀  ̇  where
+data type : 𝓤₀  ̇ where
  ι   : type
  _⇒_ : type → type → type
 
-data T : (σ : type) → 𝓤₀  ̇  where
+data T : (σ : type) → 𝓤₀  ̇ where
  Zero  : T ι
  Succ  : T (ι ⇒ ι)
  Iter  : {σ : type}     → T ((σ ⇒ σ) ⇒ σ ⇒ ι ⇒ σ)
@@ -51,7 +50,7 @@ System T extended with oracles.
 
 \begin{code}
 
-data TΩ : (σ : type) → 𝓤₀ ̇  where
+data TΩ : (σ : type) → 𝓤₀ ̇ where
  Ω     : TΩ (ι ⇒ ι)
  Zero  : TΩ ι
  Succ  : TΩ (ι ⇒ ι)
diff --git a/source/EffectfulForcing/MFPSAndVariations/Continuity.lagda b/source/EffectfulForcing/MFPSAndVariations/Continuity.lagda
index 69eb104e1..2bd7ee8af 100644
--- a/source/EffectfulForcing/MFPSAndVariations/Continuity.lagda
+++ b/source/EffectfulForcing/MFPSAndVariations/Continuity.lagda
@@ -8,13 +8,11 @@ module EffectfulForcing.MFPSAndVariations.Continuity where
 
 open import MLTT.Spartan
 open import MLTT.Athenian
-open import UF.Retracts
-open import UF.Equiv
 
 Baire : 𝓤₀ ̇
 Baire = ℕ → ℕ
 
-data _＝⟪_⟫_ {X : 𝓤₀ ̇ } : (ℕ → X) → List ℕ → (ℕ → X) → 𝓤₀ ̇  where
+data _＝⟪_⟫_ {X : 𝓤₀ ̇ } : (ℕ → X) → List ℕ → (ℕ → X) → 𝓤₀ ̇ where
  []  : {α α' : ℕ → X} → α ＝⟪ [] ⟫ α'
  _∷_ : {α α' : ℕ → X} {i : ℕ} {s : List ℕ}
      → α i ＝ α' i
@@ -40,11 +38,11 @@ continuity-extensional f g t c α = (pr₁ (c α) ,
 Cantor : 𝓤₀ ̇
 Cantor = ℕ → 𝟚
 
-data BT (X : 𝓤₀ ̇ ) : 𝓤₀ ̇  where
+data BT (X : 𝓤₀ ̇ ) : 𝓤₀ ̇ where
   []   : BT X
   _∷_ : X → (𝟚 → BT X) → BT X
 
-data _＝⟦_⟧_ {X : 𝓤₀ ̇ } : (ℕ → X) → BT ℕ → (ℕ → X) → 𝓤₀ ̇  where
+data _＝⟦_⟧_ {X : 𝓤₀ ̇ } : (ℕ → X) → BT ℕ → (ℕ → X) → 𝓤₀ ̇ where
   []  : {α α' : ℕ → X} → α ＝⟦ [] ⟧ α'
   _∷_ : {α α' : ℕ → X}{i : ℕ}{s : 𝟚 → BT ℕ}
       → α i ＝ α' i
diff --git a/source/EffectfulForcing/MFPSAndVariations/ContinuityProperties.lagda b/source/EffectfulForcing/MFPSAndVariations/ContinuityProperties.lagda
index 80039d6c0..12d6e4f75 100644
--- a/source/EffectfulForcing/MFPSAndVariations/ContinuityProperties.lagda
+++ b/source/EffectfulForcing/MFPSAndVariations/ContinuityProperties.lagda
@@ -23,11 +23,8 @@ open import Naturals.Order
 open import Naturals.Properties using (succ-no-fp; zero-not-positive)
 open import UF.Embeddings
 open import UF.Equiv
-open import UF.Logic
-open import UF.Retracts
 open import UF.Subsingletons
 open import UF.Subsingletons-FunExt
-open import UF.SubtypeClassifier
 
 \end{code}
 
diff --git a/source/EffectfulForcing/MFPSAndVariations/Dialogue.lagda b/source/EffectfulForcing/MFPSAndVariations/Dialogue.lagda
index 0e430e183..0e023f252 100644
--- a/source/EffectfulForcing/MFPSAndVariations/Dialogue.lagda
+++ b/source/EffectfulForcing/MFPSAndVariations/Dialogue.lagda
@@ -10,7 +10,7 @@ open import MLTT.Spartan
 open import MLTT.Athenian
 open import EffectfulForcing.MFPSAndVariations.Continuity
 
-data D (X : 𝓤 ̇ ) (Y : 𝓥 ̇ ) (Z : 𝓦 ̇ ) : 𝓤 ⊔ 𝓥 ⊔ 𝓦 ̇  where
+data D (X : 𝓤 ̇ ) (Y : 𝓥 ̇ ) (Z : 𝓦 ̇ ) : 𝓤 ⊔ 𝓥 ⊔ 𝓦 ̇ where
  η : Z → D X Y Z
  β : (Y → D X Y Z) → X → D X Y Z
 
@@ -23,7 +23,7 @@ dialogue (β φ x) α = dialogue (φ(α x)) α
 eloquent : {X : 𝓤 ̇ } {Y : 𝓥 ̇ } {Z : 𝓦 ̇ } → ((X → Y) → Z) → 𝓤 ⊔ 𝓥 ⊔ 𝓦 ̇
 eloquent f = Σ d ꞉ D _ _ _ , dialogue d ∼ f
 
-B : 𝓤 ̇  → 𝓤 ̇
+B : 𝓤 ̇ → 𝓤 ̇
 B = D ℕ ℕ
 
 dialogue-continuity : (d : B ℕ) → is-continuous (dialogue d)
diff --git a/source/EffectfulForcing/MFPSAndVariations/Internal.lagda b/source/EffectfulForcing/MFPSAndVariations/Internal.lagda
index acfe7db42..08f57bc77 100644
--- a/source/EffectfulForcing/MFPSAndVariations/Internal.lagda
+++ b/source/EffectfulForcing/MFPSAndVariations/Internal.lagda
@@ -15,10 +15,7 @@ module EffectfulForcing.MFPSAndVariations.Internal where
 
 open import MLTT.Spartan hiding (rec ; _^_) renaming (⋆ to 〈〉)
 open import MLTT.Fin
-open import UF.Base
 open import EffectfulForcing.MFPSAndVariations.Combinators
-open import EffectfulForcing.MFPSAndVariations.Continuity
-open import EffectfulForcing.MFPSAndVariations.Dialogue
 open import EffectfulForcing.MFPSAndVariations.SystemT
 open import EffectfulForcing.MFPSAndVariations.Church
 
diff --git a/source/EffectfulForcing/MFPSAndVariations/LambdaCalculusVersionOfMFPS.lagda b/source/EffectfulForcing/MFPSAndVariations/LambdaCalculusVersionOfMFPS.lagda
index 8c5e42b98..b19ec3866 100644
--- a/source/EffectfulForcing/MFPSAndVariations/LambdaCalculusVersionOfMFPS.lagda
+++ b/source/EffectfulForcing/MFPSAndVariations/LambdaCalculusVersionOfMFPS.lagda
@@ -14,7 +14,6 @@ module EffectfulForcing.MFPSAndVariations.LambdaCalculusVersionOfMFPS where
 
 open import MLTT.Spartan hiding (rec ; _^_) renaming (⋆ to 〈〉)
 open import MLTT.Fin
-open import UF.Base
 open import EffectfulForcing.MFPSAndVariations.Combinators
 open import EffectfulForcing.MFPSAndVariations.Continuity
 open import EffectfulForcing.MFPSAndVariations.Dialogue
diff --git a/source/EffectfulForcing/MFPSAndVariations/MFPS-XXIX.lagda b/source/EffectfulForcing/MFPSAndVariations/MFPS-XXIX.lagda
index c8cd8353f..935b9c8a4 100644
--- a/source/EffectfulForcing/MFPSAndVariations/MFPS-XXIX.lagda
+++ b/source/EffectfulForcing/MFPSAndVariations/MFPS-XXIX.lagda
@@ -11,7 +11,6 @@ module EffectfulForcing.MFPSAndVariations.MFPS-XXIX where
 
 open import MLTT.Spartan
 open import MLTT.Athenian
-open import UF.Base
 open import EffectfulForcing.MFPSAndVariations.Combinators
 open import EffectfulForcing.MFPSAndVariations.Continuity
 open import EffectfulForcing.MFPSAndVariations.Dialogue
diff --git a/source/EffectfulForcing/MFPSAndVariations/WithoutOracle.lagda b/source/EffectfulForcing/MFPSAndVariations/WithoutOracle.lagda
index e689edff6..7b94bb3f9 100644
--- a/source/EffectfulForcing/MFPSAndVariations/WithoutOracle.lagda
+++ b/source/EffectfulForcing/MFPSAndVariations/WithoutOracle.lagda
@@ -14,8 +14,6 @@ the ``oracle'' α.
 module EffectfulForcing.MFPSAndVariations.WithoutOracle where
 
 open import MLTT.Spartan
-open import MLTT.Athenian
-open import UF.Base
 open import EffectfulForcing.MFPSAndVariations.Combinators
 open import EffectfulForcing.MFPSAndVariations.Continuity
 open import EffectfulForcing.MFPSAndVariations.Dialogue
diff --git a/source/Factorial/Law.lagda b/source/Factorial/Law.lagda
index 7dbc5fd89..8823a98ea 100644
--- a/source/Factorial/Law.lagda
+++ b/source/Factorial/Law.lagda
@@ -69,7 +69,6 @@ open import UF.Equiv-FunExt
 open import UF.EquivalenceExamples
 open import UF.Retracts
 open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 
 \end{code}
 
diff --git a/source/Factorial/Swap.lagda b/source/Factorial/Swap.lagda
index f46ca85a3..4d057fa65 100644
--- a/source/Factorial/Swap.lagda
+++ b/source/Factorial/Swap.lagda
@@ -8,7 +8,6 @@ The swap automorphism.
 
 module Factorial.Swap where
 
-open import MLTT.Plus-Properties
 open import MLTT.Spartan
 open import UF.DiscreteAndSeparated
 open import UF.Equiv
diff --git a/source/Field/Axioms.lagda b/source/Field/Axioms.lagda
index 2d61fc461..68cabbf76 100755
--- a/source/Field/Axioms.lagda
+++ b/source/Field/Axioms.lagda
@@ -9,7 +9,6 @@ In this file I define the constructive field axioms.
 open import MLTT.Spartan renaming (_+_ to _∔_)
 
 open import UF.Sets
-open import UF.Subsingletons
 
 module Field.Axioms where
 
@@ -103,7 +102,6 @@ addition-associative : {𝓥 𝓦 : Universe} → (F : Ordered-Field 𝓤 { 𝓥
 addition-associative ((F , (_+_ , _*_ , _♯_) , F-is-set , +-assoc , *-assoc , +-comm , *-comm , dist , (e₀ , e₁) , e₀♯e₁ , zln , +-inverse , *-left-neutral , *-inverse) , _<_ , <-respects-additions , <-respects-multiplication) = +-assoc
 
 {-
-open import Rationals.
 
 ArchimedeanOrderedField : (𝓤 : Universe) → {𝓥 𝓦 : Universe} → (𝓤 ⁺) ⊔ (𝓥 ⁺) ⊔ (𝓦 ⁺) ̇
 ArchimedeanOrderedField 𝓤 {𝓥} {𝓦} = Σ (F , (_<_ , ofa)) ꞉ Ordered-Field 𝓤 {𝓥 } { 𝓦 } , ((embedding : (ℚ → ⟨ (F , (_<_ , ofa)) ⟩)) → (∀ x y → ∃ z ꞉ ℚ , (x < embedding z) × (embedding z < y)))
diff --git a/source/Field/DedekindReals.lagda b/source/Field/DedekindReals.lagda
index a2bc512c8..3f297b24f 100644
--- a/source/Field/DedekindReals.lagda
+++ b/source/Field/DedekindReals.lagda
@@ -4,14 +4,11 @@ Andrew Sneap, 7 February 2021
 
 {-# OPTIONS --safe --without-K --lossy-unification #-}
 
-open import MLTT.Spartan renaming (_+_ to _∔_)
 
 open import UF.PropTrunc
 open import UF.FunExt
 open import UF.Subsingletons
-open import Notation.Order
 
-open import Field.Axioms
 
 module Field.DedekindReals
          (fe : Fun-Ext)
@@ -19,8 +16,6 @@ module Field.DedekindReals
          (pe : Prop-Ext)
  where
 
-open import DedekindReals.Type fe pe pt
-open import DedekindReals.Order fe pe pt
 
 {-
 DedekindRealsField : Field-structure ℝ { 𝓤₀ }
diff --git a/source/Fin/ArgMinMax.lagda b/source/Fin/ArgMinMax.lagda
index 18d28d33e..e82614140 100644
--- a/source/Fin/ArgMinMax.lagda
+++ b/source/Fin/ArgMinMax.lagda
@@ -6,22 +6,17 @@ Martin Escardo and Paulo Oliva, October 2021.
 
 module Fin.ArgMinMax where
 
-open import UF.Subsingletons
 
 open import Fin.Embeddings
 open import Fin.Order
-open import Fin.Properties
 open import Fin.Topology
 open import Fin.Type
-open import MLTT.Plus-Properties
-open import MLTT.Spartan
+open import MLTT.Spartan hiding (_+_)
 open import MLTT.SpartanList
 open import Naturals.Order
 open import Notation.Order
 open import NotionsOfDecidability.Complemented
 open import TypeTopology.CompactTypes
-open import UF.DiscreteAndSeparated
-open import UF.Equiv
 
 \end{code}
 
@@ -283,4 +278,79 @@ argmax'-correct {succ a} p y = h y
     l : p (suc x) ≤ p γ
     l = {!!}
 -}
+
+\end{code}
+
+Added 11th September 2024. Simplified and more efficient version for
+the boolean-valued case.
+
+\begin{code}
+
+open import MLTT.Two-Properties
+open import Naturals.Addition
+
+Min₂ : (i : ℕ) → (Fin (i + 1) → 𝟚) → 𝟚
+Min₂ 0        p = p 𝟎
+Min₂ (succ i) p = min𝟚 (p 𝟎) (Min₂ i (p ∘ suc))
+
+Max₂ : (i : ℕ) → (Fin (i + 1) → 𝟚) → 𝟚
+Max₂ 0        p = p 𝟎
+Max₂ (succ i) p = max𝟚 (p 𝟎) (Max₂ i (p ∘ suc))
+
+argMin₂ : (i : ℕ) → (Fin (i + 1) → 𝟚) → Fin (i + 1)
+argMin₂ 0        p = 𝟎
+argMin₂ (succ i) p =
+ 𝟚-equality-cases
+  (λ (_ : p 𝟎 ＝ ₀) → 𝟎)
+  (λ (_ : p 𝟎 ＝ ₁) → suc (argMin₂ i (p ∘ suc)))
+
+argMax₂ : (i : ℕ) → (Fin (i + 1) → 𝟚) → Fin (i + 1)
+argMax₂ 0        p = 𝟎
+argMax₂ (succ i) p =
+ 𝟚-equality-cases
+  (λ (_ : p 𝟎 ＝ ₀) → suc (argMax₂ i (p ∘ suc)))
+  (λ (_ : p 𝟎 ＝ ₁) → 𝟎)
+
+argMin₂-is-selection-for-Min₂ : (i : ℕ)
+                                (p : Fin (i + 1) → 𝟚)
+                              → p (argMin₂ i p) ＝ Min₂ i p
+argMin₂-is-selection-for-Min₂ 0        p = refl
+argMin₂-is-selection-for-Min₂ (succ i) p =
+ 𝟚-equality-cases
+  (λ (e : p 𝟎 ＝ ₀)
+     → p (argMin₂ (succ i) p)        ＝⟨ ap p (𝟚-equality-cases₀ e) ⟩
+       p 𝟎                          ＝⟨ e ⟩
+       ₀                            ＝⟨ refl ⟩
+       min𝟚 ₀ (Min₂ i (p ∘ suc))     ＝⟨ ap (λ - → min𝟚 - (Min₂ i (p ∘ suc))) (e ⁻¹) ⟩
+       min𝟚 (p 𝟎) (Min₂ i (p ∘ suc)) ＝⟨ refl ⟩
+       Min₂ (succ i) p               ∎)
+  (λ (e : p 𝟎 ＝ ₁)
+    → p (argMin₂ (succ i) p)        ＝⟨ ap p (𝟚-equality-cases₁ e) ⟩
+      p (suc (argMin₂ i (p ∘ suc))) ＝⟨ argMin₂-is-selection-for-Min₂ i (p ∘ suc) ⟩
+      Min₂ i (p ∘ suc)              ＝⟨ refl ⟩
+      min𝟚 ₁ (Min₂ i (p ∘ suc))     ＝⟨ ap (λ - → min𝟚 - (Min₂ i (p ∘ suc))) (e ⁻¹) ⟩
+      min𝟚 (p 𝟎) (Min₂ i (p ∘ suc)) ＝⟨ refl ⟩
+      Min₂ (succ i) p               ∎)
+
+argMax₂-is-selection-for-Max₂ : (i : ℕ)
+                                (p : Fin (i + 1) → 𝟚)
+                              → p (argMax₂ i p) ＝ Max₂ i p
+argMax₂-is-selection-for-Max₂ 0        p = refl
+argMax₂-is-selection-for-Max₂ (succ i) p =
+ 𝟚-equality-cases
+  (λ (e : p 𝟎 ＝ ₀)
+    → p (argMax₂ (succ i) p)        ＝⟨ ap p (𝟚-equality-cases₀ e) ⟩
+      p (suc (argMax₂ i (p ∘ suc))) ＝⟨ argMax₂-is-selection-for-Max₂ i (p ∘ suc) ⟩
+      Max₂ i (p ∘ suc)              ＝⟨ refl ⟩
+      max𝟚 ₀ (Max₂ i (p ∘ suc))     ＝⟨ ap (λ - → max𝟚 - (Max₂ i (p ∘ suc))) (e ⁻¹) ⟩
+      max𝟚 (p 𝟎) (Max₂ i (p ∘ suc)) ＝⟨ refl ⟩
+      Max₂ (succ i) p               ∎)
+  (λ (e : p 𝟎 ＝ ₁)
+     → p (argMax₂ (succ i) p)        ＝⟨ ap p (𝟚-equality-cases₁ e) ⟩
+       p 𝟎                          ＝⟨ e ⟩
+       ₁                            ＝⟨ refl ⟩
+       max𝟚 ₁ (Max₂ i (p ∘ suc))     ＝⟨ ap (λ - → max𝟚 - (Max₂ i (p ∘ suc))) (e ⁻¹) ⟩
+       max𝟚 (p 𝟎) (Max₂ i (p ∘ suc)) ＝⟨ refl ⟩
+       Max₂ (succ i) p               ∎)
+
 \end{code}
diff --git a/source/Fin/ArithmeticViaEquivalence.lagda b/source/Fin/ArithmeticViaEquivalence.lagda
index b9693676b..3a6e3b867 100644
--- a/source/Fin/ArithmeticViaEquivalence.lagda
+++ b/source/Fin/ArithmeticViaEquivalence.lagda
@@ -414,7 +414,7 @@ Geometric definition of the factorial function:
 
 The following are theorems rather than definitions:
 
-\sbegin{code}
+\begin{code}
 
  !-base : 0 ! ＝ 1
  !-base = refl
@@ -495,7 +495,7 @@ spartan MLTT are Π and Σ.
 open import UF.PropIndexedPiSigma
 
 Σ-construction : (n : ℕ) (a : Fin n → ℕ)
-              → Σ k ꞉ ℕ , Fin k ≃ (Σ i ꞉ Fin n , Fin (a i))
+               → Σ k ꞉ ℕ , Fin k ≃ (Σ i ꞉ Fin n , Fin (a i))
 Σ-construction 0 a = 0 , (Fin 0                    ≃⟨ ≃-refl _ ⟩
                          𝟘                        ≃⟨ ≃-sym (prop-indexed-sum-zero id) ⟩
                          (Σ i ꞉ 𝟘 , Fin (a i)) ■)
@@ -611,6 +611,6 @@ natural inductive constructions of ∑ and ∏, it would have been better
 to have defined Fin(succ n) = 𝟙 + Fin n. In retrospect, this
 definition seems more natural in general.
 
-Todo: Corollary. If X is a type and A is an X-indexed family of types,
+TODO: Corollary. If X is a type and A is an X-indexed family of types,
 and if X is finite and A x is finite for every x : X, then the types Σ A
 and Π A are finite.
diff --git a/source/Fin/Bishop.lagda b/source/Fin/Bishop.lagda
index 43fed2cb4..8a7c59ecb 100644
--- a/source/Fin/Bishop.lagda
+++ b/source/Fin/Bishop.lagda
@@ -16,7 +16,6 @@ open import UF.Equiv-FunExt
 open import UF.EquivalenceExamples
 open import UF.FunExt
 open import UF.PropTrunc
-open import UF.Sets-Properties
 open import UF.Subsingletons
 open import UF.UA-FunExt
 open import UF.Univalence
diff --git a/source/Fin/Choice.lagda b/source/Fin/Choice.lagda
index 39299a05e..b70bded61 100644
--- a/source/Fin/Choice.lagda
+++ b/source/Fin/Choice.lagda
@@ -10,19 +10,13 @@ existence.
 module Fin.Choice where
 
 open import Fin.Order
-open import Fin.Properties
 open import Fin.Type
-open import MLTT.Plus-Properties
 open import MLTT.Spartan
-open import Notation.Order
 open import NotionsOfDecidability.Complemented
 open import NotionsOfDecidability.Decidable
-open import UF.DiscreteAndSeparated
-open import UF.Equiv
 open import UF.FunExt
 open import UF.PropTrunc
 open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 
 module _ (pt : propositional-truncations-exist) where
 
diff --git a/source/Fin/Embeddings.lagda b/source/Fin/Embeddings.lagda
index 6f94569ce..4198b825d 100644
--- a/source/Fin/Embeddings.lagda
+++ b/source/Fin/Embeddings.lagda
@@ -6,7 +6,6 @@ Martin Escardo, sometime between 2014 and 2021.
 
 module Fin.Embeddings where
 
-open import UF.Subsingletons
 
 open import Fin.Properties
 open import Fin.Type
@@ -14,12 +13,19 @@ open import Fin.Variation
 open import MLTT.Plus-Properties
 open import MLTT.Spartan
 open import Naturals.Order
+open import Notation.CanonicalMap
 open import Notation.Order
 open import UF.Embeddings
 
 ⟦_⟧ : {n : ℕ} → Fin n → ℕ
 ⟦_⟧ {n} = pr₁ ∘ Fin-prime n
 
+module _ {n : ℕ} where
+
+ instance
+  canonical-map-Fin-ℕ : Canonical-Map (Fin n) ℕ
+  ι {{canonical-map-Fin-ℕ}} = ⟦_⟧ {n}
+
 ⟦⟧-property : {n : ℕ} (k : Fin n) → ⟦ k ⟧ < n
 ⟦⟧-property {n} k = pr₂ (Fin-prime n k)
 
diff --git a/source/Fin/Omega.lagda b/source/Fin/Omega.lagda
index cc54a7869..e50f431a1 100644
--- a/source/Fin/Omega.lagda
+++ b/source/Fin/Omega.lagda
@@ -20,7 +20,6 @@ open import UF.Embeddings
 open import UF.Equiv
 open import UF.ClassicalLogic
 open import UF.FunExt
-open import UF.Subsingletons-FunExt
 open import UF.SubtypeClassifier
 
 having-three-distinct-points-covariant : {X : 𝓤 ̇ } {Y : 𝓥 ̇ }
@@ -121,7 +120,7 @@ Fin-to-Ω-embedding-is-equiv-iff-2-and-EM {𝓤} fe pe 2 (e , e-is-embedding) =
       I₁ = Fin-is-discrete (e⁻¹ p) (e⁻¹ ⊤)
 
       I₂ : is-decidable (e⁻¹ p ＝ e⁻¹ ⊤) → is-decidable (p holds)
-      I₂ = map-is-decidable
+      I₂ = map-decidable
            (λ (r : e⁻¹ p ＝ e⁻¹ ⊤)
                  → equal-⊤-gives-holds p
                     (equivs-are-lc e⁻¹ (inverses-are-equivs e e-is-equiv) r))
diff --git a/source/Fin/Order.lagda b/source/Fin/Order.lagda
index 9a8340a73..538de63bc 100644
--- a/source/Fin/Order.lagda
+++ b/source/Fin/Order.lagda
@@ -15,7 +15,6 @@ open import Notation.Order
 open import NotionsOfDecidability.Decidable
 open import NotionsOfDecidability.Complemented
 open import UF.Base
-open import UF.DiscreteAndSeparated
 open import UF.FunExt
 open import UF.Subsingletons
 open import UF.Subsingletons-FunExt
diff --git a/source/Fin/Pigeonhole.lagda b/source/Fin/Pigeonhole.lagda
index 40194edf8..cea996cee 100644
--- a/source/Fin/Pigeonhole.lagda
+++ b/source/Fin/Pigeonhole.lagda
@@ -6,7 +6,6 @@ Martin Escardo, November-December 2019
 
 module Fin.Pigeonhole where
 
-open import UF.Subsingletons
 
 open import Factorial.Swap
 open import Fin.Bishop
@@ -23,7 +22,6 @@ open import NotionsOfDecidability.Complemented
 open import NotionsOfDecidability.Decidable
 open import UF.DiscreteAndSeparated
 open import UF.Equiv
-open import UF.EquivalenceExamples
 open import UF.FunExt
 open import UF.LeftCancellable
 open import UF.PropTrunc
diff --git a/source/Fin/Properties.lagda b/source/Fin/Properties.lagda
index 063bacbdd..a3aaab4a0 100644
--- a/source/Fin/Properties.lagda
+++ b/source/Fin/Properties.lagda
@@ -10,12 +10,8 @@ open import UF.Subsingletons
 
 open import Factorial.PlusOneLC
 open import Fin.Type
-open import MLTT.Plus-Properties
 open import MLTT.Spartan
 open import MLTT.Unit-Properties
-open import Notation.Order
-open import UF.DiscreteAndSeparated
-open import UF.Embeddings
 open import UF.Equiv
 
 \end{code}
diff --git a/source/Fin/Topology.lagda b/source/Fin/Topology.lagda
index 24a7329ea..c75374bb2 100644
--- a/source/Fin/Topology.lagda
+++ b/source/Fin/Topology.lagda
@@ -14,10 +14,8 @@ module Fin.Topology where
 open import Fin.Bishop
 open import Fin.Properties
 open import Fin.Type
-open import MLTT.Plus-Properties
 open import MLTT.Spartan
 open import MLTT.SpartanList
-open import Notation.Order
 open import TypeTopology.CompactTypes
 open import UF.DiscreteAndSeparated
 open import UF.Equiv
diff --git a/source/Fin/Type.lagda b/source/Fin/Type.lagda
index 6be862eab..796ed79c3 100644
--- a/source/Fin/Type.lagda
+++ b/source/Fin/Type.lagda
@@ -6,7 +6,6 @@ Martin Escardo, 2014.
 
 module Fin.Type where
 
-open import UF.Subsingletons
 
 open import MLTT.Spartan
 open import MLTT.Plus-Properties
@@ -38,9 +37,16 @@ clarity in definitions by pattern matching:
 \begin{code}
 
 pattern 𝟎     = inr ⋆
-pattern 𝟏     = inl (inr ⋆)
-pattern 𝟐     = inl (inl (inr ⋆))
 pattern suc i = inl i
+pattern 𝟏     = suc 𝟎
+pattern 𝟐     = suc 𝟏
+pattern 𝟑     = suc 𝟐
+pattern 𝟒     = suc 𝟑
+pattern 𝟓     = suc 𝟒
+pattern 𝟔     = suc 𝟓
+pattern 𝟕     = suc 𝟔
+pattern 𝟖     = suc 𝟕
+pattern 𝟗     = suc 𝟖
 
 \end{code}
 
diff --git a/source/Fin/Variation.lagda b/source/Fin/Variation.lagda
index 49cd98210..68a5b3e3e 100644
--- a/source/Fin/Variation.lagda
+++ b/source/Fin/Variation.lagda
@@ -6,7 +6,6 @@ Martin Escardo, 2nd December 2019
 
 module Fin.Variation where
 
-open import UF.Subsingletons
 
 open import Fin.Type
 open import MLTT.Spartan
diff --git a/source/Games/Discussion.lagda b/source/Games/Discussion.lagda
index f0897e3a5..247651bc7 100644
--- a/source/Games/Discussion.lagda
+++ b/source/Games/Discussion.lagda
@@ -63,17 +63,13 @@ there.
 
 \begin{code}
 
-open import Games.TypeTrees using ()
 open import MLTT.Spartan
 open import UF.Base
 open import UF.Equiv
 open import UF.EquivalenceExamples
-open import UF.FunExt
 open import UF.PropIndexedPiSigma
 open import UF.Subsingletons
-open import UF.Subsingletons
 open import UF.Subsingletons-FunExt
-open import UF.UA-FunExt
 open import NotionsOfDecidability.Decidable
 \end{code}
 
@@ -710,7 +706,6 @@ modification needed to use ℍ instead:
 
 module illustration (R : Type) where
 
- open import Games.FiniteHistoryDependent using ()
  open import Games.K
 
  open K-definitions R
@@ -763,7 +758,6 @@ the function Ord-to-𝔸 below.
 
 \begin{code}
 
-open import Ordinals.CumulativeHierarchy using ()
 open import Ordinals.Type
 open import Ordinals.OrdinalOfOrdinals ua
 open import Ordinals.Underlying
@@ -816,7 +810,7 @@ hereditarily-decidable→ = transfinite-induction-on-OO _ ϕ
     I : (a : ⟨ α ⟩)
         ((b , l) : ⟨ α ↓ a ⟩)
       → is-decidable (∃ (x , m) ꞉ ⟨ α ↓ a ⟩ , x ≺⟨ α ⟩ b )
-    I a (b , l) = map-is-decidable (∥∥-functor (g a b l)) (∥∥-functor (h a b)) (e b)
+    I a (b , l) = map-decidable (∥∥-functor (g a b l)) (∥∥-functor (h a b)) (e b)
 
     II : (a : ⟨ α ⟩) → is-hereditarily-decidable (Ord-to-𝔸 (α ↓ a))
     II a = f a (e a , I a)
diff --git a/source/Games/Examples.lagda b/source/Games/Examples.lagda
index da96f61fe..a21995223 100644
--- a/source/Games/Examples.lagda
+++ b/source/Games/Examples.lagda
@@ -17,7 +17,6 @@ open import Games.K
 
 module permutations where
 
- open import MLTT.Athenian
 
  no-repetitions : ℕ → Type → 𝑻
  no-repetitions 0        X = []
@@ -72,7 +71,6 @@ module search (fe : Fun-Ext) where
 
 module another-game-representation (R : Type) where
 
- open import Games.FiniteHistoryDependent R
 
  open K-definitions R
 
diff --git a/source/Games/FiniteHistoryDependent.lagda b/source/Games/FiniteHistoryDependent.lagda
index d197fdc9e..b97ef44fa 100644
--- a/source/Games/FiniteHistoryDependent.lagda
+++ b/source/Games/FiniteHistoryDependent.lagda
@@ -1,8 +1,12 @@
 Martin Escardo, Paulo Oliva, 2-27 July 2021
 
-A paper based on this file is available at
-https://doi.org/10.48550/arXiv.2212.07735
-To appear in TCS.
+The following paper is based on this file:
+
+  [0] Martin Escardo and Paulo Oliva. Higher-order games with
+      dependent types.  Theoretical Computer Science, Volume 974, 29
+      September 2023, 114111.
+      https://doi.org/10.48550/arXiv.2212.07735
+      https://doi.org/10.1016/j.tcs.2023.114111
 
 We study finite, history dependent games of perfect information using
 selection functions and dependent-type trees.
diff --git a/source/Games/JK.lagda b/source/Games/JK.lagda
index 04dce7b63..a94916b4a 100644
--- a/source/Games/JK.lagda
+++ b/source/Games/JK.lagda
@@ -8,8 +8,6 @@ open import MLTT.Spartan hiding (J)
 
 module Games.JK where
 
-open import UF.FunExt
-open import Games.Monad
 open import Games.J
 open import Games.K
 
diff --git a/source/Games/Main.lagda b/source/Games/Main.lagda
index 3c35a44e9..b4c4b6843 100644
--- a/source/Games/Main.lagda
+++ b/source/Games/Main.lagda
@@ -18,14 +18,10 @@ The Haskell code is generated in TypeTopology/source/MAlonzo.
 
 module Games.Main where
 
-open import MLTT.Athenian
-open import MLTT.Spartan
 open import Unsafe.Haskell
 
 
 {-
-open import Games.TicTacToe0
-open import Fin.Type renaming (Fin to Fin')
 
 Fin-to-ℕ : {n : ℕ} → Fin' n → ℕ
 Fin-to-ℕ {succ n} (inl x) = Fin-to-ℕ x
diff --git a/source/Games/NonEmptyList.lagda b/source/Games/NonEmptyList.lagda
index d5c42c099..1f0f70c2f 100644
--- a/source/Games/NonEmptyList.lagda
+++ b/source/Games/NonEmptyList.lagda
@@ -11,8 +11,6 @@ open import MLTT.Spartan hiding (J)
 module Games.NonEmptyList where
 
 open import Games.Monad
-open import UF.Equiv
-open import UF.FunExt
 
 data neList (X : Type) : Type where
  [_]  : X → neList X
diff --git a/source/Games/TicTacToe1.lagda b/source/Games/TicTacToe1.lagda
index 3310bf8bd..e1cdb5117 100644
--- a/source/Games/TicTacToe1.lagda
+++ b/source/Games/TicTacToe1.lagda
@@ -25,7 +25,6 @@ open import UF.DiscreteAndSeparated
 𝟛 : Type
 𝟛 = Fin 3
 
-open import Games.TypeTrees
 open import Games.FiniteHistoryDependent 𝟛
 open import Games.Constructor 𝟛
 open import Games.J
diff --git a/source/Games/TicTacToe2.lagda b/source/Games/TicTacToe2.lagda
index e26b46136..40abc13a4 100644
--- a/source/Games/TicTacToe2.lagda
+++ b/source/Games/TicTacToe2.lagda
@@ -12,7 +12,6 @@ module Games.TicTacToe2 where
 
 open import MLTT.Spartan hiding (J)
 open import MLTT.Fin
-open import MLTT.List
 
 data 𝟛 : Type where
  O-wins draw X-wins : 𝟛
@@ -22,7 +21,6 @@ open import Games.FiniteHistoryDependent 𝟛
 open import Games.TypeTrees
 open import Games.J
 open import MLTT.Athenian
-open import TypeTopology.SigmaDiscreteAndTotallySeparated
 
 open list-util
 
@@ -179,7 +177,6 @@ l₂-test = refl
 
 {- slow
 
-open import Athenian
 
 u₂-test : s₂ ＝ (𝟎 :: refl)
            :: ((𝟒 :: refl)
diff --git a/source/Games/Transformer.lagda b/source/Games/Transformer.lagda
index f5337f46b..fde09cdfa 100644
--- a/source/Games/Transformer.lagda
+++ b/source/Games/Transformer.lagda
@@ -35,9 +35,7 @@ open import Games.Monad
 open import Games.J
 open import Games.K
 open import MLTT.Spartan hiding (J)
-open import UF.Base
 open import UF.FunExt
-open import UF.Equiv
 
 module Games.Transformer
         (fe : Fun-Ext)
diff --git a/source/Games/index.lagda b/source/Games/index.lagda
index 90ac63cb1..bfa949a4a 100644
--- a/source/Games/index.lagda
+++ b/source/Games/index.lagda
@@ -9,26 +9,26 @@ Refactored and slightly improved October 2022, and then again in April
 
 module Games.index where
 
-open import Games.Constructor             -- For simplifying the construction of games.
-open import Games.Examples                -- Miscelaneous small examples.
-open import Games.FiniteHistoryDependent  -- Theory of finite history dependent games.
-open import Games.Transformer             -- With additional monad for irrational players.
-open import Games.J                       -- Selection monad.
-open import Games.K                       -- Continuation (or quantifier) monad.
-open import Games.JK                      -- Relationship between the two mondas.
-open import Games.Monad                   -- (Automatically strong, wild) monads on types.
-open import Games.Reader
-open import Games.NonEmptyList
-open import Games.TicTacToe0
-open import Games.TicTacToe1              -- Like TicTacToe0 but using Games.Constructor.
-open import Games.TicTacToe2              -- More efficient and less elegant version.
-open import Games.TypeTrees               -- Dependent type trees.
-open import Games.alpha-beta              -- Many new things for efficiency.
-open import Games.Discussion
+import Games.Constructor             -- For simplifying the construction of games.
+import Games.Examples                -- Miscelaneous small examples.
+import Games.FiniteHistoryDependent  -- Theory of finite history dependent games.
+import Games.Transformer             -- With additional monad for irrational players.
+import Games.J                       -- Selection monad.
+import Games.K                       -- Continuation (or quantifier) monad.
+import Games.JK                      -- Relationship between the two mondas.
+import Games.Monad                   -- (Automatically strong, wild) monads on types.
+import Games.Reader
+import Games.NonEmptyList
+import Games.TicTacToe0
+import Games.TicTacToe1              -- Like TicTacToe0 but using Games.Constructor.
+import Games.TicTacToe2              -- More efficient and less elegant version.
+import Games.TypeTrees               -- Dependent type trees.
+import Games.alpha-beta              -- Many new things for efficiency.
+import Games.Discussion
 
--- open import Games.Main                 -- To be able to compile for efficieny.
-                                          -- Can't be imported here as it's not --safe.
-                                          -- This is for Agda compilation to Haskell of
-                                          -- examples to be able to run them more efficiently.
+-- import Games.Main                 -- To be able to compile for efficieny.
+                                     -- Can't be imported here as it's not --safe.
+                                     -- This is for Agda compilation to Haskell of
+                                     -- examples to be able to run them more efficiently.
 
 \end{code}
diff --git a/source/GamesExperimental/Constructor.lagda b/source/GamesExperimental/Constructor.lagda
index 8943b6f24..187266d7d 100644
--- a/source/GamesExperimental/Constructor.lagda
+++ b/source/GamesExperimental/Constructor.lagda
@@ -79,7 +79,7 @@ in a convenient way.
 
 build-GameJ : (r     : R)
               (Board : 𝓥  ̇ )
-              (τ     : Board → R + (Σ M ꞉ 𝓤 ̇  , (M → Board) × J M))
+              (τ     : Board → R + (Σ M ꞉ 𝓤 ̇ , (M → Board) × J M))
               (n     : ℕ)
               (b     : Board)
             → GameJ
@@ -89,7 +89,7 @@ build-GameJ r Board τ n b = h n b
   h 0        b = leaf r
   h (succ n) b = g (τ b)
    where
-    g : (f : R + (Σ M ꞉ 𝓤  ̇  , (M → Board) × J M)) → GameJ
+    g : (f : R + (Σ M ꞉ 𝓤  ̇ , (M → Board) × J M)) → GameJ
     g (inl r)              = leaf r
     g (inr (M , play , ε)) = branch M Xf ε
      where
@@ -98,7 +98,7 @@ build-GameJ r Board τ n b = h n b
 
 build-Game : (r  : R)
              (Board : 𝓥 ̇ )
-             (τ     : Board → R + (Σ M ꞉ 𝓤 ̇  , (M → Board) × J M))
+             (τ     : Board → R + (Σ M ꞉ 𝓤 ̇ , (M → Board) × J M))
              (n     : ℕ)
              (b     : Board)
            → Game
diff --git a/source/GamesExperimental/Discussion.lagda b/source/GamesExperimental/Discussion.lagda
index 559acc28d..5812b759a 100644
--- a/source/GamesExperimental/Discussion.lagda
+++ b/source/GamesExperimental/Discussion.lagda
@@ -2,7 +2,7 @@ sSetMartin Escardo, Paulo Oliva, 7-22 June 2023
 
 We relate our game trees to Aczel's W type of CZF sets in various ways.
 
-Peter Aczel. "The ?  ̇  Theoretic Interpretation of Constructive Set
+Peter Aczel. "The Type Theoretic Interpretation of Constructive Set
 Theory". Studies in Logic and the Foundations of Mathematics, Volume
 96, 1978, Pages 55-66.  https://doi.org/10.1016/S0049-237X(08)71989-X
 
@@ -70,17 +70,14 @@ there.
 
 \begin{code}
 
-open import Games.TypeTrees using ()
 open import UF.Base
 open import UF.Equiv
 open import UF.EquivalenceExamples
-open import UF.FunExt
 open import UF.PropIndexedPiSigma
 open import UF.Subsingletons
-open import UF.Subsingletons
 open import UF.Subsingletons-FunExt
-open import UF.UA-FunExt
 open import NotionsOfDecidability.Decidable
+
 \end{code}
 
 The following is the type of type trees, whose nodes X represent the
@@ -716,7 +713,6 @@ modification needed to use ℍ instead:
 
 module illustration (R : 𝓤  ̇ ) where
 
- open import GamesExperimental.FiniteHistoryDependent using ()
  open import GamesExperimental.K
 
  open K-definitions R
@@ -769,7 +765,6 @@ the function Ord-to-𝔸 below.
 
 \begin{code}
 
-open import Ordinals.CumulativeHierarchy using ()
 open import Ordinals.Type
 open import Ordinals.OrdinalOfOrdinals ua
 open import Ordinals.Underlying
@@ -822,7 +817,7 @@ hereditarily-decidable→ = transfinite-induction-on-OO _ ϕ
     I : (a : ⟨ α ⟩)
         ((b , l) : ⟨ α ↓ a ⟩)
       → is-decidable (∃ (x , m) ꞉ ⟨ α ↓ a ⟩ , x ≺⟨ α ⟩ b )
-    I a (b , l) = map-is-decidable (∥∥-functor (g a b l)) (∥∥-functor (h a b)) (e b)
+    I a (b , l) = map-decidable (∥∥-functor (g a b l)) (∥∥-functor (h a b)) (e b)
 
     II : (a : ⟨ α ⟩) → is-hereditarily-decidable (Ord-to-𝔸 (α ↓ a))
     II a = f a (e a , I a)
diff --git a/source/GamesExperimental/Examples.lagda b/source/GamesExperimental/Examples.lagda
index 6ef66012a..cb1dd807b 100644
--- a/source/GamesExperimental/Examples.lagda
+++ b/source/GamesExperimental/Examples.lagda
@@ -17,9 +17,8 @@ open import GamesExperimental.K
 
 module permutations where
 
- open import MLTT.Athenian
 
- no-repetitions : ℕ → 𝓤 ̇  → 𝑻 {𝓤}
+ no-repetitions : ℕ → 𝓤 ̇ → 𝑻 {𝓤}
  no-repetitions 0        X = []
  no-repetitions (succ n) X = X ∷ λ (x : X) → no-repetitions n (Σ y ꞉ X , y ≠ x)
 
@@ -72,7 +71,6 @@ module search (fe : Fun-Ext) where
 
 module another-game-representation {𝓤 𝓦₀ : Universe} (R : 𝓦₀ ̇ ) where
 
- open import GamesExperimental.FiniteHistoryDependent {𝓤} {𝓦₀} R
 
  open K-definitions R
 
diff --git a/source/GamesExperimental/FiniteHistoryDependent.lagda b/source/GamesExperimental/FiniteHistoryDependent.lagda
index ca190dc41..c7be60128 100644
--- a/source/GamesExperimental/FiniteHistoryDependent.lagda
+++ b/source/GamesExperimental/FiniteHistoryDependent.lagda
@@ -1,8 +1,12 @@
 Martin Escardo, Paulo Oliva, 2-27 July 2021
 
-A paper based on this file is available at
-https://doi.org/10.48550/arXiv.2212.07735
-To appear in TCS.
+The following paper is based on this file:
+
+  [0] Martin Escardo and Paulo Oliva. Higher-order games with
+      dependent types.  Theoretical Computer Science, Volume 974, 29
+      September 2023, 114111.
+      https://doi.org/10.48550/arXiv.2212.07735
+      https://doi.org/10.1016/j.tcs.2023.114111
 
 We study finite, history dependent games of perfect information using
 selection functions and dependent-type trees.
diff --git a/source/GamesExperimental/J.lagda b/source/GamesExperimental/J.lagda
index 96d5b4ac6..23726e03a 100644
--- a/source/GamesExperimental/J.lagda
+++ b/source/GamesExperimental/J.lagda
@@ -70,12 +70,12 @@ private
       again-by-assoc = ap (λ - → 𝕖 𝕘 (𝕖 𝕗 (ε -)))
                           (dfunext fe (λ x → (assoc 𝓣 _ _ _)⁻¹))
 
-𝕁' : Fun-Ext → 𝓦₀  ̇  → Monad
+𝕁' : Fun-Ext → 𝓦₀  ̇ → Monad
 𝕁' fe = 𝕁-transf fe 𝕀𝕕
 
 module J-definitions (R : 𝓦₀ ̇ ) where
 
- J : 𝓤 ̇  → 𝓦₀ ⊔ 𝓤  ̇
+ J : 𝓤 ̇ → 𝓦₀ ⊔ 𝓤  ̇
  J = functor (𝕁 R)
 
  _⊗ᴶ_ : {X : 𝓤 ̇ } {Y : X → 𝓥 ̇ }
@@ -118,10 +118,10 @@ module JT-definitions
  𝕁𝕋 : Monad
  𝕁𝕋 = 𝕁-transf fe 𝓣 R
 
- JT : 𝓤 ̇  → ℓ 𝓣 𝓦₀ ⊔ ℓ 𝓣 𝓤 ⊔ 𝓤  ̇
+ JT : 𝓤 ̇ → ℓ 𝓣 𝓦₀ ⊔ ℓ 𝓣 𝓤 ⊔ 𝓤  ̇
  JT = functor 𝕁𝕋
 
- KT : 𝓤 ̇  → 𝓦₀ ⊔ ℓ 𝓣 𝓦₀ ⊔ 𝓤  ̇
+ KT : 𝓤 ̇ → 𝓦₀ ⊔ ℓ 𝓣 𝓦₀ ⊔ 𝓤  ̇
  KT X = (X → T R) → R
 
  ηᴶᵀ : {X : 𝓤 ̇ } → X → JT X
diff --git a/source/GamesExperimental/JK.lagda b/source/GamesExperimental/JK.lagda
index c3ad17cb3..5ce6f107c 100644
--- a/source/GamesExperimental/JK.lagda
+++ b/source/GamesExperimental/JK.lagda
@@ -8,8 +8,6 @@ open import MLTT.Spartan hiding (J)
 
 module GamesExperimental.JK where
 
-open import UF.FunExt
-open import GamesExperimental.Monad
 open import GamesExperimental.J
 open import GamesExperimental.K
 
diff --git a/source/GamesExperimental/K.lagda b/source/GamesExperimental/K.lagda
index 06110a97d..0026d4ad9 100644
--- a/source/GamesExperimental/K.lagda
+++ b/source/GamesExperimental/K.lagda
@@ -14,7 +14,7 @@ private
  variable
   𝓦₀ : Universe
 
-𝕂 : 𝓦₀ ̇  → Monad
+𝕂 : 𝓦₀ ̇ → Monad
 𝕂 {𝓦₀} R = record {
        ℓ       = λ 𝓤 → 𝓤 ⊔ 𝓦₀ ;
        functor = λ X → (X → R) → R ;
@@ -27,7 +27,7 @@ private
 
 module K-definitions (R : 𝓦₀ ̇ ) where
 
- K : 𝓤 ̇  → 𝓦₀ ⊔ 𝓤  ̇
+ K : 𝓤 ̇ → 𝓦₀ ⊔ 𝓤  ̇
  K = functor (𝕂 R)
 
  _⊗ᴷ_ : {X : 𝓤 ̇ } {Y : X → 𝓥 ̇ }
diff --git a/source/GamesExperimental/NonEmptyList.lagda b/source/GamesExperimental/NonEmptyList.lagda
index 0ac10a786..254bdbcd8 100644
--- a/source/GamesExperimental/NonEmptyList.lagda
+++ b/source/GamesExperimental/NonEmptyList.lagda
@@ -11,10 +11,8 @@ open import MLTT.Spartan hiding (J)
 module GamesExperimental.NonEmptyList where
 
 open import GamesExperimental.Monad
-open import UF.Equiv
-open import UF.FunExt
 
-data neList (X : 𝓤 ̇ ) : 𝓤 ̇  where
+data neList (X : 𝓤 ̇ ) : 𝓤 ̇ where
  [_]  : X → neList X
  _::_ : X → neList X → neList X
 
diff --git a/source/GamesExperimental/Reader.lagda b/source/GamesExperimental/Reader.lagda
index 6b28a85ad..ad4aac04d 100644
--- a/source/GamesExperimental/Reader.lagda
+++ b/source/GamesExperimental/Reader.lagda
@@ -10,7 +10,7 @@ module GamesExperimental.Reader where
 
 open import GamesExperimental.Monad
 
-Reader : {𝓦₀ : Universe} → 𝓦₀ ̇  → Monad
+Reader : {𝓦₀ : Universe} → 𝓦₀ ̇ → Monad
 Reader {𝓦₀} A = record {
             ℓ       = λ 𝓤 → 𝓤 ⊔ 𝓦₀ ;
             functor = λ X → A → X ;
diff --git a/source/GamesExperimental/TicTacToe0.lagda b/source/GamesExperimental/TicTacToe0.lagda
index 3aa6ff137..e1a317bfe 100644
--- a/source/GamesExperimental/TicTacToe0.lagda
+++ b/source/GamesExperimental/TicTacToe0.lagda
@@ -51,7 +51,7 @@ but in this case it is convenient to do so:
 
 \begin{code}
 
-data Player : 𝓤₀ ̇  where
+data Player : 𝓤₀ ̇ where
  X O : Player
 
 opponent : Player → Player
diff --git a/source/GamesExperimental/TicTacToe1.lagda b/source/GamesExperimental/TicTacToe1.lagda
index 8732b01a0..0b49bb1ca 100644
--- a/source/GamesExperimental/TicTacToe1.lagda
+++ b/source/GamesExperimental/TicTacToe1.lagda
@@ -23,7 +23,6 @@ open import UF.DiscreteAndSeparated
 𝟛 : 𝓤₀ ̇
 𝟛 = Fin 3
 
-open import GamesExperimental.TypeTrees {𝓤₀}
 open import GamesExperimental.FiniteHistoryDependent {𝓤₀} {𝓤₀} 𝟛
 open import GamesExperimental.Constructor {𝓤₀} {𝓤₀} 𝟛
 open import GamesExperimental.J
@@ -31,7 +30,7 @@ open import GamesExperimental.J
 tic-tac-toe₁ : Game
 tic-tac-toe₁ = build-Game draw Board transition 9 board₀
  where
-  data Player : 𝓤₀ ̇  where
+  data Player : 𝓤₀ ̇ where
    X O : Player
 
   opponent : Player → Player
@@ -124,12 +123,12 @@ Convention: in a board (p , A), p is the opponent of the the current player.
   play : (b : Board) → Move b → Board
   play (p , A) m = opponent p , update p A m
 
-  transition : Board → 𝟛 + (Σ M ꞉ 𝓤₀ ̇  , (M → Board) × J M)
+  transition : Board → 𝟛 + (Σ M ꞉ 𝓤₀ ̇ , (M → Board) × J M)
   transition b@(p , A) = f b (wins p A)
    where
     f : (b : Board)
       → Bool
-      → 𝟛 + (Σ M ꞉ 𝓤₀ ̇  , (M → Board) × J M)
+      → 𝟛 + (Σ M ꞉ 𝓤₀ ̇ , (M → Board) × J M)
     f (p , A) true  = inl (value p)
     f b       false = Cases (Move-decidable b)
                        (λ (m : Move b)
diff --git a/source/GamesExperimental/TicTacToe2.lagda b/source/GamesExperimental/TicTacToe2.lagda
index ed516ae5f..1bc14431e 100644
--- a/source/GamesExperimental/TicTacToe2.lagda
+++ b/source/GamesExperimental/TicTacToe2.lagda
@@ -12,7 +12,6 @@ module GamesExperimental.TicTacToe2 where
 
 open import MLTT.Spartan hiding (J)
 open import MLTT.Fin
-open import MLTT.List
 
 data 𝟛 : Type where
  O-wins draw X-wins : 𝟛
@@ -22,7 +21,6 @@ open import GamesExperimental.FiniteHistoryDependent {𝓤₀} {𝓤₀} 𝟛
 open import GamesExperimental.TypeTrees {𝓤₀}
 open import GamesExperimental.J
 open import MLTT.Athenian
-open import TypeTopology.SigmaDiscreteAndTotallySeparated
 
 open list-util
 
@@ -34,12 +32,12 @@ tic-tac-toe₂J = build-GameJ draw Board transition 9 board₀
   flip draw   = draw
   flip X-wins = O-wins
 
-  data Player : 𝓤₀ ̇  where
+  data Player : 𝓤₀ ̇ where
    O X : Player
 
   Cell = Fin 9
 
-  record Board : 𝓤₀ ̇  where
+  record Board : 𝓤₀ ̇ where
    pattern
    constructor board
    field
@@ -140,7 +138,7 @@ predicate q:
   play (board X as xs os) (c , e) = board O (remove c as) (insert c xs) os
   play (board O as xs os) (c , e) = board X (remove c as) xs            (insert c os)
 
-  transition : Board → 𝟛 + (Σ M ꞉ 𝓤₀ ̇  , (M → Board) × J M)
+  transition : Board → 𝟛 + (Σ M ꞉ 𝓤₀ ̇ , (M → Board) × J M)
   transition b@(board next as xs os) =
    if wins b
    then inl (opponent-wins next)
@@ -179,7 +177,6 @@ l₂-test = refl
 
 {- slow
 
-open import Athenian
 
 u₂-test : s₂ ＝ (𝟎 :: refl)
            :: ((𝟒 :: refl)
diff --git a/source/GamesExperimental/Transformer.lagda b/source/GamesExperimental/Transformer.lagda
index 4eee7887e..4c7547daf 100644
--- a/source/GamesExperimental/Transformer.lagda
+++ b/source/GamesExperimental/Transformer.lagda
@@ -34,9 +34,7 @@ open import GamesExperimental.Monad
 open import GamesExperimental.J
 open import GamesExperimental.K
 open import MLTT.Spartan hiding (J)
-open import UF.Base
 open import UF.FunExt
-open import UF.Equiv
 
 module GamesExperimental.Transformer
         (fe : Fun-Ext)
diff --git a/source/GamesExperimental/TypeTrees.lagda b/source/GamesExperimental/TypeTrees.lagda
index 759c6fa41..dfa829d11 100644
--- a/source/GamesExperimental/TypeTrees.lagda
+++ b/source/GamesExperimental/TypeTrees.lagda
@@ -98,15 +98,15 @@ it:
 
 \begin{code}
 
-data structure₁ (S : 𝓤  ̇  → 𝓥 ̇ ) : 𝑻 → 𝓤 ⁺ ⊔ 𝓥 ̇ where
+data structure₁ (S : 𝓤  ̇ → 𝓥 ̇ ) : 𝑻 → 𝓤 ⁺ ⊔ 𝓥 ̇ where
  []  : structure₁ S []
  _∷_ : {X : 𝓤  ̇ } {Xf : X → 𝑻} → S X → ((x : X) → structure₁ S (Xf x)) → structure₁ S (X ∷ Xf)
 
-structure-up : (S : 𝓤 ̇  → 𝓥 ̇ ) (Xt : 𝑻) → structure S Xt → structure₁ S Xt
+structure-up : (S : 𝓤 ̇ → 𝓥 ̇ ) (Xt : 𝑻) → structure S Xt → structure₁ S Xt
 structure-up S []      ⟨⟩         = []
 structure-up S (X ∷ Xf) (s :: sf) = s ∷ (λ x → structure-up S (Xf x) (sf x))
 
-structure-down : (S : 𝓤 ̇  → 𝓥 ̇ ) (Xt : 𝑻) → structure₁ S Xt → structure S Xt
+structure-down : (S : 𝓤 ̇ → 𝓥 ̇ ) (Xt : 𝑻) → structure₁ S Xt → structure S Xt
 structure-down S []      []        = ⟨⟩
 structure-down S (X ∷ Xf) (s ∷ sf) = s :: (λ x → structure-down S (Xf x) (sf x))
 
@@ -121,7 +121,7 @@ _is-hereditarily_ : 𝑻 → (𝓤 ̇ → 𝓥 ̇ ) → 𝓤 ⊔ 𝓥  ̇
 (X ∷ Xf) is-hereditarily P = P X × ((x : X) → Xf x is-hereditarily P)
 
 being-hereditary-is-prop : Fun-Ext
-                         → (P : 𝓤 ̇  → 𝓥 ̇ )
+                         → (P : 𝓤 ̇ → 𝓥 ̇ )
                          → ((X : 𝓤 ̇ ) → is-prop (P X))
                          → (Xt : 𝑻) → is-prop (Xt is-hereditarily P)
 being-hereditary-is-prop fe P P-is-prop-valued [] = 𝟙-is-prop
diff --git a/source/GamesExperimental/alpha-beta-examples.lagda b/source/GamesExperimental/alpha-beta-examples.lagda
index 37820c811..07f60bba1 100644
--- a/source/GamesExperimental/alpha-beta-examples.lagda
+++ b/source/GamesExperimental/alpha-beta-examples.lagda
@@ -45,8 +45,6 @@ We now define standard minimax games.
 
 module GamesExperimental.alpha-beta-examples where
 
-open import GamesExperimental.J
-open import GamesExperimental.K
 open import MLTT.Athenian
 open import MLTT.Fin
 open import Naturals.Order
@@ -96,7 +94,6 @@ module example-from-wikipedia where
 
  module _ where
 
-  open import Naturals.Order
   open minimax
 
   wikipedia-G : Game ℕ
@@ -142,7 +139,6 @@ module example-from-wikipedia' where
 
 module example-from-wikipedia' where
 
- open import GamesExperimental.alpha-beta {?} {?} ? ? ?
 
  wikipedia-G⋆ : Game (ℕ × ℕ → ℕ × Path wikipedia-tree)
  wikipedia-G⋆ = G⋆
@@ -234,7 +230,7 @@ module tic-tac-toe where
   value : Board → R
   value (x , o) = if wins x then 2 else if wins o then 0 else 1
 
-  data Player : 𝓤₀  ̇  where
+  data Player : 𝓤₀  ̇ where
    X O : Player
 
   maximizing-player : Player
@@ -308,7 +304,7 @@ module tic-tac-toe where
   TTT-tree-is-listed⁺ : structure listed⁺ TTT-tree
   TTT-tree-is-listed⁺ = perm-tree-is-listed⁺ all-moves
 
-  data Player : 𝓤₀  ̇  where
+  data Player : 𝓤₀  ̇ where
    X O : Player
 
   opponent : Player → Player
diff --git a/source/GamesExperimental/alpha-beta.lagda b/source/GamesExperimental/alpha-beta.lagda
index 2d18c6252..556e2ab4c 100644
--- a/source/GamesExperimental/alpha-beta.lagda
+++ b/source/GamesExperimental/alpha-beta.lagda
@@ -55,7 +55,6 @@ open import GamesExperimental.J
 open import GamesExperimental.K
 open import GamesExperimental.TypeTrees {𝓤} public
 open import MLTT.Athenian
-open import MLTT.Fin
 open import UF.FunExt
 
 _≥_ : R → R → 𝓥 ̇
diff --git a/source/GamesExperimental/index.lagda b/source/GamesExperimental/index.lagda
index 5622b0892..fe8a6a482 100644
--- a/source/GamesExperimental/index.lagda
+++ b/source/GamesExperimental/index.lagda
@@ -9,25 +9,25 @@ Refactored and slightly improved October 2022, and then again in April
 
 module GamesExperimental.index where
 
-open import GamesExperimental.Constructor             -- For simplifying the construction of games.
-open import GamesExperimental.Examples                -- Miscelaneous small examples.
-open import GamesExperimental.FiniteHistoryDependent  -- Theory of finite history dependent games.
-open import GamesExperimental.Transformer             -- With additional monad for irrational players.
-open import GamesExperimental.J                       -- Selection monad.
-open import GamesExperimental.K                       -- Continuation (or quantifier) monad.
-open import GamesExperimental.JK                      -- Relationship between the two mondas.
-open import GamesExperimental.Monad                   -- (Automatically strong, wild) monads on suitable types.
-open import GamesExperimental.Reader
-open import GamesExperimental.NonEmptyList
-open import GamesExperimental.TicTacToe0
-open import GamesExperimental.TicTacToe1              -- Like TicTacToe0 but using GamesExperimental.Constructor.
-open import GamesExperimental.TicTacToe2              -- More efficient and less elegant version.
-open import GamesExperimental.TypeTrees               -- Dependent type trees.
-open import GamesExperimental.alpha-beta              -- Many new things for efficiency.
-open import GamesExperimental.alpha-beta-examples
-open import GamesExperimental.Discussion
+import GamesExperimental.Constructor             -- For simplifying the construction of games.
+import GamesExperimental.Examples                -- Miscelaneous small examples.
+import GamesExperimental.FiniteHistoryDependent  -- Theory of finite history dependent games.
+import GamesExperimental.Transformer             -- With additional monad for irrational players.
+import GamesExperimental.J                       -- Selection monad.
+import GamesExperimental.K                       -- Continuation (or quantifier) monad.
+import GamesExperimental.JK                      -- Relationship between the two mondas.
+import GamesExperimental.Monad                   -- (Automatically strong, wild) monads on suitable types.
+import GamesExperimental.Reader
+import GamesExperimental.NonEmptyList
+import GamesExperimental.TicTacToe0
+import GamesExperimental.TicTacToe1              -- Like TicTacToe0 but using GamesExperimental.Constructor.
+import GamesExperimental.TicTacToe2              -- More efficient and less elegant version.
+import GamesExperimental.TypeTrees               -- Dependent type trees.
+import GamesExperimental.alpha-beta              -- Many new things for efficiency.
+import GamesExperimental.alpha-beta-examples
+import GamesExperimental.Discussion
 
--- open import GamesExperimental.Main                 -- To be able to compile for efficieny.
+-- import GamesExperimental.Main                 -- To be able to compile for efficieny.
                                           -- Can't be imported here as it's not --safe.
                                           -- This is for Agda compilation to Haskell of
                                           -- examples to be able to run them more efficiently.
diff --git a/source/Groups/Cokernel.lagda b/source/Groups/Cokernel.lagda
index a4421f10e..e8187630c 100644
--- a/source/Groups/Cokernel.lagda
+++ b/source/Groups/Cokernel.lagda
@@ -23,12 +23,8 @@ TODO: adapt to use (small) quotients defined in UF-Quotient
 
 open import MLTT.Spartan
 open import Quotient.Type
-open import UF.Base hiding (_≈_)
 open import UF.Subsingletons
 open import UF.Equiv
-open import UF.EquivalenceExamples
-open import UF.Retracts
-open import UF.Embeddings
 open import UF.FunExt
 open import UF.PropTrunc
 
@@ -42,8 +38,6 @@ module Groups.Cokernel
 open general-set-quotients-exist sq
 
 open import Groups.Homomorphisms
-open import Groups.Image
-open import Groups.Kernel
 open import Groups.Quotient pt fe sq
 open import Groups.Triv
 open import Groups.Type renaming (_≅_ to _≣_)
diff --git a/source/Groups/Free.lagda b/source/Groups/Free.lagda
index 6b65c0b98..58c5a0d07 100644
--- a/source/Groups/Free.lagda
+++ b/source/Groups/Free.lagda
@@ -46,7 +46,6 @@ open import MLTT.List
                       ++-assoc to ◦-assoc)
 
 open import MLTT.Spartan
-open import MLTT.Two
 open import MLTT.Two-Properties
 open import Quotient.Effectivity
 open import Quotient.FromSetReplacement
@@ -1795,7 +1794,7 @@ Theorem₁[large-free-groups-from-set-quotients] {𝓤} fe pe sq A A-ls =
   open resize-universal-map fe pe pt
         A
         Id⟦ A-ls ⟧
-        (λ _ → ⟦ A-ls ⟧-refl)
+        (λ _ → ＝⟦ A-ls ⟧-refl)
         (λ _ _ → ＝⟦ A-ls ⟧-gives-＝)
         (λ 𝓤 → 𝓤)
         sq
@@ -2049,7 +2048,7 @@ Theorem₂[free-groups-of-large-locally-small-types] {𝓤} pt fe pe A A-ls =
   open resize-free-group fe pe pt
         A
         Id⟦ A-ls ⟧
-        (λ _ → ⟦ A-ls ⟧-refl)
+        (λ _ → ＝⟦ A-ls ⟧-refl)
         (λ _ _ → ＝⟦ A-ls ⟧-gives-＝)
 
 \end{code}
diff --git a/source/Groups/Homomorphisms.lagda b/source/Groups/Homomorphisms.lagda
index d0f4e6bd2..502007556 100644
--- a/source/Groups/Homomorphisms.lagda
+++ b/source/Groups/Homomorphisms.lagda
@@ -13,8 +13,6 @@ open import MLTT.Spartan
 open import UF.Base
 open import UF.Subsingletons
 open import UF.Equiv
-open import UF.EquivalenceExamples
-open import UF.Retracts
 open import UF.Embeddings
 open import UF.PropTrunc
 open import Groups.Type renaming (_≅_ to _≣_)
diff --git a/source/Groups/Large.lagda b/source/Groups/Large.lagda
index 0fc9dc092..f8e4f4333 100644
--- a/source/Groups/Large.lagda
+++ b/source/Groups/Large.lagda
@@ -44,7 +44,7 @@ with no small copy.
 
 \begin{code}
 
-large-group-with-no-small-copy : (Σ A ꞉ 𝓤 ⁺ ̇  , is-set A
+large-group-with-no-small-copy : (Σ A ꞉ 𝓤 ⁺ ̇ , is-set A
                                               × is-large A
                                               × is-locally-small A)
                                → Σ 𝓕 ꞉ Group (𝓤 ⁺) , ((𝓖 : Group 𝓤) → ¬ (𝓖 ≅ 𝓕))
diff --git a/source/Groups/Quotient.lagda b/source/Groups/Quotient.lagda
index 690976416..981b52275 100644
--- a/source/Groups/Quotient.lagda
+++ b/source/Groups/Quotient.lagda
@@ -24,16 +24,9 @@ TODO: adapt to use (small) quotients defined in UF-Quotient
 
 open import MLTT.Spartan
 open import Quotient.Type
-open import UF.Base hiding (_≈_)
-open import UF.Embeddings
-open import UF.Equiv
-open import UF.EquivalenceExamples
 open import UF.FunExt
 open import UF.PropTrunc
-open import UF.Retracts
 open import UF.Sets
-open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 
 module Groups.Quotient
         (pt  : propositional-truncations-exist)
diff --git a/source/Groups/Torsors.lagda b/source/Groups/Torsors.lagda
index 04f6448dc..162f9bbfa 100644
--- a/source/Groups/Torsors.lagda
+++ b/source/Groups/Torsors.lagda
@@ -20,12 +20,9 @@ open import UF.Subsingletons
 open import UF.Equiv
 open import UF.EquivalenceExamples
 open import UF.Embeddings
-open import UF.Univalence
 open import UF.Equiv-FunExt
 open import UF.FunExt
-open import UF.UA-FunExt
 open import UF.Subsingletons-FunExt
-open import UF.Retracts
 open import UF.PropTrunc
 
 open import Groups.Type renaming (_≅_ to _≣_)
diff --git a/source/Groups/Triv.lagda b/source/Groups/Triv.lagda
index cfcd8ecac..6f091236e 100644
--- a/source/Groups/Triv.lagda
+++ b/source/Groups/Triv.lagda
@@ -11,13 +11,7 @@ July 1, 2021
 
 
 open import Groups.Type renaming (_≅_ to _≣_)
-open import MLTT.Id
 open import MLTT.Spartan
-open import MLTT.Unit
-open import MLTT.Unit-Properties
-open import UF.Base
-open import UF.Equiv
-open import UF.Retracts
 open import UF.Sets
 open import UF.Subsingletons
 open import UF.Subsingletons-Properties
diff --git a/source/InjectiveTypes/Article.lagda b/source/InjectiveTypes/Article.lagda
index 7fe769e33..2034b904b 100644
--- a/source/InjectiveTypes/Article.lagda
+++ b/source/InjectiveTypes/Article.lagda
@@ -219,7 +219,6 @@ open import UF.Base
 open import UF.Embeddings
 open import UF.Equiv
 open import UF.Equiv-FunExt
-open import UF.EquivalenceExamples
 open import UF.FunExt
 open import UF.IdEmbedding
 open import UF.PairFun
@@ -1358,7 +1357,7 @@ ainjective-ntype-characterization : Propositional-resizing
                                   → D is-of-hlevel (succ n)
                                   → ainjective-type D 𝓤 𝓤
                                   ↔ (Σ X ꞉ 𝓤 ̇ , retract D of
-                                                 (X → Σ X ꞉ 𝓤 ̇  , X is-of-hlevel n))
+                                                 (X → Σ X ꞉ 𝓤 ̇ , X is-of-hlevel n))
 ainjective-ntype-characterization {𝓤} R D n h = (a , b)
  where
   a : ainjective-type D 𝓤 𝓤 → Σ X ꞉ 𝓤 ̇ , retract D of (X → ℍ n 𝓤 )
diff --git a/source/InjectiveTypes/Blackboard.lagda b/source/InjectiveTypes/Blackboard.lagda
index be3d4bb1f..6f00822ac 100644
--- a/source/InjectiveTypes/Blackboard.lagda
+++ b/source/InjectiveTypes/Blackboard.lagda
@@ -582,6 +582,10 @@ universes-are-ainjective-Σ : is-univalent (𝓤 ⊔ 𝓥)
 universes-are-ainjective-Σ ua j e f =
  f ∖ j , (λ x → eqtoid ua _ _ (Σ-extension-property f j e x))
 
+universes-are-ainjective : is-univalent (𝓤 ⊔ 𝓥)
+                         → ainjective-type (𝓤 ⊔ 𝓥 ̇ ) 𝓤 𝓥
+universes-are-ainjective = universes-are-ainjective-Π
+
 ainjective-is-retract-of-power-of-universe : (D : 𝓤 ̇ )
                                            → is-univalent 𝓤
                                            → ainjective-type D 𝓤  (𝓤 ⁺)
diff --git a/source/InjectiveTypes/CounterExamples.lagda b/source/InjectiveTypes/CounterExamples.lagda
index 7f18424e9..1ceeb51b3 100644
--- a/source/InjectiveTypes/CounterExamples.lagda
+++ b/source/InjectiveTypes/CounterExamples.lagda
@@ -44,6 +44,7 @@ open import UF.Embeddings
 open import UF.ClassicalLogic
 open import UF.FunExt
 open import UF.Retracts
+open import UF.Size
 open import UF.SubtypeClassifier
 open import UF.SubtypeClassifier-Properties
 open import UF.Subsingletons
@@ -91,7 +92,7 @@ WEM-gives-𝟚-retract-of-Ω {𝓤} wem = II
   h p (inr _) = ₁
 
   Ω-to-𝟚 : Ω 𝓤 → 𝟚
-  Ω-to-𝟚 p = h p (wem (p holds) (holds-is-prop p))
+  Ω-to-𝟚 p = h p (wem (p holds))
 
   I : (n : 𝟚) (d : is-decidable (¬ (𝟚-to-Ω n holds))) → h (𝟚-to-Ω n) d ＝ n
   I ₀ (inl ϕ) = refl
@@ -100,7 +101,7 @@ WEM-gives-𝟚-retract-of-Ω {𝓤} wem = II
   I ₁ (inr ψ) = refl
 
   d : (p : Ω 𝓤) → is-decidable (¬ (p holds))
-  d p = wem (p holds) (holds-is-prop p)
+  d p = wem (p holds)
 
   II : retract 𝟚 of (Ω 𝓤)
   II = (λ p → h p (d p)) ,
@@ -163,7 +164,7 @@ universe 𝓤₁.
 \begin{code}
 
 open import DedekindReals.Type fe' pe' pt
-open import DedekindReals.Order fe' pe' pt
+open import DedekindReals.Order fe' pe' pt renaming (_♯_ to _♯ℝ_)
 open import Notation.Order
 
 ℝ-ainjective-gives-Heaviside-function : ainjective-type ℝ 𝓤₁ 𝓤₁
@@ -214,85 +215,87 @@ open import Rationals.Type
 open import Rationals.Order
 
 ℝ-ainjective-gives-WEM : ainjective-type ℝ 𝓤 𝓥 → WEM 𝓤
-ℝ-ainjective-gives-WEM {𝓤} ℝ-ainj P P-is-prop = XI
+ℝ-ainjective-gives-WEM {𝓤} ℝ-ainj = WEM'-gives-WEM fe' XI
  where
-  q : Ω 𝓤
-  q = (P + ¬ P) , decidability-of-prop-is-prop fe' P-is-prop
+  module _ (P : 𝓤 ̇ ) (P-is-prop : is-prop P) where
 
-  ℝ-aflabby : aflabby ℝ 𝓤
-  ℝ-aflabby = ainjective-types-are-aflabby ℝ ℝ-ainj
+   q : Ω 𝓤
+   q = (P + ¬ P) , decidability-of-prop-is-prop fe' P-is-prop
 
-  f : P + ¬ P → ℝ
-  f = cases (λ _ → 0ℝ) (λ _ → 1ℝ)
+   ℝ-aflabby : aflabby ℝ 𝓤
+   ℝ-aflabby = ainjective-types-are-aflabby ℝ ℝ-ainj
 
-  r : ℝ
-  r = aflabby-extension ℝ-aflabby q f
+   f : P + ¬ P → ℝ
+   f = cases (λ _ → 0ℝ) (λ _ → 1ℝ)
 
-  I : P → r ＝ 0ℝ
-  I p = aflabby-extension-property ℝ-aflabby q f (inl p)
+   r : ℝ
+   r = aflabby-extension ℝ-aflabby q f
 
-  II : ¬ P → r ＝ 1ℝ
-  II ν = aflabby-extension-property ℝ-aflabby q f (inr ν)
+   I : P → r ＝ 0ℝ
+   I p = aflabby-extension-property ℝ-aflabby q f (inl p)
 
-  I-II : r ≠ 0ℝ → r ≠ 1ℝ → 𝟘
-  I-II u v = contrapositive II v (contrapositive I u)
+   II : ¬ P → r ＝ 1ℝ
+   II ν = aflabby-extension-property ℝ-aflabby q f (inr ν)
 
-  I-II₀ : r ≠ 1ℝ → r ＝ 0ℝ
-  I-II₀ v = ℝ-is-¬¬-separated r 0ℝ (λ u → I-II u v)
+   I-II : r ≠ 0ℝ → r ≠ 1ℝ → 𝟘
+   I-II u v = contrapositive II v (contrapositive I u)
 
-  I-II₁ : r ≠ 0ℝ → r ＝ 1ℝ
-  I-II₁ u = ℝ-is-¬¬-separated r 1ℝ (I-II u)
+   I-II₀ : r ≠ 1ℝ → r ＝ 0ℝ
+   I-II₀ v = ℝ-is-¬¬-separated r 0ℝ (λ u → I-II u v)
 
-  III : (1/4 < r) ∨ (r < 1/2)
-  III = ℝ-locatedness r 1/4 1/2 1/4<1/2
+   I-II₁ : r ≠ 0ℝ → r ＝ 1ℝ
+   I-II₁ u = ℝ-is-¬¬-separated r 1ℝ (I-II u)
 
-  IV : 1/4 < r → r ＝ 1ℝ
-  IV l = I-II₁ IV₀
-   where
-     IV₀ : r ≠ 0ℝ
-     IV₀ e = ℚ<-irrefl 1/4 IV₂
-      where
-       IV₁ : 1/4 < 0ℝ
-       IV₁ = transport (1/4 <_) e l
-       IV₂ : 1/4 < 1/4
-       IV₂ = ℚ<-trans 1/4 0ℚ 1/4 IV₁ 0<1/4
-
-  V : r < 1/2 → r ＝ 0ℝ
-  V l = I-II₀ V₀
-   where
-     V₀ : r ≠ 1ℝ
-     V₀ e = ℚ<-irrefl 1/2 V₂
-      where
-       V₁ : 1ℝ < 1/2
-       V₁ = transport (_< 1/2) e l
-       V₂ : 1/2 < 1/2
-       V₂ = ℚ<-trans 1/2 1ℚ 1/2 1/2<1 V₁
-
-  VI : r ＝ 0ℝ → ¬¬ P
-  VI e ν = apartness-gives-inequality 0ℝ 1ℝ
-            ℝ-zero-apart-from-one
-             (0ℝ ＝⟨ e ⁻¹ ⟩
-              r  ＝⟨ II ν ⟩
-              1ℝ ∎)
-
-  VII : r ＝ 1ℝ → ¬ P
-  VII e p = apartness-gives-inequality 0ℝ 1ℝ
+   III : (1/4 < r) ∨ (r < 1/2)
+   III = ℝ-locatedness r 1/4 1/2 1/4<1/2
+
+   IV : 1/4 < r → r ＝ 1ℝ
+   IV l = I-II₁ IV₀
+    where
+      IV₀ : r ≠ 0ℝ
+      IV₀ e = ℚ<-irrefl 1/4 IV₂
+       where
+        IV₁ : 1/4 < 0ℝ
+        IV₁ = transport (1/4 <_) e l
+        IV₂ : 1/4 < 1/4
+        IV₂ = ℚ<-trans 1/4 0ℚ 1/4 IV₁ 0<1/4
+
+   V : r < 1/2 → r ＝ 0ℝ
+   V l = I-II₀ V₀
+    where
+      V₀ : r ≠ 1ℝ
+      V₀ e = ℚ<-irrefl 1/2 V₂
+       where
+        V₁ : 1ℝ < 1/2
+        V₁ = transport (_< 1/2) e l
+        V₂ : 1/2 < 1/2
+        V₂ = ℚ<-trans 1/2 1ℚ 1/2 1/2<1 V₁
+
+   VI : r ＝ 0ℝ → ¬¬ P
+   VI e ν = apartness-gives-inequality 0ℝ 1ℝ
              ℝ-zero-apart-from-one
-             (0ℝ ＝⟨ (I p)⁻¹ ⟩
-             r   ＝⟨ e ⟩
-             1ℝ  ∎)
+              (0ℝ ＝⟨ e ⁻¹ ⟩
+               r  ＝⟨ II ν ⟩
+               1ℝ ∎)
 
-  VIII : r < 1/2 → ¬¬ P
-  VIII l = VI (V l)
+   VII : r ＝ 1ℝ → ¬ P
+   VII e p = apartness-gives-inequality 0ℝ 1ℝ
+              ℝ-zero-apart-from-one
+              (0ℝ ＝⟨ (I p)⁻¹ ⟩
+              r   ＝⟨ e ⟩
+              1ℝ  ∎)
 
-  IX :  1/4 ℚ<ℝ r → ¬ P
-  IX l = VII (IV l)
+   VIII : r < 1/2 → ¬¬ P
+   VIII l = VI (V l)
 
-  X : ¬ P ∨ ¬¬ P
-  X = ∨-functor IX VIII III
+   IX :  1/4 ℚ<ℝ r → ¬ P
+   IX l = VII (IV l)
 
-  XI : ¬ P + ¬¬ P
-  XI = exit-∥∥ (decidability-of-prop-is-prop fe' (negations-are-props fe')) X
+   X : ¬ P ∨ ¬¬ P
+   X = ∨-functor IX VIII III
+
+   XI : ¬ P + ¬¬ P
+   XI = exit-∥∥ (decidability-of-prop-is-prop fe' (negations-are-props fe')) X
 
 \end{code}
 
@@ -352,87 +355,93 @@ TODO. We could derive ℝ-ainjective-gives-WEM from the below. (Note the
 
 \begin{code}
 
-open import TypeTopology.TotallySeparated
-open Apartness fe pt
-
-type-with-non-trivial-apartness-injective-gives-WEM : {X : 𝓤 ̇  }
-                                                    → (_♯_ : X → X → 𝓥 ̇  )
-                                                    → is-apartness _♯_
-                                                    → (Σ (x₀ , x₁) ꞉ X × X , x₀ ♯ x₁)
-                                                    → ainjective-type X 𝓣 𝓦
-                                                    → WEM 𝓣
-type-with-non-trivial-apartness-injective-gives-WEM
- {𝓤} {𝓥} {𝓣} {𝓦} {X} _♯_ α ((x₀ , x₁) , points-apart) ainj P P-is-prop = VII
+open import Apartness.Definition
+open import Apartness.Properties pt
+open Apartness pt
+
+ainjective-type-with-non-trivial-apartness-gives-WEM
+ : {X : 𝓤 ̇ }
+ → ainjective-type X 𝓣 𝓦
+ → Nontrivial-Apartness X 𝓥
+ → WEM 𝓣
+ainjective-type-with-non-trivial-apartness-gives-WEM
+ {𝓤} {𝓣} {𝓦} {𝓥} {X} ainj ((_♯_ , α) , ((x₀ , x₁) , points-apart))
+ = WEM'-gives-WEM fe' VII
   where
-   X-aflabby : aflabby X 𝓣
-   X-aflabby = ainjective-types-are-aflabby _ ainj
+   module _ (P : 𝓣 ̇ ) (P-is-prop : is-prop P) where
 
-   f : (P + ¬ P) → X
-   f = cases (λ _ → x₀) (λ _ → x₁)
+    X-aflabby : aflabby X 𝓣
+    X-aflabby = ainjective-types-are-aflabby _ ainj
 
-   q : Ω 𝓣
-   q = (P + ¬ P) , decidability-of-prop-is-prop fe' P-is-prop
+    f : (P + ¬ P) → X
+    f = cases (λ _ → x₀) (λ _ → x₁)
 
-   x : X
-   x = aflabby-extension X-aflabby q f
+    q : Ω 𝓣
+    q = (P + ¬ P) , decidability-of-prop-is-prop fe' P-is-prop
 
-   I : P → x ＝ x₀
-   I p = aflabby-extension-property X-aflabby q f (inl p)
+    x : X
+    x = aflabby-extension X-aflabby q f
 
-   II : ¬ P → x ＝ x₁
-   II ν = aflabby-extension-property X-aflabby q f (inr ν)
+    I : P → x ＝ x₀
+    I p = aflabby-extension-property X-aflabby q f (inl p)
 
-   III : x ≠ x₀ → ¬ P
-   III = contrapositive I
+    II : ¬ P → x ＝ x₁
+    II ν = aflabby-extension-property X-aflabby q f (inr ν)
 
-   IV : x ≠ x₁ → ¬¬ P
-   IV = contrapositive II
+    III : x ≠ x₀ → ¬ P
+    III = contrapositive I
 
-   V : x₀ ♯ x ∨ x₁ ♯ x
-   V = apartness-is-cotransitive _♯_ α x₀ x₁ x points-apart
+    IV : x ≠ x₁ → ¬¬ P
+    IV = contrapositive II
 
-   VI : (x ≠ x₀) ∨ (x ≠ x₁)
-   VI = ∨-functor ν ν V
-    where
-     ν : {x y : X} → x ♯ y → y ≠ x
-     ν a refl = apartness-is-irreflexive _♯_ α _ a
+    V : x₀ ♯ x ∨ x₁ ♯ x
+    V = apartness-is-cotransitive _♯_ α x₀ x₁ x points-apart
 
-   VII : ¬ P + ¬¬ P
-   VII = ∨-elim (decidability-of-prop-is-prop fe' (negations-are-props fe'))
-                (inl ∘ III) (inr ∘ IV) VI
-
-\end{code}
+    VI : (x ≠ x₀) ∨ (x ≠ x₁)
+    VI = ∨-functor ν ν V
+     where
+      ν : {x y : X} → x ♯ y → y ≠ x
+      ν a refl = apartness-is-irreflexive _♯_ α _ a
 
-Notice that this last theore subsumes all the previous examples: the
-type 𝟚, which is a simple type, the simple types (because they are
-totally separated and hence they have a (tight) apartness), the
-Dedekind reals (with their standard apartness), ℕ∞ (again because it
-is totally separated). TODO. Maybe we can list a few more interesting
-examples?
+    VII : ¬ P + ¬¬ P
+    VII = ∨-elim (decidability-of-prop-is-prop fe' (negations-are-props fe'))
+                 (inl ∘ III) (inr ∘ IV) VI
 
-TODO.
+\end{code}
 
- * It also follows that a universe can't have an apartness relation
-   that distinguishes two types, unless weak excluded middle holds. If
-   WEM does hold, then we can define
+In particular, we have the following.
 
-    X ♯ Y := (¬ X × ¬¬ Y) + (¬¬ X × ¬ Y).
+\begin{code}
 
-   Symmetry is clear. For cotransitivity, assume that X ♯ Y and let Z
-   be any type. We use WEM to check which of ¬ Z and ¬¬ Z holds. We
-   have four cases to check, but in practice only two by symmetry. So
-   assume ¬ X and ¬¬ Y w.l.o.g. If ¬ Z, then Z ♯ Y, and if ¬¬ Z, then
-   X ♯ Z. So a universe, being injective, has an apartness relation
-   that distinguishes two types if and only if WEM holds.
+non-trivial-apartness-on-universe-gives-WEM
+ : is-univalent (𝓤 ⊔ 𝓥)
+ → Nontrivial-Apartness (𝓤 ⊔ 𝓥 ̇ ) 𝓥
+ → WEM 𝓤
+non-trivial-apartness-on-universe-gives-WEM ua =
+ ainjective-type-with-non-trivial-apartness-gives-WEM
+  (universes-are-ainjective ua)
+
+non-trivial-apartness-on-universe-iff-WEM
+ : is-univalent 𝓤
+ → Nontrivial-Apartness (𝓤 ̇ ) 𝓤 ↔ WEM 𝓤
+non-trivial-apartness-on-universe-iff-WEM {𝓤} ua = f , g
+ where
+  f : Nontrivial-Apartness (𝓤 ̇ ) 𝓤 → WEM 𝓤
+  f = non-trivial-apartness-on-universe-gives-WEM ua
 
- * More generally, an injective type has an apartness relation that
-   distinguishes two points if and only if WEM holds.
-   Cf. Taboos.Decomposability.
+  g : WEM 𝓤 → Nontrivial-Apartness (𝓤 ̇ ) 𝓤
+  g = WEM-gives-that-type-with-two-distinct-points-has-nontrivial-apartness⁺
+       fe'
+       (universes-are-locally-small ua)
+       universe-has-two-distinct-points
 
- * Notice also that that if a type Y has an apartness with y₀ ♯ y₁, then
-   the function type (X → Y) has an apartness
+\end{code}
 
-    f ♯ g := ∃ x ꞉ X , f x ♯ g x
+Notice that ainjective-type-with-non-trivial-apartness-gives-WEM
+subsumes all the previous examples: the type 𝟚, which is a simple
+type, the simple types (because they are totally separated and hence
+they have a (tight) apartness), the Dedekind reals (with their
+standard apartness), ℕ∞ (again because it is totally
+separated).
 
-   that tells apart the constant functions with values y₀ and y₁
-   respectively.
+TODO. Maybe we can list a few more interesting examples?
diff --git a/source/InjectiveTypes/InhabitedTypesTaboo.lagda b/source/InjectiveTypes/InhabitedTypesTaboo.lagda
index a7a74bd32..967d2fd01 100644
--- a/source/InjectiveTypes/InhabitedTypesTaboo.lagda
+++ b/source/InjectiveTypes/InhabitedTypesTaboo.lagda
@@ -32,11 +32,11 @@ and show that the following are equivalent:
 (1) 𝕀 is injective.
 (2) 𝕀 is a retract of 𝓤.
 (3) All propositions are projective:
-      (P : 𝓤 ̇  ) (Y : P → 𝓤 ̇  ) → is-prop P
+      (P : 𝓤 ̇ ) (Y : P → 𝓤 ̇ ) → is-prop P
                                 → ((p : P) → ∥ Y p ∥)
                                 → ∥ (p : P) → Y p ∥.
 (4) Every type has unspecified split support:
-      (X : 𝓤 ̇  ) → ∥ ∥ X ∥ → X ∥.
+      (X : 𝓤 ̇ ) → ∥ ∥ X ∥ → X ∥.
 
 The equivalence of (3) and (4) was shown in [Theorem 7.7, 1].
 
@@ -89,7 +89,6 @@ module InjectiveTypes.InhabitedTypesTaboo
 
 open PropositionalTruncation pt
 
-open import MLTT.Negation
 
 open import UF.Base
 open import UF.Equiv
@@ -124,7 +123,7 @@ For convenience we also write 𝕀 for this type in this file.
 \begin{code}
 
 Inhabited : 𝓤 ⁺ ̇
-Inhabited = Σ X ꞉ 𝓤 ̇  , ∥ X ∥
+Inhabited = Σ X ꞉ 𝓤 ̇ , ∥ X ∥
 
 private
  𝕀 : 𝓤 ⁺ ̇
@@ -141,13 +140,13 @@ top of this file.
 \begin{code}
 
 Propositions-Are-Projective : 𝓤 ⁺ ̇
-Propositions-Are-Projective = (P : 𝓤 ̇  ) (Y : P → 𝓤 ̇  )
+Propositions-Are-Projective = (P : 𝓤 ̇ ) (Y : P → 𝓤 ̇ )
                             → is-prop P
                             → ((p : P) → ∥ Y p ∥)
                             → ∥ ((p : P) → Y p) ∥
 
 Unspecified-Split-Support : 𝓤 ⁺ ̇
-Unspecified-Split-Support = (X : 𝓤 ̇  ) → ∥ (∥ X ∥ → X) ∥
+Unspecified-Split-Support = (X : 𝓤 ̇ ) → ∥ (∥ X ∥ → X) ∥
 
 \end{code}
 
@@ -157,7 +156,7 @@ implications at the end.
 \begin{code}
 
 unspecified-split-support-gives-retract : Unspecified-Split-Support
-                                        → retract 𝕀 of (𝓤 ̇  )
+                                        → retract 𝕀 of (𝓤 ̇ )
 unspecified-split-support-gives-retract uss = ρ , σ , ρσ
  where
   σ : 𝕀 → 𝓤 ̇
@@ -223,8 +222,8 @@ For convenience, we provide a summary of the chain of implications:
 
 \begin{code}
 
-summary : (Unspecified-Split-Support → retract 𝕀 of (𝓤 ̇  ))
-        × (retract 𝕀 of (𝓤 ̇  ) → ainjective-type 𝕀 𝓤 𝓤)
+summary : (Unspecified-Split-Support → retract 𝕀 of (𝓤 ̇ ))
+        × (retract 𝕀 of (𝓤 ̇ ) → ainjective-type 𝕀 𝓤 𝓤)
         × (ainjective-type 𝕀 𝓤 𝓤 → Propositions-Are-Projective)
         × (Propositions-Are-Projective → Unspecified-Split-Support)
 summary = unspecified-split-support-gives-retract
@@ -259,17 +258,17 @@ injective.
 \begin{code}
 
 𝓤∙ : 𝓤 ⁺ ̇
-𝓤∙ = Σ X ꞉ 𝓤 ̇  , X
+𝓤∙ = Σ X ꞉ 𝓤 ̇ , X
 
 𝓤∙-is-injective : ainjective-type 𝓤∙ 𝓤 𝓤
 𝓤∙-is-injective = ainjectivity-of-type-of-pointed-types
 
 𝓤∙-as-Σ-type-over-𝕀 : 𝓤∙ ≃ (Σ I ꞉ 𝕀 , ⟨ I ⟩)
 𝓤∙-as-Σ-type-over-𝕀 = 𝓤∙                      ≃⟨ Σ-cong e ⟩
-                      (Σ X ꞉ 𝓤 ̇  , ∥ X ∥ × X) ≃⟨ ≃-sym Σ-assoc ⟩
+                      (Σ X ꞉ 𝓤 ̇ , ∥ X ∥ × X) ≃⟨ ≃-sym Σ-assoc ⟩
                       (Σ I ꞉ 𝕀 , ⟨ I ⟩)       ■
  where
-  e : (X : 𝓤 ̇  ) → X ≃ ∥ X ∥ × X
+  e : (X : 𝓤 ̇ ) → X ≃ ∥ X ∥ × X
   e X = qinveq f (g , η , ε)
    where
     f : X → ∥ X ∥ × X
@@ -295,9 +294,9 @@ propositional truncation and double negation.
 \begin{code}
 
 Non-Empty : 𝓤 ⁺ ̇
-Non-Empty = Σ X ꞉ 𝓤 ̇  , is-nonempty X
+Non-Empty = Σ X ꞉ 𝓤 ̇ , is-nonempty X
 
-Non-Empty-retract : retract Non-Empty of (𝓤 ̇  )
+Non-Empty-retract : retract Non-Empty of (𝓤 ̇ )
 Non-Empty-retract = ρ , σ , ρσ
  where
   ρ : 𝓤 ̇ → Non-Empty
@@ -325,7 +324,7 @@ Non-Empty-retract = ρ , σ , ρσ
 
 Non-Empty-is-injective : ainjective-type Non-Empty 𝓤 𝓤
 Non-Empty-is-injective =
- retract-of-ainjective Non-Empty (𝓤 ̇  )
+ retract-of-ainjective Non-Empty (𝓤 ̇ )
                        (universes-are-ainjective-Π (ua 𝓤))
                        Non-Empty-retract
 
diff --git a/source/InjectiveTypes/OverSmallMaps.lagda b/source/InjectiveTypes/OverSmallMaps.lagda
index 274d5a5a4..5020348fb 100644
--- a/source/InjectiveTypes/OverSmallMaps.lagda
+++ b/source/InjectiveTypes/OverSmallMaps.lagda
@@ -12,10 +12,8 @@ module InjectiveTypes.OverSmallMaps (fe : FunExt) where
 
 open import InjectiveTypes.Blackboard fe
 open import MLTT.Spartan
-open import UF.Base
 open import UF.Embeddings
 open import UF.Equiv
-open import UF.EquivalenceExamples
 open import UF.Size
 open import UF.Subsingletons
 
diff --git a/source/InjectiveTypes/Resizing.lagda b/source/InjectiveTypes/Resizing.lagda
index 01b602e29..2699391df 100644
--- a/source/InjectiveTypes/Resizing.lagda
+++ b/source/InjectiveTypes/Resizing.lagda
@@ -69,7 +69,6 @@ module InjectiveTypes.Resizing
 open PropositionalTruncation pt
 
 open import MLTT.Spartan
-open import UF.DiscreteAndSeparated
 open import UF.FunExt
 open import UF.NotNotStablePropositions
 open import UF.Retracts
diff --git a/source/InjectiveTypes/index.lagda b/source/InjectiveTypes/index.lagda
index b0fc1233f..f321638b0 100644
--- a/source/InjectiveTypes/index.lagda
+++ b/source/InjectiveTypes/index.lagda
@@ -82,6 +82,6 @@ distinct points can be injective without ꪪ-resizing.
 
 \begin{code}
 
-open import InjectiveTypes.Resizing
+import InjectiveTypes.Resizing
 
 \end{code}
diff --git a/source/Integers/Division.lagda b/source/Integers/Division.lagda
index ab2e873d6..a45fdfdfc 100644
--- a/source/Integers/Division.lagda
+++ b/source/Integers/Division.lagda
@@ -15,7 +15,6 @@ open import UF.Subsingletons
 
 open import Integers.Addition
 open import Integers.Type
-open import Integers.Abs
 open import Integers.Negation
 open import Integers.Order
 open import Integers.Multiplication renaming (_*_ to _ℤ*_)
diff --git a/source/Integers/Exponentiation.lagda b/source/Integers/Exponentiation.lagda
index aedde4c53..495365ca2 100644
--- a/source/Integers/Exponentiation.lagda
+++ b/source/Integers/Exponentiation.lagda
@@ -8,7 +8,6 @@ open import MLTT.Spartan renaming (_+_ to _∔_)
 
 open import Naturals.Addition renaming (_+_ to _ℕ+_)
 open import Naturals.Multiplication renaming (_*_ to _ℕ*_)
-open import Integers.Addition
 open import Integers.Multiplication
 open import Integers.Type
 open import Naturals.Exponentiation
diff --git a/source/Integers/HCF.lagda b/source/Integers/HCF.lagda
index 0aa390a4a..1787e5707 100644
--- a/source/Integers/HCF.lagda
+++ b/source/Integers/HCF.lagda
@@ -23,7 +23,6 @@ open import Integers.Addition
 open import Integers.Negation
 open import Integers.Division
 open import Integers.Multiplication
-open import Integers.Abs
 open import Naturals.Division renaming (_∣_ to _ℕ∣_)
 open import Naturals.Multiplication renaming (_*_ to _ℕ*_)
 open import Naturals.HCF
diff --git a/source/Integers/Parity.lagda b/source/Integers/Parity.lagda
index dbc5a6a84..781584f82 100644
--- a/source/Integers/Parity.lagda
+++ b/source/Integers/Parity.lagda
@@ -9,7 +9,6 @@ open import Integers.Addition
 open import Integers.Type
 open import Integers.Multiplication
 open import Integers.Negation
-open import Naturals.Addition renaming (_+_ to _ℕ+_)
 open import Naturals.Multiplication renaming (_*_ to _ℕ*_)
 open import Naturals.Parity
 open import Naturals.Properties
diff --git a/source/Integers/Type.lagda b/source/Integers/Type.lagda
index 103d36798..0f174f16b 100644
--- a/source/Integers/Type.lagda
+++ b/source/Integers/Type.lagda
@@ -16,7 +16,6 @@ open import MLTT.Unit-Properties
 open import Naturals.Properties
 open import UF.DiscreteAndSeparated
 open import UF.Sets
-open import UF.Subsingletons
 
 module Integers.Type where
 
diff --git a/source/Iterative/Finite.lagda b/source/Iterative/Finite.lagda
index 2066d3c07..7b7b8a317 100644
--- a/source/Iterative/Finite.lagda
+++ b/source/Iterative/Finite.lagda
@@ -5,7 +5,6 @@ Alice Laroche , 26th September 2023
 {-# OPTIONS --safe --without-K --exact-split #-}
 
 open import MLTT.Spartan
-open import MLTT.NaturalNumbers
 open import UF.Base
 open import UF.DiscreteAndSeparated
 open import UF.Embeddings
diff --git a/source/Iterative/Multisets-Addendum.lagda b/source/Iterative/Multisets-Addendum.lagda
index 9cbcc4d16..a1a06449f 100644
--- a/source/Iterative/Multisets-Addendum.lagda
+++ b/source/Iterative/Multisets-Addendum.lagda
@@ -291,6 +291,8 @@ Question. Is there a function Πᴹ of the above type that satisfies the
 following equation? It seems that this possible for finite X. We guess
 there isn't such a function for general X, including X = ℕ.
 
+This question is answered in gist.multiset-addendum-question
+
 \begin{code}
 
 Question =
diff --git a/source/Iterative/Multisets-HFLO.lagda b/source/Iterative/Multisets-HFLO.lagda
index ebf29d344..48db599fc 100644
--- a/source/Iterative/Multisets-HFLO.lagda
+++ b/source/Iterative/Multisets-HFLO.lagda
@@ -8,9 +8,7 @@ multisets". Notice that this is data, rather then property.
 {-# OPTIONS --safe --without-K #-}
 
 open import MLTT.Spartan hiding (_^_)
-open import UF.Sets-Properties
 open import UF.Univalence
-open import UF.Universes
 
 module Iterative.Multisets-HFLO
         (ua : Univalence)
diff --git a/source/Iterative/Ordinals-working.lagda b/source/Iterative/Ordinals-working.lagda
index b137d2ae4..e8ac0b855 100644
--- a/source/Iterative/Ordinals-working.lagda
+++ b/source/Iterative/Ordinals-working.lagda
@@ -67,7 +67,7 @@ open import UF.PropTrunc
 open import Quotient.Type -- hiding (is-prop-valued)
 
 open import Ordinals.Arithmetic fe'
-open import Ordinals.ArithmeticProperties ua
+open import Ordinals.AdditionProperties ua
 open import Ordinals.OrdinalOfOrdinalsSuprema ua
 
 module 𝕍-to-Ord-construction
@@ -80,7 +80,7 @@ module 𝕍-to-Ord-construction
  𝕍-to-Ord : 𝕍 → Ord
  𝕍-to-Ord = 𝕍-induction (λ _ → Ord) f
   where
-   f : (X : 𝓤 ̇  ) (ϕ : X → 𝕍) (e : is-embedding ϕ)
+   f : (X : 𝓤 ̇ ) (ϕ : X → 𝕍) (e : is-embedding ϕ)
      → ((x : X) → Ord) → Ord
    f X ϕ e r = sup (λ x → r x +ₒ 𝟙ₒ)
 
diff --git a/source/Iterative/Ordinals.lagda b/source/Iterative/Ordinals.lagda
index 07cf05d9f..3a74a1a68 100644
--- a/source/Iterative/Ordinals.lagda
+++ b/source/Iterative/Ordinals.lagda
@@ -62,7 +62,6 @@ open import Ordinals.OrdinalOfOrdinals ua
 open import Ordinals.Type hiding (Ord)
 open import Ordinals.Underlying
 open import Ordinals.WellOrderTransport
-open import UF.Equiv-FunExt
 open import UF.Base
 open import UF.Embeddings
 open import UF.Equiv
diff --git a/source/Iterative/Sets.lagda b/source/Iterative/Sets.lagda
index 29b44e502..7e1b5220d 100644
--- a/source/Iterative/Sets.lagda
+++ b/source/Iterative/Sets.lagda
@@ -54,7 +54,6 @@ open import UF.Size
 open import UF.Subsingletons
 open import UF.Subsingletons-FunExt
 open import W.Type
-open import W.Properties (𝓤 ̇ ) id
 
 \end{code}
 
@@ -651,7 +650,7 @@ module _ (pt : propositional-truncations-exist) where
 
   private
    module union-construction
-          {I : 𝓤 ̇  }
+          {I : 𝓤 ̇ }
           (𝓐 : I → 𝕍)
          where
 
@@ -683,12 +682,12 @@ module _ (pt : propositional-truncations-exist) where
                          (⌜⌝-is-equiv im⁻-≃-im))
                        π-is-embedding
 
-  ⋃ : {I : 𝓤 ̇  } (𝓐 : I → 𝕍) → 𝕍
+  ⋃ : {I : 𝓤 ̇ } (𝓐 : I → 𝕍) → 𝕍
   ⋃ {I} 𝓐 = 𝕍-ssup im⁻ π⁻ π⁻-is-embedding
    where
     open union-construction 𝓐
 
-  ⋃-behaviour : {I : 𝓤 ̇  } (𝓐 : I → 𝕍) (B : 𝕍)
+  ⋃-behaviour : {I : 𝓤 ̇ } (𝓐 : I → 𝕍) (B : 𝕍)
               → B ∈ ⋃ 𝓐 ≃ (∃ i ꞉ I , B ＝ 𝓐 i)
   ⋃-behaviour {I} 𝓐 B =
    B ∈ ⋃ 𝓐                                    ≃⟨ ∈-behaviour' B (⋃ 𝓐) ⟩
diff --git a/source/Lifting/Algebras.lagda b/source/Lifting/Algebras.lagda
index 89cd5da49..0b4cb4ff0 100644
--- a/source/Lifting/Algebras.lagda
+++ b/source/Lifting/Algebras.lagda
@@ -22,7 +22,6 @@ open import UF.UA-FunExt
 open import UF.Univalence
 
 open import Lifting.Construction 𝓣
-open import Lifting.IdentityViaSIP 𝓣
 open import Lifting.Monad 𝓣
 
 \end{code}
diff --git a/source/Lifting/EmbeddingViaSIP.lagda b/source/Lifting/EmbeddingViaSIP.lagda
index ade0d2ebd..7d8c65370 100644
--- a/source/Lifting/EmbeddingViaSIP.lagda
+++ b/source/Lifting/EmbeddingViaSIP.lagda
@@ -15,9 +15,7 @@ module Lifting.EmbeddingViaSIP
         (X : 𝓤 ̇ )
        where
 
-open import UF.Base
 open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 open import UF.Embeddings
 open import UF.Equiv
 open import UF.EquivalenceExamples
diff --git a/source/Lifting/Miscelanea-PropExt-FunExt.lagda b/source/Lifting/Miscelanea-PropExt-FunExt.lagda
index 291106f9c..e6ed51284 100644
--- a/source/Lifting/Miscelanea-PropExt-FunExt.lagda
+++ b/source/Lifting/Miscelanea-PropExt-FunExt.lagda
@@ -202,13 +202,13 @@ viz. 𝓛 X ≃ 𝟙 + X.
 lifting-of-𝟙-is-Ω : 𝓛 (𝟙{𝓤}) ≃ Ω 𝓣
 lifting-of-𝟙-is-Ω =
  𝓛 𝟙                         ≃⟨ Σ-cong (λ P → ×-cong (→𝟙 fe) 𝕚𝕕) ⟩
- (Σ P ꞉ 𝓣 ̇  , 𝟙 × is-prop P) ≃⟨ Σ-cong (λ P → 𝟙-lneutral) ⟩
+ (Σ P ꞉ 𝓣 ̇ , 𝟙 × is-prop P) ≃⟨ Σ-cong (λ P → 𝟙-lneutral) ⟩
  Ω 𝓣                         ■
 
-EM-gives-classical-lifting : (X : 𝓤 ̇  ) → EM 𝓣 → 𝓛 X ≃ (𝟙{𝓤} + X)
+EM-gives-classical-lifting : (X : 𝓤 ̇ ) → EM 𝓣 → 𝓛 X ≃ (𝟙{𝓤} + X)
 EM-gives-classical-lifting {𝓤} X em =
  𝓛 X                                 ≃⟨ I   ⟩
- (Σ P ꞉ 𝓣 ̇  , is-prop P × (P → X))   ≃⟨ II  ⟩
+ (Σ P ꞉ 𝓣 ̇ , is-prop P × (P → X))   ≃⟨ II  ⟩
  (Σ P ꞉ Ω 𝓣 , (P holds → X))         ≃⟨ III ⟩
  (Σ b ꞉ 𝟚 , (ι b holds → X))         ≃⟨ IV  ⟩
  (Σ b ꞉ 𝟙 + 𝟙 , (ι (e b) holds → X)) ≃⟨ V   ⟩
@@ -239,7 +239,7 @@ classical-lifting-of-𝟙-gives-EM e =
        𝓛 𝟙   ≃⟨ lifting-of-𝟙-is-Ω ⟩
        Ω 𝓣   ■
 
-classical-lifting-gives-EM : ((X : 𝓤 ̇  ) → 𝓛 X ≃ 𝟙{𝓤} + X) → EM 𝓣
+classical-lifting-gives-EM : ((X : 𝓤 ̇ ) → 𝓛 X ≃ 𝟙{𝓤} + X) → EM 𝓣
 classical-lifting-gives-EM h = classical-lifting-of-𝟙-gives-EM (h 𝟙)
 
 \end{code}
diff --git a/source/Lifting/Monad.lagda b/source/Lifting/Monad.lagda
index 2a7251f41..400bee191 100644
--- a/source/Lifting/Monad.lagda
+++ b/source/Lifting/Monad.lagda
@@ -18,14 +18,11 @@ module Lifting.Monad
         (𝓣 : Universe)
        where
 
-open import UF.Base
 open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 open import UF.Equiv
 open import UF.EquivalenceExamples
 open import UF.FunExt
 open import UF.Univalence
-open import UF.UA-FunExt
 
 open import Lifting.Construction 𝓣
 open import Lifting.IdentityViaSIP 𝓣
diff --git a/source/Lifting/MonadVariation.lagda b/source/Lifting/MonadVariation.lagda
index 9a49c6eed..f7e5dc02d 100644
--- a/source/Lifting/MonadVariation.lagda
+++ b/source/Lifting/MonadVariation.lagda
@@ -13,7 +13,6 @@ module Lifting.MonadVariation where
 
 open import UF.Subsingletons
 open import UF.Embeddings
-open import UF.Equiv
 open import UF.FunExt
 
 open import Lifting.Construction
diff --git a/source/Lifting/UnivalentPrecategory.lagda b/source/Lifting/UnivalentPrecategory.lagda
index 6c7492a6a..714597747 100644
--- a/source/Lifting/UnivalentPrecategory.lagda
+++ b/source/Lifting/UnivalentPrecategory.lagda
@@ -22,14 +22,12 @@ module Lifting.UnivalentPrecategory
 open import Lifting.IdentityViaSIP 𝓣
 open import Lifting.Construction 𝓣
 open import UF.Base
-open import UF.Embeddings
 open import UF.Equiv
 open import UF.Equiv-FunExt
 open import UF.EquivalenceExamples
 open import UF.FunExt
 open import UF.Lower-FunExt
 open import UF.Sets
-open import UF.StructureIdentityPrinciple
 open import UF.Subsingletons
 open import UF.Subsingletons-FunExt
 open import UF.UA-FunExt
diff --git a/source/Locales/AdjointFunctorTheoremForFrames.lagda b/source/Locales/AdjointFunctorTheoremForFrames.lagda
index 9998ae11b..7e7eb63b7 100644
--- a/source/Locales/AdjointFunctorTheoremForFrames.lagda
+++ b/source/Locales/AdjointFunctorTheoremForFrames.lagda
@@ -12,7 +12,6 @@ Originally part of `ayberkt/formal-topology-in-UF`. Ported to TypeTopology on
 {-# OPTIONS --safe --without-K #-}
 
 open import MLTT.Spartan
-open import UF.Base
 open import UF.FunExt
 open import UF.PropTrunc
 
@@ -27,7 +26,6 @@ open import Locales.Frame pt fe
 open import Locales.GaloisConnection pt fe
 open import Slice.Family
 open import UF.Logic
-open import UF.Subsingletons
 
 open AllCombinators pt fe
 open PropositionalTruncation pt
diff --git a/source/Locales/Adjunctions/Properties-DistributiveLattice.lagda b/source/Locales/Adjunctions/Properties-DistributiveLattice.lagda
index eefc7eb69..7d7071b34 100644
--- a/source/Locales/Adjunctions/Properties-DistributiveLattice.lagda
+++ b/source/Locales/Adjunctions/Properties-DistributiveLattice.lagda
@@ -14,7 +14,6 @@ frames.
 {-# OPTIONS --safe --without-K #-}
 
 open import MLTT.Spartan
-open import UF.Base
 open import UF.FunExt
 open import UF.PropTrunc
 
@@ -24,7 +23,6 @@ module Locales.Adjunctions.Properties-DistributiveLattice
        where
 
 open import Locales.Adjunctions.Properties pt fe
-open import Locales.ContinuousMap.FrameHomomorphism-Properties pt fe
 open import Locales.DistributiveLattice.Definition fe pt
 open import Locales.Frame pt fe
 open import Locales.GaloisConnection pt fe
diff --git a/source/Locales/Adjunctions/Properties.lagda b/source/Locales/Adjunctions/Properties.lagda
index e148e8011..727c4cd96 100644
--- a/source/Locales/Adjunctions/Properties.lagda
+++ b/source/Locales/Adjunctions/Properties.lagda
@@ -20,7 +20,6 @@ to apply them to distributive lattices, generalizing them has become necessary.
 {-# OPTIONS --safe --without-K #-}
 
 open import MLTT.Spartan
-open import UF.Base
 open import UF.FunExt
 open import UF.PropTrunc
 
diff --git a/source/Locales/CharacterisationOfContinuity.lagda b/source/Locales/CharacterisationOfContinuity.lagda
index 9a6416cec..0c985dec3 100644
--- a/source/Locales/CharacterisationOfContinuity.lagda
+++ b/source/Locales/CharacterisationOfContinuity.lagda
@@ -4,8 +4,6 @@ Ayberk Tosun, 11 September 2023
 
 {-# OPTIONS --safe --without-K #-}
 
-open import UF.Base
-open import UF.Subsingletons
 open import UF.PropTrunc
 open import UF.FunExt
 open import MLTT.Spartan
@@ -15,10 +13,9 @@ module Locales.CharacterisationOfContinuity (pt : propositional-truncations-exis
                                             (fe : Fun-Ext)                          where
 
 open import Locales.Frame               pt fe
-open import Locales.WayBelowRelation.Definition pt fe
 open import UF.Logic
 open import Slice.Family
-open import Locales.Compactness pt fe
+open import Locales.Compactness.Definition pt fe
 open import Locales.Spectrality.SpectralLocale pt fe
 open import Locales.Spectrality.Properties     pt fe
 
diff --git a/source/Locales/ClassificationOfScottOpens.lagda b/source/Locales/ClassificationOfScottOpens.lagda
index 701a4f87b..fab119a70 100644
--- a/source/Locales/ClassificationOfScottOpens.lagda
+++ b/source/Locales/ClassificationOfScottOpens.lagda
@@ -22,19 +22,16 @@ open Implication fe
 open Existential pt
 open Conjunction
 
-open import Locales.Frame pt fe
 open import DomainTheory.Basics.Dcpo pt fe 𝓤 renaming (⟨_⟩ to ⟨_⟩∙)
 open import DomainTheory.Topology.ScottTopology pt fe 𝓤
 open import DomainTheory.Basics.Pointed pt fe 𝓤
 open import DomainTheory.Lifting.LiftingSet pt fe
 open import DomainTheory.Basics.Miscelanea pt fe 𝓤
 open import Lifting.Construction 𝓤
-open import UF.PropTrunc
 open import UF.SubtypeClassifier
 open import UF.Subsingletons-Properties
 open import Slice.Family
 open import UF.Equiv
-open import UF.HLevels
 open PropositionalTruncation pt
 
 \end{code}
diff --git a/source/Locales/Clopen.lagda b/source/Locales/Clopen.lagda
index f4771c3ae..a73d5ddde 100644
--- a/source/Locales/Clopen.lagda
+++ b/source/Locales/Clopen.lagda
@@ -7,32 +7,28 @@ Ayberk Tosun, 11 September 2023
 open import MLTT.Spartan hiding (𝟚)
 open import UF.PropTrunc
 open import UF.FunExt
-open import UF.UA-FunExt
 open import UF.Size
 
 module Locales.Clopen (pt : propositional-truncations-exist)
                       (fe : Fun-Ext)
                       (sr : Set-Replacement pt) where
 
-open import Locales.AdjointFunctorTheoremForFrames
+open import Locales.Compactness.Definition pt fe
+open import Locales.Complements pt fe
 open import Locales.Frame pt fe
 open import Locales.WayBelowRelation.Definition pt fe
-open import Locales.Compactness pt fe
-open import Locales.Complements pt fe
 open import Locales.WellInside pt fe sr
+open import MLTT.List hiding ([_])
 open import Slice.Family
+open import UF.Base using (from-Σ-＝)
 open import UF.Logic
 open import UF.Subsingletons
 open import UF.SubtypeClassifier
-open import MLTT.List hiding ([_])
-open import UF.Base using (from-Σ-＝)
 
 open AllCombinators pt fe
 open PropositionalTruncation pt
 
-open import Locales.GaloisConnection pt fe
 
-open import Locales.InitialFrame pt fe
 
 open Locale
 
diff --git a/source/Locales/CompactRegular.lagda b/source/Locales/CompactRegular.lagda
index 47c6fb651..be5322fd5 100644
--- a/source/Locales/CompactRegular.lagda
+++ b/source/Locales/CompactRegular.lagda
@@ -11,8 +11,6 @@ open import MLTT.Spartan hiding (𝟚)
 open import UF.Base
 open import UF.FunExt
 open import UF.PropTrunc
-open import UF.UA-FunExt
-open import UF.Univalence
 
 module Locales.CompactRegular
         (pt : propositional-truncations-exist)
diff --git a/source/Locales/Compactness.lagda b/source/Locales/Compactness/Definition.lagda
similarity index 89%
rename from source/Locales/Compactness.lagda
rename to source/Locales/Compactness/Definition.lagda
index 3d7da980c..82702401b 100644
--- a/source/Locales/Compactness.lagda
+++ b/source/Locales/Compactness/Definition.lagda
@@ -12,27 +12,39 @@ will be broken down into smaller modules.
 
 {-# OPTIONS --safe --without-K #-}
 
+open import MLTT.Spartan hiding (J)
 open import UF.Base
+open import UF.Classifiers
+open import UF.FunExt
+open import UF.PropTrunc
 open import UF.Sets
 open import UF.Subsingletons
-open import UF.Subsingletons-Properties
 open import UF.Subsingletons-FunExt
-open import UF.PropTrunc
-open import UF.FunExt
-open import MLTT.Spartan
+open import UF.Subsingletons-Properties
 open import UF.SubtypeClassifier
 
-module Locales.Compactness (pt : propositional-truncations-exist)
-                           (fe : Fun-Ext)                          where
+module Locales.Compactness.Definition
+        (pt : propositional-truncations-exist)
+        (fe : Fun-Ext)
+       where
 
+open import Fin.Kuratowski pt
+open import Fin.Type
 open import Locales.Frame     pt fe
 open import Locales.WayBelowRelation.Definition  pt fe
-open import UF.Logic
+open import MLTT.List using (member; []; _∷_; List; in-head; in-tail; length)
 open import Slice.Family
+open import Taboos.FiniteSubsetTaboo pt fe
+open import UF.Equiv hiding (_■)
+open import UF.EquivalenceExamples
+open import UF.ImageAndSurjection pt
+open import UF.Logic
+open import UF.Powerset-Fin pt
+open import UF.Powerset-MultiUniverse
 open import UF.Sets-Properties
 
 open PropositionalTruncation pt
-open Existential pt
+open AllCombinators pt fe
 
 open Locale
 
diff --git a/source/Locales/Compactness/Properties.lagda b/source/Locales/Compactness/Properties.lagda
new file mode 100644
index 000000000..1adaed1c0
--- /dev/null
+++ b/source/Locales/Compactness/Properties.lagda
@@ -0,0 +1,644 @@
+---
+title:          Properties of compactness
+author:         Ayberk Tosun
+date-started:   2024-07-19
+date-completed: 2024-07-31
+dates-updated:  [2024-09-05]
+---
+
+We collect properties related to compactness in locale theory in this module.
+This includes the equivalences to two alternative definitions of the notion of
+compactness, which we denote `is-compact-open'` and `is-compact-open''`.
+
+\begin{code}[hide]
+
+{-# OPTIONS --safe --without-K #-}
+
+open import MLTT.Spartan hiding (J)
+open import UF.Base
+open import UF.Classifiers
+open import UF.FunExt
+open import UF.PropTrunc
+open import UF.Sets
+open import UF.Subsingletons
+open import UF.Subsingletons-FunExt
+open import UF.Subsingletons-Properties
+open import UF.SubtypeClassifier
+
+module Locales.Compactness.Properties
+        (pt : propositional-truncations-exist)
+        (fe : Fun-Ext)
+        (pe : Prop-Ext)
+       where
+
+open import Fin.Kuratowski pt
+open import Fin.Type
+open import Locales.Compactness.Definition pt fe
+open import Locales.Frame pt fe renaming (⟨_⟩ to ⟨_⟩∙) hiding (∅)
+open import Locales.WayBelowRelation.Definition  pt fe
+open import MLTT.List using (member; []; _∷_; List; in-head; in-tail; length)
+open import MLTT.List-Properties
+open import Slice.Family
+open import Taboos.FiniteSubsetTaboo pt fe
+open import UF.Equiv hiding (_■)
+open import UF.EquivalenceExamples
+open import UF.ImageAndSurjection pt
+open import UF.Logic
+open import UF.Powerset-Fin pt
+open import UF.Powerset-MultiUniverse
+open import UF.Sets-Properties
+open import Notation.UnderlyingType
+
+open AllCombinators pt fe
+open Locale
+open PropositionalTruncation pt
+
+\end{code}
+
+\section{Preliminaries}
+
+We define a frame instance of the `Underlying-Type` typeclass to avoid name
+clashes.
+
+\begin{code}
+
+instance
+ underlying-type-of-frame : Underlying-Type (Frame 𝓤 𝓥 𝓦) (𝓤  ̇)
+ ⟨_⟩ {{underlying-type-of-frame}} (A , _) = A
+
+\end{code}
+
+Given a family `S`, we denote the type of its subfamilies by `SubFam S`.
+
+\begin{code}
+
+SubFam : {A : 𝓤  ̇} {𝓦 : Universe} → Fam 𝓦 A → 𝓦 ⁺  ̇
+SubFam {_} {A} {𝓦} (I , α) = Σ J ꞉ 𝓦  ̇ , (J → I)
+
+\end{code}
+
+Given any list, the type of elements that fall in the list is a
+Kuratowski-finite type.
+
+\begin{code}
+
+list-members-is-Kuratowski-finite : {X : 𝓤  ̇}
+                                  → (xs : List X)
+                                  → is-Kuratowski-finite
+                                     (Σ x ꞉ X , ∥ member x xs ∥)
+list-members-is-Kuratowski-finite {𝓤} {A} xs =
+ ∣ length xs , nth xs , nth-is-surjection xs ∣
+  where
+   open list-indexing pt
+
+\end{code}
+
+TODO: The function `nth` above should be placed in a more appropriate module.
+
+\section{Alternative definition of compactness}
+
+Compactness could have been alternatively defined as:
+
+\begin{code}
+
+is-compact-open' : (X : Locale 𝓤 𝓥 𝓦) → ⟨ 𝒪 X ⟩ → Ω (𝓤 ⊔ 𝓥 ⊔ 𝓦 ⁺)
+is-compact-open' {𝓤} {𝓥} {𝓦} X U =
+ Ɐ S ꞉ Fam 𝓦 ⟨ 𝒪 X ⟩ ,
+  U ≤ (⋁[ 𝒪 X ] S) ⇒
+   (Ǝ (J , h) ꞉ SubFam S , is-Kuratowski-finite J
+                         × (U ≤ (⋁[ 𝒪 X ] ⁅  S [ h j ] ∣ j ∶ J ⁆)) holds)
+   where
+    open PosetNotation (poset-of (𝒪 X))
+
+\end{code}
+
+This is much closer to the “every cover has a finite subcover” definition from
+point-set topology.
+
+It is easy to show that this implies the standard definition of compactness, but
+we need a bit of preparation first.
+
+Given a family `S`, we denote by `family-of-lists S` the family of families
+of lists of `S`.
+
+\begin{code}
+
+module some-lemmas-on-directification (F : Frame 𝓤 𝓥 𝓦) where
+
+ family-of-lists : Fam 𝓦 ⟨ F ⟩ → Fam 𝓦 (Fam 𝓦 ⟨ F ⟩)
+ family-of-lists S = List (index S) , h
+  where
+   h : List (index S) → Fam 𝓦 ⟨ F ⟩
+   h is = (Σ i ꞉ index S , ∥ member i is ∥) , S [_] ∘ pr₁
+
+\end{code}
+
+Using this, we can give an alternative definition of the directification of
+a family:
+
+\begin{code}
+
+ directify₂ : Fam 𝓦 ⟨ F ⟩ → Fam 𝓦 ⟨ F ⟩
+ directify₂ S = ⁅ ⋁[ F ] T ∣ T ε family-of-lists S ⁆
+
+\end{code}
+
+The function `directify₂` is equal to `directify` as expected.
+
+\begin{code}
+
+ directify₂-is-equal-to-directify
+  : (S : Fam 𝓦 ⟨ F ⟩)
+  → directify₂ S [_] ∼ directify F S [_]
+
+ directify₂-is-equal-to-directify S [] =
+  directify₂ S [ [] ]   ＝⟨ Ⅰ    ⟩
+  𝟎[ F ]                ＝⟨ refl ⟩
+  directify F S [ [] ]   ∎
+   where
+
+    † : (directify₂ S [ [] ] ≤[ poset-of F ] 𝟎[ F ]) holds
+    † = ⋁[ F ]-least
+         (family-of-lists S [ [] ])
+         (𝟎[ F ] , λ { (_ , μ) → 𝟘-elim (∥∥-rec 𝟘-is-prop not-in-empty-list μ) })
+
+    Ⅰ = only-𝟎-is-below-𝟎 F (directify₂ S [ [] ]) †
+
+ directify₂-is-equal-to-directify S (i ∷ is) =
+  directify₂ S [ i ∷ is ]                ＝⟨ Ⅰ    ⟩
+  S [ i ] ∨[ F ] directify₂ S [ is ]     ＝⟨ Ⅱ    ⟩
+  S [ i ] ∨[ F ] directify  F S [ is ]   ＝⟨ refl ⟩
+  directify F S [ i ∷ is ]               ∎
+   where
+    open PosetNotation (poset-of F)
+    open PosetReasoning (poset-of F)
+    open Joins (λ x y → x ≤[ poset-of F ] y)
+
+    IH = directify₂-is-equal-to-directify S is
+
+    β : ((S [ i ] ∨[ F ] directify₂ S [ is ])
+          is-an-upper-bound-of
+         (family-of-lists S [ i ∷ is ]))
+         holds
+    β (j , ∣μ∣) =
+     ∥∥-rec (holds-is-prop (S [ j ] ≤ (S [ i ] ∨[ F ] directify₂ S [ is ]))) † ∣μ∣
+      where
+       † : member j (i ∷ is)
+         → (S [ j ] ≤ (S [ i ] ∨[ F ] directify₂ S [ is ]))
+            holds
+       † in-head     = ∨[ F ]-upper₁ (S [ j ]) (directify₂ S [ is ])
+       † (in-tail μ) =
+        family-of-lists S [ i ∷ is ] [ j , μ′ ]  ＝⟨ refl ⟩ₚ
+        S [ j ]                                  ≤⟨ Ⅰ     ⟩
+        directify₂ S [ is ]                      ≤⟨ Ⅱ     ⟩
+        S [ i ] ∨[ F ] directify₂ S [ is ]       ■
+         where
+          μ′ : ∥ member j (i ∷ is) ∥
+          μ′ = ∣ in-tail μ ∣
+
+          Ⅰ = ⋁[ F ]-upper (family-of-lists S [ is ]) (j , ∣ μ ∣)
+          Ⅱ = ∨[ F ]-upper₂ (S [ i ]) (directify₂ S [ is ])
+
+    γ : ((directify₂ S [ i ∷ is ])
+          is-an-upper-bound-of
+         (family-of-lists S [ is ]))
+        holds
+    γ (k , μ) = ∥∥-rec (holds-is-prop (S [ k ] ≤ directify₂ S [ i ∷ is ])) ♢ μ
+     where
+      ♢ : member k is → (S [ k ] ≤ directify₂ S [ i ∷ is ]) holds
+      ♢ μ = ⋁[ F ]-upper (family-of-lists S [ i ∷ is ]) (k , ∣ in-tail μ ∣)
+
+    † : (directify₂ S [ i ∷ is ] ≤ (S [ i ] ∨[ F ] directify₂ S [ is ]))
+         holds
+    † = ⋁[ F ]-least
+         (family-of-lists S [ i ∷ is ])
+         ((S [ i ] ∨[ F ] directify₂ S [ is ]) , β)
+
+    ‡ : ((S [ i ] ∨[ F ] directify₂ S [ is ]) ≤ directify₂ S [ i ∷ is ])
+         holds
+    ‡ = ∨[ F ]-least ‡₁ ‡₂
+     where
+      ‡₁ : (S [ i ] ≤ directify₂ S [ i ∷ is ]) holds
+      ‡₁ = ⋁[ F ]-upper (family-of-lists S [ i ∷ is ]) (i , ∣ in-head ∣)
+
+      ‡₂ : (directify₂ S [ is ] ≤ directify₂ S [ i ∷ is ]) holds
+      ‡₂ = ⋁[ F ]-least
+            (family-of-lists S [ is ])
+            (directify₂ S [ i ∷ is ] , γ)
+
+    Ⅰ  = ≤-is-antisymmetric (poset-of F) † ‡
+    Ⅱ  = ap (λ - → S [ i ] ∨[ F ] -) IH
+
+\end{code}
+
+Using the equality between `directify` and `directify₂`, we can now easily show
+how to obtain a subcover, from which it follows that `is-compact` implies
+`is-compact'`.
+
+\begin{code}
+
+module characterization-of-compactness₁ (X : Locale 𝓤 𝓥 𝓦) where
+
+ open PosetNotation (poset-of (𝒪 X))
+ open PosetReasoning (poset-of (𝒪 X))
+ open some-lemmas-on-directification (𝒪 X)
+
+ finite-subcover-through-directification
+  : (U : ⟨ 𝒪 X ⟩)
+  → (S : Fam 𝓦 ⟨ 𝒪 X ⟩)
+  → (is : List (index S))
+  → (U ≤ directify (𝒪 X) S [ is ]) holds
+  → Σ (J , β) ꞉ SubFam S ,
+     is-Kuratowski-finite J × (U ≤ (⋁[ 𝒪 X ] ⁅  S [ β j ] ∣ j ∶ J ⁆)) holds
+ finite-subcover-through-directification U S is p = T , 𝕗 , q
+  where
+   T : SubFam S
+   T = (Σ i ꞉ index S , ∥ member i is ∥) , pr₁
+
+   𝕗 : is-Kuratowski-finite (index T)
+   𝕗 = list-members-is-Kuratowski-finite is
+
+   † = directify₂-is-equal-to-directify S is ⁻¹
+
+   q : (U ≤ (⋁[ 𝒪 X ] ⁅ S [ T [ x ] ] ∣ x ∶ index T ⁆)) holds
+   q = U                                          ≤⟨ p     ⟩
+       directify (𝒪 X) S [ is ]                   ＝⟨ †    ⟩ₚ
+       directify₂ S [ is ]                        ＝⟨ refl ⟩ₚ
+       ⋁[ 𝒪 X ] ⁅ S [ T [ x ] ] ∣ x ∶ index T ⁆   ■
+
+\end{code}
+
+It follows from this that `is-compact-open` implies `is-compact-open'`.
+
+\begin{code}
+
+ compact-open-implies-compact-open' : (U : ⟨ 𝒪 X ⟩)
+                                    → is-compact-open  X U holds
+                                    → is-compact-open' X U holds
+ compact-open-implies-compact-open' U κ S q = ∥∥-functor † (κ S↑ δ p)
+  where
+   open JoinNotation (join-of (𝒪 X))
+
+   Xₚ = poset-of (𝒪 X)
+
+   S↑ : Fam 𝓦 ⟨ 𝒪 X ⟩
+   S↑ = directify (𝒪 X) S
+
+   δ : is-directed (𝒪 X) (directify (𝒪 X) S) holds
+   δ = directify-is-directed (𝒪 X) S
+
+   p : (U ≤[ Xₚ ] (⋁[ 𝒪 X ] S↑)) holds
+   p = U             ≤⟨ Ⅰ ⟩
+       ⋁[ 𝒪 X ] S    ＝⟨ Ⅱ ⟩ₚ
+       ⋁[ 𝒪 X ] S↑   ■
+        where
+         Ⅰ = q
+         Ⅱ = directify-preserves-joins (𝒪 X) S
+
+   † : Σ is ꞉ index S↑ , (U ≤[ Xₚ ] S↑ [ is ]) holds
+     → Σ (J , β) ꞉ SubFam S , is-Kuratowski-finite J
+                            × (U ≤[ Xₚ ] (⋁⟨ j ∶ J ⟩ S [ β j ])) holds
+   † = uncurry (finite-subcover-through-directification U S)
+
+\end{code}
+
+We now prove the converse which is a bit more difficult. We start with some
+preparation.
+
+Given a subset `P : ⟨ 𝒪 X ⟩ → Ω` and a family `S : Fam 𝓤 ⟨ 𝒪 X ⟩`, the type
+`Upper-Bound-Data P S` is the type of indices `i` of `S` such that `S [ i ]` is
+an upper bound of the subset `P`.
+
+\begin{code}
+
+module characterization-of-compactness₂ (X : Locale (𝓤 ⁺) 𝓤 𝓤) where
+
+ open some-lemmas-on-directification (𝒪 X)
+ open PosetNotation (poset-of (𝒪 X))
+ open PosetReasoning (poset-of (𝒪 X))
+ open Joins (λ x y → x ≤ y)
+
+ Upper-Bound-Data : 𝓟 {𝓣} ⟨ 𝒪 X ⟩ → Fam 𝓤 ⟨ 𝒪 X ⟩ → 𝓤 ⁺ ⊔ 𝓣  ̇
+ Upper-Bound-Data P S =
+  Σ i ꞉ index S , (Ɐ x ꞉ ⟨ 𝒪 X ⟩ , P x ⇒ x ≤ S [ i ]) holds
+
+\end{code}
+
+We now define the truncated version of this which we denote `has-upper-bound-in`:
+
+\begin{code}
+
+ has-upper-bound-in :  𝓟 {𝓣} ⟨ 𝒪 X ⟩ → Fam 𝓤 ⟨ 𝒪 X ⟩ → Ω (𝓤 ⁺ ⊔ 𝓣)
+ has-upper-bound-in P S = ∥ Upper-Bound-Data P S ∥Ω
+
+\end{code}
+
+Given a family `S`, we denote by `χ∙ S` the subset corresponding to the image of
+the family.
+
+\begin{code}
+
+ χ∙ : Fam 𝓤 ⟨ 𝒪 X ⟩ → ⟨ 𝒪 X ⟩ → Ω (𝓤 ⁺)
+ χ∙ S U = U ∈image (S [_]) , being-in-the-image-is-prop U (S [_])
+  where
+   open Equality carrier-of-[ poset-of (𝒪 X) ]-is-set
+
+\end{code}
+
+Given a Kuratowski-finite family `S`, the subset `χ∙ S` is a Kuratowski-finite
+subset.
+
+\begin{code}
+
+ χ∙-of-Kuratowski-finite-subset-is-Kuratowski-finite
+  : (S : Fam 𝓤 ⟨ 𝒪 X ⟩)
+  → is-Kuratowski-finite (index S)
+  → is-Kuratowski-finite-subset (χ∙ S)
+ χ∙-of-Kuratowski-finite-subset-is-Kuratowski-finite S = ∥∥-functor †
+  where
+   † : Σ n ꞉ ℕ , Fin n ↠ index S → Σ n ꞉ ℕ , Fin n ↠ image (S [_])
+   † (n , h , σ) = n , h′ , φ
+    where
+     h′ : Fin n → image (S [_])
+     h′ = corestriction (S [_]) ∘ h
+
+     φ : is-surjection h′
+     φ = ∘-is-surjection σ (corestrictions-are-surjections (S [_]))
+
+\end{code}
+
+We are now ready to prove our main lemma stating that every directed family `S`
+contains at least one upper bound of every Kuratowski-finite subset.
+
+\begin{code}
+
+ open binary-unions-of-subsets pt
+
+ directed-families-have-upper-bounds-of-Kuratowski-finite-subsets
+  : (S : Fam 𝓤 ⟨ 𝒪 X ⟩)
+  → is-directed (𝒪 X) S holds
+  → (P : 𝓚 ⟨ 𝒪 X ⟩)
+  → (⟨ P ⟩ ⊆ χ∙ S)
+  → has-upper-bound-in ⟨ P ⟩ S holds
+ directed-families-have-upper-bounds-of-Kuratowski-finite-subsets S 𝒹 (P , 𝕗) φ =
+  Kuratowski-finite-subset-induction pe fe ⟨ 𝒪 X ⟩ σ R i β γ δ (P , 𝕗) φ
+   where
+    R : 𝓚 ⟨ 𝒪 X ⟩ → 𝓤 ⁺  ̇
+    R Q = ⟨ Q ⟩ ⊆ χ∙ S → has-upper-bound-in ⟨ Q ⟩ S holds
+
+    i : (Q : 𝓚 ⟨ 𝒪 X ⟩) → is-prop (R Q)
+    i Q = Π-is-prop fe λ _ → holds-is-prop (has-upper-bound-in ⟨ Q ⟩ S)
+
+    σ : is-set ⟨ 𝒪 X ⟩
+    σ = carrier-of-[ poset-of (𝒪 X) ]-is-set
+
+    open singleton-Kuratowski-finite-subsets σ
+
+    β : R ∅[𝓚]
+    β _ = ∥∥-functor
+           (λ i → i , λ _ → 𝟘-elim)
+           (directedness-entails-inhabitation (𝒪 X) S 𝒹)
+
+    γ : (U : ⟨ 𝒪 X ⟩) → R ❴ U ❵[𝓚]
+    γ U μ = ∥∥-functor † (μ U refl)
+     where
+      † : Σ i ꞉ index S , S [ i ] ＝ U
+        → Upper-Bound-Data ⟨ ❴ U ❵[𝓚] ⟩ S
+      † (i , q) = i , ϑ
+       where
+        ϑ : (V : ⟨ 𝒪 X ⟩ ) → U ＝ V → (V ≤ S [ i ]) holds
+        ϑ V p = V          ＝⟨ p ⁻¹ ⟩ₚ
+                U          ＝⟨ q ⁻¹ ⟩ₚ
+                S [ i ]    ■
+
+    δ : (𝒜 ℬ : 𝓚 ⟨ 𝒪 X ⟩) → R 𝒜 → R ℬ → R (𝒜 ∪[𝓚] ℬ)
+    δ 𝒜@(A , _) ℬ@(B , _) ψ ϑ ι =
+     ∥∥-rec₂ (holds-is-prop (has-upper-bound-in (A ∪ B) S)) † (ψ ι₁) (ϑ ι₂)
+      where
+       ι₁ : A ⊆ χ∙ S
+       ι₁ V μ = ι V ∣ inl μ ∣
+
+       ι₂ : B ⊆ χ∙ S
+       ι₂ V μ = ι V ∣ inr μ ∣
+
+       † : Upper-Bound-Data A S
+         → Upper-Bound-Data B S
+         → has-upper-bound-in (A ∪ B) S holds
+       † (i , ξ) (j , ζ) = ∥∥-functor ‡ (pr₂ 𝒹 i j)
+        where
+         ‡ : (Σ k ꞉ index S , (S [ i ] ≤[ poset-of (𝒪 X) ] S [ k ]) holds
+                            × (S [ j ] ≤[ poset-of (𝒪 X) ] S [ k ]) holds)
+           → Upper-Bound-Data (A ∪ B) S
+         ‡ (k , p , q) = k , ♢
+          where
+           ♢ : (U : ⟨ 𝒪 X ⟩) → U ∈ (A ∪ B) → (U ≤ S [ k ]) holds
+           ♢ U = ∥∥-rec (holds-is-prop (U ≤ S [ k ])) ♠
+            where
+             ♠ : A U holds + B U holds → (U ≤ S [ k ]) holds
+             ♠ (inl μ) = U           ≤⟨ ξ U μ ⟩
+                         S [ i ]     ≤⟨ p     ⟩
+                         S [ k ]     ■
+             ♠ (inr μ) = U           ≤⟨ ζ U μ ⟩
+                         S [ j ]     ≤⟨ q     ⟩
+                         S [ k ]     ■
+
+\end{code}
+
+From this, we get that directed families contain at least one upper bound of
+their Kuratowski-finite subfamilies.
+
+\begin{code}
+
+ directed-families-have-upper-bounds-of-Kuratowski-finite-subfamilies
+  : (S : Fam 𝓤 ⟨ 𝒪 X ⟩)
+  → is-directed (𝒪 X) S holds
+  → (𝒥 : SubFam S)
+  → is-Kuratowski-finite (index 𝒥)
+  → has-upper-bound-in (χ∙ ⁅ S [ 𝒥 [ j ] ] ∣ j ∶ index 𝒥 ⁆) S holds
+ directed-families-have-upper-bounds-of-Kuratowski-finite-subfamilies S 𝒹 𝒥 𝕗 =
+  directed-families-have-upper-bounds-of-Kuratowski-finite-subsets
+   S
+   𝒹
+   (χ∙ ⁅ S [ 𝒥 [ j ] ] ∣ j ∶ index 𝒥 ⁆ , 𝕗′)
+   †
+    where
+     𝕗′ : is-Kuratowski-finite-subset (χ∙ ⁅ S [ 𝒥 [ j ] ] ∣ j ∶ index 𝒥 ⁆)
+     𝕗′ = χ∙-of-Kuratowski-finite-subset-is-Kuratowski-finite
+           ⁅ S [ 𝒥 [ j ] ] ∣ j ∶ index 𝒥 ⁆
+           𝕗
+
+     † : χ∙ ⁅ S [ 𝒥 [ j ] ] ∣ j ∶ index 𝒥 ⁆ ⊆ χ∙ S
+     † U = ∥∥-functor ‡
+      where
+       ‡ : Σ j ꞉ index 𝒥 , S [ 𝒥 [ j ] ] ＝ U → Σ i ꞉ index S , S [ i ] ＝ U
+       ‡ (i , p) = 𝒥 [ i ] , p
+
+\end{code}
+
+It easily follows from this that `is-compact-open'` implies `is-compact-open`.
+
+\begin{code}
+
+ compact-open'-implies-compact-open : (U : ⟨ 𝒪 X ⟩)
+                                    → is-compact-open' X U holds
+                                    → is-compact-open  X U holds
+ compact-open'-implies-compact-open U κ S δ p = ∥∥-rec ∃-is-prop † (κ S p)
+  where
+   † : Σ (J , h) ꞉ SubFam S , is-Kuratowski-finite J
+                            × (U ≤ (⋁[ 𝒪 X ] ⁅  S [ h j ] ∣ j ∶ J ⁆)) holds
+     → ∃ i ꞉ index S , (U ≤ S [ i ]) holds
+   † ((J , h) , 𝕗 , c) = ∥∥-functor ‡ γ
+    where
+     S′ : Fam 𝓤 ⟨ 𝒪 X ⟩
+     S′ = ⁅  S [ h j ] ∣ j ∶ J ⁆
+
+     ‡ : Upper-Bound-Data (χ∙ S′) S → Σ (λ i → (U ≤ S [ i ]) holds)
+     ‡ (i , q) = i , ♢
+      where
+       φ : ((S [ i ]) is-an-upper-bound-of S′) holds
+       φ j = q (S′ [ j ]) ∣ j , refl ∣
+
+       Ⅰ = c
+       Ⅱ = ⋁[ 𝒪 X ]-least ⁅ S [ h j ] ∣ j ∶ J ⁆ (S [ i ] , φ)
+
+       ♢ : (U ≤ S [ i ]) holds
+       ♢ = U                                 ≤⟨ Ⅰ ⟩
+           ⋁[ 𝒪 X ] ⁅ S [ h j ] ∣ j ∶ J ⁆    ≤⟨ Ⅱ ⟩
+           S [ i ]                           ■
+
+     γ : has-upper-bound-in (χ∙ S′) S holds
+     γ = directed-families-have-upper-bounds-of-Kuratowski-finite-subfamilies
+          S
+          δ
+          (J , h)
+          𝕗
+
+\end{code}
+
+\section{Another alternative definition}
+
+We now provide another variant of the definition `is-compact-open'`, which we
+show to be equivalent. This one says exactly that every cover has a
+Kuratowski-finite subcover.
+
+\begin{code}
+
+is-compact-open'' : (X : Locale 𝓤 𝓥 𝓦) → ⟨ 𝒪 X ⟩ → Ω (𝓤 ⊔ 𝓦 ⁺)
+is-compact-open'' {𝓤} {𝓥} {𝓦} X U =
+ Ɐ S ꞉ Fam 𝓦 ⟨ 𝒪 X ⟩ ,
+  (U ＝ₚ ⋁[ 𝒪 X ] S) ⇒
+   (Ǝ (J , h) ꞉ SubFam S , is-Kuratowski-finite J
+                         × (U ＝ ⋁[ 𝒪 X ] ⁅  S [ h j ] ∣ j ∶ J ⁆))
+    where
+     open PosetNotation (poset-of (𝒪 X))
+     open Equality carrier-of-[ poset-of (𝒪 X) ]-is-set
+
+module characterization-of-compactness₃ (X : Locale 𝓤 𝓥 𝓦) where
+
+ open PosetNotation (poset-of (𝒪 X))
+ open PosetReasoning (poset-of (𝒪 X))
+ open some-lemmas-on-directification (𝒪 X)
+
+\end{code}
+
+To see that `is-compact-open'` implies `is-compact-open''`, notice first that
+for every open `U : ⟨ 𝒪 X ⟩` and family `S`, we have that `U ≤ ⋁ S` if and
+only if `U ＝ ⋁ { U ∧ Sᵢ ∣ i : index S }`.
+
+\begin{code}
+
+ distribute-inside-cover₁ : (U : ⟨ 𝒪 X ⟩) (S : Fam 𝓦 ⟨ 𝒪 X ⟩)
+                          → U ＝ ⋁[ 𝒪 X ] ⁅ U ∧[ 𝒪 X ] (S [ i ]) ∣ i ∶ index S ⁆
+                          → (U ≤ (⋁[ 𝒪 X ] S)) holds
+ distribute-inside-cover₁ U S p = connecting-lemma₂ (𝒪 X) †
+  where
+   Ⅰ = p
+
+   Ⅱ : ⋁[ 𝒪 X ] ⁅ U ∧[ 𝒪 X ] S [ i ] ∣ i ∶ index S ⁆ ＝ U ∧[ 𝒪 X ] (⋁[ 𝒪 X ] S)
+   Ⅱ = distributivity (𝒪 X) U S ⁻¹
+
+   † : U ＝ U ∧[ 𝒪 X ] (⋁[ 𝒪 X ] S)
+   † = U                                               ＝⟨ Ⅰ ⟩
+       ⋁[ 𝒪 X ] ⁅ U ∧[ 𝒪 X ] S [ i ] ∣ i ∶ index S ⁆   ＝⟨ Ⅱ ⟩
+       U ∧[ 𝒪 X ] (⋁[ 𝒪 X ] S)                         ∎
+
+ distribute-inside-cover₂
+  : (U : ⟨ 𝒪 X ⟩) (S : Fam 𝓦 ⟨ 𝒪 X ⟩)
+  → (U ≤ (⋁[ 𝒪 X ] S)) holds
+  → U ＝ ⋁[ 𝒪 X ] ⁅ U ∧[ 𝒪 X ] (S [ i ]) ∣ i ∶ index S ⁆
+ distribute-inside-cover₂ U S p =
+  U                                                 ＝⟨ Ⅰ ⟩
+  U ∧[ 𝒪 X ] (⋁[ 𝒪 X ] S)                           ＝⟨ Ⅱ ⟩
+  ⋁[ 𝒪 X ] ⁅ U ∧[ 𝒪 X ] (S [ i ]) ∣ i ∶ index S ⁆   ∎
+  where
+   Ⅰ = connecting-lemma₁ (𝒪 X) p
+   Ⅱ = distributivity (𝒪 X) U S
+
+\end{code}
+
+The backward implication follows easily from these two lemmas.
+
+\begin{code}
+
+ compact-open''-implies-compact-open' : (U : ⟨ 𝒪 X ⟩)
+                                      → is-compact-open'' X U holds
+                                      → is-compact-open'  X U holds
+ compact-open''-implies-compact-open' U κ S p = ∥∥-functor † ♢
+  where
+   q : U ＝ ⋁[ 𝒪 X ] ⁅ U ∧[ 𝒪 X ] (S [ i ]) ∣ i ∶ index S ⁆
+   q = distribute-inside-cover₂ U S p
+
+   ♢ : ∃ (J , h) ꞉ SubFam S , is-Kuratowski-finite J
+                            × (U ＝ ⋁[ 𝒪 X ] ⁅ U ∧[ 𝒪 X ] S [ h j ] ∣ j ∶ J ⁆)
+   ♢ = κ ⁅ U ∧[ 𝒪 X ] (S [ i ]) ∣ i ∶ index S ⁆ q
+
+   † : Σ (J , h) ꞉ SubFam S , is-Kuratowski-finite J
+                            × (U ＝ ⋁[ 𝒪 X ] ⁅ U ∧[ 𝒪 X ] S [ h j ] ∣ j ∶ J ⁆)
+     → Σ (J , h) ꞉ SubFam S , is-Kuratowski-finite J
+                            × (U ≤ (⋁[ 𝒪 X ] ⁅ S [ h j ] ∣ j ∶ J ⁆)) holds
+   † (𝒥@(J , h) , 𝕗 , p) =
+    𝒥 , 𝕗 , distribute-inside-cover₁ U ⁅ S [ h j ] ∣ j ∶ J ⁆ p
+
+\end{code}
+
+Now, the forward implication:
+
+\begin{code}
+
+ compact-open'-implies-compact-open'' : (U : ⟨ 𝒪 X ⟩)
+                                      → is-compact-open'  X U holds
+                                      → is-compact-open'' X U holds
+ compact-open'-implies-compact-open'' U κ S p = ∥∥-functor † (κ S c)
+  where
+   open Joins (λ x y → x ≤ y)
+   open PosetNotation (poset-of (𝒪 X)) renaming (_≤_ to _≤∙_)
+
+   c : (U ≤∙ (⋁[ 𝒪 X ] S)) holds
+   c = reflexivity+ (poset-of (𝒪 X)) p
+
+   † : (Σ F ꞉ SubFam S ,
+         is-Kuratowski-finite (index F)
+         × (U ≤∙ (⋁[ 𝒪 X ] ⁅ S [ F [ j ] ] ∣ j ∶ index F ⁆)) holds)
+     → Σ F ꞉ SubFam S ,
+        is-Kuratowski-finite (index F)
+        × (U ＝ ⋁[ 𝒪 X ] ⁅ S [ F [ j ] ] ∣ j ∶ index F ⁆)
+   † (F , 𝕗 , q) = F , 𝕗 , r
+    where
+     ψ : cofinal-in (𝒪 X) ⁅ S [ F [ j ] ] ∣ j ∶ index F ⁆ S holds
+     ψ j = ∣ F [ j ] , ≤-is-reflexive (poset-of (𝒪 X)) (S [ F [ j ] ]) ∣
+
+     ♢ : ((⋁[ 𝒪 X ] ⁅ S [ F [ j ] ] ∣ j ∶ index F ⁆) ≤∙ U) holds
+     ♢ = ⋁[ 𝒪 X ] ⁅ S [ F [ j ] ] ∣ j ∶ index F ⁆   ≤⟨  Ⅰ ⟩
+         ⋁[ 𝒪 X ] S                                 ＝⟨ Ⅱ ⟩ₚ
+         U                                          ■
+          where
+           Ⅰ = cofinal-implies-join-covered (𝒪 X) _ _ ψ
+           Ⅱ = p ⁻¹
+
+     r : U ＝ ⋁[ 𝒪 X ] ⁅ S [ F [ j ] ] ∣ j ∶ index F ⁆
+     r = ≤-is-antisymmetric (poset-of (𝒪 X)) q ♢
+
+\end{code}
+
+In the above proof, I have implemented a simplification that Tom de Jong
+suggested in a code review.
diff --git a/source/Locales/Complements.lagda b/source/Locales/Complements.lagda
index a2f1f02f5..6bba14958 100644
--- a/source/Locales/Complements.lagda
+++ b/source/Locales/Complements.lagda
@@ -4,24 +4,16 @@ Ayberk Tosun, 11 September 2023
 
 {-# OPTIONS --safe --without-K --lossy-unification #-}
 
-open import MLTT.Spartan hiding (𝟚)
 open import UF.FunExt
 open import UF.PropTrunc
-open import UF.UA-FunExt
 
 module Locales.Complements (pt : propositional-truncations-exist)
                            (fe : Fun-Ext)                           where
 
-open import Locales.AdjointFunctorTheoremForFrames
-open import Locales.Compactness pt fe
 open import Locales.ContinuousMap.FrameHomomorphism-Definition pt fe
 open import Locales.ContinuousMap.FrameHomomorphism-Properties pt fe
 open import Locales.Frame pt fe
-open import Locales.GaloisConnection pt fe
-open import Locales.InitialFrame     pt fe
-open import Locales.WayBelowRelation.Definition pt fe
-open import Slice.Family
-open import UF.Base using (from-Σ-＝)
+open import MLTT.Spartan hiding (𝟚)
 open import UF.Logic
 open import UF.SubtypeClassifier
 
diff --git a/source/Locales/ContinuousMap/Definition.lagda b/source/Locales/ContinuousMap/Definition.lagda
index 2c38fa1e7..40a225174 100644
--- a/source/Locales/ContinuousMap/Definition.lagda
+++ b/source/Locales/ContinuousMap/Definition.lagda
@@ -13,10 +13,8 @@ Factored out from the `Locales.Frame` module into this module on 2024-04-10.
 {-# OPTIONS --safe --without-K #-}
 
 open import MLTT.Spartan hiding (𝟚; ₀; ₁)
-open import UF.Base
 open import UF.FunExt
 open import UF.PropTrunc
-open import MLTT.List hiding ([_])
 
 module Locales.ContinuousMap.Definition
         (pt : propositional-truncations-exist)
@@ -26,12 +24,7 @@ module Locales.ContinuousMap.Definition
 open import Locales.Frame pt fe
 open import Locales.ContinuousMap.FrameHomomorphism-Definition pt fe
 open import Slice.Family
-open import UF.Equiv
-open import UF.Hedberg
 open import UF.Logic
-open import UF.Sets
-open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 open import UF.SubtypeClassifier
 
 open AllCombinators pt fe
diff --git a/source/Locales/ContinuousMap/FrameHomomorphism-Definition.lagda b/source/Locales/ContinuousMap/FrameHomomorphism-Definition.lagda
index 95ce59e78..c30ead41c 100644
--- a/source/Locales/ContinuousMap/FrameHomomorphism-Definition.lagda
+++ b/source/Locales/ContinuousMap/FrameHomomorphism-Definition.lagda
@@ -15,10 +15,8 @@ Factored out from the `Locales.Frame` module into this module on 2024-04-10.
 {-# OPTIONS --safe --without-K #-}
 
 open import MLTT.Spartan hiding (𝟚; ₀; ₁)
-open import UF.Base
 open import UF.FunExt
 open import UF.PropTrunc
-open import MLTT.List hiding ([_])
 
 module Locales.ContinuousMap.FrameHomomorphism-Definition
         (pt : propositional-truncations-exist)
@@ -28,11 +26,8 @@ module Locales.ContinuousMap.FrameHomomorphism-Definition
 open import Locales.Frame pt fe
 open import Slice.Family
 open import UF.Equiv
-open import UF.Hedberg
 open import UF.Logic
 open import UF.Sets
-open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 open import UF.SubtypeClassifier
 
 open AllCombinators pt fe
diff --git a/source/Locales/ContinuousMap/FrameHomomorphism-Properties.lagda b/source/Locales/ContinuousMap/FrameHomomorphism-Properties.lagda
index fec81c555..f78dc5b59 100644
--- a/source/Locales/ContinuousMap/FrameHomomorphism-Properties.lagda
+++ b/source/Locales/ContinuousMap/FrameHomomorphism-Properties.lagda
@@ -13,7 +13,6 @@ Factored out from the `Locales.Frame` module on 2024-04-10.
 
 {-# OPTIONS --safe --without-K #-}
 
-open import MLTT.List hiding ([_])
 open import MLTT.Spartan hiding (𝟚; ₀; ₁)
 open import UF.Base
 open import UF.FunExt
@@ -27,11 +26,8 @@ module Locales.ContinuousMap.FrameHomomorphism-Properties
 open import Locales.ContinuousMap.FrameHomomorphism-Definition pt fe
 open import Locales.Frame pt fe
 open import Slice.Family
-open import UF.Hedberg
 open import UF.Logic
-open import UF.Sets
 open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 open import UF.SubtypeClassifier
 
 open AllCombinators pt fe
diff --git a/source/Locales/ContinuousMap/FrameIsomorphism-Definition.lagda b/source/Locales/ContinuousMap/FrameIsomorphism-Definition.lagda
index f6f4e157a..cd986e507 100644
--- a/source/Locales/ContinuousMap/FrameIsomorphism-Definition.lagda
+++ b/source/Locales/ContinuousMap/FrameIsomorphism-Definition.lagda
@@ -24,12 +24,10 @@ module Locales.ContinuousMap.FrameIsomorphism-Definition
 open import Locales.ContinuousMap.FrameHomomorphism-Definition pt fe
 open import Locales.ContinuousMap.FrameHomomorphism-Properties pt fe
 open import Locales.Frame pt fe
-open import Slice.Family
 open import UF.Equiv
 open import UF.Equiv-FunExt
 open import UF.Logic
 open import UF.Retracts
-open import UF.SIP
 open import UF.Subsingletons
 open import UF.Subsingletons-FunExt
 open import UF.SubtypeClassifier
diff --git a/source/Locales/ContinuousMap/Homeomorphism-Definition.lagda b/source/Locales/ContinuousMap/Homeomorphism-Definition.lagda
index 08e05b8d9..0bc135b96 100644
--- a/source/Locales/ContinuousMap/Homeomorphism-Definition.lagda
+++ b/source/Locales/ContinuousMap/Homeomorphism-Definition.lagda
@@ -14,7 +14,6 @@ their defining frames, however, we give a different name to this notion.
 {-# OPTIONS --safe --without-K #-}
 
 open import MLTT.Spartan hiding (𝟚; ₀; ₁)
-open import UF.Base
 open import UF.FunExt
 open import UF.PropTrunc
 
@@ -23,17 +22,9 @@ module Locales.ContinuousMap.Homeomorphism-Definition
         (fe : Fun-Ext)
        where
 
-open import Locales.ContinuousMap.Definition pt fe
 open import Locales.ContinuousMap.FrameIsomorphism-Definition pt fe
 open import Locales.Frame pt fe
-open import Slice.Family
-open import UF.Equiv
-open import UF.Hedberg
 open import UF.Logic
-open import UF.Sets
-open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
-open import UF.SubtypeClassifier
 
 open AllCombinators pt fe
 open Locale
diff --git a/source/Locales/ContinuousMap/Homeomorphism-Properties.lagda b/source/Locales/ContinuousMap/Homeomorphism-Properties.lagda
index 7a7350445..5669f5bcd 100644
--- a/source/Locales/ContinuousMap/Homeomorphism-Properties.lagda
+++ b/source/Locales/ContinuousMap/Homeomorphism-Properties.lagda
@@ -11,7 +11,6 @@ Some properties of locale homeomorphisms.
 {-# OPTIONS --safe --without-K #-}
 
 open import MLTT.Spartan hiding (𝟚; ₀; ₁)
-open import UF.Base
 open import UF.FunExt
 open import UF.PropTrunc
 open import UF.Size
@@ -32,18 +31,11 @@ private
  pe : Prop-Ext
  pe {𝓤} = univalence-gives-propext (ua 𝓤)
 
-open import Locales.ContinuousMap.Definition pt fe
 open import Locales.ContinuousMap.FrameIsomorphism-Definition pt fe
 open import Locales.ContinuousMap.Homeomorphism-Definition pt fe
 open import Locales.Frame pt fe
 open import Locales.SIP.FrameSIP ua pt sr
-open import Slice.Family
-open import UF.Equiv
-open import UF.Hedberg
 open import UF.Logic
-open import UF.Sets
-open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 open import UF.SubtypeClassifier
 
 open AllCombinators pt fe
diff --git a/source/Locales/ContinuousMap/Properties.lagda b/source/Locales/ContinuousMap/Properties.lagda
index 8816f21b4..94f7445ad 100644
--- a/source/Locales/ContinuousMap/Properties.lagda
+++ b/source/Locales/ContinuousMap/Properties.lagda
@@ -11,10 +11,8 @@ Factored out from the `Locales.Frame` module on 2024-04-10.
 {-# OPTIONS --safe --without-K #-}
 
 open import MLTT.Spartan hiding (𝟚; ₀; ₁)
-open import UF.Base
 open import UF.FunExt
 open import UF.PropTrunc
-open import MLTT.List hiding ([_])
 
 module Locales.ContinuousMap.Properties
         (pt : propositional-truncations-exist)
@@ -22,17 +20,9 @@ module Locales.ContinuousMap.Properties
        where
 
 open import Locales.Frame pt fe
-open import Locales.ContinuousMap.FrameHomomorphism-Definition pt fe
 open import Locales.ContinuousMap.FrameHomomorphism-Properties pt fe
 open import Locales.ContinuousMap.Definition pt fe
-open import Slice.Family
-open import UF.Equiv
-open import UF.Hedberg
 open import UF.Logic
-open import UF.Sets
-open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
-open import UF.SubtypeClassifier
 
 open AllCombinators pt fe
 open ContinuousMaps
diff --git a/source/Locales/DirectedFamily-Poset.lagda b/source/Locales/DirectedFamily-Poset.lagda
index cbd0d7c56..c572ba7f8 100644
--- a/source/Locales/DirectedFamily-Poset.lagda
+++ b/source/Locales/DirectedFamily-Poset.lagda
@@ -24,7 +24,6 @@ module Locales.DirectedFamily-Poset (pt : propositional-truncations-exist)
 open import Locales.Frame pt fe hiding (is-directed)
 open import MLTT.Spartan
 open import UF.Logic
-open import UF.Subsingletons
 
 open AllCombinators pt fe
 open PropositionalTruncation pt
diff --git a/source/Locales/DirectedFamily.lagda b/source/Locales/DirectedFamily.lagda
index cf4004594..b522de8f4 100644
--- a/source/Locales/DirectedFamily.lagda
+++ b/source/Locales/DirectedFamily.lagda
@@ -16,7 +16,6 @@ and constructions that involve only the order of a given frame.
 open import MLTT.Spartan
 open import UF.FunExt
 open import UF.PropTrunc
-open import UF.Subsingletons
 open import UF.SubtypeClassifier
 
 module Locales.DirectedFamily
@@ -26,9 +25,7 @@ module Locales.DirectedFamily
         (_≤_ : X → X → Ω 𝓥)
        where
 
-open import Locales.Frame pt fe hiding (is-directed)
 open import Slice.Family
-open import UF.Equiv
 open import UF.Logic
 
 open AllCombinators pt fe
diff --git a/source/Locales/DiscreteLocale/Basis.lagda b/source/Locales/DiscreteLocale/Basis.lagda
new file mode 100644
index 000000000..951d52f0a
--- /dev/null
+++ b/source/Locales/DiscreteLocale/Basis.lagda
@@ -0,0 +1,189 @@
+---
+title:          Construction of a basis for the discrete locale
+author:         Ayberk Tosun
+date-started:   2024-09-13
+date-completed: 2024-09-17
+---
+
+\begin{code}
+
+{-# OPTIONS --safe --without-K #-}
+
+open import UF.FunExt
+open import UF.PropTrunc
+open import UF.Size
+open import UF.Subsingletons
+
+module Locales.DiscreteLocale.Basis
+        (fe : Fun-Ext)
+        (pe : Prop-Ext)
+        (pt : propositional-truncations-exist)
+        (sr : Set-Replacement pt)
+       where
+
+open import Locales.DiscreteLocale.Definition fe pe pt
+open import Locales.Frame pt fe hiding (∅)
+open import Locales.SmallBasis pt fe sr
+open import MLTT.List hiding ([_])
+open import MLTT.Spartan
+open import Slice.Family
+open import UF.Logic
+open import UF.Powerset
+open import UF.Sets
+open import UF.SubtypeClassifier
+
+open AllCombinators pt fe renaming (_∧_ to _∧ₚ_; _∨_ to _∨ₚ_)
+open PropositionalSubsetInclusionNotation fe
+open PropositionalTruncation pt hiding (_∨_)
+
+\end{code}
+
+We work in a module parameterized by a set `X`.
+
+\begin{code}
+
+module basis-for-the-discrete-locale (X : 𝓤  ̇) (σ : is-set X) where
+
+ open binary-unions-of-subsets pt
+ open singleton-subsets σ
+ open DefnOfDiscreteLocale X σ
+
+ 𝓟-Frm : Frame (𝓤 ⁺) 𝓤 𝓤
+ 𝓟-Frm = frame-of-subsets
+
+\end{code}
+
+We define the function `finite-union` that gives the subset corresponding to
+membership in a list.
+
+\begin{code}
+
+ finite-join : List X → 𝓟 X
+ finite-join []       = ∅
+ finite-join (x ∷ xs) = ❴ x ❵ ∪ finite-join xs
+
+\end{code}
+
+This maps the concatenation operator `_++_` to binary union `_∪_`.
+
+\begin{code}
+
+ finite-join-is-homomorphic
+  : (xs ys : List X) → finite-join (xs ++ ys) ＝ finite-join xs ∪ finite-join ys
+ finite-join-is-homomorphic []       ys = finite-join ys      ＝⟨ † ⟩
+                                          ∅ ∪ finite-join ys  ∎
+  where
+   † = ∅-left-neutral-for-∪ pe fe (finite-join ys) ⁻¹
+ finite-join-is-homomorphic (x ∷ xs) ys =
+  finite-join ((x ∷ xs) ++ ys)               ＝⟨ refl ⟩
+  finite-join (x ∷ xs ++ ys)                 ＝⟨ refl ⟩
+  ❴ x ❵ ∪ finite-join (xs ++ ys)             ＝⟨ Ⅰ    ⟩
+  ❴ x ❵ ∪ (finite-join xs ∪ finite-join ys)  ＝⟨ Ⅱ    ⟩
+  (❴ x ❵ ∪ finite-join xs) ∪ finite-join ys  ＝⟨ refl ⟩
+  finite-join (x ∷ xs) ∪ finite-join ys      ∎
+   where
+    IH = finite-join-is-homomorphic xs ys
+
+    Ⅰ = ap (λ - → ❴ x ❵ ∪ -) IH
+    Ⅱ = ∪-assoc pe fe ❴ x ❵ (finite-join xs) (finite-join ys) ⁻¹
+
+\end{code}
+
+Given a subset `S ⊆ 𝓟 X`, the index of the basic covering family for it
+is the type of lists whose finite join is included in `S`:
+
+\begin{code}
+
+ Basic-Cover-Index : 𝓟 X → 𝓤  ̇
+ Basic-Cover-Index S = Σ xs ꞉ List X , finite-join xs ⊆ S
+
+\end{code}
+
+Using this, we define the covering families:
+
+\begin{code}
+
+ lists-within : 𝓟 X → Fam 𝓤 (List X)
+ lists-within S = Basic-Cover-Index S , pr₁
+
+\end{code}
+
+It is easy to see that these covering families are directed:
+
+\begin{code}
+
+ lists-within-is-directed : (S : 𝓟 X)
+                          → is-directed
+                             𝓟-Frm
+                             ⁅ finite-join xs ∣ xs ε lists-within S ⁆
+                              holds
+ lists-within-is-directed S = ι , υ
+  where
+   open PosetReasoning (poset-of 𝓟-Frm)
+
+   ι : ∥ Basic-Cover-Index S ∥
+   ι = ∣ [] , ∅-is-least S ∣
+
+   υ : ((xs , _) (ys , _) : Basic-Cover-Index S)
+     → ∃ (zs , _) ꞉ Basic-Cover-Index S ,
+        finite-join xs ⊆ finite-join zs × finite-join ys ⊆ finite-join zs
+   υ (xs , p) (ys , q) = ∣ ((xs ++ ys) , †) , φ , ψ ∣
+    where
+     ‡ = ∪-is-lowerbound-of-upperbounds (finite-join xs) (finite-join ys) S p q
+
+     † : finite-join (xs ++ ys) ⊆ S
+     † = transport (λ - → - ⊆ S) (finite-join-is-homomorphic xs ys ⁻¹) ‡
+
+     φ : finite-join xs ⊆ finite-join (xs ++ ys)
+     φ = transport
+          (λ - → finite-join xs ⊆ -)
+          (finite-join-is-homomorphic xs ys ⁻¹)
+          (∪-is-upperbound₁ (finite-join xs) (finite-join ys))
+
+     ψ : finite-join ys ⊆ finite-join (xs ++ ys)
+     ψ = transport
+          (λ - → finite-join ys ⊆ -)
+          (finite-join-is-homomorphic xs ys ⁻¹)
+          (∪-is-upperbound₂ (finite-join xs) (finite-join ys))
+
+\end{code}
+
+We conclude that the family `finite-join : List X → 𝓟(X)` forms a directed
+basis.
+
+\begin{code}
+
+ list-forms-directed-basis : directed-basis-forᴰ 𝓟-Frm (List X , finite-join)
+ list-forms-directed-basis S = lists-within S , γ , lists-within-is-directed S
+  where
+   open Joins (λ S T → S ≤[ poset-of 𝓟-Frm ] T)
+
+   †₁ : S ⊆ (⋁[ 𝓟-Frm ] ⁅ finite-join xs ∣ xs ε lists-within S ⁆)
+   †₁ x μ =
+    ⋁[ 𝓟-Frm ]-upper ⁅ finite-join xs ∣ xs ε lists-within S ⁆ ((x ∷ []) , φ) x ∣ inl refl ∣
+     where
+      φ : finite-join (x ∷ []) ⊆ S
+      φ y p = transport (λ - → - ∈ S) q μ
+       where
+        q : y ∈ ❴ x ❵
+        q = transport (λ - → y ∈ -) (∅-right-neutral-for-∪ pe fe ❴ x ❵ ⁻¹) p
+
+
+   †₂ : (⋁[ 𝓟-Frm ] ⁅ finite-join xs ∣ xs ε lists-within S ⁆) ⊆ S
+   †₂ = ⋁[ 𝓟-Frm ]-least ⁅ finite-join xs ∣ xs ε lists-within S ⁆ (S , γ)
+    where
+
+     γ : (S is-an-upper-bound-of ⁅ finite-join xs ∣ xs ε lists-within S ⁆) holds
+     γ (xs , p) = p
+
+   † : S ＝ ⋁[ 𝓟-Frm ] ⁅ finite-join xs ∣ xs ε lists-within S ⁆
+   † = ≤-is-antisymmetric (poset-of 𝓟-Frm) †₁ †₂
+
+   γ : (S is-lub-of ⁅ finite-join xs ∣ xs ε lists-within S ⁆) holds
+   γ = transport
+        (λ - → (- is-lub-of ⁅ finite-join xs ∣ xs ε lists-within S ⁆) holds)
+        († ⁻¹)
+        (⋁[ 𝓟-Frm ]-upper ⁅ finite-join xs ∣ xs ε lists-within S ⁆
+        , ⋁[ 𝓟-Frm ]-least ⁅ finite-join xs ∣ xs ε lists-within S ⁆)
+
+\end{code}
diff --git a/source/Locales/DiscreteLocale/Definition.lagda b/source/Locales/DiscreteLocale/Definition.lagda
index 9cc9247ae..c3d9cd706 100644
--- a/source/Locales/DiscreteLocale/Definition.lagda
+++ b/source/Locales/DiscreteLocale/Definition.lagda
@@ -1,9 +1,9 @@
---------------------------------------------------------------------------------
+---
 title:          The discrete locale
 author:         Ayberk Tosun
 date-started:   2024-03-04
 date-completed: 2024-03-04
---------------------------------------------------------------------------------
+---
 
 We define the discrete locale (i.e. the frame of opens of the discrete topology)
 over a set `X`.
@@ -22,7 +22,6 @@ module Locales.DiscreteLocale.Definition
         (pt : propositional-truncations-exist)
        where
 
-open import Locales.DistributiveLattice.Definition fe pt
 open import Locales.Frame pt fe
 open import MLTT.Spartan
 open import Slice.Family
diff --git a/source/Locales/DiscreteLocale/Two-Properties.lagda b/source/Locales/DiscreteLocale/Two-Properties.lagda
index ba8e99c0d..5bc16c44c 100644
--- a/source/Locales/DiscreteLocale/Two-Properties.lagda
+++ b/source/Locales/DiscreteLocale/Two-Properties.lagda
@@ -25,22 +25,17 @@ module Locales.DiscreteLocale.Two-Properties
        where
 
 
-open import Locales.DiscreteLocale.Definition fe pe pt
+open import Locales.Compactness.Definition pt fe
 open import Locales.DiscreteLocale.Two fe pe pt
-open import Locales.DistributiveLattice.Definition fe pt
 open import Locales.Frame pt fe
+open import Locales.Sierpinski 𝓤 pe pt fe
 open import Locales.SmallBasis pt fe sr
 open import Locales.Spectrality.SpectralLocale pt fe
 open import Locales.Spectrality.SpectralMap pt fe
-open import Locales.Sierpinski 𝓤 pe pt fe
 open import Locales.Stone pt fe sr
--- open import Locales.PatchProperties pt fe sr
-open import Locales.Compactness pt fe
 open import Slice.Family
-open import UF.DiscreteAndSeparated hiding (𝟚-is-set)
 open import UF.Logic
 open import UF.Powerset
-open import UF.Sets
 open import UF.SubtypeClassifier
 
 open AllCombinators pt fe renaming (_∧_ to _∧ₚ_; _∨_ to _∨ₚ_)
diff --git a/source/Locales/DiscreteLocale/Two.lagda b/source/Locales/DiscreteLocale/Two.lagda
index b6a60f603..cdd487d72 100644
--- a/source/Locales/DiscreteLocale/Two.lagda
+++ b/source/Locales/DiscreteLocale/Two.lagda
@@ -21,16 +21,13 @@ module Locales.DiscreteLocale.Two
         (pt : propositional-truncations-exist)
        where
 
-open import Locales.DistributiveLattice.Definition fe pt
 open import Locales.DiscreteLocale.Definition fe pe pt
 open import Locales.Frame pt fe
 open import MLTT.Spartan hiding (𝟚)
-open import Slice.Family
 open import UF.Logic
 open import UF.Sets
 open import UF.DiscreteAndSeparated hiding (𝟚-is-set)
 open import UF.Powerset
-open import UF.SubtypeClassifier
 
 open AllCombinators pt fe renaming (_∧_ to _∧ₚ_; _∨_ to _∨ₚ_)
 open PropositionalSubsetInclusionNotation fe
diff --git a/source/Locales/DistributiveLattice/Definition-SigmaBased.lagda b/source/Locales/DistributiveLattice/Definition-SigmaBased.lagda
index 843f9ffce..f29b98bb3 100644
--- a/source/Locales/DistributiveLattice/Definition-SigmaBased.lagda
+++ b/source/Locales/DistributiveLattice/Definition-SigmaBased.lagda
@@ -20,15 +20,11 @@ module Locales.DistributiveLattice.Definition-SigmaBased
        where
 
 open import Locales.DistributiveLattice.Definition fe pt
-open import Locales.Frame pt fe
 open import MLTT.Spartan
-open import UF.Base
 open import UF.Equiv
 open import UF.Logic
-open import UF.Powerset-MultiUniverse
 open import UF.Sets-Properties
 open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 open import UF.Subsingletons-Properties
 open import UF.SubtypeClassifier
 
diff --git a/source/Locales/DistributiveLattice/Definition.lagda b/source/Locales/DistributiveLattice/Definition.lagda
index 6583d3564..e5891fe79 100644
--- a/source/Locales/DistributiveLattice/Definition.lagda
+++ b/source/Locales/DistributiveLattice/Definition.lagda
@@ -19,9 +19,7 @@ module Locales.DistributiveLattice.Definition
 
 open import Locales.Frame pt fe
 open import MLTT.Spartan
-open import UF.Base
 open import UF.Logic
-open import UF.Powerset-MultiUniverse
 open import UF.SubtypeClassifier
 
 open Implication fe
diff --git a/source/Locales/DistributiveLattice/Homomorphism.lagda b/source/Locales/DistributiveLattice/Homomorphism.lagda
index 52748b3c4..4dd199583 100644
--- a/source/Locales/DistributiveLattice/Homomorphism.lagda
+++ b/source/Locales/DistributiveLattice/Homomorphism.lagda
@@ -14,7 +14,6 @@ homomorphism.
 
 open import UF.FunExt
 open import UF.PropTrunc
-open import UF.Sets
 
 module Locales.DistributiveLattice.Homomorphism
         (fe : Fun-Ext)
@@ -24,9 +23,7 @@ module Locales.DistributiveLattice.Homomorphism
 open import Locales.DistributiveLattice.Definition fe pt
 open import Locales.Frame pt fe
 open import MLTT.Spartan
-open import UF.Base
 open import UF.Logic
-open import UF.Powerset-MultiUniverse
 open import UF.SubtypeClassifier
 
 open AllCombinators pt fe renaming (_∧_ to _∧ₚ_)
diff --git a/source/Locales/DistributiveLattice/Ideal-Properties.lagda b/source/Locales/DistributiveLattice/Ideal-Properties.lagda
index 0a5cd18c1..b1af6554b 100644
--- a/source/Locales/DistributiveLattice/Ideal-Properties.lagda
+++ b/source/Locales/DistributiveLattice/Ideal-Properties.lagda
@@ -12,7 +12,6 @@ dates-updated: [2024-03-13, 2024-03-28, 2024-05-03]
 open import UF.FunExt
 open import UF.PropTrunc
 open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 
 module Locales.DistributiveLattice.Ideal-Properties
         (pt : propositional-truncations-exist)
@@ -22,17 +21,12 @@ module Locales.DistributiveLattice.Ideal-Properties
 
 open import Locales.DistributiveLattice.Definition fe pt
 open import Locales.DistributiveLattice.Ideal pt fe pe
-open import Locales.DistributiveLattice.Properties fe pt
 open import Locales.DistributiveLattice.Spectrum fe pe pt
 open import Locales.Frame pt fe hiding (is-directed)
-open import MLTT.List
 open import MLTT.Spartan
 open import Slice.Family
-open import UF.Base
 open import UF.Classifiers
-open import UF.Equiv hiding (_■)
 open import UF.Logic
-open import UF.Powerset-MultiUniverse hiding (𝕋)
 open import UF.SubtypeClassifier
 
 open AllCombinators pt fe hiding (_∨_)
diff --git a/source/Locales/DistributiveLattice/Ideal.lagda b/source/Locales/DistributiveLattice/Ideal.lagda
index 81ac5a892..a221d4a92 100644
--- a/source/Locales/DistributiveLattice/Ideal.lagda
+++ b/source/Locales/DistributiveLattice/Ideal.lagda
@@ -27,7 +27,6 @@ open import Locales.DistributiveLattice.Properties fe pt
 open import Locales.Frame pt fe
 open import MLTT.List
 open import MLTT.Spartan
-open import UF.Base
 open import UF.Equiv hiding (_■)
 open import UF.Logic
 open import UF.Powerset-MultiUniverse
diff --git a/source/Locales/DistributiveLattice/Isomorphism-Properties.lagda b/source/Locales/DistributiveLattice/Isomorphism-Properties.lagda
index 97bb44487..82af6c791 100644
--- a/source/Locales/DistributiveLattice/Isomorphism-Properties.lagda
+++ b/source/Locales/DistributiveLattice/Isomorphism-Properties.lagda
@@ -12,10 +12,8 @@ In this module, we collect properties of distributive lattice isomorphisms.
 {-# OPTIONS --safe --without-K #-}
 
 open import MLTT.Spartan hiding (𝟚; ₀; ₁)
-open import UF.Base
 open import UF.FunExt
 open import UF.PropTrunc
-open import UF.Sets
 open import UF.Size
 open import UF.Subsingletons
 open import UF.UA-FunExt
@@ -34,26 +32,10 @@ private
  pe : Prop-Ext
  pe {𝓤} = univalence-gives-propext (ua 𝓤)
 
-open import Locales.AdjointFunctorTheoremForFrames pt fe
-open import Locales.Adjunctions.Properties pt fe
-open import Locales.Adjunctions.Properties-DistributiveLattice pt fe
 open import Locales.DistributiveLattice.Definition fe pt
-open import Locales.DistributiveLattice.Homomorphism fe pt
 open import Locales.DistributiveLattice.Isomorphism fe pt
-open import Locales.Frame pt fe
-open import Locales.GaloisConnection pt fe
 open import Locales.SIP.DistributiveLatticeSIP ua pt sr
-open import MLTT.Spartan
-open import UF.Base
-open import UF.Equiv
-open import UF.Equiv-FunExt
 open import UF.Logic
-open import UF.Powerset-MultiUniverse
-open import UF.Retracts
-open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
-open import UF.Subsingletons-Properties
-open import UF.SubtypeClassifier
 
 open AllCombinators pt fe renaming (_∧_ to _∧ₚ_)
 
diff --git a/source/Locales/DistributiveLattice/Isomorphism.lagda b/source/Locales/DistributiveLattice/Isomorphism.lagda
index 80b978df1..d1d5c7089 100644
--- a/source/Locales/DistributiveLattice/Isomorphism.lagda
+++ b/source/Locales/DistributiveLattice/Isomorphism.lagda
@@ -14,7 +14,6 @@ isomorphism.
 
 open import UF.FunExt
 open import UF.PropTrunc
-open import UF.Sets
 
 module Locales.DistributiveLattice.Isomorphism
         (fe : Fun-Ext)
@@ -33,11 +32,8 @@ open import UF.Base
 open import UF.Equiv
 open import UF.Equiv-FunExt
 open import UF.Logic
-open import UF.Powerset-MultiUniverse
-open import UF.Retracts
 open import UF.Subsingletons
 open import UF.Subsingletons-FunExt
-open import UF.Subsingletons-Properties
 open import UF.SubtypeClassifier
 
 open AllCombinators pt fe renaming (_∧_ to _∧ₚ_)
diff --git a/source/Locales/DistributiveLattice/Properties.lagda b/source/Locales/DistributiveLattice/Properties.lagda
index c023bbaa7..14ea0ced2 100644
--- a/source/Locales/DistributiveLattice/Properties.lagda
+++ b/source/Locales/DistributiveLattice/Properties.lagda
@@ -10,7 +10,6 @@ start-date:  2024-02-14
 
 open import UF.FunExt
 open import UF.PropTrunc
-open import UF.Sets
 
 module Locales.DistributiveLattice.Properties
         (fe : Fun-Ext)
@@ -18,14 +17,10 @@ module Locales.DistributiveLattice.Properties
        where
 
 open import Locales.DistributiveLattice.Definition fe pt
-open import Locales.Frame pt fe
-open import UF.Powerset-MultiUniverse
 open import MLTT.List
 open import MLTT.Spartan
-open import UF.Base
 open import UF.SubtypeClassifier
 open import UF.Logic
-open import UF.Equiv hiding (_■)
 
 open AllCombinators pt fe hiding (_∨_; _∧_)
 
diff --git a/source/Locales/DistributiveLattice/Resizing.lagda b/source/Locales/DistributiveLattice/Resizing.lagda
index 23ea17862..5c4f3a360 100644
--- a/source/Locales/DistributiveLattice/Resizing.lagda
+++ b/source/Locales/DistributiveLattice/Resizing.lagda
@@ -25,10 +25,7 @@ on `Aᶜ`.
 {-# OPTIONS --safe --without-K --lossy-unification #-}
 
 open import MLTT.Spartan
-open import Slice.Family
-open import UF.Base
 open import UF.FunExt
-open import UF.ImageAndSurjection
 open import UF.PropTrunc
 open import UF.Size
 open import UF.SubtypeClassifier
@@ -45,12 +42,11 @@ private
  fe : Fun-Ext
  fe {𝓤} {𝓥} = univalence-gives-funext' 𝓤 𝓥 (ua 𝓤) (ua (𝓤 ⊔ 𝓥))
 
-open import Locales.Compactness pt fe
+open import Locales.Compactness.Definition pt fe
 open import Locales.DistributiveLattice.Definition fe pt
 open import Locales.DistributiveLattice.Homomorphism fe pt
 open import Locales.DistributiveLattice.Isomorphism fe pt
 open import Locales.Frame pt fe
-open import Locales.SmallBasis pt fe sr
 open import UF.Equiv
 open import UF.Logic
 open import UF.Sets-Properties
diff --git a/source/Locales/DistributiveLattice/Spectrum-Properties.lagda b/source/Locales/DistributiveLattice/Spectrum-Properties.lagda
index a78c75172..2490289f8 100644
--- a/source/Locales/DistributiveLattice/Spectrum-Properties.lagda
+++ b/source/Locales/DistributiveLattice/Spectrum-Properties.lagda
@@ -24,7 +24,7 @@ module Locales.DistributiveLattice.Spectrum-Properties
         (sr : Set-Replacement pt)
        where
 
-open import Locales.Compactness pt fe
+open import Locales.Compactness.Definition pt fe
 open import Locales.DistributiveLattice.Definition fe pt
 open import Locales.DistributiveLattice.Ideal pt fe pe
 open import Locales.DistributiveLattice.Ideal-Properties pt fe pe
@@ -33,7 +33,6 @@ open import Locales.DistributiveLattice.Spectrum fe pe pt
 open import Locales.Frame pt fe
 open import Locales.SmallBasis pt fe sr
 open import Locales.Spectrality.SpectralLocale pt fe
-open import MLTT.Fin hiding (𝟎; 𝟏)
 open import MLTT.List hiding ([_])
 open import MLTT.Spartan
 open import Slice.Family
diff --git a/source/Locales/DistributiveLattice/Spectrum.lagda b/source/Locales/DistributiveLattice/Spectrum.lagda
index 64cf2e901..3e8a13f4a 100644
--- a/source/Locales/DistributiveLattice/Spectrum.lagda
+++ b/source/Locales/DistributiveLattice/Spectrum.lagda
@@ -26,7 +26,6 @@ open import Locales.DistributiveLattice.Definition fe pt
 open import Locales.DistributiveLattice.Ideal pt fe pe
 open import Locales.DistributiveLattice.Properties fe pt
 open import Locales.Frame pt fe hiding (is-directed)
-open import MLTT.Fin hiding (𝟎; 𝟏)
 open import MLTT.List hiding ([_])
 open import MLTT.Spartan
 open import Slice.Family
diff --git a/source/Locales/Frame.lagda b/source/Locales/Frame.lagda
index 76140a81f..8a271f92b 100644
--- a/source/Locales/Frame.lagda
+++ b/source/Locales/Frame.lagda
@@ -1746,7 +1746,7 @@ A _locale_ is a type that has a frame of opens.
 
 \begin{code}
 
-record Locale (𝓤 𝓥 𝓦 : Universe) : 𝓤 ⁺ ⊔ 𝓥 ⁺ ⊔ 𝓦 ⁺ ̇  where
+record Locale (𝓤 𝓥 𝓦 : Universe) : 𝓤 ⁺ ⊔ 𝓥 ⁺ ⊔ 𝓦 ⁺ ̇ where
  field
   ⟨_⟩ₗ         : 𝓤 ̇
   frame-str-of : frame-structure 𝓥 𝓦 ⟨_⟩ₗ
@@ -2036,3 +2036,56 @@ frame-structure-is-set A 𝓥 𝓦 pe {(d₁ , p₁)} {(d₂ , p₂)} =
     σ = carrier-of-[ poset-of (A , (d₁ , p₁)) ]-is-set
 
 \end{code}
+
+Added on 2024-08-18.
+
+\begin{code}
+
+open import UF.Equiv using (_≃_; logically-equivalent-props-are-equivalent)
+open import UF.Size using (_is_small)
+
+local-smallness-of-frame-gives-local-smallness-of-carrier
+ : (F : Frame 𝓤 𝓥 𝓦)
+ → (x y : ⟨ F ⟩)
+ → (x ＝ y) is 𝓥 small
+local-smallness-of-frame-gives-local-smallness-of-carrier F x y =
+ (x ≣[ poset-of F ] y) holds , e
+  where
+   open PosetNotation (poset-of F) using (_≤_)
+
+   s : (x ≣[ poset-of F ] y) holds → x ＝ y
+   s = uncurry (≤-is-antisymmetric (poset-of F))
+
+   r : x ＝ y → (x ≣[ poset-of F ] y) holds
+   r p = reflexivity+ (poset-of F) p , reflexivity+ (poset-of F) (p ⁻¹)
+
+   e : (x ≣[ poset-of F ] y) holds ≃ (x ＝ y)
+   e = logically-equivalent-props-are-equivalent
+        (holds-is-prop (x ≣[ poset-of F ] y))
+        carrier-of-[ poset-of F ]-is-set
+        s
+        r
+
+local-smallness-of-carrier-gives-local-smallness-of-frame
+ : (F : Frame 𝓤 𝓥 𝓦)
+ → (x y : ⟨ F ⟩)
+ → (x ≤[ poset-of F ] y) holds is 𝓤 small
+local-smallness-of-carrier-gives-local-smallness-of-frame F x y =
+ (x ∧[ F ] y ＝ x) , e
+  where
+   open PosetNotation (poset-of F) using (_≤_)
+
+   s : x ∧[ F ] y ＝ x → (x ≤ y) holds
+   s p = connecting-lemma₂ F (p ⁻¹)
+
+   r : (x ≤ y) holds → x ∧[ F ] y ＝ x
+   r p = connecting-lemma₁ F p ⁻¹
+
+   e : (x ∧[ F ] y ＝ x) ≃ (x ≤ y) holds
+   e = logically-equivalent-props-are-equivalent
+        carrier-of-[ poset-of F ]-is-set
+        (holds-is-prop (x ≤ y))
+        s
+        r
+
+\end{code}
diff --git a/source/Locales/GaloisConnection.lagda b/source/Locales/GaloisConnection.lagda
index b23b60d24..299bb2d34 100644
--- a/source/Locales/GaloisConnection.lagda
+++ b/source/Locales/GaloisConnection.lagda
@@ -17,7 +17,6 @@ module Locales.GaloisConnection
 open import Locales.Frame pt fe
 open import UF.Logic
 open import UF.SubtypeClassifier
-open import UF.SubtypeClassifier-Properties
 open import UF.Subsingletons
 
 open AllCombinators pt fe
diff --git a/source/Locales/HeytingComplementation.lagda b/source/Locales/HeytingComplementation.lagda
index a6945cab7..0d848d7eb 100644
--- a/source/Locales/HeytingComplementation.lagda
+++ b/source/Locales/HeytingComplementation.lagda
@@ -2,16 +2,9 @@
 
 {-# OPTIONS --safe --without-K --lossy-unification #-}
 
-open import MLTT.List hiding ([_])
 open import MLTT.Spartan hiding (𝟚)
-open import Slice.Family
-open import UF.Base
-open import UF.Embeddings
-open import UF.Equiv renaming (_■ to _𝔔𝔈𝔇)
 open import UF.FunExt
 open import UF.PropTrunc
-open import UF.PropTrunc
-open import UF.Retracts
 open import UF.Size
 open import UF.SubtypeClassifier
 
@@ -20,7 +13,6 @@ module Locales.HeytingComplementation (pt : propositional-truncations-exist)
                                       (sr : Set-Replacement pt) where
 
 open import Locales.Frame              pt fe
-open import Locales.Compactness        pt fe
 open import Locales.HeytingImplication pt fe
 open import Locales.Complements        pt fe
 open import Locales.Clopen             pt fe sr
diff --git a/source/Locales/HeytingImplication.lagda b/source/Locales/HeytingImplication.lagda
index 3ce7ed255..6679e61ba 100644
--- a/source/Locales/HeytingImplication.lagda
+++ b/source/Locales/HeytingImplication.lagda
@@ -5,7 +5,6 @@
 {-# OPTIONS --safe --without-K --lossy-unification #-}
 
 open import MLTT.Spartan
-open import UF.Base
 open import UF.PropTrunc
 open import UF.FunExt
 
@@ -18,7 +17,6 @@ open import Locales.Frame pt fe
 open import Locales.GaloisConnection pt fe
 open import UF.Logic
 open import UF.SubtypeClassifier
-open import UF.Subsingletons
 
 open AllCombinators pt fe
 open PropositionalTruncation pt
diff --git a/source/Locales/InitialFrame.lagda b/source/Locales/InitialFrame.lagda
index 8e8b06631..0a131372d 100644
--- a/source/Locales/InitialFrame.lagda
+++ b/source/Locales/InitialFrame.lagda
@@ -6,9 +6,7 @@ Based in part on `ayberkt/formal-topology-in-UF`.
 
 {-# OPTIONS --safe --without-K #-}
 
-open import MLTT.List hiding ([_])
 open import MLTT.Spartan hiding (𝟚)
-open import UF.Base
 open import UF.FunExt
 open import UF.PropTrunc
 
@@ -24,7 +22,6 @@ open import Slice.Family
 open import UF.Logic
 open import UF.Sets
 open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 open import UF.SubtypeClassifier
 
 open AllCombinators pt fe
diff --git a/source/Locales/LawsonLocale/CompactElementsOfPoint.lagda b/source/Locales/LawsonLocale/CompactElementsOfPoint.lagda
index 23371b01e..8af7a9e50 100644
--- a/source/Locales/LawsonLocale/CompactElementsOfPoint.lagda
+++ b/source/Locales/LawsonLocale/CompactElementsOfPoint.lagda
@@ -40,33 +40,23 @@ module Locales.LawsonLocale.CompactElementsOfPoint
 open import DomainTheory.BasesAndContinuity.Bases pt fe 𝓤
 open import DomainTheory.BasesAndContinuity.ScottDomain      pt fe 𝓤
 open import DomainTheory.Basics.Dcpo pt fe 𝓤 renaming (⟨_⟩ to ⟨_⟩∙)
-open import DomainTheory.Basics.Pointed pt fe 𝓤
 open import DomainTheory.Basics.WayBelow pt fe 𝓤
 open import DomainTheory.Topology.ScottTopology pt fe 𝓤
 open import DomainTheory.Topology.ScottTopologyProperties pt fe 𝓤
-open import Locales.Compactness pt fe hiding (is-compact)
 open import Locales.ContinuousMap.Definition pt fe
 open import Locales.ContinuousMap.FrameHomomorphism-Definition pt fe
 open import Locales.ContinuousMap.FrameHomomorphism-Properties pt fe
-open import Locales.DistributiveLattice.Definition fe pt
-open import Locales.DistributiveLattice.Ideal pt fe pe hiding (is-inhabited)
-open import Locales.DistributiveLattice.Properties fe pt
 open import Locales.Frame pt fe hiding (is-directed)
 open import Locales.InitialFrame pt fe
 open import Locales.ScottLocale.Definition pt fe 𝓤
 open import Locales.ScottLocale.Properties pt fe 𝓤
-open import Locales.ScottLocale.ScottLocalesOfAlgebraicDcpos pt fe 𝓤
 open import Locales.ScottLocale.ScottLocalesOfScottDomains pt fe sr 𝓤
-open import Locales.SmallBasis pt fe sr
 open import Locales.Point.Definition pt fe
 open import Locales.Point.Properties pt fe 𝓤 pe hiding (𝟏L)
-open import Locales.Spectrality.SpectralMap pt fe
 open import Locales.TerminalLocale.Properties pt fe sr
 open import Slice.Family
 open import UF.Logic
 open import UF.Powerset
-open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 open import UF.SubtypeClassifier renaming (⊥ to ⊥ₚ)
 open import UF.Univalence
 
diff --git a/source/Locales/LawsonLocale/PointsOfPatch.lagda b/source/Locales/LawsonLocale/PointsOfPatch.lagda
new file mode 100644
index 000000000..6b7d37541
--- /dev/null
+++ b/source/Locales/LawsonLocale/PointsOfPatch.lagda
@@ -0,0 +1,377 @@
+---
+title:          Equivalence of sharp elements and the points of patch
+author:         Ayberk Tosun
+date-started:   2024-08-04
+date-completed: 2024-08-13
+---
+
+Joint work with Martín Escardó.
+
+We prove that the sharp elements of a Scott domain `𝓓` are in bijection with the
+points of `Patch(Scott(𝓓))`.
+
+\begin{code}[hide]
+
+{-# OPTIONS --safe --without-K --lossy-unification #-}
+
+open import MLTT.Spartan
+open import UF.FunExt
+open import UF.PropTrunc
+open import UF.Size
+open import UF.Subsingletons
+open import UF.UA-FunExt
+open import UF.Univalence
+
+module Locales.LawsonLocale.PointsOfPatch
+        (𝓤  : Universe)
+        (ua : Univalence)
+        (pt : propositional-truncations-exist)
+        (sr : Set-Replacement pt)
+       where
+
+private
+ fe : Fun-Ext
+ fe {𝓤} {𝓥} = univalence-gives-funext' 𝓤 𝓥 (ua 𝓤) (ua (𝓤 ⊔ 𝓥))
+
+ pe : Prop-Ext
+ pe {𝓤} = univalence-gives-propext (ua 𝓤)
+
+open import DomainTheory.BasesAndContinuity.ScottDomain pt fe 𝓤
+open import DomainTheory.Basics.Dcpo pt fe 𝓤 renaming (⟨_⟩ to ⟨_⟩∙)
+open import Locales.ContinuousMap.Definition pt fe
+open import Locales.ContinuousMap.FrameHomomorphism-Properties pt fe
+open import Locales.Frame pt fe
+open import Locales.InitialFrame pt fe hiding (_⊑_)
+open import Locales.LawsonLocale.CompactElementsOfPoint 𝓤 fe pe pt sr
+open import Locales.LawsonLocale.SharpElementsCoincideWithSpectralPoints 𝓤 ua pt sr
+open import Locales.PatchLocale pt fe sr
+open import Locales.PatchProperties pt fe sr
+open import Locales.PerfectMaps pt fe
+open import Locales.Point.SpectralPoint-Definition pt fe pe
+open import Locales.ScottLocale.ScottLocalesOfScottDomains pt fe sr 𝓤
+open import Locales.SmallBasis pt fe sr
+open import Locales.Spectrality.SpectralMap pt fe
+open import Locales.Spectrality.SpectralityOfOmega pt fe sr 𝓤 pe
+open import Locales.Stone pt fe sr
+open import Locales.StoneImpliesSpectral pt fe sr
+open import Locales.TerminalLocale.Properties pt fe sr
+open import Locales.UniversalPropertyOfPatch pt fe sr
+open import Locales.ZeroDimensionality pt fe sr
+open import UF.Base
+open import UF.Equiv
+open import UF.Logic
+open import UF.SubtypeClassifier renaming (⊥ to ⊥ₚ)
+
+open AllCombinators pt fe
+open DefinitionOfScottDomain
+open Locale
+open PerfectMaps
+open PropositionalTruncation pt hiding (_∨_)
+
+\end{code}
+
+In the module below, we show that points `𝟏 → Patch(Scott(𝓓))` are in
+bijection with spectral points `𝟏 → Scott(𝓓)`. This is done by constructing
+an equivalence
+```
+Point(Patch(Scott(𝓓))) ≃ Spectral-Point(Patch(Scott(𝓓))) ≃ Spectral-Point(Scott(𝓓))
+```
+
+We then use this equivalence to show that the sharp elements of `𝓓` are in
+bijection with `Point(Patch(Scott(𝓓)))`.
+
+\begin{code}
+
+module sharp-elements-and-points-of-patch
+        (𝓓  : DCPO {𝓤 ⁺} {𝓤})
+        (hl : has-least (underlying-order 𝓓))
+        (sd : is-scott-domain 𝓓 holds)
+        (dc : decidability-condition 𝓓)
+       where
+
+ zd : zero-dimensionalᴰ {𝓤 ⁺} (𝒪 (𝟏Loc pe))
+ zd = 𝟏-zero-dimensionalᴰ pe
+
+ open SpectralScottLocaleConstruction₂ 𝓓 ua hl sd dc pe renaming (σ⦅𝓓⦆ to Scott⦅𝓓⦆)
+
+\end{code}
+
+Some more module opening bureaucracy.
+
+\begin{code}
+
+ open ClosedNucleus Scott⦅𝓓⦆ scott-locale-is-spectral
+ open ContinuousMaps
+ open Epsilon Scott⦅𝓓⦆ scott-locale-spectralᴰ
+ open Notion-Of-Spectral-Point
+ open PatchStoneᴰ Scott⦅𝓓⦆ scott-locale-spectralᴰ
+ open Preliminaries
+ open SmallPatchConstruction Scott⦅𝓓⦆ scott-locale-spectralᴰ
+ open UniversalProperty Scott⦅𝓓⦆ (𝟏Loc pe) scott-locale-spectralᴰ zd 𝟎Frm-is-compact
+
+\end{code}
+
+We define an alias for Patch(Scott(𝓓)).
+
+\begin{code}
+
+ Patch⦅Scott⦅𝓓⦆⦆ : Locale (𝓤 ⁺) 𝓤 𝓤
+ Patch⦅Scott⦅𝓓⦆⦆ = SmallPatch
+
+ Patch⦅Scott⦅𝓓⦆⦆-stoneᴰ : stoneᴰ Patch⦅Scott⦅𝓓⦆⦆
+ Patch⦅Scott⦅𝓓⦆⦆-stoneᴰ = patchₛ-is-compact , patchₛ-zero-dimensionalᴰ
+
+\end{code}
+
+We now instantiate the universal property of `Patch⦅Scott⦅𝓓⦆⦆` to points `𝟏 →
+Scott⦅𝓓⦆`.
+
+\begin{code}
+
+ patch-ump : (𝓅@(p , _) : 𝟏Loc pe ─c→ Scott⦅𝓓⦆)
+           → is-spectral-map Scott⦅𝓓⦆ (𝟏Loc pe) 𝓅 holds
+           → let
+              open ContinuousMapNotation (𝟏Loc pe) Patch⦅Scott⦅𝓓⦆⦆
+             in
+              ∃! 𝒻⁻ ꞉ 𝟏Loc pe ─c→ Patch⦅Scott⦅𝓓⦆⦆ ,
+               ((U : ⟨ 𝒪 Scott⦅𝓓⦆ ⟩) → p U  ＝ 𝒻⁻ ⋆∙ ‘ U ’ )
+ patch-ump = ump-of-patch
+              Scott⦅𝓓⦆
+              scott-locale-is-spectral
+              scott-locale-has-small-𝒦
+              (𝟏Loc pe)
+              (𝟏-is-stone pe)
+
+\end{code}
+
+This universal property immediately gives us a map from the spectral points of
+`Scott⦅𝓓⦆` into the spectral points of `Patch⦅Scott⦅𝓓⦆⦆`. We call this map
+`to-patch-point`.
+
+\begin{code}
+
+ to-patch-point : Spectral-Point Scott⦅𝓓⦆ → Spectral-Point Patch⦅Scott⦅𝓓⦆⦆
+ to-patch-point ℱ = to-spectral-point Patch⦅Scott⦅𝓓⦆⦆ (𝓅 , †)
+  where
+   open Spectral-Point ℱ renaming (point to F; point-preserves-compactness to 𝕤)
+   open continuous-maps-of-stone-locales (𝟏Loc pe) Patch⦅Scott⦅𝓓⦆⦆
+
+   𝓅 : 𝟏Loc pe ─c→ Patch⦅Scott⦅𝓓⦆⦆
+   𝓅 = ∃!-witness (patch-ump F 𝕤)
+
+   † : is-spectral-map Patch⦅Scott⦅𝓓⦆⦆ (𝟏Loc pe) 𝓅 holds
+   † = continuous-maps-between-stone-locales-are-spectral
+        (𝟏-stoneᴰ pe)
+        Patch⦅Scott⦅𝓓⦆⦆-stoneᴰ
+        𝓅
+
+\end{code}
+
+Recall that the map `ϵ` denotes the continuous map given by the frame
+homomorphism `x ↦ ‘ x ’`.
+
+\begin{code}
+
+ ϵ-is-a-spectral-map : is-spectral-map Scott⦅𝓓⦆ Patch⦅Scott⦅𝓓⦆⦆ ϵ holds
+ ϵ-is-a-spectral-map =
+  perfect-maps-are-spectral
+   Patch⦅Scott⦅𝓓⦆⦆
+   Scott⦅𝓓⦆
+   ∣ spectralᴰ-implies-basisᴰ Scott⦅𝓓⦆ scott-locale-spectralᴰ ∣
+   ϵ
+   ϵ-is-a-perfect-map
+
+\end{code}
+
+TODO: The proof above should be placed in a more appropriate place.
+
+We now define the inverse of `to-patch-point`: given a spectral point `𝟏 →
+Patch⦅Scott⦅𝓓⦆⦆`, we can compose this with `ϵ : Patch⦅Scott⦅𝓓⦆⦆ → Scott⦅𝓓⦆` to
+obtain a spectral point `𝟏 → Scott⦅𝓓⦆`. We call this map `to-scott-point`.
+
+\begin{code}
+
+ to-scott-point : Spectral-Point Patch⦅Scott⦅𝓓⦆⦆ → Spectral-Point Scott⦅𝓓⦆
+ to-scott-point 𝓅 = to-spectral-point Scott⦅𝓓⦆ (𝓅₀ , 𝕤)
+  where
+   open Spectral-Point 𝓅 renaming (point to 𝓅⋆)
+
+   𝓅₀ : 𝟏Loc pe ─c→ Scott⦅𝓓⦆
+   𝓅₀ = cont-comp (𝟏Loc pe) Patch⦅Scott⦅𝓓⦆⦆ Scott⦅𝓓⦆ ϵ 𝓅⋆
+
+   𝕤 : is-spectral-map Scott⦅𝓓⦆ (𝟏Loc pe) 𝓅₀ holds
+   𝕤 K κ = point-preserves-compactness ‘ K ’ (ϵ-is-a-spectral-map K κ)
+
+\end{code}
+
+We now proceed to show that these maps form a section-retraction pair.
+
+The fact that `to-scott-point` is a retraction of `to-patch-point` follows
+directly from the existence part of the universal property.
+
+\begin{code}
+
+ to-scott-point-cancels-to-patch-point : to-scott-point ∘ to-patch-point ∼ id
+ to-scott-point-cancels-to-patch-point 𝓅 =
+  to-spectral-point-＝ Scott⦅𝓓⦆ (to-scott-point (to-patch-point 𝓅)) 𝓅 †
+   where
+    open Spectral-Point 𝓅
+     using ()
+     renaming (point to 𝓅⋆; point-fn to p⋆; point-preserves-compactness to 𝕤)
+
+    𝓅′ : Spectral-Point Scott⦅𝓓⦆
+    𝓅′ = to-scott-point (to-patch-point 𝓅)
+
+    open Spectral-Point 𝓅′ using () renaming (point to 𝓅′⋆; point-fn to p′⋆)
+
+    ‡ : p′⋆ ∼ p⋆
+    ‡ U = pr₂ (description (patch-ump 𝓅⋆ 𝕤)) U ⁻¹
+
+    † : p′⋆ ＝ p⋆
+    † = dfunext fe ‡
+
+\end{code}
+
+The fact that it is a section follows from the uniqueness.
+
+\begin{code}
+
+ to-patch-point-cancels-to-scott-point : to-patch-point ∘ to-scott-point ∼ id
+ to-patch-point-cancels-to-scott-point 𝓅 =
+  to-spectral-point-＝' Patch⦅Scott⦅𝓓⦆⦆ 𝓅′ 𝓅 †
+   where
+    open Spectral-Point 𝓅
+     using ()
+     renaming (point to 𝓅⋆; point-fn to p⋆; point-preserves-compactness to 𝕤)
+    open ContinuousMapNotation (𝟏Loc pe) Patch⦅Scott⦅𝓓⦆⦆
+
+    𝓅′ : Spectral-Point Patch⦅Scott⦅𝓓⦆⦆
+    𝓅′ = to-patch-point (to-scott-point 𝓅)
+
+    𝓅₀ : 𝟏Loc pe ─c→ Scott⦅𝓓⦆
+    𝓅₀ = cont-comp (𝟏Loc pe) Patch⦅Scott⦅𝓓⦆⦆ Scott⦅𝓓⦆ ϵ 𝓅⋆
+
+    p₀ : ⟨ 𝒪 Scott⦅𝓓⦆ ⟩ → ⟨ 𝒪 (𝟏Loc pe) ⟩
+    p₀ = pr₁ 𝓅₀
+
+    𝕤₀ : is-spectral-map Scott⦅𝓓⦆ (𝟏Loc pe) 𝓅₀ holds
+    𝕤₀ K κ = 𝕤 ‘ K ’ (ϵ-is-a-spectral-map K κ)
+
+    open Spectral-Point 𝓅′ using () renaming (point to 𝓅′⋆; point-fn to p′⋆)
+
+    υ : ∃! 𝓅₀⁻ ꞉ 𝟏Loc pe ─c→ Patch⦅Scott⦅𝓓⦆⦆ ,
+         ((U : ⟨ 𝒪 Scott⦅𝓓⦆ ⟩) → p₀ U ＝ 𝓅₀⁻ ⋆∙ ‘ U ’)
+    υ = patch-ump 𝓅₀ 𝕤₀
+
+    r : (U : ⟨ 𝒪 Scott⦅𝓓⦆ ⟩) → p₀ U ＝ p⋆ ‘ U ’
+    r = λ _ → refl
+
+    † : 𝓅′⋆ ＝ 𝓅⋆
+    † = pr₁ (from-Σ-＝ (∃!-uniqueness υ 𝓅⋆ r))
+
+\end{code}
+
+We package these up into a proof that `to-patch-point` and `to-scott-point` form
+an equivalence.
+
+\begin{code}
+
+ to-patch-point-is-invertible : invertible to-patch-point
+ to-patch-point-is-invertible = to-scott-point , † , ‡
+  where
+   † : to-scott-point ∘ to-patch-point ∼ id
+   † = to-scott-point-cancels-to-patch-point
+
+   ‡ : to-patch-point ∘ to-scott-point ∼ id
+   ‡ = to-patch-point-cancels-to-scott-point
+
+ spectral-points-of-patch-are-equivalent-to-spectral-points-of-scott
+  : Spectral-Point Scott⦅𝓓⦆ ≃ Spectral-Point Patch⦅Scott⦅𝓓⦆⦆
+ spectral-points-of-patch-are-equivalent-to-spectral-points-of-scott =
+  to-patch-point , qinvs-are-equivs to-patch-point to-patch-point-is-invertible
+
+\end{code}
+
+We now proceed to show that `Point⦅Patch⦅Scott⦅𝓓⦆⦆⦆` is equivalent to
+`Spectral-Point⦅Patch⦅Scott⦅𝓓⦆⦆⦆`, since all points of `Patch⦅Scott⦅𝓓⦆⦆` are
+_automatically_ spectral.
+
+\begin{code}
+
+ forget-spectrality : Spectral-Point Patch⦅Scott⦅𝓓⦆⦆ → Point Patch⦅Scott⦅𝓓⦆⦆
+ forget-spectrality = Spectral-Point.point
+
+ to-spectral-point-of-patch : Point Patch⦅Scott⦅𝓓⦆⦆
+                            → Spectral-Point Patch⦅Scott⦅𝓓⦆⦆
+ to-spectral-point-of-patch 𝓅 = to-spectral-point Patch⦅Scott⦅𝓓⦆⦆ (𝓅 , 𝕤)
+  where
+   open continuous-maps-of-stone-locales (𝟏Loc pe) Patch⦅Scott⦅𝓓⦆⦆
+
+   𝕤 : is-spectral-map Patch⦅Scott⦅𝓓⦆⦆ (𝟏Loc pe) 𝓅 holds
+   𝕤 = continuous-maps-between-stone-locales-are-spectral
+        (𝟏-stoneᴰ pe)
+        Patch⦅Scott⦅𝓓⦆⦆-stoneᴰ
+        𝓅
+
+ open FrameHomomorphismProperties
+
+ forget-spectrality-is-invertible : invertible forget-spectrality
+ forget-spectrality-is-invertible = to-spectral-point-of-patch , † , ‡
+  where
+   † : to-spectral-point-of-patch ∘ forget-spectrality ∼ id
+   † 𝓅ₛ = to-spectral-point-＝ Patch⦅Scott⦅𝓓⦆⦆ 𝓅 𝓅ₛ refl
+    where
+     𝓅 : Spectral-Point Patch⦅Scott⦅𝓓⦆⦆
+     𝓅 = to-spectral-point-of-patch (forget-spectrality 𝓅ₛ)
+
+   ‡ : forget-spectrality ∘ to-spectral-point-of-patch  ∼ id
+   ‡ 𝓅 =
+    to-frame-homomorphism-＝ (𝒪 Patch⦅Scott⦅𝓓⦆⦆) (𝒪 (𝟏Loc pe)) 𝓅 𝓅′ (λ _ → refl)
+     where
+      𝓅′ : Point Patch⦅Scott⦅𝓓⦆⦆
+      𝓅′ = forget-spectrality (to-spectral-point-of-patch 𝓅)
+
+ spectral-points-of-patch-are-equivalent-to-points-of-patch
+  : Spectral-Point Patch⦅Scott⦅𝓓⦆⦆ ≃ Point Patch⦅Scott⦅𝓓⦆⦆
+ spectral-points-of-patch-are-equivalent-to-points-of-patch =
+  forget-spectrality , e
+   where
+    e : is-equiv forget-spectrality
+    e = qinvs-are-equivs forget-spectrality forget-spectrality-is-invertible
+
+\end{code}
+
+We combine these two equivalences to obtain an equivalence between the points of
+`Patch⦅Scott⦅𝓓⦆⦆` and spectral points of `Scott⦅𝓓⦆`.
+
+\begin{code}
+
+ points-of-patch-are-spectral-points-of-scott
+  : Point Patch⦅Scott⦅𝓓⦆⦆ ≃ Spectral-Point Scott⦅𝓓⦆
+ points-of-patch-are-spectral-points-of-scott =
+  Point Patch⦅Scott⦅𝓓⦆⦆              ≃⟨ Ⅰ ⟩
+  Spectral-Point Patch⦅Scott⦅𝓓⦆⦆     ≃⟨ Ⅱ ⟩
+  Spectral-Point Scott⦅𝓓⦆            ■
+   where
+    Ⅰ = ≃-sym spectral-points-of-patch-are-equivalent-to-points-of-patch
+    Ⅱ = ≃-sym spectral-points-of-patch-are-equivalent-to-spectral-points-of-scott
+
+\end{code}
+
+Finally, we combine this equivalence with the equivalence between sharp elements
+and spectral points.
+
+\begin{code}
+
+ open Sharp-Element-Spectral-Point-Equivalence 𝓓 hl sd dc
+
+ points-of-patch-are-the-sharp-elements : ♯𝓓 ≃ Point Patch⦅Scott⦅𝓓⦆⦆
+ points-of-patch-are-the-sharp-elements =
+  ♯𝓓                         ≃⟨ Ⅰ ⟩
+  Spectral-Point Scott⦅𝓓⦆    ≃⟨ Ⅱ ⟩
+  Point Patch⦅Scott⦅𝓓⦆⦆      ■
+   where
+    Ⅰ = ♯𝓓-equivalent-to-spectral-points-of-Scott⦅𝓓⦆
+    Ⅱ = ≃-sym points-of-patch-are-spectral-points-of-scott
+
+\end{code}
diff --git a/source/Locales/LawsonLocale/SharpElementsCoincideWithSpectralPoints.lagda b/source/Locales/LawsonLocale/SharpElementsCoincideWithSpectralPoints.lagda
index 85b92f64a..b3f54e6ac 100644
--- a/source/Locales/LawsonLocale/SharpElementsCoincideWithSpectralPoints.lagda
+++ b/source/Locales/LawsonLocale/SharpElementsCoincideWithSpectralPoints.lagda
@@ -40,37 +40,29 @@ private
  pe {𝓤} = univalence-gives-propext (ua 𝓤)
 
 open import DomainTheory.BasesAndContinuity.Bases pt fe 𝓤
-open import DomainTheory.BasesAndContinuity.CompactBasis pt fe 𝓤
 open import DomainTheory.BasesAndContinuity.Continuity pt fe 𝓤
 open import DomainTheory.BasesAndContinuity.ScottDomain pt fe 𝓤
 open import DomainTheory.Basics.Dcpo pt fe 𝓤 renaming (⟨_⟩ to ⟨_⟩∙)
 open import DomainTheory.Basics.WayBelow pt fe 𝓤
 open import DomainTheory.Topology.ScottTopology pt fe 𝓤
 open import DomainTheory.Topology.ScottTopologyProperties pt fe 𝓤
-open import Locales.Clopen pt fe sr
-open import Locales.CompactRegular pt fe using (clopens-are-compact-in-compact-frames)
-open import Locales.Compactness pt fe hiding (is-compact)
+open import Locales.Compactness.Definition pt fe hiding (is-compact)
 open import Locales.ContinuousMap.FrameHomomorphism-Definition pt fe
 open import Locales.ContinuousMap.FrameHomomorphism-Properties pt fe
 open import Locales.Frame pt fe
 open import Locales.InitialFrame pt fe hiding (_⊑_)
 open import Locales.LawsonLocale.CompactElementsOfPoint 𝓤 fe pe pt sr
-open import Locales.Point.Definition pt fe
 open import Locales.Point.SpectralPoint-Definition pt fe
-open import Locales.ScottLocale.Definition pt fe 𝓤
 open import Locales.ScottLocale.Properties pt fe 𝓤
-open import Locales.ScottLocale.ScottLocalesOfAlgebraicDcpos pt fe 𝓤
 open import Locales.ScottLocale.ScottLocalesOfScottDomains pt fe sr 𝓤
 open import Locales.SmallBasis pt fe sr
 open import Locales.Spectrality.SpectralMap pt fe
 open import Locales.TerminalLocale.Properties pt fe sr
 open import NotionsOfDecidability.Decidable
-open import NotionsOfDecidability.SemiDecidable fe pe pt
 open import Slice.Family
 open import UF.Equiv
 open import UF.Logic
 open import UF.Subsingletons-FunExt
-open import UF.Subsingletons-Properties
 open import UF.SubtypeClassifier renaming (⊥ to ⊥ₚ)
 
 open AllCombinators pt fe
diff --git a/source/Locales/NotationalConventions.lagda b/source/Locales/NotationalConventions.lagda
index fc7cb2c8b..e02f250d7 100644
--- a/source/Locales/NotationalConventions.lagda
+++ b/source/Locales/NotationalConventions.lagda
@@ -7,10 +7,6 @@ Ayberk Tosun, 13 September 2023
 
 open import UF.PropTrunc
 open import UF.FunExt
-open import MLTT.Spartan
-open import UF.Logic
-open import UF.SubtypeClassifier
-open import Slice.Family
 
 module Locales.NotationalConventions (pt : propositional-truncations-exist)
                                      (fe : Fun-Ext) where
diff --git a/source/Locales/Nucleus.lagda b/source/Locales/Nucleus.lagda
index 01fdba176..c3d4bd62d 100644
--- a/source/Locales/Nucleus.lagda
+++ b/source/Locales/Nucleus.lagda
@@ -7,10 +7,8 @@ Based on `ayberkt/formal-topology-in-UF`.
 {-# OPTIONS --safe --without-K #-}
 
 open import MLTT.Spartan
-open import UF.Base
 open import UF.FunExt
 open import UF.PropTrunc
-open import UF.PropTrunc
 
 module Locales.Nucleus
         (pt : propositional-truncations-exist)
@@ -22,7 +20,6 @@ open import Locales.ContinuousMap.FrameHomomorphism-Properties pt fe
 open import Locales.Frame pt fe
 open import UF.Logic
 open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 open import UF.SubtypeClassifier
 
 open AllCombinators pt fe
diff --git a/source/Locales/PatchLocale.lagda b/source/Locales/PatchLocale.lagda
index e96806048..53cb01ec8 100644
--- a/source/Locales/PatchLocale.lagda
+++ b/source/Locales/PatchLocale.lagda
@@ -29,7 +29,7 @@ module Locales.PatchLocale
         (sr : Set-Replacement pt)
        where
 
-open import Locales.Compactness pt fe
+open import Locales.Compactness.Definition pt fe
 open import Locales.ContinuousMap.FrameHomomorphism-Definition pt fe
 open import Locales.ContinuousMap.FrameHomomorphism-Properties pt fe
 open import Locales.Frame pt fe
diff --git a/source/Locales/PatchProperties.lagda b/source/Locales/PatchProperties.lagda
index 4dc247dc5..1caf19222 100644
--- a/source/Locales/PatchProperties.lagda
+++ b/source/Locales/PatchProperties.lagda
@@ -23,7 +23,7 @@ open import Locales.AdjointFunctorTheoremForFrames pt fe
 open import Locales.CharacterisationOfContinuity pt fe
 open import Locales.Clopen      pt fe sr
 open import Locales.CompactRegular pt fe using (∨-is-scott-continuous)
-open import Locales.Compactness pt fe
+open import Locales.Compactness.Definition pt fe
 open import Locales.Complements pt fe
 open import Locales.ContinuousMap.Definition pt fe
 open import Locales.ContinuousMap.FrameHomomorphism-Definition pt fe
diff --git a/source/Locales/PerfectMaps.lagda b/source/Locales/PerfectMaps.lagda
index ef2bfb7d2..990c9f861 100644
--- a/source/Locales/PerfectMaps.lagda
+++ b/source/Locales/PerfectMaps.lagda
@@ -11,13 +11,11 @@ module Locales.PerfectMaps (pt : propositional-truncations-exist)
                            (fe : Fun-Ext)                           where
 
 open import Locales.AdjointFunctorTheoremForFrames
-open import Locales.Compactness pt fe
+open import Locales.Compactness.Definition pt fe
 open import Locales.ContinuousMap.Definition pt fe
-open import Locales.ContinuousMap.FrameHomomorphism-Definition pt fe
 open import Locales.ContinuousMap.FrameHomomorphism-Properties pt fe
 open import Locales.Frame pt fe
 open import Locales.GaloisConnection pt fe
-open import Locales.InitialFrame pt fe
 open import Locales.Spectrality.Properties     pt fe
 open import Locales.Spectrality.SpectralLocale pt fe
 open import Locales.WayBelowRelation.Definition pt fe
diff --git a/source/Locales/Point/Definition.lagda b/source/Locales/Point/Definition.lagda
index 8a258b77f..dc5504e8a 100644
--- a/source/Locales/Point/Definition.lagda
+++ b/source/Locales/Point/Definition.lagda
@@ -10,10 +10,8 @@ This module contains the definition of point of a locale.
 {-# OPTIONS --safe --without-K --lossy-unification #-}
 
 open import MLTT.Spartan
-open import UF.Base
 open import UF.PropTrunc
 open import UF.FunExt
-open import UF.EquivalenceExamples
 open import UF.SubtypeClassifier
 open import UF.Logic
 open import UF.Equiv
diff --git a/source/Locales/Point/Properties.lagda b/source/Locales/Point/Properties.lagda
index cc314c22d..8df59c15a 100644
--- a/source/Locales/Point/Properties.lagda
+++ b/source/Locales/Point/Properties.lagda
@@ -11,7 +11,6 @@ completely prime filters.
 {-# OPTIONS --safe --without-K --lossy-unification #-}
 
 open import MLTT.Spartan
-open import UF.Base
 open import UF.PropTrunc
 open import UF.FunExt
 open import UF.Logic
diff --git a/source/Locales/Point/SpectralPoint-Definition.lagda b/source/Locales/Point/SpectralPoint-Definition.lagda
index 565013f17..a97b3733a 100644
--- a/source/Locales/Point/SpectralPoint-Definition.lagda
+++ b/source/Locales/Point/SpectralPoint-Definition.lagda
@@ -15,14 +15,10 @@ is equivalent to the standard definition.
 
 {-# OPTIONS --safe --without-K #-}
 
-open import MLTT.List hiding ([_])
 open import MLTT.Spartan
 open import UF.FunExt
 open import UF.PropTrunc
-open import UF.Size
 open import UF.Subsingletons
-open import UF.UA-FunExt
-open import UF.Univalence
 
 module Locales.Point.SpectralPoint-Definition
         (pt : propositional-truncations-exist)
@@ -30,7 +26,7 @@ module Locales.Point.SpectralPoint-Definition
         (pe : Prop-Ext)
        where
 
-open import Locales.Compactness pt fe
+open import Locales.Compactness.Definition pt fe
 open import Locales.ContinuousMap.Definition pt fe
 open import Locales.ContinuousMap.FrameHomomorphism-Definition pt fe
 open import Locales.Frame pt fe
@@ -154,3 +150,25 @@ underlying functions are equal. We call this lemma `to-spectral-point-＝`.
    Ⅲ = inverses-are-sections' e 𝒢 ⁻¹
 
 \end{code}
+
+Added on 2024-08-12.
+
+\begin{code}
+
+ to-spectral-point-＝' : (ℱ 𝒢 : Spectral-Point) → point ℱ ＝ point 𝒢 → ℱ ＝ 𝒢
+ to-spectral-point-＝' ℱ 𝒢 p =
+  ℱ                                           ＝⟨ Ⅰ ⟩
+  to-spectral-point (to-spectral-point₀ ℱ)    ＝⟨ Ⅱ ⟩
+  to-spectral-point (to-spectral-point₀ 𝒢)    ＝⟨ Ⅲ ⟩
+  𝒢                                           ∎
+   where
+    e = spectral-point-equivalent-to-spectral-map-into-Ω
+
+    † : to-spectral-point₀ ℱ ＝ to-spectral-point₀ 𝒢
+    † = to-subtype-＝ (holds-is-prop ∘ is-spectral-map X (𝟏Loc pe)) p
+
+    Ⅰ = inverses-are-sections' e ℱ
+    Ⅱ = ap to-spectral-point †
+    Ⅲ = inverses-are-sections' e 𝒢 ⁻¹
+
+\end{code}
diff --git a/source/Locales/Regular.lagda b/source/Locales/Regular.lagda
index 95be5b114..8748240f7 100644
--- a/source/Locales/Regular.lagda
+++ b/source/Locales/Regular.lagda
@@ -8,7 +8,6 @@ open import MLTT.Spartan hiding (𝟚)
 open import MLTT.List hiding ([_])
 open import UF.PropTrunc
 open import UF.FunExt
-open import UF.UA-FunExt
 open import UF.Size
 
 module Locales.Regular (pt : propositional-truncations-exist)
@@ -22,7 +21,6 @@ Importation of foundational UF stuff.
 \begin{code}
 
 open import Slice.Family
-open import UF.Subsingletons
 open import UF.SubtypeClassifier
 open import UF.Logic
 
@@ -35,17 +33,12 @@ Importations of other locale theory modules.
 
 \begin{code}
 
-open import Locales.Frame                         pt fe
-open import Locales.WayBelowRelation.Definition   pt fe
-open import Locales.Compactness                   pt fe
-open import Locales.Complements                   pt fe
-open import Locales.GaloisConnection              pt fe
-open import Locales.InitialFrame                  pt fe
-open import Locales.Spectrality.SpectralLocale    pt fe
-open import Locales.SmallBasis                    pt fe sr
-open import Locales.Clopen                        pt fe sr
-open import Locales.WellInside                    pt fe sr
-open import Locales.ScottContinuity               pt fe sr
+open import Locales.Clopen                      pt fe sr
+open import Locales.Compactness.Definition      pt fe
+open import Locales.Frame                       pt fe
+open import Locales.GaloisConnection            pt fe
+open import Locales.WayBelowRelation.Definition pt fe
+open import Locales.WellInside                  pt fe sr
 
 open Locale
 
diff --git a/source/Locales/SIP/DistributiveLatticeSIP.lagda b/source/Locales/SIP/DistributiveLatticeSIP.lagda
index 57e380608..5ea9735ca 100644
--- a/source/Locales/SIP/DistributiveLatticeSIP.lagda
+++ b/source/Locales/SIP/DistributiveLatticeSIP.lagda
@@ -34,13 +34,10 @@ open import Locales.DistributiveLattice.Definition-SigmaBased fe pt
 open import Locales.DistributiveLattice.Homomorphism fe pt
 open import Locales.DistributiveLattice.Isomorphism fe pt
 open import Locales.Frame pt fe
-open import Slice.Family
 open import UF.Base
 open import UF.Equiv
 open import UF.Logic
 open import UF.SIP
-open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 open import UF.SubtypeClassifier
 
 open AllCombinators pt fe
diff --git a/source/Locales/SIP/FrameSIP.lagda b/source/Locales/SIP/FrameSIP.lagda
index 938fae815..5a96f7892 100644
--- a/source/Locales/SIP/FrameSIP.lagda
+++ b/source/Locales/SIP/FrameSIP.lagda
@@ -45,8 +45,6 @@ open import UF.Base
 open import UF.Equiv
 open import UF.Logic
 open import UF.SIP
-open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 open import UF.SubtypeClassifier
 
 open AllCombinators pt fe
diff --git a/source/Locales/ScottContinuity.lagda b/source/Locales/ScottContinuity.lagda
index 5afba5321..c1c030c42 100644
--- a/source/Locales/ScottContinuity.lagda
+++ b/source/Locales/ScottContinuity.lagda
@@ -9,7 +9,6 @@ Split out from the `CompactRegular` module.
 open import MLTT.Spartan hiding (𝟚)
 open import UF.PropTrunc
 open import UF.FunExt
-open import UF.UA-FunExt
 open import UF.Size
 
 module Locales.ScottContinuity (pt : propositional-truncations-exist)
@@ -19,15 +18,12 @@ module Locales.ScottContinuity (pt : propositional-truncations-exist)
 open import Locales.Frame pt fe
 open import Slice.Family
 open import UF.SubtypeClassifier
-open import UF.Subsingletons
 
 open import UF.Logic
 
 open AllCombinators pt fe
 open PropositionalTruncation pt
-open import Locales.GaloisConnection pt fe
 
-open import Locales.InitialFrame pt fe
 
 \end{code}
 
diff --git a/source/Locales/ScottLocale/Definition.lagda b/source/Locales/ScottLocale/Definition.lagda
index 59d6b4103..804574a27 100644
--- a/source/Locales/ScottLocale/Definition.lagda
+++ b/source/Locales/ScottLocale/Definition.lagda
@@ -7,20 +7,14 @@ definition of dcpo from the `DomainTheory` development due to Tom de Jong.
 
 {-# OPTIONS --safe --without-K --lossy-unification #-}
 
-open import MLTT.List hiding ([_])
-open import MLTT.Pi
 open import MLTT.Spartan
 open import Slice.Family
-open import UF.Base
-open import UF.EquivalenceExamples
 open import UF.FunExt
 open import UF.Logic
 open import UF.PropTrunc
 open import UF.SubtypeClassifier
 open import UF.Subsingletons
 open import UF.Subsingletons-FunExt
-open import UF.UA-FunExt
-open import UF.Univalence
 
 \end{code}
 
@@ -58,7 +52,6 @@ by
 
 module DefnOfScottLocale (𝓓 : DCPO {𝓤} {𝓣}) (𝓦 : Universe) (pe : propext 𝓦) where
 
- open import DomainTheory.Lifting.LiftingSet pt fe 𝓦 pe
  open DefnOfScottTopology 𝓓 𝓦
 
 \end{code}
diff --git a/source/Locales/ScottLocale/Properties.lagda b/source/Locales/ScottLocale/Properties.lagda
index ed03b1783..973a13625 100644
--- a/source/Locales/ScottLocale/Properties.lagda
+++ b/source/Locales/ScottLocale/Properties.lagda
@@ -9,20 +9,13 @@ dates-updated: [2024-03-16]
 
 {-# OPTIONS --safe --without-K --exact-split --lossy-unification #-}
 
-open import MLTT.List hiding ([_])
-open import MLTT.Pi
 open import MLTT.Spartan
 open import Slice.Family
-open import UF.Base
-open import UF.EquivalenceExamples
 open import UF.FunExt
 open import UF.Logic
 open import UF.PropTrunc
 open import UF.SubtypeClassifier
 open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
-open import UF.UA-FunExt
-open import UF.Univalence
 
 \end{code}
 
@@ -36,15 +29,12 @@ module Locales.ScottLocale.Properties (pt : propositional-truncations-exist)
                                       (𝓤  : Universe) where
 
 open import DomainTheory.BasesAndContinuity.Bases            pt fe 𝓤
-open import DomainTheory.BasesAndContinuity.Continuity       pt fe 𝓤
 open import DomainTheory.Basics.Dcpo                         pt fe 𝓤
  renaming (⟨_⟩ to ⟨_⟩∙) hiding   (is-directed)
-open import DomainTheory.Basics.Pointed                      pt fe 𝓤
- renaming (⊥ to ⊥d)
 open import DomainTheory.Basics.WayBelow                     pt fe 𝓤
 open import DomainTheory.Topology.ScottTopology              pt fe 𝓤
 open import DomainTheory.Topology.ScottTopologyProperties    pt fe 𝓤
-open import Locales.Compactness                              pt fe
+open import Locales.Compactness.Definition                              pt fe
  hiding (is-compact)
 open import Locales.Frame                                    pt fe
 open import Locales.ScottLocale.Definition                   pt fe 𝓤
diff --git a/source/Locales/ScottLocale/ScottLocalesOfAlgebraicDcpos.lagda b/source/Locales/ScottLocale/ScottLocalesOfAlgebraicDcpos.lagda
index 50ea5155b..75c190214 100644
--- a/source/Locales/ScottLocale/ScottLocalesOfAlgebraicDcpos.lagda
+++ b/source/Locales/ScottLocale/ScottLocalesOfAlgebraicDcpos.lagda
@@ -23,8 +23,6 @@ open import UF.Logic
 open import UF.PropTrunc
 open import UF.SubtypeClassifier
 open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
-open import UF.Powerset-MultiUniverse
 
 \end{code}
 
@@ -75,7 +73,6 @@ module ScottLocaleConstruction (𝓓    : DCPO {𝓤 ⁺} {𝓤})
                                (hscb : has-specified-small-compact-basis 𝓓)
                                (pe   : propext 𝓤)                          where
 
- open import DomainTheory.Lifting.LiftingSet pt fe 𝓤 pe
  open DefnOfScottTopology 𝓓 𝓤
  open DefnOfScottLocale 𝓓 𝓤 pe using (𝒪ₛ-equality; _⊆ₛ_; ⊆ₛ-is-reflexive;
                                       ⊆ₛ-is-transitive; ⊆ₛ-is-antisymmetric;
diff --git a/source/Locales/ScottLocale/ScottLocalesOfScottDomains.lagda b/source/Locales/ScottLocale/ScottLocalesOfScottDomains.lagda
index 7c08d9c30..98cdbdb4a 100644
--- a/source/Locales/ScottLocale/ScottLocalesOfScottDomains.lagda
+++ b/source/Locales/ScottLocale/ScottLocalesOfScottDomains.lagda
@@ -15,11 +15,8 @@ satisfies a certain decidability condition).
 {-# OPTIONS --safe --without-K --exact-split --lossy-unification #-}
 
 open import MLTT.List hiding ([_])
-open import MLTT.Negation
 open import MLTT.Spartan hiding (𝟚)
 open import Slice.Family
-open import UF.Classifiers
-open import UF.Embeddings
 open import UF.EquivalenceExamples
 open import UF.FunExt
 open import UF.Logic
@@ -27,7 +24,6 @@ open import UF.Powerset-MultiUniverse
 open import UF.PropTrunc
 open import UF.Size
 open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 open import UF.SubtypeClassifier
 open import UF.Univalence
 
@@ -43,12 +39,10 @@ open import DomainTheory.BasesAndContinuity.Continuity       pt fe 𝓤
 open import DomainTheory.BasesAndContinuity.ScottDomain      pt fe 𝓤
 open import DomainTheory.Basics.Dcpo                         pt fe 𝓤
  renaming (⟨_⟩ to ⟨_⟩∙) hiding   (is-directed)
-open import DomainTheory.Basics.Pointed                      pt fe 𝓤
- renaming (⊥ to ⊥d)
 open import DomainTheory.Basics.WayBelow                     pt fe 𝓤
 open import DomainTheory.Topology.ScottTopology              pt fe 𝓤
 open import DomainTheory.Topology.ScottTopologyProperties    pt fe 𝓤
-open import Locales.Compactness                              pt fe
+open import Locales.Compactness.Definition                              pt fe
  hiding (is-compact)
 open import Locales.Frame                                    pt fe
  hiding (∅)
diff --git a/source/Locales/Sierpinski.lagda b/source/Locales/Sierpinski.lagda
index 0c0fdea61..7340affa5 100644
--- a/source/Locales/Sierpinski.lagda
+++ b/source/Locales/Sierpinski.lagda
@@ -3,7 +3,6 @@
 {-# OPTIONS --safe --without-K --lossy-unification #-}
 
 open import UF.FunExt
-open import UF.Logic
 open import MLTT.Spartan hiding (𝟚)
 open import UF.PropTrunc
 open import UF.Subsingletons
@@ -20,9 +19,7 @@ open import DomainTheory.Basics.Pointed pt fe 𝓤
 open import DomainTheory.Lifting.LiftingSet pt fe
 open import DomainTheory.Lifting.LiftingSetAlgebraic pt pe fe
 open import Locales.Frame pt fe hiding (𝟚)
-open import Slice.Family
 
-open import UF.SubtypeClassifier
 open import UF.Subsingletons-Properties
 
 \end{code}
@@ -48,7 +45,6 @@ open import Locales.ScottLocale.Definition pt fe 𝓤
 
 open DefnOfScottLocale (𝕊-dcpo ⁻) 𝓤 pe
 open Locale
-open import Lifting.Construction (𝓤 ⁺)
 
 𝕊 : Locale (𝓤 ⁺) (𝓤 ⁺) 𝓤
 𝕊 = ScottLocale
diff --git a/source/Locales/Sierpinski/Definition.lagda b/source/Locales/Sierpinski/Definition.lagda
index 2561cb5fd..b611e02af 100644
--- a/source/Locales/Sierpinski/Definition.lagda
+++ b/source/Locales/Sierpinski/Definition.lagda
@@ -15,7 +15,6 @@ In the future, other constructions of the Sierpiński locale might be added here
 {-# OPTIONS --safe --without-K --lossy-unification #-}
 
 open import UF.FunExt
-open import UF.Logic
 open import MLTT.Spartan hiding (𝟚)
 open import UF.PropTrunc
 open import UF.Subsingletons
@@ -39,18 +38,10 @@ open import DomainTheory.Lifting.LiftingSetAlgebraic pt pe fe 𝓤
 open import DomainTheory.Topology.ScottTopology pt fe 𝓤
 open import Lifting.Construction 𝓤 hiding (⊥)
 open import Lifting.Miscelanea-PropExt-FunExt 𝓤 pe fe
-open import Lifting.UnivalentPrecategory 𝓤 (𝟙 {𝓤})
 open import Locales.Frame pt fe hiding (𝟚; is-directed)
-open import Locales.InitialFrame pt fe
-open import Locales.SmallBasis pt fe sr
-open import Locales.Spectrality.SpectralLocale pt fe
-open import Locales.Spectrality.SpectralMap pt fe
-open import Locales.Stone pt fe sr
-open import Slice.Family
 open import UF.DiscreteAndSeparated
 open import UF.Equiv
 open import UF.Subsingletons-FunExt
-open import UF.Subsingletons-Properties
 open import UF.SubtypeClassifier
 
 open Locale
diff --git a/source/Locales/Sierpinski/Patch.lagda b/source/Locales/Sierpinski/Patch.lagda
index 9df8586cc..709a7a63a 100644
--- a/source/Locales/Sierpinski/Patch.lagda
+++ b/source/Locales/Sierpinski/Patch.lagda
@@ -22,34 +22,14 @@ module Locales.Sierpinski.Patch
         (sr : Set-Replacement pt)
        where
 
-open import DomainTheory.BasesAndContinuity.Bases pt fe 𝓤
-open import DomainTheory.BasesAndContinuity.Continuity pt fe 𝓤
-open import DomainTheory.Basics.Dcpo    pt fe 𝓤 renaming (⟨_⟩ to ⟨_⟩∙)
-open import DomainTheory.Basics.Miscelanea pt fe 𝓤
-open import DomainTheory.Basics.Pointed pt fe 𝓤 renaming (⊥ to ⊥∙)
-open import DomainTheory.Basics.WayBelow pt fe 𝓤
-open import DomainTheory.Lifting.LiftingSet pt fe 𝓤 pe
-open import DomainTheory.Lifting.LiftingSetAlgebraic pt pe fe 𝓤
-open import Lifting.Construction 𝓤
-open import Lifting.Miscelanea-PropExt-FunExt 𝓤 pe fe
-open import Lifting.UnivalentPrecategory 𝓤 (𝟙 {𝓤})
 open import Locales.ContinuousMap.Definition pt fe
 open import Locales.ContinuousMap.FrameHomomorphism-Definition pt fe
 open import Locales.ContinuousMap.FrameHomomorphism-Properties pt fe
 open import Locales.Frame pt fe hiding (𝟚; is-directed)
-open import Locales.InitialFrame pt fe
 open import Locales.Sierpinski.Definition 𝓤 pe pt fe sr
 open import Locales.Sierpinski.Properties 𝓤 pe pt fe sr
-open import Locales.SmallBasis pt fe sr
-open import Locales.Spectrality.SpectralLocale pt fe
 open import Locales.Spectrality.SpectralMap pt fe
 open import Locales.Stone pt fe sr
-open import Slice.Family
-open import UF.DiscreteAndSeparated
-open import UF.Equiv
-open import UF.Logic
-open import UF.Subsingletons-FunExt
-open import UF.Subsingletons-Properties
 open import UF.SubtypeClassifier
 
 open ContinuousMaps
diff --git a/source/Locales/Sierpinski/Properties.lagda b/source/Locales/Sierpinski/Properties.lagda
index a60b65eac..910200b72 100644
--- a/source/Locales/Sierpinski/Properties.lagda
+++ b/source/Locales/Sierpinski/Properties.lagda
@@ -23,18 +23,10 @@ module Locales.Sierpinski.Properties
         (sr : Set-Replacement pt)
        where
 
-open import DomainTheory.BasesAndContinuity.Bases pt fe 𝓤
-open import DomainTheory.BasesAndContinuity.Continuity pt fe 𝓤
 open import DomainTheory.Basics.Dcpo    pt fe 𝓤 renaming (⟨_⟩ to ⟨_⟩∙)
-open import DomainTheory.Basics.Miscelanea pt fe 𝓤
 open import DomainTheory.Basics.Pointed pt fe 𝓤 renaming (⊥ to ⊥∙)
-open import DomainTheory.Basics.WayBelow pt fe 𝓤
-open import DomainTheory.Lifting.LiftingSet pt fe 𝓤 pe
-open import DomainTheory.Lifting.LiftingSetAlgebraic pt pe fe 𝓤
 open import DomainTheory.Topology.ScottTopology pt fe 𝓤
 open import Lifting.Construction 𝓤
-open import Lifting.Miscelanea-PropExt-FunExt 𝓤 pe fe
-open import Lifting.UnivalentPrecategory 𝓤 (𝟙 {𝓤})
 open import Locales.Frame pt fe hiding (is-directed)
 open import Locales.InitialFrame pt fe
 open import Locales.ScottLocale.Definition pt fe 𝓤
@@ -43,14 +35,9 @@ open import Locales.ScottLocale.ScottLocalesOfAlgebraicDcpos pt fe 𝓤
 open import Locales.Sierpinski.Definition 𝓤 pe pt fe sr
 open import Locales.SmallBasis pt fe sr
 open import Locales.Spectrality.SpectralLocale pt fe
-open import Locales.Spectrality.SpectralMap pt fe
-open import Locales.Stone pt fe sr
 open import MLTT.List hiding ([_])
 open import Slice.Family
-open import UF.DiscreteAndSeparated
-open import UF.Equiv
 open import UF.Subsingletons-FunExt
-open import UF.Subsingletons-Properties
 open import UF.SubtypeClassifier
 
 open AllCombinators pt fe
@@ -163,7 +150,6 @@ principal-filter-on-₁-is-truth = ≤-is-antisymmetric (poset-of (𝒪 𝕊)) 
 𝕊-is-spectralᴰ : spectralᴰ 𝕊
 𝕊-is-spectralᴰ = σᴰ
 
-open import Locales.PatchLocale pt fe sr
 
 𝕊-is-spectral : is-spectral 𝕊 holds
 𝕊-is-spectral = spectralᴰ-gives-spectrality 𝕊 σᴰ
diff --git a/source/Locales/Sierpinski/UniversalProperty.lagda b/source/Locales/Sierpinski/UniversalProperty.lagda
index 97dd1aeff..29bfeca1a 100644
--- a/source/Locales/Sierpinski/UniversalProperty.lagda
+++ b/source/Locales/Sierpinski/UniversalProperty.lagda
@@ -32,30 +32,20 @@ module Locales.Sierpinski.UniversalProperty
         (sr : Set-Replacement pt)
        where
 
-open import DomainTheory.Basics.Dcpo pt fe 𝓤 renaming (⟨_⟩ to ⟨_⟩∙)
-open import DomainTheory.Basics.Pointed pt fe 𝓤
 open import DomainTheory.Topology.ScottTopology pt fe 𝓤
 open import DomainTheory.Topology.ScottTopologyProperties pt fe
 open import Locales.ContinuousMap.Definition pt fe
 open import Locales.ContinuousMap.FrameHomomorphism-Definition pt fe
 open import Locales.ContinuousMap.FrameHomomorphism-Properties pt fe
-open import Locales.DistributiveLattice.Definition fe pt
-open import Locales.DistributiveLattice.Ideal pt fe pe
-open import Locales.DistributiveLattice.Properties fe pt
 open import Locales.Frame pt fe hiding (is-directed)
 open import Locales.ScottLocale.Definition pt fe 𝓤
 open import Locales.ScottLocale.Properties pt fe 𝓤
 open import Locales.ScottLocale.ScottLocalesOfAlgebraicDcpos pt fe 𝓤
-open import Locales.ScottLocale.ScottLocalesOfScottDomains pt fe sr 𝓤
 open import Locales.Sierpinski.Definition 𝓤 pe pt fe sr
 open import Locales.Sierpinski.Properties 𝓤 pe pt fe sr
 open import Locales.SmallBasis pt fe sr
-open import MLTT.Fin hiding (𝟎; 𝟏)
-open import MLTT.List hiding ([_])
 open import Slice.Family
 open import UF.Logic
-open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 open import UF.SubtypeClassifier
 
 open AllCombinators pt fe renaming (_∧_ to _∧ₚ_; _∨_ to _∨ₚ_)
diff --git a/source/Locales/SmallBasis.lagda b/source/Locales/SmallBasis.lagda
index d03d4e897..ad4f3c271 100644
--- a/source/Locales/SmallBasis.lagda
+++ b/source/Locales/SmallBasis.lagda
@@ -21,7 +21,7 @@ module Locales.SmallBasis (pt : propositional-truncations-exist)
                           (sr : Set-Replacement pt) where
 
 open import Locales.Frame       pt fe hiding (has-directed-basis₀)
-open import Locales.Compactness pt fe
+open import Locales.Compactness.Definition pt fe
 open import Locales.Spectrality.SpectralLocale pt fe
 open import Slice.Family
 open import UF.SubtypeClassifier
@@ -29,8 +29,6 @@ open import UF.ImageAndSurjection pt
 open import UF.Equiv renaming (_■ to _𝒬ℰ𝒟)
 open import MLTT.List using (List; map; _<$>_; []; _∷_)
 open import UF.Univalence using (Univalence)
-open import UF.Sets using (is-set)
-open import UF.Subsingletons-FunExt
 open import Locales.Spectrality.Properties pt fe
 
 open PropositionalTruncation pt
diff --git a/source/Locales/Spectrality/BasisDirectification.lagda b/source/Locales/Spectrality/BasisDirectification.lagda
index 20de5d72b..82e55416b 100644
--- a/source/Locales/Spectrality/BasisDirectification.lagda
+++ b/source/Locales/Spectrality/BasisDirectification.lagda
@@ -4,15 +4,13 @@ Ayberk Tosun, 17 August 2023.
 
 {-# OPTIONS --safe --without-K --lossy-unification #-}
 
-open import MLTT.Spartan
-open import UF.Base
-open import UF.PropTrunc
-open import UF.FunExt
-open import UF.FunExt
 open import MLTT.List hiding ([_])
+open import MLTT.Spartan
 open import Slice.Family
-open import UF.SubtypeClassifier
+open import UF.FunExt
+open import UF.PropTrunc
 open import UF.Size
+open import UF.SubtypeClassifier
 
 module Locales.Spectrality.BasisDirectification
         (pt : propositional-truncations-exist)
@@ -20,7 +18,6 @@ module Locales.Spectrality.BasisDirectification
         (sr : Set-Replacement pt) where
 
 open import Locales.Frame pt fe
-open import Locales.Compactness pt fe
 open import Locales.SmallBasis pt fe sr
 
 open import UF.Logic
diff --git a/source/Locales/Spectrality/LatticeOfCompactOpens-Duality.lagda b/source/Locales/Spectrality/LatticeOfCompactOpens-Duality.lagda
index c0e151f7d..39b29f83a 100644
--- a/source/Locales/Spectrality/LatticeOfCompactOpens-Duality.lagda
+++ b/source/Locales/Spectrality/LatticeOfCompactOpens-Duality.lagda
@@ -45,7 +45,7 @@ private
  pe {𝓤} = univalence-gives-propext (ua 𝓤)
 
 open import Locales.AdjointFunctorTheoremForFrames pt fe
-open import Locales.Compactness pt fe
+open import Locales.Compactness.Definition pt fe
 open import Locales.ContinuousMap.Definition pt fe
 open import Locales.ContinuousMap.FrameHomomorphism-Definition pt fe
 open import Locales.ContinuousMap.FrameIsomorphism-Definition pt fe
@@ -57,17 +57,14 @@ open import Locales.DistributiveLattice.Homomorphism fe pt
 open import Locales.DistributiveLattice.Ideal pt fe pe
 open import Locales.DistributiveLattice.Ideal-Properties pt fe pe
 open import Locales.DistributiveLattice.Isomorphism fe pt
-open import Locales.DistributiveLattice.Isomorphism-Properties ua pt sr
 open import Locales.DistributiveLattice.Resizing ua pt sr
 open import Locales.DistributiveLattice.Spectrum fe pe pt
 open import Locales.DistributiveLattice.Spectrum-Properties fe pe pt sr
 open import Locales.Frame pt fe
 open import Locales.GaloisConnection pt fe
-open import Locales.SIP.DistributiveLatticeSIP ua pt sr
 open import Locales.SmallBasis pt fe sr
 open import Locales.Spectrality.LatticeOfCompactOpens ua pt sr
 open import Locales.Spectrality.SpectralLocale pt fe
-open import Locales.Spectrality.SpectralMap pt fe
 open import Slice.Family
 open import UF.Classifiers
 open import UF.Equiv hiding (_■)
diff --git a/source/Locales/Spectrality/LatticeOfCompactOpens.lagda b/source/Locales/Spectrality/LatticeOfCompactOpens.lagda
index 8786dfc2d..2cabfb07d 100644
--- a/source/Locales/Spectrality/LatticeOfCompactOpens.lagda
+++ b/source/Locales/Spectrality/LatticeOfCompactOpens.lagda
@@ -10,20 +10,11 @@ dates-updated:  [2024-04-30]
 
 {-# OPTIONS --safe --without-K --lossy-unification #-}
 
-open import MLTT.List hiding ([_])
-open import MLTT.Pi
 open import MLTT.Spartan
-open import Slice.Family
-open import UF.Base
-open import UF.EquivalenceExamples
 open import UF.FunExt
-open import UF.FunExt
-open import UF.ImageAndSurjection
 open import UF.Logic
 open import UF.PropTrunc
 open import UF.Size
-open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 open import UF.SubtypeClassifier
 open import UF.UA-FunExt
 open import UF.Univalence
@@ -38,13 +29,11 @@ private
  fe : Fun-Ext
  fe {𝓤} {𝓥} = univalence-gives-funext' 𝓤 𝓥 (ua 𝓤) (ua (𝓤 ⊔ 𝓥))
 
-open import Locales.Compactness pt fe
+open import Locales.Compactness.Definition pt fe
 open import Locales.DistributiveLattice.Definition fe pt
-open import Locales.DistributiveLattice.Homomorphism fe pt
 open import Locales.Frame pt fe
 open import Locales.SmallBasis pt fe sr
 open import Locales.Spectrality.SpectralLocale pt fe
-open import Locales.Spectrality.SpectralMap pt fe
 open import UF.Equiv
 
 open AllCombinators pt fe
diff --git a/source/Locales/Spectrality/Properties.lagda b/source/Locales/Spectrality/Properties.lagda
index 3cf87c0c7..9ad908160 100644
--- a/source/Locales/Spectrality/Properties.lagda
+++ b/source/Locales/Spectrality/Properties.lagda
@@ -5,25 +5,17 @@ Ayberk Tosun, 13 September 2023
 {-# OPTIONS --safe --without-K --lossy-unification #-}
 
 open import MLTT.Spartan
-open import UF.Base
-open import UF.PropTrunc
-open import UF.FunExt
-open import UF.Univalence
-open import UF.FunExt
-open import UF.EquivalenceExamples
-open import MLTT.List hiding ([_])
-open import MLTT.Pi
 open import Slice.Family
-open import UF.Subsingletons
-open import UF.SubtypeClassifier
-open import UF.Subsingletons-FunExt
+open import UF.FunExt
 open import UF.Logic
+open import UF.PropTrunc
+open import UF.SubtypeClassifier
 
 module Locales.Spectrality.Properties (pt : propositional-truncations-exist)
                                       (fe : Fun-Ext) where
 
 open import Locales.Frame                      pt fe
-open import Locales.Compactness                pt fe
+open import Locales.Compactness.Definition     pt fe
 open import Locales.Spectrality.SpectralLocale pt fe
 
 open PropositionalTruncation pt
diff --git a/source/Locales/Spectrality/SpectralLocale.lagda b/source/Locales/Spectrality/SpectralLocale.lagda
index 4a488a820..ae25e0fdb 100644
--- a/source/Locales/Spectrality/SpectralLocale.lagda
+++ b/source/Locales/Spectrality/SpectralLocale.lagda
@@ -10,25 +10,17 @@ will be broken down into smaller modules.
 {-# OPTIONS --safe --without-K --lossy-unification #-}
 
 open import MLTT.Spartan
-open import UF.Base
-open import UF.PropTrunc
-open import UF.FunExt
-open import UF.Univalence
-open import UF.FunExt
-open import UF.EquivalenceExamples
-open import MLTT.List hiding ([_])
-open import MLTT.Pi
 open import Slice.Family
-open import UF.Subsingletons
-open import UF.SubtypeClassifier
-open import UF.Subsingletons-FunExt
+open import UF.FunExt
 open import UF.Logic
+open import UF.PropTrunc
+open import UF.SubtypeClassifier
 
 module Locales.Spectrality.SpectralLocale (pt : propositional-truncations-exist)
                                           (fe : Fun-Ext) where
 
 open import Locales.Frame pt fe
-open import Locales.Compactness pt fe
+open import Locales.Compactness.Definition pt fe
 
 open PropositionalTruncation pt
 
diff --git a/source/Locales/Spectrality/SpectralMap.lagda b/source/Locales/Spectrality/SpectralMap.lagda
index 81f2db107..e14ae234b 100644
--- a/source/Locales/Spectrality/SpectralMap.lagda
+++ b/source/Locales/Spectrality/SpectralMap.lagda
@@ -15,15 +15,12 @@ open import UF.PropTrunc
 module Locales.Spectrality.SpectralMap (pt : propositional-truncations-exist)
                                        (fe : Fun-Ext) where
 
-open import Locales.Compactness pt fe
+open import Locales.Compactness.Definition pt fe
 open import Locales.ContinuousMap.Definition pt fe
 open import Locales.ContinuousMap.FrameHomomorphism-Definition pt fe
 open import Locales.ContinuousMap.FrameHomomorphism-Properties pt fe
 open import Locales.Frame pt fe
-open import MLTT.List hiding ([_])
 open import MLTT.Spartan
-open import Slice.Family
-open import UF.Base
 open import UF.Logic
 open import UF.SubtypeClassifier
 
diff --git a/source/Locales/Spectrality/SpectralMapToLatticeHomomorphism.lagda b/source/Locales/Spectrality/SpectralMapToLatticeHomomorphism.lagda
index 41d24a270..5b3a1f2b0 100644
--- a/source/Locales/Spectrality/SpectralMapToLatticeHomomorphism.lagda
+++ b/source/Locales/Spectrality/SpectralMapToLatticeHomomorphism.lagda
@@ -12,18 +12,11 @@ Any spectral map `f : X → Y` of spectral locales gives a lattice homomorphism
 
 {-# OPTIONS --safe --without-K --lossy-unification #-}
 
-open import MLTT.List hiding ([_])
-open import MLTT.Pi
 open import MLTT.Spartan
-open import Slice.Family
-open import UF.Base
 open import UF.FunExt
-open import UF.ImageAndSurjection
 open import UF.Logic
 open import UF.PropTrunc
 open import UF.Size
-open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 open import UF.SubtypeClassifier
 open import UF.UA-FunExt
 open import UF.Univalence
@@ -37,18 +30,16 @@ module Locales.Spectrality.SpectralMapToLatticeHomomorphism
 fe : Fun-Ext
 fe {𝓤} {𝓥} = univalence-gives-funext' 𝓤 𝓥 (ua 𝓤) (ua (𝓤 ⊔ 𝓥))
 
-open import Locales.Compactness pt fe
+open import Locales.Compactness.Definition pt fe
 open import Locales.ContinuousMap.Definition pt fe
 open import Locales.ContinuousMap.FrameHomomorphism-Definition pt fe
 open import Locales.ContinuousMap.FrameHomomorphism-Properties pt fe
-open import Locales.DistributiveLattice.Definition fe pt
 open import Locales.DistributiveLattice.Homomorphism fe pt
 open import Locales.Frame pt fe
 open import Locales.SmallBasis pt fe sr
 open import Locales.Spectrality.LatticeOfCompactOpens ua pt sr
 open import Locales.Spectrality.SpectralLocale pt fe
 open import Locales.Spectrality.SpectralMap pt fe
-open import UF.EquivalenceExamples
 
 open AllCombinators pt fe
 open ContinuousMaps
diff --git a/source/Locales/Spectrality/SpectralityOfOmega.lagda b/source/Locales/Spectrality/SpectralityOfOmega.lagda
index 97eba5076..2450ceec7 100644
--- a/source/Locales/Spectrality/SpectralityOfOmega.lagda
+++ b/source/Locales/Spectrality/SpectralityOfOmega.lagda
@@ -27,7 +27,7 @@ module Locales.Spectrality.SpectralityOfOmega
 
 open import Locales.InitialFrame pt fe
 open import Locales.Frame        pt fe
-open import Locales.Compactness  pt fe
+open import Locales.Compactness.Definition pt fe
 open import Slice.Family
 open import Locales.Spectrality.SpectralLocale pt fe
 open import Locales.Spectrality.BasisDirectification pt fe sr
@@ -110,21 +110,16 @@ and₂-lemma₃ (inr ⋆) y (z , p₁ , p₂) = p₂
        , (pr₂ (pr₁ ℬ𝟎-is-directed-basis-for-𝟎 U)
        , pr₂ ℬ𝟎-is-directed-basis-for-𝟎 U)
 
-𝟎-𝔽𝕣𝕞-is-spectral : is-spectral 𝟏-loc holds
-𝟎-𝔽𝕣𝕞-is-spectral =
- spectralᴰ-gives-spectrality
-  𝟏-loc
-  (ℬ𝟎↑ , pr₂ ℬ𝟎↑-directed-basisᴰ , ℬ𝟎↑-consists-of-compact-opens , γ)
-  where
-   κ : consists-of-compact-opens 𝟏-loc ℬ𝟎↑ holds
-   κ []       = 𝟎-is-compact 𝟏-loc
-   κ (i ∷ is) = compact-opens-are-closed-under-∨
-                 𝟏-loc
-                 (ℬ𝟎 [ i ])
-                 (ℬ𝟎↑ [ is ])
-                 (ℬ𝟎-consists-of-compact-opens i)
-                 (κ is)
+\end{code}
 
+The result below was cleaned up and refactored on 2024-08-05.
+
+\begin{code}
+
+𝟎-𝔽𝕣𝕞-spectralᴰ : spectralᴰ 𝟏-loc
+𝟎-𝔽𝕣𝕞-spectralᴰ =
+ pr₁ Σ-assoc (ℬ𝟎↑-directed-basisᴰ , ℬ𝟎↑-consists-of-compact-opens , γ)
+  where
    t : is-top (𝟎-𝔽𝕣𝕞 pe) (𝟏[ 𝟎-𝔽𝕣𝕞 pe ] ∨[ 𝟎-𝔽𝕣𝕞 pe ] 𝟎[ 𝟎-𝔽𝕣𝕞 pe ]) holds
    t = transport
         (λ - → is-top (𝟎-𝔽𝕣𝕞 pe) - holds)
@@ -142,3 +137,10 @@ and₂-lemma₃ (inr ⋆) y (z , p₁ , p₂) = p₂
    γ = ∣ (inr ⋆ ∷ []) , t ∣ , c
 
 \end{code}
+
+\begin{code}
+
+𝟎-𝔽𝕣𝕞-is-spectral : is-spectral 𝟏-loc holds
+𝟎-𝔽𝕣𝕞-is-spectral = spectralᴰ-gives-spectrality 𝟏-loc 𝟎-𝔽𝕣𝕞-spectralᴰ
+
+\end{code}
diff --git a/source/Locales/Stone.lagda b/source/Locales/Stone.lagda
index c8e2ab5ed..b6a256487 100644
--- a/source/Locales/Stone.lagda
+++ b/source/Locales/Stone.lagda
@@ -7,7 +7,6 @@ Ayberk Tosun, 11 September 2023
 open import MLTT.Spartan hiding (𝟚)
 open import UF.PropTrunc
 open import UF.FunExt
-open import UF.UA-FunExt
 open import UF.Size
 
 module Locales.Stone (pt : propositional-truncations-exist)
@@ -20,8 +19,6 @@ Importation of foundational UF stuff.
 
 \begin{code}
 
-open import Slice.Family
-open import UF.Subsingletons
 open import UF.SubtypeClassifier
 open import UF.Logic
 
@@ -34,10 +31,9 @@ Importations of other locale theory modules.
 
 \begin{code}
 
-open import Locales.AdjointFunctorTheoremForFrames
 open import Locales.Frame            pt fe
 open import Locales.WayBelowRelation.Definition pt fe
-open import Locales.Compactness      pt fe
+open import Locales.Compactness.Definition pt fe
 open import Locales.Complements      pt fe
 open import Locales.GaloisConnection pt fe
 open import Locales.InitialFrame     pt fe
diff --git a/source/Locales/StoneDuality/ForSpectralLocales.lagda b/source/Locales/StoneDuality/ForSpectralLocales.lagda
index 4fea384b1..86c9d3364 100644
--- a/source/Locales/StoneDuality/ForSpectralLocales.lagda
+++ b/source/Locales/StoneDuality/ForSpectralLocales.lagda
@@ -34,7 +34,7 @@ private
  pe : Prop-Ext
  pe {𝓤} = univalence-gives-propext (ua 𝓤)
 
-open import Locales.Compactness pt fe
+open import Locales.Compactness.Definition pt fe
 open import Locales.ContinuousMap.FrameHomomorphism-Definition pt fe
 open import Locales.ContinuousMap.FrameHomomorphism-Properties pt fe
 open import Locales.ContinuousMap.Homeomorphism-Definition pt fe
@@ -42,7 +42,6 @@ open import Locales.ContinuousMap.Homeomorphism-Properties ua pt sr
 open import Locales.DistributiveLattice.Definition fe pt
 open import Locales.DistributiveLattice.Isomorphism fe pt
 open import Locales.DistributiveLattice.Isomorphism-Properties ua pt sr
-open import Locales.DistributiveLattice.Resizing ua pt sr
 open import Locales.DistributiveLattice.Spectrum fe pe pt
 open import Locales.DistributiveLattice.Spectrum-Properties fe pe pt sr
 open import Locales.Frame pt fe
@@ -51,8 +50,6 @@ open import Locales.SIP.FrameSIP
 open import Locales.SmallBasis pt fe sr
 open import Locales.Spectrality.LatticeOfCompactOpens ua pt sr
 open import Locales.Spectrality.LatticeOfCompactOpens-Duality ua pt sr
-open import Locales.Spectrality.SpectralLocale pt fe
-open import Slice.Family
 open import UF.Equiv
 open import UF.Logic
 open import UF.SubtypeClassifier
diff --git a/source/Locales/StoneImpliesSpectral.lagda b/source/Locales/StoneImpliesSpectral.lagda
index 061292324..28f9fff46 100644
--- a/source/Locales/StoneImpliesSpectral.lagda
+++ b/source/Locales/StoneImpliesSpectral.lagda
@@ -7,7 +7,6 @@ Ayberk Tosun, 11 September 2023
 open import MLTT.Spartan hiding (𝟚)
 open import UF.PropTrunc
 open import UF.FunExt
-open import UF.UA-FunExt
 open import UF.Size
 
 module Locales.StoneImpliesSpectral (pt : propositional-truncations-exist)
@@ -21,7 +20,6 @@ Importation of foundational UF stuff.
 \begin{code}
 
 open import Slice.Family
-open import UF.Subsingletons
 open import UF.SubtypeClassifier
 open import UF.Logic
 
@@ -35,19 +33,21 @@ Importations of other locale theory modules.
 \begin{code}
 
 open import Locales.AdjointFunctorTheoremForFrames
-open import Locales.Frame            pt fe
-open import Locales.WayBelowRelation.Definition pt fe
-open import Locales.Compactness      pt fe
-open import Locales.Complements      pt fe
+open import Locales.Clopen pt fe sr
+open import Locales.Compactness.Definition pt fe
+open import Locales.Complements pt fe
+open import Locales.ContinuousMap.Definition pt fe
+open import Locales.Frame pt fe
 open import Locales.GaloisConnection pt fe
-open import Locales.InitialFrame     pt fe
+open import Locales.InitialFrame pt fe
+open import Locales.ScottContinuity pt fe sr
+open import Locales.SmallBasis pt fe sr
 open import Locales.Spectrality.SpectralLocale pt fe
+open import Locales.Spectrality.SpectralMap pt fe
+open import Locales.Stone pt fe sr
+open import Locales.WayBelowRelation.Definition pt fe
+open import Locales.WellInside pt fe sr
 open import Locales.ZeroDimensionality pt fe sr
-open import Locales.Stone              pt fe sr
-open import Locales.SmallBasis         pt fe sr
-open import Locales.Clopen             pt fe sr
-open import Locales.WellInside         pt fe sr
-open import Locales.ScottContinuity    pt fe sr
 
 open Locale
 
@@ -219,3 +219,61 @@ stone-locales-are-spectral X σ@(κ , ζ) = spectralᴰ-gives-spectrality X σ
   σᴰ = stoneᴰ-implies-spectralᴰ X σ
 
 \end{code}
+
+Added on 2024-08-11.
+
+\begin{code}
+
+stoneᴰ-locales-are-compact : (X : Locale 𝓤 𝓥 𝓦)
+                           → stoneᴰ X → is-compact X holds
+stoneᴰ-locales-are-compact X (κ , _) = κ
+
+\end{code}
+
+\begin{code}
+
+module continuous-maps-of-stone-locales
+        (X : Locale 𝓤 𝓥 𝓥)
+        (Y : Locale 𝓤 𝓥 𝓥)
+        (𝕤₁ : stoneᴰ X)
+        (𝕤₂ : stoneᴰ Y)
+       where
+
+ open ContinuousMaps
+
+ κ₁ : is-compact X holds
+ κ₁ = stoneᴰ-locales-are-compact X 𝕤₁
+
+ κ₂ : is-compact Y holds
+ κ₂ = stoneᴰ-locales-are-compact Y 𝕤₂
+
+ zd₂ : zero-dimensionalᴰ (𝒪 Y)
+ zd₂ = pr₂ 𝕤₂
+
+ continuous-maps-between-stone-locales-are-spectral
+  : (f : X ─c→ Y)
+  → is-spectral-map Y X f holds
+ continuous-maps-between-stone-locales-are-spectral 𝒻 K κ =
+  clopens-are-compact-in-compact-locales X κ₁ (𝒻 ⋆∙ K) ϑ
+   where
+    open ContinuousMapNotation X Y
+
+    ψ : is-clopen (𝒪 Y) K holds
+    ψ = compacts-are-clopen-in-zd-locales Y ∣ zd₂ ∣ K κ
+
+    K' : ⟨ 𝒪 Y ⟩
+    K' = pr₁ ψ
+
+    χ : is-boolean-complement-of (𝒪 Y) K' K holds
+    χ = pr₂ ψ
+
+    χ' : is-boolean-complement-of (𝒪 Y) K K' holds
+    χ' = complementation-is-symmetric (𝒪 Y) K' K χ
+
+    † : is-boolean-complement-of (𝒪 X) (𝒻 ⋆∙ K') (𝒻 ⋆∙ K) holds
+    † = frame-homomorphisms-preserve-complements (𝒪 Y) (𝒪 X) (_⋆ 𝒻) χ'
+
+    ϑ : is-clopen (𝒪 X) (𝒻 ⋆∙ K) holds
+    ϑ = 𝒻 ⋆∙ K' , †
+
+\end{code}
diff --git a/source/Locales/TerminalLocale/Properties.lagda b/source/Locales/TerminalLocale/Properties.lagda
index c888edbb2..88ddddb2c 100644
--- a/source/Locales/TerminalLocale/Properties.lagda
+++ b/source/Locales/TerminalLocale/Properties.lagda
@@ -20,7 +20,6 @@ Stone spaces.
 
 open import MLTT.List hiding ([_])
 open import MLTT.Spartan hiding (𝟚; ₀; ₁)
-open import UF.Base
 open import UF.FunExt
 open import UF.PropTrunc
 open import UF.Size
@@ -32,16 +31,16 @@ module Locales.TerminalLocale.Properties
        where
 
 open import Locales.Clopen pt fe sr
-open import Locales.Compactness pt fe
+open import Locales.Compactness.Definition pt fe
 open import Locales.Frame pt fe
 open import Locales.InitialFrame pt fe
-open import Locales.SmallBasis pt fe sr
 open import Locales.Spectrality.SpectralityOfOmega pt fe sr
+open import Locales.Stone pt fe sr
 open import Locales.StoneImpliesSpectral pt fe sr
+open import Locales.ZeroDimensionality pt fe sr
 open import Slice.Family
 open import UF.Equiv
 open import UF.Logic
-open import UF.Sets
 open import UF.Subsingletons
 open import UF.Subsingletons-FunExt
 open import UF.SubtypeClassifier
@@ -261,3 +260,50 @@ decidable propositions
     to-subtype-＝ (λ Q → decidability-of-prop-is-prop fe (holds-is-prop Q)) refl
 
 \end{code}
+
+Added on 2024-08-05.
+
+\begin{code}
+
+ ℬ𝟎-consists-of-clopens : consists-of-clopens (𝒪 (𝟏Loc pe)) ℬ𝟎 holds
+ ℬ𝟎-consists-of-clopens (inl ⋆) =
+  transport (λ - → is-clopen (𝒪 (𝟏Loc pe)) - holds) (p ⁻¹) †
+   where
+    p : ⊥ ＝ 𝟎[ 𝒪 (𝟏Loc pe) ]
+    p = 𝟎-is-⊥
+
+    † : is-clopen (𝒪 (𝟏Loc pe)) 𝟎[ 𝒪 (𝟏Loc pe) ] holds
+    † = 𝟎-is-clopen (𝒪 (𝟏Loc pe))
+ ℬ𝟎-consists-of-clopens (inr ⋆) =
+  𝟏-is-clopen (𝒪 (𝟏Loc pe))
+
+ ℬ𝟎↑-consists-of-clopens : consists-of-clopens (𝒪 (𝟏Loc pe)) ℬ𝟎↑ holds
+ ℬ𝟎↑-consists-of-clopens []       = 𝟎-is-clopen (𝒪 (𝟏Loc pe))
+ ℬ𝟎↑-consists-of-clopens (i ∷ is) =
+  clopens-are-closed-under-∨ (𝒪 (𝟏Loc pe)) (ℬ𝟎 [ i ]) (ℬ𝟎↑ [ is ]) † ‡
+   where
+    † : is-clopen (𝒪 (𝟏Loc pe)) (ℬ𝟎 [ i ]) holds
+    † = ℬ𝟎-consists-of-clopens i
+
+    ‡ : is-clopen (𝒪 (𝟏Loc pe)) (ℬ𝟎↑ [ is ]) holds
+    ‡ = ℬ𝟎↑-consists-of-clopens is
+
+ 𝟏-zero-dimensionalᴰ : zero-dimensionalᴰ (𝒪 (𝟏Loc pe))
+ 𝟏-zero-dimensionalᴰ = ℬ𝟎↑
+                     , pr₂ (ℬ𝟎↑-directed-basisᴰ 𝓤 pe)
+                     , ℬ𝟎↑-consists-of-clopens
+
+\end{code}
+
+Added on 2024-08-10.
+
+\begin{code}
+
+ 𝟏-stoneᴰ : stoneᴰ (𝟏Loc pe)
+ 𝟏-stoneᴰ = 𝟎Frm-is-compact 𝓤 pe , 𝟏-zero-dimensionalᴰ
+
+ 𝟏-is-stone : is-stone (𝟏Loc pe) holds
+ 𝟏-is-stone = 𝟎Frm-is-compact 𝓤 pe
+            , ∣ 𝟏-zero-dimensionalᴰ ∣
+
+\end{code}
diff --git a/source/Locales/ThesisIndex.lagda b/source/Locales/ThesisIndex.lagda
new file mode 100644
index 000000000..a06932648
--- /dev/null
+++ b/source/Locales/ThesisIndex.lagda
@@ -0,0 +1,70 @@
+---
+title:          Thesis Index
+author:         Ayberk Tosun
+date-started:   2024-09-19
+---
+
+\begin{code}
+
+{-# OPTIONS --safe --without-K #-}
+
+open import MLTT.Spartan
+open import UF.Base
+open import UF.FunExt
+open import UF.PropTrunc
+open import UF.Sets
+open import UF.Size
+open import UF.SubtypeClassifier
+
+module Locales.ThesisIndex
+        (pt : propositional-truncations-exist)
+        (fe : Fun-Ext)
+       where
+
+open import Locales.Frame pt fe
+open import OrderedTypes.SupLattice pt fe
+open import Locales.ContinuousMap.FrameHomomorphism-Definition pt fe
+
+\end{code}
+
+\section{Basics of pointfree topology}
+
+\begin{code}
+
+definition∶frame : (𝓤 𝓥 𝓦 : Universe) → (𝓤 ⊔ 𝓥 ⊔ 𝓦) ⁺  ̇
+definition∶frame = Frame
+
+lemma∶partial-order-gives-sethood : (X : 𝓤  ̇)
+                                  → (_≤_ : X → X → Ω 𝓥)
+                                  → is-partial-order X _≤_
+                                  → is-set X
+lemma∶partial-order-gives-sethood {𝓤} {𝓥} X _≤_ ϑ =
+ carrier-of-[ P ]-is-set
+  where
+   P : Poset 𝓤 𝓥
+   P = X , _≤_ , ϑ
+
+\end{code}
+
+\subsection{Primer on predicative lattice theory}
+
+\begin{code}
+
+sup-complete : (𝓤 𝓣 𝓥 : Universe) {A : 𝓤 ̇}
+             → sup-lattice-data 𝓤 𝓣 𝓥 A → 𝓤 ⊔ 𝓣 ⊔ 𝓥 ⁺ ̇
+sup-complete = is-sup-lattice
+
+\end{code}
+
+\subsection{Categories of frames and locales}
+
+Given frames `K` and `L`, the type of frame homomorphisms from `K` into `L` is
+denoted `K ─f→ L`.
+
+\begin{code}
+
+definition∶frame-homomorphism : Frame 𝓤 𝓥 𝓦 → Frame 𝓤' 𝓥' 𝓦 → 𝓤 ⊔ 𝓦 ⁺ ⊔ 𝓤' ⊔ 𝓥'  ̇
+definition∶frame-homomorphism =
+ FrameHomomorphisms._─f→_
+
+\end{code}
diff --git a/source/Locales/UniversalPropertyOfPatch.lagda b/source/Locales/UniversalPropertyOfPatch.lagda
index a8fb3ece1..53f6b0c0a 100644
--- a/source/Locales/UniversalPropertyOfPatch.lagda
+++ b/source/Locales/UniversalPropertyOfPatch.lagda
@@ -29,7 +29,7 @@ module Locales.UniversalPropertyOfPatch
 
 open import Locales.AdjointFunctorTheoremForFrames pt fe
 open import Locales.Clopen                     pt fe sr
-open import Locales.Compactness                pt fe
+open import Locales.Compactness.Definition                pt fe
 open import Locales.Complements                pt fe
 open import Locales.ContinuousMap.Definition pt fe
 open import Locales.ContinuousMap.FrameHomomorphism-Definition pt fe
diff --git a/source/Locales/WayBelowRelation/Properties.lagda b/source/Locales/WayBelowRelation/Properties.lagda
index 3b805a924..a5bb18e31 100644
--- a/source/Locales/WayBelowRelation/Properties.lagda
+++ b/source/Locales/WayBelowRelation/Properties.lagda
@@ -1,4 +1,9 @@
-Ayberk Tosun, 19 August 2023
+---
+title:         Properties of the way-below relation
+author:        Ayberk Tosun
+date-started:  2023-08-19
+dates-updated: [2024-09-12]
+---
 
 The module contains properties of the way below relation defined in
 `Locales.WayBelowRelation.Definition`.
@@ -28,7 +33,7 @@ open Locale
 
 \end{code}
 
-`𝟎` is way below anything.
+The bottom open `𝟎` is way below anything.
 
 \begin{code}
 
@@ -40,3 +45,94 @@ open Locale
   † i = ∣ i , 𝟎-is-bottom (𝒪 X) (S [ i ]) ∣
 
 \end{code}
+
+Added on 2024-09-12.
+
+\begin{code}
+
+way-below-implies-below : (X : Locale 𝓤 𝓥 𝓦)
+                        → {U V : ⟨ 𝒪 X ⟩}
+                        → (U ≪[ 𝒪 X ] V ⇒ U ≤[ poset-of (𝒪 X) ] V) holds
+way-below-implies-below {𝓤} {𝓥} {𝓦} X {U} {V} φ =
+ ∥∥-rec (holds-is-prop (U ≤[ Xₚ ] V)) † (φ S δ p)
+  where
+   S : Fam 𝓦 ⟨ 𝒪 X ⟩
+   S = 𝟙 , λ { ⋆ → V }
+
+   Xₚ = poset-of (𝒪 X)
+
+   γ : (i j : index S)
+     → ∃ k ꞉ index S , (S [ i ] ≤[ Xₚ ] S [ k ]) holds
+                     × (S [ j ] ≤[ Xₚ ] S [ k ]) holds
+   γ ⋆ ⋆ = ∣ ⋆ , ≤-is-reflexive Xₚ V , ≤-is-reflexive Xₚ V ∣
+
+   δ : is-directed (𝒪 X) S holds
+   δ = ∣ ⋆ ∣ , γ
+
+   p : (V ≤[ Xₚ ] (⋁[ 𝒪 X ] S)) holds
+   p = ⋁[ 𝒪 X ]-upper S ⋆
+
+   † : (Σ _ ꞉ 𝟙 , (U ≤[ Xₚ ] V) holds) → (U ≤[ Xₚ ] V) holds
+   † (⋆ , p) = p
+
+\end{code}
+
+Added on 2024-09-12.
+
+\begin{code}
+
+↑↑-is-upward-closed
+ : (X : Locale 𝓤 𝓥 𝓦)
+ → {U V W : ⟨ 𝒪 X ⟩}
+ → (U ≪[ 𝒪 X ] V ⇒ V ≤[ poset-of (𝒪 X) ] W ⇒ U ≪[ 𝒪 X ] W) holds
+↑↑-is-upward-closed X {U} {V} {W} φ q = †
+ where
+  open PosetReasoning (poset-of (𝒪 X))
+
+  † : (U ≪[ 𝒪 X ] W) holds
+  † S δ r = φ S δ p
+   where
+    p : (V ≤[ poset-of (𝒪 X) ] (⋁[ 𝒪 X ] S)) holds
+    p = V ≤⟨ q ⟩ W ≤⟨ r ⟩ ⋁[ 𝒪 X ] S ■
+
+\end{code}
+
+Added on 2024-09-12.
+
+\begin{code}
+
+being-way-below-is-closed-under-binary-joins
+ : (X : Locale 𝓤 𝓥 𝓦)
+ → {U V W : ⟨ 𝒪 X ⟩}
+ → (V ≪[ 𝒪 X ] U ⇒ W ≪[ 𝒪 X ] U ⇒ (V ∨[ 𝒪 X ] W) ≪[ 𝒪 X ] U) holds
+being-way-below-is-closed-under-binary-joins X {U} {V} {W} p q S δ@(_ , υ) r =
+ ∥∥-rec₂ ∃-is-prop γ (p S δ r) (q S δ r)
+  where
+   open PosetReasoning (poset-of (𝒪 X))
+
+   † : (V ≤[ poset-of (𝒪 X) ] (⋁[ 𝒪 X ] S)) holds
+   † = way-below-implies-below X (↑↑-is-upward-closed X p r)
+
+   ‡ : (W ≤[ poset-of (𝒪 X) ] (⋁[ 𝒪 X ] S)) holds
+   ‡ = way-below-implies-below X (↑↑-is-upward-closed X q r)
+
+   Xₚ = poset-of (𝒪 X)
+
+   γ : Σ i ꞉ index S , (V ≤[ Xₚ ] S [ i ]) holds
+     → Σ i ꞉ index S , (W ≤[ Xₚ ] S [ i ]) holds
+     → ∃ k ꞉ index S , ((V ∨[ 𝒪 X ] W) ≤[ Xₚ ] S [ k ]) holds
+   γ (i , p) (j , q) = ∥∥-rec ∃-is-prop ε (υ i j)
+    where
+     ε : Σ k ꞉ index S ,
+          (S [ i ] ≤[ Xₚ ] S [ k ] ∧ S [ j ] ≤[ Xₚ ] S [ k ]) holds
+       → ∃ k ꞉ index S ,
+          ((V ∨[ 𝒪 X ] W) ≤[ Xₚ ] S [ k ]) holds
+     ε (k , r , s) = ∣ k , ∨[ 𝒪 X ]-least φ ψ ∣
+      where
+       φ : (V ≤[ poset-of (𝒪 X) ] (S [ k ])) holds
+       φ = V ≤⟨ p ⟩ S [ i ] ≤⟨ r ⟩ S [ k ] ■
+
+       ψ : (W ≤[ poset-of (𝒪 X) ] (S [ k ])) holds
+       ψ = W ≤⟨ q ⟩ S [ j ] ≤⟨ s ⟩ S [ k ] ■
+
+\end{code}
diff --git a/source/Locales/WellInside.lagda b/source/Locales/WellInside.lagda
index 6c5b315be..820b5360f 100644
--- a/source/Locales/WellInside.lagda
+++ b/source/Locales/WellInside.lagda
@@ -9,7 +9,6 @@ Split out from the now-deprecated `CompactRegular` module.
 open import MLTT.Spartan hiding (𝟚)
 open import UF.PropTrunc
 open import UF.FunExt
-open import UF.UA-FunExt
 open import UF.Size
 
 module Locales.WellInside (pt : propositional-truncations-exist)
@@ -22,13 +21,10 @@ Importation of foundational UF stuff.
 
 \begin{code}
 
-open import Slice.Family
-open import UF.Subsingletons
 open import UF.SubtypeClassifier
 open import UF.Logic
 
 open import Locales.Frame       pt fe
-open import Locales.Complements pt fe
 
 open AllCombinators pt fe
 open PropositionalTruncation pt
diff --git a/source/Locales/ZeroDimensionality.lagda b/source/Locales/ZeroDimensionality.lagda
index a00eb759f..49b4e33c9 100644
--- a/source/Locales/ZeroDimensionality.lagda
+++ b/source/Locales/ZeroDimensionality.lagda
@@ -7,7 +7,6 @@ Ayberk Tosun, 11 September 2023
 open import MLTT.Spartan hiding (𝟚)
 open import UF.PropTrunc
 open import UF.FunExt
-open import UF.UA-FunExt
 open import UF.Size
 
 module Locales.ZeroDimensionality (pt : propositional-truncations-exist)
@@ -21,7 +20,6 @@ Importation of foundational UF stuff.
 \begin{code}
 
 open import Slice.Family
-open import UF.Subsingletons
 open import UF.SubtypeClassifier
 open import UF.Logic
 
@@ -34,11 +32,10 @@ Importations of other locale theory modules.
 
 \begin{code}
 
-open import Locales.AdjointFunctorTheoremForFrames
 
 open import Locales.Frame            pt fe           hiding (is-directed-basis)
 open import Locales.WayBelowRelation.Definition pt fe
-open import Locales.Compactness      pt fe
+open import Locales.Compactness.Definition pt fe
 open import Locales.Complements      pt fe
 open import Locales.GaloisConnection pt fe
 open import Locales.InitialFrame     pt fe
diff --git a/source/Locales/index.lagda b/source/Locales/index.lagda
index ddf996d4a..9ab91b218 100644
--- a/source/Locales/index.lagda
+++ b/source/Locales/index.lagda
@@ -6,6 +6,76 @@ Ayberk Tosun.
 
 module Locales.index where
 
+\end{code}
+
+There is a separate index file for the thesis:
+
+\begin{code}
+
+import Locales.ThesisIndex
+
+\end{code}
+
+\section{Basics}
+
+Basics of frames and quite a bit of order theory.
+
+\begin{code}
+
+import Locales.Frame
+
+\end{code}
+
+The `ContinuousMap` subdirectory contains:
+
+  1. Definition of the notion of frame homomorphism.
+  2. Properties of frame homomorphisms.
+  3. Definition of continuous maps of locales
+  4. Properties of continuous maps.
+  5. Definition of locale homeomorphisms.
+  6. Properties of homeomorphisms, including the characterization of the
+     identity type for locales.
+
+\begin{code}
+
+import Locales.ContinuousMap.FrameHomomorphism-Definition -- (1)
+import Locales.ContinuousMap.FrameHomomorphism-Properties -- (2)
+import Locales.ContinuousMap.Definition                   -- (3)
+import Locales.ContinuousMap.Properties                   -- (4)
+import Locales.ContinuousMap.Homeomorphism-Definition     -- (5)
+import Locales.ContinuousMap.Homeomorphism-Properties     -- (6)
+
+\end{code}
+
+Compact opens.
+
+\begin{code}
+
+import Locales.Compactness.Definition
+import Locales.Compactness.Properties
+
+\end{code}
+
+\section{The discrete locale}
+
+The `DiscreteLocale` directory contains
+
+  1. Definition of the discrete locale over a set.
+  2. Construction of a directed basis for the discrete locale.
+  3. The discrete locale on the type of Booleans.
+  4. Properties of the discrete locale on the type of Booleans.
+
+\begin{code}
+
+import Locales.DiscreteLocale.Basis
+import Locales.DiscreteLocale.Definition
+import Locales.DiscreteLocale.Two
+import Locales.DiscreteLocale.Two-Properties
+
+\end{code}
+
+\begin{code}
+
 import Locales.AdjointFunctorTheoremForFrames    -- (1)
 import Locales.Adjunctions.Properties
 import Locales.Adjunctions.Properties-DistributiveLattice
@@ -22,7 +92,7 @@ import Locales.Clopen                            -- (5)
 import Locales.CompactRegular                    -- (6)
 -- ↑ DEPRECATED DO NOT USE ↑ --
 
-import Locales.Compactness                       -- (7)
+import Locales.Compactness.Definition            -- (7)
 
 import Locales.Complements                       -- (8)
 
@@ -38,7 +108,6 @@ import Locales.DistributiveLattice.Resizing
 import Locales.DistributiveLattice.Spectrum
 import Locales.DistributiveLattice.Spectrum-Properties
 
-import Locales.Frame                             -- (9)
 
 import Locales.GaloisConnection                  -- (10)
 
@@ -111,18 +180,6 @@ import Locales.Point.SpectralPoint-Definition
 
 import Locales.TerminalLocale.Properties
 
-import Locales.DiscreteLocale.Definition
-
-import Locales.DiscreteLocale.Two
-import Locales.DiscreteLocale.Two-Properties
-
-import Locales.ContinuousMap.FrameHomomorphism-Definition
-import Locales.ContinuousMap.FrameHomomorphism-Properties
-import Locales.ContinuousMap.Definition
-import Locales.ContinuousMap.Properties
-import Locales.ContinuousMap.Homeomorphism-Definition
-import Locales.ContinuousMap.Homeomorphism-Properties
-
 import Locales.SIP.FrameSIP
 import Locales.SIP.DistributiveLatticeSIP
 
@@ -132,5 +189,6 @@ import Locales.StoneDuality.ForSpectralLocales
 
 import Locales.LawsonLocale.CompactElementsOfPoint
 import Locales.LawsonLocale.SharpElementsCoincideWithSpectralPoints
+import Locales.LawsonLocale.PointsOfPatch
 
 \end{code}
diff --git a/source/MGS/Universe-Lifting.lagda b/source/MGS/Universe-Lifting.lagda
index 932017e53..38317f11a 100644
--- a/source/MGS/Universe-Lifting.lagda
+++ b/source/MGS/Universe-Lifting.lagda
@@ -14,7 +14,7 @@ module MGS.Universe-Lifting where
 open import MGS.Equivalence-Constructions
 open import MGS.Embeddings public
 
-record Lift {𝓤 : Universe} (𝓥 : Universe) (X : 𝓤 ̇ ) : 𝓤 ⊔ 𝓥 ̇  where
+record Lift {𝓤 : Universe} (𝓥 : Universe) (X : 𝓤 ̇ ) : 𝓤 ⊔ 𝓥 ̇ where
  constructor
   lift
  field
diff --git a/source/MLTT/Bool.lagda b/source/MLTT/Bool.lagda
index f1a174b9e..c182d1407 100644
--- a/source/MLTT/Bool.lagda
+++ b/source/MLTT/Bool.lagda
@@ -64,7 +64,7 @@ true-right-||-absorptive false = refl
 infixl 10 _||_
 infixl 20 _&&_
 
-record Eq {𝓤} (X : 𝓤 ̇ ) : 𝓤 ̇  where
+record Eq {𝓤} (X : 𝓤 ̇ ) : 𝓤 ̇ where
   field
     _==_    : X → X → Bool
     ==-refl : (x : X) → (x == x) ＝ true
diff --git a/source/MLTT/Fin.lagda b/source/MLTT/Fin.lagda
index 57b814c23..377e79fec 100644
--- a/source/MLTT/Fin.lagda
+++ b/source/MLTT/Fin.lagda
@@ -7,10 +7,9 @@ module MLTT.Fin where
 open import MLTT.Spartan
 open import MLTT.List
 open import MLTT.Bool
-open import Naturals.Properties
 
 
-data Fin : ℕ → 𝓤₀ ̇  where
+data Fin : ℕ → 𝓤₀ ̇ where
  𝟎   : {n : ℕ} → Fin (succ n)
  suc : {n : ℕ} → Fin n → Fin (succ n)
 
diff --git a/source/MLTT/List-Properties.lagda b/source/MLTT/List-Properties.lagda
new file mode 100644
index 000000000..652fc7eaa
--- /dev/null
+++ b/source/MLTT/List-Properties.lagda
@@ -0,0 +1,68 @@
+Created by Ayberk Tosun, August 2024.
+
+In this module, we collect properties of lists.
+
+\begin{code}
+
+{-# OPTIONS --safe --without-K --no-exact-split #-}
+
+module MLTT.List-Properties where
+
+open import Fin.Type
+open import MLTT.Bool
+open import MLTT.List
+open import MLTT.Spartan
+open import Naturals.Order hiding (minus)
+open import Naturals.Properties
+open import Notation.Order
+open import UF.Base
+open import UF.PropTrunc
+open import UF.Subsingletons
+
+\end{code}
+
+The empty list has no members.
+
+\begin{code}
+
+not-in-empty-list : {A : 𝓤  ̇} {x : A} → ¬ member x []
+not-in-empty-list ()
+
+\end{code}
+
+We define the list indexing function `nth` below and prove that it is a
+surjection.
+
+\begin{code}
+
+module list-indexing (pt : propositional-truncations-exist) {X : 𝓤  ̇} where
+
+ open PropositionalTruncation pt
+ open import UF.ImageAndSurjection pt
+
+ nth : (xs : List X) → Fin (length xs) → Σ x ꞉ X , ∥ member x xs ∥
+ nth (x ∷ _)  (inr ⋆) = x , ∣ in-head ∣
+ nth (_ ∷ xs) (inl n) = x , ∥∥-functor in-tail (pr₂ IH)
+  where
+   IH : Σ x ꞉ X , ∥ member x xs ∥
+   IH = nth xs n
+
+   x : X
+   x = pr₁ IH
+
+ nth-is-surjection : (xs : List X) → is-surjection (nth xs)
+ nth-is-surjection []       (y , μ) = ∥∥-rec ∃-is-prop (λ ()) μ
+ nth-is-surjection (x ∷ xs) (y , μ) = ∥∥-rec ∃-is-prop † μ
+  where
+   † : member y (x ∷ xs) → ∃ i ꞉ Fin (length (x ∷ xs)) , (nth (x ∷ xs) i ＝ y , μ)
+   † in-head     = ∣ inr ⋆ , to-subtype-＝ (λ _ → ∥∥-is-prop) refl ∣
+   † (in-tail p) = ∥∥-rec ∃-is-prop ‡ IH
+    where
+     IH : (y , ∣ p ∣) ∈image nth xs
+     IH = nth-is-surjection xs (y , ∣ p ∣)
+
+     ‡ : Σ i ꞉ Fin (length xs) , (nth xs i ＝ y , ∣ p ∣)
+       → ∃ i ꞉ Fin (length (x ∷ xs)) , (nth (x ∷ xs) i ＝ y , μ)
+     ‡ (i , q) = ∣ inl i , to-subtype-＝ (λ _ → ∥∥-is-prop) (pr₁ (from-Σ-＝ q)) ∣
+
+\end{code}
diff --git a/source/MLTT/List.lagda b/source/MLTT/List.lagda
index a7c957c36..16242401f 100644
--- a/source/MLTT/List.lagda
+++ b/source/MLTT/List.lagda
@@ -16,7 +16,7 @@ open import Naturals.Properties
 open import Naturals.Order hiding (minus)
 open import Notation.Order
 
-data List {𝓤} (X : 𝓤 ̇ ) : 𝓤 ̇  where
+data List {𝓤} (X : 𝓤 ̇ ) : 𝓤 ̇ where
  [] : List X
  _∷_ : X → List X → List X
 
@@ -108,7 +108,7 @@ empty : {X : 𝓤 ̇ } → List X → Bool
 empty []       = true
 empty (x ∷ xs) = false
 
-data member {X : 𝓤 ̇ } : X → List X → 𝓤 ̇  where
+data member {X : 𝓤 ̇ } : X → List X → 𝓤 ̇ where
  in-head : {x : X}   {xs : List X} → member x (x ∷ xs)
  in-tail : {x y : X} {xs : List X} → member x xs → member x (y ∷ xs)
 
@@ -120,7 +120,7 @@ member-map f x' (_ ∷ xs) (in-tail m) = in-tail (member-map f x' xs m)
 
 member' : {X : 𝓤 ̇ } → X → List X → 𝓤 ̇
 member' y []       = 𝟘
-member' y (x ∷ xs) = (x ＝ y) + member y xs
+member' y (x ∷ xs) = (x ＝ y) + member' y xs
 
 \end{code}
 
@@ -131,12 +131,12 @@ member'-map : {X : 𝓤 ̇ } {Y : 𝓥 ̇ } (f : X → Y) (x : X) (xs : List X)
             → member' x xs
             → member' (f x) (map f xs)
 member'-map f x' (x ∷ xs) (inl p) = inl (ap f p)
-member'-map f x' (x ∷ xs) (inr m) = inr (member-map f x' xs m)
+member'-map f x' (x ∷ xs) (inr m) = inr (member'-map f x' xs m)
 
-listed : 𝓤 ̇  → 𝓤 ̇
+listed : 𝓤 ̇ → 𝓤 ̇
 listed X = Σ xs ꞉ List X , ((x : X) → member x xs)
 
-listed⁺ : 𝓤 ̇  → 𝓤 ̇
+listed⁺ : 𝓤 ̇ → 𝓤 ̇
 listed⁺ X = X × listed X
 
 type-from-list : {X : 𝓤  ̇} → List X → 𝓤  ̇
@@ -400,29 +400,31 @@ concat-++ (xs ∷ xss) yss =
 
 \end{code}
 
-The following are the Kleisli extension operation for the list monad and its associativity law.
+The following are the Kleisli extension operations for the list monad
+and its associativity law.
 
 \begin{code}
 
-ext : {X : 𝓤 ̇ } {Y : 𝓥 ̇ }
-    → (X → List Y) → (List X → List Y)
-ext f xs = concat (map f xs)
-
-ext-assoc : {X : 𝓤 ̇ } {Y : 𝓥 ̇ } {Z : 𝓦 ̇ }
-            (g : Y → List Z) (f : X → List Y)
-            (xs : List X)
-          → ext (λ x → ext g (f x)) xs ＝ ext g (ext f xs)
-ext-assoc g f []       = refl
-ext-assoc g f (x ∷ xs) =
- ext (λ - → ext g (f -)) (x ∷ xs)          ＝⟨ refl ⟩
- ext g (f x) ++ ext (λ - → ext g (f -)) xs ＝⟨ I ⟩
- ext g (f x) ++ ext g (ext f xs)           ＝⟨ II ⟩
- concat (map g (f x) ++ map g (ext f xs))  ＝⟨ III ⟩
- ext g (f x ++ ext f xs)                   ＝⟨ refl ⟩
- ext g (ext f (x ∷ xs))                    ∎
+List-ext : {X : 𝓤 ̇ } {Y : 𝓥 ̇ }
+         → (X → List Y) → (List X → List Y)
+List-ext f xs = concat (map f xs)
+
+List-ext-assoc
+ : {X : 𝓤 ̇ } {Y : 𝓥 ̇ } {Z : 𝓦 ̇ }
+   (g : Y → List Z) (f : X → List Y)
+   (xs : List X)
+ → List-ext (λ x → List-ext g (f x)) xs ＝ List-ext g (List-ext f xs)
+List-ext-assoc g f []       = refl
+List-ext-assoc g f (x ∷ xs) =
+ List-ext (λ - → List-ext g (f -)) (x ∷ xs)               ＝⟨ refl ⟩
+ List-ext g (f x) ++ List-ext (λ - → List-ext g (f -)) xs ＝⟨ I ⟩
+ List-ext g (f x) ++ List-ext g (List-ext f xs)           ＝⟨ II ⟩
+ concat (map g (f x) ++ map g (List-ext f xs))            ＝⟨ III ⟩
+ List-ext g (f x ++ List-ext f xs)                        ＝⟨ refl ⟩
+ List-ext g (List-ext f (x ∷ xs))                         ∎
   where
-   I   = ap (ext g (f x) ++_) (ext-assoc g f xs)
-   II  = (concat-++ (map g (f x)) (map g (ext f xs)))⁻¹
-   III = (ap concat (map-++ g (f x) (ext f xs)))⁻¹
+   I   = ap (List-ext g (f x) ++_) (List-ext-assoc g f xs)
+   II  = (concat-++ (map g (f x)) (map g (List-ext f xs)))⁻¹
+   III = (ap concat (map-++ g (f x) (List-ext f xs)))⁻¹
 
 \end{code}
diff --git a/source/MLTT/Negation.lagda b/source/MLTT/Negation.lagda
index cb5c963ad..1e3f01602 100644
--- a/source/MLTT/Negation.lagda
+++ b/source/MLTT/Negation.lagda
@@ -6,7 +6,6 @@ Negation (and emptiness).
 
 module MLTT.Negation where
 
-open import MLTT.Universes
 open import MLTT.Empty
 open import MLTT.Id
 open import MLTT.Pi
@@ -74,6 +73,9 @@ double-contrapositive = contrapositive ∘ contrapositive
 ¬¬-intro : {A : 𝓤 ̇ } → A → ¬¬ A
 ¬¬-intro x u = u x
 
+≠-is-irrefl : {X : 𝓤 ̇ } (x : X) → ¬ (x ≠ x)
+≠-is-irrefl x = ¬¬-intro refl
+
 three-negations-imply-one : {A : 𝓤 ̇ } → ¬¬¬ A → ¬ A
 three-negations-imply-one = contrapositive ¬¬-intro
 
@@ -83,7 +85,9 @@ dne' f h ϕ = h (λ g → ϕ (λ a → g (f a)))
 dne : {A : 𝓤 ̇ } {B : 𝓥 ̇ } → (A → ¬ B) → ¬¬ A → ¬ B
 dne f ϕ b = ϕ (λ a → f a b)
 
-double-negation-unshift : {X : 𝓤 ̇ } {A : X → 𝓥 ̇ } → ¬¬ ((x : X) → A x) → (x : X) → ¬¬ (A x)
+double-negation-unshift : {X : 𝓤 ̇ } {A : X → 𝓥 ̇ }
+                        → ¬¬ ((x : X) → A x)
+                        → (x : X) → ¬¬ (A x)
 double-negation-unshift f x g = f (λ h → g (h x))
 
 dnu : {A : 𝓤 ̇ } {B : 𝓥 ̇ } → ¬¬ (A × B) → ¬¬ A × ¬¬ B
diff --git a/source/MLTT/Plus-Properties.lagda b/source/MLTT/Plus-Properties.lagda
index 8a975f1ea..51ace53ab 100644
--- a/source/MLTT/Plus-Properties.lagda
+++ b/source/MLTT/Plus-Properties.lagda
@@ -7,7 +7,6 @@ Properties of the disjoint sum _+_ of types.
 module MLTT.Plus-Properties where
 
 open import MLTT.Plus
-open import MLTT.Universes
 open import MLTT.Negation
 open import MLTT.Id
 open import MLTT.Empty
@@ -57,7 +56,6 @@ Right-fails-gives-left-holds : {P : 𝓤 ̇ } {Q : 𝓥 ̇ } → P + Q → ¬ Q
 Right-fails-gives-left-holds (inl p) u = p
 Right-fails-gives-left-holds (inr q) u = 𝟘-elim (u q)
 
-open import MLTT.Unit
 open import MLTT.Sigma
 open import Notation.General
 
diff --git a/source/MLTT/Plus-Type.lagda b/source/MLTT/Plus-Type.lagda
index 863156fed..54ce55aa2 100644
--- a/source/MLTT/Plus-Type.lagda
+++ b/source/MLTT/Plus-Type.lagda
@@ -6,7 +6,7 @@ module MLTT.Plus-Type where
 
 open import MLTT.Universes public
 
-data _+_ {𝓤 𝓥} (X : 𝓤 ̇ ) (Y : 𝓥 ̇ ) : 𝓤 ⊔ 𝓥 ̇  where
+data _+_ {𝓤 𝓥} (X : 𝓤 ̇ ) (Y : 𝓥 ̇ ) : 𝓤 ⊔ 𝓥 ̇ where
  inl : X → X + Y
  inr : Y → X + Y
 
diff --git a/source/MLTT/Sigma-Type.lagda b/source/MLTT/Sigma-Type.lagda
index 30eef1ddf..03bc52980 100644
--- a/source/MLTT/Sigma-Type.lagda
+++ b/source/MLTT/Sigma-Type.lagda
@@ -6,7 +6,7 @@ module MLTT.Sigma-Type where
 
 open import MLTT.Universes
 
-record Σ {𝓤 𝓥} {X : 𝓤 ̇ } (Y : X → 𝓥 ̇ ) : 𝓤 ⊔ 𝓥 ̇  where
+record Σ {𝓤 𝓥} {X : 𝓤 ̇ } (Y : X → 𝓥 ̇ ) : 𝓤 ⊔ 𝓥 ̇ where
   constructor
    _,_
   field
diff --git a/source/MLTT/Two-Properties.lagda b/source/MLTT/Two-Properties.lagda
index 33ba2cf69..abd0c2306 100644
--- a/source/MLTT/Two-Properties.lagda
+++ b/source/MLTT/Two-Properties.lagda
@@ -12,6 +12,7 @@ module MLTT.Two-Properties where
 open import MLTT.Spartan
 open import MLTT.Unit-Properties
 open import Naturals.Properties
+open import Notation.CanonicalMap
 open import Notation.Order
 open import UF.FunExt
 open import UF.Retracts
@@ -24,12 +25,20 @@ open import UF.Subsingletons
 𝟚-equality-cases {𝓤} {A} {₀} f₀ f₁ = f₀ refl
 𝟚-equality-cases {𝓤} {A} {₁} f₀ f₁ = f₁ refl
 
-𝟚-equality-cases₀ : {A : 𝓤 ̇ } {b : 𝟚} {f₀ : b ＝ ₀ → A} {f₁ : b ＝ ₁ → A}
-                  → (p : b ＝ ₀) → 𝟚-equality-cases {𝓤} {A} {b} f₀ f₁ ＝ f₀ p
-𝟚-equality-cases₀ {𝓤} {A} {.₀} refl = refl
-
-𝟚-equality-cases₁ : {A : 𝓤 ̇ } {b : 𝟚} {f₀ : b ＝ ₀ → A} {f₁ : b ＝ ₁ → A}
-                  → (p : b ＝ ₁) → 𝟚-equality-cases {𝓤} {A} {b} f₀ f₁ ＝ f₁ p
+𝟚-equality-cases₀ : {A : 𝓤 ̇ }
+                    {b : 𝟚}
+                    {f₀ : b ＝ ₀ → A}
+                    {f₁ : b ＝ ₁ → A}
+                    (p : b ＝ ₀)
+                  → 𝟚-equality-cases {𝓤} {A} {b} f₀ f₁ ＝ f₀ p
+𝟚-equality-cases₀ {𝓤} {A} {₀} refl = refl
+
+𝟚-equality-cases₁ : {A : 𝓤 ̇ }
+                    {b : 𝟚}
+                    {f₀ : b ＝ ₀ → A}
+                    {f₁ : b ＝ ₁ → A}
+                    (p : b ＝ ₁)
+                  → 𝟚-equality-cases {𝓤} {A} {b} f₀ f₁ ＝ f₁ p
 𝟚-equality-cases₁ {𝓤} {A} {.₁} refl = refl
 
 𝟚-equality-cases' : {A₀ A₁ : 𝓤 ̇ } {b : 𝟚} → (b ＝ ₀ → A₀) → (b ＝ ₁ → A₁) → A₀ + A₁
@@ -107,6 +116,12 @@ complement-involutive : (b : 𝟚) → complement (complement b) ＝ b
 complement-involutive ₀ = refl
 complement-involutive ₁ = refl
 
+complement-lc : (b c : 𝟚) → complement b ＝ complement c → b ＝ c
+complement-lc ₀ ₀ refl = refl
+complement-lc ₀ ₁ p    = p ⁻¹
+complement-lc ₁ ₀ p    = p ⁻¹
+complement-lc ₁ ₁ refl = refl
+
 eq𝟚 : 𝟚 → 𝟚 → 𝟚
 eq𝟚 ₀ n = complement n
 eq𝟚 ₁ n = n
@@ -233,6 +248,20 @@ min𝟚 : 𝟚 → 𝟚 → 𝟚
 min𝟚 ₀ b = ₀
 min𝟚 ₁ b = b
 
+min𝟚-comm : (b c : 𝟚) → min𝟚 b c ＝ min𝟚 c b
+min𝟚-comm ₀ ₀ = refl
+min𝟚-comm ₀ ₁ = refl
+min𝟚-comm ₁ ₀ = refl
+min𝟚-comm ₁ ₁ = refl
+
+min𝟚-idemp : (b : 𝟚) → min𝟚 b b ＝ b
+min𝟚-idemp ₀ = refl
+min𝟚-idemp ₁ = refl
+
+min𝟚-property₀ : (b : 𝟚) → min𝟚 b ₀ ＝ ₀
+min𝟚-property₀ ₀ = refl
+min𝟚-property₀ ₁ = refl
+
 min𝟚-preserves-≤ : {a b a' b' : 𝟚} → a ≤ a' → b ≤ b' → min𝟚 a b ≤ min𝟚 a' b'
 min𝟚-preserves-≤ {₀} {b} {a'} {b'} l m = l
 min𝟚-preserves-≤ {₁} {b} {₁}  {b'} l m = m
@@ -277,6 +306,16 @@ max𝟚 : 𝟚 → 𝟚 → 𝟚
 max𝟚 ₀ b = b
 max𝟚 ₁ b = ₁
 
+max𝟚-comm : (b c : 𝟚) → max𝟚 b c ＝ max𝟚 c b
+max𝟚-comm ₀ ₀ = refl
+max𝟚-comm ₀ ₁ = refl
+max𝟚-comm ₁ ₀ = refl
+max𝟚-comm ₁ ₁ = refl
+
+max𝟚-idemp : (b : 𝟚) → max𝟚 b b ＝ b
+max𝟚-idemp ₀ = refl
+max𝟚-idemp ₁ = refl
+
 max𝟚-lemma : {a b : 𝟚} → max𝟚 a b ＝ ₁ → (a ＝ ₁) + (b ＝ ₁)
 max𝟚-lemma {₀} r = inr r
 max𝟚-lemma {₁} r = inl refl
@@ -344,11 +383,24 @@ Lemma[b≠c→b⊕c＝₁] = different-from-₀-equal-₁ ∘ (contrapositive Le
 Lemma[b⊕c＝₁→b≠c] : {b c : 𝟚} → b ⊕ c ＝ ₁ → b ≠ c
 Lemma[b⊕c＝₁→b≠c] = (contrapositive Lemma[b＝c→b⊕c＝₀]) ∘ equal-₁-different-from-₀
 
+complement₀ : {a : 𝟚} → complement a ＝ ₀ → a ＝ ₁
+complement₀ {₁} refl = refl
+
 complement₁ : {a : 𝟚} → complement a ＝ ₁ → a ＝ ₀
 complement₁ {₀} refl = refl
 
-complement₀ : {a : 𝟚} → complement a ＝ ₀ → a ＝ ₁
-complement₀ {₁} refl = refl
+complement₁-back : {a : 𝟚} → a ＝ ₀ → complement a ＝ ₁
+complement₁-back {₀} refl = refl
+
+complement₀-back : {a : 𝟚} → a ＝ ₁ → complement a ＝ ₀
+complement₀-back {₁} refl = refl
+
+complement-one-gives-argument-not-one : {a : 𝟚} → complement a ＝ ₁ → a ≠ ₁
+complement-one-gives-argument-not-one {₀} _ = zero-is-not-one
+
+argument-not-one-gives-complement-one : {a : 𝟚} → a ≠ ₁ → complement a ＝ ₁
+argument-not-one-gives-complement-one {₀} ν = refl
+argument-not-one-gives-complement-one {₁} ν = 𝟘-elim (ν refl)
 
 complement-left : {b c : 𝟚} → complement b ≤ c → complement c ≤ b
 complement-left {₀} {₁} l = ⋆
@@ -397,15 +449,6 @@ complement-both-right {₁} {₁} l = ⋆
 ⊕-intro₁₁ : {a b : 𝟚} → a ＝ ₁ → b ＝ ₁ → a ⊕ b ＝ ₀
 ⊕-intro₁₁ {₁} {₁} p q = refl
 
-complement-intro₀ : {a : 𝟚} → a ＝ ₀ → complement a ＝ ₁
-complement-intro₀ {₀} p = refl
-
-complement-one-gives-argument-not-one : {a : 𝟚} → complement a ＝ ₁ → a ≠ ₁
-complement-one-gives-argument-not-one {₀} _ = zero-is-not-one
-
-complement-intro₁ : {a : 𝟚} → a ＝ ₁ → complement a ＝ ₀
-complement-intro₁ {₁} p = refl
-
 ⊕-₀-right-neutral : {a : 𝟚} → a ⊕ ₀ ＝ a
 ⊕-₀-right-neutral {₀} = refl
 ⊕-₀-right-neutral {₁} = refl
@@ -438,24 +481,28 @@ Lemma[b≠₁→b＝₀] : {b : 𝟚} → ¬ (b ＝ ₁) → b ＝ ₀
 Lemma[b≠₁→b＝₀] {₀} f = refl
 Lemma[b≠₁→b＝₀] {₁} f = 𝟘-elim (f refl)
 
-𝟚-ℕ-embedding : 𝟚 → ℕ
-𝟚-ℕ-embedding ₀ = 0
-𝟚-ℕ-embedding ₁ = 1
+𝟚-to-ℕ : 𝟚 → ℕ
+𝟚-to-ℕ ₀ = 0
+𝟚-to-ℕ ₁ = 1
+
+instance
+ Canonical-Map-𝟚-ℕ : Canonical-Map 𝟚 ℕ
+ ι {{Canonical-Map-𝟚-ℕ}} = 𝟚-to-ℕ
 
-𝟚-ℕ-embedding-is-lc : left-cancellable 𝟚-ℕ-embedding
-𝟚-ℕ-embedding-is-lc {₀} {₀} refl = refl
-𝟚-ℕ-embedding-is-lc {₀} {₁} r    = 𝟘-elim (positive-not-zero 0 (r ⁻¹))
-𝟚-ℕ-embedding-is-lc {₁} {₀} r    = 𝟘-elim (positive-not-zero 0 r)
-𝟚-ℕ-embedding-is-lc {₁} {₁} refl = refl
+𝟚-to-ℕ-is-lc : left-cancellable 𝟚-to-ℕ
+𝟚-to-ℕ-is-lc {₀} {₀} refl = refl
+𝟚-to-ℕ-is-lc {₀} {₁} r    = 𝟘-elim (positive-not-zero 0 (r ⁻¹))
+𝟚-to-ℕ-is-lc {₁} {₀} r    = 𝟘-elim (positive-not-zero 0 r)
+𝟚-to-ℕ-is-lc {₁} {₁} refl = refl
 
 C-B-embedding : (ℕ → 𝟚) → (ℕ → ℕ)
-C-B-embedding α = 𝟚-ℕ-embedding ∘ α
+C-B-embedding α = 𝟚-to-ℕ ∘ α
 
 C-B-embedding-is-lc : funext 𝓤₀ 𝓤₀ → left-cancellable C-B-embedding
 C-B-embedding-is-lc fe {α} {β} p = dfunext fe h
  where
   h : (n : ℕ) → α n ＝ β n
-  h n = 𝟚-ℕ-embedding-is-lc (ap (λ - → - n) p)
+  h n = 𝟚-to-ℕ-is-lc (ap (λ - → - n) p)
 
 𝟚-retract-of-ℕ : retract 𝟚 of ℕ
 𝟚-retract-of-ℕ = r , s , rs
diff --git a/source/MLTT/Unit-Properties.lagda b/source/MLTT/Unit-Properties.lagda
index 2816eca07..60419d97c 100644
--- a/source/MLTT/Unit-Properties.lagda
+++ b/source/MLTT/Unit-Properties.lagda
@@ -6,7 +6,6 @@ One-element type properties.
 
 module MLTT.Unit-Properties where
 
-open import MLTT.Universes
 open import MLTT.Unit
 open import MLTT.Empty
 open import MLTT.Id
diff --git a/source/MLTT/Universes.lagda b/source/MLTT/Universes.lagda
index e60a608a3..db21b036d 100644
--- a/source/MLTT/Universes.lagda
+++ b/source/MLTT/Universes.lagda
@@ -1,3 +1,126 @@
+Martin Escardo, original date unknown.
+
+This file defines our notation for type universes.
+
+Our convention for type universes here is the following.
+
+When the HoTT book writes
+
+  X : 𝓤
+
+we write
+
+  X : 𝓤 ̇
+
+although we wish we could use the same notation as the HoTT book. This
+would be possible if Agda had implicit coercions like other proof
+assistants such as Coq and we declared upperscript dot as an implicit
+coercion.
+
+Our choice of an almost invisible upperscript dot is deliberate. If
+you don't see it, then that's better.
+
+Officially, in our situation, 𝓤 is a so-called universe level, with
+corresponding universe
+
+  𝓤 ̇
+
+but we rename `Level` to `Universe` so that we can write e.g.
+
+  foo : {𝓤 : Universe} (X : 𝓤 ̇ ) → X ＝ X
+
+Moreover, we declare
+
+  𝓤 𝓥 𝓦 𝓣 𝓤' 𝓥' 𝓦' 𝓣'
+
+as `variables` so that the above can be shortened to the following
+with exactly the same meaning:
+
+  foo : (X : 𝓤 ̇ ) → X ＝ X
+
+Then the definition of `foo` can be
+
+  foo X = refl
+
+using the conventions for the identity type in another file in this
+development, or, if we want to be explicit (or need, in similar
+definitions, to refer to 𝓤), it can be
+
+  foo {𝓤} X = refl {𝓤} {X}
+
+**Important**. We also have the problem of *visualizing* this notation
+in both emacs and the html rendering of our Agda files in web
+browsers.
+
+First of all, we define upperscript dot as a postfix operator.
+Therefore, it is necessary to write a space between 𝓤 and the
+upperscript dot following it, by the conventions adopted by Agda.
+
+Secondly, it is the nature of unicode that upperscript dot is (almost)
+always displayed at the *top* of the previous character, which in our
+case is a space. Therefore, there is no visible space between 𝓤 and
+the upperscript dot in
+
+  𝓤 ̇
+
+but it does have to be typed, as otherwise we get
+
+  𝓤̇
+
+both in emacs and the html rendering, which Agda interprets as a
+single token.
+
+Moreover, Agda doesn't require the upperscript dot to have a space
+when it is followed by a closing bracket. Compare
+
+  (X : 𝓤 ̇)
+
+and
+
+  (X : 𝓤 ̇ )
+
+in both emacs and their html rendering
+
+  https://www.cs.bham.ac.uk/~mhe/TypeTopology/MLTT.Universes.html
+
+which here are typed, respectively, as
+
+  open bracket, X, colon, 𝓤, space, upperscript dot, close bracket
+
+and
+
+  open bracket, X, colon, 𝓤, space, upperscript dot, space, close bracket.
+
+You will see that the dot is placed at the top the closing bracket in
+the second example in its html version, but not in its emacs version.
+
+So we always need a space between the upperscript dot and the closing
+bracket.
+
+Another pitfall is that some TypeTopology contributors, including
+yours truly, often end up accidentally writing **two spaces** before
+the closing brackets, to avoid this, which we don't want, due to the
+above weirdness. Make sure you type exactly one space after the dot
+and before the closing bracket. More precisely, we want the first
+option, namely
+
+  open bracket, X, colon, 𝓤, space, upperscript dot, close bracket
+
+I really wish Agda had implicit coercions and we could write 𝓤 rather
+than the more cumbersome 𝓤 ̇. We can't really blame unicode here.
+
+If you are a TypeTopology contributor, make sure you read the above
+both in emacs in its agda version and in a web browser in its html
+version.
+
+  https://www.cs.bham.ac.uk/~mhe/TypeTopology/MLTT.Universes.html
+
+to understand this visualization problem and its solution in practice.
+
+Not all web browsers exhibit the same problem, though, which is even
+more annoying. The current solution works for all browsers I tested
+on 5th September 2024 (Firefox, Chrome, Chromium, Safari).
+
 \begin{code}
 
 {-# OPTIONS --safe --without-K #-}
diff --git a/source/MLTT/index.lagda b/source/MLTT/index.lagda
index 2b59242ae..e596e3785 100644
--- a/source/MLTT/index.lagda
+++ b/source/MLTT/index.lagda
@@ -15,6 +15,7 @@ import MLTT.Fin
 import MLTT.Id
 import MLTT.Identity-Type
 import MLTT.List
+import MLTT.List-Properties
 import MLTT.Natural-Numbers-Type
 import MLTT.NaturalNumbers
 import MLTT.Negation
diff --git a/source/MetricSpaces/DedekindReals.lagda b/source/MetricSpaces/DedekindReals.lagda
index 4c6d43379..d7788370a 100755
--- a/source/MetricSpaces/DedekindReals.lagda
+++ b/source/MetricSpaces/DedekindReals.lagda
@@ -20,10 +20,7 @@ open import UF.FunExt
 open import UF.Powerset
 open import UF.PropTrunc
 open import UF.Subsingletons
-open import Naturals.Addition renaming (_+_ to _ℕ+_)
-open import Naturals.Order renaming ( max to ℕmax
-                                    ; max-comm to ℕmax-comm
-                                    ; max-assoc to ℕmax-assoc)
+open import Naturals.Order renaming (max to ℕmax)
 open import Rationals.Addition
 open import Rationals.Type
 open import Rationals.Abs
@@ -41,12 +38,10 @@ module MetricSpaces.DedekindReals
 
 open PropositionalTruncation pt
 
-open import Rationals.Limits fe pe pt
 open import MetricSpaces.Type fe pe pt
 open import MetricSpaces.Rationals fe pe pt
 open import DedekindReals.Type fe pe pt
 open import DedekindReals.Properties fe pe pt
-open import DedekindReals.Order fe pe pt
 
 \end{code}
 
diff --git a/source/MetricSpaces/Rationals.lagda b/source/MetricSpaces/Rationals.lagda
index 5552555c6..0912ca212 100755
--- a/source/MetricSpaces/Rationals.lagda
+++ b/source/MetricSpaces/Rationals.lagda
@@ -11,7 +11,6 @@ open import MLTT.Spartan renaming (_+_ to _∔_)
 
 open import Notation.Order
 open import UF.FunExt
-open import UF.Base
 open import UF.Subsingletons
 open import UF.PropTrunc
 open import Rationals.Type
@@ -27,7 +26,6 @@ module MetricSpaces.Rationals
   (pt : propositional-truncations-exist)
  where
 
-open import Rationals.MinMax
 open import MetricSpaces.Type fe pe pt
 
 ℚ-zero-dist : (q : ℚ) → abs (q - q) ＝ 0ℚ
diff --git a/source/MetricSpaces/Type.lagda b/source/MetricSpaces/Type.lagda
index 580e6f36b..dab2b3c62 100755
--- a/source/MetricSpaces/Type.lagda
+++ b/source/MetricSpaces/Type.lagda
@@ -8,13 +8,11 @@ Cauchy and convergent sequences.
 
 open import MLTT.Spartan renaming (_+_ to _∔_)
 
-open import Naturals.Addition renaming (_+_ to _ℕ+_)
 open import Naturals.Order
 open import Notation.Order
 open import UF.FunExt
 open import UF.PropTrunc
 open import UF.Subsingletons
-open import Rationals.Type
 open import Rationals.Positive
 
 module MetricSpaces.Type
diff --git a/source/Modal/Open.lagda b/source/Modal/Open.lagda
index 440eae577..05ff59ba8 100644
--- a/source/Modal/Open.lagda
+++ b/source/Modal/Open.lagda
@@ -30,7 +30,7 @@ about open modalities, so we will assume it throughout.
 \begin{code}
 
  (fe : funext 𝓤 𝓤)
- 
+
 \end{code}
 
 There is an open modality for each proposition P. We fix such a
@@ -38,7 +38,7 @@ proposition throughout.
 
 \begin{code}
 
- (P : 𝓤 ̇  )
+ (P : 𝓤 ̇ )
  (P-is-prop : is-prop P)
  where
 
@@ -97,7 +97,7 @@ exponential-is-reflection A B B-modal =
    pr₁ (pr₂ B-modal) (open-unit B (j f))
     ＝⟨ pr₂ (pr₂ B-modal) (j f) ⟩
    j f ∎
- 
+
 open-is-reflective : subuniverse-is-reflective open-subuniverse
 open-is-reflective A =
  (((P → A) , (exponential-is-modal A)) , (open-unit A)) ,
@@ -116,7 +116,7 @@ open-is-replete A B e B-modal =
  ≃-2-out-of-3-left
   (pr₂ (→cong' fe fe e))
   (∘-is-equiv ⌜ e ⌝-is-equiv B-modal)
- 
+
 open-is-sigma-closed : subuniverse-is-sigma-closed open-subuniverse
 open-is-sigma-closed A B A-modal B-modal =
  ≃-2-out-of-3-left
diff --git a/source/Modal/ReflectiveSubuniverse.lagda b/source/Modal/ReflectiveSubuniverse.lagda
index d706256b2..f18b2376d 100644
--- a/source/Modal/ReflectiveSubuniverse.lagda
+++ b/source/Modal/ReflectiveSubuniverse.lagda
@@ -7,13 +7,11 @@ Much of this file is based on the proofs from Egbert Rijke's PhD thesis.
 {-# OPTIONS --safe --without-K #-}
 
 open import MLTT.Spartan
-open import UF.Subsingletons
 open import UF.Base
 open import UF.FunExt
 open import UF.Equiv
 open import UF.Retracts
 open import UF.Embeddings
-open import UF.EquivalenceExamples
 import UF.PairFun as PairFun
 import Slice.Construction as Slice
 
diff --git a/source/Modal/Subuniverse.lagda b/source/Modal/Subuniverse.lagda
index 4a7a5e839..8b1299dd1 100644
--- a/source/Modal/Subuniverse.lagda
+++ b/source/Modal/Subuniverse.lagda
@@ -9,8 +9,6 @@ module Modal.Subuniverse where
 
 open import MLTT.Spartan
 open import UF.Subsingletons
-open import UF.Base
-open import UF.FunExt
 open import UF.Equiv
 open import UF.Univalence
 
diff --git a/source/Naturals/Division.lagda b/source/Naturals/Division.lagda
index fc029579f..8dbf2809f 100755
--- a/source/Naturals/Division.lagda
+++ b/source/Naturals/Division.lagda
@@ -15,7 +15,6 @@ open import Naturals.Multiplication
 open import Naturals.Properties
 open import Naturals.Order
 open import Notation.Order
-open import UF.Base
 open import UF.DiscreteAndSeparated
 open import UF.Subsingletons
 
diff --git a/source/Naturals/HCF.lagda b/source/Naturals/HCF.lagda
index 53a82fe09..ccf1584bf 100755
--- a/source/Naturals/HCF.lagda
+++ b/source/Naturals/HCF.lagda
@@ -15,7 +15,6 @@ open import Naturals.Multiplication
 open import Naturals.Order
 open import Naturals.Properties
 open import Notation.Order
-open import UF.Base
 open import UF.DiscreteAndSeparated
 open import UF.FunExt
 open import UF.Subsingletons
diff --git a/source/Naturals/Multiplication.lagda b/source/Naturals/Multiplication.lagda
index 9e52346dc..1dfd191b4 100755
--- a/source/Naturals/Multiplication.lagda
+++ b/source/Naturals/Multiplication.lagda
@@ -13,7 +13,6 @@ open import MLTT.Spartan renaming (_+_ to _∔_)
 open import Naturals.Addition
 open import Naturals.Properties
 
-open import UF.Base
 
 module Naturals.Multiplication where
 
diff --git a/source/Naturals/Order.lagda b/source/Naturals/Order.lagda
index e81fc2e50..2b2d16ab3 100644
--- a/source/Naturals/Order.lagda
+++ b/source/Naturals/Order.lagda
@@ -160,8 +160,8 @@ not-less-than-itself 0    l = l
 not-less-than-itself (succ n) l = not-less-than-itself n l
 
 not-less-bigger-or-equal : (m n : ℕ) → ¬ (n < m) → n ≥ m
-not-less-bigger-or-equal 0    n u = zero-least n
-not-less-bigger-or-equal (succ m) 0    = ¬¬-intro (zero-least m)
+not-less-bigger-or-equal 0        n        = λ _ → zero-least n
+not-less-bigger-or-equal (succ m) 0        = ¬¬-intro (zero-least m)
 not-less-bigger-or-equal (succ m) (succ n) = not-less-bigger-or-equal m n
 
 bigger-or-equal-not-less : (m n : ℕ) → n ≥ m → ¬ (n < m)
@@ -252,6 +252,13 @@ course-of-values-induction-on-value-of-function
 
 TODO. Also add plain induction on the values of a function.
 
+TODO. Notice that this proof of course-of-values induction uses the
+accessibility predicate. From a foundational point of view, this is a
+too powerful tool - an indexed W-type. In fact, this is not
+needed. The course-of-values-induction theorem can be proved in MLTT
+with only natural numbers and without universes, identity types, of W
+types (indexed or not) other than the natural numbers.
+
 \begin{code}
 
 <-is-extensional : is-extensional _<_
@@ -293,7 +300,6 @@ Added December 2019.
 
 \begin{code}
 
-open import NotionsOfDecidability.Decidable
 open import NotionsOfDecidability.Complemented
 
 ≤-decidable : (m n : ℕ ) → is-decidable (m ≤ n)
diff --git a/source/Naturals/RootsTruncation.lagda b/source/Naturals/RootsTruncation.lagda
index 1b6067067..20f211197 100644
--- a/source/Naturals/RootsTruncation.lagda
+++ b/source/Naturals/RootsTruncation.lagda
@@ -19,39 +19,43 @@ open import MLTT.Spartan
 open import UF.DiscreteAndSeparated
 open import UF.Base
 
-module Naturals.RootsTruncation
-        (𝓤 : Universe)
-        (Z : 𝓤 ̇ )
-        (z : Z)
-        (z-is-isolated : is-isolated' z)
-       where
+module Naturals.RootsTruncation where
 
 open import MLTT.Plus-Properties
 open import Naturals.Order
 open import Notation.Order
-open import UF.Subsingletons
-open import UF.KrausLemma
 open import UF.Hedberg
+open import UF.KrausLemma
+open import UF.KrausLemma
+open import UF.PropTrunc
+open import UF.Subsingletons
+
+module Roots-truncation
+        {𝓤 : Universe}
+        (Z : 𝓤 ̇ )
+        (z : Z)
+        (z-is-isolated : is-isolated' z)
+       where
 
 \end{code}
 
 We now consider whether there is or there isn't a minimal root
-(strictly) bounded by a number k, where a root of α is an n : ℕ with α
-n ＝ z.
+(strictly) bounded by a number k, where a root of α is an n : ℕ with
+α n ＝ z.
 
 \begin{code}
 
-_has-no-root<_ : (ℕ → Z) → ℕ → 𝓤 ̇
-α has-no-root< k = (n : ℕ) → n < k → α n ≠ z
+ _has-no-root<_ : (ℕ → Z) → ℕ → 𝓤 ̇
+ α has-no-root< k = (n : ℕ) → n < k → α n ≠ z
 
-_has-a-minimal-root<_ : (ℕ → Z) → ℕ → 𝓤 ̇
-α has-a-minimal-root< k = Σ m ꞉ ℕ , (α m ＝ z)
-                                     × (m < k)
-                                     × α has-no-root< m
+ _has-a-minimal-root<_ : (ℕ → Z) → ℕ → 𝓤 ̇
+ α has-a-minimal-root< k = Σ m ꞉ ℕ , (α m ＝ z)
+                                      × (m < k)
+                                      × α has-no-root< m
 
-FPO : ℕ → (ℕ → Z) → 𝓤 ̇
-FPO k α = α has-a-minimal-root< k
-        + α has-no-root< k
+ FPO : ℕ → (ℕ → Z) → 𝓤 ̇
+ FPO k α = α has-a-minimal-root< k
+         + α has-no-root< k
 
 \end{code}
 
@@ -61,21 +65,21 @@ extensionality here.
 
 \begin{code}
 
-fpo : ∀ k α → FPO k α
-fpo zero α = inr (λ n p → 𝟘-elim p)
-fpo (succ k) α = cases f g (fpo k α)
- where
-  f : α has-a-minimal-root< k → FPO (succ k) α
-  f (m , p , l , φ) = inl (m , p , ≤-trans (succ m) k (succ k) l (≤-succ k) , φ)
+ fpo : ∀ k α → FPO k α
+ fpo 0 α = inr (λ n p → 𝟘-elim p)
+ fpo (succ k) α = cases f g (fpo k α)
+  where
+   f : α has-a-minimal-root< k → FPO (succ k) α
+   f (m , p , l , φ) = inl (m , p , ≤-trans (succ m) k (succ k) l (≤-succ k) , φ)
 
-  g : α has-no-root< k → FPO (succ k) α
-  g φ = cases g₀ g₁ (z-is-isolated (α k))
-   where
-    g₀ : α k ＝ z → FPO (succ k) α
-    g₀ p = inl (k , p , ≤-refl k , φ)
+   g : α has-no-root< k → FPO (succ k) α
+   g φ = cases g₀ g₁ (z-is-isolated (α k))
+    where
+     g₀ : α k ＝ z → FPO (succ k) α
+     g₀ p = inl (k , p , ≤-refl k , φ)
 
-    g₁ : α k ≠ z → FPO (succ k) α
-    g₁ u = inr (bounded-∀-next (λ n → α n ≠ z) k u φ)
+     g₁ : α k ≠ z → FPO (succ k) α
+     g₁ u = inr (bounded-∀-next (λ n → α n ≠ z) k u φ)
 
 \end{code}
 
@@ -83,11 +87,11 @@ Given any root, we can find a minimal root.
 
 \begin{code}
 
-minimal-root : ∀ α n → α n ＝ z → α has-a-minimal-root< (succ n)
-minimal-root α n p = Right-fails-gives-left-holds (fpo (succ n) α) g
- where
-  g : ¬ (α has-no-root< (succ n))
-  g φ = φ n (≤-refl n) p
+ minimal-root : ∀ α n → α n ＝ z → α has-a-minimal-root< (succ n)
+ minimal-root α n p = Right-fails-gives-left-holds (fpo (succ n) α) g
+  where
+   g : ¬ (α has-no-root< (succ n))
+   g φ = φ n (≤-refl n) p
 
 \end{code}
 
@@ -97,65 +101,72 @@ be empty, and still the function is well defined.
 
 \begin{code}
 
-roots : (ℕ → Z) → 𝓤 ̇
-roots α = Σ n ꞉ ℕ , α n ＝ z
+ Root : (ℕ → Z) → 𝓤 ̇
+ Root α = Σ n ꞉ ℕ , α n ＝ z
 
-μρ : (α : ℕ → Z) → roots α → roots α
-μρ α (n , p) = pr₁ (minimal-root α n p) , pr₁ (pr₂ (minimal-root α n p))
+ μρ : (α : ℕ → Z) → Root α → Root α
+ μρ α (n , p) = pr₁ (minimal-root α n p) , pr₁ (pr₂ (minimal-root α n p))
 
-μρ-root : (α : ℕ → Z) → roots α → ℕ
-μρ-root α r = pr₁ (μρ α r)
+ μ-root : (α : ℕ → Z) → Root α → ℕ
+ μ-root α r = pr₁ (μρ α r)
 
-μρ-root-is-root : (α : ℕ → Z) (r : roots α) → α (μρ-root α r) ＝ z
-μρ-root-is-root α r = pr₂ (μρ α r)
+ μ-root-is-root : (α : ℕ → Z) (r : Root α) → α (μ-root α r) ＝ z
+ μ-root-is-root α r = pr₂ (μρ α r)
 
-μρ-root-minimal : (α : ℕ → Z) (m : ℕ) (p : α m ＝ z)
-                → (n : ℕ) → α n ＝ z → μρ-root α (m , p) ≤ n
-μρ-root-minimal α m p n q = not-less-bigger-or-equal (μρ-root α (m , p)) n (f (¬¬-intro q))
- where
-  f : ¬ (α n ≠ z) → ¬ (n < μρ-root α (m , p))
-  f = contrapositive (pr₂(pr₂(pr₂ (minimal-root α m p))) n)
+ μ-root-is-minimal : (α : ℕ → Z) (m : ℕ) (p : α m ＝ z)
+                   → (n : ℕ) → α n ＝ z → μ-root α (m , p) ≤ n
+ μ-root-is-minimal α m p n q = not-less-bigger-or-equal k n g
+  where
+   k : ℕ
+   k = μ-root α (m , p)
 
-μρ-constant : (α : ℕ → Z) → wconstant (μρ α)
-μρ-constant α (n , p) (n' , p') = r
- where
-  m m' : ℕ
-  m  = μρ-root α (n , p)
-  m' = μρ-root α (n' , p')
+   f : n < k → α n ≠ z
+   f = pr₂ (pr₂ (pr₂ (minimal-root α m p))) n
+
+   g : ¬ (n < k)
+   g l = f l q
+
+ μρ-constant : (α : ℕ → Z) → wconstant (μρ α)
+ μρ-constant α (n , p) (n' , p') = r
+  where
+   m m' : ℕ
+   m  = μ-root α (n , p)
+   m' = μ-root α (n' , p')
 
-  l : m ≤ m'
-  l = μρ-root-minimal α n p m' (μρ-root-is-root α (n' , p'))
+   l : m ≤ m'
+   l = μ-root-is-minimal α n p m' (μ-root-is-root α (n' , p'))
 
-  l' : m' ≤ m
-  l' = μρ-root-minimal α n' p' m (μρ-root-is-root α (n , p))
+   l' : m' ≤ m
+   l' = μ-root-is-minimal α n' p' m (μ-root-is-root α (n , p))
 
-  q : m ＝ m'
-  q = ≤-anti _ _ l l'
+   q : m ＝ m'
+   q = ≤-anti _ _ l l'
 
-  r : μρ α (n , p) ＝ μρ α (n' , p')
-  r = to-Σ-＝ (q , isolated-Id-is-prop z z-is-isolated _ _ _)
+   r : μρ α (n , p) ＝ μρ α (n' , p')
+   r = to-Σ-＝ (q , isolated-Id-is-prop z z-is-isolated _ _ _)
 
-roots-has-prop-truncation : (α : ℕ → Z) → ∀ 𝓥 → has-prop-truncation 𝓥 (roots α)
-roots-has-prop-truncation α = collapsible-has-prop-truncation (μρ α , μρ-constant α)
+ Root-has-prop-truncation : (α : ℕ → Z) → ∀ 𝓥 → has-prop-truncation 𝓥 (Root α)
+ Root-has-prop-truncation α = collapsible-has-prop-truncation
+                               (μρ α , μρ-constant α)
 
 \end{code}
 
-Explicitly (and repeating the construction of roots-has-prop-truncation):
+Explicitly (and repeating the construction of Root-has-prop-truncation):
 
 \begin{code}
 
-roots-truncation : (ℕ → Z) → 𝓤 ̇
-roots-truncation α = Σ r ꞉ roots α , r ＝ μρ α r
+ Root-truncation : (ℕ → Z) → 𝓤 ̇
+ Root-truncation α = Σ r ꞉ Root α , r ＝ μρ α r
 
-roots-truncation-is-prop : (α : ℕ → Z) → is-prop (roots-truncation α)
-roots-truncation-is-prop α = fix-is-prop (μρ α) (μρ-constant α)
+ Root-truncation-is-prop : (α : ℕ → Z) → is-prop (Root-truncation α)
+ Root-truncation-is-prop α = fix-is-prop (μρ α) (μρ-constant α)
 
-roots-η : (α : ℕ → Z) → roots α → roots-truncation α
-roots-η α = to-fix (μρ α) (μρ-constant α)
+ η-Root : (α : ℕ → Z) → Root α → Root-truncation α
+ η-Root α = to-fix (μρ α) (μρ-constant α)
 
-roots-universal : (α : ℕ → Z) (P : 𝓥 ̇ )
-                → is-prop P → (roots α → P) → roots-truncation α → P
-roots-universal α P _ f t = f (from-fix (μρ α) t)
+ Root-truncation-universal : (α : ℕ → Z) (P : 𝓥 ̇ )
+                           → is-prop P → (Root α → P) → Root-truncation α → P
+ Root-truncation-universal α P _ f t = f (from-fix (μρ α) t)
 
 \end{code}
 
@@ -163,8 +174,8 @@ We can't normally "exit a truncation", but in this special case we can:
 
 \begin{code}
 
-roots-exit-truncation : (α : ℕ → Z) → roots-truncation α → roots α
-roots-exit-truncation α = from-fix (μρ α)
+ Root-exit-truncation : (α : ℕ → Z) → Root-truncation α → Root α
+ Root-exit-truncation α = from-fix (μρ α)
 
 \end{code}
 
@@ -173,24 +184,262 @@ root truncations using the above technique.
 
 \begin{code}
 
-open import UF.PropTrunc
+ module exit-Roots-truncation (pt : propositional-truncations-exist) where
 
-module ExitRootTruncations (pt : propositional-truncations-exist) where
+  open PropositionalTruncation pt
+  open split-support-and-collapsibility pt
 
- open PropositionalTruncation pt
+  exit-Root-truncation : (α : ℕ → Z) → (∃ n ꞉ ℕ , α n ＝ z) → Σ n ꞉ ℕ , α n ＝ z
+  exit-Root-truncation α = collapsible-gives-split-support (μρ α , μρ-constant α)
+
+\end{code}
+
+This says that if there is a root, then we can find one.
 
- exit-roots-truncation : (α : ℕ → Z) → (∃ n ꞉ ℕ , α n ＝ z) → Σ n ꞉ ℕ , α n ＝ z
- exit-roots-truncation α = h ∘ g
+Added 17th August 2024.
+
+\begin{code}
+
+open import NotionsOfDecidability.Complemented
+open import NotionsOfDecidability.Decidable
+
+module _ (A : ℕ → 𝓤 ̇ )
+         (δ : is-complemented A)
+      where
+
+ minimal-witness : (Σ n ꞉ ℕ , A n)
+                 → Σ m ꞉ ℕ , (A m × ((k : ℕ) → A k → m ≤ k))
+ minimal-witness (n , aₙ) = m , aₘ , m-is-minimal-witness
   where
-   f : (Σ n ꞉ ℕ , α n ＝ z) → fix (μρ α)
-   f = to-fix (μρ α) (μρ-constant α)
+   open Roots-truncation 𝟚 ₀ (λ b → 𝟚-is-discrete b ₀)
+
+   α : ℕ → 𝟚
+   α = characteristic-map A δ
 
-   g : ∥(Σ n ꞉ ℕ , α n ＝ z)∥ → fix (μρ α)
-   g = ∥∥-rec (fix-is-prop (μρ α) (μρ-constant α)) f
+   n-is-root : α n ＝ ₀
+   n-is-root = characteristic-map-property₀-back A δ n aₙ
 
-   h : fix (μρ α) → Σ n ꞉ ℕ , α n ＝ z
-   h = from-fix (μρ α)
+   r : Root α
+   r = n , n-is-root
+
+   m : ℕ
+   m = μ-root α r
+
+   m-is-root : α m ＝ ₀
+   m-is-root = μ-root-is-root α r
+
+   aₘ : A m
+   aₘ = characteristic-map-property₀ A δ m m-is-root
+
+   m-is-minimal-root : (k : ℕ) → α k ＝ ₀ → m ≤ k
+   m-is-minimal-root = μ-root-is-minimal α n n-is-root
+
+   m-is-minimal-witness : (k : ℕ) → A k → m ≤ k
+   m-is-minimal-witness k aₖ = m-is-minimal-root k k-is-root
+    where
+     k-is-root : α k ＝ ₀
+     k-is-root = characteristic-map-property₀-back A δ k aₖ
 
 \end{code}
 
-This says that if there is a root, then we can find one.
+Added 18th September 2024. The following "exit-truncation lemma"
+generalizes the above development with a simpler proof. But this
+result was already known in
+
+   Martín H. Escardó and Chuangjie Xu. The inconsistency of a
+   Brouwerian continuity principle with the Curry-Howard
+   interpretation. 13th International Conference on Typed Lambda
+   Calculi and Applications (TLCA 2015).
+
+   https://drops.dagstuhl.de/opus/portals/lipics/index.php?semnr=15006
+   https://doi.org/10.4230/LIPIcs.TLCA.2015.153
+
+although it was presented with a different proof that assumes function
+extensionlity.
+
+\begin{code}
+
+private
+ abstract
+  minimal-pair⁺ : (A : ℕ → 𝓤 ̇ )
+                → ((n : ℕ) → A n → (k : ℕ) → k < n → is-decidable (A k))
+                → (n : ℕ)
+                → A n
+                → Σ (k , aₖ) ꞉ Σ A , ((i : ℕ) → A i → k ≤ i)
+  minimal-pair⁺ A δ 0        a₀   = (0 , a₀) , (λ i aᵢ → zero-least i)
+  minimal-pair⁺ A δ (succ n) aₙ₊₁ = II
+   where
+    IH : Σ (j , aⱼ₊₁) ꞉ Σ (A ∘ succ) , ((i : ℕ) → A (succ i) → j ≤ i)
+    IH = minimal-pair⁺ (A ∘ succ) (λ n aₙ₊₁ j → δ (succ n) aₙ₊₁ (succ j)) n aₙ₊₁
+
+    I : type-of IH
+      → Σ (k , aₖ) ꞉ Σ A , ((i : ℕ) → A i → k ≤ i)
+    I ((j , aⱼ₊₁) , b) =
+     Cases (δ (succ n) aₙ₊₁ 0 (zero-least j))
+      (λ (a₀ :    A 0) → (0 , a₀)        , (λ i aᵢ → zero-least i))
+      (λ (ν₀  : ¬ A 0) → (succ j , aⱼ₊₁) , I₀ ν₀)
+       where
+        I₀ : ¬ A 0 → (i : ℕ) (aᵢ : A i) → j < i
+        I₀ ν₀ 0        a₀   = 𝟘-elim (ν₀ a₀)
+        I₀ ν₀ (succ i) aᵢ₊₁ = b i aᵢ₊₁
+
+    II : Σ (k , aⱼ) ꞉ Σ A , ((i : ℕ) → A i → k ≤ i)
+    II = I IH
+
+module _ (A : ℕ → 𝓤 ̇ )
+         (δ : (n : ℕ) → A n → (k : ℕ) → k < n → is-decidable (A k))
+       where
+
+ minimal-pair : Σ A → Σ A
+ minimal-pair (n , aₙ) = pr₁ (minimal-pair⁺ A δ n aₙ)
+
+ minimal-number : Σ A → ℕ
+ minimal-number = pr₁ ∘ minimal-pair
+
+ minimal-number-requirement : (σ : Σ A) → A (minimal-number σ)
+ minimal-number-requirement = pr₂ ∘ minimal-pair
+
+ minimality : (σ : Σ A) → (i : ℕ) → A i → minimal-number σ ≤ i
+ minimality (n , aₙ) = pr₂ (minimal-pair⁺ A δ n aₙ)
+
+ minimal-pair-wconstant : is-prop-valued-family A → wconstant minimal-pair
+ minimal-pair-wconstant A-prop-valued σ σ' =
+  to-subtype-＝ A-prop-valued
+   (need
+     minimal-number σ ＝ minimal-number σ'
+    which-is-given-by
+     ≤-anti _ _
+      (minimality σ  (minimal-number σ') (minimal-number-requirement σ'))
+      (minimality σ' (minimal-number σ)  (minimal-number-requirement σ)))
+
+module exit-truncations (pt : propositional-truncations-exist) where
+
+ open PropositionalTruncation pt
+ open split-support-and-collapsibility pt
+
+ module _ (A : ℕ → 𝓤 ̇ )
+          (A-is-prop-valued : is-prop-valued-family A)
+          (δ : (n : ℕ) → A n → (k : ℕ) → k < n → is-decidable (A k))
+        where
+
+  exit-truncation⁺ : ∥ Σ A ∥ → Σ A
+  exit-truncation⁺ = collapsible-gives-split-support
+                      (minimal-pair A δ ,
+                       minimal-pair-wconstant A δ A-is-prop-valued)
+
+  exit-truncation⁺-minimality
+   : (s : ∥ Σ A ∥) (i : ℕ) → A i → pr₁ (exit-truncation⁺ s) ≤ i
+  exit-truncation⁺-minimality s = IV
+   where
+    I : minimal-pair A δ (exit-truncation⁺ s) ＝ exit-truncation⁺ s
+    I = exit-prop-trunc-is-fixed
+         (minimal-pair A δ)
+         (minimal-pair-wconstant A δ A-is-prop-valued)
+         s
+
+    II : minimal-number A δ (exit-truncation⁺ s) ＝ pr₁ (exit-truncation⁺ s)
+    II = ap pr₁ I
+
+    III : (i : ℕ) → A i → minimal-number A δ (exit-truncation⁺ s) ≤ i
+    III = minimality A δ (exit-truncation⁺ s)
+
+    IV : (i : ℕ) → A i → pr₁ (exit-truncation⁺ s) ≤ i
+    IV = transport (λ - → (i : ℕ) → A i → - ≤ i) II III
+
+\end{code}
+
+This is not quite a generalization of the previous result, because the
+previous result doesn't have the assumption that A is prop-valued.
+
+TODO. Can we remove the prop-valuedness assumption?
+
+In the following particular case of interest, the prop-valuedness
+assumption can be removed.
+
+\begin{code}
+
+ module _ (B : ℕ → 𝓤 ̇ )
+          (d : (n : ℕ) → is-decidable (B n))
+        where
+
+  private
+    A : ℕ → 𝓤₀ ̇
+    A n = ∥ B n ∥⟨ d n ⟩
+
+    A-is-prop-valued : is-prop-valued-family A
+    A-is-prop-valued n = ∥∥⟨⟩-is-prop (d n)
+
+    δ : (n : ℕ) → A n → (k : ℕ) → k < n → is-decidable (A k)
+    δ n aₙ k l = ∥∥⟨⟩-is-decidable (d k)
+
+    f : Σ B → Σ A
+    f (n , bₙ) = n , ∣ bₙ ∣⟨ d n ⟩
+
+    g : Σ A → Σ B
+    g (n , aₙ) = (n , ∣∣⟨⟩-exit (d n) aₙ)
+
+  exit-truncation : ∥ Σ B ∥ → Σ B
+  exit-truncation t = g (exit-truncation⁺ A A-is-prop-valued δ (∥∥-functor f t))
+
+  exit-truncation-minimality
+   : (t : ∥ Σ B ∥) (i : ℕ) → B i → pr₁ (exit-truncation t) ≤ i
+  exit-truncation-minimality t i b =
+   exit-truncation⁺-minimality
+    A
+    A-is-prop-valued
+    δ
+    (∥∥-functor f t)
+    i
+    ∣ b ∣⟨ d i ⟩
+
+\end{code}
+
+Added 19th September 2024.
+
+The following is useful in practice to fulfill a hypothesis of
+exit-truncation⁺.
+
+\begin{code}
+
+regression-lemma₀
+ : (A : ℕ → 𝓤 ̇ )
+ → ((n : ℕ) → A (succ n) → is-decidable (A n))
+ → ((n : ℕ) → A n → A (succ n))
+ → (n : ℕ) → A (succ n) → is-decidable (A 0)
+regression-lemma₀ A f g 0        = f 0
+regression-lemma₀ A f g (succ n) = I
+ where
+  IH : A (succ (succ n)) → is-decidable (A 1)
+  IH = regression-lemma₀ (A ∘ succ) (f ∘ succ) (g ∘ succ) n
+
+  I : A (succ (succ n)) → is-decidable (A 0)
+  I a = Cases (IH a)
+         (λ (a₁ :   A 1) → f 0 a₁)
+         (λ (ν  : ¬ A 1) → inr (contrapositive (g 0) ν))
+
+regression-lemma
+ : (A : ℕ → 𝓤 ̇ )
+ → ((n : ℕ) → A (succ n) → is-decidable (A n))
+ → ((n : ℕ) → A n → A (succ n))
+ → (n : ℕ) → A n → (k : ℕ) → k < n → is-decidable (A k)
+regression-lemma A f g 0        a k        l = 𝟘-elim l
+regression-lemma A f g (succ n) a 0        l = regression-lemma₀ A f g n a
+regression-lemma A f g (succ n) a (succ k) l = regression-lemma
+                                                (A ∘ succ)
+                                                (f ∘ succ)
+                                                (g ∘ succ)
+                                                n a k l
+\end{code}
+
+Notice that these functions don't actually use the full force of the
+assumption
+
+ (n : ℕ) → A n → A (succ n)
+
+but only its contrapositive. So there is a more general result that
+assumes
+
+ (n : ℕ) → ¬ A (succ n) → ¬ A n
+
+instead, although I don't think this will ever be needed. If it is, we
+can come back here and do a little bit of refactoring.
diff --git a/source/Naturals/Sequence.lagda b/source/Naturals/Sequence.lagda
index ab80b4c30..f5062d333 100644
--- a/source/Naturals/Sequence.lagda
+++ b/source/Naturals/Sequence.lagda
@@ -9,7 +9,6 @@ open import UF.FunExt
 module Naturals.Sequence (fe : FunExt) where
 
 open import MLTT.Spartan hiding (_+_)
-open import UF.Base
 open import UF.Retracts
 open import Naturals.Addition
 
diff --git a/source/Naturals/UniversalProperty.lagda b/source/Naturals/UniversalProperty.lagda
index ef8024d05..427505132 100644
--- a/source/Naturals/UniversalProperty.lagda
+++ b/source/Naturals/UniversalProperty.lagda
@@ -12,7 +12,6 @@ here from nondependent functions to dependent functions.
 
 module Naturals.UniversalProperty where
 
-open import MLTT.NaturalNumbers
 
 open import MLTT.Spartan
 open import UF.Base
diff --git a/source/Notation/CanonicalMap.lagda b/source/Notation/CanonicalMap.lagda
index dd521460f..62b7cff25 100644
--- a/source/Notation/CanonicalMap.lagda
+++ b/source/Notation/CanonicalMap.lagda
@@ -11,7 +11,7 @@ module Notation.CanonicalMap where
 
 open import MLTT.Spartan
 
-record Canonical-Map {𝓤} {𝓥} (X : 𝓤 ̇ ) (Y : 𝓥 ̇ ) : 𝓤 ⊔ 𝓥 ̇  where
+record Canonical-Map {𝓤} {𝓥} (X : 𝓤 ̇ ) (Y : 𝓥 ̇ ) : 𝓤 ⊔ 𝓥 ̇ where
  field
   ι : X → Y
 
diff --git a/source/Notation/Decimal.lagda b/source/Notation/Decimal.lagda
new file mode 100644
index 000000000..f51732768
--- /dev/null
+++ b/source/Notation/Decimal.lagda
@@ -0,0 +1,75 @@
+Martin Escardo 12th September 2024
+
+This file provides an interface to implement automatic converscxion of
+decimal literals to types other than just the natural numbers.
+
+See https://agda.readthedocs.io/en/latest/language/literal-overloading.html
+
+\begin{code}
+
+{-# OPTIONS --safe --without-K #-}
+
+module Notation.Decimal where
+
+open import MLTT.Universes
+open import MLTT.NaturalNumbers
+
+record Decimal {𝓤 𝓥 : Universe} (A : 𝓤 ̇ ) : 𝓤 ⊔ 𝓥 ⁺ ̇ where
+  field
+    constraint : ℕ → 𝓥 ̇
+    fromℕ : (n : ℕ) {{_ : constraint n}} → A
+
+open Decimal {{...}} public using (fromℕ)
+
+{-# BUILTIN FROMNAT fromℕ #-}
+{-# DISPLAY Decimal.fromℕ _ n = fromℕ n #-}
+
+record Negative {𝓤 𝓥 : Universe} (A : 𝓤 ̇ ) : 𝓤 ⊔ 𝓥 ⁺ ̇ where
+  field
+    constraint : ℕ → 𝓥 ̇
+    fromNeg : (n : ℕ) {{_ : constraint n}} → A
+
+open Negative {{...}} public using (fromNeg)
+
+{-# BUILTIN FROMNEG fromNeg #-}
+{-# DISPLAY Negative.fromNeg _ n = fromNeg n #-}
+
+data No-Constraint : 𝓤₀ ̇ where
+ no-constraint : No-Constraint
+
+instance
+ really-no-constraint : No-Constraint
+ really-no-constraint = no-constraint
+
+make-decimal-with-no-constraint
+ : {A : 𝓤 ̇ }
+ → ((n : ℕ)  {{ _ : No-Constraint }} → A)
+ → Decimal A
+make-decimal-with-no-constraint f =
+ record {
+   constraint = λ _ → No-Constraint
+ ; fromℕ = f
+ }
+
+make-negative-with-no-constraint
+ : {A : 𝓤 ̇ }
+ → ((n : ℕ)  {{_ : No-Constraint}} → A)
+ → Negative A
+make-negative-with-no-constraint f =
+ record {
+   constraint = λ _ → No-Constraint
+ ; fromNeg = f
+ }
+
+\end{code}
+
+The natural place for this would be MLTT.NaturalNumbers, but then we
+would get a circular dependency.
+
+\begin{code}
+
+instance
+ Decimal-ℕ-to-ℕ : Decimal ℕ
+ Decimal-ℕ-to-ℕ = make-decimal-with-no-constraint (λ n → n)
+
+\end{code}
diff --git a/source/Notation/Order.lagda b/source/Notation/Order.lagda
index 230852fc6..a0c7d3cd1 100644
--- a/source/Notation/Order.lagda
+++ b/source/Notation/Order.lagda
@@ -10,7 +10,7 @@ module Notation.Order where
 
 open import MLTT.Spartan
 
-record Strict-Order {𝓤} {𝓥} {𝓦} (X : 𝓤 ̇ ) (Y : 𝓥 ̇ ) : (𝓤 ⊔ 𝓥 ⊔ 𝓦)⁺ ̇  where
+record Strict-Order {𝓤} {𝓥} {𝓦} (X : 𝓤 ̇ ) (Y : 𝓥 ̇ ) : (𝓤 ⊔ 𝓥 ⊔ 𝓦)⁺ ̇ where
  field
    _<_ : X → Y → 𝓦  ̇
 
@@ -28,7 +28,7 @@ record Strict-Order {𝓤} {𝓥} {𝓦} (X : 𝓤 ̇ ) (Y : 𝓥 ̇ ) : (𝓤 
 
 open Strict-Order {{...}} public
 
-record Order {𝓤} {𝓥} {𝓦} (X : 𝓤 ̇ ) (Y : 𝓥 ̇ ) : (𝓤 ⊔ 𝓥 ⊔ 𝓦)⁺ ̇  where
+record Order {𝓤} {𝓥} {𝓦} (X : 𝓤 ̇ ) (Y : 𝓥 ̇ ) : (𝓤 ⊔ 𝓥 ⊔ 𝓦)⁺ ̇ where
  field
    _≤_ : X → Y → 𝓦  ̇
 
@@ -47,7 +47,7 @@ record Order {𝓤} {𝓥} {𝓦} (X : 𝓤 ̇ ) (Y : 𝓥 ̇ ) : (𝓤 ⊔ 𝓥
 
 open Order {{...}} public
 
-record Strict-Square-Order {𝓤} {𝓥} {𝓦} (X : 𝓤 ̇ ) (Y : 𝓥 ̇ ) : (𝓤 ⊔ 𝓥 ⊔ 𝓦)⁺ ̇  where
+record Strict-Square-Order {𝓤} {𝓥} {𝓦} (X : 𝓤 ̇ ) (Y : 𝓥 ̇ ) : (𝓤 ⊔ 𝓥 ⊔ 𝓦)⁺ ̇ where
  field
    _⊏_ : X → Y → 𝓦  ̇
 
@@ -59,7 +59,7 @@ record Strict-Square-Order {𝓤} {𝓥} {𝓦} (X : 𝓤 ̇ ) (Y : 𝓥 ̇ ) :
 
 open Strict-Square-Order {{...}} public
 
-record Square-Order {𝓤} {𝓥} {𝓦} (X : 𝓤 ̇ ) (Y : 𝓥 ̇ ) : (𝓤 ⊔ 𝓥 ⊔ 𝓦)⁺ ̇  where
+record Square-Order {𝓤} {𝓥} {𝓦} (X : 𝓤 ̇ ) (Y : 𝓥 ̇ ) : (𝓤 ⊔ 𝓥 ⊔ 𝓦)⁺ ̇ where
  field
    _⊑_ : X → Y → 𝓦  ̇
 
@@ -71,7 +71,7 @@ record Square-Order {𝓤} {𝓥} {𝓦} (X : 𝓤 ̇ ) (Y : 𝓥 ̇ ) : (𝓤 
 
 open Square-Order {{...}} public
 
-record Strict-Curly-Order {𝓤} {𝓥} {𝓦} (X : 𝓤 ̇ ) (Y : 𝓥 ̇ ) : (𝓤 ⊔ 𝓥 ⊔ 𝓦)⁺ ̇  where
+record Strict-Curly-Order {𝓤} {𝓥} {𝓦} (X : 𝓤 ̇ ) (Y : 𝓥 ̇ ) : (𝓤 ⊔ 𝓥 ⊔ 𝓦)⁺ ̇ where
  field
    _≺_ : X → Y → 𝓦  ̇
 
@@ -83,7 +83,7 @@ record Strict-Curly-Order {𝓤} {𝓥} {𝓦} (X : 𝓤 ̇ ) (Y : 𝓥 ̇ ) : (
 
 open Strict-Curly-Order {{...}} public
 
-record Curly-Order {𝓤} {𝓥} {𝓦} (X : 𝓤 ̇ ) (Y : 𝓥 ̇ ) : (𝓤 ⊔ 𝓥 ⊔ 𝓦)⁺ ̇  where
+record Curly-Order {𝓤} {𝓥} {𝓦} (X : 𝓤 ̇ ) (Y : 𝓥 ̇ ) : (𝓤 ⊔ 𝓥 ⊔ 𝓦)⁺ ̇ where
  field
    _≼_ : X → Y → 𝓦  ̇
 
@@ -125,7 +125,7 @@ Define a general notation for reasoning chains
 
 \begin{code}
 record Reflexive-Order {𝓤} (X : 𝓤 ̇ )
- (_R_ : X → X → 𝓤 ̇ ) : 𝓤 ̇  where
+ (_R_ : X → X → 𝓤 ̇ ) : 𝓤 ̇ where
  field
   _▨ : (x : X) → x R x
 
@@ -137,7 +137,7 @@ record Reasoning-Chain {𝓤} {𝓥} {𝓦} {𝓣} {𝓧 : Universe}
  (X : 𝓤 ̇ ) (Y : 𝓥 ̇ ) (Z : 𝓦 ̇ )
  (_R₁_ : X → Y → 𝓦 ̇ )
  (_R₂_ : Y → Z → 𝓣 ̇ )
- (_R₃_ : X → Z → 𝓧 ̇ ) : (𝓤 ⊔ 𝓥 ⊔ 𝓦 ⊔ 𝓣 ⊔ 𝓧)⁺ ̇  where
+ (_R₃_ : X → Z → 𝓧 ̇ ) : (𝓤 ⊔ 𝓥 ⊔ 𝓦 ⊔ 𝓣 ⊔ 𝓧)⁺ ̇ where
  field
   _⸴_⊢_ : (x : X) {y : Y} {z : Z} → x R₁ y → y R₂ z → x R₃ z
 
diff --git a/source/Notation/UnderlyingType.lagda b/source/Notation/UnderlyingType.lagda
index b4c7f6fe9..86eb540b3 100644
--- a/source/Notation/UnderlyingType.lagda
+++ b/source/Notation/UnderlyingType.lagda
@@ -1,6 +1,6 @@
 Martin Escardo 6th May 2022
 
-Type-class for notation for underlying types of ordered sets.
+Type-class for notation for underlying things.
 
 \begin{code}
 
@@ -10,9 +10,9 @@ module Notation.UnderlyingType where
 
 open import MLTT.Spartan
 
-record Underlying-Type {𝓤} (X : 𝓤 ̇ ) (𝓥 : Universe) : 𝓤 ⊔ 𝓥 ⁺ ̇  where
+record Underlying-Type {𝓤} {𝓥} (X : 𝓤 ̇ ) (Y : 𝓥 ̇) : 𝓤 ⊔ 𝓥 ⁺ ̇ where
  field
-  ⟨_⟩ : X → 𝓥 ̇
+  ⟨_⟩ : X → Y
 
 open Underlying-Type {{...}} public
 
diff --git a/source/NotionsOfDecidability/Decidable.lagda b/source/NotionsOfDecidability/Decidable.lagda
index a3c2c7474..c180817fa 100644
--- a/source/NotionsOfDecidability/Decidable.lagda
+++ b/source/NotionsOfDecidability/Decidable.lagda
@@ -18,22 +18,33 @@ open import UF.Logic
 ¬¬-elim (inl a) f = a
 ¬¬-elim (inr g) f = 𝟘-elim(f g)
 
-map-is-decidable : {A : 𝓤 ̇ } {B : 𝓥 ̇ } → (A → B) → (B → A) → is-decidable A → is-decidable B
-map-is-decidable f g (inl x) = inl (f x)
-map-is-decidable f g (inr h) = inr (λ y → h (g y))
+map-decidable : {A : 𝓤 ̇ } {B : 𝓥 ̇ }
+              → (A → B)
+              → (B → A)
+              → is-decidable A
+              → is-decidable B
+map-decidable f g (inl x) = inl (f x)
+map-decidable f g (inr h) = inr (λ y → h (g y))
 
-map-is-decidable-↔ : {A : 𝓤 ̇ } {B : 𝓥 ̇ } → (A ↔ B) → (is-decidable A ↔ is-decidable B)
-map-is-decidable-↔ (f , g) = map-is-decidable f g , map-is-decidable g f
+map-decidable-↔ : {A : 𝓤 ̇ } {B : 𝓥 ̇ }
+                → (A ↔ B)
+                → (is-decidable A ↔ is-decidable B)
+map-decidable-↔ (f , g) = map-decidable f g ,
+                          map-decidable g f
 
 decidability-is-closed-under-≃ : {A : 𝓤 ̇ } {B : 𝓥 ̇ }
                                → (A ≃ B)
                                → is-decidable A
                                → is-decidable B
-decidability-is-closed-under-≃ (f , e) = map-is-decidable f (inverse f e)
+decidability-is-closed-under-≃ (f , e) = map-decidable f (inverse f e)
 
-map-is-decidable' : {A : 𝓤 ̇ } {B : 𝓥 ̇ } → (A → ¬ B) → (¬ A → B) → is-decidable A → is-decidable B
-map-is-decidable' f g (inl x) = inr (f x)
-map-is-decidable' f g (inr h) = inl (g h)
+map-decidable' : {A : 𝓤 ̇ } {B : 𝓥 ̇ }
+               → (A → ¬ B)
+               → (¬ A → B)
+               → is-decidable A
+               → is-decidable B
+map-decidable' f g (inl x) = inr (f x)
+map-decidable' f g (inr h) = inl (g h)
 
 empty-is-decidable : {X : 𝓤 ̇ } → is-empty X → is-decidable X
 empty-is-decidable = inr
@@ -161,8 +172,12 @@ which-of : {A : 𝓤 ̇ } {B : 𝓥 ̇ }
          → A + B
          → Σ b ꞉ 𝟚 , (b ＝ ₀ → A)
                    × (b ＝ ₁ → B)
-which-of (inl a) = ₀ , (λ (r : ₀ ＝ ₀) → a) , λ (p : ₀ ＝ ₁) → 𝟘-elim (zero-is-not-one p)
-which-of (inr b) = ₁ , (λ (p : ₁ ＝ ₀) → 𝟘-elim (zero-is-not-one (p ⁻¹))) , (λ (r : ₁ ＝ ₁) → b)
+which-of (inl a) = ₀ ,
+                   (λ (r : ₀ ＝ ₀) → a) ,
+                   (λ (p : ₀ ＝ ₁) → 𝟘-elim (zero-is-not-one p))
+which-of (inr b) = ₁ ,
+                   (λ (p : ₁ ＝ ₀) → 𝟘-elim (zero-is-not-one (p ⁻¹))) ,
+                   (λ (r : ₁ ＝ ₁) → b)
 
 \end{code}
 
@@ -176,17 +191,6 @@ boolean-value : {A : 𝓤 ̇ }
                         × (b ＝ ₁ → ¬ A)
 boolean-value = which-of
 
-\end{code}
-
-Notice that this b is unique (Agda exercise) and that the converse
-also holds. In classical mathematics it is posited that all
-propositions have binary truth values, irrespective of whether they
-have BHK-style witnesses. And this is precisely the role of the
-principle of excluded middle in classical mathematics.  The following
-requires choice, which holds in BHK-style constructive mathematics:
-
-\begin{code}
-
 module _ {X : 𝓤 ̇ } {A₀ : X → 𝓥 ̇ } {A₁ : X → 𝓦 ̇ }
          (h : (x : X) → A₀ x + A₁ x)
        where
@@ -195,7 +199,8 @@ module _ {X : 𝓤 ̇ } {A₀ : X → 𝓥 ̇ } {A₁ : X → 𝓦 ̇ }
                                       × (p x ＝ ₁ → A₁ x))
  indicator = (λ x → pr₁(lemma₁ x)) , (λ x → pr₂(lemma₁ x))
   where
-   lemma₀ : (x : X) → (A₀ x + A₁ x) → Σ b ꞉ 𝟚 , (b ＝ ₀ → A₀ x) × (b ＝ ₁ → A₁ x)
+   lemma₀ : (x : X) → (A₀ x + A₁ x) → Σ b ꞉ 𝟚 , (b ＝ ₀ → A₀ x)
+                                              × (b ＝ ₁ → A₁ x)
    lemma₀ x = which-of
 
    lemma₁ : (x : X) → Σ b ꞉ 𝟚 , (b ＝ ₀ → A₀ x) × (b ＝ ₁ → A₁ x)
@@ -204,11 +209,58 @@ module _ {X : 𝓤 ̇ } {A₀ : X → 𝓥 ̇ } {A₁ : X → 𝓦 ̇ }
  indicator-map : X → 𝟚
  indicator-map = pr₁ indicator
 
- indicator₀ : (x : X) → indicator-map x ＝ ₀ → A₀ x
- indicator₀ x = pr₁ (pr₂ indicator x)
+ indicator-property : (x : X) → (indicator-map x ＝ ₀ → A₀ x)
+                              × (indicator-map x ＝ ₁ → A₁ x)
+ indicator-property = pr₂ indicator
+
+ indicator-property₀ : (x : X) → indicator-map x ＝ ₀ → A₀ x
+ indicator-property₀ x = pr₁ (indicator-property x)
+
+ indicator-property₁ : (x : X) → indicator-map x ＝ ₁ → A₁ x
+ indicator-property₁ x = pr₂ (indicator-property x)
+
+module _ {X : 𝓤 ̇ } (A : X → 𝓥 ̇ )
+         (δ : (x : X) → A x + ¬ A x)
+       where
+
+ private
+  f : (x : X) → is-decidable (A x) → 𝟚
+  f x (inl a) = ₀
+  f x (inr ν) = ₁
+
+  f₀ : (x : X) (d : is-decidable (A x)) → f x d ＝ ₀ → A x
+  f₀ x (inl a) e = a
+  f₀ x (inr ν) e = 𝟘-elim (one-is-not-zero e)
 
- indicator₁ : (x : X) → indicator-map x ＝ ₁ → A₁ x
- indicator₁ x = pr₂ (pr₂ indicator x)
+  f₁ : (x : X) (d : is-decidable (A x)) → f x d ＝ ₁ → ¬ A x
+  f₁ x (inl a) e = 𝟘-elim (zero-is-not-one e)
+  f₁ x (inr ν) e = ν
+
+  f₀-back : (x : X) (d : is-decidable (A x)) → A x → f x d ＝ ₀
+  f₀-back x (inl a) a' = refl
+  f₀-back x (inr ν) a' = 𝟘-elim (ν a')
+
+  f₁-back : (x : X) (d : is-decidable (A x)) → ¬ A x → f x d ＝ ₁
+  f₁-back x (inl a) ν' = 𝟘-elim (ν' a)
+  f₁-back x (inr ν) ν' = refl
+
+  χ : X → 𝟚
+  χ x = f x (δ x)
+
+ characteristic-map : X → 𝟚
+ characteristic-map = χ
+
+ characteristic-map-property₀ : (x : X) → χ x ＝ ₀ → A x
+ characteristic-map-property₀ x = f₀ x (δ x)
+
+ characteristic-map-property₁ : (x : X) → χ x ＝ ₁ → ¬ A x
+ characteristic-map-property₁ x = f₁ x (δ x)
+
+ characteristic-map-property₀-back : (x : X) → A x → χ x ＝ ₀
+ characteristic-map-property₀-back x = f₀-back x (δ x)
+
+ characteristic-map-property₁-back : (x : X) → ¬ A x → χ x ＝ ₁
+ characteristic-map-property₁-back x = f₁-back x (δ x)
 
 \end{code}
 
@@ -247,4 +299,90 @@ all-types-are-¬¬-decidable X h = claim₂ claim₁
 ¬¬-stable-if-decidable X (inl  x) = λ _ → x
 ¬¬-stable-if-decidable X (inr nx) = λ h → 𝟘-elim (h nx)
 
-\end{code}
\ No newline at end of file
+\end{code}
+
+Added by Martin Escardo 17th September 2024. The propositional
+truncation of a decidable type can be constructed with no assumptions
+and it has split support.
+
+\begin{code}
+
+∥_∥⟨_⟩ : (X : 𝓤 ̇) → is-decidable X → 𝓤₀ ̇
+∥ X ∥⟨ inl x ⟩ = 𝟙
+∥ X ∥⟨ inr ν ⟩ = 𝟘
+
+∥∥⟨⟩-is-prop : {X : 𝓤 ̇ } (δ : is-decidable X) → is-prop ∥ X ∥⟨ δ ⟩
+∥∥⟨⟩-is-prop (inl x) = 𝟙-is-prop
+∥∥⟨⟩-is-prop (inr ν) = 𝟘-is-prop
+
+∥∥⟨⟩-is-decidable : {X : 𝓤 ̇ } (δ : is-decidable X) → is-decidable ∥ X ∥⟨ δ ⟩
+∥∥⟨⟩-is-decidable (inl x) = 𝟙-is-decidable
+∥∥⟨⟩-is-decidable (inr ν) = 𝟘-is-decidable
+
+∣_∣⟨_⟩ : {X : 𝓤 ̇ } → X → (δ : is-decidable X) → ∥ X ∥⟨ δ ⟩
+∣ x ∣⟨ inl _ ⟩ = ⋆
+∣ x ∣⟨ inr ν ⟩ = ν x
+
+\end{code}
+
+Notice that induction principle doesn't require the family A to be
+prop-valued.
+
+\begin{code}
+
+∥∥⟨⟩-induction : {X : 𝓤 ̇ } (δ : is-decidable X)
+                 (A : ∥ X ∥⟨ δ ⟩ → 𝓥 ̇ )
+               → ((x : X) → A ∣ x ∣⟨ δ ⟩)
+               → (s : ∥ X ∥⟨ δ ⟩) → A s
+∥∥⟨⟩-induction (inl x) A f ⋆ = f x
+∥∥⟨⟩-induction (inr ν) A f s = 𝟘-elim s
+
+\end{code}
+
+But the induction equation does.
+
+\begin{code}
+
+∥∥⟨⟩-induction-equation : {X : 𝓤 ̇ }
+                          (δ : is-decidable X)
+                          (A : ∥ X ∥⟨ δ ⟩ → 𝓥 ̇ )
+                        → ((s : ∥ X ∥⟨ δ ⟩) → is-prop (A s))
+                        → (f : (x : X) → A ∣ x ∣⟨ δ ⟩)
+                          (x : X)
+                        → ∥∥⟨⟩-induction δ A f ∣ x ∣⟨ δ ⟩ ＝ f x
+∥∥⟨⟩-induction-equation (inl x) A A-is-prop f x' = A-is-prop ⋆ (f x) (f x')
+∥∥⟨⟩-induction-equation (inr ν) A A-is-prop f x  = 𝟘-elim (ν x)
+
+∥∥⟨⟩-rec : {X : 𝓤 ̇ } (δ : is-decidable X) {A : 𝓥 ̇ }
+         → (X → A) → ∥ X ∥⟨ δ ⟩ → A
+∥∥⟨⟩-rec δ {A} = ∥∥⟨⟩-induction δ (λ _ → A)
+
+∣∣⟨⟩-exit : {X : 𝓤 ̇} (δ : is-decidable X) → ∥ X ∥⟨ δ ⟩ → X
+∣∣⟨⟩-exit δ = ∥∥⟨⟩-rec δ id
+
+∣∣⟨⟩-exit-is-section : {X : 𝓤 ̇} (δ : is-decidable X)
+                     → (s : ∥ X ∥⟨ δ ⟩) → ∣ ∣∣⟨⟩-exit δ s ∣⟨ δ ⟩ ＝ s
+∣∣⟨⟩-exit-is-section (inl x) ⋆ = refl
+∣∣⟨⟩-exit-is-section (inr ν) s = 𝟘-elim s
+
+infix 0 ∥_∥⟨_⟩
+infix 0 ∣_∣⟨_⟩
+
+module propositional-truncation-of-decidable-type
+        (pt : propositional-truncations-exist)
+       where
+
+ open propositional-truncations-exist pt public
+
+ module _ {X : 𝓤 ̇ } (δ : is-decidable X) where
+
+  ∥∥⟨⟩-to-∥∥ : ∥ X ∥⟨ δ ⟩ → ∥ X ∥
+  ∥∥⟨⟩-to-∥∥ = ∥∥⟨⟩-rec δ ∣_∣
+
+  ∥∥-to-∥∥⟨⟩ : ∥ X ∥ → ∥ X ∥⟨ δ ⟩
+  ∥∥-to-∥∥⟨⟩ = ∥∥-rec (∥∥⟨⟩-is-prop δ) ∣_∣⟨ δ ⟩
+
+  decidable-types-have-split-support : ∥ X ∥ → X
+  decidable-types-have-split-support s = ∣∣⟨⟩-exit δ (∥∥-to-∥∥⟨⟩ s)
+
+\end{code}
diff --git a/source/NotionsOfDecidability/DecidableClassifier.lagda b/source/NotionsOfDecidability/DecidableClassifier.lagda
index 92d7a5190..f8ff78deb 100644
--- a/source/NotionsOfDecidability/DecidableClassifier.lagda
+++ b/source/NotionsOfDecidability/DecidableClassifier.lagda
@@ -15,7 +15,6 @@ module NotionsOfDecidability.DecidableClassifier where
 
 open import MLTT.Spartan
 
-open import MLTT.Plus-Properties
 open import MLTT.Two-Properties
 
 open import UF.DiscreteAndSeparated
@@ -29,7 +28,6 @@ open import UF.Subsingletons-FunExt
 open import UF.SubtypeClassifier
 
 open import NotionsOfDecidability.Decidable
-open import NotionsOfDecidability.Complemented
 
 boolean-value' : {A : 𝓤 ̇ }
                → is-decidable A
diff --git a/source/NotionsOfDecidability/QuasiDecidable.lagda b/source/NotionsOfDecidability/QuasiDecidable.lagda
index 618de7b51..823757be4 100644
--- a/source/NotionsOfDecidability/QuasiDecidable.lagda
+++ b/source/NotionsOfDecidability/QuasiDecidable.lagda
@@ -238,7 +238,6 @@ open import UF.Yoneda
 open import UF.Embeddings
 open import UF.Powerset
 
-open import NotionsOfDecidability.Decidable
 open import Dominance.Definition
 
 \end{code}
@@ -869,7 +868,6 @@ propositional resizing is available:
 
 \begin{code}
 
-open import UF.Size
 
 module quasidecidability-construction-from-resizing
         (𝓣 𝓚 : Universe)
diff --git a/source/NotionsOfDecidability/SemiDecidable.lagda b/source/NotionsOfDecidability/SemiDecidable.lagda
index 71d532e3b..10191218a 100644
--- a/source/NotionsOfDecidability/SemiDecidable.lagda
+++ b/source/NotionsOfDecidability/SemiDecidable.lagda
@@ -385,7 +385,7 @@ instance
  ι {{canonical-map-Ω¬¬-to-Ω}} = Ω¬¬-to-Ω
 
 Ωˢᵈ : (𝓤 : Universe) → 𝓤 ⁺ ̇
-Ωˢᵈ 𝓤 = Σ X ꞉ 𝓤 ̇  , is-semidecidable X
+Ωˢᵈ 𝓤 = Σ X ꞉ 𝓤 ̇ , is-semidecidable X
 
 Ωˢᵈ-to-Ω : Ωˢᵈ 𝓤 → Ω 𝓤
 Ωˢᵈ-to-Ω (X , σ) = (X , prop-if-semidecidable σ)
diff --git a/source/OrderedTypes/DeltaCompletePoset.lagda b/source/OrderedTypes/DeltaCompletePoset.lagda
index d42e97194..ab74fd4dc 100644
--- a/source/OrderedTypes/DeltaCompletePoset.lagda
+++ b/source/OrderedTypes/DeltaCompletePoset.lagda
@@ -11,23 +11,9 @@ URL: https://arxiv.org/abs/2301.12405
 
 {-# OPTIONS --safe --without-K --exact-split #-}
 
-open import MLTT.Spartan
-open import MLTT.Two-Properties
 open import UF.FunExt
 open import UF.PropTrunc
-open import UF.Logic
 open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
-open import UF.SubtypeClassifier
-open import UF.Size
-open import UF.Equiv
-open import UF.Retracts
-open import UF.Subsingletons-FunExt
-open import UF.NotNotStablePropositions
-open import UF.Embeddings
-open import UF.Sets
-open import UF.ClassicalLogic
-open import Slice.Family
 
 module OrderedTypes.DeltaCompletePoset
  (pt : propositional-truncations-exist)
@@ -35,8 +21,23 @@ module OrderedTypes.DeltaCompletePoset
  (pe : Prop-Ext)
   where
 
+open import MLTT.Spartan
+open import MLTT.Two-Properties
+
+open import UF.ClassicalLogic
+open import UF.Embeddings
+open import UF.Equiv
+open import UF.Logic
+open import UF.NotNotStablePropositions
+open import UF.Retracts
+open import UF.Size
+open import UF.Subsingletons-FunExt
+open import UF.SubtypeClassifier
+
 open import Locales.Frame pt fe hiding (𝟚; ₀; ₁)
 open import OrderedTypes.TwoElementPoset pt fe
+open import Slice.Family
+
 open AllCombinators pt fe
 
 module δ-complete-poset {𝓤 𝓦 : Universe} (𝓥 : Universe) (A : Poset 𝓤 𝓦) where
@@ -206,26 +207,28 @@ We now show that the two element poset is δ complete only if WEM holds.
 2-is-δ-complete-gives-WEM : {𝓥 : Universe}
                           → δ-complete-poset.is-δ-complete {𝓤₀} {𝓤₀} 𝓥 2-Poset
                           → WEM 𝓥
-2-is-δ-complete-gives-WEM {𝓥} i P P-is-prop = wem
+2-is-δ-complete-gives-WEM {𝓥} i = WEM'-gives-WEM fe wem'
  where
   open Joins (rel-syntax 2-Poset)
   open δ-complete-poset 𝓥 2-Poset
   open non-trivial-posets 2-Poset
 
-  sup-from-δ-completeness : Σ s ꞉ ∣ 2-Poset ∣ₚ ,
-                          (s is-lub-of (δ-fam ₀ ₁ (P , P-is-prop))) holds
-  sup-from-δ-completeness = i ₀ ₁ ⋆ (P , P-is-prop)
+  module _ (P : 𝓥 ̇ ) (P-is-prop : is-prop P) where
 
-  sup-gives-wem : Σ s ꞉ ∣ 2-Poset ∣ₚ ,
+   sup-from-δ-completeness : Σ s ꞉ ∣ 2-Poset ∣ₚ ,
                            (s is-lub-of (δ-fam ₀ ₁ (P , P-is-prop))) holds
-                         → ¬ P + ¬ (¬ P)
-  sup-gives-wem (₀ , sup) =
-    inl (x-is-lub-gives-not-P 𝓥 2-is-non-trivial (P , P-is-prop) sup)
-  sup-gives-wem (₁ , sup) =
-    inr (y-is-lub-gives-not-not-P 𝓥 2-is-non-trivial (P , P-is-prop) sup)
-
-  wem : ¬ P + ¬ (¬ P)
-  wem = sup-gives-wem sup-from-δ-completeness
+   sup-from-δ-completeness = i ₀ ₁ ⋆ (P , P-is-prop)
+
+   sup-gives-wem : Σ s ꞉ ∣ 2-Poset ∣ₚ ,
+                            (s is-lub-of (δ-fam ₀ ₁ (P , P-is-prop))) holds
+                          → ¬ P + ¬ (¬ P)
+   sup-gives-wem (₀ , sup) =
+     inl (x-is-lub-gives-not-P 𝓥 2-is-non-trivial (P , P-is-prop) sup)
+   sup-gives-wem (₁ , sup) =
+     inr (y-is-lub-gives-not-not-P 𝓥 2-is-non-trivial (P , P-is-prop) sup)
+
+   wem' : ¬ P + ¬ (¬ P)
+   wem' = sup-gives-wem sup-from-δ-completeness
 
 \end{code}
 
diff --git a/source/OrderedTypes/FreeJoinSemiLattice.lagda b/source/OrderedTypes/FreeJoinSemiLattice.lagda
index 9459badcc..089a46d45 100644
--- a/source/OrderedTypes/FreeJoinSemiLattice.lagda
+++ b/source/OrderedTypes/FreeJoinSemiLattice.lagda
@@ -20,6 +20,7 @@ open import Fin.ArithmeticViaEquivalence
 open import Fin.Kuratowski pt
 open import Fin.Type
 open import MLTT.Spartan
+open import Notation.UnderlyingType
 open import OrderedTypes.JoinSemiLattices
 open import UF.Base
 open import UF.Equiv
diff --git a/source/OrderedTypes/FreeSupLattice.lagda b/source/OrderedTypes/FreeSupLattice.lagda
index 087dfc62c..a082f0ea6 100644
--- a/source/OrderedTypes/FreeSupLattice.lagda
+++ b/source/OrderedTypes/FreeSupLattice.lagda
@@ -13,7 +13,6 @@ open import UF.Lower-FunExt
 open import UF.Powerset
 open import UF.PropTrunc
 open import UF.Sets
-open import UF.SubtypeClassifier-Properties
 open import UF.Subsingletons
 open import UF.Subsingletons-FunExt
 
diff --git a/source/OrderedTypes/PredicativeLFP.lagda b/source/OrderedTypes/PredicativeLFP.lagda
index 705d6eae1..214516605 100644
--- a/source/OrderedTypes/PredicativeLFP.lagda
+++ b/source/OrderedTypes/PredicativeLFP.lagda
@@ -1,4 +1,4 @@
-Ian Ray 01/09/2023 -- edited 09/04/2024.
+Ian Ray 1 September 2023 -- edited 9 April 2024
 
 We formalize Curi's notion of abstract inductive definition (in CZF) within
 the context of a sup-lattice L with small basis B (and β : B → L). An abstract
@@ -40,12 +40,9 @@ open import UF.Equiv
 open import UF.Equiv-FunExt
 open import UF.EquivalenceExamples
 open import UF.FunExt
-open import UF.Hedberg
 open import UF.Logic
 open import UF.Powerset-MultiUniverse
 open import UF.PropTrunc
-open import UF.Retracts
-open import UF.Sets
 open import UF.Subsingletons
 open import UF.Subsingletons-FunExt
 open import UF.SubtypeClassifier
diff --git a/source/OrderedTypes/SupLattice-SmallBasis.lagda b/source/OrderedTypes/SupLattice-SmallBasis.lagda
index 505b78448..2f0bea635 100644
--- a/source/OrderedTypes/SupLattice-SmallBasis.lagda
+++ b/source/OrderedTypes/SupLattice-SmallBasis.lagda
@@ -22,21 +22,13 @@ for all x.
 
 open import MLTT.Spartan
 open import UF.Equiv
-open import UF.Equiv-FunExt
 open import UF.EquivalenceExamples
 open import UF.FunExt
-open import UF.Hedberg
 open import UF.Logic
-open import UF.Powerset-MultiUniverse
 open import UF.PropTrunc
-open import UF.Retracts
-open import UF.Sets
 open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 open import UF.SubtypeClassifier
 open import UF.Size
-open import UF.SmallnessProperties
-open import UF.UniverseEmbedding
 
 module OrderedTypes.SupLattice-SmallBasis
         (pt : propositional-truncations-exist)
@@ -45,7 +37,6 @@ module OrderedTypes.SupLattice-SmallBasis
 
 open import Locales.Frame pt fe hiding (⟨_⟩ ; join-of)
 open import Slice.Family
-open import UF.ImageAndSurjection pt
 open import OrderedTypes.SupLattice pt fe
 
 open AllCombinators pt fe
diff --git a/source/OrderedTypes/SupLattice.lagda b/source/OrderedTypes/SupLattice.lagda
index 7a1cab93d..70aec5567 100644
--- a/source/OrderedTypes/SupLattice.lagda
+++ b/source/OrderedTypes/SupLattice.lagda
@@ -2,7 +2,7 @@ Ian Ray, started: 2023-09-12 - updated: 2024-02-05.
 
 A Sup Lattice L is a set with a partial order ≤ that has suprema of 'small'
 types. We will use three universe parameters: 𝓤 for the carrier, 𝓦 for the
-order values and 𝓥 for the families which have suprema. 
+order values and 𝓥 for the families which have suprema.
 
 \begin{code}
 
@@ -10,8 +10,6 @@ order values and 𝓥 for the families which have suprema.
 
 open import MLTT.Spartan
 open import UF.Equiv
-open import UF.Equiv-FunExt
-open import UF.EquivalenceExamples
 open import UF.FunExt
 open import UF.Hedberg
 open import UF.Logic
@@ -19,12 +17,8 @@ open import UF.Powerset-MultiUniverse
 open import UF.PropTrunc
 open import UF.Retracts
 open import UF.Sets
-open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 open import UF.SubtypeClassifier
 open import UF.Size
-open import UF.SmallnessProperties
-open import UF.UniverseEmbedding
 
 module OrderedTypes.SupLattice
         (pt : propositional-truncations-exist)
@@ -40,7 +34,7 @@ open PropositionalTruncation pt
 
 \end{code}
 
-We commence by defining sup lattices. 
+We commence by defining sup lattices.
 
 \begin{code}
 
@@ -48,8 +42,8 @@ module _ (𝓤 𝓣 𝓥 : Universe) where
 
  sup-lattice-data : 𝓤  ̇ → 𝓤 ⊔ 𝓣 ⁺ ⊔ 𝓥 ⁺  ̇
  sup-lattice-data A = (A → A → Ω 𝓣) × (Fam 𝓥 A → A)
- 
- is-sup-lattice : {A : 𝓤  ̇} → sup-lattice-data A → 𝓤 ⊔ 𝓣 ⊔ 𝓥 ⁺  ̇  
+
+ is-sup-lattice : {A : 𝓤  ̇} → sup-lattice-data A → 𝓤 ⊔ 𝓣 ⊔ 𝓥 ⁺  ̇
  is-sup-lattice {A} (_≤_ , ⋁_) = is-partial-order A _≤_ × suprema
   where
    open Joins _≤_
@@ -88,7 +82,7 @@ partial-orderedness-of (A , (_≤_ , ⋁_) , order , is-lub-of) = order
 reflexivity-of : (L : Sup-Lattice 𝓤 𝓣 𝓥) → is-reflexive (order-of L) holds
 reflexivity-of L = pr₁ (pr₁ (partial-orderedness-of L))
 
-antisymmetry-of : (L : Sup-Lattice 𝓤 𝓣 𝓥) → is-antisymmetric (order-of L) 
+antisymmetry-of : (L : Sup-Lattice 𝓤 𝓣 𝓥) → is-antisymmetric (order-of L)
 antisymmetry-of L = pr₂ (partial-orderedness-of L)
 
 transitivity-of : (L : Sup-Lattice 𝓤 𝓣 𝓥) → is-transitive (order-of L) holds
@@ -145,7 +139,7 @@ module _ where
 \end{code}
 
 We now show that when one subset contains another the join of their total
-spaces are ordered as expected. 
+spaces are ordered as expected.
 
 \begin{code}
 
@@ -181,7 +175,7 @@ module _
         (m : T → ⟨ L ⟩)
         (T-is-small : T is 𝓥 small)
        where
- private 
+ private
   T' : 𝓥  ̇
   T' = (resized T) T-is-small
 
@@ -190,7 +184,7 @@ module _
 
   T'-to-T : T' → T
   T'-to-T = ⌜ T'-≃-T ⌝
- 
+
   T'-to-T-is-equiv : is-equiv T'-to-T
   T'-to-T-is-equiv = ⌜ T'-≃-T ⌝-is-equiv
 
@@ -223,7 +217,7 @@ module _
    I : (s is-an-upper-bound-of (T , m)) holds
    I t = II
     where
-     II : (m t ≤⟨ L ⟩ s) holds 
+     II : (m t ≤⟨ L ⟩ s) holds
      II = transport (λ - → (m - ≤⟨ L ⟩ s) holds)
                     (section-T'-to-T t)
                     (join-is-upper-bound-of L (T' , T'-inclusion) (T-to-T' t))
diff --git a/source/OrderedTypes/TwoElementPoset.lagda b/source/OrderedTypes/TwoElementPoset.lagda
index d1c191c7c..208c3b2cd 100644
--- a/source/OrderedTypes/TwoElementPoset.lagda
+++ b/source/OrderedTypes/TwoElementPoset.lagda
@@ -7,13 +7,10 @@ Constructing the two element poset.
 {-# OPTIONS --safe --without-K --exact-split #-}
 
 open import MLTT.Spartan
-open import MLTT.Two-Properties
 open import UF.FunExt
 open import UF.PropTrunc
-open import UF.Logic
 
 open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 open import UF.SubtypeClassifier
 
 module OrderedTypes.TwoElementPoset
diff --git a/source/OrderedTypes/ZornsLemma.lagda b/source/OrderedTypes/ZornsLemma.lagda
index 4b2554edb..040aec3f4 100644
--- a/source/OrderedTypes/ZornsLemma.lagda
+++ b/source/OrderedTypes/ZornsLemma.lagda
@@ -9,13 +9,11 @@ relevant definitions.
 
 open import MLTT.Spartan
 open import Ordinals.Equivalence
-open import Ordinals.Notions
 open import Ordinals.Type
 open import Ordinals.Underlying
 open import UF.Base
 open import UF.Choice
 open import UF.ClassicalLogic
-open import UF.DiscreteAndSeparated
 open import UF.Embeddings
 open import UF.Equiv
 open import UF.EquivalenceExamples
@@ -23,7 +21,6 @@ open import UF.FunExt
 open import UF.Logic
 open import UF.Powerset-MultiUniverse
 open import UF.PropTrunc
-open import UF.Sets
 open import UF.Size
 open import UF.Subsingletons
 open import UF.Subsingletons-FunExt
@@ -60,7 +57,6 @@ open UF.Choice.choice-functions pt pe' fe
 open UF.Logic.Existential pt
 open UF.Logic.Universal fe'
 open import OrderedTypes.Poset fe'
-open import Ordinals.Arithmetic fe
 open import Ordinals.WellOrderingTaboo fe' pe
 open inhabited-subsets pt
 
diff --git a/source/OrderedTypes/sigma-sup-lattice.lagda b/source/OrderedTypes/sigma-sup-lattice.lagda
index 9c934d74b..c8f1f7ee9 100644
--- a/source/OrderedTypes/sigma-sup-lattice.lagda
+++ b/source/OrderedTypes/sigma-sup-lattice.lagda
@@ -13,13 +13,10 @@ open import UF.Subsingletons
 
 module OrderedTypes.sigma-sup-lattice (fe : Fun-Ext) where
 
-open import UF.Base
-open import UF.Equiv hiding (_≅_)
 open import UF.Hedberg
 open import UF.SIP
 open import UF.Sets
 open import UF.Subsingletons-FunExt
-open import UF.Univalence
 
 σ-suplat-structure : 𝓤 ̇ → 𝓤 ̇
 σ-suplat-structure X = X × ((ℕ → X) → X)
diff --git a/source/Ordinals/ArithmeticProperties.lagda b/source/Ordinals/AdditionProperties.lagda
similarity index 86%
rename from source/Ordinals/ArithmeticProperties.lagda
rename to source/Ordinals/AdditionProperties.lagda
index da67f122a..b5910f962 100644
--- a/source/Ordinals/ArithmeticProperties.lagda
+++ b/source/Ordinals/AdditionProperties.lagda
@@ -8,7 +8,7 @@ Small additions by Tom de Jong in May 2024.
 
 open import UF.Univalence
 
-module Ordinals.ArithmeticProperties
+module Ordinals.AdditionProperties
        (ua : Univalence)
        where
 
@@ -34,6 +34,7 @@ private
 
 open import MLTT.Plus-Properties
 open import MLTT.Spartan
+open import MLTT.Sigma
 open import Notation.CanonicalMap
 open import Ordinals.Arithmetic fe
 open import Ordinals.ConvergentSequence ua
@@ -630,7 +631,7 @@ module _ {𝓤 : Universe} where
  open import UF.DiscreteAndSeparated
 
  ⊴-add-taboo : Ωₒ ⊴ (𝟙ₒ +ₒ Ωₒ) → WEM 𝓤
- ⊴-add-taboo (f , s) = V
+ ⊴-add-taboo (f , s) = VI
   where
    I : is-least (𝟙ₒ +ₒ Ωₒ) (inl ⋆)
    I (inl ⋆) u       l = l
@@ -655,6 +656,10 @@ module _ {𝓤 : Universe} where
                           (λ (u : ¬ P)
                                 → to-subtype-＝ (λ _ → being-prop-is-prop fe')
                                    (empty-types-are-＝-𝟘 fe' (pe 𝓤) u)⁻¹) ν))
+
+   VI : ∀ P → ¬ P + ¬¬ P
+   VI = WEM'-gives-WEM fe' V
+
 \end{code}
 
 Added 5th April 2022.
@@ -732,51 +737,55 @@ succ-not-necessarily-monotone : ((α β : Ordinal 𝓤)
                                       → α ⊴ β
                                       → (α +ₒ 𝟙ₒ) ⊴ (β +ₒ 𝟙ₒ))
                               → WEM 𝓤
-succ-not-necessarily-monotone {𝓤} ϕ P isp = II I
+succ-not-necessarily-monotone {𝓤} ϕ = XII
  where
-  α : Ordinal 𝓤
-  α = prop-ordinal P isp
+  module _ (P : 𝓤 ̇) (isp : is-prop P) where
+   α : Ordinal 𝓤
+   α = prop-ordinal P isp
 
-  I :  (α +ₒ 𝟙ₒ) ⊴ 𝟚ₒ
-  I = ϕ α 𝟙ₒ l
-   where
-    l : α ⊴ 𝟙ₒ
-    l = unique-to-𝟙 ,
-        (λ x y (l : y ≺⟨ 𝟙ₒ ⟩ ⋆) → 𝟘-elim l) ,
-        (λ x y l → l)
+   I :  (α +ₒ 𝟙ₒ) ⊴ 𝟚ₒ
+   I = ϕ α 𝟙ₒ l
+    where
+     l : α ⊴ 𝟙ₒ
+     l = unique-to-𝟙 ,
+         (λ x y (l : y ≺⟨ 𝟙ₒ ⟩ ⋆) → 𝟘-elim l) ,
+         (λ x y l → l)
 
-  II : type-of I → ¬ P + ¬¬ P
-  II (f , f-is-initial , f-is-order-preserving) = III (f (inr ⋆)) refl
-   where
-    III : (y : ⟨ 𝟚ₒ ⟩) → f (inr ⋆) ＝ y → ¬ P + ¬¬ P
-    III (inl ⋆) e = inl VII
-     where
-      IV : (p : P) → f (inl p) ≺⟨ 𝟚ₒ ⟩ f (inr ⋆)
-      IV p = f-is-order-preserving (inl p) (inr ⋆) ⋆
+   II : type-of I → ¬ P + ¬¬ P
+   II (f , f-is-initial , f-is-order-preserving) = III (f (inr ⋆)) refl
+    where
+     III : (y : ⟨ 𝟚ₒ ⟩) → f (inr ⋆) ＝ y → ¬ P + ¬¬ P
+     III (inl ⋆) e = inl VII
+      where
+       IV : (p : P) → f (inl p) ≺⟨ 𝟚ₒ ⟩ f (inr ⋆)
+       IV p = f-is-order-preserving (inl p) (inr ⋆) ⋆
 
-      V : (p : P) → f (inl p) ≺⟨ 𝟚ₒ ⟩ inl ⋆
-      V p = transport (λ - → f (inl p) ≺⟨ 𝟚ₒ ⟩ -) e (IV p)
+       V : (p : P) → f (inl p) ≺⟨ 𝟚ₒ ⟩ inl ⋆
+       V p = transport (λ - → f (inl p) ≺⟨ 𝟚ₒ ⟩ -) e (IV p)
 
-      VI : (z : ⟨ 𝟚ₒ ⟩) → ¬ (z ≺⟨ 𝟚ₒ ⟩ inl ⋆)
-      VI (inl ⋆) l = 𝟘-elim l
-      VI (inr ⋆) l = 𝟘-elim l
+       VI : (z : ⟨ 𝟚ₒ ⟩) → ¬ (z ≺⟨ 𝟚ₒ ⟩ inl ⋆)
+       VI (inl ⋆) l = 𝟘-elim l
+       VI (inr ⋆) l = 𝟘-elim l
 
-      VII : ¬ P
-      VII p = VI (f (inl p)) (V p)
-    III (inr ⋆) e = inr IX
-     where
-      VIII : Σ x' ꞉ ⟨ α +ₒ 𝟙ₒ ⟩ , (x' ≺⟨ α +ₒ 𝟙ₒ ⟩ inr ⋆) × (f x' ＝ inl ⋆)
-      VIII = f-is-initial (inr ⋆) (inl ⋆) (transport⁻¹ (λ - → inl ⋆ ≺⟨ 𝟚ₒ ⟩ -) e ⋆)
+       VII : ¬ P
+       VII p = VI (f (inl p)) (V p)
+     III (inr ⋆) e = inr IX
+      where
+       VIII : Σ x' ꞉ ⟨ α +ₒ 𝟙ₒ ⟩ , (x' ≺⟨ α +ₒ 𝟙ₒ ⟩ inr ⋆) × (f x' ＝ inl ⋆)
+       VIII = f-is-initial (inr ⋆) (inl ⋆) (transport⁻¹ (λ - → inl ⋆ ≺⟨ 𝟚ₒ ⟩ -) e ⋆)
 
-      IX : ¬¬ P
-      IX u = XI
-       where
-        X : ∀ x' → ¬ (x' ≺⟨ α +ₒ 𝟙ₒ ⟩ inr ⋆)
-        X (inl p) l = u p
-        X (inr ⋆) l = 𝟘-elim l
+       IX : ¬¬ P
+       IX u = XI
+        where
+         X : ∀ x' → ¬ (x' ≺⟨ α +ₒ 𝟙ₒ ⟩ inr ⋆)
+         X (inl p) l = u p
+         X (inr ⋆) l = 𝟘-elim l
+
+         XI : 𝟘
+         XI = X (pr₁ VIII) (pr₁ (pr₂ VIII))
 
-        XI : 𝟘
-        XI = X (pr₁ VIII) (pr₁ (pr₂ VIII))
+  XII : WEM 𝓤
+  XII = WEM'-gives-WEM fe' (λ P isp → II P isp (I P isp))
 
 \end{code}
 
@@ -930,7 +939,6 @@ also is not a successor ordinal unless LPO holds:
 \begin{code}
 
  open import CoNaturals.Type
- open import Notation.CanonicalMap
  open import Notation.Order
  open import Naturals.Order
 
@@ -1029,7 +1037,7 @@ also is not a successor ordinal unless LPO holds:
      VII : f ∞ ≺⟨ ω ⟩ f ∞
      VII = VI (f ∞) V
 
- open import Taboos.LPO fe
+ open import Taboos.LPO
 
  ℕ∞-successor-gives-LPO : (Σ α ꞉ Ordinal 𝓤₀ , (ℕ∞ₒ ＝ (α +ₒ 𝟙ₒ))) → LPO
  ℕ∞-successor-gives-LPO (α , p) = IV
@@ -1051,7 +1059,7 @@ also is not a successor ordinal unless LPO holds:
  open PropositionalTruncation pt
 
  ℕ∞-successor-gives-LPO' : (∃ α ꞉ Ordinal 𝓤₀ , (ℕ∞ₒ ＝ (α +ₒ 𝟙ₒ))) → LPO
- ℕ∞-successor-gives-LPO' = ∥∥-rec LPO-is-prop ℕ∞-successor-gives-LPO
+ ℕ∞-successor-gives-LPO' = ∥∥-rec (LPO-is-prop fe') ℕ∞-successor-gives-LPO
 
  LPO-gives-ℕ∞-successor : LPO → (Σ α ꞉ Ordinal 𝓤₀ , (ℕ∞ₒ ＝ (α +ₒ 𝟙ₒ)))
  LPO-gives-ℕ∞-successor lpo = ω , ℕ∞-is-successor₃ lpo
@@ -1062,7 +1070,7 @@ Therefore, constructively, it is not necessarily the case that every
 ordinal is either a successor or a limit.
 
 TODO (1st June 2023). A classically equivalently definition of limit
-ordinal α is that there is some β < α, and for evert β < α there is γ
+ordinal α is that there is some β < α, and for every β < α there is γ
 with β < γ < α. We have that ℕ∞ is a limit ordinal in this sense.
 
 Added 4th May 2022.
@@ -1118,18 +1126,89 @@ alternative-plus τ₀ τ₁ = eqtoidₒ (ua _) fe' _ _ (alternative-plusₒ τ
 
 \end{code}
 
-Added 24th May 2024 by Tom de Jong.
+Added 13 November 2023 by Fredrik Nordvall Forsberg.
 
-Every ordinal is the supremum of the successors of its initial segments.
+Addition satisfies the expected recursive equations (which classically define
+addition): zero is the neutral element (this is 𝟘₀-right-neutral above), addition
+commutes with successors and addition preserves inhabited suprema.
+
+Note that (the index of) the supremum indeed has to be inhabited, because
+preserving the empty supremum would give the false equation
+  α +ₒ 𝟘 ＝ 𝟘
+for any ordinal α.
 
 \begin{code}
 
++ₒ-commutes-with-successor : (α β : Ordinal 𝓤) → α +ₒ (β +ₒ 𝟙ₒ) ＝ (α +ₒ β) +ₒ 𝟙ₒ
++ₒ-commutes-with-successor α β = (+ₒ-assoc α β 𝟙ₒ) ⁻¹
+
 module _ (pt : propositional-truncations-exist)
          (sr : Set-Replacement pt)
        where
 
  open import Ordinals.OrdinalOfOrdinalsSuprema ua
  open suprema pt sr
+ open PropositionalTruncation pt
+
+ +ₒ-preserves-inhabited-suprema : (α : Ordinal 𝓤) {I : 𝓤 ̇ } (β : I → Ordinal 𝓤)
+                                → ∥ I ∥
+                                → α +ₒ sup β ＝ sup (λ i → α +ₒ β i)
+ +ₒ-preserves-inhabited-suprema α {I} β =
+  ∥∥-rec (the-type-of-ordinals-is-a-set (ua _) fe')
+         (λ i₀ → ⊴-antisym _ _ (≼-gives-⊴ _ _ (⦅1⦆ i₀)) ⦅2⦆)
+   where
+    ⦅2⦆ : sup (λ i → α +ₒ β i) ⊴ (α +ₒ sup β)
+    ⦅2⦆ = sup-is-lower-bound-of-upper-bounds (λ i → α +ₒ β i) (α +ₒ sup β) ⦅2⦆'
+     where
+      ⦅2⦆' : (i : I) → (α +ₒ β i) ⊴ (α +ₒ sup β)
+      ⦅2⦆' i = ≼-gives-⊴ (α +ₒ β i) (α +ₒ sup β)
+                (+ₒ-right-monotone α (β i) (sup β)
+                 (⊴-gives-≼ _ _ (sup-is-upper-bound β i)))
+
+    ⦅1⦆ : I → (α +ₒ sup β) ≼ sup (λ i → α +ₒ β i)
+    ⦅1⦆ i₀ _ (inl a , refl) =
+     transport (_⊲ sup (λ i → α +ₒ β i))
+               (+ₒ-↓-left a)
+               (⊲-⊴-gives-⊲ (α ↓ a) (α +ₒ β i₀) (sup (λ i → α +ₒ β i))
+                (inl a , +ₒ-↓-left a)
+                (sup-is-upper-bound (λ i → α +ₒ β i) i₀))
+    ⦅1⦆ i₀ _ (inr s , refl) =
+     transport (_⊲ sup (λ i → α +ₒ β i))
+               (+ₒ-↓-right s)
+               (∥∥-rec (⊲-is-prop-valued _ _) ⦅1⦆'
+                (initial-segment-of-sup-is-initial-segment-of-some-component
+                  β s))
+      where
+       ⦅1⦆' : Σ i ꞉ I , Σ b ꞉ ⟨ β i ⟩ , sup β ↓ s ＝ β i ↓ b
+            → (α +ₒ (sup β ↓ s)) ⊲ sup (λ i → α +ₒ β i)
+       ⦅1⦆' (i , b , p) =
+        transport⁻¹ (λ - → (α +ₒ -) ⊲ sup (λ j → α +ₒ β j)) p
+         (⊲-⊴-gives-⊲ (α +ₒ (β i ↓ b)) (α +ₒ β i) (sup (λ j → α +ₒ β j))
+          (inr b , +ₒ-↓-right b)
+          (sup-is-upper-bound (λ j → α +ₒ β j) i))
+
+\end{code}
+
+Constructively, these equations do not fully characterize ordinal addition, at
+least not as far as we know. If addition preserved *all* suprema, then,
+expressing the ordinal β as a supremum via the result given below, we would have
+the recursive equation
+  α +ₒ β ＝ α +ₒ sup (λ b → (B ↓ b) +ₒ 𝟙ₒ)
+         ＝ sup (λ b → α +ₒ ((B ↓ b) +ₒ 𝟙ₒ))
+         ＝ sup (λ b → (α +ₒ (B ↓ b)) +ₒ 𝟙ₒ)
+which would ensure that there is at most one operation satisfying the above
+equations for successors and suprema. The problem is that constructively we
+cannot, in general, make a case distinction on whether β is zero or not.
+
+In contrast, multiplication behaves differently and is unique characterized by
+similar equations since it does preserve all suprema, see
+MultiplicationProperties.
+
+
+Added 24th May 2024 by Tom de Jong.
+Every ordinal is the supremum of the successors of its initial segments.
+
+\begin{code}
 
  supremum-of-successors-of-initial-segments :
   (α : Ordinal 𝓤) → α ＝ sup (λ x → (α ↓ x) +ₒ 𝟙ₒ)
@@ -1173,4 +1252,4 @@ no-greatest-ordinal {𝓤} (α , α-greatest) = irrefl (OO 𝓤) α IV
   IV : α ⊲ α
   IV = transport (α ⊲_) III (successor-increasing α)
 
-\end{code}
\ No newline at end of file
+\end{code}
diff --git a/source/Ordinals/BuraliForti.lagda b/source/Ordinals/BuraliForti.lagda
index 6095333b9..be3dc04d9 100644
--- a/source/Ordinals/BuraliForti.lagda
+++ b/source/Ordinals/BuraliForti.lagda
@@ -126,11 +126,9 @@ module Ordinals.BuraliForti
        (ua : Univalence)
        where
 
-open import UF.Base
 open import UF.Subsingletons
 open import UF.Retracts
 open import UF.Equiv hiding (_≅_)
-open import UF.EquivalenceExamples
 open import UF.UniverseEmbedding
 open import UF.UA-FunExt
 open import UF.FunExt
@@ -536,7 +534,7 @@ Monoids:
 
 \begin{code}
 
- open import Ordinals.ArithmeticProperties ua
+ open import Ordinals.AdditionProperties ua
 
  monoid-structure : 𝓤 ̇ → 𝓤 ̇
  monoid-structure X = (X → X → X) × X
diff --git a/source/Ordinals/ConvergentSequence.lagda b/source/Ordinals/ConvergentSequence.lagda
index 8ebe59d10..84a1934ad 100644
--- a/source/Ordinals/ConvergentSequence.lagda
+++ b/source/Ordinals/ConvergentSequence.lagda
@@ -23,7 +23,7 @@ private
 
 open import MLTT.Spartan
 open import Notation.CanonicalMap
-open import Taboos.LPO fe
+open import Taboos.LPO
 open import Naturals.Order
 open import Ordinals.Arithmetic fe
 open import Ordinals.OrdinalOfOrdinals ua
diff --git a/source/Ordinals/CumulativeHierarchy-Addendum.lagda b/source/Ordinals/CumulativeHierarchy-Addendum.lagda
index 1fb3700cf..3f7076dca 100644
--- a/source/Ordinals/CumulativeHierarchy-Addendum.lagda
+++ b/source/Ordinals/CumulativeHierarchy-Addendum.lagda
@@ -85,7 +85,6 @@ open import UF.Equiv
 open import UF.EquivalenceExamples
 open import UF.FunExt
 open import UF.ImageAndSurjection pt
-open import UF.Sets
 open import UF.Size
 open import UF.SubtypeClassifier
 open import UF.Subsingletons
diff --git a/source/Ordinals/CumulativeHierarchy.lagda b/source/Ordinals/CumulativeHierarchy.lagda
index c67224c7a..43b252b26 100644
--- a/source/Ordinals/CumulativeHierarchy.lagda
+++ b/source/Ordinals/CumulativeHierarchy.lagda
@@ -400,7 +400,7 @@ an arbitrary well founded order) also appears at the bottom of [Acz77, p. 743].
 \begin{code}
 
  open import Ordinals.Arithmetic fe'
- open import Ordinals.ArithmeticProperties ua
+ open import Ordinals.AdditionProperties ua
  open import Ordinals.OrdinalOfOrdinalsSuprema ua
 
  open import Quotient.Type hiding (is-prop-valued)
diff --git a/source/Ordinals/Equivalence.lagda b/source/Ordinals/Equivalence.lagda
index 72853f8f4..cee2a632e 100644
--- a/source/Ordinals/Equivalence.lagda
+++ b/source/Ordinals/Equivalence.lagda
@@ -22,7 +22,6 @@ open import UF.PreUnivalence
 open import UF.Sets
 open import UF.Size
 open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 open import UF.Univalence
 open import UF.Yoneda
 
diff --git a/source/Ordinals/Fin.lagda b/source/Ordinals/Fin.lagda
index 52859607d..331425026 100644
--- a/source/Ordinals/Fin.lagda
+++ b/source/Ordinals/Fin.lagda
@@ -15,7 +15,6 @@ open import MLTT.Spartan
 open import Notation.Order
 open import Ordinals.Type
 open import Ordinals.Notions
-open import UF.Embeddings
 
 import Naturals.Order as ℕ
 
diff --git a/source/Ordinals/Indecomposable.lagda b/source/Ordinals/Indecomposable.lagda
index 2b28ece21..5f75ee586 100644
--- a/source/Ordinals/Indecomposable.lagda
+++ b/source/Ordinals/Indecomposable.lagda
@@ -15,6 +15,5 @@ This file has been moved to the following location:
 
 module Ordinals.Indecomposable where
 
-open import Taboos.Decomposability using ()
 
 \end{code}
diff --git a/source/Ordinals/Injectivity.lagda b/source/Ordinals/Injectivity.lagda
index 9df8f4459..7fd8e8f42 100644
--- a/source/Ordinals/Injectivity.lagda
+++ b/source/Ordinals/Injectivity.lagda
@@ -130,13 +130,11 @@ Added 11th May 2022.
 
 \begin{code}
 
-open import UF.Univalence
 
 module ordinals-injectivity-order (ua : Univalence) where
 
  open import Ordinals.OrdinalOfOrdinals ua
  open import UF.UA-FunExt
- open import UF.Subsingletons
 
  fe : FunExt
  fe = Univalence-gives-FunExt ua
@@ -228,7 +226,6 @@ module topped-ordinals-injectivity-order (ua : Univalence) where
 
  open import Ordinals.ToppedType fe
  open import Ordinals.OrdinalOfOrdinals ua
- open import UF.Subsingletons
 
  open topped-ordinals-injectivity fe
 
diff --git a/source/Ordinals/LexicographicOrder.lagda b/source/Ordinals/LexicographicOrder.lagda
index 09181a9d8..7acf7f089 100644
--- a/source/Ordinals/LexicographicOrder.lagda
+++ b/source/Ordinals/LexicographicOrder.lagda
@@ -16,8 +16,6 @@ even on (Σ x ꞉ X , Y x) if Y and S depend on X.
 module Ordinals.LexicographicOrder where
 
 open import MLTT.Spartan
-open import UF.Base
-open import UF.Subsingletons
 
 lex-order : ∀ {𝓣} {X : 𝓤 ̇ } {Y : X → 𝓥 ̇ }
           →  (X → X → 𝓦 ̇ )
diff --git a/source/Ordinals/Maps.lagda b/source/Ordinals/Maps.lagda
index 530cea4f1..84cc9dd92 100644
--- a/source/Ordinals/Maps.lagda
+++ b/source/Ordinals/Maps.lagda
@@ -6,26 +6,19 @@ Various maps of ordinals, including equivalences.
 
 {-# OPTIONS --safe --without-K #-}
 
-open import UF.Univalence
 
 module Ordinals.Maps where
 
 open import MLTT.Spartan
-open import Notation.CanonicalMap
 open import Ordinals.Notions
 open import Ordinals.Type
 open import Ordinals.Underlying
 open import UF.Base
 open import UF.Embeddings
 open import UF.Equiv
-open import UF.Equiv-FunExt
-open import UF.EquivalenceExamples
 open import UF.FunExt
-open import UF.Size
 open import UF.Subsingletons
 open import UF.Subsingletons-FunExt
-open import UF.UA-FunExt
-open import UF.Yoneda
 
 \end{code}
 
diff --git a/source/Ordinals/MultiplicationProperties.lagda b/source/Ordinals/MultiplicationProperties.lagda
new file mode 100644
index 000000000..a5860892f
--- /dev/null
+++ b/source/Ordinals/MultiplicationProperties.lagda
@@ -0,0 +1,576 @@
+Fredrik Nordvall Forsberg, 13 November 2023.
+In collaboration with Tom de Jong, Nicolai Kraus and Chuangjie Xu.
+
+Minor updates 9 and 11 September 2024.
+
+We prove several properties of ordinal multiplication, including that it
+preserves suprema of ordinals and that it enjoys a left-cancellation property.
+
+\begin{code}
+
+{-# OPTIONS --safe --without-K --lossy-unification #-}
+
+open import UF.Univalence
+
+module Ordinals.MultiplicationProperties
+       (ua : Univalence)
+       where
+
+open import UF.Base
+open import UF.Equiv
+open import UF.FunExt
+open import UF.Subsingletons
+open import UF.Subsingletons-FunExt
+open import UF.UA-FunExt
+
+private
+ fe : FunExt
+ fe = Univalence-gives-FunExt ua
+
+ fe' : Fun-Ext
+ fe' {𝓤} {𝓥} = fe 𝓤 𝓥
+
+open import MLTT.Spartan
+
+open import Ordinals.Arithmetic fe
+open import Ordinals.Equivalence
+open import Ordinals.Maps
+open import Ordinals.OrdinalOfOrdinals ua
+open import Ordinals.Type
+open import Ordinals.Underlying
+open import Ordinals.AdditionProperties ua
+
+×ₒ-𝟘ₒ-right : (α : Ordinal 𝓤) → α ×ₒ 𝟘ₒ {𝓥} ＝ 𝟘ₒ
+×ₒ-𝟘ₒ-right α = ⊴-antisym _ _
+                 (to-⊴ (α ×ₒ 𝟘ₒ) 𝟘ₒ (λ (a , b) → 𝟘-elim b))
+                 (𝟘ₒ-least-⊴ (α ×ₒ 𝟘ₒ))
+
+×ₒ-𝟘ₒ-left : (α : Ordinal 𝓤) → 𝟘ₒ {𝓥} ×ₒ α ＝ 𝟘ₒ
+×ₒ-𝟘ₒ-left α = ⊴-antisym _ _
+                (to-⊴ (𝟘ₒ ×ₒ α) 𝟘ₒ (λ (b , a) → 𝟘-elim b))
+                (𝟘ₒ-least-⊴ (𝟘ₒ ×ₒ α))
+
+𝟙ₒ-left-neutral-×ₒ : (α : Ordinal 𝓤) → 𝟙ₒ {𝓤} ×ₒ α ＝ α
+𝟙ₒ-left-neutral-×ₒ {𝓤} α = eqtoidₒ (ua _) fe' _ _
+                            (f , f-order-preserving ,
+                             f-is-equiv , g-order-preserving)
+ where
+  f : 𝟙 × ⟨ α ⟩ → ⟨ α ⟩
+  f = pr₂
+
+  g : ⟨ α ⟩ → 𝟙 × ⟨ α ⟩
+  g = ( ⋆ ,_)
+
+  f-order-preserving : is-order-preserving (𝟙ₒ {𝓤} ×ₒ α) α f
+  f-order-preserving x y (inl p) = p
+
+  f-is-equiv : is-equiv f
+  f-is-equiv = qinvs-are-equivs f (g , (λ _ → refl) , (λ _ → refl))
+
+  g-order-preserving : is-order-preserving α (𝟙ₒ {𝓤} ×ₒ α) g
+  g-order-preserving x y p = inl p
+
+𝟙ₒ-right-neutral-×ₒ : (α : Ordinal 𝓤) → α ×ₒ 𝟙ₒ {𝓤} ＝ α
+𝟙ₒ-right-neutral-×ₒ {𝓤} α = eqtoidₒ (ua _) fe' _ _
+                             (f , f-order-preserving ,
+                              f-is-equiv , g-order-preserving)
+ where
+  f : ⟨ α ⟩ × 𝟙 → ⟨ α ⟩
+  f = pr₁
+
+  g : ⟨ α ⟩ → ⟨ α ⟩ × 𝟙
+  g = (_, ⋆ )
+
+  f-order-preserving : is-order-preserving (α ×ₒ 𝟙ₒ {𝓤}) α f
+  f-order-preserving x y (inr (refl , p)) = p
+
+  f-is-equiv : is-equiv f
+  f-is-equiv = qinvs-are-equivs f (g , (λ _ → refl) , (λ _ → refl))
+
+  g-order-preserving : is-order-preserving α (α ×ₒ 𝟙ₒ {𝓤}) g
+  g-order-preserving x y p = inr (refl , p)
+
+\end{code}
+
+Because we use --lossy-unification to speed up typechecking we have to
+explicitly mention the universes in the lemma below; using them as variables (as
+usual) results in a unification error.
+
+\begin{code}
+
+×ₒ-assoc : {𝓤 𝓥 𝓦 : Universe}
+           (α : Ordinal 𝓤) (β : Ordinal 𝓥) (γ : Ordinal 𝓦)
+         → (α ×ₒ β) ×ₒ γ ＝ α ×ₒ (β ×ₒ γ)
+×ₒ-assoc α β γ =
+ eqtoidₒ (ua _) fe' ((α  ×ₒ β) ×ₒ γ) (α  ×ₒ (β ×ₒ γ))
+  (f , order-preserving-reflecting-equivs-are-order-equivs
+   ((α  ×ₒ β) ×ₒ γ) (α  ×ₒ (β ×ₒ γ))
+   f f-equiv f-preserves-order f-reflects-order)
+  where
+   f : ⟨ (α ×ₒ β) ×ₒ γ ⟩ → ⟨ α ×ₒ (β ×ₒ γ) ⟩
+   f ((a , b) , c) = (a , (b , c))
+
+   g : ⟨ α ×ₒ (β ×ₒ γ) ⟩ → ⟨ (α ×ₒ β) ×ₒ γ ⟩
+   g (a , (b , c)) = ((a , b) , c)
+
+   f-equiv : is-equiv f
+   f-equiv = qinvs-are-equivs f (g , (λ x → refl) , (λ x → refl))
+
+   f-preserves-order : is-order-preserving  ((α  ×ₒ β) ×ₒ γ) (α  ×ₒ (β ×ₒ γ)) f
+   f-preserves-order _ _ (inl p) = inl (inl p)
+   f-preserves-order _ _ (inr (r , inl p)) = inl (inr (r , p))
+   f-preserves-order _ _ (inr (r , inr (u , q))) = inr (to-×-＝ u r , q)
+
+   f-reflects-order : is-order-reflecting ((α  ×ₒ β) ×ₒ γ) (α  ×ₒ (β ×ₒ γ)) f
+   f-reflects-order _ _ (inl (inl p)) = inl p
+   f-reflects-order _ _ (inl (inr (r , q))) = inr (r , (inl q))
+   f-reflects-order _ _ (inr (refl , q)) = inr (refl , (inr (refl , q)))
+
+\end{code}
+
+The lemma below is as general as possible in terms of universe parameters
+because addition requires its arguments to come from the same universe, at least
+at present.
+
+\begin{code}
+
+×ₒ-distributes-+ₒ-right : (α : Ordinal 𝓤) (β γ : Ordinal 𝓥)
+                        → α ×ₒ (β +ₒ γ) ＝ (α ×ₒ β) +ₒ (α ×ₒ γ)
+×ₒ-distributes-+ₒ-right α β γ = eqtoidₒ (ua _) fe' _ _
+                                 (f , f-order-preserving ,
+                                  f-is-equiv , g-order-preserving)
+ where
+  f : ⟨ α ×ₒ (β +ₒ γ) ⟩ → ⟨ (α ×ₒ β) +ₒ (α ×ₒ γ) ⟩
+  f (a , inl b) = inl (a , b)
+  f (a , inr c) = inr (a , c)
+
+  g : ⟨ (α ×ₒ β) +ₒ (α ×ₒ γ) ⟩ → ⟨ α ×ₒ (β +ₒ γ) ⟩
+  g (inl (a , b)) = a , inl b
+  g (inr (a , c)) = a , inr c
+
+  f-order-preserving : is-order-preserving _ _ f
+  f-order-preserving (a , inl b) (a' , inl b') (inl p) = inl p
+  f-order-preserving (a , inl b) (a' , inr c') (inl p) = ⋆
+  f-order-preserving (a , inr c) (a' , inr c') (inl p) = inl p
+  f-order-preserving (a , inl b) (a' , inl .b) (inr (refl , q)) = inr (refl , q)
+  f-order-preserving (a , inr c) (a' , inr .c) (inr (refl , q)) = inr (refl , q)
+
+  f-is-equiv : is-equiv f
+  f-is-equiv = qinvs-are-equivs f (g , η , ε)
+   where
+    η : g ∘ f ∼ id
+    η (a , inl b) = refl
+    η (a , inr c) = refl
+
+    ε : f ∘ g ∼ id
+    ε (inl (a , b)) = refl
+    ε (inr (a , c)) = refl
+
+  g-order-preserving : is-order-preserving _ _ g
+  g-order-preserving (inl (a , b)) (inl (a' , b')) (inl p) = inl p
+  g-order-preserving (inl (a , b)) (inl (a' , .b)) (inr (refl , q)) =
+   inr (refl , q)
+  g-order-preserving (inl (a , b)) (inr (a' , c')) p = inl ⋆
+  g-order-preserving (inr (a , c)) (inr (a' , c')) (inl p) = inl p
+  g-order-preserving (inr (a , c)) (inr (a' , c')) (inr (refl , q)) =
+   inr (refl , q)
+
+\end{code}
+
+The following characterizes the initial segments of a product and is rather
+useful when working with simulations between products.
+
+\begin{code}
+
+×ₒ-↓ : (α β : Ordinal 𝓤)
+     → {a : ⟨ α ⟩} {b : ⟨ β ⟩}
+     → (α ×ₒ β) ↓ (a , b) ＝ (α ×ₒ (β ↓ b)) +ₒ (α ↓ a)
+×ₒ-↓ α β {a} {b} = eqtoidₒ (ua _) fe' _ _ (f , f-order-preserving ,
+                                           f-is-equiv , g-order-preserving)
+ where
+  f : ⟨ (α ×ₒ β) ↓ (a , b) ⟩ → ⟨ (α ×ₒ (β ↓ b)) +ₒ (α ↓ a) ⟩
+  f ((x , y) , inl p) = inl (x , (y , p))
+  f ((x , y) , inr (r , q)) = inr (x , q)
+
+  g : ⟨ (α ×ₒ (β ↓ b)) +ₒ (α ↓ a) ⟩ → ⟨ (α ×ₒ β) ↓ (a , b) ⟩
+  g (inl (x , y , p)) = (x , y) , inl p
+  g (inr (x , q)) = (x , b) , inr (refl , q)
+
+  f-order-preserving : is-order-preserving _ _ f
+  f-order-preserving ((x , y) , inl p) ((x' , y') , inl p') (inl l) = inl l
+  f-order-preserving ((x , y) , inl p) ((x' , _)  , inl p') (inr (refl , l)) =
+   inr ((ap (y ,_) (Prop-valuedness β _ _ p p')) , l)
+  f-order-preserving ((x , y) , inl p) ((x' , y') , inr (r' , q')) l = ⋆
+  f-order-preserving ((x , y) , inr (refl , q)) ((x' , y') , inl p') (inl l) =
+   𝟘-elim (irrefl β y (Transitivity β _ _ _ l p'))
+  f-order-preserving ((x , y) , inr (refl , q))
+                     ((x' , _)  , inl p') (inr (refl , l)) = 𝟘-elim
+                                                              (irrefl β y p')
+  f-order-preserving ((x , y) , inr (refl , q))
+                     ((x' , _)  , inr (refl , q')) (inl l) = 𝟘-elim
+                                                              (irrefl β y l)
+  f-order-preserving ((x , y) , inr (refl , q))
+                     ((x' , _)  , inr (refl , q')) (inr (_ , l)) = l
+
+  f-is-equiv : is-equiv f
+  f-is-equiv = qinvs-are-equivs f (g , η , ε)
+   where
+    η : g ∘ f ∼ id
+    η ((x , y) , inl p) = refl
+    η ((x , y) , inr (refl , q)) = refl
+
+    ε : f ∘ g ∼ id
+    ε (inl (x , y)) = refl
+    ε (inr x) = refl
+
+  g-order-preserving : is-order-preserving _ _ g
+  g-order-preserving (inl (x , y , p)) (inl (x' , y' , p')) (inl l) = inl l
+  g-order-preserving (inl (x , y , p)) (inl (x' , y' , p')) (inr (refl , l)) =
+   inr (refl , l)
+  g-order-preserving (inl (x , y , p)) (inr (x' , q')) _ = inl p
+  g-order-preserving (inr (x , q))     (inr (x' , q')) l = inr (refl , l)
+
+\end{code}
+
+We now prove several useful facts about (bounded) simulations between products.
+
+\begin{code}
+
+×ₒ-increasing-on-right : (α β γ : Ordinal 𝓤)
+                       → 𝟘ₒ ⊲ α
+                       → β ⊲ γ
+                       → (α ×ₒ β) ⊲ (α ×ₒ γ)
+×ₒ-increasing-on-right α β γ (a , p) (c , q) = (a , c) , I
+ where
+  I = α ×ₒ β                    ＝⟨ 𝟘ₒ-right-neutral (α ×ₒ β) ⁻¹ ⟩
+      (α ×ₒ β) +ₒ 𝟘ₒ            ＝⟨ ap₂ (λ -₁ -₂ → (α ×ₒ -₁) +ₒ -₂) q p ⟩
+      (α ×ₒ (γ ↓ c)) +ₒ (α ↓ a) ＝⟨ ×ₒ-↓ α γ ⁻¹ ⟩
+      (α ×ₒ γ) ↓ (a , c)        ∎
+
+×ₒ-right-monotone-⊴ : (α : Ordinal 𝓤) (β γ : Ordinal 𝓥)
+                    → β ⊴ γ
+                    → (α ×ₒ β) ⊴ (α ×ₒ γ)
+×ₒ-right-monotone-⊴ α β γ (g , sim-g) = f , f-initial-segment ,
+                                            f-order-preserving
+ where
+   f : ⟨ α ×ₒ β ⟩ → ⟨ α ×ₒ γ ⟩
+   f (a , b) = a , g b
+
+   f-initial-segment : is-initial-segment (α ×ₒ β) (α ×ₒ γ) f
+   f-initial-segment (a , b) (a' , c') (inl l) = (a' , b') , inl k , ap (a' ,_) q
+    where
+     I : Σ b' ꞉ ⟨ β ⟩ , b' ≺⟨ β ⟩ b × (g b' ＝ c')
+     I = simulations-are-initial-segments β γ g sim-g b c' l
+     b' = pr₁ I
+     k = pr₁ (pr₂ I)
+     q = pr₂ (pr₂ I)
+   f-initial-segment (a , b) (a' , c') (inr (refl , q)) =
+    (a' , b) , inr (refl , q) , refl
+
+   f-order-preserving : is-order-preserving (α ×ₒ β) (α ×ₒ γ) f
+   f-order-preserving (a , b) (a' , b') (inl p) =
+    inl (simulations-are-order-preserving β γ g sim-g b b' p)
+   f-order-preserving (a , b) (a' , b') (inr (refl , q)) = inr (refl , q)
+
+×ₒ-≼-left : (α : Ordinal 𝓤) (β : Ordinal 𝓥)
+            {a a' : ⟨ α ⟩} {b : ⟨ β ⟩}
+          → a ≼⟨ α ⟩ a'
+          → (a , b) ≼⟨ α ×ₒ β ⟩ (a' , b)
+×ₒ-≼-left α β p (a₀ , b₀) (inl r) = inl r
+×ₒ-≼-left α β p (a₀ , b₀) (inr (eq , r)) = inr (eq , p a₀ r)
+
+\end{code}
+
+To prove that multiplication is left cancellable, we require the following
+technical lemma: if α > 𝟘, then every simulation from α ×ₒ β to α ×ₒ γ
+decomposes as the identity on the first component and a function β → γ on the
+second component, viz. one that is independent of the first component.
+
+\begin{code}
+
+simulation-product-decomposition
+ : (α : Ordinal 𝓤) (β γ : Ordinal 𝓥)
+   ((a₀ , a₀-least) : 𝟘ₒ ⊲ α)
+   ((f , _) : (α ×ₒ β) ⊴ (α ×ₒ γ))
+ → (a : ⟨ α ⟩) (b : ⟨ β ⟩) → f (a , b) ＝ (a , pr₂ (f (a₀ , b)))
+simulation-product-decomposition {𝓤} {𝓥} α β γ (a₀ , a₀-least)
+                                 (f , sim@(init-seg , order-pres)) a b = I
+ where
+  f' : ⟨ α ×ₒ β ⟩ → ⟨ α ×ₒ γ ⟩
+  f' (a , b) = (a , pr₂ (f (a₀ , b)))
+
+  P : ⟨ α ×ₒ β ⟩ → 𝓤 ⊔ 𝓥 ̇
+  P (a , b) = (f (a , b)) ＝ f' (a , b)
+
+  I : P (a , b)
+  I = Transfinite-induction (α ×ₒ β) P II (a , b)
+   where
+    II : (x : ⟨ α ×ₒ β ⟩)
+       → ((y : ⟨ α ×ₒ β ⟩) → y ≺⟨ α ×ₒ β ⟩ x → P y)
+       → P x
+    II (a , b) IH = Extensionality (α ×ₒ γ) (f (a , b)) (f' (a , b)) III IV
+     where
+      III : (u : ⟨ α ×ₒ γ ⟩) → u ≺⟨ α ×ₒ γ ⟩ f (a , b) → u ≺⟨ α ×ₒ γ ⟩ f' (a , b)
+      III (a' , c') p = transport (λ - → - ≺⟨ α ×ₒ γ ⟩ f' (a , b)) III₂ (III₃ p')
+       where
+        III₁ : Σ (a'' , b') ꞉ ⟨ α ×ₒ β ⟩ , (a'' , b') ≺⟨ α ×ₒ β ⟩ (a , b)
+                                         × (f (a'' , b') ＝ a' , c')
+        III₁ = init-seg (a , b) (a' , c') p
+        a'' = pr₁ (pr₁ III₁)
+        b' = pr₂ (pr₁ III₁)
+        p' = pr₁ (pr₂ III₁)
+        eq : f (a'' , b') ＝ (a' , c')
+        eq = pr₂ (pr₂ III₁)
+
+        III₂ : f' (a'' , b') ＝ (a' , c')
+        III₂ = IH (a'' , b') p' ⁻¹ ∙ eq
+
+        III₃ : (a'' , b') ≺⟨ α ×ₒ β ⟩ (a , b)
+             → f' (a'' , b') ≺⟨ α ×ₒ γ ⟩ f' (a , b)
+        III₃ (inl q) = h (order-pres (a₀' , b') (a₀ , b) (inl q))
+         where
+          a₀' : ⟨ α ⟩
+          a₀' = pr₁ (f (a₀ , b))
+
+          ih : (f (a₀' , b')) ＝ f' (a₀' , b')
+          ih = IH (a₀' , b') (inl q)
+
+          h : f  (a₀' , b') ≺⟨ α ×ₒ γ ⟩ f  (a₀ , b)
+            → f' (a'' , b') ≺⟨ α ×ₒ γ ⟩ f' (a , b)
+          h (inl r) = inl (transport (λ - → - ≺⟨ γ ⟩ pr₂ (f (a₀ , b)))
+                                     (ap pr₂ ih) r)
+          h (inr (_ , r)) = 𝟘-elim (irrefl α a₀' (transport (λ - → - ≺⟨ α ⟩ a₀')
+                                                            (ap pr₁ ih) r))
+        III₃ (inr (e , q)) = inr (ap (λ - → pr₂ (f (a₀ , -))) e , q)
+
+      IV : (u : ⟨ α ×ₒ γ ⟩) → u ≺⟨ α ×ₒ γ ⟩ f' (a , b) → u ≺⟨ α ×ₒ γ ⟩ f  (a , b)
+      IV (a' , c') (inl p) = l₂ (a' , c') (inl p)
+       where
+        l₁ : a₀ ≼⟨ α ⟩ a
+        l₁ x p = 𝟘-elim (transport ⟨_⟩ (a₀-least ⁻¹) (x , p))
+        l₂ : f (a₀ , b) ≼⟨ α ×ₒ γ ⟩ f (a , b)
+        l₂ = simulations-are-monotone _ _
+              f sim (a₀ , b) (a , b) (×ₒ-≼-left α β l₁)
+      IV (a' , c') (inr (r , q)) =
+       transport (λ - → - ≺⟨ α ×ₒ γ ⟩ f  (a , b)) eq
+                 (order-pres (a' , b) (a , b) (inr (refl , q)))
+        where
+         eq = f  (a' , b)             ＝⟨ IH (a' , b) (inr (refl , q)) ⟩
+              f' (a' , b)             ＝⟨ refl ⟩
+              (a' , pr₂ (f (a₀ , b))) ＝⟨ ap (a' ,_) (r ⁻¹) ⟩
+              (a' , c')               ∎
+
+\end{code}
+
+The following result states that multiplication for ordinals can be cancelled on
+the left. Interestingly, Andrew Swan [Swa18] proved that the corresponding
+result for sets is not provable constructively already for α = 𝟚: there are
+toposes where the statement
+
+  𝟚 × X ≃ 𝟚 × Y → X ≃ Y
+
+is not true for certain objects X and Y in the topos.
+
+[Swa18] Andrew Swan
+        On Dividing by Two in Constructive Mathematics
+        2018
+        https://arxiv.org/abs/1804.04490
+
+\begin{code}
+
+×ₒ-left-cancellable : (α β γ : Ordinal 𝓤)
+                    → 𝟘ₒ ⊲ α
+                    → (α ×ₒ β) ＝ (α ×ₒ γ)
+                    → β ＝ γ
+×ₒ-left-cancellable {𝓤} α β γ (a₀ , a₀-least) =
+ transfinite-induction-on-OO P II β γ
+  where
+   P : Ordinal 𝓤 → 𝓤 ⁺ ̇
+   P β = (γ : Ordinal 𝓤) → (α ×ₒ β) ＝ (α ×ₒ γ) → β ＝ γ
+
+   I : (β γ : Ordinal 𝓤)
+     → (α ×ₒ β) ＝ (α ×ₒ γ)
+     → (b : ⟨ β ⟩) → Σ c ꞉ ⟨ γ ⟩ , (α ×ₒ (β ↓ b) ＝ α ×ₒ (γ ↓ c))
+   I β γ e b = c , eq
+    where
+     𝕗 : (α ×ₒ β) ⊴ (α ×ₒ γ)
+     𝕗 = ≃ₒ-to-⊴ (α ×ₒ β) (α ×ₒ γ) (idtoeqₒ _ _ e)
+     f : ⟨ α ×ₒ β ⟩ → ⟨ α ×ₒ γ ⟩
+     f = [ α ×ₒ β , α ×ₒ γ ]⟨ 𝕗 ⟩
+
+     c : ⟨ γ ⟩
+     c = pr₂ (f (a₀ , b))
+
+     eq = α ×ₒ (β ↓ b)                ＝⟨ 𝟘ₒ-right-neutral (α ×ₒ (β ↓ b)) ⁻¹ ⟩
+          (α ×ₒ (β ↓ b)) +ₒ 𝟘ₒ        ＝⟨ ap ((α ×ₒ (β ↓ b)) +ₒ_) a₀-least ⟩
+          (α ×ₒ (β ↓ b)) +ₒ (α ↓ a₀)  ＝⟨ ×ₒ-↓ α β ⁻¹ ⟩
+          (α ×ₒ β) ↓ (a₀ , b)         ＝⟨ eq₁ ⟩
+          (α ×ₒ γ) ↓ (a₀' , c)        ＝⟨ eq₂ ⟩
+          (α ×ₒ γ) ↓ (a₀ , c)         ＝⟨ ×ₒ-↓ α γ ⟩
+          (α ×ₒ (γ ↓ c)) +ₒ (α ↓ a₀)  ＝⟨ ap ((α ×ₒ (γ ↓ c)) +ₒ_) (a₀-least ⁻¹) ⟩
+          (α ×ₒ (γ ↓ c)) +ₒ 𝟘ₒ        ＝⟨ 𝟘ₒ-right-neutral (α ×ₒ (γ ↓ c)) ⟩
+          α ×ₒ (γ ↓ c)                ∎
+      where
+       a₀' : ⟨ α ⟩
+       a₀' = pr₁ (f (a₀ , b))
+
+       eq₁ = simulations-preserve-↓ (α ×ₒ β) (α ×ₒ γ) 𝕗 (a₀ , b)
+       eq₂ = ap ((α ×ₒ γ) ↓_)
+                (simulation-product-decomposition α β γ (a₀ , a₀-least) 𝕗 a₀ b)
+
+   II : (β : Ordinal 𝓤) → ((b : ⟨ β ⟩) → P (β ↓ b)) → P β
+   II β IH γ e = Extensionality (OO 𝓤) β γ (to-≼ III) (to-≼ IV)
+    where
+     III : (b : ⟨ β ⟩) → (β ↓ b) ⊲ γ
+     III b = let (c , eq) = I β γ  e     b in (c , IH b (γ ↓ c) eq)
+     IV  : (c : ⟨ γ ⟩) → (γ ↓ c) ⊲ β
+     IV  c = let (b , eq) = I γ β (e ⁻¹) c in (b , (IH b (γ ↓ c) (eq ⁻¹) ⁻¹))
+
+\end{code}
+
+Finally, multiplication satisfies the expected recursive equations (which
+classically define ordinal multiplication): zero is fixed by multiplication
+(this is ×ₒ-𝟘ₒ-right above), multiplication for successors is repeated addition
+and multiplication preserves suprema.
+
+\begin{code}
+
+×ₒ-successor : (α β : Ordinal 𝓤) → α ×ₒ (β +ₒ 𝟙ₒ) ＝ (α ×ₒ β) +ₒ α
+×ₒ-successor α β =
+  α ×ₒ (β +ₒ 𝟙ₒ)          ＝⟨ ×ₒ-distributes-+ₒ-right α β 𝟙ₒ ⟩
+  ((α ×ₒ β) +ₒ (α ×ₒ 𝟙ₒ)) ＝⟨ ap ((α ×ₒ β) +ₒ_) (𝟙ₒ-right-neutral-×ₒ α)  ⟩
+  (α ×ₒ β) +ₒ α           ∎
+
+open import UF.PropTrunc
+open import UF.Size
+
+module _ (pt : propositional-truncations-exist)
+         (sr : Set-Replacement pt)
+       where
+
+ open import Ordinals.OrdinalOfOrdinalsSuprema ua
+ open suprema pt sr
+ open PropositionalTruncation pt
+
+ ×ₒ-preserves-suprema : (α : Ordinal 𝓤) {I : 𝓤 ̇ } (β : I → Ordinal 𝓤)
+                      → α ×ₒ sup β ＝ sup (λ i → α ×ₒ β i)
+ ×ₒ-preserves-suprema {𝓤} α {I} β = ⊴-antisym (α ×ₒ sup β) (sup (λ i → α ×ₒ β i)) ⦅1⦆ ⦅2⦆
+  where
+   ⦅2⦆ : sup (λ i → α ×ₒ β i) ⊴ (α ×ₒ sup β)
+   ⦅2⦆ = sup-is-lower-bound-of-upper-bounds (λ i → α ×ₒ β i) (α ×ₒ sup β)
+          (λ i → ×ₒ-right-monotone-⊴ α (β i) (sup β) (sup-is-upper-bound β i))
+
+   ⦅1⦆ : (α ×ₒ sup β) ⊴ sup (λ i → α ×ₒ β i)
+   ⦅1⦆ = ≼-gives-⊴ (α ×ₒ sup β) (sup (λ i → α ×ₒ β i)) ⦅1⦆-I
+    where
+     ⦅1⦆-I : (γ : Ordinal 𝓤) → γ ⊲ (α ×ₒ sup β) → γ ⊲ sup (λ i → α ×ₒ β i)
+     ⦅1⦆-I _ ((a , y) , refl) = ⦅1⦆-III
+      where
+       ⦅1⦆-II : (Σ i ꞉ I , Σ b ꞉ ⟨ β i ⟩ , sup β ↓ y ＝ (β i) ↓ b)
+              → ((α ×ₒ sup β) ↓ (a , y)) ⊲ sup (λ j → α ×ₒ β j)
+       ⦅1⦆-II (i , b , e) = σ (a , b) , eq
+        where
+         σ : ⟨ α ×ₒ β i ⟩ → ⟨ sup (λ j → α ×ₒ β j) ⟩
+         σ = [ α ×ₒ β i , sup (λ j → α ×ₒ β j) ]⟨ sup-is-upper-bound _ i ⟩
+
+         eq = (α ×ₒ sup β) ↓ (a , y)           ＝⟨ ×ₒ-↓ α (sup β) ⟩
+              (α ×ₒ (sup β ↓ y)) +ₒ (α ↓ a)    ＝⟨ eq₁ ⟩
+              (α ×ₒ (β i ↓ b)) +ₒ (α ↓ a)      ＝⟨ ×ₒ-↓ α (β i) ⁻¹ ⟩
+              (α ×ₒ β i) ↓ (a , b)             ＝⟨ eq₂ ⟩
+              sup (λ j → α ×ₒ β j) ↓ σ (a , b) ∎
+          where
+           eq₁ = ap (λ - → ((α ×ₒ -) +ₒ (α ↓ a))) e
+           eq₂ = (initial-segment-of-sup-at-component
+                  (λ j → α ×ₒ β j) i (a , b)) ⁻¹
+
+       ⦅1⦆-III : ((α ×ₒ sup β) ↓ (a , y)) ⊲ sup (λ i → α ×ₒ β i)
+       ⦅1⦆-III = ∥∥-rec (⊲-is-prop-valued _ _) ⦅1⦆-II
+                  (initial-segment-of-sup-is-initial-segment-of-some-component
+                    β y)
+
+\end{code}
+
+11 September 2024, added by Tom de Jong following a question by Martin Escardo.
+
+The equations for successor and suprema uniquely specify the multiplication
+operation even though they are not constructively sufficient to define it.
+
+\begin{code}
+
+ private
+  successor-equation : (Ordinal 𝓤 → Ordinal 𝓤 → Ordinal 𝓤) → 𝓤 ⁺ ̇
+  successor-equation {𝓤} _⊗_ =
+   (α β : Ordinal 𝓤) → α ⊗ (β +ₒ 𝟙ₒ) ＝ (α ⊗ β) +ₒ α
+
+  suprema-equation : (Ordinal 𝓤 → Ordinal 𝓤 → Ordinal 𝓤) → 𝓤 ⁺ ̇
+  suprema-equation {𝓤} _⊗_ =
+   (α : Ordinal 𝓤) (I : 𝓤 ̇  ) (β : I → Ordinal 𝓤)
+    → α ⊗ (sup β) ＝ sup (λ i → α ⊗ β i)
+
+  recursive-equation : (Ordinal 𝓤 → Ordinal 𝓤 → Ordinal 𝓤) → 𝓤 ⁺ ̇
+  recursive-equation {𝓤} _⊗_ =
+   (α β : Ordinal 𝓤) → α ⊗ β ＝ sup (λ b → (α ⊗ (β ↓ b)) +ₒ α)
+
+  successor-and-suprema-equations-give-recursive-equation
+   : (_⊗_ : Ordinal 𝓤 → Ordinal 𝓤 → Ordinal 𝓤)
+   → successor-equation _⊗_
+   → suprema-equation _⊗_
+   → recursive-equation _⊗_
+  successor-and-suprema-equations-give-recursive-equation
+   _⊗_ ⊗-succ ⊗-sup α β = α ⊗ β                           ＝⟨ I   ⟩
+                          (α ⊗ sup (λ b → (β ↓ b) +ₒ 𝟙ₒ)) ＝⟨ II  ⟩
+                          sup (λ b → α ⊗ ((β ↓ b) +ₒ 𝟙ₒ)) ＝⟨ III ⟩
+                          sup (λ b → (α ⊗ (β ↓ b)) +ₒ α)  ∎
+    where
+     I   = ap (α ⊗_) (supremum-of-successors-of-initial-segments pt sr β)
+     II  = ⊗-sup α ⟨ β ⟩ (λ b → (β ↓ b) +ₒ 𝟙ₒ)
+     III = ap sup (dfunext fe' (λ b → ⊗-succ α (β ↓ b)))
+
+ ×ₒ-recursive-equation : recursive-equation {𝓤} _×ₒ_
+ ×ₒ-recursive-equation =
+  successor-and-suprema-equations-give-recursive-equation
+    _×ₒ_ ×ₒ-successor (λ α _ β → ×ₒ-preserves-suprema α β)
+
+ ×ₒ-is-uniquely-specified'
+  : (_⊗_ : Ordinal 𝓤 → Ordinal 𝓤 → Ordinal 𝓤)
+  → recursive-equation _⊗_
+  → (α β : Ordinal 𝓤) → α ⊗ β ＝ α ×ₒ β
+ ×ₒ-is-uniquely-specified' {𝓤} _⊗_ ⊗-rec α =
+  transfinite-induction-on-OO (λ - → (α ⊗ -) ＝ (α ×ₒ -)) I
+   where
+    I : (β : Ordinal 𝓤)
+      → ((b : ⟨ β ⟩) → (α ⊗ (β ↓ b)) ＝ (α ×ₒ (β ↓ b)))
+      → (α ⊗ β) ＝ (α ×ₒ β)
+    I β IH = α ⊗ β                            ＝⟨ II  ⟩
+             sup (λ b → (α ⊗ (β ↓ b)) +ₒ α)   ＝⟨ III ⟩
+             sup (λ b → (α ×ₒ (β ↓ b)) +ₒ α)  ＝⟨ IV  ⟩
+             α ×ₒ β                           ∎
+     where
+      II  = ⊗-rec α β
+      III = ap sup (dfunext fe' (λ b → ap (_+ₒ α) (IH b)))
+      IV  = ×ₒ-recursive-equation α β ⁻¹
+
+ ×ₒ-is-uniquely-specified
+  : ∃! _⊗_ ꞉ (Ordinal 𝓤 → Ordinal 𝓤 → Ordinal 𝓤) ,
+     (successor-equation _⊗_) × (suprema-equation _⊗_)
+ ×ₒ-is-uniquely-specified {𝓤} =
+  (_×ₒ_ , (×ₒ-successor , (λ α _ β → ×ₒ-preserves-suprema α β))) ,
+  (λ (_⊗_ , ⊗-succ , ⊗-sup) →
+   to-subtype-＝
+    (λ F → ×-is-prop (Π₂-is-prop fe'
+                       (λ _ _ → underlying-type-is-set fe (OO 𝓤)))
+                     (Π₃-is-prop fe'
+                       (λ _ _ _ → underlying-type-is-set fe (OO 𝓤))))
+    (dfunext fe'
+      (λ α → dfunext fe'
+       (λ β →
+        (×ₒ-is-uniquely-specified' _⊗_
+          (successor-and-suprema-equations-give-recursive-equation
+            _⊗_ ⊗-succ ⊗-sup)
+        α β) ⁻¹))))
+
+\end{code}
+
+The above should be contrasted to the situation for addition where we do not
+know how to prove such a result since only *inhabited* suprema are preserved by
+addition.
\ No newline at end of file
diff --git a/source/Ordinals/NotationInterpretation0.lagda b/source/Ordinals/NotationInterpretation0.lagda
index 0eb874b26..8632203e1 100644
--- a/source/Ordinals/NotationInterpretation0.lagda
+++ b/source/Ordinals/NotationInterpretation0.lagda
@@ -17,7 +17,6 @@ module Ordinals.NotationInterpretation0
         (pt : propositional-truncations-exist)
        where
 
-open import UF.Equiv
 open import UF.FunExt
 open import UF.Subsingletons
 open import UF.UA-FunExt
@@ -35,13 +34,11 @@ private
 open PropositionalTruncation pt
 
 open import CoNaturals.Type
-open import MLTT.Plus-Properties
 open import MLTT.Spartan
 open import Notation.CanonicalMap
 open import Ordinals.Arithmetic fe
-open import Ordinals.ArithmeticProperties ua
+open import Ordinals.AdditionProperties ua
 open import Ordinals.Brouwer
-open import Ordinals.Equivalence
 open import Ordinals.Injectivity
 open import Ordinals.Maps
 open import Ordinals.OrdinalOfOrdinals ua
@@ -53,11 +50,7 @@ open import Ordinals.TrichotomousType fe
 open import Ordinals.Type
 open import Ordinals.Underlying
 open import TypeTopology.CompactTypes
-open import TypeTopology.GenericConvergentSequenceCompactness
-open import TypeTopology.PropTychonoff
 open import TypeTopology.SquashedSum fe
-open import UF.Embeddings
-open import UF.ImageAndSurjection pt
 open import UF.Size
 
 open ordinals-injectivity fe
diff --git a/source/Ordinals/NotationInterpretation1.lagda b/source/Ordinals/NotationInterpretation1.lagda
index 474c11fc4..9d1eba7a4 100644
--- a/source/Ordinals/NotationInterpretation1.lagda
+++ b/source/Ordinals/NotationInterpretation1.lagda
@@ -449,7 +449,6 @@ Added 4th April 2022. A third interpretation of ordinal expressions.
 
 open import UF.PropTrunc
 open import UF.Univalence
-open import UF.Equiv
 open import UF.Size
 
 open import CoNaturals.Type
@@ -468,12 +467,9 @@ module _ (pt : propositional-truncations-exist)
  pe : Prop-Ext
  pe = Univalence-gives-Prop-Ext ua
 
- open import Ordinals.OrdinalOfOrdinals ua
  open import Ordinals.OrdinalOfOrdinalsSuprema ua
  open import Ordinals.Injectivity
- open import Ordinals.ArithmeticProperties ua
 
- open import UF.ImageAndSurjection pt
  open ordinals-injectivity fe
 
  module _ (sr : Set-Replacement pt) where
@@ -499,7 +495,7 @@ module _ (pt : propositional-truncations-exist)
                            (sum-to-sup-is-surjection (extension (𝓢 ∘ ν)))
                            (Σ-is-compact∙
                              (ℕ∞-compact∙ fe₀)
-                             (λ u → prop-tychonoff fe
+                             (λ u → prop-tychonoff (fe 𝓤₀ 𝓤₀)
                                      (ℕ-to-ℕ∞-is-embedding fe₀ u)
                                      (λ (i , _) → 𝓢-compact∙ (ν i))))
   σ : (ν : OE) → ⟨ Κ ν ⟩ → ⟨ 𝓢 ν ⟩
diff --git a/source/Ordinals/NotationInterpretation2.lagda b/source/Ordinals/NotationInterpretation2.lagda
index 4648f61fc..0162014a1 100644
--- a/source/Ordinals/NotationInterpretation2.lagda
+++ b/source/Ordinals/NotationInterpretation2.lagda
@@ -60,23 +60,19 @@ open import Ordinals.ToppedArithmetic fe
 open import Ordinals.ToppedType fe
 open import Ordinals.Type
 open import Ordinals.Underlying
-open import Taboos.LPO fe
+open import Taboos.LPO
 open import Taboos.WLPO
 open import TypeTopology.CompactTypes
-open import TypeTopology.ConvergentSequenceHasInf
 open import TypeTopology.Density
 open import TypeTopology.InfProperty
 open import TypeTopology.PropInfTychonoff fe
-open import TypeTopology.PropTychonoff fe
 open import TypeTopology.SigmaDiscreteAndTotallySeparated
-open import UF.Base
 open import UF.Embeddings
 open import UF.DiscreteAndSeparated
 open import UF.Equiv
 open import UF.PairFun
 open import UF.Retracts
 open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 
 \end{code}
 
@@ -584,7 +580,7 @@ We conclude with some impossibility results.
 LPO-gives-ι-is-equiv : LPO
                      → (ν : E) → is-equiv (ι ν)
 LPO-gives-ι-is-equiv lpo ⌜𝟙⌝         = id-is-equiv 𝟙
-LPO-gives-ι-is-equiv lpo ⌜ω+𝟙⌝       = LPO-gives-ι𝟙-is-equiv lpo
+LPO-gives-ι-is-equiv lpo ⌜ω+𝟙⌝       = LPO-gives-ι𝟙-is-equiv fe₀ lpo
 LPO-gives-ι-is-equiv lpo (ν₀ ⌜+⌝ ν₁) = pair-fun-is-equiv
                                           id
                                           (dep-cases (λ _ → ι ν₀) (λ _ → ι ν₁))
diff --git a/source/Ordinals/Notions.lagda b/source/Ordinals/Notions.lagda
index fc8c7338c..6f13f37e2 100644
--- a/source/Ordinals/Notions.lagda
+++ b/source/Ordinals/Notions.lagda
@@ -660,7 +660,6 @@ module _
    fe : FunExt
    fe 𝓤 𝓥 = f-e
 
-   open import UF.PropTrunc
    open PropositionalTruncation pt
 
    lem-consequence : is-well-order → (u v : X) → (∃ i ꞉ X , ((i < u) × ¬ (i < v))) + (u ≼ v)
@@ -901,7 +900,6 @@ module _ (fe : Fun-Ext)
 
  module _ (pt : propositional-truncations-exist) where
 
-  open import UF.PropTrunc
   open PropositionalTruncation pt
 
   nonempty-has-minimal : is-well-order
diff --git a/source/Ordinals/OrdinalOfOrdinals.lagda b/source/Ordinals/OrdinalOfOrdinals.lagda
index b11c000d6..843d5e443 100644
--- a/source/Ordinals/OrdinalOfOrdinals.lagda
+++ b/source/Ordinals/OrdinalOfOrdinals.lagda
@@ -708,6 +708,15 @@ to-⊴ α β ϕ = g
 
 \end{code}
 
+Added 9 September 2024 by Tom de Jong and Fredrik Nordvall Forsberg.
+
+\begin{code}
+
+⊲-⊴-gives-⊲ : (α β γ : Ordinal 𝓤) → α ⊲ β → β ⊴ γ → α ⊲ γ
+⊲-⊴-gives-⊲ α β γ l k = ≼-trans _⊲_ (⊴-gives-≼ β γ k) (≼-refl _⊲_) α l
+
+\end{code}
+
 Transfinite induction on the ordinal of ordinals:
 
 \begin{code}
diff --git a/source/Ordinals/OrdinalOfTruthValues.lagda b/source/Ordinals/OrdinalOfTruthValues.lagda
index 4837da0cf..dbc11fb4f 100644
--- a/source/Ordinals/OrdinalOfTruthValues.lagda
+++ b/source/Ordinals/OrdinalOfTruthValues.lagda
@@ -15,10 +15,8 @@ module Ordinals.OrdinalOfTruthValues
        (pe : propext 𝓤)
        where
 
-open import UF.Subsingletons-FunExt
 
 open import Ordinals.Arithmetic fe
-open import Ordinals.Equivalence
 open import Ordinals.Maps
 open import Ordinals.Notions
 open import Ordinals.Type
diff --git a/source/Ordinals/SupSum.lagda b/source/Ordinals/SupSum.lagda
index 9b3bc9df4..e5c6d6272 100644
--- a/source/Ordinals/SupSum.lagda
+++ b/source/Ordinals/SupSum.lagda
@@ -29,7 +29,6 @@ module Ordinals.SupSum
 
 open import MLTT.Spartan
 open import Notation.CanonicalMap
-open import Ordinals.Equivalence
 open import Ordinals.Maps
 open import Ordinals.OrdinalOfOrdinals ua
 open import Ordinals.OrdinalOfOrdinalsSuprema ua
@@ -142,7 +141,7 @@ module _ {𝓤 : Universe}
   where
    open import Ordinals.OrdinalOfTruthValues fe 𝓤 (pe 𝓤)
    open Omega (pe 𝓤)
-   open import Ordinals.ArithmeticProperties ua
+   open import Ordinals.AdditionProperties ua
 
    τ = 𝟚ᵒ
 
diff --git a/source/Ordinals/Taboos.lagda b/source/Ordinals/Taboos.lagda
index 5869362ec..a5b76ebf7 100644
--- a/source/Ordinals/Taboos.lagda
+++ b/source/Ordinals/Taboos.lagda
@@ -237,8 +237,6 @@ module _
   fe = Univalence-gives-FunExt ua
 
  open import NotionsOfDecidability.Decidable
- open import NotionsOfDecidability.DecidableClassifier
- open import NotionsOfDecidability.Complemented
 
  open import Ordinals.Arithmetic fe
  open import Ordinals.OrdinalOfOrdinals ua
diff --git a/source/Ordinals/ToppedArithmetic.lagda b/source/Ordinals/ToppedArithmetic.lagda
index bf0004dcc..2c23cad8d 100644
--- a/source/Ordinals/ToppedArithmetic.lagda
+++ b/source/Ordinals/ToppedArithmetic.lagda
@@ -146,7 +146,6 @@ module Omega {𝓤} (pe : propext 𝓤) where
 
  open import Ordinals.OrdinalOfTruthValues fe 𝓤 pe
  open import Ordinals.Notions
- open import UF.Subsingletons-FunExt
  open import UF.SubtypeClassifier
 
  Ωᵒ : Ordinalᵀ (𝓤 ⁺)
diff --git a/source/Ordinals/ToppedType.lagda b/source/Ordinals/ToppedType.lagda
index 8ad8ccd98..a85d7f53a 100644
--- a/source/Ordinals/ToppedType.lagda
+++ b/source/Ordinals/ToppedType.lagda
@@ -17,7 +17,6 @@ open import Notation.CanonicalMap
 open import Ordinals.Notions
 open import Ordinals.Type
 open import Ordinals.Underlying
-open import UF.Base
 open import UF.Sets
 open import UF.Subsingletons
 
diff --git a/source/Ordinals/TrichotomousArithmetic.lagda b/source/Ordinals/TrichotomousArithmetic.lagda
index 31a685dea..5af1985d0 100644
--- a/source/Ordinals/TrichotomousArithmetic.lagda
+++ b/source/Ordinals/TrichotomousArithmetic.lagda
@@ -12,7 +12,6 @@ module Ordinals.TrichotomousArithmetic
         (fe : FunExt)
        where
 
-open import UF.Subsingletons
 
 open import MLTT.Spartan
 open import Notation.CanonicalMap
diff --git a/source/Ordinals/TrichotomousType.lagda b/source/Ordinals/TrichotomousType.lagda
index a01a3cdd4..ab75fadae 100644
--- a/source/Ordinals/TrichotomousType.lagda
+++ b/source/Ordinals/TrichotomousType.lagda
@@ -17,7 +17,6 @@ open import Notation.CanonicalMap
 open import Ordinals.Notions
 open import Ordinals.Type
 open import Ordinals.Underlying
-open import UF.Base
 open import UF.Sets
 open import UF.Subsingletons
 
diff --git a/source/Ordinals/Underlying.lagda b/source/Ordinals/Underlying.lagda
index dcdce05b4..ac51f4b5f 100644
--- a/source/Ordinals/Underlying.lagda
+++ b/source/Ordinals/Underlying.lagda
@@ -12,7 +12,7 @@ module Ordinals.Underlying where
 open import MLTT.Spartan
 open import Ordinals.Notions
 
-record Underlying {𝓤} (O : 𝓤 ⁺ ̇ ) : 𝓤 ⁺ ̇  where
+record Underlying {𝓤} (O : 𝓤 ⁺ ̇ ) : 𝓤 ⁺ ̇ where
  field
   ⟨_⟩              : O → 𝓤 ̇
   underlying-order : (α : O) → ⟨ α ⟩ → ⟨ α ⟩ → 𝓤 ̇
diff --git a/source/Ordinals/WellOrderArithmetic.lagda b/source/Ordinals/WellOrderArithmetic.lagda
index f1f9a40fa..a77b3b580 100644
--- a/source/Ordinals/WellOrderArithmetic.lagda
+++ b/source/Ordinals/WellOrderArithmetic.lagda
@@ -104,10 +104,14 @@ and then adapt the following definitions.
              → is-extensional _<_
              → is-extensional _≺_
              → is-extensional _⊏_
- extensional w e e' (inl x) (inl x') f g = ap inl (e x x' (f ∘ inl) (g ∘ inl))
- extensional w e e' (inl x) (inr y') f g = 𝟘-elim (irreflexive _<_ x (w x) (g (inl x) ⋆))
- extensional w e e' (inr y) (inl x') f g = 𝟘-elim (irreflexive _<_ x' (w x') (f (inl x') ⋆))
- extensional w e e' (inr y) (inr y') f g = ap inr (e' y y' (f ∘ inr) (g ∘ inr))
+ extensional w e e' (inl x) (inl x') f g =
+  ap inl (e x x' (f ∘ inl) (g ∘ inl))
+ extensional w e e' (inl x) (inr y') f g =
+  𝟘-elim (irreflexive _<_ x (w x) (g (inl x) ⋆))
+ extensional w e e' (inr y) (inl x') f g =
+  𝟘-elim (irreflexive _<_ x' (w x') (f (inl x') ⋆))
+ extensional w e e' (inr y) (inr y') f g =
+  ap inr (e' y y' (f ∘ inr) (g ∘ inr))
 
  transitive : is-transitive _<_
             → is-transitive _≺_
@@ -146,10 +150,8 @@ and then adapt the following definitions.
  well-order : is-well-order _<_
             → is-well-order _≺_
             → is-well-order _⊏_
- well-order (p , w , e , t) (p' , w' , e' , t') = prop-valued p p' ,
-                                                  well-founded w w' ,
-                                                  extensional w e e' ,
-                                                  transitive t t'
+ well-order (p , w , e , t) (p' , w' , e' , t') =
+  prop-valued p p' , well-founded w w' , extensional w e e' , transitive t t'
 
  top-preservation : has-top _≺_ → has-top _⊏_
  top-preservation (y , f) = inr y , g
@@ -224,6 +226,11 @@ module successor
 
 Multiplication. Cartesian product with the lexicographic order.
 
+Fredrik Nordvall Forsberg, 3 November 2023: Changed order of multiplication to
+reverse lexicographic order to adhere to the standard convention.
+
+Martin Escardo 13th September 2024. But notice that for sums we can't do this swap, due to type dependency, and hence *swapped* mulplication is a particular case of ordinal sum.
+
 \begin{code}
 
 module times
@@ -235,8 +242,8 @@ module times
        where
 
  private
-  _⊏_ : X × Y → X × Y → 𝓤 ⊔ 𝓦 ⊔ 𝓣 ̇
-  (a , b) ⊏ (x , y) = (a < x) + ((a ＝ x) × (b ≺ y))
+  _⊏_ : X × Y → X × Y → 𝓣 ⊔ 𝓥 ⊔ 𝓦 ̇
+  (a , b) ⊏ (x , y) = (b ≺ y) + ((b ＝ y) × (a < x))
 
  order = _⊏_
 
@@ -248,21 +255,25 @@ module times
    P : X × Y → 𝓤 ⊔ 𝓥 ⊔ 𝓦 ⊔ 𝓣 ̇
    P = is-accessible _⊏_
 
-   γ : (x : X) → ((x' : X) → x' < x → (y' : Y) → P (x' , y')) → (y : Y) → P (x , y)
-   γ x s = transfinite-induction _≺_ w' (λ y → P (x , y)) (λ y f → acc (ψ y f))
+   γ : (y : Y)
+     → ((y' : Y) → y' ≺ y → (x' : X) → P (x' , y'))
+     → (x : X) → P (x , y)
+   γ y s = transfinite-induction _<_ w (λ x → P (x , y)) (λ x f → acc (ψ x f))
     where
-     ψ : (y : Y) → ((y' : Y) → y' ≺ y → P (x , y')) → (z' : X × Y) → z' ⊏ (x , y) → P z'
-     ψ y f (x' , y') (inl l) = s x' l y'
-     ψ y f (x' , y') (inr (r , m)) = transport⁻¹ P p α
+     ψ : (x : X)
+       → ((x' : X) → x' < x → P (x' , y))
+       → (z' : X × Y) → z' ⊏ (x , y) → P z'
+     ψ x f (x' , y') (inl l) = s y' l x'
+     ψ x f (x' , y') (inr (r , m)) = transport⁻¹ P p α
       where
-       α : P (x , y')
-       α = f y' m
+       α : P (x' , y)
+       α = f x' m
 
-       p : (x' , y') ＝ (x , y')
-       p = to-×-＝ r refl
+       p : (x' , y') ＝ (x' , y)
+       p = to-×-＝ refl r
 
    φ : (x : X) (y : Y) → P (x , y)
-   φ = transfinite-induction _<_ w (λ x → (y : Y) → P (x , y)) γ
+   φ x y = transfinite-induction _≺_ w' (λ y → (x : X) → P (x , y)) γ y x
 
  transitive : is-transitive _<_
             → is-transitive _≺_
@@ -270,10 +281,10 @@ module times
  transitive t t' (a , b) (x , y) (u , v) = f
   where
    f : (a , b) ⊏ (x , y) → (x , y) ⊏ (u , v) → (a , b) ⊏ (u , v)
-   f (inl l)       (inl m)          = inl (t _ _ _ l m)
-   f (inl l)       (inr (q , m))    = inl (transport (λ - → a < -) q l)
-   f (inr (r , l)) (inl m)          = inl (transport⁻¹ (λ - → - < u) r m)
-   f (inr (r , l)) (inr (refl , m)) = inr (r , (t' _ _ _ l m))
+   f (inl l)       (inl m)          = inl (t' _ _ _ l m)
+   f (inl l)       (inr (q , m))    = inl (transport (λ - → b ≺ -) q l)
+   f (inr (r , l)) (inl m)          = inl (transport⁻¹ (λ - → - ≺ v) r m)
+   f (inr (r , l)) (inr (refl , m)) = inr (r , (t _ _ _ l m))
 
  extensional : is-well-founded _<_
              → is-well-founded _≺_
@@ -283,38 +294,39 @@ module times
  extensional w w' e e' (a , b) (x , y) f g = to-×-＝ p q
   where
    f' : (u : X) → u < a → u < x
-   f' u l = Cases (f (u , y) (inl l))
-             (λ (m : u < x) → m)
-             (λ (σ : (u ＝ x) × (y ≺ y)) → 𝟘-elim (irreflexive _≺_ y (w' y) (pr₂ σ)))
+   f' u l = Cases (f (u , b) (inr (refl , l)))
+             (λ (m : b ≺ y)
+                → 𝟘-elim (irreflexive _<_ a (w a)
+                           (Cases (g (a , b) (inl m))
+                             (λ (n : b ≺ b)
+                                → 𝟘-elim (irreflexive _≺_ b (w' b) n))
+                             (λ (σ : (b ＝ b) × (a < a))
+                                → 𝟘-elim (irreflexive _<_ a (w a) (pr₂ σ))))))
+             (λ (σ : (b ＝ y) × (u < x)) → pr₂ σ)
 
    g' : (u : X) → u < x → u < a
-   g' u l = Cases (g ((u , b)) (inl l))
-             (λ (m : u < a) → m)
-             (λ (σ : (u ＝ a) × (b ≺ b)) → 𝟘-elim (irreflexive _≺_ b (w' b) (pr₂ σ)))
+   g' u l = Cases (g (u , y) (inr (refl , l)))
+             (λ (m : y ≺ b)
+                → Cases (f (x , y) (inl m))
+                   (λ (m : y ≺ y) → 𝟘-elim (irreflexive _≺_ y (w' y) m))
+                   (λ (σ : (y ＝ y) × (x < x))
+                      → 𝟘-elim (irreflexive _<_ x (w x) (pr₂ σ))))
+             (λ (σ : (y ＝ b) × (u < a)) → pr₂ σ)
 
    p : a ＝ x
    p = e a x f' g'
 
    f'' : (v : Y) → v ≺ b → v ≺ y
-   f'' v l = Cases (f (a , v) (inr (refl , l)))
-              (λ (m : a < x)
-                 → 𝟘-elim (irreflexive _≺_ b (w' b)
-                             (Cases (g (a , b) (inl m))
-                              (λ (n : a < a) → 𝟘-elim (irreflexive _<_ a (w a) n))
-                              (λ (σ : (a ＝ a) × (b ≺ b)) → 𝟘-elim (irreflexive _≺_ b (w' b) (pr₂ σ))))))
-              (λ (σ : (a ＝ x) × (v ≺ y))
-                 → pr₂ σ)
+   f'' v l = Cases (f (x , v) (inl l))
+              (λ (m : v ≺ y) → m)
+              (λ (σ : (v ＝ y) × (x < x))
+                 → 𝟘-elim (irreflexive _<_ x (w x) (pr₂ σ)))
 
    g'' : (v : Y) → v ≺ y → v ≺ b
-   g'' v l = Cases (g (x , v) (inr (refl , l)))
-              (λ (m : x < a)
-                 → Cases (f (x , y) (inl m))
-                     (λ (m : x < x)
-                        → 𝟘-elim (irreflexive _<_ x (w x) m))
-                     (λ (σ : (x ＝ x) × (y ≺ y))
-                        → 𝟘-elim (irreflexive _≺_ y (w' y) (pr₂ σ))))
-              (λ (σ : (x ＝ a) × (v ≺ b))
-                 → pr₂ σ)
+   g'' v l = Cases (g (a , v) (inl l))
+              (λ (m : v ≺ b) → m)
+              (λ (σ : (v ＝ b) × (a < a))
+                 → 𝟘-elim (irreflexive _<_ a (w a) (pr₂ σ)))
 
    q : b ＝ y
    q = e' b y f'' g''
@@ -323,45 +335,47 @@ module times
             → is-well-order _<_
             → is-well-order _≺_
             → is-well-order _⊏_
- well-order fe (p , w , e , t) (p' , w' , e' , t') = prop-valued ,
-                                                     well-founded w w' ,
-                                                     extensional w w' e e' ,
-                                                     transitive t t'
+ well-order fe (p , w , e , t) (p' , w' , e' , t') =
+  prop-valued , well-founded w w' , extensional w w' e e' , transitive t t'
   where
    prop-valued : is-prop-valued _⊏_
    prop-valued (a , b) (x , y) (inl l) (inl m) =
-     ap inl (p a x l m)
+    ap inl (p' b y l m)
    prop-valued (a , b) (x , y) (inl l) (inr (s , m)) =
-     𝟘-elim (irreflexive _<_ x (w x) (transport (λ - → - < x) s l))
+    𝟘-elim (irreflexive _≺_ y (w' y) (transport (λ - → - ≺ y) s l))
    prop-valued (a , b) (x , y) (inr (r , l)) (inl m) =
-     𝟘-elim (irreflexive _<_ x (w x) (transport (λ - → - < x) r m))
+    𝟘-elim (irreflexive _≺_ y (w' y) (transport (λ - → - ≺ y) r m))
    prop-valued (a , b) (x , y) (inr (r , l)) (inr (s , m)) =
-     ap inr (to-×-＝ (well-ordered-types-are-sets _<_ fe (p , w , e , t) r s) (p' b y l m))
+    ap inr (to-×-＝ (well-ordered-types-are-sets _≺_ fe
+                      (p' , w' , e' , t')
+                      r
+                      s)
+                    (p a x l m))
 
  top-preservation : has-top _<_ → has-top _≺_ → has-top _⊏_
  top-preservation (x , f) (y , g) = (x , y) , h
   where
    h : (z : X × Y) → ¬ ((x , y) ⊏ z)
-   h (x' , y') (inl l) = f x' l
-   h (x' , y') (inr (r , l)) = g y' l
+   h (x' , y') (inl l) = g y' l
+   h (x' , y') (inr (r , l)) = f x' l
 
  tricho : {x : X} {y : Y}
         → is-trichotomous-element _<_ x
         → is-trichotomous-element _≺_ y
         → is-trichotomous-element _⊏_ (x , y)
  tricho {x} {y} t u (x' , y') =
-  Cases (t x')
-   (λ (l : x < x') → inl (inl l))
+  Cases (u y')
+   (λ (l : y ≺ y') → inl (inl l))
    (cases
-     (λ (p : x ＝ x')
-        → Cases (u y')
-           (λ (l : y ≺ y')
+     (λ (p : y ＝ y')
+        → Cases (t x')
+           (λ (l : x < x')
               → inl (inr (p , l)))
            (cases
-             (λ (q : y ＝ y')
-                → inr (inl (to-×-＝ p q)))
-             (λ (l : y' ≺ y) → inr (inr (inr ((p ⁻¹) , l))))))
-     (λ (l : x' < x) → inr (inr (inl l))))
+             (λ (q : x ＝ x')
+                → inr (inl (to-×-＝ q p)))
+             (λ (l : x' < x) → inr (inr (inr ((p ⁻¹) , l))))))
+     (λ (l : y' ≺ y) → inr (inr (inl l))))
 
  trichotomy-preservation : is-trichotomous-order _<_
                          → is-trichotomous-order _≺_
@@ -434,7 +448,6 @@ constructed in the module UF.PropIndexedPiSigma:
 
 \begin{code}
 
- open import UF.Equiv
  open import UF.PropIndexedPiSigma
 
  private
@@ -686,14 +699,14 @@ module sum
              → ((x : X) → is-prop-valued (_≺_ {x}))
              → is-prop-valued _⊏_
  prop-valued fe p w e f (a , b) (x , y) (inl l) (inl m) =
-   ap inl (p a x l m)
+  ap inl (p a x l m)
  prop-valued fe p w e f (a , b) (x , y) (inl l) (inr (s , m)) =
-   𝟘-elim (irreflexive _<_ x (w x) (transport (λ - → - < x) s l))
+  𝟘-elim (irreflexive _<_ x (w x) (transport (λ - → - < x) s l))
  prop-valued fe p w e f (a , b) (x , y) (inr (r , l)) (inl m) =
-   𝟘-elim (irreflexive _<_ x (w x) (transport (λ - → - < x) r m))
+  𝟘-elim (irreflexive _<_ x (w x) (transport (λ - → - < x) r m))
  prop-valued fe p _ e f (a , b) (x , y) (inr (r , l)) (inr (s , m)) =
-   ap inr (to-Σ-＝ (extensionally-ordered-types-are-sets _<_ fe p e r s ,
-                     (f x (transport Y s b) y _ m)))
+  ap inr (to-Σ-＝ (extensionally-ordered-types-are-sets _<_ fe p e r s ,
+                    (f x (transport Y s b) y _ m)))
 
  tricho : {x : X} {y : Y x}
         → is-trichotomous-element _<_ x
@@ -710,12 +723,15 @@ module sum
            (cases
              (λ (q : y ＝ transport⁻¹ Y p y')
                 → inr (inl (to-Σ-＝
-                             (p , (transport Y p y                    ＝⟨ ap (transport Y p) q ⟩
-                                   transport Y p (transport⁻¹ Y p y') ＝⟨ back-and-forth-transport p ⟩
+                             (p , (transport Y p y                    ＝⟨ I p q ⟩
+                                   transport Y p (transport⁻¹ Y p y') ＝⟨ II p ⟩
                                    y'                                 ∎
                                       )))))
              (λ (l : transport⁻¹ Y p y' ≺ y) → inr (inr (inr ((p ⁻¹) , l))))))
      (λ (l : x' < x) → inr (inr (inl l))))
+      where
+       I  = λ p → ap (transport Y p)
+       II = back-and-forth-transport
 
  trichotomy-preservation : is-trichotomous-order _<_
                          → ((x : X) → is-trichotomous-order (_≺_ {x}))
@@ -726,8 +742,8 @@ module sum
 
 The above trichotomy preservation added 19th April 2022.
 
-We know how to prove extensionality either assuming top elements or
-assuming cotransitivity. We do this in the following two modules.
+We know show how to prove extensionality either assuming top elements
+or assuming cotransitivity. We do this in the following two modules.
 
 \begin{code}
 
@@ -740,7 +756,7 @@ module sum-top
         (_≺_ : {x : X} → Y x → Y x → 𝓣 ̇ )
         (top : Π Y)
         (ist : (x : X) → is-top _≺_ (top x))
-      where
+       where
 
  open sum {𝓤} {𝓥} {𝓦} {𝓣} {X} {Y} _<_  _≺_ public
 
@@ -774,27 +790,30 @@ module sum-top
    p =  e a x f' g'
 
    f'' : (v : Y x) → v ≺ transport Y p b → v ≺ y
-   f'' v l = Cases (f (x , v) (inr ((p ⁻¹) , transport-right-rel _≺_ a x b v p l)))
-              (λ (l : x < x)
-                 → 𝟘-elim (irreflexive _<_ x (w x) l))
-              (λ (σ : Σ r ꞉ x ＝ x , transport Y r v ≺ y)
-                 → φ σ)
-              where
-               φ : (σ : Σ r ꞉ x ＝ x , transport Y r v ≺ y) → v ≺ y
-               φ (r , l) = transport
-                            (λ - → transport Y - v ≺ y)
-                            (extensionally-ordered-types-are-sets _<_ fe ispv e r refl)
-                            l
+   f'' v l =
+    Cases (f (x , v) (inr ((p ⁻¹) , transport-right-rel _≺_ a x b v p l)))
+     (λ (l : x < x)
+        → 𝟘-elim (irreflexive _<_ x (w x) l))
+     (λ (σ : Σ r ꞉ x ＝ x , transport Y r v ≺ y)
+        → φ σ)
+     where
+      φ : (σ : Σ r ꞉ x ＝ x , transport Y r v ≺ y) → v ≺ y
+      φ (r , l) =
+       transport
+        (λ - → transport Y - v ≺ y)
+        (extensionally-ordered-types-are-sets _<_ fe ispv e r refl)
+        l
 
    g'' : (u : Y x) → u ≺ y → u ≺ transport Y p b
-   g'' u m = Cases (g (x , u) (inr (refl , m)))
-              (λ (l : x < a)
-                 → 𝟘-elim (irreflexive _<_ x (w x) (transport (λ - → x < -) p l)))
-              (λ (σ : Σ r ꞉ x ＝ a , transport Y r u ≺ b)
-                 → transport
-                     (λ - → u ≺ transport Y - b)
-                     (extensionally-ordered-types-are-sets _<_ fe ispv e ((pr₁ σ)⁻¹) p)
-                     (transport-left-rel _≺_ a x b u (pr₁ σ) (pr₂ σ)))
+   g'' u m =
+    Cases (g (x , u) (inr (refl , m)))
+     (λ (l : x < a)
+        → 𝟘-elim (irreflexive _<_ x (w x) (transport (λ - → x < -) p l)))
+     (λ (σ : Σ r ꞉ x ＝ a , transport Y r u ≺ b)
+        → transport
+            (λ - → u ≺ transport Y - b)
+            (extensionally-ordered-types-are-sets _<_ fe ispv e ((pr₁ σ)⁻¹) p)
+            (transport-left-rel _≺_ a x b u (pr₁ σ) (pr₂ σ)))
 
    q : transport Y p b ＝ y
    q = e' x (transport Y p b) y f'' g''
@@ -802,15 +821,16 @@ module sum-top
  well-order : is-well-order _<_
             → ((x : X) → is-well-order (_≺_ {x}))
             → is-well-order _⊏_
- well-order (p , w , e , t) f = prop-valued fe p w e (λ x → prop-valuedness _≺_ (f x)) ,
-                                well-founded w (λ x → well-foundedness _≺_ (f x)) ,
-                                extensional
-                                  (prop-valuedness _<_ (p , w , e , t))
-                                     w
-                                     (λ x → well-foundedness _≺_ (f x))
-                                     e
-                                     (λ x → extensionality _≺_ (f x)) ,
-                                transitive t (λ x → transitivity _≺_ (f x))
+ well-order (p , w , e , t) f =
+  prop-valued fe p w e (λ x → prop-valuedness _≺_ (f x)) ,
+  well-founded w (λ x → well-foundedness _≺_ (f x)) ,
+  extensional
+    (prop-valuedness _<_ (p , w , e , t))
+       w
+       (λ x → well-foundedness _≺_ (f x))
+       e
+       (λ x → extensionality _≺_ (f x)) ,
+  transitive t (λ x → transitivity _≺_ (f x))
 
  top-preservation : has-top _<_ → has-top _⊏_
  top-preservation (x , f) = (x , top x) , g
@@ -821,9 +841,11 @@ module sum-top
 
 \end{code}
 
-\begin{code}
+We can prove extensionality from cotransitivity, but this doesn't seem
+to be very useful, as cotransivitiy doesn't have good preservation
+properties.
 
-open import UF.DiscreteAndSeparated
+\begin{code}
 
 module sum-cotransitive
         (fe : FunExt)
@@ -870,29 +892,31 @@ module sum-cotransitive
    p =  e a x f' g'
 
    f'' : (v : Y x) → v ≺ transport Y p b → v ≺ y
-   f'' v l = Cases (f (x , v) (inr ((p ⁻¹) , transport-right-rel _≺_ a x b v p l)))
-              (λ (l : x < x)
-                 → 𝟘-elim (irreflexive _<_ x (w x) l))
-              (λ (σ : Σ r ꞉ x ＝ x , transport Y r v ≺ y)
-                 → φ σ)
-              where
-               φ : (σ : Σ r ꞉ x ＝ x , transport Y r v ≺ y) → v ≺ y
-               φ (r , l) = transport
-                            (λ r → transport Y r v ≺ y)
-                            (extensionally-ordered-types-are-sets _<_ fe
-                              ispv e r refl)
-                            l
+   f'' v l =
+    Cases (f (x , v) (inr ((p ⁻¹) , transport-right-rel _≺_ a x b v p l)))
+     (λ (l : x < x)
+        → 𝟘-elim (irreflexive _<_ x (w x) l))
+     (λ (σ : Σ r ꞉ x ＝ x , transport Y r v ≺ y)
+        → φ σ)
+     where
+      φ : (σ : Σ r ꞉ x ＝ x , transport Y r v ≺ y) → v ≺ y
+      φ (r , l) = transport
+                   (λ r → transport Y r v ≺ y)
+                   (extensionally-ordered-types-are-sets _<_ fe
+                     ispv e r refl)
+                   l
 
    g'' : (u : Y x) → u ≺ y → u ≺ transport Y p b
-   g'' u m = Cases (g (x , u) (inr (refl , m)))
-              (λ (l : x < a)
-                 → 𝟘-elim (irreflexive _<_ x (w x) (transport (λ - → x < -) p l)))
-              (λ (σ : Σ r ꞉ x ＝ a , transport Y r u ≺ b)
-                 → transport
-                     (λ - → u ≺ transport Y - b)
-                     (extensionally-ordered-types-are-sets _<_ fe
-                       ispv e ((pr₁ σ)⁻¹) p)
-                     (transport-left-rel _≺_ a x b u (pr₁ σ) (pr₂ σ)))
+   g'' u m =
+    Cases (g (x , u) (inr (refl , m)))
+     (λ (l : x < a)
+        → 𝟘-elim (irreflexive _<_ x (w x) (transport (λ - → x < -) p l)))
+     (λ (σ : Σ r ꞉ x ＝ a , transport Y r u ≺ b)
+        → transport
+            (λ - → u ≺ transport Y - b)
+            (extensionally-ordered-types-are-sets _<_ fe
+              ispv e ((pr₁ σ)⁻¹) p)
+            (transport-left-rel _≺_ a x b u (pr₁ σ) (pr₂ σ)))
 
    q : transport Y p b ＝ y
    q = e' x (transport Y p b) y f'' g''
@@ -901,15 +925,15 @@ module sum-cotransitive
             → ((x : X) → is-well-order (_≺_ {x}))
             → is-well-order _⊏_
  well-order (p , w , e , t) f =
-   prop-valued fe p w e (λ x → prop-valuedness _≺_ (f x)) ,
-   well-founded w (λ x → well-foundedness _≺_ (f x)) ,
-   extensional
-     (prop-valuedness _<_ (p , w , e , t))
-     w
-     (λ x → well-foundedness _≺_ (f x))
-     e
-     (λ x → extensionality _≺_ (f x)) ,
-   transitive t (λ x → transitivity _≺_ (f x))
+  prop-valued fe p w e (λ x → prop-valuedness _≺_ (f x)) ,
+  well-founded w (λ x → well-foundedness _≺_ (f x)) ,
+  extensional
+    (prop-valuedness _<_ (p , w , e , t))
+    w
+    (λ x → well-foundedness _≺_ (f x))
+    e
+    (λ x → extensionality _≺_ (f x)) ,
+  transitive t (λ x → transitivity _≺_ (f x))
 
 \end{code}
 
@@ -939,7 +963,6 @@ but the constructions still work.
 \begin{code}
 
 open import UF.Embeddings
-open import UF.Equiv
 
 module extension
         (fe : FunExt)
@@ -973,11 +996,11 @@ module extension
 
  top-preservation : ((x : X) → has-top (_<_ {x})) → has-top _≺_
  top-preservation f = φ , g
-   where
-    φ : (p : fiber j a) → Y (pr₁ p)
-    φ (x , r) = pr₁ (f x)
+  where
+   φ : (p : fiber j a) → Y (pr₁ p)
+   φ (x , r) = pr₁ (f x)
 
-    g : (ψ : (Y / j) a) → ¬ (φ ≺ ψ)
-    g ψ ((x , r) , l) = pr₂ (f x) (ψ (x , r)) l
+   g : (ψ : (Y / j) a) → ¬ (φ ≺ ψ)
+   g ψ ((x , r) , l) = pr₂ (f x) (ψ (x , r)) l
 
 \end{code}
diff --git a/source/Ordinals/WellOrderingTaboo.lagda b/source/Ordinals/WellOrderingTaboo.lagda
index d3fc9cdfd..b8f3aaf9e 100644
--- a/source/Ordinals/WellOrderingTaboo.lagda
+++ b/source/Ordinals/WellOrderingTaboo.lagda
@@ -310,7 +310,6 @@ module swan'
 
  open import Quotient.Type
  open import Quotient.Large pt fe pe
- open import UF.ImageAndSurjection pt
 
  open general-set-quotients-exist large-set-quotients
 
@@ -773,7 +772,6 @@ module _
         (pt : propositional-truncations-exist)
        where
 
- open import UF.Retracts
  open import UF.Choice
 
  open Univalent-Choice (λ _ _ → fe) pt
diff --git a/source/Ordinals/index.lagda b/source/Ordinals/index.lagda
index af09af53d..8366bfa77 100644
--- a/source/Ordinals/index.lagda
+++ b/source/Ordinals/index.lagda
@@ -7,7 +7,7 @@ Martin Escardo
 module Ordinals.index where
 
 import Ordinals.Arithmetic
-import Ordinals.ArithmeticProperties
+import Ordinals.AdditionProperties
 import Ordinals.Brouwer
 import Ordinals.BuraliForti                   -- by Bezem, Coquand, Dybjer and Escardo.
 import Ordinals.Closure
@@ -20,6 +20,7 @@ import Ordinals.Indecomposable
 import Ordinals.Injectivity
 import Ordinals.LexicographicOrder
 import Ordinals.Maps
+import Ordinals.MultiplicationProperties      -- by de Jong, Kraus, Nordvall Forsberg, and Xu.
 import Ordinals.NotationInterpretation
 import Ordinals.NotationInterpretation0
 import Ordinals.NotationInterpretation1
diff --git a/source/PCF/Combinatory/PCFCombinators.lagda b/source/PCF/Combinatory/PCFCombinators.lagda
index c647aaf33..a46b16f62 100644
--- a/source/PCF/Combinatory/PCFCombinators.lagda
+++ b/source/PCF/Combinatory/PCFCombinators.lagda
@@ -24,9 +24,7 @@ module PCF.Combinatory.PCFCombinators
 open PropositionalTruncation pt
 
 open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 
-open import OrderedTypes.Poset fe
 open import DomainTheory.Basics.Dcpo pt fe 𝓥
 open import DomainTheory.Basics.Exponential pt fe 𝓥
 open import DomainTheory.Basics.Miscelanea pt fe 𝓥
diff --git a/source/PCF/Combinatory/ScottModelOfPCF.lagda b/source/PCF/Combinatory/ScottModelOfPCF.lagda
index 3bda6ae91..37372182b 100644
--- a/source/PCF/Combinatory/ScottModelOfPCF.lagda
+++ b/source/PCF/Combinatory/ScottModelOfPCF.lagda
@@ -44,7 +44,6 @@ open import PCF.Combinatory.PCF pt
 open import DomainTheory.Basics.Dcpo pt fe 𝓤₀
 open import DomainTheory.Basics.Exponential pt fe 𝓤₀
 open import DomainTheory.Basics.LeastFixedPoint pt fe 𝓤₀
-open import DomainTheory.Basics.Miscelanea pt fe 𝓤₀
 open import DomainTheory.Basics.Pointed pt fe 𝓤₀
 
 open import PCF.Combinatory.PCFCombinators pt fe 𝓤₀
diff --git a/source/PCF/Lambda/AbstractSyntax.lagda b/source/PCF/Lambda/AbstractSyntax.lagda
index 8b0982ba7..af335bb3c 100644
--- a/source/PCF/Lambda/AbstractSyntax.lagda
+++ b/source/PCF/Lambda/AbstractSyntax.lagda
@@ -13,7 +13,6 @@ module PCF.Lambda.AbstractSyntax (pt : propositional-truncations-exist) where
 open PropositionalTruncation pt
 
 open import MLTT.Spartan
-open import Naturals.Properties hiding (pred-succ)
 
 data Vec (X : 𝓤₀ ̇) : ℕ → 𝓤₀ ̇ where
  ⟨⟩  : Vec X zero
@@ -23,7 +22,7 @@ data Fin : (n : ℕ) → 𝓤₀ ̇ where
  zero : ∀ {n} → Fin (succ n)
  succ : ∀ {n} → Fin n → Fin (succ n)
 
-data type : 𝓤₀ ̇  where
+data type : 𝓤₀ ̇ where
  ι : type
  _⇒_ : type → type → type
 
diff --git a/source/PCF/Lambda/Adequacy.lagda b/source/PCF/Lambda/Adequacy.lagda
index f730cd994..3f9d9f456 100644
--- a/source/PCF/Lambda/Adequacy.lagda
+++ b/source/PCF/Lambda/Adequacy.lagda
@@ -22,11 +22,8 @@ open import DomainTheory.Basics.Dcpo pt fe 𝓤₀
 open import DomainTheory.Basics.Exponential pt fe 𝓤₀
 open import DomainTheory.Basics.LeastFixedPoint pt fe 𝓤₀
 open import DomainTheory.Basics.Pointed pt fe 𝓤₀
-open import DomainTheory.Lifting.LiftingDcpo pt fe 𝓤₀ pe
 open import Lifting.Construction 𝓤₀ hiding (⊥)
 open import Lifting.Miscelanea 𝓤₀
-open import Lifting.Miscelanea-PropExt-FunExt 𝓤₀ pe fe
-open import Lifting.Monad 𝓤₀ hiding (μ)
 open import Naturals.Properties hiding (pred-succ)
 open import PCF.Combinatory.PCFCombinators pt fe 𝓤₀
 open import PCF.Lambda.AbstractSyntax pt
diff --git a/source/PCF/Lambda/BigStep.lagda b/source/PCF/Lambda/BigStep.lagda
index a147b06cf..4693449c5 100644
--- a/source/PCF/Lambda/BigStep.lagda
+++ b/source/PCF/Lambda/BigStep.lagda
@@ -13,7 +13,6 @@ module PCF.Lambda.BigStep (pt : propositional-truncations-exist) where
 open PropositionalTruncation pt
 
 open import MLTT.Spartan
-open import Naturals.Properties hiding (pred-succ)
 open import PCF.Lambda.AbstractSyntax pt
 
 data _⇓'_ : ∀ {n : ℕ} {Γ : Context n} {σ : type} → PCF Γ σ → PCF Γ σ → 𝓤₀ ̇ where
diff --git a/source/PCF/Lambda/Correctness.lagda b/source/PCF/Lambda/Correctness.lagda
index 2644c1cd6..38f6e7523 100644
--- a/source/PCF/Lambda/Correctness.lagda
+++ b/source/PCF/Lambda/Correctness.lagda
@@ -17,7 +17,6 @@ module PCF.Lambda.Correctness
 
 open PropositionalTruncation pt
 
-open import DomainTheory.Basics.Curry pt fe 𝓤₀
 open import DomainTheory.Basics.Dcpo pt fe 𝓤₀
 open import DomainTheory.Basics.LeastFixedPoint pt fe 𝓤₀
 open import DomainTheory.Basics.Pointed pt fe 𝓤₀
diff --git a/source/PCF/Lambda/ScottModelOfContexts.lagda b/source/PCF/Lambda/ScottModelOfContexts.lagda
index 841899354..bd06ea2e1 100644
--- a/source/PCF/Lambda/ScottModelOfContexts.lagda
+++ b/source/PCF/Lambda/ScottModelOfContexts.lagda
@@ -17,12 +17,10 @@ module PCF.Lambda.ScottModelOfContexts
 
 open PropositionalTruncation pt
 
-open import DomainTheory.Basics.Curry pt fe 𝓤₀
 open import DomainTheory.Basics.Dcpo pt fe 𝓤₀
 open import DomainTheory.Basics.FunctionComposition pt fe 𝓤₀
 open import DomainTheory.Basics.Pointed pt fe 𝓤₀
 open import DomainTheory.Basics.Products pt fe
-open import DomainTheory.Lifting.LiftingSet pt fe 𝓤₀ pe
 open import PCF.Lambda.AbstractSyntax pt
 open import PCF.Lambda.ScottModelOfTypes pt fe pe
 open import OrderedTypes.Poset fe
diff --git a/source/PCF/Lambda/ScottModelOfIfZero.lagda b/source/PCF/Lambda/ScottModelOfIfZero.lagda
index a01b2b740..15a40cd86 100644
--- a/source/PCF/Lambda/ScottModelOfIfZero.lagda
+++ b/source/PCF/Lambda/ScottModelOfIfZero.lagda
@@ -18,17 +18,13 @@ module PCF.Lambda.ScottModelOfIfZero
 open PropositionalTruncation pt
 
 open import DomainTheory.Basics.Curry pt fe 𝓤₀
-open import DomainTheory.Basics.Dcpo pt fe 𝓤₀
 open import DomainTheory.Basics.Exponential pt fe 𝓤₀
 open import DomainTheory.Basics.FunctionComposition pt fe 𝓤₀
 open import DomainTheory.Basics.Pointed pt fe 𝓤₀
 open import DomainTheory.Basics.Products pt fe
-open import DomainTheory.Lifting.LiftingSet pt fe 𝓤₀ pe
 open import PCF.Combinatory.PCFCombinators pt fe 𝓤₀
 open import PCF.Lambda.AbstractSyntax pt
 open import PCF.Lambda.ScottModelOfContexts pt fe pe
-open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 
 open DcpoProductsGeneral 𝓤₀
 open IfZeroDenotationalSemantics pe
diff --git a/source/PCF/Lambda/ScottModelOfTerms.lagda b/source/PCF/Lambda/ScottModelOfTerms.lagda
index d45745bad..16ca6617a 100644
--- a/source/PCF/Lambda/ScottModelOfTerms.lagda
+++ b/source/PCF/Lambda/ScottModelOfTerms.lagda
@@ -18,7 +18,6 @@ module PCF.Lambda.ScottModelOfTerms
 open PropositionalTruncation pt
 
 open import DomainTheory.Basics.Curry pt fe 𝓤₀
-open import DomainTheory.Basics.Dcpo pt fe 𝓤₀
 open import DomainTheory.Basics.FunctionComposition pt fe 𝓤₀
 open import DomainTheory.Basics.LeastFixedPoint pt fe 𝓤₀
 open import DomainTheory.Basics.Miscelanea pt fe 𝓤₀
diff --git a/source/PCF/Lambda/ScottModelOfTypes.lagda b/source/PCF/Lambda/ScottModelOfTypes.lagda
index 3f2459491..e65398854 100644
--- a/source/PCF/Lambda/ScottModelOfTypes.lagda
+++ b/source/PCF/Lambda/ScottModelOfTypes.lagda
@@ -15,7 +15,6 @@ module PCF.Lambda.ScottModelOfTypes
         (pe : propext 𝓤₀)
        where
 
-open import DomainTheory.Basics.Dcpo pt fe 𝓤₀
 open import DomainTheory.Basics.Exponential pt fe 𝓤₀
 open import DomainTheory.Basics.Pointed pt fe 𝓤₀
 open import DomainTheory.Lifting.LiftingSet pt fe 𝓤₀ pe
diff --git a/source/PCF/Lambda/Substitution.lagda b/source/PCF/Lambda/Substitution.lagda
index a69eb9605..bad4e9e98 100644
--- a/source/PCF/Lambda/Substitution.lagda
+++ b/source/PCF/Lambda/Substitution.lagda
@@ -17,10 +17,8 @@ module PCF.Lambda.Substitution
 
 open PropositionalTruncation pt
 
-open import Naturals.Properties
 open import PCF.Lambda.AbstractSyntax pt
 open import UF.Base
-open import UF.Subsingletons
 
 ids : {n : ℕ} {Γ : Context n} {A : type} → Γ ∋ A → PCF Γ A
 ids x = v x
diff --git a/source/PCF/Lambda/SubstitutionDenotational.lagda b/source/PCF/Lambda/SubstitutionDenotational.lagda
index eff3de5ea..a2d69e16d 100644
--- a/source/PCF/Lambda/SubstitutionDenotational.lagda
+++ b/source/PCF/Lambda/SubstitutionDenotational.lagda
@@ -17,24 +17,18 @@ module PCF.Lambda.SubstitutionDenotational
 
 open PropositionalTruncation pt
 
-open import DomainTheory.Basics.Curry pt fe 𝓤₀
 open import DomainTheory.Basics.Dcpo pt fe 𝓤₀
 open import DomainTheory.Basics.LeastFixedPoint pt fe 𝓤₀
 open import DomainTheory.Basics.Pointed pt fe 𝓤₀
 open import DomainTheory.Basics.Products pt fe
-open import DomainTheory.Basics.ProductsContinuity pt fe 𝓤₀
-open import Lifting.Construction 𝓤₀
-open import Lifting.Miscelanea-PropExt-FunExt 𝓤₀ pe fe
 open import Lifting.Monad 𝓤₀ hiding (μ)
 open import Naturals.Properties
 open import PCF.Combinatory.PCFCombinators pt fe 𝓤₀
 open import PCF.Lambda.AbstractSyntax pt
 open import PCF.Lambda.ScottModelOfContexts pt fe pe
-open import PCF.Lambda.ScottModelOfIfZero pt fe pe
 open import PCF.Lambda.ScottModelOfTerms pt fe pe
 open import PCF.Lambda.ScottModelOfTypes pt fe pe
 open import UF.Base
-open import UF.Subsingletons
 
 open DcpoProductsGeneral 𝓤₀
 open IfZeroDenotationalSemantics pe
diff --git a/source/PathSequences/Ap.lagda b/source/PathSequences/Ap.lagda
index e8a901de6..98c820201 100644
--- a/source/PathSequences/Ap.lagda
+++ b/source/PathSequences/Ap.lagda
@@ -13,7 +13,6 @@ library to TypeTopology.
 
 open import MLTT.Spartan
 open import UF.Base
-open import UF.Equiv
 open import PathSequences.Type
 open import PathSequences.Reasoning
 
diff --git a/source/PathSequences/Inversion.lagda b/source/PathSequences/Inversion.lagda
index 1d415146d..1a642bdc9 100644
--- a/source/PathSequences/Inversion.lagda
+++ b/source/PathSequences/Inversion.lagda
@@ -15,7 +15,6 @@ Inversion of path sequences.
 
 open import MLTT.Spartan
 open import UF.Base
-open import UF.Equiv
 open import PathSequences.Type
 open import PathSequences.Concat
 open import PathSequences.Reasoning
diff --git a/source/PathSequences/Reasoning.lagda b/source/PathSequences/Reasoning.lagda
index b668ac2b4..8cda4fc19 100644
--- a/source/PathSequences/Reasoning.lagda
+++ b/source/PathSequences/Reasoning.lagda
@@ -13,7 +13,6 @@ library to TypeTopology.
 {-# OPTIONS --without-K --exact-split --safe #-}
 
 open import MLTT.Spartan
-open import UF.Base
 open import UF.Equiv
 open import PathSequences.Type
 open import PathSequences.Concat
diff --git a/source/PathSequences/Rotations.lagda b/source/PathSequences/Rotations.lagda
index 4ab24daf3..65605209d 100644
--- a/source/PathSequences/Rotations.lagda
+++ b/source/PathSequences/Rotations.lagda
@@ -15,7 +15,6 @@ Rotating path sequences.
 
 open import MLTT.Spartan
 open import UF.Base
-open import UF.Equiv
 open import PathSequences.Type
 open import PathSequences.Concat
 open import PathSequences.Reasoning
diff --git a/source/PathSequences/Split.lagda b/source/PathSequences/Split.lagda
index 533a6ae6c..e041d0540 100644
--- a/source/PathSequences/Split.lagda
+++ b/source/PathSequences/Split.lagda
@@ -13,7 +13,6 @@ library to TypeTopology.
 {-# OPTIONS --without-K --safe #-}
 
 open import MLTT.Spartan
-open import UF.Base
 open import PathSequences.Type
 open import PathSequences.Concat
 
diff --git a/source/PathSequences/Type.lagda b/source/PathSequences/Type.lagda
index 5fd7795c8..369c9c91b 100644
--- a/source/PathSequences/Type.lagda
+++ b/source/PathSequences/Type.lagda
@@ -15,7 +15,6 @@ library to TypeTopology.
 module PathSequences.Type where
 
 open import MLTT.Spartan
-open import UF.Base
 
 \end{code}
 
diff --git a/source/Quotient/Effectivity.lagda b/source/Quotient/Effectivity.lagda
index ad81a9ae7..b420d2f45 100644
--- a/source/Quotient/Effectivity.lagda
+++ b/source/Quotient/Effectivity.lagda
@@ -32,14 +32,7 @@ open import MLTT.Spartan
 open import Quotient.Type
 open import Quotient.Large
 open import Quotient.GivesPropTrunc
-open import UF.Base hiding (_≈_)
-open import UF.Equiv
 open import UF.PropTrunc
-open import UF.Sets
-open import UF.Sets-Properties
-open import UF.SubtypeClassifier
-open import UF.SubtypeClassifier-Properties
-open import UF.Subsingletons-FunExt
 
 effectivity : (sq : set-quotients-exist)
             → are-effective sq
diff --git a/source/Quotient/FromSetReplacement.lagda b/source/Quotient/FromSetReplacement.lagda
index f8a803a2b..e31d68661 100644
--- a/source/Quotient/FromSetReplacement.lagda
+++ b/source/Quotient/FromSetReplacement.lagda
@@ -19,12 +19,7 @@ replacement assumption (again, see UF.Size.lagda for details).
 {-# OPTIONS --safe --without-K #-}
 
 open import UF.FunExt
-open import UF.Powerset
 open import UF.PropTrunc
-open import UF.Sets
-open import UF.Sets-Properties
-open import UF.SubtypeClassifier
-open import UF.SubtypeClassifier-Properties
 open import UF.Subsingletons
 
 module Quotient.FromSetReplacement
@@ -35,14 +30,18 @@ module Quotient.FromSetReplacement
 
 open import MLTT.Spartan
 
-open import UF.Base hiding (_≈_)
-open import UF.Subsingletons-FunExt
-open import UF.ImageAndSurjection
 open import UF.Equiv
+open import UF.EquivalenceExamples
+open import UF.Powerset
+open import UF.Sets
+open import UF.Sets-Properties
+open import UF.Size
+open import UF.Subsingletons-FunExt
+open import UF.SubtypeClassifier
+open import UF.SubtypeClassifier-Properties
 
 open import Quotient.Large pt fe pe
 open import Quotient.Type -- using (set-quotients-exist ; is-effective ; EqRel)
-open import UF.Size
 
 open general-set-quotients-exist large-set-quotients
 
@@ -52,9 +51,6 @@ module _
         (≋@(_≈_ , ≈p , ≈r , ≈s , ≈t) : EqRel {𝓤} {𝓥} X)
        where
 
- open import UF.Equiv
- open import UF.EquivalenceExamples
-
  abstract
   resize-set-quotient : (X / ≋) is (𝓤 ⊔ 𝓥) small
   resize-set-quotient = R equiv-rel (X , (≃-refl X)) γ
diff --git a/source/Quotient/GivesPropTrunc.lagda b/source/Quotient/GivesPropTrunc.lagda
index 065e56144..656bd3748 100644
--- a/source/Quotient/GivesPropTrunc.lagda
+++ b/source/Quotient/GivesPropTrunc.lagda
@@ -1,4 +1,4 @@
-.Tom de Jong, 4 & 5 April 2022.
+Tom de Jong, 4 & 5 April 2022.
 
 Assuming set quotients, we derive propositional truncations in the
 presence of function extensionality.
@@ -30,7 +30,7 @@ module _ (sq : set-quotients-exist) where
    ≋ : EqRel X
    ≋ = _≈_ , (λ x y → 𝟙-is-prop) , (λ x → ⋆) , (λ x y _ → ⋆) , (λ x y z _ _ → ⋆)
 
-  ∥_∥ : 𝓤 ̇  → 𝓤 ̇
+  ∥_∥ : 𝓤 ̇ → 𝓤 ̇
   ∥_∥ X = X / ≋
 
   ∣_∣ : {X : 𝓤 ̇ } → X → ∥ X ∥
diff --git a/source/Quotient/Large-Variation.lagda b/source/Quotient/Large-Variation.lagda
index 2bef1d8e4..45843ea33 100644
--- a/source/Quotient/Large-Variation.lagda
+++ b/source/Quotient/Large-Variation.lagda
@@ -12,7 +12,6 @@ For more comments and explanations, see the original files.
 open import MLTT.Spartan
 
 open import UF.Base hiding (_≈_)
-open import UF.Equiv
 open import UF.FunExt
 open import UF.Powerset
 open import UF.Sets
diff --git a/source/Quotient/Large.lagda b/source/Quotient/Large.lagda
index eb2326d18..580230c79 100644
--- a/source/Quotient/Large.lagda
+++ b/source/Quotient/Large.lagda
@@ -35,9 +35,7 @@ open import MLTT.Spartan
 
 open import Quotient.Type
 open import UF.Base hiding (_≈_)
-open import UF.Equiv
 open import UF.FunExt
-open import UF.Hedberg
 open import UF.Powerset
 open import UF.PropTrunc
 open import UF.Sets
diff --git a/source/Rationals/Abs.lagda b/source/Rationals/Abs.lagda
index 4b15f68d1..0041e8be8 100644
--- a/source/Rationals/Abs.lagda
+++ b/source/Rationals/Abs.lagda
@@ -10,13 +10,10 @@ open import MLTT.Spartan renaming (_+_ to _∔_)
 
 open import Notation.Order
 open import UF.Base hiding (_≈_)
-open import UF.Subsingletons
 open import Integers.Abs
-open import Integers.Addition renaming (_+_ to _ℤ+_) hiding (_-_)
 open import Integers.Type hiding (abs)
 open import Integers.Multiplication renaming (_*_ to _ℤ*_)
 open import Integers.Order
-open import Naturals.Multiplication renaming (_*_ to _ℕ*_)
 open import Rationals.Fractions
 open import Rationals.FractionsOperations renaming (abs to 𝔽-abs) renaming (-_ to 𝔽-_) hiding (_+_) hiding (_*_)
 open import Rationals.Type
diff --git a/source/Rationals/Addition.lagda b/source/Rationals/Addition.lagda
index ed270a038..612509ee2 100644
--- a/source/Rationals/Addition.lagda
+++ b/source/Rationals/Addition.lagda
@@ -12,7 +12,6 @@ open import MLTT.Spartan renaming (_+_ to _∔_)
 open import UF.Base hiding (_≈_)
 open import Integers.Type
 open import Integers.Addition renaming (_+_ to _ℤ+_)
-open import Integers.Multiplication
 open import Rationals.Fractions
 open import Rationals.FractionsOperations renaming (_+_ to _𝔽+_)
 open import Rationals.Type
diff --git a/source/Rationals/Extension.lagda b/source/Rationals/Extension.lagda
index 8cfa0c240..43d219367 100644
--- a/source/Rationals/Extension.lagda
+++ b/source/Rationals/Extension.lagda
@@ -18,7 +18,6 @@ open import UF.FunExt
 open import UF.PropTrunc
 open import UF.Powerset
 open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 open import Rationals.Type
 open import Rationals.Addition
 open import Rationals.Negation
diff --git a/source/Rationals/FractionsOperations.lagda b/source/Rationals/FractionsOperations.lagda
index 0377b5040..0becb51a0 100644
--- a/source/Rationals/FractionsOperations.lagda
+++ b/source/Rationals/FractionsOperations.lagda
@@ -9,7 +9,6 @@ open import MLTT.Spartan renaming (_+_ to _∔_)
 open import Naturals.Addition renaming (_+_ to _ℕ+_)
 open import Naturals.Properties
 open import UF.Base hiding (_≈_)
-open import UF.Subsingletons
 open import Integers.Type hiding (abs)
 open import Integers.Abs
 open import Integers.Addition renaming (_+_ to _ℤ+_)
diff --git a/source/Rationals/FractionsOrder.lagda b/source/Rationals/FractionsOrder.lagda
index 96de7791c..fe1d46694 100644
--- a/source/Rationals/FractionsOrder.lagda
+++ b/source/Rationals/FractionsOrder.lagda
@@ -11,12 +11,10 @@ open import Notation.Order
 open import UF.Base
 open import UF.Subsingletons
 
-open import Integers.Abs
 open import Integers.Addition renaming (_+_ to _ℤ+_)
 open import Integers.Type
 open import Integers.Multiplication renaming (_*_ to _ℤ*_)
 open import Integers.Order
-open import Naturals.Addition renaming (_+_ to _ℕ+_)
 open import Naturals.Multiplication renaming (_*_ to _ℕ*_)
 open import Rationals.Fractions
 open import Rationals.FractionsOperations
diff --git a/source/Rationals/Limits.lagda b/source/Rationals/Limits.lagda
index 3e0872565..c30a54b54 100644
--- a/source/Rationals/Limits.lagda
+++ b/source/Rationals/Limits.lagda
@@ -18,7 +18,6 @@ open import UF.PropTrunc
 open import Rationals.Type
 open import Rationals.Addition
 open import Rationals.Abs
-open import Rationals.MinMax hiding (min ; max)
 open import Rationals.Multiplication
 open import Rationals.Negation
 open import Rationals.Order
@@ -42,7 +41,6 @@ module Rationals.Limits
  where
 
 open import MetricSpaces.Rationals fe pe pt
-open import MetricSpaces.Type fe pe pt
 
 _⟶_ : (f : ℕ → ℚ) → (L : ℚ) → 𝓤₀ ̇
 f ⟶ L = (ε₊@(ε , _) : ℚ₊) → Σ N ꞉ ℕ , ((n : ℕ) → N ≤ n → abs (f n - L) < ε)
diff --git a/source/Rationals/Multiplication.lagda b/source/Rationals/Multiplication.lagda
index 4ff3f6b23..2fdd46009 100644
--- a/source/Rationals/Multiplication.lagda
+++ b/source/Rationals/Multiplication.lagda
@@ -12,7 +12,6 @@ open import MLTT.Spartan renaming (_+_ to _∔_)
 
 open import UF.Base hiding (_≈_)
 open import Naturals.Properties
-open import Integers.Abs
 open import Integers.Type
 open import Integers.Multiplication renaming (_*_ to _ℤ*_)
 open import Naturals.Multiplication renaming (_*_ to _ℕ*_)
diff --git a/source/Rationals/Negation.lagda b/source/Rationals/Negation.lagda
index dbfd9f6a8..8e08af9e1 100644
--- a/source/Rationals/Negation.lagda
+++ b/source/Rationals/Negation.lagda
@@ -8,15 +8,9 @@ In this file I define negation of real numbers.
 
 open import MLTT.Spartan renaming (_+_ to _∔_)
 
-open import UF.Base hiding (_≈_)
-open import UF.FunExt
 open import Integers.Type
-open import Integers.Addition renaming (_+_ to _ℤ+_) hiding (_-_)
 open import Integers.Multiplication renaming (_*_ to _ℤ*_)
 open import Integers.Negation renaming (-_ to ℤ-_)
-open import Naturals.Addition renaming (_+_ to _ℕ+_)
-open import Naturals.Multiplication renaming (_*_ to _ℕ*_)
-open import Naturals.Properties
 open import Rationals.Fractions
 open import Rationals.FractionsOperations renaming (-_ to 𝔽-_ ; _+_ to _𝔽+_ ; _*_ to _𝔽*_)
 open import Rationals.Type
diff --git a/source/Rationals/Order.lagda b/source/Rationals/Order.lagda
index 99bada393..51e5b4078 100644
--- a/source/Rationals/Order.lagda
+++ b/source/Rationals/Order.lagda
@@ -15,7 +15,6 @@ open import Naturals.Addition renaming (_+_ to _ℕ+_)
 open import MLTT.Plus-Properties
 open import UF.Base hiding (_≈_)
 open import UF.Subsingletons
-open import Integers.Abs
 open import Integers.Addition renaming (_+_ to _ℤ+_) hiding (_-_)
 open import Integers.Type
 open import Integers.Multiplication renaming (_*_ to _ℤ*_)
diff --git a/source/Rationals/Positive.lagda b/source/Rationals/Positive.lagda
index c249e26a1..db03412ce 100644
--- a/source/Rationals/Positive.lagda
+++ b/source/Rationals/Positive.lagda
@@ -8,11 +8,9 @@ This file defines positive rationals, which are useful for metric spaces.
 open import MLTT.Spartan renaming (_+_ to _∔_)
 open import Notation.Order
 open import Rationals.Type
-open import Rationals.Abs
 open import Rationals.Addition renaming (_+_ to _ℚ+_)
 open import Rationals.Multiplication renaming (_*_ to _ℚ*_)
 open import Rationals.Order
-open import UF.Base
 
 module Rationals.Positive where
 
diff --git a/source/Rationals/Type.lagda b/source/Rationals/Type.lagda
index 44b455dcd..66d74a66f 100644
--- a/source/Rationals/Type.lagda
+++ b/source/Rationals/Type.lagda
@@ -6,20 +6,17 @@ In this file I define rational numbers.
 
 {-# OPTIONS --safe --without-K #-}
 
-open import Integers.Abs
 open import Integers.Multiplication renaming (_*_ to _ℤ*_)
 open import Integers.Negation
 open import Integers.Order
 open import Integers.Type
 open import MLTT.Spartan renaming (_+_ to _∔_)
-open import Naturals.Division
 open import Naturals.HCF
 open import Naturals.Multiplication renaming (_*_ to _ℕ*_)
 open import Naturals.Properties
 open import Notation.CanonicalMap
 open import Rationals.Fractions
 open import TypeTopology.SigmaDiscreteAndTotallySeparated
-open import UF.Base hiding (_≈_)
 open import UF.DiscreteAndSeparated
 open import UF.Sets
 open import UF.Subsingletons
diff --git a/source/Relations/ChurchRosser.lagda b/source/Relations/ChurchRosser.lagda
index a9ae7c054..804f7143d 100644
--- a/source/Relations/ChurchRosser.lagda
+++ b/source/Relations/ChurchRosser.lagda
@@ -17,8 +17,6 @@ module Relations.ChurchRosser
        where
 
 open import Relations.SRTclosure
-open import UF.PropTrunc
-open import UF.Subsingletons
 
 infix 1 _◁▷_
 infix 1 _◁▷[_]_
diff --git a/source/Slice/Algebras.lagda b/source/Slice/Algebras.lagda
index 7244c4cce..3ce4686dc 100644
--- a/source/Slice/Algebras.lagda
+++ b/source/Slice/Algebras.lagda
@@ -10,9 +10,6 @@ module Slice.Algebras
         (𝓣 : Universe)
        where
 
-open import UF.Base
-open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 open import UF.Equiv
 open import UF.EquivalenceExamples
 open import UF.FunExt
@@ -20,7 +17,6 @@ open import UF.Univalence
 open import UF.UA-FunExt
 
 open import Slice.Construction 𝓣
-open import Slice.IdentityViaSIP 𝓣
 open import Slice.Monad 𝓣
 
 double-𝓕-charac : (X : 𝓤 ̇ )
diff --git a/source/Slice/Construction.lagda b/source/Slice/Construction.lagda
index 55407bc6a..22e1bbc02 100644
--- a/source/Slice/Construction.lagda
+++ b/source/Slice/Construction.lagda
@@ -14,7 +14,6 @@ open import UF.Base
 open import UF.Equiv
 open import UF.EquivalenceExamples
 open import UF.FunExt
-open import UF.Subsingletons
 
 𝓕 : 𝓤 ̇ → 𝓤 ⊔ 𝓣 ⁺ ̇
 𝓕 X = Σ I ꞉ 𝓣 ̇ , (I → X)
@@ -120,8 +119,6 @@ https://ncatlab.org/nlab/show/locally+cartesian+closed+category
   l (τ , H) = (φ ∘ τ , H)
 
 open import UF.Classifiers
-open import UF.Equiv
-open import UF.FunExt
 open import UF.Univalence
 
 𝓕-equiv-particular : is-univalent 𝓣
@@ -131,11 +128,7 @@ open import UF.Univalence
 𝓕-equiv-particular = classifier-single-universe.classification 𝓣
 
 open import UF.Size
-open import UF.Base
-open import UF.Equiv-FunExt
 open import UF.UA-FunExt
-open import UF.UniverseEmbedding
-open import UF.EquivalenceExamples
 
 𝓕-equiv : Univalence → (X : 𝓤 ̇ ) → 𝓕 X ≃ (Σ A ꞉ (X → 𝓣 ⊔ 𝓤 ̇ ), (Σ A) is 𝓣 small)
 𝓕-equiv {𝓤} ua X = qinveq φ (ψ , ψφ , φψ)
diff --git a/source/TWA/BanachFixedPointTheorem.lagda b/source/TWA/BanachFixedPointTheorem.lagda
index 3d9f90ff4..1d44e5c99 100644
--- a/source/TWA/BanachFixedPointTheorem.lagda
+++ b/source/TWA/BanachFixedPointTheorem.lagda
@@ -12,10 +12,8 @@ module TWA.BanachFixedPointTheorem (fe : FunExt) where
 
 open import MLTT.Spartan
 open import CoNaturals.Type hiding (min)
-open import CoNaturals.Arithmetic fe
 open import TWA.Closeness fe
 open import Naturals.Order
-open import Naturals.Properties
 open import Notation.Order
 open import Notation.CanonicalMap
 
diff --git a/source/TWA/Thesis/AndrewSneap/DyadicRationals.lagda b/source/TWA/Thesis/AndrewSneap/DyadicRationals.lagda
index 3e719240b..a1c6e656d 100644
--- a/source/TWA/Thesis/AndrewSneap/DyadicRationals.lagda
+++ b/source/TWA/Thesis/AndrewSneap/DyadicRationals.lagda
@@ -19,7 +19,6 @@ open import UF.Base
 open import UF.FunExt
 open import UF.Subsingletons
 open import UF.Subsingletons-FunExt
-open import UF.Sets
 open import UF.DiscreteAndSeparated
 
 open import TWA.Thesis.Chapter5.Integers
diff --git a/source/TWA/Thesis/AndrewSneap/DyadicReals.lagda b/source/TWA/Thesis/AndrewSneap/DyadicReals.lagda
index b9f92f317..5d92d3596 100644
--- a/source/TWA/Thesis/AndrewSneap/DyadicReals.lagda
+++ b/source/TWA/Thesis/AndrewSneap/DyadicReals.lagda
@@ -6,7 +6,6 @@ Note that this file is incomplete.
 {-# OPTIONS --without-K --safe  #-}
 
 open import MLTT.Spartan
-open import Notation.CanonicalMap
 open import Notation.Order
 open import UF.FunExt
 open import UF.PropTrunc
@@ -14,7 +13,6 @@ open import UF.Powerset
 open import UF.Subsingletons
 
 open import TWA.Thesis.AndrewSneap.DyadicRationals
-open import TWA.Thesis.Chapter5.Integers
 
 module TWA.Thesis.AndrewSneap.DyadicReals
   (pe : PropExt)
diff --git a/source/TWA/Thesis/Chapter2/Finite.lagda b/source/TWA/Thesis/Chapter2/Finite.lagda
index 2f5b0b24f..800eca636 100644
--- a/source/TWA/Thesis/Chapter2/Finite.lagda
+++ b/source/TWA/Thesis/Chapter2/Finite.lagda
@@ -7,7 +7,6 @@ Todd Waugh Ambridge, January 2024
 
 open import MLTT.Spartan
 open import UF.DiscreteAndSeparated
-open import UF.Subsingletons
 open import UF.Sets
 open import UF.Sets-Properties
 open import UF.Equiv
diff --git a/source/TWA/Thesis/Chapter3/ClosenessSpaces-Examples.lagda b/source/TWA/Thesis/Chapter3/ClosenessSpaces-Examples.lagda
index ff48de47f..aa1d9d61c 100644
--- a/source/TWA/Thesis/Chapter3/ClosenessSpaces-Examples.lagda
+++ b/source/TWA/Thesis/Chapter3/ClosenessSpaces-Examples.lagda
@@ -20,9 +20,7 @@ open import MLTT.Two-Properties
 open import Fin.Type
 open import Fin.Bishop
 open import Fin.Embeddings
-open import Fin.ArithmeticViaEquivalence
 open import UF.Equiv
-open import UF.EquivalenceExamples
 open import MLTT.SpartanList hiding (⟨_⟩; _∷_)
 
 module TWA.Thesis.Chapter3.ClosenessSpaces-Examples (fe : FunExt) where
@@ -489,7 +487,6 @@ Least-PseudoClosenessSpace X Y f v
  , Least-clofun X Y v
  , Least-clofun-is-psclofun X Y v
 
-open import MLTT.Two-Properties
 
 close-to-close : (X : ClosenessSpace 𝓤)
                → (Y : ClosenessSpace 𝓥)
diff --git a/source/TWA/Thesis/Chapter3/ClosenessSpaces.lagda b/source/TWA/Thesis/Chapter3/ClosenessSpaces.lagda
index 3fe7ad005..03eedec09 100644
--- a/source/TWA/Thesis/Chapter3/ClosenessSpaces.lagda
+++ b/source/TWA/Thesis/Chapter3/ClosenessSpaces.lagda
@@ -10,7 +10,6 @@ open import Notation.Order
 open import Naturals.Order
 open import UF.DiscreteAndSeparated
 open import UF.FunExt
-open import UF.Subsingletons
 open import UF.Subsingletons-FunExt
 open import UF.SubtypeClassifier
 open import Quotient.Type
diff --git a/source/TWA/Thesis/Chapter3/SearchableTypes.lagda b/source/TWA/Thesis/Chapter3/SearchableTypes.lagda
index a0f15410c..a618bca89 100644
--- a/source/TWA/Thesis/Chapter3/SearchableTypes.lagda
+++ b/source/TWA/Thesis/Chapter3/SearchableTypes.lagda
@@ -8,7 +8,6 @@ Todd Waugh Ambridge, January 2024
 open import MLTT.Spartan
 open import UF.FunExt
 open import NotionsOfDecidability.Complemented
-open import UF.Subsingletons
 open import UF.SubtypeClassifier
 open import UF.Equiv
 open import UF.DiscreteAndSeparated
diff --git a/source/TWA/Thesis/Chapter4/ApproxOrder-Examples.lagda b/source/TWA/Thesis/Chapter4/ApproxOrder-Examples.lagda
index f4cde764c..827258608 100644
--- a/source/TWA/Thesis/Chapter4/ApproxOrder-Examples.lagda
+++ b/source/TWA/Thesis/Chapter4/ApproxOrder-Examples.lagda
@@ -20,8 +20,6 @@ open import CoNaturals.Type
   renaming (ℕ-to-ℕ∞ to _↑
          ; Zero-smallest to zero-minimal
          ; ∞-largest to ∞-maximal)
-open import NotionsOfDecidability.Decidable
-open import MLTT.Two-Properties
 open import Fin.Type
 open import Fin.Bishop
 open import UF.PropTrunc
@@ -35,7 +33,6 @@ module TWA.Thesis.Chapter4.ApproxOrder-Examples (fe : FunExt) where
 
 open import TWA.Thesis.Chapter3.ClosenessSpaces fe
 open import TWA.Thesis.Chapter3.ClosenessSpaces-Examples fe
-open import TWA.Thesis.Chapter3.SearchableTypes fe
 open import TWA.Thesis.Chapter4.ApproxOrder fe
 \end{code}
 
diff --git a/source/TWA/Thesis/Chapter4/GlobalOptimisation.lagda b/source/TWA/Thesis/Chapter4/GlobalOptimisation.lagda
index 8f9d6a3a8..63530f84a 100644
--- a/source/TWA/Thesis/Chapter4/GlobalOptimisation.lagda
+++ b/source/TWA/Thesis/Chapter4/GlobalOptimisation.lagda
@@ -10,7 +10,6 @@ open import UF.FunExt
 open import Fin.Type
 open import Fin.Bishop
 
-open import TWA.Thesis.Chapter2.Finite
 
 module TWA.Thesis.Chapter4.GlobalOptimisation (fe : FunExt) where
 
diff --git a/source/TWA/Thesis/Chapter4/ParametricRegression.lagda b/source/TWA/Thesis/Chapter4/ParametricRegression.lagda
index 2d2f9d63d..88b4cee53 100644
--- a/source/TWA/Thesis/Chapter4/ParametricRegression.lagda
+++ b/source/TWA/Thesis/Chapter4/ParametricRegression.lagda
@@ -6,7 +6,6 @@ Todd Waugh Ambridge, January 2024
 {-# OPTIONS --without-K --safe #-}
 
 open import UF.FunExt
-open import UF.Subsingletons
 open import Quotient.Type
   using (is-prop-valued;is-equiv-relation;EqRel)
 open import MLTT.Spartan
@@ -32,7 +31,6 @@ open import TWA.Thesis.Chapter4.ApproxOrder fe
 open import TWA.Thesis.Chapter4.ApproxOrder-Examples fe
 open import TWA.Thesis.Chapter4.GlobalOptimisation fe
 
-open import TWA.Closeness fe hiding (is-ultra;is-closeness)
 \end{code}
 
 ## Regression as maximisation
diff --git a/source/TWA/Thesis/Chapter5/BoehmVerification.lagda b/source/TWA/Thesis/Chapter5/BoehmVerification.lagda
index 9b7fbc0f0..4e71c8898 100644
--- a/source/TWA/Thesis/Chapter5/BoehmVerification.lagda
+++ b/source/TWA/Thesis/Chapter5/BoehmVerification.lagda
@@ -10,7 +10,6 @@ open import Integers.Negation renaming (-_ to ℤ-_ )
 open import Integers.Order
 open import Integers.Type
 open import MLTT.Spartan
-open import MLTT.Two-Properties
 open import Notation.Order
 open import UF.FunExt
 open import UF.Powerset hiding (𝕋)
diff --git a/source/TWA/Thesis/Chapter5/SignedDigit.lagda b/source/TWA/Thesis/Chapter5/SignedDigit.lagda
index 0ce735f21..8a1482877 100644
--- a/source/TWA/Thesis/Chapter5/SignedDigit.lagda
+++ b/source/TWA/Thesis/Chapter5/SignedDigit.lagda
@@ -10,7 +10,6 @@ open import UF.DiscreteAndSeparated
 open import UF.Equiv
 open import Fin.Type
 open import Fin.Bishop
-open import UF.Subsingletons
 open import UF.Sets
 
 open import TWA.Thesis.Chapter2.Finite
diff --git a/source/TWA/Thesis/Chapter5/SignedDigitIntervalObject.lagda b/source/TWA/Thesis/Chapter5/SignedDigitIntervalObject.lagda
index b86d0f58f..1cf02db99 100644
--- a/source/TWA/Thesis/Chapter5/SignedDigitIntervalObject.lagda
+++ b/source/TWA/Thesis/Chapter5/SignedDigitIntervalObject.lagda
@@ -7,7 +7,6 @@ Todd Waugh Ambridge, January 2024
 
 open import MLTT.Spartan
 open import UF.FunExt
-open import Naturals.Addition renaming (_+_ to _+ℕ_)
 
 open import TWA.Thesis.Chapter2.Sequences
 open import TWA.Thesis.Chapter5.SignedDigit
diff --git a/source/TWA/Thesis/Chapter6/Main.lagda b/source/TWA/Thesis/Chapter6/Main.lagda
index 110f91421..666dea1af 100644
--- a/source/TWA/Thesis/Chapter6/Main.lagda
+++ b/source/TWA/Thesis/Chapter6/Main.lagda
@@ -11,8 +11,6 @@ open import Integers.Type
 open import MLTT.Spartan
 open import Unsafe.Haskell
 
-open import TWA.Thesis.Chapter2.Vectors
-open import TWA.Thesis.Chapter2.Sequences
 open import TWA.Thesis.Chapter5.SignedDigit
 
 module TWA.Thesis.Chapter6.Main where
@@ -21,7 +19,6 @@ postulate fe : FunExt
 postulate pe : PropExt
 
 open import TWA.Thesis.Chapter6.SignedDigitSearch fe pe
-open import TWA.Thesis.Chapter6.SignedDigitExamples fe pe
 
 𝟛-to-ℤ : 𝟛 → ℤ
 𝟛-to-ℤ −1 = negsucc 0
diff --git a/source/TWA/Thesis/Chapter6/SequenceContinuity.lagda b/source/TWA/Thesis/Chapter6/SequenceContinuity.lagda
index 47de715a8..103fd956e 100644
--- a/source/TWA/Thesis/Chapter6/SequenceContinuity.lagda
+++ b/source/TWA/Thesis/Chapter6/SequenceContinuity.lagda
@@ -6,14 +6,11 @@ Todd Waugh Ambridge, January 2024
 {-# OPTIONS --without-K --safe #-}
 
 open import MLTT.Spartan
-open import CoNaturals.Type
- renaming (ℕ-to-ℕ∞ to _↑) hiding (max)
+
 open import Notation.Order
 open import Naturals.Order
 open import UF.DiscreteAndSeparated
-open import UF.Subsingletons
 open import UF.FunExt
-open import UF.Equiv
 
 module TWA.Thesis.Chapter6.SequenceContinuity (fe : FunExt) where
 
diff --git a/source/TWA/Thesis/Chapter6/SignedDigitContinuity.lagda b/source/TWA/Thesis/Chapter6/SignedDigitContinuity.lagda
index 5be8d299c..c9a87e925 100644
--- a/source/TWA/Thesis/Chapter6/SignedDigitContinuity.lagda
+++ b/source/TWA/Thesis/Chapter6/SignedDigitContinuity.lagda
@@ -10,20 +10,14 @@ open import MLTT.Spartan
 open import UF.FunExt
 open import Notation.Order
 open import Naturals.Order
-open import UF.DiscreteAndSeparated
-open import CoNaturals.Type
- hiding (max)
- renaming (ℕ-to-ℕ∞ to _↑)
 
 open import TWA.Thesis.Chapter2.Sequences
-open import TWA.Thesis.Chapter2.Vectors
 open import TWA.Thesis.Chapter5.SignedDigit
 
 module TWA.Thesis.Chapter6.SignedDigitContinuity (fe : FunExt) where
 
 open import TWA.Thesis.Chapter3.ClosenessSpaces fe
 open import TWA.Thesis.Chapter3.ClosenessSpaces-Examples fe
-open import TWA.Thesis.Chapter3.SearchableTypes fe
 open import TWA.Thesis.Chapter6.SequenceContinuity fe
 \end{code}
 
diff --git a/source/TWA/Thesis/Chapter6/SignedDigitExamples.lagda b/source/TWA/Thesis/Chapter6/SignedDigitExamples.lagda
index 963af93cb..638409279 100644
--- a/source/TWA/Thesis/Chapter6/SignedDigitExamples.lagda
+++ b/source/TWA/Thesis/Chapter6/SignedDigitExamples.lagda
@@ -4,7 +4,6 @@ Todd Waugh Ambridge, January 2024
 {-# OPTIONS --without-K --safe #-}
 
 open import MLTT.Spartan
-open import NotionsOfDecidability.Complemented
 open import UF.Subsingletons
 open import UF.FunExt
 open import MLTT.SpartanList hiding (_∷_;⟨_⟩;[_])
diff --git a/source/TWA/Thesis/index.lagda b/source/TWA/Thesis/index.lagda
index 4c91612a5..7c2a7ba5f 100644
--- a/source/TWA/Thesis/index.lagda
+++ b/source/TWA/Thesis/index.lagda
@@ -72,9 +72,9 @@ our formal framework for search, optimisation and regression.
 https://arxiv.org/pdf/2401.09270.pdf#chapter.2
 
 \begin{code}
-open import TWA.Thesis.Chapter2.Finite
-open import TWA.Thesis.Chapter2.Vectors
-open import TWA.Thesis.Chapter2.Sequences
+import TWA.Thesis.Chapter2.Finite
+import TWA.Thesis.Chapter2.Vectors
+import TWA.Thesis.Chapter2.Sequences
 \end{code}
 
 CHAPTER THREE: Searchability and Continuity
@@ -97,11 +97,11 @@ under countable products.
 https://arxiv.org/pdf/2401.09270.pdf#chapter.3
 
 \begin{code}
-open import TWA.Thesis.Chapter3.ClosenessSpaces
-open import TWA.Thesis.Chapter3.ClosenessSpaces-Examples
-open import TWA.Thesis.Chapter3.SearchableTypes
-open import TWA.Thesis.Chapter3.SearchableTypes-Examples
-open import TWA.Thesis.Chapter3.PredicateEquality
+import TWA.Thesis.Chapter3.ClosenessSpaces
+import TWA.Thesis.Chapter3.ClosenessSpaces-Examples
+import TWA.Thesis.Chapter3.SearchableTypes
+import TWA.Thesis.Chapter3.SearchableTypes-Examples
+import TWA.Thesis.Chapter3.PredicateEquality
 \end{code}
 
 CHAPTER FOUR: Generalised Optimisation and Regression
@@ -119,10 +119,10 @@ have introduced.
 https://arxiv.org/pdf/2401.09270.pdf#chapter.4
 
 \begin{code}
-open import TWA.Thesis.Chapter4.ApproxOrder
-open import TWA.Thesis.Chapter4.ApproxOrder-Examples
-open import TWA.Thesis.Chapter4.GlobalOptimisation
-open import TWA.Thesis.Chapter4.ParametricRegression
+import TWA.Thesis.Chapter4.ApproxOrder
+import TWA.Thesis.Chapter4.ApproxOrder-Examples
+import TWA.Thesis.Chapter4.GlobalOptimisation
+import TWA.Thesis.Chapter4.ParametricRegression
 \end{code}
 
 CHAPTER FIVE: Real Numbers
@@ -141,35 +141,35 @@ structure and show how it yields representations of compact intervals
 that we can then use for search.
 
 \begin{code}
-open import TWA.Thesis.Chapter5.IntervalObject
-open import TWA.Thesis.Chapter5.IntervalObjectApproximation
-open import TWA.Thesis.Chapter5.SignedDigit
-open import TWA.Thesis.Chapter5.SignedDigitIntervalObject
-open import TWA.Thesis.Chapter5.BoehmStructure
-open import TWA.Thesis.Chapter5.BoehmVerification
-open import TWA.Thesis.Chapter5.Integers
+import TWA.Thesis.Chapter5.IntervalObject
+import TWA.Thesis.Chapter5.IntervalObjectApproximation
+import TWA.Thesis.Chapter5.SignedDigit
+import TWA.Thesis.Chapter5.SignedDigitIntervalObject
+import TWA.Thesis.Chapter5.BoehmStructure
+import TWA.Thesis.Chapter5.BoehmVerification
+import TWA.Thesis.Chapter5.Integers
 \end{code}
 
 CHAPTER SIX: Exact Real Search
 
 In Chapter 6, we bring our formal framework full-circle by
-instantiating it on these two types for representing real numbers. 
+instantiating it on these two types for representing real numbers.
 Example evaluations of algorithms for search, optimisation and
 regression --- either extracted from Agda or implemented in Java ---
 are then given to show the use of the framework in practice.
 
 \begin{code}
-open import TWA.Thesis.Chapter6.SequenceContinuity
-open import TWA.Thesis.Chapter6.SignedDigitSearch
-open import TWA.Thesis.Chapter6.SignedDigitOrder
-open import TWA.Thesis.Chapter6.SignedDigitContinuity
-open import TWA.Thesis.Chapter6.SignedDigitExamples
+import TWA.Thesis.Chapter6.SequenceContinuity
+import TWA.Thesis.Chapter6.SignedDigitSearch
+import TWA.Thesis.Chapter6.SignedDigitOrder
+import TWA.Thesis.Chapter6.SignedDigitContinuity
+import TWA.Thesis.Chapter6.SignedDigitExamples
 \end{code}
 
 CHAPTER SEVEN: Conclusion
 
 Finally, in Chapter 7, by way of conclusion we discuss some further
-avenues for this line of work. 
+avenues for this line of work.
 
 SPECIAL THANKS
 
@@ -177,7 +177,6 @@ A special thanks goes to Andrew Sneap, who wrote the following two
 files specifically for the use of the Boehm verification in Chapter 5.
 
 \begin{code}
-open import TWA.Thesis.AndrewSneap.DyadicRationals
-open import TWA.Thesis.AndrewSneap.DyadicReals
+import TWA.Thesis.AndrewSneap.DyadicRationals
+import TWA.Thesis.AndrewSneap.DyadicReals
 \end{code}
-
diff --git a/source/Taboos/BasicDiscontinuity.lagda b/source/Taboos/BasicDiscontinuity.lagda
index a043bf40d..608359ea2 100644
--- a/source/Taboos/BasicDiscontinuity.lagda
+++ b/source/Taboos/BasicDiscontinuity.lagda
@@ -26,7 +26,9 @@ open import Taboos.WLPO
 basic-discontinuity : (ℕ∞ → 𝟚) → 𝓤₀ ̇
 basic-discontinuity p = ((n : ℕ) → p (ι n) ＝ ₀) × (p ∞ ＝ ₁)
 
-basic-discontinuity-taboo : (p : ℕ∞ → 𝟚) → basic-discontinuity p → WLPO
+basic-discontinuity-taboo : (p : ℕ∞ → 𝟚)
+                          → basic-discontinuity p
+                          → WLPO
 basic-discontinuity-taboo p (f , r) u = 𝟚-equality-cases lemma₀ lemma₁
  where
   fact₀ : u ＝ ∞ → p u ＝ ₁
@@ -60,7 +62,8 @@ of type ℕ∞ → 𝟚.
 
 \begin{code}
 
-WLPO-is-discontinuous : WLPO → Σ p ꞉ (ℕ∞ → 𝟚), basic-discontinuity p
+WLPO-is-discontinuous : WLPO
+                      → Σ p ꞉ (ℕ∞ → 𝟚), basic-discontinuity p
 WLPO-is-discontinuous f = p , (d , d∞)
  where
   p : ℕ∞ → 𝟚
@@ -92,31 +95,55 @@ WLPO-is-discontinuous f = p , (d , d∞)
 
 \end{code}
 
-If two 𝟚-valued functions defined on ℕ∞ agree at ℕ, they have to agree
-at ∞ too, unless WLPO holds:
+If two discrete-valued functions defined on ℕ∞ agree, they have to
+agree at ∞ too, unless WLPO holds:
 
 \begin{code}
 
+open import NotionsOfDecidability.Decidable
+open import UF.DiscreteAndSeparated
+
+module _ {D : 𝓤 ̇ } (d : is-discrete D) where
+
+ disagreement-taboo' : (p q : ℕ∞ → D)
+                     → ((n : ℕ) → p (ι n) ＝ q (ι n))
+                     → p ∞ ≠ q ∞
+                     → WLPO
+ disagreement-taboo' p q f g = basic-discontinuity-taboo r (r-lemma , r-lemma∞)
+  where
+   A : ℕ∞ → 𝓤 ̇
+   A u = p u ＝ q u
+
+   δ : (u : ℕ∞) → is-decidable (p u ＝ q u)
+   δ u = d (p u) (q u)
+
+   r : ℕ∞ → 𝟚
+   r = characteristic-map A δ
+
+   r-lemma : (n : ℕ) → r (ι n) ＝ ₀
+   r-lemma n = characteristic-map-property₀-back A δ (ι n) (f n)
+
+   r-lemma∞ : r ∞ ＝ ₁
+   r-lemma∞ = characteristic-map-property₁-back A δ ∞ (λ a → g a)
+
+ agreement-cotaboo' : ¬ WLPO
+                    → (p q : ℕ∞ → D)
+                    → ((n : ℕ) → p (ι n) ＝ q (ι n))
+                    → p ∞ ＝ q ∞
+ agreement-cotaboo' φ p q f = discrete-is-¬¬-separated d (p ∞) (q ∞)
+                               (contrapositive (disagreement-taboo' p q f) φ)
+
 disagreement-taboo : (p q : ℕ∞ → 𝟚)
                    → ((n : ℕ) → p (ι n) ＝ q (ι n))
                    → p ∞ ≠ q ∞
                    → WLPO
-disagreement-taboo p q f g = basic-discontinuity-taboo r (r-lemma , r-lemma∞)
- where
-  r : ℕ∞ → 𝟚
-  r u = (p u) ⊕ (q u)
-
-  r-lemma : (n : ℕ) → r (ι n) ＝ ₀
-  r-lemma n = Lemma[b＝c→b⊕c＝₀] (f n)
-
-  r-lemma∞ : r ∞ ＝ ₁
-  r-lemma∞ = Lemma[b≠c→b⊕c＝₁] g
-
-open import UF.DiscreteAndSeparated
+disagreement-taboo = disagreement-taboo' 𝟚-is-discrete
 
-agreement-cotaboo :  ¬ WLPO → (p q : ℕ∞ → 𝟚) → ((n : ℕ) → p (ι n) ＝ q (ι n)) → p ∞ ＝ q ∞
-agreement-cotaboo φ p q f = 𝟚-is-¬¬-separated (p ∞) (q ∞)
-                             (contrapositive (disagreement-taboo p q f) φ)
+agreement-cotaboo : ¬ WLPO
+                  → (p q : ℕ∞ → 𝟚)
+                  → ((n : ℕ) → p (ι n) ＝ q (ι n))
+                  → p ∞ ＝ q ∞
+agreement-cotaboo = agreement-cotaboo' 𝟚-is-discrete
 
 \end{code}
 
@@ -127,7 +154,9 @@ Added 23rd August 2023. Variation.
 basic-discontinuity' : (ℕ∞ → ℕ∞) → 𝓤₀ ̇
 basic-discontinuity' f = ((n : ℕ) → f (ι n) ＝ ι 0) × (f ∞ ＝ ι 1)
 
-basic-discontinuity-taboo' : (f : ℕ∞ → ℕ∞) → basic-discontinuity' f → WLPO
+basic-discontinuity-taboo' : (f : ℕ∞ → ℕ∞)
+                           → basic-discontinuity' f
+                           → WLPO
 basic-discontinuity-taboo' f (f₀ , f₁) = VI
  where
   I : (u : ℕ∞) → f u ＝ ι 0 → u ≠ ∞
diff --git a/source/Taboos/Decomposability.lagda b/source/Taboos/Decomposability.lagda
index d10021ef3..60f4a1188 100644
--- a/source/Taboos/Decomposability.lagda
+++ b/source/Taboos/Decomposability.lagda
@@ -28,7 +28,6 @@ open import MLTT.Two-Properties
 open import Ordinals.Arithmetic fe
 open import Ordinals.Equivalence
 open import Ordinals.Maps
-open import Ordinals.OrdinalOfOrdinals
 open import Ordinals.Type
 open import Ordinals.Underlying
 open import UF.Base
@@ -38,13 +37,11 @@ open import UF.Equiv
 open import UF.Equiv-FunExt
 open import UF.EquivalenceExamples
 open import UF.PropTrunc
-open import UF.Sets
 open import UF.Size
 open import UF.Subsingletons
 open import UF.Subsingletons-FunExt
 open import UF.SubtypeClassifier
 open import UF.SubtypeClassifier-Properties
-open import UF.UA-FunExt
 open import UF.Univalence
 
 private
@@ -115,7 +112,7 @@ WEM-gives-decomposition-of-two-pointed-types wem X ((x₀ , x₁) , d) = γ
   g x (inr _) = ₁
 
   h : (x : X) → ¬ (x ≠ x₀) + ¬¬ (x ≠ x₀)
-  h x = wem (x ≠ x₀) (negations-are-props fe')
+  h x = wem (x ≠ x₀)
 
   f : X → 𝟚
   f x = g x (h x)
@@ -162,14 +159,14 @@ WEM-gives-decomposition-of-two-pointed-types⁺ {𝓤} wem X l ((x₀ , x₁) ,
   g x (inr _) = ₁
 
   h : (x : X) → ¬ (x ≠⟦ l ⟧ x₀) + ¬¬ (x ≠⟦ l ⟧ x₀)
-  h x = wem (x ≠⟦ l ⟧ x₀) (negations-are-props fe')
+  h x = wem (x ≠⟦ l ⟧ x₀)
 
   f : X → 𝟚
   f x = g x (h x)
 
   g₀ : (δ : ¬ (x₀ ≠⟦ l ⟧ x₀) + ¬¬ (x₀ ≠⟦ l ⟧ x₀)) → g x₀ δ ＝ ₀
   g₀ (inl _) = refl
-  g₀ (inr u) = 𝟘-elim (three-negations-imply-one u ⟦ l ⟧-refl)
+  g₀ (inr u) = 𝟘-elim (three-negations-imply-one u ＝⟦ l ⟧-refl)
 
   e₀ : f x₀ ＝ ₀
   e₀ = g₀ (h x₀)
@@ -210,7 +207,7 @@ The type of ordinals in any universe has Ω-paths between any two points.
 
 \begin{code}
 
-has-Ω-paths : (𝓥 : Universe) → 𝓤 ̇  → 𝓤 ⊔ (𝓥 ⁺) ̇
+has-Ω-paths : (𝓥 : Universe) → 𝓤 ̇ → 𝓤 ⊔ (𝓥 ⁺) ̇
 has-Ω-paths 𝓥 X = (x y : X) → Ω-Path 𝓥 x y
 
 type-of-ordinals-has-Ω-paths : is-univalent 𝓤
@@ -228,7 +225,7 @@ type-of-ordinals-has-Ω-paths {𝓤} ua α β = f , γ⊥ , γ⊤
     u (inl (x , a)) = a
 
     o : is-order-preserving (f ⊥) α u
-    o (inl (x , a)) (inl (x , b)) (inr (refl , l)) = l
+    o (inl (x , a)) (inl (y , b)) (inl l) = l
 
     v : ⟨ α ⟩ → ⟨ f ⊥ ⟩
     v a = inl (𝟘-elim , a)
@@ -243,7 +240,7 @@ type-of-ordinals-has-Ω-paths {𝓤} ua α β = f , γ⊥ , γ⊤
     e = qinvs-are-equivs u (v , vu , uv)
 
     p : is-order-preserving α (f ⊥) v
-    p a b l = inr (refl , l)
+    p a b l = inl l
 
   γ⊤ : f ⊤ ＝ β
   γ⊤ = eqtoidₒ ua fe' (f ⊤) β (u , o , e , p)
@@ -254,7 +251,7 @@ type-of-ordinals-has-Ω-paths {𝓤} ua α β = f , γ⊥ , γ⊤
 
     o : is-order-preserving (f ⊤) β u
     o (inl (f , _)) y l = 𝟘-elim (f ⋆)
-    o (inr (⋆ , _)) (inr (⋆ , _)) (inr (_ , l)) = l
+    o (inr (⋆ , _)) (inr (⋆ , _)) (inl l) = l
 
     v : ⟨ β ⟩ → ⟨ f ⊤ ⟩
     v b = inr (⋆ , b)
@@ -270,13 +267,13 @@ type-of-ordinals-has-Ω-paths {𝓤} ua α β = f , γ⊥ , γ⊤
     e = qinvs-are-equivs u (v , vu , uv)
 
     p : is-order-preserving β (f ⊤) v
-    p b c l = inr (refl , l)
+    p b c l = inl l
 
 decomposition-of-Ω-gives-WEM : propext 𝓤
                              → decomposition (Ω 𝓤)
                              → WEM 𝓤
 decomposition-of-Ω-gives-WEM
-  {𝓤} pe (f , (p₀@(P₀ , i₀) , e₀) , (p₁@(P₁ , i₁) , e₁)) = IV
+  {𝓤} pe (f , (p₀@(P₀ , i₀) , e₀) , (p₁@(P₁ , i₁) , e₁)) = V
  where
   g : Ω 𝓤 → Ω 𝓤
   g (Q , j) = ((P₀ × Q) + (P₁ × ¬ Q)) , k
@@ -321,9 +318,12 @@ decomposition-of-Ω-gives-WEM
   III₁ : (q : Ω 𝓤) → f (g q) ＝ ₁ → ¬ (q holds) + ¬¬ (q holds)
   III₁ q e = inl (contrapositive (I₀ q) (equal-₁-different-from-₀ e))
 
-  IV : (Q : 𝓤  ̇ )→ is-prop Q → ¬ Q + ¬¬ Q
+  IV : (Q : 𝓤  ̇ ) → is-prop Q → ¬ Q + ¬¬ Q
   IV Q j = 𝟚-equality-cases (III₀ (Q , j)) (III₁ (Q , j))
 
+  V : (Q : 𝓤  ̇ ) → ¬ Q + ¬¬ Q
+  V = WEM'-gives-WEM fe' IV
+
 decomposition-of-type-with-Ω-paths-gives-WEM : propext 𝓥
                                              → {X : 𝓤 ̇ }
                                              → decomposition X
@@ -401,7 +401,8 @@ types decomposable (Ordinal 𝓤) and WEM are property, we get data out
 of them if we are given a proof of decomposability.
 
 
-Added 9th September 2022 by Tom de Jong.
+Added 9th September 2022 by Tom de Jong (which is subsumed by a remark
+below added 25th July 2024).
 
 After a discussion with Martín on 8th September 2022, we noticed that
 the decomposability theorem can be generalised from Ord 𝓤 to any
@@ -599,6 +600,44 @@ module decomposability-bis (pt : propositional-truncations-exist) where
    (decomposition-of-ainjective-type-gives-WEM pe D D-ainj) ,
   (λ wem → ∣ WEM-gives-decomposition-of-two-pointed-types wem D htdp ∣)
 
+\end{code}
+
+Added 25th July 2024 by Tom de Jong and Martin Escardo.
+
+The previous theorem, however, doesn't capture our examples of injective types. Indeed, the assumption that D : 𝓤 is injective with respect to 𝓤
+and 𝓥 is a bit unnatural, as all known examples of injective types are
+large, e.g. the universe 𝓤 is injective w.r.t 𝓤 and 𝓤, as are the
+ordinals in 𝓤 and the propositions in 𝓤. In fact, in
+InjectiveTypes.Resizing we showed that such injective types are
+necessarily large unless ꪪ-resizing holds. Therefore, we now improve
+and generalize the above theorem to a large, but locally small,
+type, so that all known examples are captured.
+
+\begin{code}
+
+ ainjective-type-decomposable-iff-WEM⁺
+  : propext 𝓤
+  → (D : 𝓤 ⁺ ̇ )
+  → is-locally-small D
+  → ainjective-type D 𝓤 𝓥
+  → has-two-distinct-points D
+  → decomposable D ↔ WEM 𝓤
+ ainjective-type-decomposable-iff-WEM⁺ pe D D-ls D-ainj htdp =
+  ∥∥-rec
+   (WEM-is-prop fe)
+   (decomposition-of-ainjective-type-gives-WEM pe D D-ainj) ,
+  (λ wem → ∣ WEM-gives-decomposition-of-two-pointed-types⁺ wem D D-ls htdp ∣)
+
+\end{code}
+
+End of addition.
+
+Notice that the following doesn't mention WEM in its statement, but
+its proof does. Although the proof is constructive, the assumption is
+necessarily non-constructive.
+
+\begin{code}
+
  ainjective-type-decomposability-gives-decomposition
   : propext 𝓤
   → (D : 𝓤 ̇ )
@@ -614,6 +653,27 @@ module decomposability-bis (pt : propositional-truncations-exist) where
 
 \end{code}
 
+Also added 25th July 2024 for the same reason given above:
+
+\begin{code}
+
+ ainjective-type-decomposability-gives-decomposition⁺
+  : propext 𝓤
+  → (D : 𝓤 ⁺ ̇ )
+  → is-locally-small D
+  → ainjective-type D 𝓤 𝓥
+  → has-two-distinct-points D
+  → decomposable D
+  → decomposition D
+ ainjective-type-decomposability-gives-decomposition⁺ pe D D-ls D-ainj htdp δ =
+  WEM-gives-decomposition-of-two-pointed-types⁺
+   (lr-implication (ainjective-type-decomposable-iff-WEM⁺ pe D D-ls D-ainj htdp) δ)
+   D
+   D-ls
+   htdp
+
+\end{code}
+
 Added by Martin Escardo 10th June 2024. From any non-trivial,
 totally separated, injective type we get the double negation of the
 principle of weak excluded middle. Here by non-trivial we mean that
diff --git a/source/Taboos/DrinkerParadox.lagda b/source/Taboos/DrinkerParadox.lagda
index cab341207..0c5fc6060 100644
--- a/source/Taboos/DrinkerParadox.lagda
+++ b/source/Taboos/DrinkerParadox.lagda
@@ -19,7 +19,6 @@ open PropositionalTruncation pt
 
 open import MLTT.Spartan
 open import UF.ClassicalLogic
-open import UF.Subsingletons
 open import UF.SubtypeClassifier
 
 \end{code}
diff --git a/source/Taboos/FiniteSubsetTaboo.lagda b/source/Taboos/FiniteSubsetTaboo.lagda
index 7cb1afd41..0bfdc3da4 100644
--- a/source/Taboos/FiniteSubsetTaboo.lagda
+++ b/source/Taboos/FiniteSubsetTaboo.lagda
@@ -19,7 +19,6 @@ module Taboos.FiniteSubsetTaboo (pt : propositional-truncations-exist)
 
 open import Fin.Kuratowski pt
 open import Fin.Type
-open import MLTT.Negation
 open import MLTT.Spartan
 open import Naturals.Order
 open import Notation.Order
diff --git a/source/Taboos/LLPO.lagda b/source/Taboos/LLPO.lagda
index 28e9b3f63..1df55fd50 100644
--- a/source/Taboos/LLPO.lagda
+++ b/source/Taboos/LLPO.lagda
@@ -9,8 +9,6 @@ Lesser Limited Principle of Omniscience.
 module Taboos.LLPO where
 
 open import CoNaturals.BothTypes
-open import CoNaturals.Equivalence
-open import CoNaturals.Type2Properties
 open import MLTT.Plus-Properties
 open import MLTT.Spartan
 open import MLTT.Two-Properties
@@ -19,7 +17,6 @@ open import Naturals.Properties
 open import Notation.CanonicalMap
 open import Taboos.BasicDiscontinuity
 open import Taboos.WLPO
-open import UF.Equiv
 open import UF.FunExt
 open import UF.PropTrunc
 open import UF.Subsingletons
diff --git a/source/Taboos/LPO.lagda b/source/Taboos/LPO.lagda
index 322552651..fb3bf9ac7 100644
--- a/source/Taboos/LPO.lagda
+++ b/source/Taboos/LPO.lagda
@@ -28,7 +28,7 @@ GenericConvergentSequence)
 
 open import UF.FunExt
 
-module Taboos.LPO (fe : FunExt) where
+module Taboos.LPO where
 
 open import CoNaturals.Type
 open import MLTT.Spartan
@@ -43,32 +43,48 @@ open import UF.Equiv
 open import UF.Subsingletons
 open import UF.Subsingletons-FunExt
 
-private
- fe₀ = fe 𝓤₀ 𝓤₀
-
 LPO : 𝓤₀ ̇
 LPO = (x : ℕ∞) → is-decidable (Σ n ꞉ ℕ , x ＝ ι n)
 
-LPO-is-prop : is-prop LPO
-LPO-is-prop = Π-is-prop fe₀ f
+\end{code}
+
+Added 10th September 2024. In retrospect, it would have been better if
+we had equivalently defined
+
+  LPO = (x : ℕ∞) → is-decidable (Σ n ꞉ ℕ , ι n ＝ ℕ)
+
+because we have
+
+  fiber ι x = Σ n ꞉ ℕ , ι n ＝ ℕ
+
+by definition and ι is an embedding, so that e.g. the following would
+require a proof given our definition of embedding.
+
+End of addition.
+
+\begin{code}
+
+LPO-is-prop : funext₀ → is-prop LPO
+LPO-is-prop fe = Π-is-prop fe f
  where
   a : (x : ℕ∞) → is-prop (Σ n ꞉ ℕ , x ＝ ι n)
-  a x (n , p) (m , q) = to-Σ-＝ (ℕ-to-ℕ∞-lc (p ⁻¹ ∙ q) , ℕ∞-is-set fe₀ _ _)
+  a x (n , p) (m , q) = to-Σ-＝ (ℕ-to-ℕ∞-lc (p ⁻¹ ∙ q) , ℕ∞-is-set fe _ _)
 
   f : (x : ℕ∞) → is-prop (is-decidable (Σ n ꞉ ℕ , x ＝ ι n))
-  f x = decidability-of-prop-is-prop fe₀ (a x)
+  f x = decidability-of-prop-is-prop fe (a x)
 
 \end{code}
 
 We now show that LPO is logically equivalent to its traditional
-formulation by Bishop. However, the traditional formulation is not a
-univalent proposition in general, and not type equivalent (in the
-sense of UF) to our formulation.
+formulation by Bishop, which here amounts the compactness of ℕ.
+However, the traditional formulation is not a univalent proposition in
+general, and not type equivalent (in the sense of UF) to our
+formulation.
 
 \begin{code}
 
-LPO-gives-compact-ℕ : LPO → is-compact ℕ
-LPO-gives-compact-ℕ ℓ β = γ
+LPO-gives-compact-ℕ : funext₀ → LPO → is-compact ℕ
+LPO-gives-compact-ℕ fe ℓ β = γ
   where
     A = (Σ n ꞉ ℕ , β n ＝ ₀) + (Π n ꞉ ℕ , β n ＝ ₁)
 
@@ -102,7 +118,7 @@ LPO-gives-compact-ℕ ℓ β = γ
             c = v n
 
             l : x ＝ ∞
-            l = not-finite-is-∞ fe₀ v
+            l = not-finite-is-∞ fe v
 
             e : α n ＝ ₁
             e = ap (λ - → ι - n) l
@@ -110,8 +126,8 @@ LPO-gives-compact-ℕ ℓ β = γ
     γ : A
     γ = cases a b d
 
-compact-ℕ-gives-LPO : is-compact ℕ → LPO
-compact-ℕ-gives-LPO κ x = γ
+compact-ℕ-gives-LPO : funext₀ → is-compact ℕ → LPO
+compact-ℕ-gives-LPO fe κ x = γ
   where
     A = is-decidable (Σ n ꞉ ℕ , x ＝ ι n)
 
@@ -125,7 +141,7 @@ compact-ℕ-gives-LPO κ x = γ
     a (n , p) = inl (pr₁ g , pr₂(pr₂ g))
       where
         g : Σ m ꞉ ℕ , (m ≤ n) × (x ＝ ι m)
-        g = ℕ-to-ℕ∞-lemma fe₀ x n p
+        g = ℕ-to-ℕ∞-lemma fe x n p
 
     b : (Π n ꞉ ℕ , β n ＝ ₁) → A
     b φ = inr g
@@ -164,17 +180,17 @@ knowing whether LPO holds or not!
 
 open import TypeTopology.PropTychonoff
 
-[LPO→ℕ]-is-compact∙ : is-compact∙ (LPO → ℕ)
-[LPO→ℕ]-is-compact∙ = prop-tychonoff-corollary' fe LPO-is-prop f
+[LPO→ℕ]-is-compact∙ : funext₀ → is-compact∙ (LPO → ℕ)
+[LPO→ℕ]-is-compact∙ fe = prop-tychonoff-corollary' fe (LPO-is-prop fe) f
  where
    f : LPO → is-compact∙ ℕ
-   f lpo = compact-pointed-types-are-compact∙ (LPO-gives-compact-ℕ lpo) 0
+   f lpo = compact-pointed-types-are-compact∙ (LPO-gives-compact-ℕ fe lpo) 0
 
-[LPO→ℕ]-is-compact : is-compact (LPO → ℕ)
-[LPO→ℕ]-is-compact = compact∙-types-are-compact [LPO→ℕ]-is-compact∙
+[LPO→ℕ]-is-compact : funext₀ → is-compact (LPO → ℕ)
+[LPO→ℕ]-is-compact fe = compact∙-types-are-compact ([LPO→ℕ]-is-compact∙ fe)
 
-[LPO→ℕ]-is-Compact : is-Compact (LPO → ℕ) {𝓤}
-[LPO→ℕ]-is-Compact = compact-types-are-Compact [LPO→ℕ]-is-compact
+[LPO→ℕ]-is-Compact : funext₀ → is-Compact (LPO → ℕ) {𝓤}
+[LPO→ℕ]-is-Compact fe = compact-types-are-Compact ([LPO→ℕ]-is-compact fe)
 
 \end{code}
 
@@ -187,10 +203,13 @@ Feb 2020):
 open import Naturals.Properties
 open import UF.DiscreteAndSeparated
 
-[LPO→ℕ]-discrete-gives-¬LPO-decidable : is-discrete (LPO → ℕ) → is-decidable (¬ LPO)
-[LPO→ℕ]-discrete-gives-¬LPO-decidable =
+[LPO→ℕ]-discrete-gives-¬LPO-decidable
+ : funext₀
+ → is-discrete (LPO → ℕ)
+ → is-decidable (¬ LPO)
+[LPO→ℕ]-discrete-gives-¬LPO-decidable fe =
   discrete-exponential-has-decidable-emptiness-of-exponent
-   fe₀
+   fe
    (1 , 0 , positive-not-zero 0)
 
 \end{code}
@@ -222,21 +241,38 @@ embedding ι𝟙 : ℕ + 𝟙 → ℕ∞ has a section:
 ι𝟙-inverse .(ι n) (inl (n , refl)) = inl n
 ι𝟙-inverse u (inr g) = inr ⋆
 
-LPO-gives-has-section-ι𝟙 : LPO → Σ s ꞉ (ℕ∞ → ℕ + 𝟙) , ι𝟙 ∘ s ∼ id
-LPO-gives-has-section-ι𝟙 lpo = s , ε
+LPO-gives-has-section-ι𝟙 : funext₀ → LPO → Σ s ꞉ (ℕ∞ → ℕ + 𝟙) , ι𝟙 ∘ s ∼ id
+LPO-gives-has-section-ι𝟙 fe lpo = s , ε
  where
   s : ℕ∞ → ℕ + 𝟙
   s u = ι𝟙-inverse u (lpo u)
 
   φ : (u : ℕ∞) (d : is-decidable (Σ n ꞉ ℕ , u ＝ ι n)) → ι𝟙 (ι𝟙-inverse u d) ＝ u
   φ .(ι n) (inl (n , refl)) = refl
-  φ u (inr g) = (not-finite-is-∞ fe₀ (curry g))⁻¹
+  φ u (inr g) = (not-finite-is-∞ fe (curry g))⁻¹
 
   ε : ι𝟙 ∘ s ∼ id
   ε u = φ u (lpo u)
 
-LPO-gives-ι𝟙-is-equiv : LPO → is-equiv ι𝟙
-LPO-gives-ι𝟙-is-equiv lpo = embeddings-with-sections-are-equivs ι𝟙
-                             (ι𝟙-is-embedding fe₀)
-                             (LPO-gives-has-section-ι𝟙 lpo)
+LPO-gives-ι𝟙-is-equiv : funext₀ → LPO → is-equiv ι𝟙
+LPO-gives-ι𝟙-is-equiv fe lpo = embeddings-with-sections-are-equivs ι𝟙
+                               (ι𝟙-is-embedding fe)
+                               (LPO-gives-has-section-ι𝟙 fe lpo)
+\end{code}
+
+Added 3rd September 2024.
+
+\begin{code}
+
+open import Taboos.WLPO
+
+LPO-gives-WLPO : funext₀ → LPO → WLPO
+LPO-gives-WLPO fe lpo u =
+ Cases (lpo u)
+  (λ (n , p) → inr (λ {refl → ∞-is-not-finite n p}))
+  (λ ν → inl (not-finite-is-∞ fe (λ n p → ν (n , p))))
+
+¬WLPO-gives-¬LPO : funext₀ → ¬ WLPO → ¬ LPO
+¬WLPO-gives-¬LPO fe = contrapositive (LPO-gives-WLPO fe)
+
 \end{code}
diff --git a/source/Taboos/MarkovsPrinciple.lagda b/source/Taboos/MarkovsPrinciple.lagda
new file mode 100644
index 000000000..220e2aa3a
--- /dev/null
+++ b/source/Taboos/MarkovsPrinciple.lagda
@@ -0,0 +1,65 @@
+Martin Escardo 11th September 2024.
+
+Markov's principle and the well-known fact that it and WLPO together
+imply LPO.
+
+\begin{code}
+
+{-# OPTIONS --safe --without-K --lossy-unification #-}
+
+module Taboos.MarkovsPrinciple where
+
+open import MLTT.Spartan
+open import MLTT.Two-Properties
+open import NotionsOfDecidability.Complemented
+open import Taboos.LPO
+open import Taboos.WLPO
+open import TypeTopology.CompactTypes
+open import UF.DiscreteAndSeparated
+open import UF.FunExt
+
+MP : (𝓤 : Universe) → 𝓤 ⁺ ̇
+MP 𝓤 = (A : ℕ → 𝓤 ̇ )
+     → is-complemented A
+     → ¬¬ (Σ n ꞉ ℕ , A n)
+     → Σ n ꞉ ℕ , A n
+
+MP-and-WLPO-give-LPO
+ : funext 𝓤₀ 𝓤₀
+ → MP 𝓤₀
+ → WLPO → LPO
+MP-and-WLPO-give-LPO fe mp wlpo = III
+ where
+  I : WLPO-traditional
+  I = WLPO-gives-WLPO-traditional fe wlpo
+
+  II : WLPO-traditional → is-compact ℕ
+  II wlpot p = II₄
+   where
+    II₀ : ¬ (Σ n ꞉ ℕ , p n ＝ ₀) → (n : ℕ) → p n ＝ ₁
+    II₀ ν n = Lemma[b≠₀→b＝₁] (λ (e : p n ＝ ₀) → ν (n , e))
+
+    II₁ : ¬ ((n : ℕ) → p n ＝ ₁) → ¬¬ (Σ n ꞉ ℕ , p n ＝ ₀)
+    II₁ = contrapositive II₀
+
+    II₂ : ¬ ((n : ℕ) → p n ＝ ₁) → Σ n ꞉ ℕ , p n ＝ ₀
+    II₂ ν = mp (λ n → p n ＝ ₀)
+               (λ n → 𝟚-is-discrete (p n) ₀)
+               (II₁ ν)
+
+    II₃ : is-decidable ((n : ℕ) → p n ＝ ₁)
+        → (Σ n ꞉ ℕ , p n ＝ ₀) + ((n : ℕ) → p n ＝ ₁)
+    II₃ (inl a) = inr a
+    II₃ (inr ν) = inl (II₂ ν)
+
+    II₄ : (Σ n ꞉ ℕ , p n ＝ ₀) + ((n : ℕ) → p n ＝ ₁)
+    II₄ = II₃ (wlpot p)
+
+  III : LPO
+  III = compact-ℕ-gives-LPO fe (II I)
+
+\end{code}
+
+TODO. It doesn't matter if we formulated MP with Σ or ∃, or for
+𝟚-valued functions, so that we get four logically equivalent
+formulations.
diff --git a/source/Taboos/P2.lagda b/source/Taboos/P2.lagda
index cc47fc2bc..5148dc9b2 100644
--- a/source/Taboos/P2.lagda
+++ b/source/Taboos/P2.lagda
@@ -17,7 +17,6 @@ private
  fe' 𝓤 𝓥 = fe {𝓤} {𝓥}
 
 open import MLTT.Spartan
-open import MLTT.Two
 open import MLTT.Two-Properties
 open import UF.Base
 open import UF.ClassicalLogic
@@ -383,16 +382,19 @@ this file so far.
 irrefutable-props-are-thinly-inhabited-gives-WEM
  : ((P : 𝓤 ̇ ) → is-prop P → ¬¬ P → is-thinly-inhabited P)
  → WEM 𝓤
-irrefutable-props-are-thinly-inhabited-gives-WEM {𝓤} α Q i =
-  thinly-inhabited-wem-lemma Q h
+irrefutable-props-are-thinly-inhabited-gives-WEM {𝓤} α = I
  where
-  P = Q + ¬ Q
+  module _ (Q : 𝓤 ̇ ) (i : is-prop Q) where
+   P = Q + ¬ Q
 
-  ν : ¬¬ P
-  ν ϕ = ϕ (inr (λ q → ϕ (inl q)))
+   ν : ¬¬ P
+   ν ϕ = ϕ (inr (λ q → ϕ (inl q)))
 
-  h : is-thinly-inhabited P
-  h = α P (decidability-of-prop-is-prop fe i) ν
+   h : is-thinly-inhabited P
+   h = α P (decidability-of-prop-is-prop fe i) ν
+
+  I : WEM 𝓤
+  I = WEM'-gives-WEM fe (λ Q i → thinly-inhabited-wem-lemma Q (h Q i))
 
 \end{code}
 
diff --git a/source/Taboos/WLPO.lagda b/source/Taboos/WLPO.lagda
index 41a068753..cbfdebb94 100644
--- a/source/Taboos/WLPO.lagda
+++ b/source/Taboos/WLPO.lagda
@@ -79,7 +79,7 @@ Notice that weak excluded middle implies WLPO.
 open import UF.ClassicalLogic
 
 WEM-gives-WLPO : funext₀ → WEM 𝓤₀ → WLPO
-WEM-gives-WLPO fe wem u = Cases (wem (u ＝ ∞) (ℕ∞-is-set fe))
+WEM-gives-WLPO fe wem u = Cases (wem (u ＝ ∞))
                            (λ (p : (u ≠ ∞))
                                  → inr p)
                            (λ (ν : ¬ (u ≠ ∞))
@@ -97,7 +97,7 @@ WLPO-traditional = (α : ℕ → 𝟚) → is-decidable ((n : ℕ) → α n ＝
 
 open import MLTT.Two-Properties
 
-WLPO-gives-WLPO-traditional : Fun-Ext → WLPO → WLPO-traditional
+WLPO-gives-WLPO-traditional : funext 𝓤₀ 𝓤₀ → WLPO → WLPO-traditional
 WLPO-gives-WLPO-traditional fe wlpo α = IV
  where
   I : (ℕ→𝟚-to-ℕ∞ α ＝ ∞) + (ℕ→𝟚-to-ℕ∞ α ≠ ∞)
@@ -133,7 +133,7 @@ WLPO-gives-WLPO-traditional fe wlpo α = IV
              ℕ∞-to-ℕ→𝟚 ∞ n             ∎
 
   IV : is-decidable ((n : ℕ) → α n ＝ ₁)
-  IV = map-is-decidable II III I
+  IV = map-decidable II III I
 
 WLPO-traditional-gives-WLPO : funext₀ → WLPO-traditional → WLPO
 WLPO-traditional-gives-WLPO fe wlpot u = IV
@@ -148,6 +148,43 @@ WLPO-traditional-gives-WLPO fe wlpot u = IV
   III e n = ap (λ - → ℕ∞-to-ℕ→𝟚 - n) e
 
   IV : (u ＝ ∞) + (u ≠ ∞)
-  IV = map-is-decidable II III I
+  IV = map-decidable II III I
 
 \end{code}
+
+Added 9th September 2024. WLPO amounts to saying that the constancy of
+a binary sequence is decidable.
+
+\begin{code}
+
+WLPO-variation : 𝓤₀ ̇
+WLPO-variation = (α : ℕ → 𝟚) → is-decidable ((n : ℕ) → α n ＝ α 0)
+
+WLPO-variation-gives-WLPO-traditional
+ : WLPO-variation
+ → WLPO-traditional
+WLPO-variation-gives-WLPO-traditional wlpov α
+ = 𝟚-equality-cases I II
+ where
+  I : α 0 ＝ ₀ → ((n : ℕ) → α n ＝ ₁) + ¬ ((n : ℕ) → α n ＝ ₁)
+  I p = inr (λ (ϕ : (n : ℕ) → α n ＝ ₁)
+               → zero-is-not-one
+                  (₀   ＝⟨ p ⁻¹ ⟩
+                   α 0 ＝⟨ ϕ 0 ⟩
+                   ₁   ∎))
+
+  II : α 0 ＝ ₁ → ((n : ℕ) → α n ＝ ₁) + ¬ ((n : ℕ) → α n ＝ ₁)
+  II p = map-decidable
+          (λ (ϕ : (n : ℕ) → α n ＝ α 0) (n : ℕ)
+             → α n ＝⟨ ϕ n ⟩
+               α 0 ＝⟨ p ⟩
+               ₁   ∎)
+          (λ (γ : (n : ℕ) → α n ＝ ₁) (n : ℕ)
+             → α n ＝⟨ γ n ⟩
+               ₁   ＝⟨ p ⁻¹ ⟩
+               α 0 ∎)
+          (wlpov α)
+
+\end{code}
+
+TODO. The converse.
diff --git a/source/Taboos/index.lagda b/source/Taboos/index.lagda
index a3711f028..d8f5f054e 100644
--- a/source/Taboos/index.lagda
+++ b/source/Taboos/index.lagda
@@ -14,6 +14,7 @@ import Taboos.DrinkerParadox
 import Taboos.FiniteSubsetTaboo    -- by Ayberk Tosun
 import Taboos.LLPO
 import Taboos.LPO
+import Taboos.MarkovsPrinciple
 import Taboos.P2
 import Taboos.WLPO
 
diff --git a/source/TypeTopology/ADecidableQuantificationOverTheNaturals.lagda b/source/TypeTopology/ADecidableQuantificationOverTheNaturals.lagda
index 8157196ed..861abaf9f 100644
--- a/source/TypeTopology/ADecidableQuantificationOverTheNaturals.lagda
+++ b/source/TypeTopology/ADecidableQuantificationOverTheNaturals.lagda
@@ -1,13 +1,18 @@
 Chuangjie Xu, 2012.
 
 This is an Agda formalization of Theorem 8.2 of the extended version
-of Escardo's paper "Infinite sets that satisfy the principle of
-omniscience in all varieties of constructive mathematics", Journal of
-Symbolic Logic, volume 78, number 3, September 2013, pages 764-784.
+of [1].
 
 The theorem says that, for any p : ℕ∞ → 𝟚, the proposition
 (n : ℕ) → p (ι n) ＝ ₁ is decidable where ι : ℕ → ∞ is the inclusion.
 
+[1] Martin Escardo. Infinite sets that satisfy the principle of
+    omniscience in all varieties of constructive mathematics, Journal
+    of Symbolic Logic, volume 78, number 3, September 2013, pages
+    764-784.
+
+    https://doi.org/10.2178/jsl.7803040
+
 \begin{code}
 
 {-# OPTIONS --safe --without-K #-}
@@ -22,10 +27,8 @@ open import MLTT.Two-Properties
 open import Notation.CanonicalMap
 open import NotionsOfDecidability.Complemented
 open import NotionsOfDecidability.Decidable
-open import TypeTopology.CompactTypes
 open import TypeTopology.GenericConvergentSequenceCompactness fe
 open import UF.DiscreteAndSeparated
-open import UF.PropTrunc
 
 Lemma-8·1 : (p : ℕ∞ → 𝟚) → (Σ x ꞉ ℕ∞ , (x ≠ ∞) × (p x ＝ ₀))
                          + ((n : ℕ) → p (ι n) ＝ ₁)
@@ -89,13 +92,20 @@ Lemma-8·1 p = cases claim₀ claim₁ claim₂
     q = pr₁ f
 
     g : (Σ y ꞉ ℕ∞ , q y ＝ ₀) + ((y : ℕ∞) → q y ＝ ₁)
-     → (Σ y ꞉ ℕ∞ , p y ≠ p (Succ y)) + ((y : ℕ∞) → p y ＝ p (Succ y))
+      → (Σ y ꞉ ℕ∞ , p y ≠ p (Succ y)) + ((y : ℕ∞) → p y ＝ p (Succ y))
     g (inl (y , r)) = inl (y , (pr₁ (pr₂ f y) r))
     g (inr h ) = inr (λ y → discrete-is-¬¬-separated
                              𝟚-is-discrete
                              (p y) (p (Succ y))
                              (pr₂ (pr₂ f y) (h y)))
 
+\end{code}
+
+TODO. The name of the following fact is that of the reference [1]
+above. It deserves a better name, or at least a better synonym.
+
+\begin{code}
+
 abstract
  Theorem-8·2 : (p : ℕ∞ → 𝟚) → is-decidable ((n : ℕ) → p (ι n) ＝ ₁)
  Theorem-8·2 p = cases claim₀ claim₁ (Lemma-8·1 p)
@@ -181,7 +191,8 @@ module examples where
     p₄ : ℕ∞ → 𝟚
     p₄ (α , _) = α 5 == α 100
 
-    to-something : (p : ℕ∞ → 𝟚) → is-decidable ((n : ℕ) → p (ι n) ＝ ₁) → (p (ι 17) ＝ ₁) + ℕ
+    to-something : (p : ℕ∞ → 𝟚)
+                 → is-decidable ((n : ℕ) → p (ι n) ＝ ₁) → (p (ι 17) ＝ ₁) + ℕ
     to-something p (inl f) = inl (f 17)
     to-something p (inr _) = inr 1070
 
@@ -192,3 +203,33 @@ module examples where
 
     Despite the fact that we use function extensionality, eval pi
     evaluates to a numeral for i=0,...,4.
+
+
+Added by Martin Escardo 5th September 2024. The following version is
+more convenient in practice.
+
+\begin{code}
+
+
+abstract
+ Theorem-8·2' : (A : ℕ∞ → 𝓤 ̇ )
+              → is-complemented A
+              → is-decidable ((n : ℕ) → A (ι n))
+ Theorem-8·2' {𝓤} A δ = IV
+  where
+   p : ℕ∞ → 𝟚
+   p = complement ∘ characteristic-map A δ
+
+   I : is-decidable ((n : ℕ) → p (ι n) ＝ ₁)
+   I = Theorem-8·2 p
+
+   II : ((n : ℕ) → p (ι n) ＝ ₁) → (n : ℕ) → A (ι n)
+   II b n = characteristic-map-property₀ A δ (ι n) (complement₁ (b n))
+
+   III : ((n : ℕ) → A (ι n)) → (n : ℕ) → p (ι n) ＝ ₁
+   III a n = complement₁-back (characteristic-map-property₀-back A δ (ι n) (a n))
+
+   IV : is-decidable ((n : ℕ) → A (ι n))
+   IV = map-decidable II III I
+
+\end{code}
diff --git a/source/TypeTopology/AbsolutenessOfCompactness.lagda b/source/TypeTopology/AbsolutenessOfCompactness.lagda
index 8faeea387..9a6168e9e 100644
--- a/source/TypeTopology/AbsolutenessOfCompactness.lagda
+++ b/source/TypeTopology/AbsolutenessOfCompactness.lagda
@@ -95,10 +95,8 @@ open import Modal.Subuniverse
 
 open import TypeTopology.CompactTypes
 
-open import UF.Base
 open import UF.Equiv
 open import UF.FunExt
-open import UF.Univalence
 open import UF.UniverseEmbedding
 
 \end{code}
@@ -449,7 +447,7 @@ general.
 \begin{code}
 
  modalities-preserve-compact
-  : (A : 𝓤 ̇  )
+  : (A : 𝓤 ̇ )
   → ○ (is-compact∙ A)
   → is-compact∙ (○ A)
  modalities-preserve-compact A c =
diff --git a/source/TypeTopology/AbsolutenessOfCompactnessExample.lagda b/source/TypeTopology/AbsolutenessOfCompactnessExample.lagda
index a5b9f4333..87f314206 100644
--- a/source/TypeTopology/AbsolutenessOfCompactnessExample.lagda
+++ b/source/TypeTopology/AbsolutenessOfCompactnessExample.lagda
@@ -15,9 +15,7 @@ import Modal.SigmaClosedReflectiveSubuniverse
 import TypeTopology.AbsolutenessOfCompactness
 open import TypeTopology.CompactTypes
 
-open import UF.Base
 open import UF.Equiv
-open import UF.Equiv-FunExt
 open import UF.FunExt
 open import UF.PropIndexedPiSigma
 open import UF.Subsingletons
@@ -103,7 +101,7 @@ prop-tychonoff₂ A A-compact = ΠA-compact
 
 \end{code}
 
-We are given a family of types A : P → 𝓤 ̇  and we aim to apply the
+We are given a family of types A : P → 𝓤 ̇ and we aim to apply the
 non-dependent version above to the product Π A. In order to do this,
 there are two things to check. Firstly, we have to show that P implies
 Π A is compact. This allows us to apply the non-dependent version
diff --git a/source/TypeTopology/Cantor.lagda b/source/TypeTopology/Cantor.lagda
new file mode 100644
index 000000000..93a380bab
--- /dev/null
+++ b/source/TypeTopology/Cantor.lagda
@@ -0,0 +1,343 @@
+Martin Escardo, 20th June 2019 onwards.
+
+The Cantor type of infinite binary sequences.
+
+\begin{code}
+
+{-# OPTIONS --safe --without-K #-}
+
+open import Apartness.Definition
+open import MLTT.Spartan
+open import MLTT.Two-Properties
+open import Naturals.Order
+open import Naturals.RootsTruncation
+open import Notation.Order
+open import NotionsOfDecidability.Decidable
+open import UF.DiscreteAndSeparated hiding (_♯_)
+open import UF.Equiv
+open import UF.FunExt
+open import UF.PropTrunc
+open import UF.Subsingletons
+open import UF.Subsingletons-FunExt
+
+module TypeTopology.Cantor where
+
+Cantor = ℕ → 𝟚
+
+\end{code}
+
+We let  α,β,γ range  over the  Cantor type.
+
+The constant sequences:
+
+\begin{code}
+
+𝟎 : Cantor
+𝟎 = (i ↦ ₀)
+
+𝟏 : Cantor
+𝟏 = (i ↦ ₁)
+
+\end{code}
+
+Cons, head and tail.
+
+\begin{code}
+
+head : Cantor → 𝟚
+head α = α 0
+
+tail : Cantor → Cantor
+tail α = α ∘ succ
+
+cons : 𝟚 → Cantor → Cantor
+cons n α 0        = n
+cons n α (succ i) = α i
+
+_∷_ : 𝟚 → Cantor → Cantor
+_∷_ = cons
+
+cons-∼ : {x : 𝟚} {α β : Cantor} → α ∼ β → x ∷ α ∼ x ∷ β
+cons-∼ h 0        = refl
+cons-∼ h (succ i) = h i
+
+∼-cons : {x y : 𝟚} {α : Cantor} → x ＝ y → x ∷ α ∼ y ∷ α
+∼-cons refl = ∼-refl
+
+head-cons : (n : 𝟚) (α : Cantor) → head (cons n α) ＝ n
+head-cons n α = refl
+
+tail-cons : (n : 𝟚) (α : Cantor) → tail (cons n α) ＝ α
+tail-cons n α = refl
+
+tail-cons' : (n : 𝟚) (α : Cantor) → tail (cons n α) ∼ α
+tail-cons' n α i = refl
+
+cons-head-tail : (α : Cantor) → α ∼ cons (head α) (tail α)
+cons-head-tail α 0        = refl
+cons-head-tail α (succ i) = refl
+
+\end{code}
+
+Agreement of two binary sequences α and β at the first n positions,
+written α ＝⟦ n ⟧ β.
+
+\begin{code}
+
+_＝⟦_⟧_ : Cantor → ℕ → Cantor → 𝓤₀ ̇
+α ＝⟦ 0      ⟧ β = 𝟙
+α ＝⟦ succ n ⟧ β = (head α ＝ head β) × (tail α ＝⟦ n ⟧ tail β)
+
+＝⟦⟧-refl : (α : Cantor) (k : ℕ) → α ＝⟦ k ⟧ α
+＝⟦⟧-refl α 0 = ⋆
+＝⟦⟧-refl α (succ k) = refl , ＝⟦⟧-refl (tail α) k
+
+＝⟦⟧-trans : (α β γ : Cantor) (k : ℕ) → α ＝⟦ k ⟧ β → β ＝⟦ k ⟧ γ → α ＝⟦ k ⟧ γ
+＝⟦⟧-trans α β γ 0 d e = ⋆
+＝⟦⟧-trans α β γ (succ k) (h , t) (h' , t') =
+ (h ∙ h') ,
+ ＝⟦⟧-trans (tail α) (tail β) (tail γ) k t t'
+
+＝⟦⟧-sym : (α β : Cantor) (k : ℕ) → α ＝⟦ k ⟧ β → β ＝⟦ k ⟧ α
+＝⟦⟧-sym α β 0        ⋆       = ⋆
+＝⟦⟧-sym α β (succ k) (h , t) = (h ⁻¹) , ＝⟦⟧-sym (tail α) (tail β) k t
+
+＝⟦⟧-is-decidable : (α β : Cantor) (k : ℕ) → is-decidable (α ＝⟦ k ⟧ β)
+＝⟦⟧-is-decidable α β 0        = inl ⋆
+＝⟦⟧-is-decidable α β (succ k) =
+ Cases (𝟚-is-discrete (head α) (head β))
+  (λ (h : head α ＝ head β)
+        → map-decidable
+           (λ (t : tail α ＝⟦ k ⟧ tail β) → h , t)
+           (λ (_ , t) → t)
+           (＝⟦⟧-is-decidable (tail α) (tail β) k))
+  (λ (ν : head α ≠ head β) → inr (λ (h , _) → ν h))
+
+\end{code}
+
+We have that (α ＝⟦ n ⟧ β) iff α k ＝ β k for all k < n:
+
+\begin{code}
+
+agreement→ : (α β : Cantor)
+             (n : ℕ)
+           → (α ＝⟦ n ⟧ β)
+           → ((k : ℕ) → k < n → α k ＝ β k)
+agreement→ α β 0        *       k        l = 𝟘-elim l
+agreement→ α β (succ n) (p , e) 0        l = p
+agreement→ α β (succ n) (p , e) (succ k) l = IH k l
+ where
+  IH : (k : ℕ) → k < n → α (succ k) ＝ β (succ k)
+  IH = agreement→ (tail α) (tail β) n e
+
+agreement← : (α β : Cantor)
+             (n : ℕ)
+           → ((k : ℕ) → k < n → α k ＝ β k)
+           → (α ＝⟦ n ⟧ β)
+agreement← α β 0        ϕ = ⋆
+agreement← α β (succ n) ϕ = ϕ 0 ⋆ , agreement← (tail α) (tail β) n (ϕ ∘ succ)
+
+\end{code}
+
+A function Cantor → 𝟚 is uniformly continuous if it has a modulus
+of continuity:
+
+\begin{code}
+
+_is-a-modulus-of-uniform-continuity-of_ : ℕ → (Cantor → 𝟚) → 𝓤₀ ̇
+m is-a-modulus-of-uniform-continuity-of p = ∀ α β → α ＝⟦ m ⟧ β → p α ＝ p β
+
+uniformly-continuous : (Cantor → 𝟚) → 𝓤₀ ̇
+uniformly-continuous p = Σ m ꞉ ℕ , m is-a-modulus-of-uniform-continuity-of p
+
+uniform-continuity-data = uniformly-continuous
+
+\end{code}
+
+Uniform continuity as defined above is data rather than property. This
+is because any number bigger than a modulus of uniform continuity is
+also a modulus.
+
+TODO. Show that
+
+ (Σ p ꞉ (Cantor  → 𝟚) , uniformly-continuous p) ≃ (Σ n ꞉ ℕ , Fin (2 ^ n) → 𝟚)
+
+If we define uniform continuity with ∃ rather than Σ, this is no
+longer the case.
+
+\begin{code}
+
+continuous : (Cantor → 𝟚) → 𝓤₀ ̇
+continuous p = ∀ α → Σ m ꞉ ℕ , (∀ β → α ＝⟦ m ⟧ β → p α ＝ p β)
+
+continuity-data = continuous
+
+\end{code}
+
+\begin{code}
+
+module notions-of-continuity (pt : propositional-truncations-exist) where
+
+ open PropositionalTruncation pt
+
+ is-uniformly-continuous : (Cantor → 𝟚) → 𝓤₀ ̇
+ is-uniformly-continuous p = ∃ m ꞉ ℕ , m is-a-modulus-of-uniform-continuity-of p
+
+ is-continuous : (Cantor → 𝟚) → 𝓤₀ ̇
+ is-continuous p = ∀ α → ∃ m ꞉ ℕ , (∀ β → α ＝⟦ m ⟧ β → p α ＝ p β)
+
+\end{code}
+
+We now define the canonical apartness relation _♯_ for points of the
+Cantor type. Two sequences are apart if they differ at some index.
+
+To make apartness into a proposition, which is crucial for our
+purposes, we consider the minimal index at which they differ. This
+allows us to avoid the assumption that propositional truncations
+exist. But we still need function extensionality, so that the proof is
+not in the realm of pure Martin-Löf type theory.
+
+\begin{code}
+
+open Apartness
+
+_♯_ : Cantor → Cantor → 𝓤₀ ̇
+α ♯ β = Σ n ꞉ ℕ , (α n ≠ β n)
+                × ((i : ℕ) → α i ≠ β i → n ≤ i)
+
+\end{code}
+
+We use δ to range over the type α n ≠ β n, and μ to range over the
+minimality condition (i : ℕ) → α i ≠ β i → n ≤ i, for α, β and n
+suitably specialized according to the situation we are considering.
+We also use the letter "a" to range over the apartness type α ♯ β.
+
+\begin{code}
+
+apartness-criterion : (α β : Cantor) → (Σ n ꞉ ℕ , α n ≠ β n) → α ♯ β
+apartness-criterion α β = minimal-witness
+                           (λ n → α n ≠ β n)
+                           (λ n → ¬-preserves-decidability
+                                   (𝟚-is-discrete (α n) (β n)))
+
+apartness-criterion-converse : (α β : Cantor) → α ♯ β → (Σ n ꞉ ℕ , α n ≠ β n)
+apartness-criterion-converse α β (n , δ , _) = (n , δ)
+
+\end{code}
+
+Hence, in view of the following, the type α ♯ β has the universal
+property of the propositional truncation of the type Σ n ꞉ ℕ , α n ≠ β n.
+
+\begin{code}
+
+♯-is-prop-valued : Fun-Ext → is-prop-valued _♯_
+♯-is-prop-valued fe α β (n , δ , μ) (n' , δ' , μ') = III
+ where
+  I : (n : ℕ) → is-prop ((α n ≠ β n) × ((i : ℕ) → α i ≠ β i → n ≤ i))
+  I n = ×-is-prop
+         (negations-are-props fe)
+         (Π₂-is-prop fe λ i _ → ≤-is-prop-valued n i)
+
+  II : n ＝ n'
+  II = ≤-anti n n' (μ n' δ') (μ' n δ)
+
+  III : (n , δ , μ) ＝[ α ♯ β ] (n' , δ' , μ')
+  III = to-subtype-＝ I II
+
+\end{code}
+
+The apartness axioms are satisfied, and, moreover, the apartness is tight.
+
+\begin{code}
+
+♯-is-irreflexive : is-irreflexive _♯_
+♯-is-irreflexive α (n , δ , μ) = ≠-is-irrefl (α n) δ
+
+♯-is-symmetric : is-symmetric _♯_
+♯-is-symmetric α β (n , δ , μ) = n , (λ e → δ (e ⁻¹)) , λ i d → μ i (≠-sym d)
+
+♯-strongly-cotransitive : is-strongly-cotransitive _♯_
+♯-strongly-cotransitive α β γ (n , δ , μ) = III
+ where
+  I : (α n ≠ γ n) + (β n ≠ γ n)
+  I = discrete-types-are-cotransitive' 𝟚-is-discrete {α n} {β n} {γ n} δ
+
+  II : type-of I → (α ♯ γ) + (β ♯ γ)
+  II (inl d) = inl (apartness-criterion α γ (n , d))
+  II (inr d) = inr (apartness-criterion β γ (n , d))
+
+  III : (α ♯ γ) + (β ♯ γ)
+  III = II I
+
+♯-is-tight : Fun-Ext → is-tight _♯_
+♯-is-tight fe α β ν = dfunext fe I
+ where
+  I : (n : ℕ) → α n ＝ β n
+  I n = 𝟚-is-¬¬-separated (α n) (β n)
+         (λ (d : α n ≠ β n) → ν (apartness-criterion α β (n , d)))
+
+\end{code}
+
+If two sequences α and β are apart, they agree before the apartness index n.
+
+\begin{code}
+
+♯-agreement : (α β : Cantor)
+              ((n , δ , μ) : α ♯ β)
+              (i : ℕ)
+            → i < n → α i ＝ β i
+♯-agreement α β (n , _ , μ) i ℓ = IV
+ where
+  I : α i ≠ β i → n ≤ i
+  I = μ i
+
+  II : ¬ (n ≤ i) → ¬ (α i ≠ β i)
+  II = contrapositive I
+
+  III : ¬ (n ≤ i)
+  III = less-not-bigger-or-equal i n ℓ
+
+  IV : α i ＝ β i
+  IV = 𝟚-is-¬¬-separated (α i) (β i) (II III)
+
+\end{code}
+
+The Cantor type is homogeneous.
+
+\begin{code}
+
+module _ (fe : Fun-Ext) (α β : Cantor) where
+
+ Cantor-swap : Cantor → Cantor
+ Cantor-swap γ i = (β i ⊕ α i) ⊕ γ i
+
+ Cantor-swap-involutive : Cantor-swap ∘ Cantor-swap ∼ id
+ Cantor-swap-involutive γ = dfunext fe (λ i → ⊕-involutive {β i ⊕ α i} {γ i})
+
+ Cantor-swap-swaps∼ : Cantor-swap α ∼ β
+ Cantor-swap-swaps∼ i =
+  Cantor-swap α i   ＝⟨ refl ⟩
+  (β i ⊕ α i) ⊕ α i ＝⟨ ⊕-assoc {β i} {α i} {α i} ⟩
+  β i ⊕ (α i ⊕ α i) ＝⟨ ap (β i ⊕_) (Lemma[b⊕b＝₀] {α i}) ⟩
+  β i ⊕ ₀           ＝⟨ ⊕-₀-right-neutral  ⟩
+  β i               ∎
+
+ Cantor-swap-swaps : Cantor-swap α ＝ β
+ Cantor-swap-swaps = dfunext fe Cantor-swap-swaps∼
+
+ Cantor-swap-swaps' : Cantor-swap β ＝ α
+ Cantor-swap-swaps' = involution-swap
+                       Cantor-swap
+                       Cantor-swap-involutive
+                       Cantor-swap-swaps
+
+ Cantor-swap-≃ : Cantor ≃ Cantor
+ Cantor-swap-≃ = Cantor-swap ,
+                 involutions-are-equivs Cantor-swap Cantor-swap-involutive
+
+Cantor-homogeneous : Fun-Ext
+                   → (α β : Cantor)
+                   → Σ f ꞉ Cantor ≃ Cantor , (⌜ f ⌝ α ＝ β)
+Cantor-homogeneous fe α β = Cantor-swap-≃ fe α β , Cantor-swap-swaps fe α β
+
+\end{code}
diff --git a/source/TypeTopology/CantorMinusPoint.lagda b/source/TypeTopology/CantorMinusPoint.lagda
index fed4e241e..e5c395bb9 100644
--- a/source/TypeTopology/CantorMinusPoint.lagda
+++ b/source/TypeTopology/CantorMinusPoint.lagda
@@ -22,139 +22,16 @@ open import MLTT.Spartan
 open import MLTT.Two-Properties
 open import Naturals.Order
 open import Notation.Order
-open import UF.DiscreteAndSeparated hiding (_♯_)
+open import TypeTopology.Cantor
 open import UF.Base
-open import UF.DiscreteAndSeparated hiding (_♯_)
 open import UF.Equiv
 open import UF.FunExt
 open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
-
-\end{code}
-
-We assume function extensionality in this file:
-
-\begin{code}
 
 module TypeTopology.CantorMinusPoint (fe : Fun-Ext) where
 
 \end{code}
 
-The Cantor type of infinite binary sequences:
-
-\begin{code}
-
-Cantor = ℕ → 𝟚
-
-\end{code}
-
-We let α,β,γ range over the Cantor type.
-
-The constantly ₁ sequence:
-
-\begin{code}
-
-𝟏 : Cantor
-𝟏 = (i ↦ ₁)
-
-\end{code}
-
-We now define the canonical apartness relation _♯_ for points of the
-Cantor type. Two sequences are apart if they differ at some index.
-
-To make apartness into a proposition, which is crucial for our
-purposes, we consider the minimal index at which they differ. This
-allows us to avoid the assumption that propositional truncations
-exist. But we still need function extensionality, so that the proof is
-not in the realm of pure Martin-Löf type theory.
-
-\begin{code}
-
-_♯_ : Cantor → Cantor → 𝓤₀ ̇
-α ♯ β = Σ n ꞉ ℕ , (α n ≠ β n)
-                × ((i : ℕ) → α i ≠ β i → n ≤ i)
-
-\end{code}
-
-TODO. It is easy to see that this is a tight apartness relation. Maybe
-implement this here. But this is not needed for our purposes.
-
-We use δ to range over the type α n ≠ β n, and μ to range over the
-minimality condition (i : ℕ) → α i ≠ β i → n ≤ i, for α, β and n
-suitably specialized according to the situation we are considering.
-We also use the letter "a" to range over the apartness type α ♯ β.
-
-As claimed above, the apartness relation is proposition-valued.
-
-\begin{code}
-
-♯-is-prop-valued : (α β : Cantor) → is-prop (α ♯ β)
-♯-is-prop-valued α β (n , δ , μ) (n' , δ' , μ') = III
- where
-  I : (n : ℕ) → is-prop ((α n ≠ β n) × ((i : ℕ) → α i ≠ β i → n ≤ i))
-  I n = ×-is-prop
-         (negations-are-props fe)
-         (Π₂-is-prop fe λ i _ → ≤-is-prop-valued n i)
-
-  II : n ＝ n'
-  II = ≤-anti n n' (μ n' δ') (μ' n δ)
-
-  III : (n , δ , μ) ＝[ α ♯ β ] (n' , δ' , μ')
-  III = to-subtype-＝ I II
-
-\end{code}
-
-If two sequences α and β are apart, they agree before the apartness index n.
-
-\begin{code}
-
-♯-agreement : (α β : Cantor) ((n , δ , μ) : α ♯ β) → (i : ℕ) → i < n → α i ＝ β i
-♯-agreement α β (n , _ , μ) i ℓ = IV
- where
-  I : α i ≠ β i → n ≤ i
-  I = μ i
-
-  II : ¬ (n ≤ i) → ¬ (α i ≠ β i)
-  II = contrapositive I
-
-  III : ¬ (n ≤ i)
-  III = less-not-bigger-or-equal i n ℓ
-
-  IV : α i ＝ β i
-  IV = 𝟚-is-¬¬-separated (α i) (β i) (II III)
-
-\end{code}
-
-Cons, head, tail.
-
-\begin{code}
-
-_∷_ : 𝟚 → Cantor → Cantor
-(x ∷ α) 0        = x
-(x ∷ α) (succ n) = α n
-
-head : Cantor → 𝟚
-head α = α 0
-
-tail : Cantor → Cantor
-tail α = α ∘ succ
-
-tail-cons : (x : 𝟚) (α : Cantor) → tail (x ∷ α) ∼ α
-tail-cons x α i = refl
-
-cons-head-tail : (α : Cantor) → head α ∷ tail α ∼ α
-cons-head-tail α 0        = refl
-cons-head-tail α (succ n) = refl
-
-cons-∼ : {x : 𝟚} {α β : Cantor} → α ∼ β → x ∷ α ∼ x ∷ β
-cons-∼ h 0        = refl
-cons-∼ h (succ i) = h i
-
-∼-cons : {x y : 𝟚} {α : Cantor} → x ＝ y → x ∷ α ∼ y ∷ α
-∼-cons refl = ∼-refl
-
-\end{code}
-
 The function ϕ is defined so that ϕ n β is the binary sequence of
 n-many ones followed by a zero and then β.
 
@@ -200,13 +77,18 @@ The function ψ n is a left inverse of the function ϕ n.
 ψϕ n α = dfunext fe (h n α)
  where
   h : (n : ℕ) (α : Cantor) → ψ n (ϕ n α) ∼ α
-  h 0        = tail-cons ₀
+  h 0        = tail-cons' ₀
   h (succ n) = h n
 
 \end{code}
 
-But it is a right inverse only for sequences α ♯ 𝟏, in the following
-sense.
+But it is a right inverse only for sequences α apart 𝟏, in the following
+sense, where the apartness relation is defined by
+
+    α ♯ β = Σ n ꞉ ℕ , (α n ≠ β n)
+                    × ((i : ℕ) → α i ≠ β i → n ≤ i)
+
+in the module Cantor.
 
 \begin{code}
 
@@ -222,13 +104,13 @@ sense.
   h 0 α δ _ =
    ϕ 0 (ψ 0 α)     ∼⟨ ∼-refl ⟩
    ₀ ∷ tail α      ∼⟨ ∼-ap (_∷ tail α) ((different-from-₁-equal-₀ δ)⁻¹) ⟩
-   head α ∷ tail α ∼⟨ cons-head-tail α ⟩
+   head α ∷ tail α ∼⟨ ∼-sym (cons-head-tail α) ⟩
    α               ∼∎
   h (succ n) α δ μ =
     ϕ (succ n) (ψ (succ n) α) ∼⟨ ∼-refl ⟩
     ₁ ∷ ϕ n (ψ n (tail α))    ∼⟨ cons-∼ (h n (tail α) δ (μ ∘ succ)) ⟩
     ₁ ∷ tail α                ∼⟨ h₁ ⟩
-    head α ∷ tail α           ∼⟨ cons-head-tail α ⟩
+    head α ∷ tail α           ∼⟨ ∼-sym (cons-head-tail α) ⟩
     α                         ∼∎
      where
       h₁ = ∼-cons ((♯-agreement α 𝟏 (succ n , δ , μ) 0 (zero-least n))⁻¹)
@@ -252,7 +134,7 @@ Cantor-minus-𝟏-≃ = qinveq f (g , gf , fg)
   g (n , β) = ϕ n β , n , ϕ-property-δ β n , ϕ-property-μ β n
 
   gf : g ∘ f ∼ id
-  gf (α , a) = to-subtype-＝ (λ α → ♯-is-prop-valued α 𝟏) (ϕψ α a)
+  gf (α , a) = to-subtype-＝ (λ α → ♯-is-prop-valued fe α 𝟏) (ϕψ α a)
 
   fg : f ∘ g ∼ id
   fg (n , β) = to-Σ-＝ (refl , ψϕ n β)
@@ -266,43 +148,7 @@ works.
 As discussed above, it doesn't matter which point we remove, because
 the Cantor space is homogeneous, in the sense that for any two points
 α and β there is an automorphism (in fact, an involution) that maps α
-to β.
-
-\begin{code}
-
-module _ (α β : Cantor) where
-
- Cantor-swap : Cantor → Cantor
- Cantor-swap γ i = (β i ⊕ α i) ⊕ γ i
-
- Cantor-swap-involutive : Cantor-swap ∘ Cantor-swap ∼ id
- Cantor-swap-involutive γ = dfunext fe (λ i → ⊕-involutive {β i ⊕ α i} {γ i})
-
- Cantor-swap-swaps∼ : Cantor-swap α ∼ β
- Cantor-swap-swaps∼ i =
-  Cantor-swap α i   ＝⟨ refl ⟩
-  (β i ⊕ α i) ⊕ α i ＝⟨ ⊕-assoc {β i} {α i} {α i} ⟩
-  β i ⊕ (α i ⊕ α i) ＝⟨ ap (β i ⊕_) (Lemma[b⊕b＝₀] {α i}) ⟩
-  β i ⊕ ₀           ＝⟨ ⊕-₀-right-neutral  ⟩
-  β i               ∎
-
- Cantor-swap-swaps : Cantor-swap α ＝ β
- Cantor-swap-swaps = dfunext fe Cantor-swap-swaps∼
-
- Cantor-swap-swaps' : Cantor-swap β ＝ α
- Cantor-swap-swaps' = involution-swap
-                       Cantor-swap
-                       Cantor-swap-involutive
-                       Cantor-swap-swaps
-
- Cantor-swap-≃ : Cantor ≃ Cantor
- Cantor-swap-≃ = Cantor-swap ,
-                 involutions-are-equivs Cantor-swap Cantor-swap-involutive
-
-Cantor-homogeneous : (α β : Cantor) → Σ f ꞉ Cantor ≃ Cantor , (⌜ f ⌝ α ＝ β)
-Cantor-homogeneous α β = Cantor-swap-≃ α β , Cantor-swap-swaps α β
-
-\end{code}
+to β, as proved in the module Cantor.
 
 TODO. Use this to conclude, as a corollary, that
 
diff --git a/source/TypeTopology/CantorSearch.lagda b/source/TypeTopology/CantorSearch.lagda
index f1a7202e4..d4b7e64e1 100644
--- a/source/TypeTopology/CantorSearch.lagda
+++ b/source/TypeTopology/CantorSearch.lagda
@@ -17,11 +17,8 @@ sequences to equal booleans.
 
 open import MLTT.Spartan
 open import MLTT.Two-Properties
-open import Naturals.Order
-open import Notation.Order
-open import UF.FunExt
+open import TypeTopology.Cantor
 open import UF.Base
-open import UF.DiscreteAndSeparated
 
 module TypeTopology.CantorSearch where
 
@@ -95,93 +92,7 @@ by checking whether or not p (ε𝟚 p) ＝ ₀. This is what A𝟚 does.
 
 \end{code}
 
-We use this to search over the Cantor type. We first need some
-preliminary definitions and facts.
-
-\begin{code}
-
-Cantor = ℕ → 𝟚
-
-head : Cantor → 𝟚
-head α = α 0
-
-tail : Cantor → Cantor
-tail α = α ∘ succ
-
-cons : 𝟚 → Cantor → Cantor
-cons n α 0        = n
-cons n α (succ i) = α i
-
-head-cons : (n : 𝟚) (α : Cantor) → head (cons n α) ＝ n
-head-cons n α = refl
-
-tail-cons : (n : 𝟚) (α : Cantor) → tail (cons n α) ＝ α
-tail-cons n α = refl
-
-cons-head-tail : (α : Cantor) → α ∼ cons (head α) (tail α)
-cons-head-tail α 0        = refl
-cons-head-tail α (succ i) = refl
-
-\end{code}
-
-Uniform continuity as defined below is data rather than property. This
-is because any number bigger than a modulus of uniform continuity is
-also a modulus.
-
-We first define when two binary sequences α and β agree at the first n
-positions, written α ＝⟦ n ⟧ β.
-
-\begin{code}
-
-_＝⟦_⟧_ : Cantor → ℕ → Cantor → 𝓤₀ ̇
-α ＝⟦ 0      ⟧ β = 𝟙
-α ＝⟦ succ n ⟧ β = (head α ＝ head β) × (tail α ＝⟦ n ⟧ tail β)
-
-\end{code}
-
-We have that (α ＝⟦ n ⟧ β) iff α k ＝ β k for all k < n:
-
-\begin{code}
-
-agreement→ : (α β : Cantor)
-             (n : ℕ)
-           → (α ＝⟦ n ⟧ β)
-           → ((k : ℕ) → k < n → α k ＝ β k)
-agreement→ α β 0        *       k        l = 𝟘-elim l
-agreement→ α β (succ n) (p , e) 0        l = p
-agreement→ α β (succ n) (p , e) (succ k) l = IH k l
- where
-  IH : (k : ℕ) → k < n → α (succ k) ＝ β (succ k)
-  IH = agreement→ (tail α) (tail β) n e
-
-agreement← : (α β : Cantor)
-             (n : ℕ)
-           → ((k : ℕ) → k < n → α k ＝ β k)
-           → (α ＝⟦ n ⟧ β)
-agreement← α β 0        ϕ = ⋆
-agreement← α β (succ n) ϕ = ϕ 0 ⋆ , agreement← (tail α) (tail β) n (ϕ ∘ succ)
-
-\end{code}
-
-A function is Cantor → 𝟚 is uniformly continuous if it has a modulus
-of continuity:
-
-\begin{code}
-
-_is-a-modulus-of-uniform-continuity-of_ : ℕ → (Cantor → 𝟚) → 𝓤₀ ̇
-n is-a-modulus-of-uniform-continuity-of p = (α β : Cantor) → α ＝⟦ n ⟧ β → p α ＝ p β
-
-uniformly-continuous : (Cantor → 𝟚) → 𝓤₀ ̇
-uniformly-continuous p = Σ n ꞉ ℕ , n is-a-modulus-of-uniform-continuity-of p
-
-\end{code}
-
-TODO. Show that
-
- (Σ p ꞉ (Cantor  → 𝟚) , uniformly-continuous p) ≃ (Σ n ꞉ ℕ , Fin (2 ^ n) → 𝟚)
-
-If we define uniform continuity with ∃ rather than Σ, this is no
-longer the case.
+We use this to search over the Cantor type.
 
 Notice that a function has modulus of continuity zero if and only if
 it is constant, and that if a function has modulus of continuity n
@@ -432,7 +343,7 @@ check this file with `false` is less than 2s.
  open import MLTT.Bool
 
  check-large-example : Bool
- check-large-example = true
+ check-large-example = false
 
  large-xor-example : if check-large-example then (xor-example 17 ＝ ₀) else (₀ ＝ ₀)
  large-xor-example = refl
diff --git a/source/TypeTopology/CompactTypes.lagda b/source/TypeTopology/CompactTypes.lagda
index 88077010c..5a781c562 100644
--- a/source/TypeTopology/CompactTypes.lagda
+++ b/source/TypeTopology/CompactTypes.lagda
@@ -680,11 +680,16 @@ in the original development:
 is-Σ-Compact : 𝓤 ̇ → {𝓥 : Universe} → 𝓤 ⊔ (𝓥 ⁺) ̇
 is-Σ-Compact X {𝓥} = (A : X → 𝓥 ̇ ) → is-complemented A → is-decidable (Σ A)
 
-is-Compact = is-Σ-Compact
-
 Complemented-choice : 𝓤 ̇ → {𝓥 : Universe} → 𝓤 ⊔ (𝓥 ⁺) ̇
 Complemented-choice X {𝓥} = (A : X → 𝓥 ̇ ) → is-complemented A → ¬¬ Σ A → Σ A
 
+Σ-Compactness-gives-Complemented-choice : {X : 𝓤 ̇ }
+                                        → is-Σ-Compact X {𝓥}
+                                        → Complemented-choice X {𝓥}
+Σ-Compactness-gives-Complemented-choice {𝓤} {𝓥} {X} c A δ = ¬¬-elim (c A δ)
+
+is-Compact = is-Σ-Compact
+
 Compactness-gives-complemented-choice : {X : 𝓤 ̇ }
                                       → is-Compact X
                                       → Complemented-choice X {𝓥}
@@ -897,12 +902,13 @@ module CompactTypesPT (pt : propositional-truncations-exist) where
              ∃-is-prop)
 
 
- ∃-Compactness-gives-Markov : {X : 𝓤 ̇ }
-                            → is-∃-Compact X {𝓥}
-                            → (A : X → 𝓥 ̇ )
-                            → is-complemented A
-                            → ¬¬ ∃ A
-                            → ∃ A
+ ∃-Compactness-gives-Markov
+  : {X : 𝓤 ̇ }
+  → is-∃-Compact X {𝓥}
+  → (A : X → 𝓥 ̇ )
+  → is-complemented A
+  → ¬¬ ∃ A
+  → ∃ A
  ∃-Compactness-gives-Markov {𝓤} {𝓥} {X} c A δ = ¬¬-elim (c A δ)
 
  ∥Compact∥-gives-∃-Compact : Fun-Ext
@@ -1134,10 +1140,10 @@ compact-gives-Σ+Π : (X : 𝓤 ̇ ) (A : X → 𝓥 ̇ ) (B : X → 𝓦 ̇ )
 compact-gives-Σ+Π X A B κ q = III II
  where
   p : X → 𝟚
-  p = pr₁ (indicator q)
+  p = indicator-map q
 
   I : (x : X) → (p x ＝ ₀ → A x) × (p x ＝ ₁ → B x)
-  I = pr₂ (indicator q)
+  I = indicator-property q
 
   II : (Σ x ꞉ X , p x ＝ ₀) + (Π x ꞉ X , p x ＝ ₁)
   II = κ p
diff --git a/source/TypeTopology/DecidabilityOfNonContinuity.lagda b/source/TypeTopology/DecidabilityOfNonContinuity.lagda
index cf1c86a86..a416c9bb3 100644
--- a/source/TypeTopology/DecidabilityOfNonContinuity.lagda
+++ b/source/TypeTopology/DecidabilityOfNonContinuity.lagda
@@ -1,21 +1,26 @@
-Martin Escardo, 7 May 2014.
+Martin Escardo, 7 May 2014, with many additions in the summer of 2024.
 
 For any function f : ℕ∞ → ℕ, it is decidable whether f is non-continuous.
 
-  Π (f : ℕ∞ → ℕ). ¬ (continuous f) + ¬¬ (continuous f).
+  (f : ℕ∞ → ℕ) → ¬ continuous f + ¬¬ continuous f.
 
 Based on the paper
 
+[1] Martin Escardo. Constructive decidability of classical continuity.
     Mathematical Structures in Computer Science , Volume 25,
     October 2015 , pp. 1578 - 1589
-    DOI: https://doi.org/10.1017/S096012951300042X
+    https://doi.org/10.1017/S096012951300042X
 
-The title of this paper is a bit misleading. It should have been
-called "Decidability of non-continuity".
+The title of this paper is a bit misleading. It should probably have
+been called "Decidability of non-continuity". In any case, it is not
+wrong.
+
+TODO. Parametrize this module by a discrete type, rather than use 𝟚 or
+ℕ as the types of values of functions.
 
 \begin{code}
 
-{-# OPTIONS --safe --without-K #-}
+{-# OPTIONS --safe --without-K --lossy-unification #-}
 
 open import MLTT.Spartan
 open import UF.FunExt
@@ -23,40 +28,72 @@ open import UF.FunExt
 module TypeTopology.DecidabilityOfNonContinuity (fe : funext 𝓤₀ 𝓤₀) where
 
 open import CoNaturals.Type
+open import MLTT.Plus-Properties
 open import MLTT.Two-Properties
 open import Notation.CanonicalMap
+open import Notation.Order
+open import NotionsOfDecidability.Complemented
 open import NotionsOfDecidability.Decidable
+open import Taboos.LPO
+open import Taboos.MarkovsPrinciple
 open import TypeTopology.ADecidableQuantificationOverTheNaturals fe
 open import UF.DiscreteAndSeparated
 
-Lemma-3·1 : (q : ℕ∞ → ℕ∞ → 𝟚)
-          → is-decidable ((m : ℕ) → ¬ ((n : ℕ) → q (ι m) (ι n) ＝ ₁))
-Lemma-3·1 q = claim₄
+\end{code}
+
+TODO. Give a more sensible name of the following fact. It is the name
+given in [1].
+
+This is an iterated version of Theorem 8.2 of [2], which also deserves
+a better name here, and it is the crucial lemma to prove the
+decidability of non-continuity.
+
+[2] Martin Escardo. Infinite sets that satisfy the principle of
+    omniscience in all varieties of constructive mathematics, Journal
+    of Symbolic Logic, volume 78, number 3, September 2013, pages
+    764-784.
+
+    https://doi.org/10.2178/jsl.7803040
+
+For convenience, we first recall the version of Theorem 8.2, which is
+used a number of times in this file.
+
+\begin{code}
+
+_ : (A : ℕ∞ → 𝓤 ̇ )
+  → is-complemented A
+  → is-decidable ((n : ℕ) → A (ι n))
+_ = Theorem-8·2'
+
+Lemma-3·1
+ : (A : ℕ∞ → ℕ∞ → 𝓤 ̇ )
+ → ((x y : ℕ∞) → is-decidable (A x y))
+ → is-decidable ((m : ℕ) → ¬ ((n : ℕ) → A (ι m) (ι n)))
+Lemma-3·1 {𝓤} A δ
+ = III
  where
-  A : ℕ∞ → 𝓤₀ ̇
-  A u = (n : ℕ) → q u (ι n) ＝ ₁
+  B : ℕ∞ → 𝓤 ̇
+  B u = (n : ℕ) → A u (ι n)
 
-  claim₀ :  (u : ℕ∞) → is-decidable (A u)
-  claim₀ u = Theorem-8·2 (q u)
+  I :  (x : ℕ∞) → is-decidable (B x)
+  I x = Theorem-8·2' (A x) (δ x)
 
-  p : ℕ∞ → 𝟚
-  p = pr₁ (indicator claim₀)
+  II :  (x : ℕ∞) → is-decidable (¬ B x)
+  II x = ¬-preserves-decidability (I x)
 
-  p-spec : (x : ℕ∞) → (p x ＝ ₀ → A x) × (p x ＝ ₁ → ¬ A x)
-  p-spec = pr₂ (indicator claim₀)
+  III : is-decidable ((n : ℕ) → ¬ B (ι n))
+  III = Theorem-8·2' (λ x → ¬ B x) II
 
-  claim₁ : is-decidable ((n : ℕ) → p (ι n) ＝ ₁)
-  claim₁ = Theorem-8·2 p
+\end{code}
 
-  claim₂ : ((n : ℕ) → ¬ A (ι n)) → (n : ℕ) → p (ι n) ＝ ₁
-  claim₂ φ n = different-from-₀-equal-₁ (λ v → φ n (pr₁ (p-spec (ι n)) v))
+The following is the original formulation of the above in [1], which
+we keep nameless as it is not needed for our purposes and in any case
+is just a direct particular case.
 
-  claim₃ : is-decidable ((n : ℕ) → p (ι n) ＝ ₁) → is-decidable ((n : ℕ) → ¬ A (ι n))
-  claim₃ (inl f) = inl (λ n → pr₂ (p-spec (ι n)) (f n))
-  claim₃ (inr u) = inr (contrapositive claim₂ u)
+\begin{code}
 
-  claim₄ : is-decidable ((n : ℕ) → ¬ (A (ι n)))
-  claim₄ = claim₃ claim₁
+_ : (q : ℕ∞ → ℕ∞ → 𝟚) → is-decidable ((m : ℕ) → ¬ ((n : ℕ) → q (ι m) (ι n) ＝ ₁))
+_ = λ q → Lemma-3·1 (λ x y → q x y ＝ ₁) (λ x y → 𝟚-is-discrete (q x y) ₁)
 
 \end{code}
 
@@ -66,48 +103,1553 @@ Omitting the inclusion function, or coercion,
 
 a map f : ℕ∞ → ℕ is called continuous iff
 
-   ∃ m. ∀ n ≥ m. f n ＝ ∞,
+   ∃ m : ℕ , ∀ n ≥ m , f n ＝ f ∞,
 
 where m and n range over the natural numbers.
 
-The negation of this statement is equivalent to
+The negation of this statement is (constructively) equivalent to
 
-   ∀ m. ¬ ∀ n ≥ m. f n ＝ ∞.
+   ∀ m : ℕ , ¬ ∀ n ≥ m , f n ＝ f ∞
 
-We can implement ∀ y ≥ x. A y as ∀ x. A (max x y), so that the
+via currying and uncurrying.
+
+We can implement ∀ y ≥ x , A y as ∀ x , A (max x y), so that the
 continuity of f amounts to
 
-   ∃ m. ∀ n. f (max m n) ＝ ∞,
+   ∃ m : ℕ ,  ∀ n : ℕ , f (max m n) ＝ f ∞,
 
 and its negation to
 
-   ∀ m. ¬ ∀ n. f (max m n) ＝ ∞.
+   ∀ m : ℕ , ¬ ∀ n : ℕ , f (max m n) ＝ f ∞,
+
+and it is technically convenient to do so here.
+
+The above paper [1] mentions that its mathematical development can be
+carried out in a number of foundations, including dependent type
+theory, but it doesn't say what "∃" should be taken to mean in
+HoTT/UF. Fortunately, it turns out (added summer 2024 - see below)
+that it doesn't matter whether `∃` is interpreted to mean `Σ` or the
+propositional truncation of `Σ`, although this is nontrivial and is
+proved below, but does follow from what is developed in [1].
+
+For the following, we adopt `∃` to mean the propositional truncation
+of `Σ` (as we generally do in TypeTopology).
+
+For the next few things, because we are going to prove facts about the
+negation of continuity, it doesn't matter whether we define the notion
+with ∃ or Σ, because negations are propositions in the presence of
+function extensionality, and we choose the latter for convenience.
+
+\begin{code}
+
+is-modulus-of-continuity : (ℕ∞ → ℕ) → ℕ → 𝓤₀ ̇
+is-modulus-of-continuity f m = (n : ℕ) → f (max (ι m) (ι n)) ＝ f ∞
+
+continuous : (ℕ∞ → ℕ) → 𝓤₀ ̇
+continuous f = Σ m ꞉ ℕ , is-modulus-of-continuity f m
+
+\end{code}
+
+Later we are going to use the terminology `is-continuous f` for the
+propositional truncation of the type `continuous f`, but also it will
+be more appropriate to think of the type `continuous f` as that of
+continuity data for f.
 
 \begin{code}
 
-non-continuous : (ℕ∞ → ℕ) → 𝓤₀ ̇
-non-continuous f = (m : ℕ) → ¬ ((n : ℕ) → f (max (ι m) (ι n)) ＝[ℕ] f ∞)
+continuity-data = continuous
 
-Theorem-3·2 : (f : ℕ∞ → ℕ) → is-decidable (non-continuous f)
-Theorem-3·2 f = Lemma-3·1 ((λ x y → χ＝ (f (max x y)) (f ∞)))
+\end{code}
+
+The following is Theorem 3.2 of [1] and is a direct application of
+Lemma 3.1.
+
+\begin{code}
+
+private
+ Theorem-3·2
+  : (f : ℕ∞ → ℕ)
+  → is-decidable (¬ continuous f)
+ Theorem-3·2 f
+  = map-decidable
+     uncurry
+     curry
+     (Lemma-3·1
+       (λ x y → f (max x y) ＝ (f ∞))
+       (λ x y → ℕ-is-discrete (f (max x y)) (f ∞)))
+
+\end{code}
+
+For our purposes, the following terminology is better.
+
+\begin{code}
+
+the-negation-of-continuity-is-decidable = Theorem-3·2
 
 \end{code}
 
-(Maybe) to be continued (see the paper for the moment).
+The paper [1] also discusses the following.
 
-   * MP gives that continuity and doubly negated continuity agree.
+ 1. MP gives that continuity and doubly negated continuity agree.
 
-   * WLPO is equivalent to the existence of a non-continuous function ℕ∞ → ℕ.
+ 2. WLPO is equivalent to the existence of a noncontinuous function
+    ℕ∞ → ℕ.
 
-   * ¬WLPO is equivalent to the doubly negated continuity of all functions ℕ∞ → ℕ.
+ 3. ¬ WLPO is equivalent to the doubly negated continuity of all
+    functions ℕ∞ → ℕ.
 
-   * If MP and ¬WLPO then all functions ℕ∞ → ℕ are continuous.
+ 4. If MP and ¬ WLPO then all functions ℕ∞ → ℕ are continuous.
 
-For future use:
+All of them are proved below, but not in this order.
+
+We first prove (2).
 
 \begin{code}
 
-continuous : (ℕ∞ → ℕ) → 𝓤₀ ̇
-continuous f = Σ m ꞉ ℕ , ((n : ℕ) → f (max (ι m) (ι n)) ＝ f ∞)
+open import Taboos.WLPO
+open import TypeTopology.CompactTypes
+open import TypeTopology.GenericConvergentSequenceCompactness fe
+
+noncontinuous-map-gives-WLPO
+ : (Σ f ꞉ (ℕ∞ → ℕ) , ¬ continuous f)
+ → WLPO
+noncontinuous-map-gives-WLPO (f , f-non-cts)
+ = VI
+ where
+  g : (u : ℕ∞)
+    → Σ v₀ ꞉ ℕ∞ , (f (max u v₀) ＝ f ∞ → (v : ℕ∞) → f (max u v) ＝ f ∞)
+  g u = ℕ∞-Compact∙
+         (λ v → f (max u v) ＝ f ∞)
+         (λ v → ℕ-is-discrete (f (max u v)) (f ∞))
+
+  G : ℕ∞ → ℕ∞
+  G u = max u (pr₁ (g u))
+
+  G-property₀ : (u : ℕ∞) → f (G u) ＝ f ∞ → (v : ℕ∞) → f (max u v) ＝ f ∞
+  G-property₀ u = pr₂ (g u)
+
+  G-property₁ : (u : ℕ∞)
+              → (Σ v ꞉ ℕ∞ , f (max u v) ≠ f ∞)
+              → f (G u) ≠ f ∞
+  G-property₁ u (v , d) = contrapositive
+                            (λ (e : f (G u) ＝ f ∞) → G-property₀ u e v)
+                            d
+
+  I : (u : ℕ∞)
+    → ¬¬ (Σ v ꞉ ℕ∞ , f (max u v) ≠ f ∞)
+    → (Σ v ꞉ ℕ∞ , f (max u v) ≠ f ∞)
+  I u = Σ-Compactness-gives-Complemented-choice
+          ℕ∞-Compact
+          (λ v → f (max u v) ≠ f ∞)
+          (λ v → ¬-preserves-decidability
+                  (ℕ-is-discrete (f (max u v)) (f ∞)))
+
+  II : (u : ℕ∞)
+     → ¬ (Σ v ꞉ ℕ∞ , f (max u v) ≠ f ∞)
+     → (v : ℕ∞) → f (max u v) ＝ f ∞
+  II u ν v = discrete-is-¬¬-separated
+              ℕ-is-discrete
+              (f (max u v))
+              (f ∞)
+              (λ (d : f (max u v) ≠ f ∞) → ν (v , d))
+
+  III : (u : ℕ∞)
+      → ¬ ((v : ℕ∞) → f (max u v) ＝ f ∞)
+      → ¬¬ (Σ v ꞉ ℕ∞ , f (max u v) ≠ f ∞)
+  III u = contrapositive (II u)
+
+  G-property₂ : (u : ℕ∞)
+              → ¬ ((v : ℕ∞) → f (max u v) ＝ f ∞)
+              → f (G u) ≠ f ∞
+  G-property₂ u a = G-property₁ u (I u (III u a))
+
+  G-propertyₙ : (n : ℕ) → f (G (ι n)) ≠ f ∞
+  G-propertyₙ n = G-property₂ (ι n) h
+   where
+    h : ¬ ((v : ℕ∞) → f (max (ι n) v) ＝ f ∞)
+    h a = f-non-cts (n , a ∘ ι)
+
+  G-property∞ : G ∞ ＝ ∞
+  G-property∞ = max∞-property (pr₁ (g ∞))
+
+  IV : (u : ℕ∞) → u ＝ ∞ → f (G u) ＝ f ∞
+  IV u refl = ap f G-property∞
+
+  V : (u : ℕ∞) → f (G u) ＝ f ∞ → u ＝ ∞
+  V u a = not-finite-is-∞ fe h
+   where
+    h : (n : ℕ) → u ≠ ι n
+    h n refl = G-propertyₙ n a
+
+  VI : WLPO
+  VI u = map-decidable (V u) (IV u) (ℕ-is-discrete (f (G u)) (f ∞))
 
 \end{code}
+
+Added 7th September 2024. We now prove (3)(→).
+
+\begin{code}
+
+¬WLPO-gives-all-functions-are-not-not-continuous
+ : ¬ WLPO
+ → (f : ℕ∞ → ℕ)
+ → ¬¬ continuous f
+¬WLPO-gives-all-functions-are-not-not-continuous nwlpo f
+ = contrapositive
+    (λ (ν : ¬ continuous f) → noncontinuous-map-gives-WLPO (f , ν))
+    nwlpo
+
+\end{code}
+
+And now we prove (1).
+
+\begin{code}
+
+MP-gives-that-not-not-continuous-functions-are-continuous
+ : MP 𝓤₀
+ → (f : ℕ∞ → ℕ)
+ → ¬¬ continuous f
+ → continuous f
+MP-gives-that-not-not-continuous-functions-are-continuous mp f
+ = mp (λ m → (n : ℕ) → f (max (ι m) (ι n)) ＝ f ∞)
+      (λ m → Theorem-8·2'
+              (λ x → f (max (ι m) x) ＝ f ∞)
+              (λ x → ℕ-is-discrete (f (max (ι m) x)) (f ∞)))
+
+\end{code}
+
+The converse of the above is trivial (double negation introduction)
+and so we will not add it in code, even if it turns out to be needed
+in future additions. The following also is an immediate consequence of
+the above, but we choose to record it explicitly.
+
+And now we prove (4).
+
+\begin{code}
+
+MP-and-¬WLPO-give-that-all-functions-are-continuous
+ : MP 𝓤₀
+ → ¬ WLPO
+ → (f : ℕ∞ → ℕ)
+ → continuous f
+MP-and-¬WLPO-give-that-all-functions-are-continuous mp nwlpo f
+ = MP-gives-that-not-not-continuous-functions-are-continuous
+    mp
+    f
+    (¬WLPO-gives-all-functions-are-not-not-continuous nwlpo f)
+
+\end{code}
+
+End of 7th September 2024 addition.
+
+In the following fact we can replace Σ by ∃ because WLPO is a
+proposition. Hence WLPO is the propositional truncation of the type
+Σ f ꞉ (ℕ∞ → ℕ) , ¬ continuous f.
+
+TODO. Add code for this observation.
+
+The following is from [1] with the same proof.
+
+\begin{code}
+
+open import Taboos.BasicDiscontinuity fe
+open import Naturals.Properties
+
+WLPO-gives-noncontinous-map
+ : WLPO
+ → (Σ f ꞉ (ℕ∞ → ℕ) , ¬ continuous f)
+WLPO-gives-noncontinous-map wlpo
+ = f , f-non-cts
+ where
+  p : ℕ∞ → 𝟚
+  p = pr₁ (WLPO-is-discontinuous wlpo)
+
+  p-spec : ((n : ℕ) → p (ι n) ＝ ₀) × (p ∞ ＝ ₁)
+  p-spec = pr₂ (WLPO-is-discontinuous wlpo)
+
+  g : 𝟚 → ℕ
+  g ₀ = 0
+  g ₁ = 1
+
+  f : ℕ∞ → ℕ
+  f = g ∘ p
+
+  f₀ : (n : ℕ) → f (ι n) ＝ 0
+  f₀ n =  f (ι n) ＝⟨ ap g (pr₁ p-spec n) ⟩
+          g ₀     ＝⟨ refl ⟩
+          0       ∎
+
+  f∞ : (n : ℕ) → f (ι n) ≠ f ∞
+  f∞ n e = zero-not-positive 0
+            (0       ＝⟨ f₀ n ⁻¹ ⟩
+             f (ι n) ＝⟨ e ⟩
+             f ∞     ＝⟨ ap g (pr₂ p-spec) ⟩
+             1       ∎)
+
+  f-non-cts : ¬ continuous f
+  f-non-cts (m , a) = f∞ m
+                       (f (ι m)             ＝⟨ ap f ((max-idemp fe (ι m))⁻¹) ⟩
+                        f (max (ι m) (ι m)) ＝⟨ a m ⟩
+                        f ∞                 ∎)
+
+\end{code}
+
+And a corollary is that the negation of WLPO amount to a weak continuity
+principle that says that all functions are not-not continuous.
+
+\begin{code}
+
+¬WLPO-iff-all-maps-are-¬¬-continuous
+ : ¬ WLPO ↔ ((f : ℕ∞ → ℕ) → ¬¬ continuous f)
+¬WLPO-iff-all-maps-are-¬¬-continuous
+ = (λ nwlpo → curry (contrapositive noncontinuous-map-gives-WLPO nwlpo)) ,
+   (λ (a : (f : ℕ∞ → ℕ) → ¬¬ continuous f)
+     → contrapositive
+        WLPO-gives-noncontinous-map
+        (uncurry a))
+
+\end{code}
+
+It is shown in [2] that negative consistent axioms can be postulated
+in MLTT without loss of canonicity, and Andreas Abel filled important
+gaps and formalized this in Agda [3] using a logical-relations
+technique. Hence we can, if we wish, postulate ¬ WLPO without loss of
+canonicity, and get a weak continuity axiom for free. But notice that
+we can also postulate ¬¬ WLPO without loss of continuity, to get a
+weak classical axiom for free. Of course, we can't postulate both at
+the same time while retaining canonicity (and consistency!).
+
+[2] T. Coquand, N.A. Danielsson, M.H. Escardo, U. Norell and Chuangjie Xu.
+Negative consistent axioms can be postulated without loss of canonicity.
+https://www.cs.bham.ac.uk/~mhe/papers/negative-axioms.pdf
+
+[3] Andreas Abel. Negative Axioms.
+    https://github.com/andreasabel/logrel-mltt/tree/master/Application/NegativeAxioms
+
+Added 16 August 2024. This is not in [1].
+
+The above definition of continuity is "continuity at the point ∞", and
+also it is not a proposition.
+
+Next we show that this is equivalent to usual continuity, as in the
+module Cantor, using the fact that ℕ∞ is a subspace of the Cantor type
+ℕ → 𝟚.
+
+Moreover, in the particular case of the subspace ℕ∞ of the Cantor
+space, continuity of functions ℕ∞ → ℕ is equivalent to uniform
+continuity, constructively, without the need of Brouwerian axioms.
+
+So what we will do next is to show that all imaginable notions of
+(uniform) continuity for functions ℕ∞ → ℕ are equivalent,
+constructively.
+
+Moreover, the truncated and untruncated notions are also equivalent.
+
+Added 20th August. Continuity as property gives continuity data.
+
+\begin{code}
+
+open import Naturals.RootsTruncation
+open import UF.PropTrunc
+open import UF.Subsingletons
+open import UF.Subsingletons-FunExt
+
+module continuity-criteria (pt : propositional-truncations-exist) where
+
+ open PropositionalTruncation pt
+ open exit-truncations pt
+
+ is-continuous : (ℕ∞ → ℕ) → 𝓤₀ ̇
+ is-continuous f = ∃ m ꞉ ℕ , ((n : ℕ) → f (max (ι m) (ι n)) ＝ f ∞)
+
+ module _ (f : ℕ∞ → ℕ) where
+
+  continuity-data-gives-continuity-property
+   : continuity-data f → is-continuous f
+  continuity-data-gives-continuity-property
+   = ∣_∣
+
+  continuity-property-gives-continuity-data
+   : is-continuous f
+   → continuity-data f
+  continuity-property-gives-continuity-data
+   = exit-truncation (A ∘ ι) (A-is-decidable ∘ ι)
+   where
+    A : ℕ∞ → 𝓤₀ ̇
+    A x = (n : ℕ) → f (max x (ι n)) ＝ f ∞
+
+    A-is-decidable : (x : ℕ∞) → is-decidable (A x)
+    A-is-decidable x = Theorem-8·2'
+                        (λ y → f (max x y) ＝ f ∞)
+                        (λ y → ℕ-is-discrete (f (max x y)) (f ∞))
+\end{code}
+
+Next, we show that continuity is equivalent to a more familiar notion
+of continuity and also equivalent to the uniform version of the of the
+more familiar version. We first work with the untruncated versions.
+
+Notice that ι denotes the inclusion ℕ → ℕ∞ and also the inclusion
+ℕ∞ → (ℕ → 𝟚), where the context has to be used to disambiguate.
+
+We first define when two extended natural numbers x and y agree up to
+precision k, written x ＝⟪ k ⟫ y.
+
+\begin{code}
+
+open import TypeTopology.Cantor hiding (continuous ; continuity-data)
+
+_＝⟪_⟫_ : ℕ∞ → ℕ → ℕ∞ → 𝓤₀ ̇
+x ＝⟪ k ⟫ y = ι x ＝⟦ k ⟧ ι y
+
+traditional-continuity-data
+ : (ℕ∞ → ℕ) → 𝓤₀ ̇
+traditional-continuity-data f
+ = (x : ℕ∞) → Σ m ꞉ ℕ , ((y : ℕ∞) → x ＝⟪ m ⟫ y → f x ＝ f y)
+
+traditional-uniform-continuity-data
+ : (ℕ∞ → ℕ) → 𝓤₀ ̇
+traditional-uniform-continuity-data f
+ = Σ m ꞉ ℕ , ((x y : ℕ∞) → x ＝⟪ m ⟫ y → f x ＝ f y)
+
+\end{code}
+
+We now need a lemma about the relation x ＝⟪ k ⟫ y.
+
+\begin{code}
+
+lemma₀
+ : (k : ℕ)
+   (n : ℕ)
+ → ∞ ＝⟪ k ⟫ (max (ι k) (ι n))
+lemma₀ 0        n        = ⋆
+lemma₀ (succ k) 0        = refl , lemma₀ k 0
+lemma₀ (succ k) (succ n) = refl , lemma₀ k n
+
+module _ (f : ℕ∞ → ℕ) where
+
+ traditional-uniform-continuity-data-gives-traditional-continuity-data
+  : traditional-uniform-continuity-data f
+  → traditional-continuity-data f
+ traditional-uniform-continuity-data-gives-traditional-continuity-data
+  (m , m-is-modulus) x = m , m-is-modulus x
+
+ traditional-continuity-data-gives-continuity-data
+  : traditional-continuity-data f
+  → continuity-data f
+ traditional-continuity-data-gives-continuity-data f-cts-traditional
+  = II
+  where
+   m : ℕ
+   m = pr₁ (f-cts-traditional ∞)
+
+   m-is-modulus : (y : ℕ∞) → ∞ ＝⟪ m ⟫ y → f ∞ ＝ f y
+   m-is-modulus = pr₂ (f-cts-traditional ∞)
+
+   I : (n : ℕ) → f (max (ι m) (ι n)) ＝ f ∞
+   I n = (m-is-modulus (max (ι m) (ι n)) (lemma₀ m n))⁻¹
+
+   II : continuous f
+   II = m , I
+
+\end{code}
+
+We now need more lemmas about the relation x ＝⟪ k ⟫ y.
+
+\begin{code}
+
+ lemma₁
+  : (k : ℕ)
+    (y : ℕ∞)
+  → ∞ ＝⟪ k ⟫ y
+  → max (ι k) y ＝ y
+ lemma₁ 0        y ⋆       = refl
+ lemma₁ (succ k) y (h , t) = γ
+  where
+   have-h : ₁ ＝ ι y 0
+   have-h = h
+
+   have-t : ∞ ＝⟪ k ⟫ (Pred y)
+   have-t = t
+
+   IH : max (ι k) (Pred y) ＝ Pred y
+   IH = lemma₁ k (Pred y) t
+
+   δ : ι (max (Succ (ι k)) y) ∼ ι y
+   δ 0        = h
+   δ (succ i) = ap (λ - → ι - i) IH
+
+   γ : max (Succ (ι k)) y ＝ y
+   γ = ℕ∞-to-ℕ→𝟚-lc fe (dfunext fe δ)
+
+ lemma₂
+  : (x y : ℕ∞)
+    (k : ℕ)
+  → x ＝⟪ k ⟫ y
+  → (x ＝ y) + (∞ ＝⟪ k ⟫ x)
+ lemma₂ x y 0        ⋆       = inr ⋆
+ lemma₂ x y (succ k) (h , t) = γ
+  where
+   IH : (Pred x ＝ Pred y) + (∞ ＝⟪ k ⟫ (Pred x))
+   IH = lemma₂ (Pred x) (Pred y) k t
+
+   γl∼ : Pred x ＝ Pred y → ι x ∼ ι y
+   γl∼ p 0        = h
+   γl∼ p (succ i) = ap (λ - → ι - i) p
+
+   γl : Pred x ＝ Pred y → x ＝ y
+   γl p = ℕ∞-to-ℕ→𝟚-lc fe (dfunext fe (γl∼ p))
+
+   γr : ∞ ＝⟪ k ⟫ (Pred x) → (x ＝ y) + (∞ ＝⟪ succ k ⟫ x)
+   γr q = 𝟚-equality-cases
+           (λ (p : ι x 0 ＝ ₀)
+                 → inl (x    ＝⟨ is-Zero-equal-Zero fe p ⟩
+                        Zero ＝⟨ (is-Zero-equal-Zero fe (h ⁻¹ ∙ p))⁻¹ ⟩
+                        y    ∎))
+           (λ (p : ι x 0 ＝ ₁)
+                 → inr ((p ⁻¹) , q))
+
+   γ : (x ＝ y) + (∞ ＝⟪ succ k ⟫ x)
+   γ = Cases IH (inl ∘ γl) γr
+
+ lemma₃
+  : (x y : ℕ∞)
+    (k : ℕ)
+  → x ＝⟪ k ⟫ y
+  → (x ＝ y) + (max (ι k) x ＝ x) × (max (ι k) y ＝ y)
+ lemma₃ x y k e
+  = III
+  where
+   I : ∞ ＝⟪ k ⟫ x → ∞ ＝⟪ k ⟫ y
+   I q = ＝⟦⟧-trans (ι ∞) (ι x) (ι y) k q e
+
+   II : (x ＝ y) + (∞ ＝⟪ k ⟫ x)
+      → (x ＝ y) + (max (ι k) x ＝ x) × (max (ι k) y ＝ y)
+   II (inl p) = inl p
+   II (inr q) = inr (lemma₁ k x q , lemma₁ k y (I q))
+
+   III : (x ＝ y) + (max (ι k) x ＝ x) × (max (ι k) y ＝ y)
+   III = II (lemma₂ x y k e)
+
+ continuity-data-gives-traditional-uniform-continuity-data
+  : continuity-data f
+  → traditional-uniform-continuity-data f
+ continuity-data-gives-traditional-uniform-continuity-data
+  (m , m-is-modulus) = m , m-is-modulus'
+  where
+   qₙ : (n : ℕ) → f (max (ι m) (ι n)) ＝ f ∞
+   qₙ = m-is-modulus
+
+   I : (z : ℕ∞) → max (ι m) z ＝ z → f z ＝ f ∞
+   I z p = γ
+    where
+     q∞ : f (max (ι m) ∞) ＝ f ∞
+     q∞ = ap f (max∞-property' fe (ι m))
+
+     q : (u : ℕ∞) → f (max (ι m) u) ＝ f ∞
+     q = ℕ∞-density fe ℕ-is-¬¬-separated qₙ q∞
+
+     γ = f z             ＝⟨ ap f (p ⁻¹) ⟩
+         f (max (ι m) z) ＝⟨ q z ⟩
+         f ∞             ∎
+
+   m-is-modulus' : (x y : ℕ∞) → x ＝⟪ m ⟫ y → f x ＝ f y
+   m-is-modulus' x y e =
+    Cases (lemma₃ x y m e)
+     (λ (p : x ＝ y) → ap f p)
+     (λ (q , r) → f x ＝⟨ I x q ⟩
+                  f ∞ ＝⟨ I y r ⁻¹ ⟩
+                  f y ∎)
+
+\end{code}
+
+This closes a circle, so that that all notions of continuity data are
+logically equivalent.
+
+TODO. They should also be equivalent as types, but this is not
+important for our purposes, because we are interested in continuity as
+property. But maybe it would be interesting to code this anyway.
+
+Added 21 August 2023. We now establish the logical equivalence with
+the remaining propositional versions of continuity.
+
+So far we know that, for f : ℕ∞ → ℕ,
+
+    continuity-data f                    ↔ is-continuous f
+        ↕
+    traditional-continuity-data
+        ↕
+    traditional-uniform-continuity-data
+
+
+We now complete this to the logical equivalences
+
+    continuity-data f                   ↔ is-continuous f
+        ↕
+    traditional-continuity-data         ↔ is-traditionally-continuous
+        ↕
+    traditional-uniform-continuity-data ↔ is-traditionally-uniformly-continuous
+
+so that all six (truncated and untruncated) notions of (uniform)
+continuity for functions ℕ∞ → ℕ are logically equivalent.
+
+\begin{code}
+
+module more-continuity-criteria (pt : propositional-truncations-exist) where
+
+ open PropositionalTruncation pt
+ open exit-truncations pt
+
+ is-traditionally-continuous
+  : (ℕ∞ → ℕ) → 𝓤₀ ̇
+ is-traditionally-continuous f
+  = (x : ℕ∞) → ∃ m ꞉ ℕ , ((y : ℕ∞) → x ＝⟪ m ⟫ y → f x ＝ f y)
+
+ is-traditionally-uniformly-continuous
+  : (ℕ∞ → ℕ) → 𝓤₀ ̇
+ is-traditionally-uniformly-continuous f
+  = ∃ m ꞉ ℕ , ((x y : ℕ∞) → x ＝⟪ m ⟫ y → f x ＝ f y)
+
+ module _ (f : ℕ∞ → ℕ) where
+
+  traditional-continuity-data-gives-traditional-continuity
+   : traditional-continuity-data f
+   → is-traditionally-continuous f
+  traditional-continuity-data-gives-traditional-continuity d x
+   = ∣ d x ∣
+
+  traditional-continuity-gives-traditional-continuity-data
+   : is-traditionally-continuous f
+   → traditional-continuity-data f
+  traditional-continuity-gives-traditional-continuity-data f-cts x
+   = exit-truncation (C x) (C-is-decidable x) (f-cts x)
+   where
+    C : ℕ∞ → ℕ → 𝓤₀ ̇
+    C x m = (y : ℕ∞) → x ＝⟪ m ⟫ y → f x ＝ f y
+
+    C-is-decidable : (x : ℕ∞) (m : ℕ) → is-decidable (C x m)
+    C-is-decidable x m =
+     ℕ∞-Π-Compact
+      (λ y → x ＝⟪ m ⟫ y → f x ＝ f y)
+      (λ y → →-preserves-decidability
+              (＝⟦⟧-is-decidable (ι x) (ι y) m)
+              (ℕ-is-discrete (f x) (f y)))
+
+  traditional-uniform-continuity-data-gives-traditional-uniform-continuity
+   : traditional-uniform-continuity-data f
+   → is-traditionally-uniformly-continuous f
+  traditional-uniform-continuity-data-gives-traditional-uniform-continuity
+   = ∣_∣
+
+  traditional-uniform-continuity-gives-traditional-uniform-continuity-data
+   : is-traditionally-uniformly-continuous f
+   → traditional-uniform-continuity-data f
+  traditional-uniform-continuity-gives-traditional-uniform-continuity-data f-uc
+   = exit-truncation U U-is-decidable f-uc
+   where
+    U : ℕ → 𝓤₀ ̇
+    U m = (x y : ℕ∞) → x ＝⟪ m ⟫ y → f x ＝ f y
+
+    U-is-decidable : (m : ℕ) → is-decidable (U m)
+    U-is-decidable m =
+     ℕ∞-Π-Compact
+      (λ x → (y : ℕ∞) → x ＝⟪ m ⟫ y → f x ＝ f y)
+      (λ x → ℕ∞-Π-Compact
+              (λ y → x ＝⟪ m ⟫ y → f x ＝ f y)
+              (λ y → →-preserves-decidability
+                      (＝⟦⟧-is-decidable (ι x) (ι y) m)
+                      (ℕ-is-discrete (f x) (f y))))
+\end{code}
+
+Added 2nd September 2024. This is also not in [1].
+
+The type `ℕ∞-extension g` is that of all extensions of g : ℕ → ℕ to
+functions ℕ∞ → ℕ.
+
+Our first question is when this type is a proposition (so that it
+could be called `is-ℕ∞-extendable g`).
+
+Notice that LPO is stronger than WLPO, and hence, by taking the
+contrapositive, ¬ WLPO is stronger than ¬ LPO:
+
+     LPO →  WLPO
+  ¬ WLPO → ¬ LPO
+
+\begin{code}
+
+restriction : (ℕ∞ → ℕ) → (ℕ → ℕ)
+restriction f = f ∘ ι
+
+_extends_ : (ℕ∞ → ℕ) → (ℕ → ℕ) → 𝓤₀ ̇
+f extends g = restriction f ∼ g
+
+ℕ∞-extension : (ℕ → ℕ) → 𝓤₀ ̇
+ℕ∞-extension g = Σ f ꞉ (ℕ∞ → ℕ) , f extends g
+
+\end{code}
+
+The following says that if all functions ℕ∞ → ℕ are continuous, or,
+more generally, if just ¬ WLPO holds, then the type of ℕ∞-extensions
+of g has at most one element.
+
+(In my view, this is a situation where it would be more sensible to
+use the terminology `is-subsingleton` rather than `is-prop`. In fact,
+I generally prefer the former terminology over the latter, but here we
+try to be consistent with the terminology of the HoTT/UF community.)
+
+\begin{code}
+
+¬WLPO-gives-ℕ∞-extension-is-prop
+ : funext 𝓤₀ 𝓤₀
+ → (g : ℕ → ℕ)
+ → ¬ WLPO
+ → is-prop (ℕ∞-extension g)
+¬WLPO-gives-ℕ∞-extension-is-prop fe g nwlpo (f , e) (f' , e')
+ = IV
+ where
+  I : (n : ℕ) → f (ι n) ＝ f' (ι n)
+  I n = f (ι n)  ＝⟨ e n ⟩
+        g n      ＝⟨ (e' n)⁻¹ ⟩
+        f' (ι n) ∎
+
+  II : f ∞ ＝ f' ∞
+  II = agreement-cotaboo' ℕ-is-discrete nwlpo f f' I
+
+  III : f ∼ f'
+  III = ℕ∞-density fe ℕ-is-¬¬-separated I II
+
+  IV : (f , e) ＝ (f' , e')
+  IV = to-subtype-＝ (λ - → Π-is-prop fe (λ n → ℕ-is-set)) (dfunext fe III)
+
+\end{code}
+
+Therefore the non-propositionality of the type `ℕ∞-extension g` gives
+the classical principle ¬¬ WLPO.
+
+\begin{code}
+
+ℕ∞-extension-is-not-prop-gives-¬¬WLPO
+ : funext 𝓤₀ 𝓤₀
+ → (g : ℕ → ℕ)
+ → ¬ is-prop (ℕ∞-extension g)
+ → ¬¬ WLPO
+ℕ∞-extension-is-not-prop-gives-¬¬WLPO fe g
+ = contrapositive (¬WLPO-gives-ℕ∞-extension-is-prop fe g)
+
+\end{code}
+
+We are unable, at the time of writing (4th September 2024) to
+establish the converse.  However, if we strengthen the classical
+principle ¬¬ WLPO to LPO, we can. We begin with a classical extension
+lemma, which is then applied to prove this claim.
+
+\begin{code}
+
+LPO-gives-ℕ∞-extension
+ : LPO
+ → (g : ℕ → ℕ)
+   (y : ℕ)
+ → Σ (f , _) ꞉ ℕ∞-extension g , (f ∞ ＝ y)
+LPO-gives-ℕ∞-extension lpo g y
+ = (f , e) , p
+ where
+  F : (x : ℕ∞) → is-decidable (Σ n ꞉ ℕ , x ＝ ι n) → ℕ
+  F x (inl (n , p)) = g n
+  F x (inr ν)       = y
+
+  f : ℕ∞ → ℕ
+  f x = F x (lpo x)
+
+  E : (k : ℕ) (d : is-decidable (Σ n ꞉ ℕ , ι k ＝ ι n)) → F (ι k) d ＝ g k
+  E k (inl (n , p)) = ap g (ℕ-to-ℕ∞-lc (p ⁻¹))
+  E k (inr ν)       = 𝟘-elim (ν (k , refl))
+
+  e : restriction f ∼ g
+  e k = E k (lpo (ι k))
+
+  P : (d : is-decidable (Σ n ꞉ ℕ , ∞ ＝ ι n)) → F ∞ d ＝ y
+  P (inl (n , p)) = 𝟘-elim (∞-is-not-finite n p)
+  P (inr _)       = refl
+
+  p : f ∞ ＝ y
+  p = P (lpo ∞)
+
+LPO-gives-ℕ∞-extension-is-not-prop
+ : (g : ℕ → ℕ)
+ → LPO
+ → ¬ is-prop (ℕ∞-extension g)
+LPO-gives-ℕ∞-extension-is-not-prop g lpo ext-is-prop
+  = I (LPO-gives-ℕ∞-extension lpo g 0) (LPO-gives-ℕ∞-extension lpo g 1)
+ where
+  I : (Σ (f , _) ꞉ ℕ∞-extension g , (f ∞ ＝ 0))
+    → (Σ (f , _) ꞉ ℕ∞-extension g , (f ∞ ＝ 1))
+    → 𝟘
+  I ((f , e) , p) ((f' , e') , p') =
+   zero-not-positive 0
+    (0    ＝⟨ p ⁻¹ ⟩
+     f  ∞ ＝⟨ ap ((λ (- , _) → - ∞)) (ext-is-prop (f , e) (f' , e')) ⟩
+     f' ∞ ＝⟨ p' ⟩
+     1    ∎)
+
+\end{code}
+
+It is direct that if there is at most one extension, then LPO can't
+hold.
+
+\begin{code}
+
+ℕ∞-extension-is-prop-gives-¬LPO
+ : (g : ℕ → ℕ)
+ → is-prop (ℕ∞-extension g)
+ → ¬ LPO
+ℕ∞-extension-is-prop-gives-¬LPO g i lpo
+ = LPO-gives-ℕ∞-extension-is-not-prop g lpo i
+
+\end{code}
+
+So we have the chain of implications
+
+    ¬ WLPO → is-prop (ℕ∞-extension g) → ¬ LPO.
+
+Recall that LPO → WLPO, and so ¬ WLPO → ¬ LPO in any case. We don't
+know whether the implication ¬ WLPO → ¬ LPO can be reversed in general
+(we would guess not).
+
+We also have the chain of implications
+
+    LPO → ¬ is-prop (ℕ∞-extension g) → ¬¬ WLPO.
+
+So the type ¬ is-prop (ℕ∞-extension g) sits between two constructive
+taboos and so is an inherently classical statement.
+
+Added 4th September 2024.
+
+Our next question is when the type `ℕ∞-extension g` is pointed.
+
+\begin{code}
+
+open import Naturals.Order renaming
+                            (max to maxℕ ;
+                             max-idemp to maxℕ-idemp ;
+                             max-comm to maxℕ-comm)
+
+is-modulus-of-eventual-constancy : (ℕ → ℕ) → ℕ → 𝓤₀ ̇
+is-modulus-of-eventual-constancy g m = ((n : ℕ) → g (maxℕ m n) ＝ g m)
+
+being-modulus-of-eventual-constancy-is-prop
+ : (g : ℕ → ℕ)
+   (m : ℕ)
+ → is-prop (is-modulus-of-eventual-constancy g m)
+being-modulus-of-eventual-constancy-is-prop g m
+ = Π-is-prop fe (λ n → ℕ-is-set)
+
+eventually-constant : (ℕ → ℕ) → 𝓤₀ ̇
+eventually-constant g = Σ m ꞉ ℕ , is-modulus-of-eventual-constancy g m
+
+eventual-constancy-data = eventually-constant
+
+eventual-constancy-gives-continuous-extension
+ : (g : ℕ → ℕ)
+   ((m , _) : eventually-constant g)
+ → Σ (f , _) ꞉ ℕ∞-extension g , is-modulus-of-continuity f m
+eventual-constancy-gives-continuous-extension g (m , a)
+ = h g m a
+ where
+  h : (g : ℕ → ℕ)
+      (m : ℕ)
+    → is-modulus-of-eventual-constancy g m
+    → Σ (f , _) ꞉ ℕ∞-extension g , is-modulus-of-continuity f m
+  h g 0        a = ((λ _ → g 0) ,
+                    (λ n →  g 0          ＝⟨ (a n)⁻¹ ⟩
+                            g (maxℕ 0 n) ＝⟨ refl ⟩
+                            g n          ∎)) ,
+                   (λ n → refl)
+  h g (succ m) a = I IH
+   where
+    IH : Σ (f , _) ꞉ ℕ∞-extension (g ∘ succ) , is-modulus-of-continuity f m
+    IH = h (g ∘ succ) m (a ∘ succ)
+
+    I : type-of IH
+      → Σ (f' , _) ꞉ ℕ∞-extension g , is-modulus-of-continuity f' (succ m)
+    I ((f , e) , m-is-modulus)
+     = (f' , e') , succ-m-is-modulus
+     where
+      f' : ℕ∞ → ℕ
+      f' = ℕ∞-cases fe (g 0) f
+
+      e' : (n : ℕ) → f' (ι n) ＝ g n
+      e' 0 = f' (ι 0) ＝⟨ refl ⟩
+             f' Zero  ＝⟨ ℕ∞-cases-Zero fe (g 0) f ⟩
+             g 0      ∎
+      e' (succ n) = f' (ι (succ n)) ＝⟨ refl ⟩
+                    f' (Succ (ι n)) ＝⟨ ℕ∞-cases-Succ fe (g 0) f (ι n) ⟩
+                    f (ι n)         ＝⟨ e n ⟩
+                    g (succ n)      ∎
+
+      succ-m-is-modulus : (n : ℕ) → f' (max (ι (succ m)) (ι n)) ＝ f' ∞
+      succ-m-is-modulus 0        = m-is-modulus 0
+      succ-m-is-modulus (succ n) =
+       f' (max (ι (succ m)) (ι (succ n))) ＝⟨ II ⟩
+       f' (Succ (max (ι m) (ι n)))        ＝⟨ III ⟩
+       f (max (ι m) (ι n))                ＝⟨ IV ⟩
+       f ∞                                ＝⟨ V ⟩
+       f' (Succ ∞)                        ＝⟨ VI ⟩
+       f' ∞                               ∎
+        where
+         II  = ap f' ((max-Succ fe (ι m) (ι n))⁻¹)
+         III = ℕ∞-cases-Succ fe (g 0) f (max (ι m) (ι n))
+         IV  = m-is-modulus n
+         V   = (ℕ∞-cases-Succ fe (g 0) f ∞)⁻¹
+         VI  = ap f' (Succ-∞-is-∞ fe)
+
+\end{code}
+
+It will be convenient name various projections of the construction above.
+
+\begin{code}
+
+evc-extension
+ : (g : ℕ → ℕ)
+ → eventually-constant g
+ → ℕ∞ → ℕ
+evc-extension g c
+ = pr₁ (pr₁ (eventual-constancy-gives-continuous-extension g c))
+
+evc-extension-property
+ : (g : ℕ → ℕ)
+   (c : eventually-constant g)
+ → (evc-extension g c) extends g
+evc-extension-property g c
+ = pr₂ (pr₁ (eventual-constancy-gives-continuous-extension g c))
+
+evc-extension-modulus-of-continuity
+ : (g : ℕ → ℕ)
+   (c@(m , _) : eventually-constant g)
+ → is-modulus-of-continuity (evc-extension g c) m
+evc-extension-modulus-of-continuity g c@(m , _)
+ = pr₂ (eventual-constancy-gives-continuous-extension g c)
+
+evc-extension-continuity
+ : (g : ℕ → ℕ)
+   (c : eventually-constant g)
+ → continuous (evc-extension g c)
+evc-extension-continuity g c@(m , _)
+ = m , evc-extension-modulus-of-continuity g c
+
+evc-extension-∞
+ : (g : ℕ → ℕ)
+   (c@(m , _) : eventually-constant g)
+ → evc-extension g c ∞ ＝ g m
+evc-extension-∞ g c@(m , a)
+ = f ∞                 ＝⟨ (evc-extension-modulus-of-continuity g c m)⁻¹ ⟩
+   f (max (ι m) (ι m)) ＝⟨ ap f (max-idemp fe (ι m)) ⟩
+   f (ι m)             ＝⟨ evc-extension-property g c m ⟩
+   g m                 ∎
+ where
+  f : ℕ∞ → ℕ
+  f = evc-extension g c
+
+\end{code}
+
+The converse of the above.
+
+\begin{code}
+
+continuous-extension-gives-eventual-constancy'
+ : (g : ℕ → ℕ)
+   ((f , _) : ℕ∞-extension g)
+   (m : ℕ)
+ → is-modulus-of-continuity f m
+ → is-modulus-of-eventual-constancy g m
+continuous-extension-gives-eventual-constancy' g (f , e) m  m-is-modulus
+ = (λ n → g (maxℕ m n)        ＝⟨ (e (maxℕ m n))⁻¹ ⟩
+              f (ι (maxℕ m n))    ＝⟨ ap f (max-fin fe m n) ⟩
+              f (max (ι m) (ι n)) ＝⟨ m-is-modulus n ⟩
+              f ∞                 ＝⟨ (m-is-modulus m)⁻¹ ⟩
+              f (max (ι m) (ι m)) ＝⟨ ap f (max-idemp fe (ι m)) ⟩
+              f (ι m)             ＝⟨ e m ⟩
+              g m                 ∎)
+
+continuous-extension-gives-eventual-constancy
+ : (g : ℕ → ℕ)
+   ((f , _) : ℕ∞-extension g)
+ → continuous f
+ → eventually-constant g
+continuous-extension-gives-eventual-constancy g ext (m , m-is-modulus)
+ = m , continuous-extension-gives-eventual-constancy' g ext m m-is-modulus
+
+\end{code}
+
+Is there a nice necessary and sufficient condition for the
+extendability of any such given g?
+
+A sufficient condition is that LPO holds or g is eventually constant.
+
+\begin{code}
+
+ℕ∞-extension-explicit-existence-sufficient-condition
+ : (g : ℕ → ℕ)
+ → LPO + eventually-constant g
+ → ℕ∞-extension g
+ℕ∞-extension-explicit-existence-sufficient-condition g (inl lpo)
+ = pr₁ (LPO-gives-ℕ∞-extension lpo g 0)
+ℕ∞-extension-explicit-existence-sufficient-condition g (inr ec)
+ = pr₁ (eventual-constancy-gives-continuous-extension g ec)
+
+\end{code}
+
+Its contrapositive says that if g doesn't have an extension, then
+neither LPO holds nor g is eventually constant.
+
+\begin{code}
+
+ℕ∞-extension-nonexistence-gives-¬LPO-and-not-eventual-constancy
+ : (g : ℕ → ℕ)
+ → ¬ ℕ∞-extension g
+ → ¬ LPO × ¬ eventually-constant g
+ℕ∞-extension-nonexistence-gives-¬LPO-and-not-eventual-constancy g ν
+ = I ∘ inl , I ∘ inr
+ where
+  I : ¬ (LPO + eventually-constant g)
+  I = contrapositive (ℕ∞-extension-explicit-existence-sufficient-condition g) ν
+
+\end{code}
+
+A necessary condition is that WLPO holds or that g is not-not
+eventually constant.
+
+\begin{code}
+
+ℕ∞-extension-explicit-existence-first-necessary-condition
+ : (g : ℕ → ℕ)
+ → ℕ∞-extension g
+ → WLPO + ¬¬ eventually-constant g
+ℕ∞-extension-explicit-existence-first-necessary-condition
+ g (f , e) = III
+ where
+  II : is-decidable (¬ continuous f) → WLPO + ¬¬ eventually-constant g
+  II (inl l) = inl (noncontinuous-map-gives-WLPO (f , l))
+  II (inr r) = inr (¬¬-functor
+                     (continuous-extension-gives-eventual-constancy g (f , e)) r)
+
+  III : WLPO + ¬¬ eventually-constant g
+  III = II (the-negation-of-continuity-is-decidable f)
+
+\end{code}
+
+Its contrapositive says that if WLPO fails and g is not eventually
+constant, then there isn't any extension.
+
+\begin{code}
+
+¬WLPO-gives-that-non-eventually-constant-functions-have-no-extensions
+ : (g : ℕ → ℕ)
+ → ¬ WLPO
+ → ¬ eventually-constant g
+ → ¬ ℕ∞-extension g
+¬WLPO-gives-that-non-eventually-constant-functions-have-no-extensions g nwlpo nec
+ = contrapositive
+    (ℕ∞-extension-explicit-existence-first-necessary-condition g)
+    (cases nwlpo (¬¬-intro nec))
+
+\end{code}
+
+Because LPO implies WLPO and A implies ¬¬ A for any mathematical
+statement A, we have that
+
+  (LPO + eventually-constant g) implies (WLPO + ¬¬ eventually-constant g).
+
+TODO. Is there a nice necessary and sufficient condition for the
+      explicit existence of an extension, between the respectively
+      necessary and sufficient conditions
+
+        WLPO + ¬¬ eventually-constant g
+
+      and
+
+        LPO + eventually-constant g?
+
+      We leave this open. However, we show below that, under Markov's
+      Principle, the latter is a necessry and sufficient for g to have
+      an extension.
+
+\end{code}
+
+Added 9th September 2023. A second necessary condition for the
+explicit existence of an extension.
+
+Notice that, because the condition
+
+  (n : ℕ) → g (maxℕ m n) ＝ g m
+
+is not a priori decidable, as this implies WLPO if it holds for all m
+and g, the type of eventual constancy data doesn't in general have
+split support.
+
+However, if a particular g has an extension to ℕ∞, then this condition becomes
+decidable, and so in this case this type does have split support.
+
+Notice that this doesn't require the eventual constancy of g. It just
+requires that g has some (not necessarily continuous) extension.
+
+\begin{code}
+
+being-modulus-of-constancy-decidable-for-all-functions-gives-WLPO
+ : ((g : ℕ → ℕ) (m : ℕ)
+       → is-decidable (is-modulus-of-eventual-constancy g m))
+ → WLPO
+being-modulus-of-constancy-decidable-for-all-functions-gives-WLPO ϕ
+ = WLPO-traditional-gives-WLPO fe (WLPO-variation-gives-WLPO-traditional I)
+ where
+  I : WLPO-variation
+  I α = I₂
+   where
+    g : ℕ → ℕ
+    g = ι ∘ α
+
+    I₀ : ((n : ℕ) → ι (α (maxℕ 0 n)) ＝ ι (α 0))
+       → (n : ℕ) → α n ＝ α 0
+    I₀ a n = 𝟚-to-ℕ-is-lc (a n)
+
+    I₁ : ((n : ℕ) → α n ＝ α 0)
+       → (n : ℕ) → ι (α (maxℕ 0 n)) ＝ ι (α 0)
+    I₁ b n = ι (α (maxℕ 0 n)) ＝⟨ refl ⟩
+             ι (α n)          ＝⟨ ap ι (b n) ⟩
+             ι (α 0)          ∎
+
+    I₂ : is-decidable ((n : ℕ) → α n ＝ α 0)
+    I₂ = map-decidable I₀ I₁ (ϕ g 0)
+
+second-necessary-condition-for-the-explicit-existence-of-an-extension
+ : (g : ℕ → ℕ)
+ → ℕ∞-extension g
+ → (m : ℕ) → is-decidable (is-modulus-of-eventual-constancy g m)
+second-necessary-condition-for-the-explicit-existence-of-an-extension g (f , e) m
+ = IV
+ where
+  I : is-decidable ((n : ℕ) → f (max (ι m) (ι n)) ＝ f (ι m))
+  I = Theorem-8·2'
+       (λ x → f (max (ι m) x) ＝ f (ι m))
+       (λ x → ℕ-is-discrete (f (max (ι m) x)) (f (ι m)))
+
+  II : ((n : ℕ) → f (max (ι m) (ι n)) ＝ f (ι m))
+     → is-modulus-of-eventual-constancy g m
+  II a n = g (maxℕ m n)        ＝⟨ e (maxℕ m n) ⁻¹ ⟩
+           f (ι (maxℕ m n))    ＝⟨ ap f (max-fin fe m n) ⟩
+           f (max (ι m) (ι n)) ＝⟨ a n ⟩
+           f (ι m)             ＝⟨ e m ⟩
+           g m                 ∎
+
+  III : is-modulus-of-eventual-constancy g m
+      → (n : ℕ) → f (max (ι m) (ι n)) ＝ f (ι m)
+  III b n = f (max (ι m) (ι n)) ＝⟨ ap f ((max-fin fe m n)⁻¹) ⟩
+            f (ι (maxℕ m n))    ＝⟨ e (maxℕ m n) ⟩
+            g (maxℕ m n)        ＝⟨ b n ⟩
+            g m                 ＝⟨ e m ⁻¹ ⟩
+            f (ι m)             ∎
+
+  IV : is-decidable (is-modulus-of-eventual-constancy g m)
+  IV = map-decidable II III I
+
+\end{code}
+
+So, although a function g that has an extension doesn't need to be
+eventually constant, because classical logic may (or may not) hold, it
+is decidable whether any given m is a modulus of eventual constancy of g
+if g has a given extension.
+
+\begin{code}
+
+module eventual-constancy-under-propositional-truncations
+        (pt : propositional-truncations-exist)
+       where
+
+ open PropositionalTruncation pt
+ open exit-truncations pt
+
+ is-extendable-to-ℕ∞
+  : (ℕ → ℕ) → 𝓤₀ ̇
+ is-extendable-to-ℕ∞ g
+  = ∃ f ꞉ (ℕ∞ → ℕ) , f extends g
+
+ is-eventually-constant
+  : (ℕ → ℕ) → 𝓤₀ ̇
+ is-eventually-constant g
+  = ∃ m ꞉ ℕ , is-modulus-of-eventual-constancy g m
+
+\end{code}
+
+As promised, any extension of g gives that the type of eventual
+constancy data has split support.
+
+\begin{code}
+
+ eventual-constancy-data-for-extendable-functions-has-split-support
+  : (g : ℕ → ℕ)
+  → ℕ∞-extension g
+  → is-eventually-constant g
+  → eventual-constancy-data g
+ eventual-constancy-data-for-extendable-functions-has-split-support g extension
+  = exit-truncation
+     (λ m → (n : ℕ) → g (maxℕ m n) ＝ g m)
+     (second-necessary-condition-for-the-explicit-existence-of-an-extension
+       g
+       extension)
+
+\end{code}
+
+A more general result is proved below, which doesn't assume that g has
+an extension.
+
+The second necessary condition for the explicit existence of an
+extension is also necessary for the anonymous existence.
+
+\begin{code}
+
+ necessary-condition-for-the-anonymous-existence-of-an-extension
+  : (g : ℕ → ℕ)
+  → is-extendable-to-ℕ∞ g
+  → (m : ℕ) → is-decidable (is-modulus-of-eventual-constancy g m)
+ necessary-condition-for-the-anonymous-existence-of-an-extension g
+  = ∥∥-rec
+     (Π-is-prop fe
+       (λ n → decidability-of-prop-is-prop fe
+               (being-modulus-of-eventual-constancy-is-prop g n)))
+     (second-necessary-condition-for-the-explicit-existence-of-an-extension g)
+
+\end{code}
+
+The following is immediate, and we need its reformulation given after
+it.
+
+\begin{code}
+
+ open continuity-criteria pt
+
+ is-continuous-extension-gives-is-eventually-constant
+  : (g : ℕ → ℕ)
+    ((f , _) : ℕ∞-extension g)
+  → is-continuous f
+  → is-eventually-constant g
+ is-continuous-extension-gives-is-eventually-constant  g e
+  = ∥∥-functor (continuous-extension-gives-eventual-constancy g e)
+
+ restriction-of-continuous-function-is-eventually-constant
+  : (f : ℕ∞ → ℕ)
+  → is-continuous f
+  → is-eventually-constant (restriction f)
+ restriction-of-continuous-function-is-eventually-constant f
+  = is-continuous-extension-gives-is-eventually-constant
+     (restriction f)
+     (f , (λ x → refl))
+
+\end{code}
+
+Added 10th September 2024. We should have added this immediate
+consequence earlier. If all maps ℕ → ℕ can be extended to ℕ∞, then
+WLPO holds. Just consider the identity function, which can't have any
+continuous extension, and so deduce WLPO.
+
+\begin{code}
+
+all-maps-have-extensions-gives-WLPO
+ : ((g : ℕ → ℕ) → ℕ∞-extension g)
+ → WLPO
+all-maps-have-extensions-gives-WLPO a
+ = I (a id)
+ where
+  I : ℕ∞-extension id → WLPO
+  I (f , e) = noncontinuous-map-gives-WLPO (f , ν)
+   where
+    ν : ¬ continuous f
+    ν (m , m-is-modulus) =
+     succ-no-fp m
+      (m                          ＝⟨ refl ⟩
+       id m                       ＝⟨ (e m)⁻¹ ⟩
+       f (ι m)                    ＝⟨ ap f ((max-idemp fe (ι m))⁻¹) ⟩
+       f (max (ι m) (ι m))        ＝⟨ m-is-modulus m ⟩
+       f ∞                        ＝⟨ (m-is-modulus (succ m))⁻¹ ⟩
+       f (max (ι m) (ι (succ m))) ＝⟨ ap f (max-succ fe m) ⟩
+       f (ι (succ m))             ＝⟨ e (succ m) ⟩
+       id (succ m)                ＝⟨ refl ⟩
+       succ m                     ∎)
+
+\end{code}
+
+Added 11th September 2024. Another immediate consequence of the above
+is that, under Markov's Principle, a map ℕ → ℕ has an extension ℕ∞ → ℕ
+if and only if LPO holds or g is eventually constant.
+
+\begin{code}
+
+decidability-of-modulus-of-constancy-gives-eventual-constancy-¬¬-stable
+ : MP 𝓤₀
+ → (g : ℕ → ℕ)
+ → ((m : ℕ) → is-decidable (is-modulus-of-eventual-constancy g m))
+ → ¬¬ eventually-constant g
+ → eventually-constant g
+decidability-of-modulus-of-constancy-gives-eventual-constancy-¬¬-stable mp g
+ =  mp (is-modulus-of-eventual-constancy g)
+
+sufficient-condition-is-necessary-under-MP
+ : MP 𝓤₀
+ → (g : ℕ → ℕ)
+ → ℕ∞-extension g
+ → LPO + eventually-constant g
+sufficient-condition-is-necessary-under-MP mp g ext
+ = II
+ where
+  I : WLPO + ¬¬ eventually-constant g → LPO + eventually-constant g
+  I = +functor
+       (MP-and-WLPO-give-LPO fe mp)
+       (decidability-of-modulus-of-constancy-gives-eventual-constancy-¬¬-stable
+         mp
+         g
+         (second-necessary-condition-for-the-explicit-existence-of-an-extension
+           g
+           ext))
+
+  II : LPO + eventually-constant g
+  II = I (ℕ∞-extension-explicit-existence-first-necessary-condition g ext)
+
+necessary-and-sufficient-condition-for-explicit-extension-under-MP
+ : MP 𝓤₀
+ → (g : ℕ → ℕ)
+ → ℕ∞-extension g ↔ LPO + eventually-constant g
+necessary-and-sufficient-condition-for-explicit-extension-under-MP mp g
+ = sufficient-condition-is-necessary-under-MP mp g ,
+   ℕ∞-extension-explicit-existence-sufficient-condition g
+
+\end{code}
+
+TODO. Find a necessary and sufficient condition without assuming
+Markov's Principle. We leave this as an open problem.
+
+Added 18th September 2024. There is another way of looking at the
+above development, which gives rise to a further question.
+
+We have the restriction map (ℕ∞ → ℕ) → (ℕ → ℕ) defined above
+as restriction f ＝ f ∘ ι.
+
+For any map f : X → Y we have that
+
+ X ≃ Σ y ꞉ Y , Σ x ꞉ X , f x ＝ y
+   ＝ Σ y ꞉ Y , fiber f y.
+
+With X = (ℕ∞ → ℕ) and Y = (ℕ → ℕ) and f = restriction, the definition
+of _extends_, together with the fact that _∼_ coincides with _＝_
+under function extensionality, the above specializes to
+
+ (ℕ∞ → ℕ) ≃ Σ g ꞉ (ℕ → ℕ) , Σ f ꞉ (ℕ∞ → ℕ) , f ∘ ι ＝ g
+          ≃ Σ g ꞉ (ℕ → ℕ) , Σ f ꞉ (ℕ∞ → ℕ) , restriction f ∼ g
+          ≃ Σ g ꞉ (ℕ → ℕ) , Σ f ꞉ (ℕ∞ → ℕ) , f extends g
+          ≃ Σ g ꞉ (ℕ → ℕ) , ℕ-extension g
+
+The above characterizes the type "ℕ-extension g" up to logical
+equivalence, under the assumption of Markov's Principle.
+
+TODO. Is there a nice characterization "Nice g" of the type
+"ℕ-extension g", preferably without assuming MP, up to type
+equivalence, rather than just logical equivalence, such that
+
+ (ℕ∞ → ℕ) ≃ Σ g ꞉ (ℕ → ℕ) , Nice g?
+
+The idea is that such a nice characterization should not mention ℕ∞,
+and in some sense should be an "intrinsic" property of / data for g.
+
+Added 19th September 2024. Before doing anything about the above
+remark and question, we improve part of the above development
+following a discussion and contributions at mathstodon by various
+people
+
+https://mathstodon.xyz/deck/@MartinEscardo/113024154634637479
+
+\begin{code}
+
+module eventual-constancy-under-propositional-truncations⁺
+        (pt : propositional-truncations-exist)
+       where
+
+ open eventual-constancy-under-propositional-truncations pt
+ open PropositionalTruncation pt
+ open exit-truncations pt
+
+\end{code}
+
+Notice that the proofs of modulus-down and modulus-up are not by
+induction.
+
+\begin{code}
+
+ modulus-down
+  : (g : ℕ → ℕ)
+    (n : ℕ)
+  → is-modulus-of-eventual-constancy g (succ n)
+  → is-decidable (is-modulus-of-eventual-constancy g n)
+ modulus-down g n μ = III
+  where
+   I : g (succ n) ＝ g n → is-modulus-of-eventual-constancy g n
+   I e m =
+    Cases (order-split n m)
+     (λ (l : n < m)
+     → g (maxℕ n m)        ＝⟨ ap g (max-ord→ n m (≤-trans _ _ _ (≤-succ n) l)) ⟩
+       g m                 ＝⟨ ap g ((max-ord→ (succ n) m l)⁻¹) ⟩
+       g (maxℕ (succ n) m) ＝⟨ μ m ⟩
+       g (succ n)          ＝⟨ e ⟩
+       g n                 ∎)
+     (λ (l : m ≤ n)
+     → g (maxℕ n m) ＝⟨ ap g (maxℕ-comm n m) ⟩
+       g (maxℕ m n) ＝⟨ ap g (max-ord→ m n l) ⟩
+       g n          ∎)
+
+   II : is-modulus-of-eventual-constancy g n → g (succ n) ＝ g n
+   II a = g (succ n)          ＝⟨ ap g ((max-ord→ n (succ n) (≤-succ n))⁻¹) ⟩
+          g (maxℕ n (succ n)) ＝⟨ a (succ n) ⟩
+          g n                 ∎
+
+   III : is-decidable (is-modulus-of-eventual-constancy g n)
+   III = map-decidable I II (ℕ-is-discrete (g (succ n)) (g n))
+
+ modulus-up
+   : (g : ℕ → ℕ)
+     (n : ℕ)
+   → is-modulus-of-eventual-constancy g n
+   → is-modulus-of-eventual-constancy g (succ n)
+ modulus-up g n μ m =
+  g (maxℕ (succ n) m)          ＝⟨ ap g I ⟩
+  g (maxℕ n (maxℕ (succ n) m)) ＝⟨ μ (maxℕ (succ n) m) ⟩
+  g n                          ＝⟨ (μ (succ n))⁻¹ ⟩
+  g (maxℕ n (succ n))          ＝⟨ ap g (max-ord→ n (succ n) (≤-succ n)) ⟩
+  g (succ n)                   ∎
+  where
+   I : maxℕ (succ n) m ＝ maxℕ n (maxℕ (succ n) m)
+   I = (max-ord→ n _
+         (≤-trans _ _ _
+           (≤-succ n)
+           (max-ord← _ _
+             (maxℕ (succ n) (maxℕ (succ n) m) ＝⟨ II ⟩
+              maxℕ (maxℕ (succ n) (succ n)) m ＝⟨ III ⟩
+              maxℕ (succ n) m                 ∎))))⁻¹
+               where
+                II  = (max-assoc (succ n) (succ n) m)⁻¹
+                III = ap (λ - → maxℕ - m) (maxℕ-idemp (succ n))
+
+ conditional-decidability-of-being-modulus-of-constancy
+  : (g : ℕ → ℕ)
+    (n : ℕ)
+  → is-modulus-of-eventual-constancy g n
+  → (k : ℕ)
+  → k < n
+  → is-decidable (is-modulus-of-eventual-constancy g k)
+ conditional-decidability-of-being-modulus-of-constancy g
+  = regression-lemma
+     (is-modulus-of-eventual-constancy g)
+     (modulus-down g)
+     (modulus-up g)
+
+ eventual-constancy-property-gives-eventual-constancy-data
+  : (g : ℕ → ℕ)
+  → is-eventually-constant g
+  → eventual-constancy-data g
+ eventual-constancy-property-gives-eventual-constancy-data g
+  = exit-truncation⁺
+    (is-modulus-of-eventual-constancy g)
+    (being-modulus-of-eventual-constancy-is-prop g)
+    (conditional-decidability-of-being-modulus-of-constancy g)
+
+ open import UF.Equiv
+ open continuity-criteria pt
+
+ private
+  ϕ : (Σ f ꞉ (ℕ∞ → ℕ) , is-continuous f)
+    → (Σ g ꞉ (ℕ → ℕ), is-eventually-constant g)
+  ϕ (f , f-cts) = restriction f ,
+                  restriction-of-continuous-function-is-eventually-constant f f-cts
+
+  γ : (Σ g ꞉ (ℕ → ℕ), is-eventually-constant g)
+    → (Σ f ꞉ (ℕ∞ → ℕ) , is-continuous f)
+  γ (g , g-evc) =
+   evc-extension g (eventual-constancy-property-gives-eventual-constancy-data g g-evc) ,
+   ∣ evc-extension-continuity g (eventual-constancy-property-gives-eventual-constancy-data g g-evc) ∣
+   where
+    c : eventual-constancy-data g
+    c = eventual-constancy-property-gives-eventual-constancy-data g g-evc
+
+{-
+  γϕ : γ ∘ ϕ ∼ id
+  γϕ (f , f-cts) = to-subtype-＝
+                    (λ _ → ∃-is-prop)
+                    (dfunext fe III)
+   where
+    c : eventual-constancy-data (restriction f)
+    c = eventual-constancy-property-gives-eventual-constancy-data
+         (restriction f)
+         (restriction-of-continuous-function-is-eventually-constant f f-cts)
+
+    I : (n : ℕ) → evc-extension (restriction f) c (ι n) ＝ f (ι n)
+    I = evc-extension-property (restriction f) c
+
+    m : ℕ
+    m = pr₁ c
+
+-- To fill the the remaining need to prove a couple of lemmas that are
+-- worth having anyway. Next time.
+
+    gap : is-modulus-of-continuity f m
+    gap = {!!}
+
+    II
+     = evc-extension (restriction f) c ∞ ＝⟨ evc-extension-∞ (restriction f) c ⟩
+       restriction f m                   ＝⟨ refl ⟩
+       f (ι m)                           ＝⟨ ap f ((max-idemp fe (ι m))⁻¹) ⟩
+       f (max (ι m) (ι m))               ＝⟨ gap m ⟩
+       f ∞ ∎
+
+    III : (x : ℕ∞) → evc-extension (restriction f) c x ＝ f x
+    III = ℕ∞-density fe ℕ-is-¬¬-separated I II
+
+  ϕγ : ϕ ∘ γ ∼ id
+  ϕγ (g , g-evc) =
+   to-subtype-＝
+    (λ _ → ∃-is-prop)
+    (dfunext fe
+      (λ n → evc-extension-property
+              g
+              (eventual-constancy-property-gives-eventual-constancy-data g g-evc)
+              n))
+
+  ϕ-is-equiv : is-equiv ϕ
+  ϕ-is-equiv = qinvs-are-equivs ϕ (γ , γϕ , ϕγ)
+
+ characterization-of-type-of-continuous-functions-≃
+  : (Σ f ꞉ (ℕ∞ → ℕ) , is-continuous f)
+  ≃ (Σ g ꞉ (ℕ → ℕ), is-eventually-constant g)
+ characterization-of-type-of-continuous-functions-≃
+  = ϕ , ϕ-is-equiv
+-}
+
+\end{code}
+
+Added 20th September 2024.
+
+I think, in retrospect, it would have been a better idea to work with
+minimal moduli of continuity and eventual constancy. In this way, we
+never need to use propositional truncations, because the explicit
+existence of minimal moduli, of continuity or eventual constancy, is
+property rather than data (or property-like data, if you wish).
+
+In any case, if we want to keep this development as it is, it is
+enough to use
+
+  exit-truncation⁺-minimality
+   : (A : ℕ → 𝓤 ̇ )
+   → is-prop-valued-family A)
+   → ((n : ℕ) → A n → (k : ℕ) → k < n → is-decidable (A k))
+   → (s : ∥ Σ A ∥) → ((i : ℕ) → A i → pr₁ (exit-truncation⁺ s) ≤ i)
+
+This holds because exit-truncation⁺ does produce, by construction, a
+minimal witness.
+
+One possible idea is to do both, but instead take the primary
+definitions of `is-continuous` and of `is-eventually-constant` using
+minimality rather than propositional truncaion, and then show that the
+definitions using minimality are (logically and typally) equivalent.
diff --git a/source/TypeTopology/DisconnectedTypes.lagda b/source/TypeTopology/DisconnectedTypes.lagda
index 1f5b83acd..d5fdc4e75 100644
--- a/source/TypeTopology/DisconnectedTypes.lagda
+++ b/source/TypeTopology/DisconnectedTypes.lagda
@@ -177,7 +177,6 @@ various equivalent ways.
 \begin{code}
 
 open import TypeTopology.TotallySeparated
-open import UF.Base
 open import UF.FunExt
 open import UF.Subsingletons
 open import UF.Subsingletons-FunExt
diff --git a/source/TypeTopology/ExtendedSumCompact.lagda b/source/TypeTopology/ExtendedSumCompact.lagda
index aa842fb8d..800fecc50 100644
--- a/source/TypeTopology/ExtendedSumCompact.lagda
+++ b/source/TypeTopology/ExtendedSumCompact.lagda
@@ -11,7 +11,7 @@ open import UF.Embeddings
 module TypeTopology.ExtendedSumCompact (fe : FunExt) where
 
 open import TypeTopology.CompactTypes
-open import TypeTopology.PropTychonoff fe
+open import TypeTopology.PropTychonoff
 
 open import InjectiveTypes.Blackboard fe
 
@@ -23,6 +23,7 @@ extended-sum-compact∙ : {X : 𝓤 ̇ }
                       → ((x : X) → is-compact∙ (Y x))
                       → is-compact∙ K
                       → is-compact∙ (Σ (Y / j))
-extended-sum-compact∙ j e ε δ = Σ-is-compact∙ δ (λ k → prop-tychonoff (e k) (ε ∘ pr₁))
+extended-sum-compact∙ {𝓤} {𝓥} {𝓦} j e ε δ =
+ Σ-is-compact∙ δ (λ k → prop-tychonoff (fe (𝓤 ⊔ 𝓥) 𝓦) (e k) (ε ∘ pr₁))
 
 \end{code}
diff --git a/source/TypeTopology/FailureOfTotalSeparatedness.lagda b/source/TypeTopology/FailureOfTotalSeparatedness.lagda
index 15dfc5ae6..3b661bd9f 100644
--- a/source/TypeTopology/FailureOfTotalSeparatedness.lagda
+++ b/source/TypeTopology/FailureOfTotalSeparatedness.lagda
@@ -59,113 +59,115 @@ more transparent and conceptual argument.)
 
 \begin{code}
 
-module ℕ∞₂ where
+ℕ∞₂ : 𝓤₀ ̇
+ℕ∞₂ = Σ u ꞉ ℕ∞ , (u ＝ ∞ → 𝟚)
 
- ℕ∞₂ : 𝓤₀ ̇
- ℕ∞₂ = Σ u ꞉ ℕ∞ , (u ＝ ∞ → 𝟚)
+∞₀ : ℕ∞₂
+∞₀ = (∞ , λ r → ₀)
 
- ∞₀ : ℕ∞₂
- ∞₀ = (∞ , λ r → ₀)
-
- ∞₁ : ℕ∞₂
- ∞₁ = (∞ , λ r → ₁)
+∞₁ : ℕ∞₂
+∞₁ = (∞ , λ r → ₁)
 
 \end{code}
 
- The elements ∞₀ and ∞₁ look different:
+The elements ∞₀ and ∞₁ look different:
 
 \begin{code}
 
- naive : (pr₂ ∞₀ refl ＝ ₀)  ×  (pr₂ ∞₁ refl ＝ ₁)
- naive = refl , refl
+naive : (pr₂ ∞₀ refl ＝ ₀)  ×  (pr₂ ∞₁ refl ＝ ₁)
+naive = refl , refl
 
 \end{code}
 
- But there is no function p : ℕ∞₂ → 𝟚 such that p x = pr₂ x refl, because
- pr₁ x may be different from ∞, in which case pr₂ x is the function with
- empty graph, and so it can't be applied to anything, and certainly
- not to refl. In fact, the definition
+But there is no function p : ℕ∞₂ → 𝟚 such that p x = pr₂ x refl, because
+pr₁ x may be different from ∞, in which case pr₂ x is the function with
+empty graph, and so it can't be applied to anything, and certainly
+not to refl. In fact, the definition
 
-    p : ℕ∞₂ → 𝟚
-    p x = pr₂ x refl
+   p : ℕ∞₂ → 𝟚
+   p x = pr₂ x refl
 
- doesn't type check (Agda says: " (pr₁ (pr₁ x) x) != ₁ of type 𝟚 when
- checking that the expression refl has type pr₁ x ＝ ∞"), and hence we
- haven't distinguished ∞₀ and ∞₁ by applying the same function to
- them. This is clearly seen when enough implicit arguments are made
- explicit.
+doesn't type check (Agda says: " (pr₁ (pr₁ x) x) != ₁ of type 𝟚 when
+checking that the expression refl has type pr₁ x ＝ ∞"), and hence we
+haven't distinguished ∞₀ and ∞₁ by applying the same function to
+them. This is clearly seen when enough implicit arguments are made
+explicit.
 
- No matter how hard we try to find such a function, we won't succeed,
- because we know that WLPO is not provable:
+No matter how hard we try to find such a function, we won't succeed,
+because we know that WLPO is not provable:
 
 \begin{code}
 
- failure : (p : ℕ∞₂ → 𝟚) → p ∞₀ ≠ p ∞₁ → WLPO
- failure p = disagreement-taboo p₀ p₁ lemma
-  where
-   p₀ : ℕ∞ → 𝟚
-   p₀ u = p (u , λ r → ₀)
-
-   p₁ : ℕ∞ → 𝟚
-   p₁ u = p (u , λ r → ₁)
-
-   lemma : (n : ℕ) → p₀ (ι n) ＝ p₁ (ι n)
-   lemma n = ap (λ - → p (ι n , -)) (dfunext fe₀ claim)
-    where
-     claim : (r : ι n ＝ ∞) → (λ r → ₀) r ＝ (λ r → ₁) r
-     claim s = 𝟘-elim (∞-is-not-finite n (s ⁻¹))
-
- open import UF.DiscreteAndSeparated
-
- 𝟚-indistinguishability : ¬ WLPO → (p : ℕ∞₂ → 𝟚) → p ∞₀ ＝ p ∞₁
- 𝟚-indistinguishability nwlpo p = 𝟚-is-¬¬-separated (p ∞₀) (p ∞₁)
-                                   (not-Σ-implies-Π-not
-                                     (contrapositive
-                                       (λ (p , ν) → failure p ν)
-                                       nwlpo)
-                                     p)
+failure : (p : ℕ∞₂ → 𝟚) → p ∞₀ ≠ p ∞₁ → WLPO
+failure p = disagreement-taboo p₀ p₁ lemma
+ where
+  p₀ : ℕ∞ → 𝟚
+  p₀ u = p (u , λ r → ₀)
+
+  p₁ : ℕ∞ → 𝟚
+  p₁ u = p (u , λ r → ₁)
+
+  lemma : (n : ℕ) → p₀ (ι n) ＝ p₁ (ι n)
+  lemma n = ap (λ - → p (ι n , -)) (dfunext fe₀ claim)
+   where
+    claim : (r : ι n ＝ ∞) → (λ r → ₀) r ＝ (λ r → ₁) r
+    claim s = 𝟘-elim (∞-is-not-finite n (s ⁻¹))
+
+open import UF.DiscreteAndSeparated
+
+𝟚-indistinguishability : ¬ WLPO → (p : ℕ∞₂ → 𝟚) → p ∞₀ ＝ p ∞₁
+𝟚-indistinguishability nwlpo p = 𝟚-is-¬¬-separated (p ∞₀) (p ∞₁)
+                                  (not-Σ-implies-Π-not
+                                    (contrapositive
+                                      (λ (p , ν) → failure p ν)
+                                      nwlpo)
+                                    p)
 \end{code}
 
- Precisely because one cannot construct maps from ℕ∞₂ into 𝟚 that
- distinguish ∞₀ and ∞₁, it is a bit tricky to prove that they are
- indeed different:
+Precisely because one cannot construct maps from ℕ∞₂ into 𝟚 that
+distinguish ∞₀ and ∞₁, it is a bit tricky to prove that they are
+indeed different:
 
 \begin{code}
 
- ∞₀-and-∞₁-different : ∞₀ ≠ ∞₁
- ∞₀-and-∞₁-different r = zero-is-not-one claim₂
-  where
-   p : ∞ ＝ ∞
-   p = ap pr₁ r
+∞₀-and-∞₁-different : ∞₀ ≠ ∞₁
+∞₀-and-∞₁-different r = zero-is-not-one claim₂
+ where
+  p : ∞ ＝ ∞
+  p = ap pr₁ r
 
-   t : {x x' : ℕ∞} → x ＝ x' → (x ＝ ∞ → 𝟚) → (x' ＝ ∞ → 𝟚)
-   t = transport (λ - → - ＝ ∞ → 𝟚)
+  t : {x x' : ℕ∞} → x ＝ x' → (x ＝ ∞ → 𝟚) → (x' ＝ ∞ → 𝟚)
+  t = transport (λ - → - ＝ ∞ → 𝟚)
 
-   claim₀ : refl ＝ p
-   claim₀ = ℕ∞-is-set fe₀ refl p
+  claim₀ : refl ＝ p
+  claim₀ = ℕ∞-is-set fe₀ refl p
 
-   claim₁ : t p (λ p → ₀) ＝ (λ p → ₁)
-   claim₁ = from-Σ-＝' r
+  claim₁ : t p (λ p → ₀) ＝ (λ p → ₁)
+  claim₁ = from-Σ-＝' r
 
-   claim₂ : ₀ ＝ ₁
-   claim₂ =  ₀                  ＝⟨ ap (λ - → t - (λ _ → ₀) refl) claim₀ ⟩
-             t p (λ _ → ₀) refl ＝⟨ ap (λ - → - refl) claim₁ ⟩
-             ₁                  ∎
+  claim₂ : ₀ ＝ ₁
+  claim₂ =  ₀                  ＝⟨ ap (λ - → t - (λ _ → ₀) refl) claim₀ ⟩
+            t p (λ _ → ₀) refl ＝⟨ ap (λ - → - refl) claim₁ ⟩
+            ₁                  ∎
 
 \end{code}
 
- Finally, the total separatedness of ℕ∞₂ is a taboo. In particular, it
- can't be proved, because ¬ WLPO is consistent.
+Finally, the total separatedness of ℕ∞₂ is a taboo. In particular, it
+can't be proved, because ¬ WLPO is consistent.
 
 \begin{code}
 
- open import TypeTopology.TotallySeparated
+open import TypeTopology.TotallySeparated
 
- Failure : is-totally-separated ℕ∞₂ → ¬¬ WLPO
- Failure ts nwlpo = g (𝟚-indistinguishability nwlpo)
-  where
-   g : ¬ ((p : ℕ∞₂ → 𝟚) → p ∞₀ ＝ p ∞₁)
-   g = contrapositive ts ∞₀-and-∞₁-different
+ℕ∞₂-is-not-totally-separated-in-general : is-totally-separated ℕ∞₂
+                                        → ¬¬ WLPO
+ℕ∞₂-is-not-totally-separated-in-general ts nwlpo = c
+ where
+  g : ¬ ((p : ℕ∞₂ → 𝟚) → p ∞₀ ＝ p ∞₁)
+  g = contrapositive ts ∞₀-and-∞₁-different
+
+  c : 𝟘
+  c = g (𝟚-indistinguishability nwlpo)
 
 \end{code}
 
diff --git a/source/TypeTopology/GenericConvergentSequenceCompactness.lagda b/source/TypeTopology/GenericConvergentSequenceCompactness.lagda
index 13c39d8b1..0ccfb91b8 100644
--- a/source/TypeTopology/GenericConvergentSequenceCompactness.lagda
+++ b/source/TypeTopology/GenericConvergentSequenceCompactness.lagda
@@ -133,6 +133,12 @@ Corollaries:
 ℕ∞-Compact : is-Compact ℕ∞ {𝓤}
 ℕ∞-Compact = compact-types-are-Compact ℕ∞-compact
 
+ℕ∞-Π-Compact : is-Π-Compact ℕ∞ {𝓤}
+ℕ∞-Π-Compact = Σ-Compact-types-are-Π-Compact ℕ∞ ℕ∞-Compact
+
+ℕ∞-Compact∙ : is-Compact∙ ℕ∞ {𝓤}
+ℕ∞-Compact∙ = Compact-pointed-gives-Compact∙ ℕ∞-Compact ∞
+
 ℕ∞→ℕ-is-discrete : is-discrete (ℕ∞ → ℕ)
 ℕ∞→ℕ-is-discrete = discrete-to-power-compact-is-discrete fe ℕ∞-compact (λ u → ℕ-is-discrete)
 
diff --git a/source/TypeTopology/InfProperty.lagda b/source/TypeTopology/InfProperty.lagda
index 411eda864..25b3b8d61 100644
--- a/source/TypeTopology/InfProperty.lagda
+++ b/source/TypeTopology/InfProperty.lagda
@@ -20,7 +20,8 @@ is-upper-bound-of-lower-bounds : (X → 𝟚) → X → 𝓤 ⊔ 𝓥 ̇
 is-upper-bound-of-lower-bounds p u = (l : X) → is-roots-lower-bound p l → l ≤ u
 
 is-roots-infimum : (X → 𝟚) → X → 𝓤 ⊔ 𝓥 ̇
-is-roots-infimum p x = is-roots-lower-bound p x × is-upper-bound-of-lower-bounds p x
+is-roots-infimum p x = is-roots-lower-bound p x
+                     × is-upper-bound-of-lower-bounds p x
 
 has-inf : 𝓤 ⊔ 𝓥 ̇
 has-inf = (p : X → 𝟚) → Σ x ꞉ X , is-conditional-root p x × is-roots-infimum p x
diff --git a/source/TypeTopology/PropInfTychonoff.lagda b/source/TypeTopology/PropInfTychonoff.lagda
index 69b4499ad..a5111aa81 100644
--- a/source/TypeTopology/PropInfTychonoff.lagda
+++ b/source/TypeTopology/PropInfTychonoff.lagda
@@ -13,13 +13,10 @@ open import UF.FunExt
 module TypeTopology.PropInfTychonoff (fe : FunExt) where
 
 open import MLTT.Two-Properties
-open import TypeTopology.CompactTypes
 open import TypeTopology.InfProperty
-open import UF.Base
 open import UF.Subsingletons
 open import UF.PropIndexedPiSigma
 open import UF.Equiv
-open import UF.EquivalenceExamples
 
 prop-inf-tychonoff : {X : 𝓤 ̇ } {Y : X → 𝓥 ̇ }
                    → is-prop X
diff --git a/source/TypeTopology/PropTychonoff.lagda b/source/TypeTopology/PropTychonoff.lagda
index c55e9312d..dfcea721b 100644
--- a/source/TypeTopology/PropTychonoff.lagda
+++ b/source/TypeTopology/PropTychonoff.lagda
@@ -40,23 +40,21 @@ The point is that
 
 open import MLTT.Spartan
 
-open import UF.FunExt
-
-module TypeTopology.PropTychonoff (fe : FunExt) where
+module TypeTopology.PropTychonoff where
 
 open import MLTT.Two-Properties
 open import TypeTopology.CompactTypes
-open import UF.Base
 open import UF.Equiv
-open import UF.EquivalenceExamples
+open import UF.FunExt
 open import UF.PropIndexedPiSigma
 open import UF.Subsingletons
 
-prop-tychonoff : {X : 𝓤 ̇ } {Y : X → 𝓥 ̇ }
+prop-tychonoff : funext 𝓤 𝓥
+               → {X : 𝓤 ̇ } {Y : X → 𝓥 ̇ }
                → is-prop X
                → ((x : X) → is-compact∙ (Y x))
                → is-compact∙ (Π Y)
-prop-tychonoff {𝓤} {𝓥} {X} {Y} X-is-prop ε p = γ
+prop-tychonoff {𝓤} {𝓥} fe {X} {Y} X-is-prop ε p = γ
  where
   have-ε : (x : X) → is-compact∙ (Y x)
   have-ε = ε
@@ -65,7 +63,7 @@ prop-tychonoff {𝓤} {𝓥} {X} {Y} X-is-prop ε p = γ
   have-p = p
 
   𝕗 : (x : X) → Π Y ≃ Y x
-  𝕗 = prop-indexed-product (fe 𝓤 𝓥) X-is-prop
+  𝕗 = prop-indexed-product fe X-is-prop
 
 \end{code}
 
@@ -180,7 +178,7 @@ We get the same conclusion if X is empty:
   φ₀-is-universal-witness-assuming-X-empty
    : (X → 𝟘) → p φ₀ ＝ ₁ → (φ : Π Y) → p φ ＝ ₁
   φ₀-is-universal-witness-assuming-X-empty u r φ =
-   p φ  ＝⟨ ap p (dfunext (fe 𝓤 𝓥) (λ x → unique-from-𝟘 (u x))) ⟩
+   p φ  ＝⟨ ap p (dfunext fe (λ x → unique-from-𝟘 (u x))) ⟩
    p φ₀ ＝⟨ r ⟩
    ₁    ∎
 
@@ -257,11 +255,12 @@ A particular case is the following:
 
 \begin{code}
 
-prop-tychonoff-corollary : {X : 𝓤 ̇ } {Y : 𝓥 ̇ }
+prop-tychonoff-corollary : funext 𝓤 𝓥
+                         → {X : 𝓤 ̇ } {Y : 𝓥 ̇ }
                          → is-prop X
                          → is-compact∙ Y
                          → is-compact∙ (X → Y)
-prop-tychonoff-corollary X-is-prop ε = prop-tychonoff X-is-prop (λ x → ε)
+prop-tychonoff-corollary fe X-is-prop ε = prop-tychonoff fe X-is-prop (λ x → ε)
 
 \end{code}
 
@@ -273,11 +272,12 @@ Better (9 Sep 2015):
 
 \begin{code}
 
-prop-tychonoff-corollary' : {X : 𝓤 ̇ } {Y : 𝓥 ̇ }
+prop-tychonoff-corollary' : funext 𝓤 𝓥
+                          → {X : 𝓤 ̇ } {Y : 𝓥 ̇ }
                           → is-prop X
                           → (X → is-compact∙ Y)
                           → is-compact∙ (X → Y)
-prop-tychonoff-corollary' = prop-tychonoff
+prop-tychonoff-corollary' fe = prop-tychonoff fe
 
 \end{code}
 
@@ -295,12 +295,12 @@ proposition P, which is weak excluded middle, which is not provable.
 
 open import UF.ClassicalLogic
 
-compact-prop-tychonoff-gives-WEM : ((X : 𝓤 ̇ ) (Y : X → 𝓥 ̇ )
-                                       → is-prop X
-                                       → ((x : X) → is-compact (Y x))
-                                       → is-compact (Π Y))
-                                 → WEM 𝓤
-compact-prop-tychonoff-gives-WEM {𝓤} {𝓥} τ X X-is-prop = δ γ
+compact-prop-tychonoff-gives-WEM' : ((X : 𝓤 ̇ ) (Y : X → 𝓥 ̇ )
+                                        → is-prop X
+                                        → ((x : X) → is-compact (Y x))
+                                        → is-compact (Π Y))
+                                  → WEM' 𝓤
+compact-prop-tychonoff-gives-WEM' {𝓤} {𝓥} τ X X-is-prop = δ γ
  where
   Y : X → 𝓥 ̇
   Y x = 𝟘
@@ -316,3 +316,6 @@ compact-prop-tychonoff-gives-WEM {𝓤} {𝓥} τ X X-is-prop = δ γ
   δ (inr ϕ) = inr (contrapositive (λ f → 𝟘-elim ∘ f) ϕ)
 
 \end{code}
+
+If we further assume function extensionality, we get WEM from WEM',
+and hence we can replace the conclusion of the above fact by WEM.
diff --git a/source/TypeTopology/RicesTheoremForTheUniverse.lagda b/source/TypeTopology/RicesTheoremForTheUniverse.lagda
index 9fb8f5f21..5e6c5e22f 100644
--- a/source/TypeTopology/RicesTheoremForTheUniverse.lagda
+++ b/source/TypeTopology/RicesTheoremForTheUniverse.lagda
@@ -71,7 +71,6 @@ module TypeTopology.RicesTheoremForTheUniverse (fe : FunExt) where
 open import MLTT.Spartan
 
 open import UF.Equiv
-open import UF.EquivalenceExamples
 open import TypeTopology.TheTopologyOfTheUniverse fe
 open import CoNaturals.Type
 open import Taboos.WLPO
diff --git a/source/TypeTopology/SequentiallyHausdorff.lagda b/source/TypeTopology/SequentiallyHausdorff.lagda
index 00cf7f95a..7eb98bc60 100644
--- a/source/TypeTopology/SequentiallyHausdorff.lagda
+++ b/source/TypeTopology/SequentiallyHausdorff.lagda
@@ -27,9 +27,9 @@ open import Taboos.WLPO
 
 \end{code}
 
-A topological space is sequentially Hausdorff if every sequence of
-points converges to at most one point. In our synthetic setting, this
-can be formulated as follows, following the above blog post by Chris
+A topological space is sequentially Hausdorff if every sequence
+converges to at most one point. In our synthetic setting, this can be
+formulated as follows, following the above blog post by Chris
 Grossack.
 
 \begin{code}
@@ -42,7 +42,8 @@ is-sequentially-Hausdorff X = (f g : ℕ∞ → X)
 \end{code}
 
 If WLPO holds in our topos, then our topos is not topological, in any
-conceivable sense, and no non-trivial type is sequentially Hausdorff.
+conceivable sense, and no type with two distinct points is
+sequentially Hausdorff.
 
 \begin{code}
 
@@ -128,8 +129,8 @@ totally-separated-types-are-sequentially-Hausdorff nwlpo X X-is-ts f g a = II
 
 \end{code}
 
-There are plenty of totally separated types. For example, the types 𝟚
-and ℕ are totally separated, and the totally separated types are
+There are plenty of totally separated types. For example, the types 𝟚,
+ℕ and ℕ∞ are totally separated, and the totally separated types are
 closed under products (and hence function spaces and more generally
 form an exponential ideal) and under retracts, as proved in the above
 import TypeTopology.TotallySeparated.
@@ -148,7 +149,6 @@ which amounts to ℕ∞ with the point ∞ split into two copies
 \begin{code}
 
 open import TypeTopology.FailureOfTotalSeparatedness fe₀
-open ℕ∞₂
 
 ℕ∞₂-is-not-sequentially-Hausdorff : ¬ is-sequentially-Hausdorff ℕ∞₂
 ℕ∞₂-is-not-sequentially-Hausdorff h = III
diff --git a/source/TypeTopology/SigmaDiscreteAndTotallySeparated.lagda b/source/TypeTopology/SigmaDiscreteAndTotallySeparated.lagda
index 2cc91fadc..3f67b9aff 100644
--- a/source/TypeTopology/SigmaDiscreteAndTotallySeparated.lagda
+++ b/source/TypeTopology/SigmaDiscreteAndTotallySeparated.lagda
@@ -160,10 +160,7 @@ separated types are closed under Σ.
 
 \begin{code}
 
-module _ (fe : FunExt) where
-
- private
-  fe₀ = fe 𝓤₀ 𝓤₀
+module _ (fe₀ : funext 𝓤₀ 𝓤₀) where
 
  Σ-totally-separated-taboo :
 
@@ -175,7 +172,7 @@ module _ (fe : FunExt) where
       ¬¬ WLPO
 
  Σ-totally-separated-taboo τ =
-   ℕ∞₂.Failure fe₀
+   ℕ∞₂-is-not-totally-separated-in-general fe₀
     (τ ℕ∞ (λ u → u ＝ ∞ → 𝟚)
        (ℕ∞-is-totally-separated fe₀)
           (λ u → Π-is-totally-separated fe₀ (λ _ → 𝟚-is-totally-separated)))
@@ -207,11 +204,11 @@ Even compact totally separated types fail to be closed under Σ:
       ¬¬ WLPO
 
  Σ-totally-separated-stronger-taboo τ =
-   ℕ∞₂.Failure fe₀
+   ℕ∞₂-is-not-totally-separated-in-general fe₀
     (τ ℕ∞ (λ u → u ＝ ∞ → 𝟚)
        (ℕ∞-compact fe₀)
        (λ _ → compact∙-types-are-compact
-               (prop-tychonoff fe (ℕ∞-is-set fe₀) (λ _ → 𝟚-is-compact∙)))
+               (prop-tychonoff fe₀ (ℕ∞-is-set fe₀) (λ _ → 𝟚-is-compact∙)))
        (ℕ∞-is-totally-separated fe₀)
           (λ u → Π-is-totally-separated fe₀ (λ _ → 𝟚-is-totally-separated)))
 
diff --git a/source/TypeTopology/SquashedCantor.lagda b/source/TypeTopology/SquashedCantor.lagda
index 1756afbe4..4005052c5 100644
--- a/source/TypeTopology/SquashedCantor.lagda
+++ b/source/TypeTopology/SquashedCantor.lagda
@@ -31,11 +31,8 @@ open import Naturals.Sequence fe
 open import Notation.CanonicalMap
 open import TypeTopology.SquashedSum fe
 open import UF.Base
-open import UF.Embeddings
-open import UF.Equiv
 open import UF.Retracts
 open import UF.Retracts-FunExt
-open import UF.Subsingletons
 
 private
  fe' : Fun-Ext
@@ -596,7 +593,6 @@ Snoc α = (Head α , Tail α)
 Snoc-Cons : (d : D Cantor) → Snoc (Cons d) ＝ d
 Snoc-Cons (u , π) = to-Σ-＝ (Head-Cons u π , Tail-Cons' u π)
 
-open import UF.Retracts
 
 D-Cantor-retract-of-Cantor : retract (D Cantor) of Cantor
 D-Cantor-retract-of-Cantor = Snoc , Cons , Snoc-Cons
diff --git a/source/TypeTopology/SquashedSum.lagda b/source/TypeTopology/SquashedSum.lagda
index fc2bb890e..8fe33f9f5 100644
--- a/source/TypeTopology/SquashedSum.lagda
+++ b/source/TypeTopology/SquashedSum.lagda
@@ -32,7 +32,6 @@ open import UF.DiscreteAndSeparated
 open import UF.Embeddings
 open import UF.Equiv
 open import UF.PairFun
-open import UF.Subsingletons
 open import UF.Subsingletons-Properties
 
 \end{code}
diff --git a/source/TypeTopology/TotallySeparated.lagda b/source/TypeTopology/TotallySeparated.lagda
index a77e91566..a4d8ff9e2 100644
--- a/source/TypeTopology/TotallySeparated.lagda
+++ b/source/TypeTopology/TotallySeparated.lagda
@@ -75,7 +75,6 @@ open import UF.Hedberg
 open import UF.LeftCancellable
 open import UF.Lower-FunExt
 open import UF.NotNotStablePropositions
-open import UF.Powerset hiding (𝕋)
 open import UF.PropTrunc
 open import UF.Retracts
 open import UF.Sets
@@ -742,61 +741,20 @@ separated, where tightness means ¬ (x ♯ y)→ x = y. Part of the following
 should be moved to another module about apartness, but I keep it here
 for the moment.
 
-26 January 2018.
+Added 26 January 2018.
+
+We now show that a type is totally separated iff a particular
+apartness relation _♯₂ is tight:
 
 \begin{code}
 
-module Apartness
-        (fe : FunExt)
+module total-separatedness-via-apartness
         (pt : propositional-truncations-exist)
        where
 
- private
-  fe' : Fun-Ext
-  fe' {𝓤} {𝓥} = fe 𝓤 𝓥
-
  open PropositionalTruncation pt
- open import UF.ImageAndSurjection pt
-
- is-prop-valued is-irreflexive is-symmetric is-cotransitive is-tight is-apartness
-     : {X : 𝓤 ̇ } → (X → X → 𝓥 ̇ ) → 𝓤 ⊔ 𝓥 ̇
-
- is-prop-valued  _♯_ = ∀ x y → is-prop (x ♯ y)
- is-irreflexive  _♯_ = ∀ x → ¬ (x ♯ x)
- is-symmetric    _♯_ = ∀ x y → x ♯ y → y ♯ x
- is-cotransitive _♯_ = ∀ x y z → x ♯ y → x ♯ z ∨ y ♯ z
- is-tight        _♯_ = ∀ x y → ¬ (x ♯ y) → x ＝ y
- is-apartness    _♯_ = is-prop-valued _♯_
-                     × is-irreflexive _♯_
-                     × is-symmetric _♯_
-                     × is-cotransitive _♯_
-
- apartness-is-prop-valued : {X : 𝓤 ̇ } (_♯_ : X → X → 𝓥 ̇ )
-                          → is-apartness _♯_
-                          → is-prop-valued _♯_
- apartness-is-prop-valued _♯_ (p , i , s , c) = p
-
- apartness-is-irreflexive : {X : 𝓤 ̇ } (_♯_ : X → X → 𝓥 ̇ )
-                          → is-apartness _♯_
-                          → is-irreflexive _♯_
- apartness-is-irreflexive _♯_ (p , i , s , c) = i
-
- apartness-is-symmetric : {X : 𝓤 ̇ } (_♯_ : X → X → 𝓥 ̇ )
-                        → is-apartness _♯_
-                        → is-symmetric _♯_
- apartness-is-symmetric _♯_ (p , i , s , c) = s
-
- apartness-is-cotransitive : {X : 𝓤 ̇ } (_♯_ : X → X → 𝓥 ̇ )
-                           → is-apartness _♯_
-                           → is-cotransitive _♯_
- apartness-is-cotransitive _♯_ (p , i , s , c) = c
-
-\end{code}
-
-We now show that a type is totally separated iff a particular
-apartness relation _♯₂ is tight:
-
-\begin{code}
+ open import Apartness.Definition
+ open Apartness pt
 
  _♯₂_ : {X : 𝓤 ̇ } → X → X → 𝓤 ̇
  x ♯₂ y = ∃ p ꞉ (type-of x → 𝟚), p x ≠ p y
@@ -856,716 +814,3 @@ apartness relation _♯₂ is tight:
    α p = 𝟚-is-¬¬-separated (p x) (p y) (λ u → h (p , u))
 
 \end{code}
-
- I don't think there is a tight apartness relation on Ω without
- constructive taboos. The natural apartness relation seems to be the
- following, but it isn't contrasitive unless excluded middle holds.
-
-\begin{code}
-
- _♯Ω_ : Ω 𝓤 → Ω 𝓤 → 𝓤 ̇
- (P , i) ♯Ω (Q , j) = (P × ¬ Q) + (¬ P × Q)
-
- ♯Ω-irrefl : is-irreflexive (_♯Ω_ {𝓤})
- ♯Ω-irrefl (P , i) (inl (p , nq)) = nq p
- ♯Ω-irrefl (P , i) (inr (np , q)) = np q
-
- ♯Ω-sym : is-symmetric (_♯Ω_ {𝓤})
- ♯Ω-sym (P , i) (Q , j) (inl (p , nq)) = inr (nq , p)
- ♯Ω-sym (P , i) (Q , j) (inr (np , q)) = inl (q , np)
-
- ♯Ω-cotran-taboo : is-cotransitive (_♯Ω_ {𝓤})
-                 → (p : Ω 𝓤) → p holds ∨ ¬ (p holds)
- ♯Ω-cotran-taboo c p = ∥∥-functor II I
-  where
-   I : (⊥ ♯Ω p) ∨ (⊤ ♯Ω p)
-   I = c ⊥ ⊤ p (inr (𝟘-elim , ⋆))
-
-   II : (⊥ ♯Ω p) + (⊤ ♯Ω p) → (p holds) + ¬ (p holds)
-   II (inl (inr (a , b))) = inl b
-   II (inr (inl (a , b))) = inr b
-   II (inr (inr (a , b))) = inl b
-
-\end{code}
-
-
- 12 Feb 2018. The following was prompted by the discussion
-
-https://nforum.ncatlab.org/discussion/8282/points-of-the-localic-quotient-with-respect-to-an-apartness-relation/
-
- But is clearly related to the above characterization of total
- separatedness.
-
-\begin{code}
-
- is-reflexive is-transitive is-equivalence-rel
-     : {X : 𝓤 ̇ } → (X → X → 𝓥 ̇ ) → 𝓤 ⊔ 𝓥 ̇
-
- is-reflexive       _≈_ = ∀ x → x ≈ x
- is-transitive      _≈_ = ∀ x y z → x ≈ y → y ≈ z → x ≈ z
- is-equivalence-rel _≈_ = is-prop-valued _≈_
-                        × is-reflexive _≈_
-                        × is-symmetric _≈_
-                        × is-transitive _≈_
-
-\end{code}
-
- The following is the standard equivalence relation induced by an
- apartness relation. The tightness axiom defined above says that this
- equivalence relation is equality.
-
-\begin{code}
-
- neg-apart-is-equiv : {X : 𝓤 ̇ }
-                    → funext 𝓤 𝓤₀
-                    → (_♯_ : X → X → 𝓤 ̇ )
-                    → is-apartness _♯_
-                    → is-equivalence-rel (λ x y → ¬ (x ♯ y))
- neg-apart-is-equiv {𝓤} {X} fe _♯_ (♯p , ♯i , ♯s , ♯c) = p , ♯i , s , t
-  where
-   p : (x y : X) → is-prop (¬ (x ♯ y))
-   p x y = negations-are-props fe
-
-   s : (x y : X) → ¬ (x ♯ y) → ¬ (y ♯ x)
-   s x y u a = u (♯s y x a)
-
-   t : (x y z : X) → ¬ (x ♯ y) → ¬ (y ♯ z) → ¬ (x ♯ z)
-   t x y z u v a = v (♯s z y (left-fails-gives-right-holds (♯p z y) b u))
-    where
-     b : (x ♯ y) ∨ (z ♯ y)
-     b = ♯c x z y a
-
- \end{code}
-
- The following positive formulation of ¬ (x ♯ y), which says that two
- elements have the same elements apart from them iff they are not
- apart, gives another way to see that it is an equivalence relation:
-
- \begin{code}
-
- not-apart-have-same-apart : {X : 𝓤 ̇ } (x y : X) (_♯_ : X → X → 𝓥 ̇ )
-                           → is-apartness _♯_
-                           → ¬ (x ♯ y)
-                           → ((z : X) → x ♯ z ↔ y ♯ z)
- not-apart-have-same-apart {𝓤} {𝓥} {X} x y _♯_ (p , i , s , c) = g
-  where
-   g : ¬ (x ♯ y) → (z : X) → x ♯ z ↔ y ♯ z
-   g n z = g₁ , g₂
-    where
-     g₁ : x ♯ z → y ♯ z
-     g₁ a = s z y (left-fails-gives-right-holds (p z y) b n)
-      where
-       b : (x ♯ y) ∨ (z ♯ y)
-       b = c x z y a
-
-     n' : ¬ (y ♯ x)
-     n' a = n (s y x a)
-
-     g₂ : y ♯ z → x ♯ z
-     g₂ a = s z x (left-fails-gives-right-holds (p z x) b n')
-      where
-       b : (y ♯ x) ∨ (z ♯ x)
-       b = c y z x a
-
- have-same-apart-are-not-apart : {X : 𝓤 ̇ } (x y : X) (_♯_ : X → X → 𝓥 ̇ )
-                               → is-apartness _♯_
-                               → ((z : X) → x ♯ z ↔ y ♯ z)
-                               → ¬ (x ♯ y)
- have-same-apart-are-not-apart {𝓤} {𝓥} {X} x y _♯_ (p , i , s , c) = f
-  where
-   f : ((z : X) → x ♯ z ↔ y ♯ z) → ¬ (x ♯ y)
-   f φ a = i y (pr₁(φ y) a)
-
-\end{code}
-
- As far as we know, the above observation that the negation of
- apartness can be characterized in positive terms is new.
-
- Not-not equal elements are not apart, and hence, in the presence of
- tightness, they are equal. It follows that tight apartness types are
- sets.
-
- TODO. We need better names for the following functions:
-
-\begin{code}
-
- not-not-equal-not-apart' : {X : 𝓤 ̇ } (x y : X) (_♯_ : X → X → 𝓥 ̇ )
-                          → is-irreflexive _♯_
-                          → ¬¬ (x ＝ y)
-                          → ¬ (x ♯ y)
- not-not-equal-not-apart' x y _♯_ i = contrapositive f
-  where
-   f : x ♯ y → ¬ (x ＝ y)
-   f a p = i y (transport (λ - → - ♯ y) p a)
-
- tight-is-¬¬-separated' : {X : 𝓤 ̇ } (_♯_ : X → X → 𝓥 ̇ )
-                        → is-irreflexive _♯_
-                        → is-tight _♯_
-                        → is-¬¬-separated X
- tight-is-¬¬-separated' _♯_ i t = f
-  where
-   f : ∀ x y → ¬¬ (x ＝ y) → x ＝ y
-   f x y φ = t x y (not-not-equal-not-apart' x y _♯_ i φ)
-
- tight-is-set' : {X : 𝓤 ̇ } (_♯_ : X → X → 𝓥 ̇ )
-               → funext 𝓤 𝓤₀
-               → is-irreflexive _♯_
-               → is-tight _♯_
-               → is-set X
- tight-is-set' _♯_ fe i t = ¬¬-separated-types-are-sets fe
-                             (tight-is-¬¬-separated' _♯_ i t)
-
- not-not-equal-not-apart : {X : 𝓤 ̇ } (x y : X) (_♯_ : X → X → 𝓥 ̇ )
-                         → is-apartness _♯_
-                         → ¬¬ (x ＝ y)
-                         → ¬ (x ♯ y)
- not-not-equal-not-apart x y _♯_ (_ , i , _ , _) =
-  not-not-equal-not-apart' x y _♯_ i
-
- tight-is-¬¬-separated : {X : 𝓤 ̇ } (_♯_ : X → X → 𝓥 ̇ )
-                       → is-apartness _♯_
-                       → is-tight _♯_
-                       → is-¬¬-separated X
- tight-is-¬¬-separated _♯_ (_ , i , _ , _) = tight-is-¬¬-separated' _♯_ i
-
- tight-is-set : {X : 𝓤 ̇ } (_♯_ : X → X → 𝓥 ̇ )
-              → funext 𝓤 𝓤₀
-              → is-apartness _♯_
-              → is-tight _♯_
-              → is-set X
- tight-is-set _♯_ fe (_ , i , _ , _) = tight-is-set' _♯_ fe i
-
-\end{code}
-
- The above use apartness data, but its existence is enough, because
- being a ¬¬-separated type and being a set are propositions.
-
-\begin{code}
-
- tight-separated' : funext 𝓤 𝓤
-                  → {X : 𝓤 ̇ }
-                  → (∃ _♯_ ꞉ (X → X → 𝓤 ̇ ), is-apartness _♯_ × is-tight _♯_)
-                  → is-¬¬-separated X
- tight-separated' {𝓤} fe {X} = ∥∥-rec (being-¬¬-separated-is-prop fe) f
-   where
-    f : (Σ _♯_ ꞉ (X → X → 𝓤 ̇ ), is-apartness _♯_ × is-tight _♯_)
-      → is-¬¬-separated X
-    f (_♯_ , a , t) = tight-is-¬¬-separated _♯_ a t
-
- tight-is-set'' : funext 𝓤 𝓤
-                → {X : 𝓤 ̇ }
-                → (∃ _♯_ ꞉ (X → X → 𝓤 ̇ ), is-apartness _♯_ × is-tight _♯_)
-                → is-set X
- tight-is-set'' {𝓤} fe {X} = ∥∥-rec (being-set-is-prop fe) f
-   where
-    f : (Σ _♯_ ꞉ (X → X → 𝓤 ̇ ), is-apartness _♯_ × is-tight _♯_) → is-set X
-    f (_♯_ , a , t) = tight-is-set _♯_ (lower-funext 𝓤 𝓤 fe) a t
-
-\end{code}
-
- A map is called strongly extensional if it reflects apartness. In the
- category of apartness types, the morphisms are the strongly
- extensional maps.
-
-\begin{code}
-
- is-strongly-extensional : ∀ {𝓣} {X : 𝓤 ̇ } {Y : 𝓥 ̇ }
-                         → (X → X → 𝓦 ̇ ) → (Y → Y → 𝓣 ̇ ) → (X → Y) → 𝓤 ⊔ 𝓦 ⊔ 𝓣 ̇
- is-strongly-extensional _♯_ _♯'_ f = ∀ x x' → f x ♯' f x' → x ♯ x'
-
- private
-  is-se = is-strongly-extensional
-
- being-strongly-extensional-is-prop : ∀ {𝓣} {X : 𝓤 ̇ } {Y : 𝓥 ̇ }
-                                    → (_♯_ : X → X → 𝓦 ̇ )
-                                    → (_♯'_ : Y → Y → 𝓣 ̇ )
-                                    → is-prop-valued _♯_
-                                    → (f : X → Y)
-                                    → is-prop (is-strongly-extensional _♯_ _♯'_ f)
- being-strongly-extensional-is-prop _♯_ _♯'_ ♯p f =
-  Π₃-is-prop  fe' (λ x x' a → ♯p x  x')
-
- preserves : ∀ {𝓣} {X : 𝓤 ̇ } {Y : 𝓥 ̇ }
-           → (X → X → 𝓦 ̇ ) → (Y → Y → 𝓣 ̇ ) → (X → Y) → 𝓤 ⊔ 𝓦 ⊔ 𝓣 ̇
- preserves R S f = ∀ {x x'} → R x x' → S (f x) (f x')
-
- module tight-reflection
-          (pe : propext 𝓥)
-          (X : 𝓤 ̇ )
-          (_♯_ : X → X → 𝓥 ̇ )
-          (♯p : is-prop-valued _♯_)
-          (♯i : is-irreflexive _♯_)
-          (♯s : is-symmetric _♯_)
-          (♯c : is-cotransitive _♯_)
-   where
-
-\end{code}
-
-  We now name the standard equivalence relation induced by _♯_.
-
-\begin{code}
-
-  _~_ : X → X → 𝓥 ̇
-  x ~ y = ¬ (x ♯ y)
-
-\end{code}
-
-  For certain purposes we need the apartness axioms packed into a
-  single axiom.
-
-\begin{code}
-
-  ♯a : is-apartness _♯_
-  ♯a = (♯p , ♯i , ♯s , ♯c)
-
-\end{code}
-
-  Initially we tried to work with the function apart : X → (X → 𝓥 ̇ )
-  defined by apart = _♯_. However, at some point in the development
-  below it was difficult to proceed, when we need that the identity
-  type apart x = apart y is a proposition. This should be the case
-  because _♯_ is is-prop-valued. The most convenient way to achieve this
-  is to restrict the codomain of apart from 𝓥 to Ω, so that the
-  codomain of apart is a set.
-
-\begin{code}
-
-  α : X → (X → Ω 𝓥)
-  α x y = x ♯ y , ♯p x y
-
-\end{code}
-
-  The following is an immediate consequence of the fact that two
-  equivalent elements have the same apartness class, using functional
-  and propositional extensionality.
-
-\begin{code}
-
-  α-lemma : (x y : X) → x ~ y → α x ＝ α y
-  α-lemma x y na = dfunext fe' h
-   where
-    f : (z : X) → x ♯ z ↔ y ♯ z
-    f = not-apart-have-same-apart x y _♯_ ♯a na
-
-    g : (z : X) → x ♯ z ＝ y ♯ z
-    g z = pe (♯p x z) (♯p y z) (pr₁ (f z)) (pr₂ (f z))
-
-    h : (z : X) → α x z ＝ α y z
-    h z = to-subtype-＝ (λ _ → being-prop-is-prop fe') (g z)
-
-\end{code}
-
-  We now construct the tight reflection of (X,♯) to get (X',♯')
-  together with a universal strongly extensional map from X into tight
-  apartness types. We take X' to be the image of the map α.
-
-\begin{code}
-
-  X' : 𝓤 ⊔ 𝓥 ⁺ ̇
-  X' = image α
-
-\end{code}
-
-The type X may or may not be a set, but its tight reflection is
-necessarily a set, and we can see this before we define a tight
-apartness on it.
-
-\begin{code}
-
-  X'-is-set : is-set X'
-  X'-is-set = subsets-of-sets-are-sets (X → Ω 𝓥) _
-               (powersets-are-sets'' fe' fe' pe) ∥∥-is-prop
-
-  η : X → X'
-  η = corestriction α
-
-\end{code}
-
-  The following induction principle is our main tool. Its uses look
-  convoluted at times by the need to show that the property one is
-  doing induction over is proposition valued. Typically this involves
-  the use of the fact the propositions form an exponential ideal, and,
-  more generally, are closed under products.
-
-\begin{code}
-
-  η-is-surjection : is-surjection η
-  η-is-surjection = corestrictions-are-surjections α
-
-  η-induction : (P : X' → 𝓦 ̇ )
-              → ((x' : X') → is-prop (P x'))
-              → ((x : X) → P (η x))
-              → (x' : X') → P x'
-  η-induction = surjection-induction η η-is-surjection
-
-\end{code}
-
-  The apartness relation _♯'_ on X' is defined as follows.
-
-\begin{code}
-
-  _♯'_ : X' → X' → 𝓤 ⊔ 𝓥 ⁺ ̇
-  (u , _) ♯' (v , _) = ∃ x ꞉ X , Σ y ꞉ X , (x ♯ y) × (α x ＝ u) × (α y ＝ v)
-
-\end{code}
-
-  Then η preserves and reflects apartness.
-
-\begin{code}
-
-  η-preserves-apartness : preserves _♯_ _♯'_ η
-  η-preserves-apartness {x} {y} a = ∣ x , y , a , refl , refl ∣
-
-  η-is-se : is-se _♯_ _♯'_ η
-  η-is-se x y = ∥∥-rec (♯p x y) g
-   where
-    g : (Σ x' ꞉ X , Σ y' ꞉ X , (x' ♯ y') × (α x' ＝ α x) × (α y' ＝ α y))
-      → x ♯ y
-    g (x' , y' , a , p , q) = ♯s _ _ (j (♯s _ _ (i a)))
-     where
-      i : x' ♯ y' → x ♯ y'
-      i = idtofun _ _ (ap pr₁ (happly p y'))
-
-      j : y' ♯ x → y ♯ x
-      j = idtofun _ _ (ap pr₁ (happly q x))
-
-\end{code}
-
-  Of course, we must check that _♯'_ is indeed an apartness
-  relation. We do this by η-induction. These proofs by induction need
-  routine proofs that some things are propositions.
-
-\begin{code}
-
-  ♯'p : is-prop-valued _♯'_
-  ♯'p _ _ = ∥∥-is-prop
-
-  ♯'i : is-irreflexive _♯'_
-  ♯'i = by-induction
-   where
-    induction-step : ∀ x → ¬ (η x ♯' η x)
-    induction-step x a = ♯i x (η-is-se x x a)
-
-    by-induction = η-induction (λ x' → ¬ (x' ♯' x'))
-                    (λ _ → Π-is-prop fe' (λ _ → 𝟘-is-prop))
-                    induction-step
-
-  ♯'s : is-symmetric _♯'_
-  ♯'s = by-nested-induction
-   where
-    induction-step : ∀ x y → η x ♯' η y → η y ♯' η x
-    induction-step x y a = η-preserves-apartness
-                            (♯s x y (η-is-se x y a))
-
-    by-nested-induction =
-      η-induction (λ x' → ∀ y' → x' ♯' y' → y' ♯' x')
-       (λ x' → Π₂-is-prop fe' (λ y' _ → ♯'p y' x'))
-       (λ x → η-induction (λ y' → η x ♯' y' → y' ♯' η x)
-                (λ y' → Π-is-prop fe' (λ _ → ♯'p y' (η x)))
-                (induction-step x))
-
-  ♯'c : is-cotransitive _♯'_
-  ♯'c = by-nested-induction
-   where
-    induction-step : ∀ x y z → η x ♯' η y → η x ♯' η z ∨ η y ♯' η z
-    induction-step x y z a = ∥∥-functor c b
-     where
-      a' : x ♯ y
-      a' = η-is-se x y a
-
-      b : x ♯ z ∨ y ♯ z
-      b = ♯c x y z a'
-
-      c : (x ♯ z) + (y ♯ z) → (η x ♯' η z) + (η y ♯' η z)
-      c (inl e) = inl (η-preserves-apartness e)
-      c (inr f) = inr (η-preserves-apartness f)
-
-    by-nested-induction =
-      η-induction (λ x' → ∀ y' z' → x' ♯' y' → (x' ♯' z') ∨ (y' ♯' z'))
-       (λ _ → Π₃-is-prop fe' (λ _ _ _ → ∥∥-is-prop))
-       (λ x → η-induction (λ y' → ∀ z' → η x ♯' y' → (η x ♯' z') ∨ (y' ♯' z'))
-                (λ _ → Π₂-is-prop fe' (λ _ _ → ∥∥-is-prop))
-                (λ y → η-induction (λ z' → η x ♯' η y → (η x ♯' z') ∨ (η y ♯' z'))
-                         (λ _ → Π-is-prop fe' (λ _ → ∥∥-is-prop))
-                         (induction-step x y)))
-
-  ♯'a : is-apartness _♯'_
-  ♯'a = (♯'p , ♯'i , ♯'s , ♯'c)
-
-\end{code}
-
-  The tightness of _♯'_ cannot by proved by induction by reduction to
-  properties of _♯_, as above, because _♯_ is not (necessarily)
-  tight. We need to work with the definitions of X' and _♯'_ directly.
-
-\begin{code}
-
-  ♯'t : is-tight _♯'_
-  ♯'t (u , e) (v , f) n = ∥∥-rec X'-is-set (λ σ → ∥∥-rec X'-is-set (h σ) f) e
-   where
-    h : (Σ x ꞉ X , α x ＝ u) → (Σ y ꞉ X , α y ＝ v) → (u , e) ＝ (v , f)
-    h (x , p) (y , q) = to-Σ-＝ (t , ∥∥-is-prop _ _)
-     where
-      remark : ¬∃ x ꞉ X , Σ y ꞉ X , (x ♯ y) × (α x ＝ u) × (α y ＝ v)
-      remark = n
-
-      r : ¬ (x ♯ y)
-      r a = n ∣ x , y , a , p , q ∣
-
-      t : u ＝ v
-      t = u   ＝⟨ p ⁻¹ ⟩
-          α x ＝⟨ α-lemma x y r ⟩
-          α y ＝⟨ q ⟩
-          v   ∎
-
-\end{code}
-
-  The tightness of _♯'_ gives that η maps equivalent elements to equal
-  elements, and its irreflexity gives that elements with the same η
-  image are equivalent.
-
-\begin{code}
-
-  η-equiv-gives-equal : {x y : X} → x ~ y → η x ＝ η y
-  η-equiv-gives-equal = ♯'t _ _ ∘ contrapositive (η-is-se _ _)
-
-  η-equal-gives-equiv : {x y : X} → η x ＝ η y → x ~ y
-  η-equal-gives-equiv {x} {y} p a = ♯'i
-                                     (η y)
-                                     (transport (λ - → - ♯' η y)
-                                     p
-                                     (η-preserves-apartness a))
-
-\end{code}
-
-  We now show that the above data provide the tight reflection, or
-  universal strongly extensional map from X to tight apartness types,
-  where unique existence is expressed by saying that a Σ type is a
-  singleton, as usual in univalent mathematics and homotopy type
-  theory. Notice the use of η-induction to avoid dealing directly with
-  the details of the constructions performed above.
-
-\begin{code}
-
-  module _
-          {𝓦 𝓣 : Universe}
-          (A : 𝓦 ̇ )
-          (_♯ᴬ_ : A → A → 𝓣 ̇ )
-          (♯ᴬa : is-apartness _♯ᴬ_)
-          (♯ᴬt : is-tight _♯ᴬ_)
-          (f : X → A)
-          (f-is-se : is-se _♯_ _♯ᴬ_ f)
-         where
-
-   private
-    A-is-set : is-set A
-    A-is-set = tight-is-set _♯ᴬ_ fe' ♯ᴬa ♯ᴬt
-
-    f-transforms-~-into-= : {x y : X} → x ~ y → f x ＝ f y
-    f-transforms-~-into-= = ♯ᴬt _ _ ∘ contrapositive (f-is-se _ _)
-
-   tr-lemma : (x' : X') → is-prop (Σ a ꞉ A , ∃ x ꞉ X , (η x ＝ x') × (f x ＝ a))
-   tr-lemma = η-induction _ p induction-step
-     where
-      p : (x' : X')
-        → is-prop (is-prop (Σ a ꞉ A , ∃ x ꞉ X , (η x ＝ x') × (f x ＝ a)))
-      p x' = being-prop-is-prop fe'
-
-      induction-step : (y : X)
-                     → is-prop (Σ a ꞉ A , ∃ x ꞉ X , (η x ＝ η y) × (f x ＝ a))
-      induction-step x (a , d) (b , e) = to-Σ-＝ (IV , ∥∥-is-prop _ _)
-       where
-        I : (Σ x' ꞉ X , (η x' ＝ η x) × (f x' ＝ a))
-          → (Σ y' ꞉ X , (η y' ＝ η x) × (f y' ＝ b))
-          → a ＝ b
-        I (x' , r , s) (y' , t , u) =
-         a    ＝⟨ s ⁻¹ ⟩
-         f x' ＝⟨ f-transforms-~-into-= III ⟩
-         f y' ＝⟨ u ⟩
-         b    ∎
-          where
-            II : η x' ＝ η y'
-            II = η x' ＝⟨ r ⟩
-                 η x  ＝⟨ t ⁻¹ ⟩
-                 η y' ∎
-
-            III : x' ~ y'
-            III = η-equal-gives-equiv II
-
-        IV : a ＝ b
-        IV = ∥∥-rec A-is-set (λ σ → ∥∥-rec A-is-set (I σ) e) d
-
-   tr-construction : (x' : X') → Σ a ꞉ A , ∃ x ꞉ X , (η x ＝ x') × (f x ＝ a)
-   tr-construction = η-induction _ tr-lemma induction-step
-    where
-     induction-step : (y : X) → Σ a ꞉ A , ∃ x ꞉ X , (η x ＝ η y) × (f x ＝ a)
-     induction-step x = f x , ∣ x , refl , refl ∣
-
-   mediating-map : X' → A
-   mediating-map x' = pr₁ (tr-construction x')
-
-   private
-    f⁻ = mediating-map
-
-   mediating-map-property : (y : X) → ∃ x ꞉ X , (η x ＝ η y) × (f x ＝ f⁻ (η y))
-   mediating-map-property y = pr₂ (tr-construction (η y))
-
-   mediating-triangle : f⁻ ∘ η ＝ f
-   mediating-triangle = dfunext fe' II
-    where
-     I : (y : X) → (Σ x ꞉ X , (η x ＝ η y) × (f x ＝ f⁻ (η y))) → f⁻ (η y) ＝ f y
-     I y (x , p , q) =
-      f⁻ (η y) ＝⟨ q ⁻¹ ⟩
-      f x      ＝⟨ f-transforms-~-into-= (η-equal-gives-equiv p) ⟩
-      f y      ∎
-
-     II : (y : X) → f⁻ (η y) ＝ f y
-     II y = ∥∥-rec A-is-set (I y) (mediating-map-property y)
-
-   private
-    c' : is-central
-           (Σ f⁻ ꞉ (X' → A) , (f⁻ ∘ η ＝ f))
-           (f⁻ , mediating-triangle)
-    c' (f⁺ , f⁺-triangle) = IV
-      where
-       I : f⁻ ∘ η ∼ f⁺ ∘ η
-       I = happly (f⁻ ∘ η  ＝⟨ mediating-triangle ⟩
-                   f       ＝⟨ f⁺-triangle ⁻¹ ⟩
-                   f⁺ ∘ η  ∎)
-
-       II : f⁻ ＝ f⁺
-       II = dfunext fe' (η-induction _ (λ _ → A-is-set) I)
-
-       triangle : f⁺ ∘ η ＝ f
-       triangle = transport (λ - → - ∘ η ＝ f) II mediating-triangle
-
-       III : triangle ＝ f⁺-triangle
-       III = Π-is-set fe' (λ _ → A-is-set) triangle f⁺-triangle
-
-       IV : (f⁻ , mediating-triangle) ＝ (f⁺ , f⁺-triangle)
-       IV = to-subtype-＝ (λ h → Π-is-set fe' (λ _ → A-is-set)) II
-
-   pre-tight-reflection : ∃! f⁻ ꞉ (X' → A) , (f⁻ ∘ η ＝ f)
-   pre-tight-reflection = (f⁻ , mediating-triangle) , c'
-
-   mediating-map-is-se : is-strongly-extensional _♯'_ _♯ᴬ_ f⁻
-   mediating-map-is-se = V
-    where
-     I : (x y : X) → f⁻ (η x) ♯ᴬ f⁻ (η y) → η x ♯' η y
-     I x y a = IV
-      where
-       II : f x ♯ᴬ f y
-       II = transport₂ (_♯ᴬ_)
-             (happly mediating-triangle x)
-             (happly mediating-triangle y) a
-
-       III : x ♯ y
-       III = f-is-se x y II
-
-       IV : η x ♯' η y
-       IV = η-preserves-apartness III
-
-     V : ∀ x' y' → f⁻ x' ♯ᴬ f⁻ y' → x' ♯' y'
-     V = η-induction (λ x' → (y' : X') → f⁻ x' ♯ᴬ f⁻ y' → x' ♯' y')
-           (λ x' → Π₂-is-prop fe' (λ y' _ → ♯'p x' y'))
-           (λ x → η-induction (λ y' → f⁻ (η x) ♯ᴬ f⁻ y' → η x ♯' y')
-                   (λ y' → Π-is-prop fe' (λ _ → ♯'p (η x) y'))
-                   (I x))
-
-   private
-    c : is-central
-         (Σ f⁻ ꞉ (X' → A) , (is-se _♯'_ _♯ᴬ_ f⁻) × (f⁻ ∘ η ＝ f))
-         (f⁻ , mediating-map-is-se , mediating-triangle)
-    c (f⁺ , f⁺-is-se , f⁺-triangle) =
-     to-subtype-＝
-       (λ h → ×-is-prop
-                (being-strongly-extensional-is-prop _♯'_ _♯ᴬ_ ♯'p h)
-                (Π-is-set fe' (λ _ → A-is-set)))
-       (ap pr₁ (c' (f⁺ , f⁺-triangle)))
-
-
-   tight-reflection : ∃! f⁻ ꞉ (X' → A)
-                            , (is-strongly-extensional _♯'_ _♯ᴬ_ f⁻)
-                            × (f⁻ ∘ η ＝ f)
-   tight-reflection = (f⁻ , mediating-map-is-se , mediating-triangle) , c
-
-\end{code}
-
-  The following is an immediate consequence of the tight reflection,
-  by the usual categorical argument, using the fact that the identity
-  map is strongly extensional (with the identity function as the
-  proof). Notice that our construction of the reflection produces a
-  result in a universe higher than those where the starting data are,
-  to avoid impredicativity (aka propositional resizing). Nevertheless,
-  the usual categorical argument is applicable.
-
-  A direct proof that doesn't rely on the tight reflection is equally
-  short in this case, and is also included.
-
-  What the following construction says is that if _♯_ is tight, then
-  any element of X is uniquely determined by the set of elements apart
-  from it.
-
-\begin{code}
-
-  tight-η-equiv-abstract-nonsense : is-tight _♯_ → X ≃ X'
-  tight-η-equiv-abstract-nonsense ♯t = η , (θ , happly p₄) , (θ , happly p₀)
-   where
-    u : ∃! θ ꞉ (X' → X), θ ∘ η ＝ id
-    u = pre-tight-reflection X _♯_ ♯a ♯t id (λ _ _ a → a)
-
-    v : ∃! ζ ꞉ (X' → X'), ζ ∘ η ＝ η
-    v = pre-tight-reflection X' _♯'_ ♯'a ♯'t η η-is-se
-
-    θ : X' → X
-    θ = ∃!-witness u
-
-    ζ : X' → X'
-    ζ = ∃!-witness v
-
-    φ : (ζ' : X' → X') → ζ' ∘ η ＝ η → ζ ＝ ζ'
-    φ ζ' p = ap pr₁ (∃!-uniqueness' v (ζ' , p))
-
-    p₀ : θ ∘ η ＝ id
-    p₀ = ∃!-is-witness u
-
-    p₁ : η ∘ θ ∘ η ＝ η
-    p₁ = ap (η ∘_) p₀
-
-    p₂ : ζ ＝ η ∘ θ
-    p₂ = φ (η ∘ θ) p₁
-
-    p₃ : ζ ＝ id
-    p₃ = φ id refl
-
-    p₄ = η ∘ θ ＝⟨ p₂ ⁻¹ ⟩
-         ζ     ＝⟨ p₃ ⟩
-         id    ∎
-
-  tight-η-equiv-direct : is-tight _♯_ → X ≃ X'
-  tight-η-equiv-direct t = (η , vv-equivs-are-equivs η cm)
-   where
-    lc : left-cancellable η
-    lc {x} {y} p = j h
-     where
-      j : ¬ (η x ♯' η y) → x ＝ y
-      j = t x y ∘ contrapositive (η-preserves-apartness {x} {y})
-
-      h : ¬ (η x ♯' η y)
-      h a = ♯'i (η y) (transport (λ - → - ♯' η y) p a)
-
-    e : is-embedding η
-    e = lc-maps-into-sets-are-embeddings η lc X'-is-set
-
-    cm : is-vv-equiv η
-    cm = surjective-embeddings-are-vv-equivs η e η-is-surjection
-
-\end{code}
-
-TODO.
-
-* The tight reflection has the universal property of the quotient by
-  _~_. Conversely, the quotient by _~_ gives the tight reflection.
-
-* The tight reflection of ♯₂ has the universal property of the totally
-  separated reflection.
diff --git a/source/TypeTopology/UniformSearch.lagda b/source/TypeTopology/UniformSearch.lagda
index 907caa5bf..15734e5f4 100644
--- a/source/TypeTopology/UniformSearch.lagda
+++ b/source/TypeTopology/UniformSearch.lagda
@@ -14,8 +14,6 @@ uniformly continuous predicates. In this module, we generalise this to types
 {-# OPTIONS --safe --without-K #-}
 
 open import MLTT.Spartan
-open import UF.Base
-open import TypeTopology.TotallySeparated
 open import TypeTopology.CompactTypes
 open import UF.FunExt
 
diff --git a/source/TypeTopology/WeaklyCompactTypes.lagda b/source/TypeTopology/WeaklyCompactTypes.lagda
index 12e5eabd5..ff33f7e25 100644
--- a/source/TypeTopology/WeaklyCompactTypes.lagda
+++ b/source/TypeTopology/WeaklyCompactTypes.lagda
@@ -10,7 +10,6 @@ the module CompactTypes for the strong notion.
 open import MLTT.Spartan
 
 open import CoNaturals.Type
-open import MLTT.Plus-Properties
 open import MLTT.Two-Properties
 open import Notation.Order
 open import Taboos.WLPO
@@ -37,7 +36,6 @@ private
  fe' {𝓤} {𝓥} = fe 𝓤 𝓥
 
 open PropositionalTruncation pt
-open import NotionsOfDecidability.Decidable
 open import NotionsOfDecidability.Complemented
 
 is-∃-compact : 𝓤 ̇ → 𝓤 ̇
diff --git a/source/TypeTopology/index.lagda b/source/TypeTopology/index.lagda
index cd6621d96..2f1b235fb 100644
--- a/source/TypeTopology/index.lagda
+++ b/source/TypeTopology/index.lagda
@@ -11,8 +11,9 @@ https://grossack.site/tags/life-in-the-topological-topos/
 module TypeTopology.index where
 
 import TypeTopology.ADecidableQuantificationOverTheNaturals
-import TypeTopology.AbsolutenessOfCompactness
-import TypeTopology.AbsolutenessOfCompactnessExample
+import TypeTopology.AbsolutenessOfCompactness -- by Andrew Swan
+import TypeTopology.AbsolutenessOfCompactnessExample -- by Andrew Swan
+import TypeTopology.Cantor
 import TypeTopology.CantorMinusPoint
 import TypeTopology.CantorSearch
 import TypeTopology.CompactTypes
diff --git a/source/UF/Choice.lagda b/source/UF/Choice.lagda
index 866a88750..8944b2224 100644
--- a/source/UF/Choice.lagda
+++ b/source/UF/Choice.lagda
@@ -38,14 +38,11 @@ choice where X is a proposition (see https://arxiv.org/abs/1610.03346).
 open import MLTT.Spartan
 open import UF.DiscreteAndSeparated
 open import UF.Base
-open import UF.Equiv
 open import UF.ClassicalLogic
 open import UF.FunExt
-open import UF.Hedberg
 open import UF.LeftCancellable
 open import UF.Powerset
 open import UF.PropTrunc
-open import UF.Retracts
 open import UF.Sets
 open import UF.Sets-Properties
 open import UF.Subsingletons
diff --git a/source/UF/ClassicalLogic.lagda b/source/UF/ClassicalLogic.lagda
index 7755b6748..6dd3d2081 100644
--- a/source/UF/ClassicalLogic.lagda
+++ b/source/UF/ClassicalLogic.lagda
@@ -18,14 +18,12 @@ module UF.ClassicalLogic where
 open import MLTT.Spartan
 
 open import UF.Base
-open import UF.Embeddings
 open import UF.Equiv
 open import UF.FunExt
 open import UF.PropTrunc
-
-open import UF.SubtypeClassifier
 open import UF.Subsingletons
 open import UF.Subsingletons-FunExt
+open import UF.SubtypeClassifier
 open import UF.UniverseEmbedding
 
 \end{code}
@@ -68,13 +66,37 @@ EM-gives-LEM em p = em (p holds) (holds-is-prop p)
 LEM-gives-EM : LEM 𝓤 → EM 𝓤
 LEM-gives-EM lem P i = lem (P , i)
 
+\end{code}
+
+Added by Martin Escardo and Tom de Jong 29th August 2024. Originally
+we worked with what is now called WEM'. But it turns out that it is
+not necessary to assume that P is a proposition, and so we now work
+with the new definition WEM, which removes this assumption.
+
+\begin{code}
+
+WEM' : ∀ 𝓤 → 𝓤 ⁺ ̇
+WEM' 𝓤 = (P : 𝓤 ̇ ) → is-prop P → ¬ P + ¬¬ P
+
 WEM : ∀ 𝓤 → 𝓤 ⁺ ̇
-WEM 𝓤 = (P : 𝓤 ̇ ) → is-prop P → ¬ P + ¬¬ P
+WEM 𝓤 = (P : 𝓤 ̇ ) → ¬ P + ¬¬ P
+
+WEM'-gives-WEM : funext 𝓤 𝓤₀ → WEM' 𝓤 → WEM 𝓤
+WEM'-gives-WEM fe wem' P =
+ Cases (wem' (¬ P) (negations-are-props fe)) inr (inl ∘ three-negations-imply-one)
+
+WEM-gives-WEM' : WEM 𝓤 → WEM' 𝓤
+WEM-gives-WEM' wem P P-is-prop = wem P
 
 WEM-is-prop : FunExt → is-prop (WEM 𝓤)
-WEM-is-prop {𝓤} fe = Π₂-is-prop (λ {𝓤} {𝓥} → fe 𝓤 𝓥)
-                      (λ _ _ → decidability-of-prop-is-prop (fe 𝓤 𝓤₀)
-                                (negations-are-props (fe 𝓤 𝓤₀)))
+WEM-is-prop {𝓤} fe = Π-is-prop (fe (𝓤 ⁺) 𝓤)
+                       (λ _ → decidability-of-prop-is-prop (fe 𝓤 𝓤₀)
+                               (negations-are-props (fe 𝓤 𝓤₀)))
+
+WEM'-is-prop : FunExt → is-prop (WEM' 𝓤)
+WEM'-is-prop {𝓤} fe = Π₂-is-prop (λ {𝓥} {𝓦} → fe 𝓥 𝓦)
+                       (λ _ _ → decidability-of-prop-is-prop (fe 𝓤 𝓤₀)
+                                 (negations-are-props (fe 𝓤 𝓤₀)))
 
 \end{code}
 
@@ -107,15 +129,17 @@ all-props-negative-gives-DNE {𝓤} fe ϕ P P-is-prop = I (ϕ P P-is-prop)
   I : (Σ Q ꞉ 𝓤 ̇ , (P ↔ ¬ Q)) → ¬¬ P → P
   I (Q , f , g) ν = g (three-negations-imply-one (double-contrapositive f ν))
 
-all-props-negative-gives-EM : funext 𝓤 𝓤₀
-                            → ((P : 𝓤 ̇ ) → is-prop P → Σ Q ꞉ 𝓤 ̇ , (P ↔ ¬ Q))
-                            → EM 𝓤
-all-props-negative-gives-EM {𝓤} fe ϕ = DNE-gives-EM fe
-                                        (all-props-negative-gives-DNE fe ϕ)
-
-fe-and-em-give-propositional-truncations : FunExt
-                                         → Excluded-Middle
-                                         → propositional-truncations-exist
+all-props-negative-gives-EM
+ : funext 𝓤 𝓤₀
+ → ((P : 𝓤 ̇ ) → is-prop P → Σ Q ꞉ 𝓤 ̇ , (P ↔ ¬ Q))
+ → EM 𝓤
+all-props-negative-gives-EM {𝓤} fe ϕ
+ = DNE-gives-EM fe (all-props-negative-gives-DNE fe ϕ)
+
+fe-and-em-give-propositional-truncations
+ : FunExt
+ → Excluded-Middle
+ → propositional-truncations-exist
 fe-and-em-give-propositional-truncations fe em =
  record {
   ∥_∥          = λ X → ¬¬ X ;
@@ -124,6 +148,15 @@ fe-and-em-give-propositional-truncations fe em =
   ∥∥-rec       = λ i u φ → EM-gives-DNE em _ i (¬¬-functor u φ)
   }
 
+\end{code}
+
+Like WEM, we don't need to assume that P and Q are propositions in the
+definition of De Morgan's Law (added by Martin Escardo and Tom de Jong
+29th August 2024). See below for a proof. But we begin with a
+definition that does.
+
+\begin{code}
+
 De-Morgan : ∀ 𝓤 → 𝓤 ⁺ ̇
 De-Morgan 𝓤 = (P Q : 𝓤 ̇ )
              → is-prop P
@@ -149,28 +182,44 @@ But already weak excluded middle gives De Morgan:
 non-contradiction : {X : 𝓤 ̇ } → ¬ (X × ¬ X)
 non-contradiction (x , ν) = ν x
 
-WEM-gives-De-Morgan : WEM 𝓤 → De-Morgan 𝓤
-WEM-gives-De-Morgan wem A B i j =
+De-Morgan' : ∀ 𝓤 → 𝓤 ⁺ ̇
+De-Morgan' 𝓤 = (P Q : 𝓤 ̇ ) → ¬ (P × Q) → ¬ P + ¬ Q
+
+De-Morgan'-gives-De-Morgan : De-Morgan' 𝓤 → De-Morgan 𝓤
+De-Morgan'-gives-De-Morgan d' P Q i j = d' P Q
+
+WEM-gives-De-Morgan' : WEM 𝓤 → De-Morgan' 𝓤
+WEM-gives-De-Morgan' wem A B =
  λ (ν : ¬ (A × B)) →
-      Cases (wem A i)
+      Cases (wem A)
        inl
        (λ (ϕ : ¬¬ A)
-             → Cases (wem B j)
+             → Cases (wem B)
                 inr
-                (λ (γ : ¬¬ B) → 𝟘-elim (ϕ (λ (a : A) → γ (λ (b : B) → ν (a , b))))))
+                (λ (γ : ¬¬ B) → 𝟘-elim
+                                 (ϕ (λ (a : A) → γ (λ (b : B) → ν (a , b))))))
+
+WEM-gives-De-Morgan : WEM 𝓤 → De-Morgan 𝓤
+WEM-gives-De-Morgan = De-Morgan'-gives-De-Morgan ∘ WEM-gives-De-Morgan'
 
 De-Morgan-gives-WEM : funext 𝓤 𝓤₀ → De-Morgan 𝓤 → WEM 𝓤
-De-Morgan-gives-WEM fe d P i = d P (¬ P) i (negations-are-props fe) non-contradiction
+De-Morgan-gives-WEM fe d =
+ WEM'-gives-WEM fe
+  (λ P i → d P (¬ P) i (negations-are-props fe) non-contradiction)
+
+De-Morgan-gives-De-Morgan' : funext 𝓤 𝓤₀ → De-Morgan 𝓤 → De-Morgan' 𝓤
+De-Morgan-gives-De-Morgan' fe = WEM-gives-De-Morgan' ∘ De-Morgan-gives-WEM fe
 
 \end{code}
 
-Is the above De Morgan Law a proposition? If it doesn't hold, it is
-vacuously a proposition. But if it does hold, it is not a
-proposition. We prove this by modifying any given δ : De-Mordan 𝓤 to a
-different δ' : De-Morgan 𝓤. Then we also consider a truncated version
-of De-Morgan that is a proposition and is logically equivalent to
-De-Morgan. So De-Morgan 𝓤 is not necessarily a proposition, but it
-always has split support (it has a proposition as a retract).
+Is the above untruncated De Morgan Law a proposition? Not in
+general. If it doesn't hold, it is vacuously a proposition. But if it
+does hold, it is not a proposition. We prove this by modifying any
+given δ : De-Mordan 𝓤 to a different δ' : De-Morgan 𝓤. Then we also
+consider a truncated version of De-Morgan that is a proposition and is
+logically equivalent to De-Morgan. So De-Morgan 𝓤 is not necessarily a
+proposition, but it always has split support (it has a proposition as
+a retract).
 
 \begin{code}
 
@@ -198,13 +247,13 @@ De-Morgan-is-not-prop {𝓤} fe δ = IV
   g P Q i j ν (inr _) _       _       = δ P Q i j ν
 
   δ' : De-Morgan 𝓤
-  δ' P Q i j ν = g P Q i j ν (wem P i) (wem Q j) (δ P Q i j ν)
+  δ' P Q i j ν = g P Q i j ν (wem P) (wem Q) (δ P Q i j ν)
 
-  I : (i : is-prop 𝟘) (h : ¬ 𝟘) → wem 𝟘 i ＝ inl h
-  I i h = I₀ (wem 𝟘 i) refl
+  I : (i : is-prop 𝟘) (h : ¬ 𝟘) → wem 𝟘 ＝ inl h
+  I i h = I₀ (wem 𝟘) refl
    where
-    I₀ : (a : ¬ 𝟘 + ¬¬ 𝟘) → wem 𝟘 i ＝ a → wem 𝟘 i ＝ inl h
-    I₀ (inl u) p = transport (λ - → wem 𝟘 i ＝ inl -) (negations-are-props fe u h) p
+    I₀ : (a : ¬ 𝟘 + ¬¬ 𝟘) → wem 𝟘 ＝ a → wem 𝟘 ＝ inl h
+    I₀ (inl u) p = transport (λ - → wem 𝟘 ＝ inl -) (negations-are-props fe u h) p
     I₀ (inr ϕ) p = 𝟘-elim (ϕ h)
 
   ν : ¬ (𝟘 × 𝟘)
@@ -246,46 +295,104 @@ De-Morgan-is-not-prop {𝓤} fe δ = IV
   IV : ¬ is-prop (De-Morgan 𝓤)
   IV i = III (i δ' δ)
 
+De-Morgan-curiousity : funext 𝓤 𝓤₀
+                     → ¬¬ is-prop (De-Morgan 𝓤)
+                     → is-prop (De-Morgan 𝓤)
+De-Morgan-curiousity fe =
+ De-Morgan-is-prop ∘ contrapositive (De-Morgan-is-not-prop fe)
+
 module _ (pt : propositional-truncations-exist) where
 
  open PropositionalTruncation pt
 
  truncated-De-Morgan : ∀ 𝓤 → 𝓤 ⁺ ̇
- truncated-De-Morgan 𝓤 = (P Q : 𝓤 ̇ )
-                       → is-prop P
-                       → is-prop Q
-                       → ¬ (P × Q) → ¬ P ∨ ¬ Q
+ truncated-De-Morgan 𝓤 = (P Q : 𝓤 ̇ ) → ¬ (P × Q) → ¬ P ∨ ¬ Q
+
+ truncated-De-Morgan' : ∀ 𝓤 → 𝓤 ⁺ ̇
+ truncated-De-Morgan' 𝓤 = (P Q : 𝓤 ̇ )
+                        → is-prop P
+                        → is-prop Q
+                        → ¬ (P × Q) → ¬ P ∨ ¬ Q
 
  truncated-De-Morgan-is-prop : FunExt → is-prop (truncated-De-Morgan 𝓤)
- truncated-De-Morgan-is-prop fe = Π₅-is-prop (λ {𝓤} {𝓥} → fe 𝓤 𝓥)
-                                   (λ P Q i j ν → ∨-is-prop)
+ truncated-De-Morgan-is-prop fe = Π₃-is-prop (λ {𝓤} {𝓥} → fe 𝓤 𝓥)
+                                   (λ P Q ν → ∨-is-prop)
+
+ truncated-De-Morgan'-is-prop : FunExt → is-prop (truncated-De-Morgan' 𝓤)
+ truncated-De-Morgan'-is-prop fe = Π₅-is-prop (λ {𝓤} {𝓥} → fe 𝓤 𝓥)
+                                    (λ P Q i j ν → ∨-is-prop)
 
- De-Morgan-gives-truncated-De-Morgan : De-Morgan 𝓤 → truncated-De-Morgan 𝓤
- De-Morgan-gives-truncated-De-Morgan d P Q i j ν = ∣ d P Q i j ν ∣
+ De-Morgan-gives-truncated-De-Morgan' : De-Morgan 𝓤 → truncated-De-Morgan' 𝓤
+ De-Morgan-gives-truncated-De-Morgan' d P Q i j ν = ∣ d P Q i j ν ∣
 
- truncated-De-Morgan-gives-WEM : FunExt → truncated-De-Morgan 𝓤 → WEM 𝓤
- truncated-De-Morgan-gives-WEM {𝓤} fe t P i = III
+ truncated-De-Morgan'-gives-WEM' : funext 𝓤 𝓤₀ → truncated-De-Morgan' 𝓤 → WEM' 𝓤
+ truncated-De-Morgan'-gives-WEM' {𝓤} fe t P i = III
   where
    I : ¬ (P × ¬ P) → ¬ P ∨ ¬¬ P
-   I = t P (¬ P) i (negations-are-props (fe 𝓤 𝓤₀))
+   I = t P (¬ P) i (negations-are-props fe)
 
    II : ¬ P ∨ ¬¬ P
    II = I non-contradiction
 
    III : ¬ P + ¬¬ P
    III = exit-∥∥
-          (decidability-of-prop-is-prop (fe 𝓤 𝓤₀)
-          (negations-are-props (fe 𝓤 𝓤₀)))
+          (decidability-of-prop-is-prop fe
+          (negations-are-props fe))
           II
 
- truncated-De-Morgan-gives-De-Morgan : FunExt → truncated-De-Morgan 𝓤 → De-Morgan 𝓤
- truncated-De-Morgan-gives-De-Morgan fe t P Q i j ν =
-  WEM-gives-De-Morgan (truncated-De-Morgan-gives-WEM fe t) P Q i j ν
+ truncated-De-Morgan'-gives-WEM : funext 𝓤 𝓤₀ → truncated-De-Morgan' 𝓤 → WEM 𝓤
+ truncated-De-Morgan'-gives-WEM {𝓤} fe =
+  WEM'-gives-WEM fe ∘ truncated-De-Morgan'-gives-WEM' fe
+
+ truncated-De-Morgan'-gives-De-Morgan : funext 𝓤 𝓤₀ → truncated-De-Morgan' 𝓤 → De-Morgan 𝓤
+ truncated-De-Morgan'-gives-De-Morgan fe t P Q i j ν =
+  WEM-gives-De-Morgan (truncated-De-Morgan'-gives-WEM fe t) P Q i j ν
+
+ truncated-De-Morgan-gives-truncated-De-Morgan'
+  : truncated-De-Morgan 𝓤
+  → truncated-De-Morgan' 𝓤
+ truncated-De-Morgan-gives-truncated-De-Morgan' d P Q i j = d P Q
+
+ truncated-De-Morgan'-gives-truncated-De-Morgan
+  : funext 𝓤 𝓤₀
+  → truncated-De-Morgan' 𝓤
+  → truncated-De-Morgan 𝓤
+ truncated-De-Morgan'-gives-truncated-De-Morgan {𝓤} fe d P Q ν
+  = ∣ WEM-gives-De-Morgan' (truncated-De-Morgan'-gives-WEM fe d) P Q ν ∣
 
 \end{code}
 
 The above shows that weak excluded middle, De Morgan and truncated De
-Morgan are logically equivalent (https://ncatlab.org/nlab/show/De%20Morgan%20laws).
+Morgan are logically equivalent, all in their two (primed and
+unprimed) versions, so in a total of six logically equivalent
+statements.
+
+That weak excluded middle and De Morgan are equivalent is long known
+and now part of the folklore. We don't know who proved this first,
+but, for example, it is in Johnstone's papers on topos theory and his
+Elephant two-volume book.
+
+Mike Shulman asked in the HoTT mailing list [1] whether untruncated De
+Morgan implies truncated De Morgan, and Martin Escardo offered a proof
+as an answer [2], which Mike Shulman added to the nLab [3].
+
+[1] Mike Shulman. de Morgan's Law.
+    https://groups.google.com/g/homotopytypetheory/c/Azq6GVU98II/m/qEp8TeInYgAJ
+    1st September 2014.
+
+[3] Martin Escardo. de Morgan's Law.
+    https://groups.google.com/g/homotopytypetheory/c/Azq6GVU98II/m/bXMixO9s1boJ
+    2nd September 2014
+
+[3] Added to the nLab by Mike Shulman.
+    https://ncatlab.org/nlab/show/De%20Morgan%20laws.
+    2nd September 2014
+
+Here we have added, to both WEM and De Morgan, truncated or not, the
+discussion of whether the types in question need to be propositions or
+not for them to be all equivalent, and the answer is that it doesn't
+matter whether we assume that the types in question are all
+propositions.
 
 \begin{code}
 
@@ -352,8 +459,6 @@ Added by Tom de Jong in August 2021.
 
 \begin{code}
 
-
-
  not-Π-not-implies-∃ : {X : 𝓤 ̇ } {A : X → 𝓥 ̇ }
                      → EM (𝓤 ⊔ 𝓥)
                      → ¬ ((x : X) → ¬ A x)
@@ -363,7 +468,6 @@ Added by Tom de Jong in August 2021.
     γ : ¬¬ (∃ A)
     γ g = f (λ x a → g ∣ x , a ∣)
 
- 
 \end{code}
 
 Added by Martin Escardo 26th April 2022.
@@ -384,4 +488,5 @@ Global-Choice'-gives-Global-Choice gc X = gc (X + ¬ X)
                                              (λ u → u (inr (λ p → u (inl p))))
 \end{code}
 
-Global choice contradicts univalence.
+TODO. Global choice contradicts univalence. This is already present in
+the directory MGS.
diff --git a/source/UF/Classifiers-Old.lagda b/source/UF/Classifiers-Old.lagda
index 6e1ec441a..f26a351cb 100644
--- a/source/UF/Classifiers-Old.lagda
+++ b/source/UF/Classifiers-Old.lagda
@@ -174,11 +174,11 @@ The examples are obtained by specialising to a specific property green:
 
  * A type is green exactly if it is inhabited.
    Then a map is green exactly if it is a surjection.
-   (Σ X ꞉ 𝓤 ̇ , (Σ f ꞉ X → Y , is-surjection f )) ≃ (Y → (Σ X ꞉ 𝓤 ̇  , ∥ X ∥))
+   (Σ X ꞉ 𝓤 ̇ , (Σ f ꞉ X → Y , is-surjection f )) ≃ (Y → (Σ X ꞉ 𝓤 ̇ , ∥ X ∥))
 
  * A type is green exactly if it is pointed.
    Then a map is green exactly if it is a retraction.
-   (Σ X ꞉ 𝓤 ̇ , Y ◁ X) ≃ (Y → (Σ X ꞉ 𝓤 ̇  , X))
+   (Σ X ꞉ 𝓤 ̇ , Y ◁ X) ≃ (Y → (Σ X ꞉ 𝓤 ̇ , X))
 
 \begin{code}
 
@@ -500,7 +500,7 @@ module pointed-classifier
  open general-classifier (univalence-gives-funext ua) fe' ua Y (λ (X : 𝓤 ̇ ) → X)
 
  pointed-classification-equivalence :
-  (Σ X ꞉ 𝓤 ̇ , Y ◁ X) ≃ (Y → (Σ X ꞉ 𝓤 ̇  , X))
+  (Σ X ꞉ 𝓤 ̇ , Y ◁ X) ≃ (Y → (Σ X ꞉ 𝓤 ̇ , X))
  pointed-classification-equivalence =
   (Σ X ꞉ 𝓤 ̇ , Y ◁ X)                                  ≃⟨ i ⟩
   (Σ X ꞉ 𝓤 ̇ , (Σ f ꞉ (X → Y) , ((y : Y) → fiber f y))) ≃⟨ ii ⟩
diff --git a/source/UF/ConnectedTypes.lagda b/source/UF/ConnectedTypes.lagda
new file mode 100644
index 000000000..ca998d999
--- /dev/null
+++ b/source/UF/ConnectedTypes.lagda
@@ -0,0 +1,209 @@
+Ian Ray, 23rd July 2024
+
+We define connected types and maps (recall our convention that H-levels start
+at 0). We then explore relationships, closure properties and characterizations
+of interest pertaining to the concept of connectedness.
+
+\begin{code}
+
+{-# OPTIONS --safe --without-K #-}
+
+open import UF.FunExt
+
+module UF.ConnectedTypes
+        (fe : Fun-Ext)
+       where
+                          
+open import MLTT.Spartan
+open import Naturals.Addition renaming (_+_ to _+'_)
+open import Naturals.Order
+open import UF.Equiv
+open import UF.EquivalenceExamples
+open import UF.H-Levels fe
+open import UF.PropTrunc 
+open import UF.Subsingletons
+open import UF.Subsingletons-FunExt
+open import UF.Truncations fe
+open import UF.Univalence
+
+\end{code}
+
+We now define the notion of k-connectedness for types and functions with respect
+to H-levels. TODO: show that connectedness as defined elsewhere in the library is
+a special case of k-connectedness. Connectedness typically means set connectedness,
+by our convention it will mean 2-connectedness.
+
+\begin{code}
+
+module connectedness (te : H-level-truncations-exist) where
+
+ private 
+  pt : propositional-truncations-exist
+  pt = H-level-truncations-give-propositional-truncations te
+
+ open H-level-truncations-exist te
+ open propositional-truncations-exist pt
+ open import UF.ImageAndSurjection pt
+
+ _is_connected : 𝓤 ̇ → ℕ → 𝓤 ̇
+ X is k connected = is-contr (∥ X ∥[ k ])
+
+ _is_connected-map : {X : 𝓤 ̇} {Y : 𝓥 ̇} → (f : X → Y) → ℕ → 𝓤 ⊔ 𝓥 ̇
+ f is k connected-map = each-fiber-of f (λ - → - is k connected)
+
+\end{code}
+
+We characterize 1-connected types as inhabited types and 1-connected maps as
+surjections.
+
+\begin{code}
+
+ inhabited-if-one-connected : {X : 𝓤 ̇}
+                            → X is 1 connected → ∥ X ∥
+ inhabited-if-one-connected X-1-conn = one-trunc-to-prop-trunc pt (center X-1-conn)
+
+ one-connected-if-inhabited : {X : 𝓤 ̇}
+                            → ∥ X ∥ → X is 1 connected
+ one-connected-if-inhabited x-anon =
+  pointed-props-are-singletons (prop-trunc-to-one-trunc pt x-anon) one-trunc-is-prop
+
+ one-connected-iff-inhabited : {X : 𝓤 ̇}
+                             → X is 1 connected ↔ ∥ X ∥
+ one-connected-iff-inhabited =
+  (inhabited-if-one-connected , one-connected-if-inhabited)
+
+ map-is-surj-if-one-connected : {X : 𝓤 ̇} {Y : 𝓥 ̇} {f : X → Y}
+                              → f is 1 connected-map → is-surjection f
+ map-is-surj-if-one-connected f-1-con y = inhabited-if-one-connected (f-1-con y)
+
+ map-is-one-connected-if-surj : {X : 𝓤 ̇} {Y : 𝓥 ̇} {f : X → Y}
+                              → is-surjection f → f is 1 connected-map
+ map-is-one-connected-if-surj f-is-surj y = one-connected-if-inhabited (f-is-surj y)
+
+ map-is-one-connected-iff-surj : {X : 𝓤 ̇} {Y : 𝓥 ̇} {f : X → Y}
+                               → f is 1 connected-map ↔ is-surjection f
+ map-is-one-connected-iff-surj =
+  (map-is-surj-if-one-connected , map-is-one-connected-if-surj)
+
+\end{code}
+
+We develop some closure conditions pertaining to connectedness. Connectedness
+is closed under equivalence as expected, but more importantly connectedness
+extends below: more precisely if a type is k connected then it is l connected
+for all l ≤ k. We provide a few incarnations of this fact below which may prove
+useful. 
+
+\begin{code}
+
+ connectedness-closed-under-equiv : {X : 𝓤 ̇} {Y : 𝓥 ̇} {k : ℕ}
+                                  → X ≃ Y
+                                  → Y is k connected
+                                  → X is k connected
+ connectedness-closed-under-equiv e Y-con =
+  equiv-to-singleton (truncation-closed-under-equiv e) Y-con
+
+ contractible-types-are-connected : {X : 𝓤 ̇} {k : ℕ}
+                                  → is-contr X
+                                  → X is k connected
+ contractible-types-are-connected {𝓤} {X} {k} (c , C) = ((∣ c ∣[ k ]) , C')
+  where
+   C' : (s : ∥ X ∥[ k ]) → (∣ c ∣[ k ]) ＝ s
+   C' = ∥∥ₙ-ind (hlevels-are-closed-under-id ∥∥ₙ-hlevel (∣ c ∣[ k ]))
+                (λ x → ap ∣_∣[ k ] (C x))
+
+ connectedness-is-lower-closed : {X : 𝓤 ̇} {k : ℕ}
+                               → X is (succ k) connected
+                               → X is k connected
+ connectedness-is-lower-closed {𝓤} {X} {k} X-succ-con =
+  equiv-to-singleton successive-truncations-equiv 
+                      (contractible-types-are-connected X-succ-con)
+
+ connectedness-is-lower-closed-+ : {X : 𝓤 ̇} {k l : ℕ}
+                                 → X is (l +' k) connected
+                                 → X is l connected
+ connectedness-is-lower-closed-+ {𝓤} {X} {0} {l} X-con = X-con
+ connectedness-is-lower-closed-+ {𝓤} {X} {succ k} {l} X-con =
+  connectedness-is-lower-closed-+ (connectedness-is-lower-closed X-con)
+
+ connectedness-is-lower-closed' : {X : 𝓤 ̇} {k l : ℕ}
+                                → (l ≤ℕ k)
+                                → X is k connected
+                                → X is l connected
+ connectedness-is-lower-closed' {𝓤} {X} {k} {l} o X-con =
+  connectedness-is-lower-closed-+ (transport (λ z → X is z connected) p X-con)
+  where
+   m : ℕ
+   m = pr₁ (subtraction l k o)
+   p = k        ＝⟨ pr₂ (subtraction l k o) ⁻¹ ⟩
+       m +' l   ＝⟨ addition-commutativity m l ⟩
+       l +' m   ∎
+
+\end{code}
+
+We characterize connected types in terms of inhabitedness and connectedness of
+the identity type at one level below. We will assume univalence only when necessary.
+
+\begin{code}
+
+ inhabited-if-connected : {X : 𝓤 ̇} {k : ℕ}
+                        → X is (succ k) connected → ∥ X ∥
+ inhabited-if-connected {_} {_} {k} X-conn =
+  inhabited-if-one-connected (connectedness-is-lower-closed' ⋆ X-conn)
+
+ _is-locally_connected : (X : 𝓤 ̇) (k : ℕ) → 𝓤  ̇
+ X is-locally k connected = (x y : X) → (x ＝ y) is k connected
+
+ connected-types-are-locally-connected : {X : 𝓤 ̇} {k : ℕ}
+                                       → is-univalent 𝓤
+                                       → X is (succ k) connected
+                                       → X is-locally k connected
+ connected-types-are-locally-connected {_} {_} {k} ua X-conn x y =
+  equiv-to-singleton (eliminated-trunc-identity-char ua)
+   (is-prop-implies-is-prop' (singletons-are-props X-conn)
+    ∣ x ∣[ succ k ] ∣ y ∣[ succ k ])
+
+ connected-types-are-inhabited-and-locally-connected : {X : 𝓤 ̇} {k : ℕ}
+                                                     → is-univalent 𝓤
+                                                     → X is (succ k) connected
+                                                     → ∥ X ∥
+                                                      × X is-locally k connected
+ connected-types-are-inhabited-and-locally-connected ua X-conn =
+  (inhabited-if-connected X-conn , connected-types-are-locally-connected ua X-conn)
+
+ inhabited-and-locally-connected-types-are-connected : {X : 𝓤 ̇} {k : ℕ}
+                                                     → is-univalent 𝓤
+                                                     → ∥ X ∥
+                                                      × X is-locally k connected
+                                                     → X is (succ k) connected
+ inhabited-and-locally-connected-types-are-connected
+  {_} {_} {0} ua (anon-x , id-conn) =
+  pointed-props-are-singletons (prop-trunc-to-one-trunc pt anon-x) one-trunc-is-prop
+ inhabited-and-locally-connected-types-are-connected
+  {_} {_} {succ k} ua (anon-x , id-conn) =
+  ∥∥-rec (being-singleton-is-prop fe)
+         (λ x → (∣ x ∣[ succ (succ k) ]
+          , ∥∥ₙ-ind (λ v → hlevels-are-upper-closed
+                            (λ p q → ∥∥ₙ-hlevel ∣ x ∣[ succ (succ k) ] v p q)) 
+                    (λ y → forth-trunc-id-char ua (center (id-conn x y)))))
+         anon-x
+
+ connected-characterization : {X : 𝓤 ̇} {k : ℕ}
+                            → is-univalent 𝓤
+                            → X is (succ k) connected
+                            ↔ ∥ X ∥ × X is-locally k connected
+ connected-characterization ua =
+  (connected-types-are-inhabited-and-locally-connected ua
+   , inhabited-and-locally-connected-types-are-connected ua)
+
+ ap-is-less-connected : {X : 𝓤 ̇} {Y : 𝓥 ̇} {k : ℕ} 
+                      → (ua : is-univalent (𝓤 ⊔ 𝓥))
+                      → (f : X → Y)
+                      → f is (succ k) connected-map
+                      → {x x' : X}
+                      → (ap f {x} {x'}) is k connected-map
+ ap-is-less-connected ua f f-conn {x} {x'} p =
+  equiv-to-singleton (truncation-closed-under-equiv (fiber-of-ap-≃ f p))
+   (connected-types-are-locally-connected ua (f-conn (f x'))
+    (x , p) (x' , refl))
+
+\end{code}
diff --git a/source/UF/DiscreteAndSeparated.lagda b/source/UF/DiscreteAndSeparated.lagda
index ab96da347..3051f5bc0 100644
--- a/source/UF/DiscreteAndSeparated.lagda
+++ b/source/UF/DiscreteAndSeparated.lagda
@@ -22,6 +22,7 @@ open import UF.Equiv
 open import UF.FunExt
 open import UF.Hedberg
 open import UF.HedbergApplications
+open import UF.PropTrunc
 open import UF.Retracts
 open import UF.Sets
 open import UF.SubtypeClassifier
@@ -76,8 +77,10 @@ props-are-discrete i x y = inl (i x y)
 
 ℕ-is-discrete : is-discrete ℕ
 ℕ-is-discrete 0 0 = inl refl
-ℕ-is-discrete 0 (succ n) = inr (λ (p : zero ＝ succ n) → positive-not-zero n (p ⁻¹))
-ℕ-is-discrete (succ m) 0 = inr (λ (p : succ m ＝ zero) → positive-not-zero m p)
+ℕ-is-discrete 0 (succ n) = inr (λ (p : zero ＝ succ n)
+                                     → positive-not-zero n (p ⁻¹))
+ℕ-is-discrete (succ m) 0 = inr (λ (p : succ m ＝ zero)
+                                     → positive-not-zero m p)
 ℕ-is-discrete (succ m) (succ n) =  step (ℕ-is-discrete m n)
   where
    step : (m ＝ n) + (m ≠ n) → (succ m ＝ succ n) + (succ m ≠ succ n)
@@ -124,16 +127,27 @@ General properties:
 \begin{code}
 
 discrete-types-are-cotransitive : {X : 𝓤 ̇ }
-                                → is-discrete X
-                                → {x y z : X}
-                                → x ≠ y
-                                → (x ≠ z) + (z ≠ y)
+                                 → is-discrete X
+                                 → {x y z : X}
+                                 → x ≠ y
+                                 → (x ≠ z) + (z ≠ y)
 discrete-types-are-cotransitive d {x} {y} {z} φ = f (d x z)
  where
   f : (x ＝ z) + (x ≠ z) → (x ≠ z) + (z ≠ y)
   f (inl r) = inr (λ s → φ (r ∙ s))
   f (inr γ) = inl γ
 
+discrete-types-are-cotransitive' : {X : 𝓤 ̇ }
+                                 → is-discrete X
+                                 → {x y z : X}
+                                 → x ≠ y
+                                 → (x ≠ z) + (y ≠ z)
+discrete-types-are-cotransitive' d {x} {y} {z} φ = f (d x z)
+ where
+  f : (x ＝ z) + (x ≠ z) → (x ≠ z) + (y ≠ z)
+  f (inl r) = inr (λ s → φ (r ∙ s ⁻¹))
+  f (inr γ) = inl γ
+
 retract-is-discrete : {X : 𝓤 ̇ } {Y : 𝓥 ̇ }
                     → retract Y of X → is-discrete X → is-discrete Y
 retract-is-discrete (f , (s , φ)) d y y' = g (d (s y) (s y'))
@@ -142,9 +156,14 @@ retract-is-discrete (f , (s , φ)) d y y' = g (d (s y) (s y'))
   g (inl p) = inl ((φ y) ⁻¹ ∙ ap f p ∙ φ y')
   g (inr u) = inr (contrapositive (ap s) u)
 
-𝟚-retract-of-non-trivial-type-with-isolated-point : {X : 𝓤 ̇ } {x₀ x₁ : X} → x₀ ≠ x₁
-                                                  → is-isolated x₀ → retract 𝟚 of X
-𝟚-retract-of-non-trivial-type-with-isolated-point {𝓤} {X} {x₀} {x₁} ne d = r , (s , rs)
+𝟚-retract-of-non-trivial-type-with-isolated-point
+ : {X : 𝓤 ̇ }
+   {x₀ x₁ : X}
+ → x₀ ≠ x₁
+ → is-isolated x₀
+ → retract 𝟚 of X
+𝟚-retract-of-non-trivial-type-with-isolated-point {𝓤} {X} {x₀} {x₁} ne d =
+  r , (s , rs)
  where
   r : X → 𝟚
   r = pr₁ (characteristic-function d)
@@ -157,7 +176,11 @@ retract-is-discrete (f , (s , φ)) d y y' = g (d (s y) (s y'))
   rs ₀ = different-from-₁-equal-₀ (λ p → pr₂ (φ x₀) p refl)
   rs ₁ = different-from-₀-equal-₁ λ p → 𝟘-elim (ne (pr₁ (φ x₁) p))
 
-𝟚-retract-of-discrete : {X : 𝓤 ̇ } {x₀ x₁ : X} → x₀ ≠ x₁ → is-discrete X → retract 𝟚 of X
+𝟚-retract-of-discrete : {X : 𝓤 ̇ }
+                        {x₀ x₁ : X}
+                      → x₀ ≠ x₁
+                      → is-discrete X
+                      → retract 𝟚 of X
 𝟚-retract-of-discrete {𝓤} {X} {x₀} {x₁} ne d = 𝟚-retract-of-non-trivial-type-with-isolated-point ne (d x₀)
 
 \end{code}
@@ -191,6 +214,9 @@ discrete-is-¬¬-separated d x y = ¬¬-elim (d x y)
 𝟚-is-¬¬-separated : is-¬¬-separated 𝟚
 𝟚-is-¬¬-separated = discrete-is-¬¬-separated 𝟚-is-discrete
 
+ℕ-is-¬¬-separated : is-¬¬-separated ℕ
+ℕ-is-¬¬-separated = discrete-is-¬¬-separated ℕ-is-discrete
+
 subtype-is-¬¬-separated : {X : 𝓤 ̇ } {Y : 𝓥 ̇ } (m : X → Y)
                                      → left-cancellable m
                                      → is-¬¬-separated Y
@@ -239,7 +265,7 @@ apart-is-cotransitive d f g h (x , φ)  = lemma₁ (lemma₀ φ)
 \end{code}
 
 We now consider two cases which render the apartness relation ♯ tight,
-assuming extensionality:
+assuming function extensionality:
 
 \begin{code}
 
@@ -260,7 +286,9 @@ tight fe s f g h = dfunext fe lemma₁
 tight' : {X : 𝓤 ̇ }
        → funext 𝓤 𝓥
        → {Y : X → 𝓥 ̇ }
-       → ((x : X) → is-discrete (Y x)) → (f g : (x : X) → Y x) → ¬ (f ♯ g) → f ＝ g
+       → ((x : X) → is-discrete (Y x))
+       → (f g : (x : X) → Y x)
+       → ¬ (f ♯ g) → f ＝ g
 tight' fe d = tight fe (λ x → discrete-is-¬¬-separated (d x))
 
 \end{code}
@@ -308,9 +336,12 @@ binary-sum-is-¬¬-separated {𝓤} {𝓥} {X} {Y} s t (inl x) (inl x') = lemma
   lemma : ¬¬ (inl x ＝ inl x') → inl x ＝ inl x'
   lemma = ap inl ∘ s x x' ∘ ¬¬-functor claim
 
-binary-sum-is-¬¬-separated s t (inl x) (inr y) =  λ φ → 𝟘-elim (φ +disjoint )
-binary-sum-is-¬¬-separated s t (inr y) (inl x)  = λ φ → 𝟘-elim (φ (+disjoint ∘ _⁻¹))
-binary-sum-is-¬¬-separated {𝓤} {𝓥} {X} {Y} s t (inr y) (inr y') = lemma
+binary-sum-is-¬¬-separated s t (inl x) (inr y) =
+ λ φ → 𝟘-elim (φ +disjoint )
+binary-sum-is-¬¬-separated s t (inr y) (inl x)  =
+ λ φ → 𝟘-elim (φ (+disjoint ∘ _⁻¹))
+binary-sum-is-¬¬-separated {𝓤} {𝓥} {X} {Y} s t (inr y) (inr y') =
+  lemma
  where
   claim : inr y ＝ inr y' → y ＝ y'
   claim = ap q
@@ -412,7 +443,8 @@ equality-of-¬¬stable-propositions fe pe p q f g a = γ
             → f ⊥ ＝ ₁
             → f ⊤ ＝ ₁
             → (p : Ω 𝓤) → f p ＝ ₁
-⊥-⊤-density fe pe f r s p = ⊥-⊤-Density fe pe f 𝟚-is-¬¬-separated (r ∙ s ⁻¹) p ∙ s
+⊥-⊤-density fe pe f r s p =
+ ⊥-⊤-Density fe pe f 𝟚-is-¬¬-separated (r ∙ s ⁻¹) p ∙ s
 
 \end{code}
 
@@ -445,7 +477,9 @@ Back to old stuff:
 
 \begin{code}
 
-＝-indicator :  (m : ℕ) → Σ p ꞉ (ℕ → 𝟚) , ((n : ℕ) → (p n ＝ ₀ → m ≠ n) × (p n ＝ ₁ → m ＝ n))
+＝-indicator : (m : ℕ)
+            → Σ p ꞉ (ℕ → 𝟚) , ((n : ℕ) → (p n ＝ ₀ → m ≠ n)
+                                       × (p n ＝ ₁ → m ＝ n))
 ＝-indicator m = co-characteristic-function (ℕ-is-discrete m)
 
 χ＝ : ℕ → ℕ → 𝟚
@@ -460,9 +494,13 @@ m ＝[ℕ] n = (χ＝ m n) ＝ ₁
 infix  30 _＝[ℕ]_
 
 ＝-agrees-with-＝[ℕ] : (m n : ℕ) → m ＝ n ↔ m ＝[ℕ] n
-＝-agrees-with-＝[ℕ] m n = (λ r → different-from-₀-equal-₁ (λ s → pr₁ (χ＝-spec m n) s r)) , pr₂ (χ＝-spec m n)
+＝-agrees-with-＝[ℕ] m n =
+ (λ r → different-from-₀-equal-₁ (λ s → pr₁ (χ＝-spec m n) s r)) ,
+ pr₂ (χ＝-spec m n)
 
-≠-indicator :  (m : ℕ) → Σ p ꞉ (ℕ → 𝟚) , ((n : ℕ) → (p n ＝ ₀ → m ＝ n) × (p n ＝ ₁ → m ≠ n))
+≠-indicator : (m : ℕ)
+            → Σ p ꞉ (ℕ → 𝟚) , ((n : ℕ) → (p n ＝ ₀ → m ＝ n)
+                                       × (p n ＝ ₁ → m ≠ n))
 ≠-indicator m = indicator (ℕ-is-discrete m)
 
 χ≠ : ℕ → ℕ → 𝟚
@@ -477,10 +515,14 @@ m ≠[ℕ] n = (χ≠ m n) ＝ ₁
 infix  30 _≠[ℕ]_
 
 ≠[ℕ]-agrees-with-≠ : (m n : ℕ) → m ≠[ℕ] n ↔ m ≠ n
-≠[ℕ]-agrees-with-≠ m n = pr₂ (χ≠-spec m n) , (λ d → different-from-₀-equal-₁ (contrapositive (pr₁ (χ≠-spec m n)) d))
+≠[ℕ]-agrees-with-≠ m n =
+ pr₂ (χ≠-spec m n) ,
+ (λ d → different-from-₀-equal-₁ (contrapositive (pr₁ (χ≠-spec m n)) d))
 
 \end{code}
 
+We now show that discrete types are sets (Hedberg's Theorem).
+
 \begin{code}
 
 decidable-types-are-collapsible : {X : 𝓤 ̇ } → is-decidable X → collapsible X
@@ -491,7 +533,8 @@ discrete-is-Id-collapsible : {X : 𝓤 ̇ } → is-discrete X → Id-collapsible
 discrete-is-Id-collapsible d = decidable-types-are-collapsible (d _ _)
 
 discrete-types-are-sets : {X : 𝓤 ̇ } → is-discrete X → is-set X
-discrete-types-are-sets d = Id-collapsibles-are-sets (discrete-is-Id-collapsible d)
+discrete-types-are-sets d =
+ Id-collapsibles-are-sets (discrete-is-Id-collapsible d)
 
 being-isolated-is-prop : FunExt → {X : 𝓤 ̇ } (x : X) → is-prop (is-isolated x)
 being-isolated-is-prop {𝓤} fe x = prop-criterion γ
@@ -509,7 +552,8 @@ being-isolated'-is-prop {𝓤} fe x = prop-criterion γ
   γ : is-isolated' x → is-prop (is-isolated' x)
   γ i = Π-is-prop (fe 𝓤 𝓤)
          (λ x → sum-of-contradictory-props
-                 (local-hedberg' _ (λ y → decidable-types-are-collapsible (i y)) x)
+                 (local-hedberg' _
+                   (λ y → decidable-types-are-collapsible (i y)) x)
                  (negations-are-props (fe 𝓤 𝓤₀))
                  (λ p n → n p))
 
@@ -646,12 +690,14 @@ Added 14th Feb 2020:
 
 \begin{code}
 
-discrete-exponential-has-decidable-emptiness-of-exponent : {X : 𝓤 ̇ } {Y : 𝓥 ̇ }
-                                                         → funext 𝓤 𝓥
-                                                         → (Σ y₀ ꞉ Y , Σ y₁ ꞉ Y , y₀ ≠ y₁)
-                                                         → is-discrete (X → Y)
-                                                         → is-decidable (is-empty X)
-discrete-exponential-has-decidable-emptiness-of-exponent {𝓤} {𝓥} {X} {Y} fe (y₀ , y₁ , ne) d = γ
+discrete-exponential-has-decidable-emptiness-of-exponent
+ : {X : 𝓤 ̇ } {Y : 𝓥 ̇ }
+ → funext 𝓤 𝓥
+ → (Σ y₀ ꞉ Y , Σ y₁ ꞉ Y , y₀ ≠ y₁)
+ → is-discrete (X → Y)
+ → is-decidable (is-empty X)
+discrete-exponential-has-decidable-emptiness-of-exponent
+  {𝓤} {𝓥} {X} {Y} fe (y₀ , y₁ , ne) d = γ
  where
   a : is-decidable ((λ _ → y₀) ＝ (λ _ → y₁))
   a = d (λ _ → y₀) (λ _ → y₁)
@@ -698,7 +744,7 @@ maps-of-props-into-isolated-points-are-embeddings f i j =
  maps-of-props-into-h-isolated-points-are-embeddings f i
   (λ p → isolated-is-h-isolated (f p) (j p))
 
-global-point-is-embedding : {X : 𝓤 ̇  } (f : 𝟙 {𝓥} → X)
+global-point-is-embedding : {X : 𝓤 ̇ } (f : 𝟙 {𝓥} → X)
                           → is-h-isolated (f ⋆)
                           → is-embedding f
 global-point-is-embedding f h =
@@ -714,10 +760,29 @@ Added 1st May 2024. Wrapper for use with instance arguments:
 
 \begin{code}
 
-data is-discrete' {𝓤 : Universe} (X : 𝓤 ̇ ) : 𝓤 ̇ where
- discrete-gives-discrete' : is-discrete X → is-discrete' X
+record is-discrete' {𝓤 : Universe} (X : 𝓤 ̇ ) : 𝓤 ̇ where
+ constructor
+  discrete-gives-discrete'
+ field
+  discrete'-gives-discrete : is-discrete X
 
-discrete'-gives-discrete : {X : 𝓤 ̇ } → is-discrete' X → is-discrete X
-discrete'-gives-discrete (discrete-gives-discrete' d) = d
+open is-discrete' {{...}} public
 
 \end{code}
+
+Added 21th August 2024 by Alice Laroche.
+
+\begin{code}
+
+module _ (pt : propositional-truncations-exist) where
+
+ open PropositionalTruncation pt
+
+ decidable-inhabited-types-are-pointed : {X : 𝓤 ̇} → ∥ X ∥ → is-decidable X → X
+ decidable-inhabited-types-are-pointed ∣x∣ (inl x)  = x
+ decidable-inhabited-types-are-pointed ∣x∣ (inr ¬x) =
+  𝟘-elim (∥∥-rec 𝟘-is-prop ¬x ∣x∣)
+
+\end{code}
+
+End of addition.
diff --git a/source/UF/Embeddings.lagda b/source/UF/Embeddings.lagda
index 341d676ef..8773b2a04 100644
--- a/source/UF/Embeddings.lagda
+++ b/source/UF/Embeddings.lagda
@@ -620,6 +620,19 @@ while the composite
 
 is an embedding, the evaluation map isn't.
 
+Added by Ian Ray 22nd August 2024
+
+\begin{code}
+
+equiv-embeds-into-function : {X : 𝓤 ̇ } {Y : 𝓥 ̇ }
+                           → FunExt
+                           → (X ≃ Y) ↪ (X → Y)
+equiv-embeds-into-function fe =
+ (⌜_⌝ , pr₁-is-embedding (λ f → being-equiv-is-prop fe f))
+
+\end{code}
+
+End of addition.
 
 Fixities:
 
diff --git a/source/UF/EquivalenceExamples.lagda b/source/UF/EquivalenceExamples.lagda
index eb210113a..2e38f1e12 100644
--- a/source/UF/EquivalenceExamples.lagda
+++ b/source/UF/EquivalenceExamples.lagda
@@ -15,7 +15,6 @@ open import UF.FunExt
 open import UF.Lower-FunExt
 open import UF.PropIndexedPiSigma
 open import UF.Retracts
-open import UF.SubtypeClassifier
 open import UF.Subsingletons
 open import UF.Subsingletons-FunExt
 open import UF.Subsingletons-Properties
@@ -1045,7 +1044,7 @@ Added 9 July 2024 by Tom de Jong.
 
 \begin{code}
 
-fiber-of-ap-≃' : {A : 𝓤 ̇  } {B : 𝓥 ̇  } (f : A → B)
+fiber-of-ap-≃' : {A : 𝓤 ̇ } {B : 𝓥 ̇ } (f : A → B)
                  {x y : A} (p : f x ＝ f y)
                → fiber (ap f) p ≃ ((x , refl) ＝[ fiber' f (f x) ] (y , p))
 fiber-of-ap-≃' f {x} {y} p =
@@ -1053,7 +1052,7 @@ fiber-of-ap-≃' f {x} {y} p =
  (Σ e ꞉ x ＝ y , transport (λ - → (f x ＝ f -)) e refl ＝ p) ≃⟨ ≃-sym Σ-＝-≃ ⟩
  ((x , refl) ＝ (y , p))                                     ■
 
-fiber-of-ap-≃ : {A : 𝓤 ̇  } {B : 𝓥 ̇  } (f : A → B)
+fiber-of-ap-≃ : {A : 𝓤 ̇ } {B : 𝓥 ̇ } (f : A → B)
                 {x y : A} (p : f x ＝ f y)
               → fiber (ap f) p ≃ ((x , p) ＝[ fiber f (f y) ] (y , refl))
 fiber-of-ap-≃ f {x} {y} p =
diff --git a/source/UF/FunExt-Properties.lagda b/source/UF/FunExt-Properties.lagda
index 16e3e5eb1..05a18d969 100644
--- a/source/UF/FunExt-Properties.lagda
+++ b/source/UF/FunExt-Properties.lagda
@@ -16,7 +16,6 @@ open import UF.Equiv-FunExt
 open import UF.Yoneda
 open import UF.Subsingletons
 open import UF.Retracts
-open import UF.EquivalenceExamples
 
 \end{code}
 
diff --git a/source/UF/FunExt-from-Naive-FunExt.lagda b/source/UF/FunExt-from-Naive-FunExt.lagda
index 0cee9095c..44884f977 100644
--- a/source/UF/FunExt-from-Naive-FunExt.lagda
+++ b/source/UF/FunExt-from-Naive-FunExt.lagda
@@ -23,7 +23,6 @@ open import MLTT.Spartan
 open import UF.Base
 open import UF.FunExt
 open import UF.Equiv
-open import UF.EquivalenceExamples
 open import UF.Equiv-FunExt
 open import UF.Yoneda
 open import UF.Subsingletons
diff --git a/source/UF/H-Levels.lagda b/source/UF/H-Levels.lagda
index 95aa5031a..99981a7aa 100644
--- a/source/UF/H-Levels.lagda
+++ b/source/UF/H-Levels.lagda
@@ -1,14 +1,16 @@
-Martin Escardo and Ian Ray, 06/02/2024
+Ian Ray, 2 June 2024
+
+Minor modifications by Tom de Jong on 4 September 2024
 
 We develop H-levels (a la Voevodsky). In Homotopy Type Theory there is a
-natural stratification of types defined inductively starting with contractible
-types and saying the an (n+1)-type has an identity type that is an n-type.
-Voevodsky introduced the notion of H-level where contractible types are at
-level n = 0. Alternatively, in book HoTT, truncated types are defined so that
-contractible types are at level k = -2. Of course, the two notions are
-equivalent as they are indexed by equivalent types, that is ℕ ≃ ℤ₋₂, but it is
-important to be aware of the fact that concepts are 'off by 2' when translating
-between conventions. 
+natural stratification of types defined inductively; with contractible
+types as the base and saying an (n+1)-type is a type whose identity types
+are all n-types. Voevodsky introduced the notion of H-level where contractible
+types are at level n = 0. Alternatively, in book HoTT, truncated types are
+defined so that contractible types are at level k = -2. Of course, the two
+notions are equivalent as they are indexed by equivalent types, that is
+ℕ ≃ ℤ₋₂, but it is important to be aware of the fact that concepts are 'off by
+2' when translating between conventions.
 
 In this file we will assume function extensionality globally but not univalence.
 The final result of the file will be proved in the local presence of univalence.
@@ -17,36 +19,67 @@ The final result of the file will be proved in the local presence of univalence.
 
 {-# OPTIONS --safe --without-K #-}
 
+open import UF.FunExt
+
+module UF.H-Levels (fe : Fun-Ext)
+                    where
+
 open import MLTT.Spartan
-open import UF.Base
+
+open import Naturals.Order
+
 open import UF.Embeddings
 open import UF.Equiv
 open import UF.EquivalenceExamples
-open import UF.Equiv-FunExt
-open import UF.FunExt
-open import UF.IdentitySystems
 open import UF.Retracts
-open import UF.Sets
 open import UF.Singleton-Properties
 open import UF.Subsingletons
 open import UF.Subsingletons-FunExt
 open import UF.Subsingletons-Properties
 open import UF.Univalence
-open import UF.UA-FunExt
-open import Naturals.Order
 
-module UF.H-Levels (fe : FunExt) (fe' : Fun-Ext) where
+private
+ fe' : FunExt
+ fe' 𝓤 𝓥 = fe {𝓤} {𝓥}
 
 _is-of-hlevel_ : 𝓤 ̇ → ℕ → 𝓤 ̇
-X is-of-hlevel zero = is-contr X
+X is-of-hlevel 0      = is-contr X
 X is-of-hlevel succ n = (x x' : X) → (x ＝ x') is-of-hlevel n
 
-hlevel-relation-is-prop : {𝓤 : Universe} (n : ℕ) (X : 𝓤 ̇ )
+hlevel-relation-is-prop : {𝓤 : Universe} {n : ℕ} {X : 𝓤 ̇ }
                         → is-prop (X is-of-hlevel n)
-hlevel-relation-is-prop {𝓤} zero X = being-singleton-is-prop (fe 𝓤 𝓤)
-hlevel-relation-is-prop {𝓤} (succ n) X =
-  Π₂-is-prop fe'
-             (λ x x' → hlevel-relation-is-prop n (x ＝ x'))
+hlevel-relation-is-prop {𝓤} {0} = being-singleton-is-prop fe
+hlevel-relation-is-prop {𝓤} {succ n} =
+  Π₂-is-prop fe (λ x x' → hlevel-relation-is-prop)
+
+map_is-of-hlevel_ : {X : 𝓤 ̇} {Y : 𝓥 ̇} → (f : X → Y) → ℕ → 𝓤 ⊔ 𝓥 ̇
+map f is-of-hlevel n = each-fiber-of f (λ - → - is-of-hlevel n)
+
+\end{code}
+
+Being of hlevel one is equivalent to being a proposition.
+
+\begin{code}
+
+is-prop' : (X : 𝓤 ̇) → 𝓤  ̇
+is-prop' X = X is-of-hlevel 1
+
+being-prop'-is-prop : (X : 𝓤 ̇) → is-prop (is-prop' X)
+being-prop'-is-prop X = hlevel-relation-is-prop
+
+is-prop-implies-is-prop' : {X : 𝓤 ̇} → is-prop X → is-prop' X
+is-prop-implies-is-prop' X-is-prop x x' =
+ pointed-props-are-singletons (X-is-prop x x') (props-are-sets X-is-prop)
+
+is-prop'-implies-is-prop : {X : 𝓤 ̇} → is-prop' X → is-prop X
+is-prop'-implies-is-prop X-is-prop' x x' = center (X-is-prop' x x')
+
+is-prop-equiv-is-prop' : {X : 𝓤 ̇} → is-prop X ≃ is-prop' X
+is-prop-equiv-is-prop' {𝓤} {X} =
+ logically-equivalent-props-are-equivalent (being-prop-is-prop fe)
+                                           (being-prop'-is-prop X)
+                                           is-prop-implies-is-prop'
+                                           is-prop'-implies-is-prop
 
 \end{code}
 
@@ -54,20 +87,22 @@ H-Levels are cumulative.
 
 \begin{code}
 
-hlevels-are-upper-closed : (n : ℕ) (X : 𝓤 ̇)
-                         → (X is-of-hlevel n)
-                         → (X is-of-hlevel succ n)
-hlevels-are-upper-closed zero X h-level = base h-level
- where
-  base : is-contr X → (x x' : X) → is-contr (x ＝ x')
-  base (c , C) x x' = (((C x)⁻¹ ∙ C x') , D)
-   where
-    D : is-central (x ＝ x') (C x ⁻¹ ∙ C x')
-    D refl = left-inverse (C x)
-hlevels-are-upper-closed (succ n) X h-level = step
- where
-  step : (x x' : X) (p q : x ＝ x') → (p ＝ q) is-of-hlevel n
-  step x x' p q = hlevels-are-upper-closed n (x ＝ x') (h-level x x') p q
+contr-implies-id-contr : {X : 𝓤 ̇} → is-contr X → is-prop' X
+contr-implies-id-contr = is-prop-implies-is-prop' ∘ singletons-are-props
+
+hlevels-are-upper-closed : {n : ℕ} {X : 𝓤 ̇ }
+                         → X is-of-hlevel n
+                         → X is-of-hlevel succ n
+hlevels-are-upper-closed {𝓤} {0} = contr-implies-id-contr
+hlevels-are-upper-closed {𝓤} {succ n} h-level x x' =
+ hlevels-are-upper-closed (h-level x x')
+
+hlevels-are-closed-under-id : {n : ℕ} {X : 𝓤 ̇ }
+                            → X is-of-hlevel n
+                            → (x x' : X) → (x ＝ x') is-of-hlevel n
+hlevels-are-closed-under-id {𝓤} {0} = contr-implies-id-contr
+hlevels-are-closed-under-id {𝓤} {succ n} X-hlev x x' =
+  hlevels-are-upper-closed (X-hlev x x')
 
 \end{code}
 
@@ -75,31 +110,20 @@ We will now give some closure results about H-levels.
 
 \begin{code}
 
-hlevel-closed-under-retract : (n : ℕ)
-                            → (X : 𝓤 ̇ ) (Y : 𝓥 ̇ )
+hlevel-closed-under-retract : {n : ℕ} {X : 𝓤 ̇ } {Y : 𝓥 ̇ }
                             → retract X of Y
                             → Y is-of-hlevel n
                             → X is-of-hlevel n
-hlevel-closed-under-retract zero X Y X-retract-Y Y-contr =
-  singleton-closed-under-retract X Y X-retract-Y Y-contr
-hlevel-closed-under-retract (succ n) X Y (r , s , H) Y-h-level x x' =
-  hlevel-closed-under-retract n (x ＝ x') (s x ＝ s x') retr
-                              (Y-h-level (s x) (s x'))
- where
-  t : (s x ＝ s x') → x ＝ x'
-  t q = H x ⁻¹ ∙ ap r q ∙ H x'
-  G : (p : x ＝ x') → H x ⁻¹ ∙ ap r (ap s p) ∙ H x' ＝ p
-  G refl = left-inverse (H x)
-  retr : retract x ＝ x' of (s x ＝ s x')
-  retr = (t , ap s , G)
-
-hlevel-closed-under-equiv : (n : ℕ)
-                          → (X : 𝓤 ̇ ) (Y : 𝓥 ̇ )
+hlevel-closed-under-retract {𝓤} {𝓥} {0} {X} {Y} X-retract-Y Y-contr =
+ singleton-closed-under-retract X Y X-retract-Y Y-contr
+hlevel-closed-under-retract {𝓤} {𝓥} {succ n} (r , s , H) Y-h-level x x' =
+ hlevel-closed-under-retract (＝-retract s (r , H) x x') (Y-h-level (s x) (s x'))
+
+hlevel-closed-under-equiv : {n : ℕ} {X : 𝓤 ̇ } {Y : 𝓥 ̇ }
                           → X ≃ Y
                           → Y is-of-hlevel n
                           → X is-of-hlevel n
-hlevel-closed-under-equiv n X Y e =
-  hlevel-closed-under-retract n X Y (≃-gives-◁ e)
+hlevel-closed-under-equiv e = hlevel-closed-under-retract (≃-gives-◁ e)
 
 \end{code}
 
@@ -107,17 +131,15 @@ We can prove closure under embeddings as a consequence of the previous result.
 
 \begin{code}
 
-hlevel-closed-under-embedding : (n : ℕ)
+hlevel-closed-under-embedding : {n : ℕ}
                               → 1 ≤ℕ n
-                              → (X : 𝓤 ̇ ) (Y : 𝓥 ̇ )
+                              → {X : 𝓤 ̇ } {Y : 𝓥 ̇ }
                               → X ↪ Y
                               → Y is-of-hlevel n
                               → X is-of-hlevel n
-hlevel-closed-under-embedding
-  (succ n) n-above-one X Y (e , is-emb) Y-h-level x x' =
-    hlevel-closed-under-equiv n (x ＝ x') (e x ＝ e x')
-                              (ap e , embedding-gives-embedding' e is-emb x x')
-                              (Y-h-level (e x) (e x'))
+hlevel-closed-under-embedding {𝓤} {𝓥} {succ n} _ (e , is-emb) Y-h-level x x' =
+ hlevel-closed-under-equiv (ap e , embedding-gives-embedding' e is-emb x x')
+                           (Y-h-level (e x) (e x'))
 
 \end{code}
 
@@ -125,32 +147,32 @@ Using closure under equivalence we can show closure under Σ and Π.
 
 \begin{code}
 
-hlevel-closed-under-Σ : (n : ℕ)
-                      → (X : 𝓤 ̇ ) (Y : X → 𝓤 ̇ )
+hlevel-closed-under-Σ : {n : ℕ} {X : 𝓤 ̇ } (Y : X → 𝓥 ̇ )
                       → X is-of-hlevel n
                       → ((x : X) → (Y x) is-of-hlevel n)
                       → (Σ Y) is-of-hlevel n
-hlevel-closed-under-Σ zero X Y l m = Σ-is-singleton l m
-hlevel-closed-under-Σ (succ n) X Y l m (x , y) (x' , y') =
-  hlevel-closed-under-equiv n ((x , y) ＝ (x' , y'))
-                            (Σ p ꞉ x ＝ x' , transport Y p y ＝ y') Σ-＝-≃
-                            (hlevel-closed-under-Σ n (x ＝ x')
-                                                   (λ p → transport Y p y ＝ y')
-                                                   (l x x')
-                                                   (λ p → m x'
-                                                            (transport Y p y)
-                                                            y'))
-
-hlevel-closed-under-Π : {𝓤 : Universe}
-                      → (n : ℕ)
-                      → (X : 𝓤 ̇ ) (Y : X → 𝓤 ̇ )
+hlevel-closed-under-Σ {𝓤} {𝓥} {0} Y l m = Σ-is-singleton l m
+hlevel-closed-under-Σ {𝓤} {𝓥} {succ n} Y l m (x , y) (x' , y') =
+ hlevel-closed-under-equiv Σ-＝-≃
+  (hlevel-closed-under-Σ
+   (λ p → transport Y p y ＝ y')
+   (l x x')
+   (λ p → m x' (transport Y p y) y'))
+
+hlevel-closed-under-Π : {n : ℕ} {X : 𝓤 ̇ } (Y : X → 𝓥 ̇ )
                       → ((x : X) → (Y x) is-of-hlevel n)
                       → (Π Y) is-of-hlevel n
-hlevel-closed-under-Π {𝓤} zero X Y m = Π-is-singleton (fe 𝓤 𝓤) m
-hlevel-closed-under-Π {𝓤} (succ n) X Y m f g =
-  hlevel-closed-under-equiv n (f ＝ g) (f ∼ g) (happly-≃ (fe 𝓤 𝓤))
-                            (hlevel-closed-under-Π n X (λ x → f x ＝ g x)
-                                                   (λ x → m x (f x) (g x)))
+hlevel-closed-under-Π {𝓤} {𝓥} {0} Y m = Π-is-singleton fe m
+hlevel-closed-under-Π {𝓤} {𝓥} {succ n} Y m f g =
+ hlevel-closed-under-equiv (happly-≃ fe)
+  (hlevel-closed-under-Π (λ x → f x ＝ g x)
+  (λ x → m x (f x) (g x)))
+
+hlevel-closed-under-→ : {n : ℕ} {X : 𝓤 ̇ } {Y : 𝓥 ̇ }
+                      → Y is-of-hlevel n
+                      → (X → Y) is-of-hlevel n
+hlevel-closed-under-→ {𝓤} {𝓥} {n} {X} {Y} m =
+ hlevel-closed-under-Π (λ - → Y) (λ - → m)
 
 \end{code}
 
@@ -163,108 +185,29 @@ The subuniverse of types of hlevel n is defined as follows.
 
 \end{code}
 
-Being of hlevel one is equivalent to being a proposition.
-We will quickly demonstrate this fact. 
+From univalence we can show that ℍ n is of level (n + 1), for all n : ℕ.
 
 \begin{code}
 
-is-prop' : (X : 𝓤 ̇) → 𝓤  ̇
-is-prop' X = X is-of-hlevel (succ zero)
-
-being-prop'-is-prop : (X : 𝓤 ̇) → is-prop (is-prop' X)
-being-prop'-is-prop X = hlevel-relation-is-prop (succ zero) X
-
-is-prop-implies-is-prop' : {X : 𝓤 ̇} → is-prop X → is-prop' X
-is-prop-implies-is-prop' X-is-prop x x' =
-  pointed-props-are-singletons (X-is-prop x x') (props-are-sets X-is-prop)
-
-is-prop'-implies-is-prop : {X : 𝓤 ̇} → is-prop' X → is-prop X
-is-prop'-implies-is-prop X-is-prop' x x' = center (X-is-prop' x x')
-
-is-prop-equiv-is-prop' : {𝓤 : Universe} {X :  𝓤 ̇} → is-prop X ≃ is-prop' X
-is-prop-equiv-is-prop' {𝓤} {X} =
-  logically-equivalent-props-are-equivalent (being-prop-is-prop (fe 𝓤 𝓤))
-                                            (being-prop'-is-prop X)
-                                            is-prop-implies-is-prop'
-                                            is-prop'-implies-is-prop
-
-\end{code}
-
-From Univalence we can show that (ℍ n) is of level (n + 1), for all n : ℕ.
+equiv-preserves-hlevel : {n : ℕ} {X : 𝓤 ̇ } {Y : 𝓥 ̇ }
+                       → X is-of-hlevel n
+                       → Y is-of-hlevel n
+                       → (X ≃ Y) is-of-hlevel n
+equiv-preserves-hlevel {𝓤} {𝓥} {0} = ≃-is-singleton fe'
+equiv-preserves-hlevel {𝓤} {𝓥} {succ n} {X} {Y} X-h-lev Y-h-lev =
+ hlevel-closed-under-embedding ⋆ (equiv-embeds-into-function fe')
+  (hlevel-closed-under-Π (λ _ → Y) (λ _ → Y-h-lev))
 
-\begin{code}
-
-ℍ-is-of-next-hlevel : (n : ℕ)
-                    → (𝓤 : Universe)
+ℍ-is-of-next-hlevel : {n : ℕ} {𝓤 : Universe}
                     → is-univalent 𝓤
                     → (ℍ n 𝓤) is-of-hlevel (succ n)
-ℍ-is-of-next-hlevel zero 𝓤 ua = C
+ℍ-is-of-next-hlevel ua (X , l) (Y , l') =
+ hlevel-closed-under-equiv I (equiv-preserves-hlevel l l')
  where
-  C : (X X' : ℍ zero 𝓤) → is-contr (X ＝ X')
-  C (X , X-is-contr) (X' , X'-is-contr) =
-    hlevel-closed-under-equiv zero ((X , X-is-contr) ＝ (X' , X'-is-contr))
-                              (X ≃ X') e C'
+  I = ((X , l) ＝ (Y , l')) ≃⟨ II ⟩
+       (X ＝ Y)             ≃⟨ univalence-≃ ua X Y ⟩
+       (X ≃ Y)              ■
    where
-    e = ((X , X-is-contr) ＝ (X' , X'-is-contr)) ≃⟨ ≃-sym (to-subtype-＝-≃
-                                                  (λ X → being-singleton-is-prop
-                                                         (fe 𝓤 𝓤))) ⟩
-        (X ＝ X')                                ≃⟨ univalence-≃ ua X X' ⟩
-        (X ≃ X')                                 ■
-    P : is-prop (X ≃ X')
-    P = ≃-is-prop fe (is-prop'-implies-is-prop
-                        (hlevels-are-upper-closed zero X' X'-is-contr))
-    C' : is-contr (X ≃ X')
-    C' = pointed-props-are-singletons (singleton-≃ X-is-contr X'-is-contr) P
-ℍ-is-of-next-hlevel (succ n) 𝓤 ua (X , l) (X' , l') =
-  hlevel-closed-under-equiv (succ n) ((X , l) ＝ (X' , l')) (X ≃ X') e
-      (hlevel-closed-under-embedding (succ n) ⋆ (X ≃ X') (X → X') e'
-                                     (hlevel-closed-under-Π (succ n) X
-                                                            (λ _ → X')
-                                                            (λ x x' → l' x')))
-  where
-   e = ((X , l) ＝ (X' , l')) ≃⟨ ≃-sym (to-subtype-＝-≃
-                                  (λ _ → Π-is-prop (fe 𝓤 𝓤)
-                                  (λ x → Π-is-prop (fe 𝓤 𝓤)
-                                  (λ x' → hlevel-relation-is-prop
-                                            n (x ＝ x'))))) ⟩
-       (X ＝ X')              ≃⟨ univalence-≃ ua X X' ⟩
-       (X ≃ X')               ■
-
-   e' : (X ≃ X') ↪ (X → X')
-   e' = (pr₁ , pr₁-is-embedding (λ f → being-equiv-is-prop fe f))
-
-\end{code}
-
-We now define the notion of a k-truncation using record types.
-
-\begin{code}
-
-record H-level-truncations-exist : 𝓤ω where
- field
-  ∣∣_∣∣_ : {𝓤 : Universe} → 𝓤 ̇ → ℕ → 𝓤 ̇
-  ∣∣∣∣-is-prop : {𝓤 : Universe} {X : 𝓤 ̇ } {n : ℕ} → is-prop (∣∣ X ∣∣ n)
-  ∣_∣_ :  {𝓤 : Universe} {X : 𝓤 ̇ } → X → (n : ℕ) → ∣∣ X ∣∣ n
-  ∣∣∣∣-rec : {𝓤 𝓥 : Universe} {X : 𝓤 ̇ } {Y : 𝓥 ̇ } {n : ℕ}
-           → Y is-of-hlevel n → (X → Y) → ∣∣ X ∣∣ n → Y
- infix 0 ∣∣_∣∣_
- infix 0 ∣_∣_
-
-\end{code}
-
-We now add the notion of k-connectedness of type and functions with respect to
-H-levels. We will then see that connectedness as defined elsewhere in the
-library is a special case
-
-\begin{code}
-
-module k-connectedness (te : H-level-truncations-exist) where
-
- open H-level-truncations-exist te
-
- _is_connected : 𝓤 ̇ → ℕ → 𝓤 ̇
- X is k connected = is-contr (∣∣ X ∣∣ k)
-
- map_is_connected : {X : 𝓤 ̇} {Y : 𝓥 ̇} → (f : X → Y) → ℕ → 𝓤 ⊔ 𝓥 ̇
- map f is k connected = (y : codomain f) → (fiber f y) is k connected
+    II = ≃-sym (to-subtype-＝-≃ (λ _ → hlevel-relation-is-prop))
 
 \end{code}
diff --git a/source/UF/HLevels.lagda b/source/UF/HLevels.lagda
index 0d7c12cbc..ee94d5c5f 100644
--- a/source/UF/HLevels.lagda
+++ b/source/UF/HLevels.lagda
@@ -1,5 +1,18 @@
 Martin Escardo, January 2019.
 
+--
+This module is deprecated. Instead use UF.H-Level by Ian Ray.
+
+TODO. Remove all uses of this module, and then delete it.
+
+What Ian Ray does is to (1) weaken assumptions of univalence to
+functionality, and (2) add more facts.
+
+For historical reference, we originally needed this for the injective
+types paper published in LMCS, where univalence is needed anyway. We
+wrote here quickly the bare minimum that was needed for that.
+--
+
 Minimal development of hlevels. For simplicity, for the moment we
 assume univalence globally, although it is not necessary. Our
 convention here is that propositions are at level zero (apologies).
@@ -15,7 +28,6 @@ module UF.HLevels (ua : Univalence) where
 
 open import UF.EquivalenceExamples
 open import UF.FunExt
-open import UF.Sets
 open import UF.Subsingletons
 open import UF.Subsingletons-FunExt
 open import UF.Subsingletons-Properties
diff --git a/source/UF/Hedberg.lagda b/source/UF/Hedberg.lagda
index 412a7a85c..986535c1e 100644
--- a/source/UF/Hedberg.lagda
+++ b/source/UF/Hedberg.lagda
@@ -1,6 +1,6 @@
-Martin Escardo
+Martin Escardo 2012.
 
-Based on
+Part of
 
  Kraus, N., Escardó, M., Coquand, T., Altenkirch, T.
  Generalizations of Hedberg’s Theorem.
@@ -82,8 +82,38 @@ Id-collapsibles-are-sets pc {x} = Id-collapsibles-are-h-isolated x pc
 
 \end{code}
 
-Here is an example. Any type that admits a prop-valued, reflexive and
-antisymmetric relation is a set.
+We also need the following symmetrical version of local Hedberg, which
+can be proved by reduction to the above (using the fact that
+collapsible types are closed under equivalence), but at this point we
+don't have the machinery at our disposal (which is developed in
+modules that depend on this one), and hence we prove it directly by
+symmetrizing the proof.
+
+\begin{code}
+
+local-hedberg' : {X : 𝓤 ̇ } (x : X)
+               → ((y : X) → collapsible (y ＝ x))
+               → (y : X) → is-prop (y ＝ x)
+local-hedberg' {𝓤} {X} x pc y p q =
+  p                     ＝⟨ c y p ⟩
+  f y p ∙ (f x refl)⁻¹  ＝⟨  ap (λ - → - ∙ (f x refl)⁻¹) (κ y p q) ⟩
+  f y q ∙ (f x refl)⁻¹  ＝⟨ (c y q)⁻¹ ⟩
+  q                     ∎
+ where
+  f : (y : X) → y ＝ x → y ＝ x
+  f y = pr₁ (pc y)
+
+  κ : (y : X) (p q : y ＝ x) → f y p ＝ f y q
+  κ y = pr₂ (pc y)
+
+  c : (y : X) (r : y ＝ x) → r ＝  f y r ∙ (f x refl)⁻¹
+  c _ refl = sym-is-inverse' (f x refl)
+
+\end{code}
+
+Here is an example (added some time after the pandemic, not sure
+when). Any type that admits a prop-valued, reflexive and antisymmetric
+relation is a set.
 
 \begin{code}
 
@@ -117,32 +147,3 @@ type-with-prop-valued-refl-antisym-rel-is-set
   γ = Id-collapsibles-are-sets (f , κ)
 
 \end{code}
-
-We also need the following symmetrical version of local Hedberg, which
-can be proved by reduction to the above (using the fact that
-collapsible types are closed under equivalence), but at this point we
-don't have the machinery at our disposal (which is developed in
-modules that depend on this one), and hence we prove it directly by
-symmetrizing the proof.
-
-\begin{code}
-
-local-hedberg' : {X : 𝓤 ̇ } (x : X)
-               → ((y : X) → collapsible (y ＝ x))
-               → (y : X) → is-prop (y ＝ x)
-local-hedberg' {𝓤} {X} x pc y p q =
-  p                     ＝⟨ c y p ⟩
-  f y p ∙ (f x refl)⁻¹  ＝⟨  ap (λ - → - ∙ (f x refl)⁻¹) (κ y p q) ⟩
-  f y q ∙ (f x refl)⁻¹  ＝⟨ (c y q)⁻¹ ⟩
-  q                     ∎
- where
-  f : (y : X) → y ＝ x → y ＝ x
-  f y = pr₁ (pc y)
-
-  κ : (y : X) (p q : y ＝ x) → f y p ＝ f y q
-  κ y = pr₂ (pc y)
-
-  c : (y : X) (r : y ＝ x) → r ＝  (f y r) ∙ (f x refl)⁻¹
-  c _ refl = sym-is-inverse' (f x refl)
-
-\end{code}
diff --git a/source/UF/Knapp-UA.lagda b/source/UF/Knapp-UA.lagda
index f6b85ceea..136fb53e8 100644
--- a/source/UF/Knapp-UA.lagda
+++ b/source/UF/Knapp-UA.lagda
@@ -17,8 +17,6 @@ module UF.Knapp-UA where
 
 open import MLTT.Spartan
 open import UF.Base
-open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 open import UF.Equiv
 open import UF.Equiv-FunExt
 open import UF.Univalence
diff --git a/source/UF/KrausLemma.lagda b/source/UF/KrausLemma.lagda
index 135050109..231af1072 100644
--- a/source/UF/KrausLemma.lagda
+++ b/source/UF/KrausLemma.lagda
@@ -32,20 +32,22 @@ key-insight : {X Y : 𝓤 ̇ } (f : X → Y)
             → {x : X} (p : x ＝ x) → ap f p ＝ refl
 key-insight f g p = key-lemma f g p ∙ (sym-is-inverse (g _ _))⁻¹
 
-transport-ids-along-ids : {X Y : 𝓤 ̇ }
-                          {x y : X}
-                          (p : x ＝ y)
-                          (h k : X → Y)
-                          (q : h x ＝ k x)
-                        → transport (λ - → h - ＝ k -) p q ＝ (ap h p)⁻¹ ∙ q ∙ ap k p
+transport-ids-along-ids
+ : {X Y : 𝓤 ̇ }
+   {x y : X}
+   (p : x ＝ y)
+   (h k : X → Y)
+   (q : h x ＝ k x)
+ → transport (λ - → h - ＝ k -) p q ＝ (ap h p)⁻¹ ∙ q ∙ ap k p
 transport-ids-along-ids refl h k q = refl-left-neutral ⁻¹
 
-transport-ids-along-ids' : {X : 𝓤 ̇ }
-                           {x : X}
-                           (p : x ＝ x)
-                           (f : X → X)
-                           (q : x ＝ f x)
-                         → transport (λ - → - ＝ f -) p q ＝ (p ⁻¹ ∙ q) ∙ ap f p
+transport-ids-along-ids'
+ : {X : 𝓤 ̇ }
+   {x : X}
+   (p : x ＝ x)
+   (f : X → X)
+   (q : x ＝ f x)
+ → transport (λ - → - ＝ f -) p q ＝ (p ⁻¹ ∙ q) ∙ ap f p
 transport-ids-along-ids' {𝓤} {X} {x} p f q = γ
  where
   g : x ＝ x → x ＝ f x
@@ -84,18 +86,27 @@ fix-is-prop {𝓤} {X} f g (x , p) (y , q) =
      q' = transport (λ - → - ＝ f -) s p'
 
      t : q' ＝ q
-     t = q'                        ＝⟨ transport-ids-along-ids' s f p' ⟩
-         (s ⁻¹ ∙ p') ∙ ap f s      ＝⟨ ∙assoc (s ⁻¹) p' (ap f s) ⟩
-         s ⁻¹ ∙ (p' ∙ ap f s)      ＝⟨ ap (λ - → s ⁻¹ ∙ (p' ∙ -)) (key-insight f g s) ⟩
-         s ⁻¹ ∙ (p' ∙ refl)        ＝⟨ ap (λ - → s ⁻¹ ∙ -) ((refl-right-neutral p')⁻¹) ⟩
+     t = q'                        ＝⟨ I ⟩
+         (s ⁻¹ ∙ p') ∙ ap f s      ＝⟨ II ⟩
+         s ⁻¹ ∙ (p' ∙ ap f s)      ＝⟨ III ⟩
+         s ⁻¹ ∙ (p' ∙ refl)        ＝⟨ IV ⟩
          s ⁻¹ ∙ p'                 ＝⟨ refl ⟩
-        (p' ∙ (q ⁻¹))⁻¹ ∙ p'       ＝⟨ ap (λ - → - ∙ p') ((⁻¹-contravariant p' (q ⁻¹))⁻¹) ⟩
-        ((q ⁻¹)⁻¹ ∙ (p' ⁻¹)) ∙ p'  ＝⟨ ap (λ - → (- ∙ (p' ⁻¹)) ∙ p') (⁻¹-involutive q) ⟩
-        (q ∙ (p' ⁻¹)) ∙ p'         ＝⟨ ∙assoc q (p' ⁻¹) p' ⟩
-         q ∙ ((p' ⁻¹) ∙ p')        ＝⟨ ap (λ - → q ∙ -) ((sym-is-inverse p')⁻¹) ⟩
-         q ∙ refl                  ＝⟨ (refl-right-neutral q)⁻¹ ⟩
+        (p' ∙ (q ⁻¹))⁻¹ ∙ p'       ＝⟨ V ⟩
+        ((q ⁻¹)⁻¹ ∙ (p' ⁻¹)) ∙ p'  ＝⟨ VI ⟩
+        (q ∙ (p' ⁻¹)) ∙ p'         ＝⟨ VII ⟩
+         q ∙ ((p' ⁻¹) ∙ p')        ＝⟨ VIII ⟩
+         q ∙ refl                  ＝⟨ IX ⟩
          q                         ∎
-
+          where
+           I    = transport-ids-along-ids' s f p'
+           II   = ∙assoc (s ⁻¹) p' (ap f s)
+           III  = ap (λ - → s ⁻¹ ∙ (p' ∙ -)) (key-insight f g s)
+           IV   = ap (λ - → s ⁻¹ ∙ -) ((refl-right-neutral p')⁻¹)
+           V    = ap (λ - → - ∙ p') ((⁻¹-contravariant p' (q ⁻¹))⁻¹)
+           VI   = ap (λ - → (- ∙ (p' ⁻¹)) ∙ p') (⁻¹-involutive q)
+           VII  = ∙assoc q (p' ⁻¹) p'
+           VIII = ap (λ - → q ∙ -) ((sym-is-inverse p')⁻¹)
+           IX   = (refl-right-neutral q)⁻¹
 \end{code}
 
 A main application is to show that, in pure spartan MLTT, if a type
@@ -106,6 +117,10 @@ has a wconstant endfunction then it has a propositional truncation.
 from-fix : {X : 𝓤 ̇ } (f : X → X) → fix f → X
 from-fix f = pr₁
 
+from-fix-is-fixed : {X : 𝓤 ̇ } (f : X → X) (φ : fix f)
+                  → from-fix f φ ＝ f (from-fix f φ)
+from-fix-is-fixed f = pr₂
+
 to-fix : {X : 𝓤 ̇ } (f : X → X) → wconstant f → X → fix f
 to-fix f g x = (f x , g x (f x))
 
@@ -171,6 +186,20 @@ equivalence?
    x : X
    x = from-fix f (g s)
 
+ exit-prop-trunc : {X : 𝓤 ̇ }
+                 → (f : X → X)
+                 → wconstant f
+                 → ∥ X ∥ → X
+ exit-prop-trunc f κ = collapsible-gives-split-support (f , κ)
+
+ exit-prop-trunc-is-fixed : {X : 𝓤 ̇ }
+                            (f : X → X)
+                            (κ : wconstant f)
+                            (s : ∥ X ∥)
+                          → f (exit-prop-trunc f κ s) ＝ exit-prop-trunc f κ s
+ exit-prop-trunc-is-fixed f κ s =
+  (from-fix-is-fixed f (∥∥-rec (fix-is-prop f κ) (to-fix f κ) s))⁻¹
+
  split-support-gives-collapsible : {X : 𝓤 ̇ }
                                  → has-split-support X
                                  → collapsible X
diff --git a/source/UF/Logic.lagda b/source/UF/Logic.lagda
index c01aff467..ede918d94 100644
--- a/source/UF/Logic.lagda
+++ b/source/UF/Logic.lagda
@@ -260,7 +260,7 @@ module Truncation (pt : propositional-truncations-exist) where
 
   open PropositionalTruncation pt
 
-  ∥_∥Ω : 𝓤 ̇  → Ω 𝓤
+  ∥_∥Ω : 𝓤 ̇ → Ω 𝓤
   ∥ A ∥Ω = ∥ A ∥ , ∥∥-is-prop
 
   ∥∥Ω-rec : {X : 𝓤  ̇} {P : Ω 𝓥} → (X → P holds) → ∥ X ∥ → P holds
diff --git a/source/UF/NotNotStablePropositions.lagda b/source/UF/NotNotStablePropositions.lagda
index 348e98c74..06468aea6 100644
--- a/source/UF/NotNotStablePropositions.lagda
+++ b/source/UF/NotNotStablePropositions.lagda
@@ -8,11 +8,6 @@ module UF.NotNotStablePropositions where
 
 open import MLTT.Spartan
 
-open import MLTT.Plus-Properties
-open import MLTT.Two-Properties
-open import Naturals.Properties
-open import NotionsOfDecidability.Complemented
-open import NotionsOfDecidability.Decidable
 open import UF.Base
 open import UF.DiscreteAndSeparated
 open import UF.Embeddings
@@ -79,8 +74,6 @@ Added 25 August 2023 by Martin Escardo from the former file UF.Miscelanea.
 
 \begin{code}
 
-open import UF.DiscreteAndSeparated
-open import UF.SubtypeClassifier
 
 decidable-types-are-¬¬-stable : {X : 𝓤 ̇ } → is-decidable X → ¬¬-stable X
 decidable-types-are-¬¬-stable (inl x) φ = x
diff --git a/source/UF/PairFun.lagda b/source/UF/PairFun.lagda
index c998a575e..7099b9aca 100644
--- a/source/UF/PairFun.lagda
+++ b/source/UF/PairFun.lagda
@@ -164,7 +164,7 @@ pair-fun-embedding (f , i) g = pair-fun f (λ x → ⌊ g x ⌋) ,
 
 
 pair-fun-is-embedding-special : {𝓤 𝓥 𝓦 : Universe}
-                                {X : 𝓤 ̇  } {Y : 𝓥 ̇  } {B : Y → 𝓦 ̇  }
+                                {X : 𝓤 ̇ } {Y : 𝓥 ̇ } {B : Y → 𝓦 ̇ }
                               → (f : X → Y)
                               → (g : (x : X) → B (f x))
                               → is-embedding f
diff --git a/source/UF/Powerset-Fin.lagda b/source/UF/Powerset-Fin.lagda
index 493372b97..8c232cf53 100644
--- a/source/UF/Powerset-Fin.lagda
+++ b/source/UF/Powerset-Fin.lagda
@@ -22,22 +22,19 @@ open import Fin.Type
 open import Fin.Kuratowski pt
 
 open import MLTT.List
+open import Notation.UnderlyingType
 open import OrderedTypes.JoinSemiLattices
 
 open import UF.Base
 open import UF.Equiv
 open import UF.EquivalenceExamples
 open import UF.FunExt
-open import UF.Classifiers
 open import UF.Lower-FunExt
 open import UF.ImageAndSurjection pt
 open import UF.Powerset
 open import UF.Sets
 open import UF.Sets-Properties
 open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
-open import UF.SubtypeClassifier
-open import UF.SubtypeClassifier-Properties
 
 open binary-unions-of-subsets pt
 
@@ -161,8 +158,9 @@ module _
         {X : 𝓤 ̇ }
        where
 
- ⟨_⟩ : 𝓚 X → 𝓟 X
- ⟨_⟩ = pr₁
+ instance
+  underlying-type-of-𝓚 : Underlying-Type (𝓚 X) (𝓟 X)
+  ⟨_⟩ {{underlying-type-of-𝓚}} (A , _) = A
 
  ⟨_⟩₂ : (A : 𝓚 X) → is-Kuratowski-finite-subset ⟨ A ⟩
  ⟨_⟩₂ = pr₂
diff --git a/source/UF/Powerset-Resizing.lagda b/source/UF/Powerset-Resizing.lagda
index d5806defc..f11e348c3 100644
--- a/source/UF/Powerset-Resizing.lagda
+++ b/source/UF/Powerset-Resizing.lagda
@@ -15,17 +15,10 @@ module UF.Powerset-Resizing
        where
 
 open import MLTT.Spartan
-open import UF.Equiv
-open import UF.Equiv-FunExt
-open import UF.FunExt
-open import UF.Lower-FunExt
+open import UF.Powerset
 open import UF.PropTrunc
 open import UF.Subsingletons
 open import UF.Subsingletons-FunExt
-open import UF.UA-FunExt
-open import UF.Univalence
-open import UF.Powerset
-open import UF.PropTrunc
 open import UF.SubtypeClassifier
 
 \end{code}
diff --git a/source/UF/PreSIP-Examples.lagda b/source/UF/PreSIP-Examples.lagda
index 472dfc2d5..dff78db0f 100644
--- a/source/UF/PreSIP-Examples.lagda
+++ b/source/UF/PreSIP-Examples.lagda
@@ -9,7 +9,6 @@ Modified from SIP-Examples. Only the examples we need are included for the momen
 module UF.PreSIP-Examples where
 
 open import MLTT.Spartan
-open import Notation.Order
 
 open import UF.Base
 open import UF.PreSIP
diff --git a/source/UF/PreUnivalence.lagda b/source/UF/PreUnivalence.lagda
index 1caa50f55..fab11efb4 100644
--- a/source/UF/PreUnivalence.lagda
+++ b/source/UF/PreUnivalence.lagda
@@ -16,7 +16,6 @@ axiom and the K axiom.
 module UF.PreUnivalence where
 
 open import MLTT.Spartan
-open import UF.Base
 open import UF.Embeddings
 open import UF.Equiv
 open import UF.Sets
diff --git a/source/UF/PropTrunc-Variation.lagda b/source/UF/PropTrunc-Variation.lagda
index 3de9c50ea..6cee3d99e 100644
--- a/source/UF/PropTrunc-Variation.lagda
+++ b/source/UF/PropTrunc-Variation.lagda
@@ -14,7 +14,6 @@ open import MLTT.Spartan
 module UF.PropTrunc-Variation (F : Universe → Universe) where
 
 open import MLTT.Plus-Properties
-open import UF.Base
 open import UF.Subsingletons
 open import UF.FunExt
 open import UF.Subsingletons-FunExt
diff --git a/source/UF/PropTrunc.lagda b/source/UF/PropTrunc.lagda
index f5413b88f..ccd4fa255 100644
--- a/source/UF/PropTrunc.lagda
+++ b/source/UF/PropTrunc.lagda
@@ -51,7 +51,6 @@ module PropositionalTruncation (pt : propositional-truncations-exist) where
    φ' : ∥ X ∥ → P s
    φ' = ∥∥-rec (i s) φ
 
-
  is-singleton'-is-prop : {X : 𝓤 ̇ } → funext 𝓤 𝓤 → is-prop (is-prop X × ∥ X ∥)
  is-singleton'-is-prop fe = Σ-is-prop (being-prop-is-prop fe) (λ _ → ∥∥-is-prop)
 
diff --git a/source/UF/Retracts-FunExt.lagda b/source/UF/Retracts-FunExt.lagda
index 32bfb2bea..bed6e74fe 100644
--- a/source/UF/Retracts-FunExt.lagda
+++ b/source/UF/Retracts-FunExt.lagda
@@ -5,7 +5,6 @@
 module UF.Retracts-FunExt where
 
 open import MLTT.Spartan
-open import UF.Base
 open import UF.Retracts
 open import UF.FunExt
 
diff --git a/source/UF/Retracts.lagda b/source/UF/Retracts.lagda
index 2d2cefa58..1962336e5 100644
--- a/source/UF/Retracts.lagda
+++ b/source/UF/Retracts.lagda
@@ -407,6 +407,22 @@ ap-of-section-is-section {𝓤} {𝓥} {X} {Y} s (r , rs) x x' = ρ , ρap
 
 \end{code}
 
+Added 8 August 2024 by Tom de Jong.
+
+\begin{code}
+
+＝-retract : {X : 𝓤 ̇ } {Y : 𝓥 ̇ } (s : X → Y)
+           → is-section s
+           → (x x' : X) → (x ＝ x') ◁ (s x ＝ s x')
+＝-retract s s-sect x x' = ρ , ap s , η
+ where
+  ρ : s x ＝ s x' → x ＝ x'
+  ρ = retraction-of (ap s) (ap-of-section-is-section s s-sect x x')
+  η : ρ ∘ ap s ∼ id
+  η = retraction-equation (ap s) (ap-of-section-is-section s s-sect x x')
+
+\end{code}
+
 Fixities:
 
 \begin{code}
diff --git a/source/UF/SIP-Examples.lagda b/source/UF/SIP-Examples.lagda
index c8bc5f741..05eb471c8 100644
--- a/source/UF/SIP-Examples.lagda
+++ b/source/UF/SIP-Examples.lagda
@@ -47,7 +47,6 @@ open import UF.Embeddings
 open import UF.Equiv hiding (_≅_)
 open import UF.EquivalenceExamples
 open import UF.FunExt
-open import UF.Retracts
 open import UF.SIP
 open import UF.Sets
 open import UF.Sets-Properties
diff --git a/source/UF/Section-Embedding.lagda b/source/UF/Section-Embedding.lagda
index 6309c7156..65242c8aa 100644
--- a/source/UF/Section-Embedding.lagda
+++ b/source/UF/Section-Embedding.lagda
@@ -12,14 +12,12 @@ https://lmcs.episciences.org/2027
 module UF.Section-Embedding where
 
 open import MLTT.Spartan
-open import UF.Base
 open import UF.Embeddings
 open import UF.Equiv
 open import UF.EquivalenceExamples
 open import UF.Hedberg
 open import UF.KrausLemma
 open import UF.PropTrunc
-open import UF.Retracts
 open import UF.Subsingletons
 
 splits : {X : 𝓤 ̇ } → (X → X) → (𝓥 : Universe) → 𝓤 ⊔ (𝓥 ⁺) ̇
diff --git a/source/UF/SetTrunc.lagda b/source/UF/SetTrunc.lagda
index b08d13e8b..1ad310fc5 100644
--- a/source/UF/SetTrunc.lagda
+++ b/source/UF/SetTrunc.lagda
@@ -8,7 +8,6 @@ module UF.SetTrunc where
 
 open import MLTT.Spartan
 open import UF.Sets
-open import UF.Subsingletons
 
 \end{code}
 
diff --git a/source/UF/Sets.lagda b/source/UF/Sets.lagda
index 7808b9a3a..8fd694a9c 100644
--- a/source/UF/Sets.lagda
+++ b/source/UF/Sets.lagda
@@ -10,7 +10,6 @@ module UF.Sets where
 
 open import MLTT.Plus-Properties
 open import MLTT.Spartan
-open import MLTT.Unit-Properties
 open import UF.Base
 open import UF.Subsingletons
 
diff --git a/source/UF/Singleton-Properties.lagda b/source/UF/Singleton-Properties.lagda
index 39d92f7a8..e07b1e69d 100644
--- a/source/UF/Singleton-Properties.lagda
+++ b/source/UF/Singleton-Properties.lagda
@@ -1,4 +1,4 @@
-Ian Ray, 07/02/2024
+Ian Ray, 7 February 2024
 
 Singleton Properties. Of course there are alot more we can add to this file.
 For now we will show that singletons are closed under retracts and Σ types.
@@ -9,7 +9,9 @@ For now we will show that singletons are closed under retracts and Σ types.
 
 open import MLTT.Spartan
 open import UF.Equiv
+open import UF.Equiv-FunExt
 open import UF.EquivalenceExamples
+open import UF.FunExt
 open import UF.Retracts
 open import UF.Subsingletons
 
@@ -24,7 +26,7 @@ singleton-closed-under-retract X Y (r , s , H) (c , C) = (r c , C')
   C' : is-central X (r c)
   C' x = r c      ＝⟨ ap r (C (s x)) ⟩
          r (s x)  ＝⟨ H x ⟩
-         x        ∎ 
+         x        ∎
 
 Σ-is-singleton : {X : 𝓤 ̇ } {A : X → 𝓥 ̇ }
                → is-singleton X
@@ -41,4 +43,13 @@ singleton-closed-under-retract X Y (r , s , H) (c , C) = (r c , C')
         center (h x)                     ＝⟨ centrality (h x) a ⟩
         a                                ∎
 
+≃-is-singleton : FunExt
+               → {X : 𝓤 ̇ } {Y : 𝓥 ̇ }
+               → is-singleton X
+               → is-singleton Y
+               → is-singleton (X ≃ Y)
+≃-is-singleton fe i j = pointed-props-are-singletons
+                         (singleton-≃ i j)
+                         (≃-is-prop fe (singletons-are-props j))
+
 \end{code}
diff --git a/source/UF/Size.lagda b/source/UF/Size.lagda
index e6d14bf6b..3c801a59b 100644
--- a/source/UF/Size.lagda
+++ b/source/UF/Size.lagda
@@ -214,7 +214,7 @@ being-small-is-prop {𝓤} ua X 𝓥 = c
            (≃-sym (Lift-is-universe-embedding 𝓥 X))
     a₁ = ≃-sym (univalence-≃ (ua (𝓤 ⊔ 𝓥)) _ _)
 
-  b : (Σ Y ꞉ 𝓥 ̇ , Y ≃ X) ≃ (Σ Y ꞉ 𝓥 ̇  , Lift 𝓤 Y ＝ Lift 𝓥 X)
+  b : (Σ Y ꞉ 𝓥 ̇ , Y ≃ X) ≃ (Σ Y ꞉ 𝓥 ̇ , Lift 𝓤 Y ＝ Lift 𝓥 X)
   b = Σ-cong a
 
   c : is-prop (Σ Y ꞉ 𝓥 ̇ , Y ≃ X)
@@ -260,7 +260,7 @@ prop-being-small-is-prop {𝓤} pe fe P i {𝓥} = c
     a₁ = ≃-sym (prop-univalent-≃
            (pe (𝓤 ⊔ 𝓥))(fe (𝓤 ⊔ 𝓥) (𝓤 ⊔ 𝓥)) (Lift 𝓤 Y) (Lift 𝓥 P) j)
 
-  b : (Σ Y ꞉ 𝓥 ̇ , Y ≃ P) ≃ (Σ Y ꞉ 𝓥 ̇  , Lift 𝓤 Y ＝ Lift 𝓥 P)
+  b : (Σ Y ꞉ 𝓥 ̇ , Y ≃ P) ≃ (Σ Y ꞉ 𝓥 ̇ , Lift 𝓤 Y ＝ Lift 𝓥 P)
   b = Σ-cong a
 
   c : is-prop (Σ Y ꞉ 𝓥 ̇ , Y ≃ P)
@@ -897,6 +897,15 @@ For example, by univalence, universes are locally small, and so is the
 
 \begin{code}
 
+universes-are-locally-small : is-univalent 𝓤 → is-locally-small (𝓤 ̇ )
+universes-are-locally-small ua X Y = (X ≃ Y) , ≃-sym (univalence-≃ ua X Y)
+
+\end{code}
+
+General machinery for dealing with local smallness:
+
+\begin{code}
+
 _＝⟦_⟧_ : {X : 𝓤 ⁺ ̇ } → X → is-locally-small X → X → 𝓤 ̇
 x ＝⟦ ls ⟧ y = resized (x ＝ y) (ls x y)
 
@@ -909,8 +918,8 @@ Id⟦ ls ⟧ x y = x ＝⟦ ls ⟧ y
 ＝-gives-＝⟦_⟧ : {X : 𝓤 ⁺ ̇ } (ls : is-locally-small X) {x y : X} → x ＝ y → x ＝⟦ ls ⟧ y
 ＝-gives-＝⟦ ls ⟧ {x} {y} = ⌜ resizing-condition (ls x y) ⌝⁻¹
 
-⟦_⟧-refl : {X : 𝓤 ⁺ ̇ } (ls : is-locally-small X) {x : X} → x ＝⟦ ls ⟧ x
-⟦ ls ⟧-refl {x} = ⌜ ≃-sym (resizing-condition (ls x x)) ⌝ refl
+＝⟦_⟧-refl : {X : 𝓤 ⁺ ̇ } (ls : is-locally-small X) {x : X} → x ＝⟦ ls ⟧ x
+＝⟦ ls ⟧-refl {x} = ⌜ ≃-sym (resizing-condition (ls x x)) ⌝ refl
 
 ＝⟦_⟧-sym : {X : 𝓤 ⁺ ̇ } (ls : is-locally-small X) → {x y : X} → x ＝⟦ ls ⟧ y → y ＝⟦ ls ⟧ x
 ＝⟦ ls ⟧-sym p = ＝-gives-＝⟦ ls ⟧ (＝⟦ ls ⟧-gives-＝ p ⁻¹)
@@ -918,6 +927,9 @@ Id⟦ ls ⟧ x y = x ＝⟦ ls ⟧ y
 _≠⟦_⟧_ : {X : 𝓤 ⁺ ̇ } → X → is-locally-small X → X → 𝓤 ̇
 x ≠⟦ ls ⟧ y = ¬ (x ＝⟦ ls ⟧ y)
 
+≠⟦_⟧-irrefl : {X : 𝓤 ⁺ ̇ } (ls : is-locally-small X) {x : X} → ¬ (x ≠⟦ ls ⟧ x)
+≠⟦ ls ⟧-irrefl {x} ν = ν ＝⟦ ls ⟧-refl
+
 ≠⟦_⟧-sym : {X : 𝓤 ⁺ ̇ } (ls : is-locally-small X) → {x y : X} → x ≠⟦ ls ⟧ y → y ≠⟦ ls ⟧ x
 ≠⟦ ls ⟧-sym {x} {y} n = λ (p : y ＝⟦ ls ⟧ x) → n (＝⟦ ls ⟧-sym p)
 
@@ -1031,7 +1043,7 @@ when adding set quotients as higher inductive types).
 
 \begin{code}
 
-_is-locally_small : 𝓤 ̇  → (𝓥 : Universe) → 𝓥 ⁺ ⊔ 𝓤 ̇
+_is-locally_small : 𝓤 ̇ → (𝓥 : Universe) → 𝓥 ⁺ ⊔ 𝓤 ̇
 X is-locally 𝓥 small = (x y : X) → (x ＝ y) is 𝓥 small
 
 module _ (pt : propositional-truncations-exist) where
@@ -1045,3 +1057,43 @@ module _ (pt : propositional-truncations-exist) where
                  → is-set Y
                  → image f is (𝓤 ⊔ 𝓥) small
 \end{code}
+
+Added by Ian Ray 11th September 2024
+
+If X is 𝓥-small then it is locally 𝓥-small.
+
+\begin{code}
+
+small-implies-locally-small : (X : 𝓤 ̇) → (𝓥 : Universe)
+                            → X is 𝓥 small
+                            → X is-locally 𝓥 small
+small-implies-locally-small X 𝓥 (Y , e) x x' =
+ ((⌜ e ⌝⁻¹ x ＝ ⌜ e ⌝⁻¹ x') , path-resized)
+ where
+  path-resized : (⌜ e ⌝⁻¹ x ＝ ⌜ e ⌝⁻¹ x') ≃ (x ＝ x')
+  path-resized = ≃-sym (ap ⌜ e ⌝⁻¹ , ap-is-equiv ⌜ e ⌝⁻¹ (⌜⌝⁻¹-is-equiv e))
+
+\end{code}
+
+Added by Martin Escardo and Tom de Jong 29th August 2024.
+
+\begin{code}
+
+WEM-gives-that-negated-types-are-small
+ : funext 𝓤 𝓤₀
+ → WEM 𝓤
+ → (X : 𝓤 ̇ ) → (¬ X) is 𝓥 small
+WEM-gives-that-negated-types-are-small {𝓤} {𝓥} fe wem X =
+ Cases (wem (¬ X)) f g
+ where
+  f : ¬¬ X → (¬ X) is 𝓥 small
+  f h = 𝟘 , ≃-sym (empty-≃-𝟘 h)
+
+  g : ¬¬¬ X → (¬ X) is 𝓥 small
+  g h = 𝟙 ,
+        singleton-≃-𝟙'
+         (pointed-props-are-singletons
+           (three-negations-imply-one h)
+           (negations-are-props fe))
+
+\end{code}
diff --git a/source/UF/SmallnessProperties.lagda b/source/UF/SmallnessProperties.lagda
index 77446cbab..402339ce7 100644
--- a/source/UF/SmallnessProperties.lagda
+++ b/source/UF/SmallnessProperties.lagda
@@ -16,12 +16,10 @@ open import NotionsOfDecidability.Decidable
 open import UF.Base
 open import UF.Embeddings
 open import UF.Equiv
-open import UF.Equiv-FunExt
 open import UF.EquivalenceExamples
 open import UF.FunExt
 open import UF.PropTrunc
 open import UF.Size
-open import UF.Subsingletons
 
 smallness-closed-under-≃ : {X : 𝓤 ̇ } {Y : 𝓥 ̇ }
                          → X is 𝓦 small
diff --git a/source/UF/StructureIdentityPrinciple.lagda b/source/UF/StructureIdentityPrinciple.lagda
index b0fc0c693..fc0786844 100644
--- a/source/UF/StructureIdentityPrinciple.lagda
+++ b/source/UF/StructureIdentityPrinciple.lagda
@@ -315,7 +315,6 @@ module ∞-magma (𝓤 : Universe) (ua : is-univalent 𝓤) where
 
  open import UF.FunExt
  open import UF.UA-FunExt
- open import UF.EquivalenceExamples
 
  fe : funext 𝓤 𝓤
  fe = univalence-gives-funext ua
diff --git a/source/UF/Subsingletons.lagda b/source/UF/Subsingletons.lagda
index e0d6c6884..2155a17a7 100644
--- a/source/UF/Subsingletons.lagda
+++ b/source/UF/Subsingletons.lagda
@@ -281,6 +281,9 @@ used in the following construction.
 𝟘-is-not-𝟙 : 𝟘 {𝓤} ≠ 𝟙 {𝓤}
 𝟘-is-not-𝟙 p = 𝟘-elim (Idtofun (p ⁻¹) ⋆)
 
+universe-has-two-distinct-points : has-two-distinct-points (𝓤 ̇ )
+universe-has-two-distinct-points = ((𝟘 , 𝟙) , 𝟘-is-not-𝟙)
+
 \end{code}
 
 Unique existence.
diff --git a/source/UF/SubtypeClassifier-Properties.lagda b/source/UF/SubtypeClassifier-Properties.lagda
index 974c01d69..e665ddcf0 100644
--- a/source/UF/SubtypeClassifier-Properties.lagda
+++ b/source/UF/SubtypeClassifier-Properties.lagda
@@ -17,7 +17,6 @@ open import UF.FunExt
 open import UF.Hedberg
 open import UF.Lower-FunExt
 open import UF.Sets
-open import UF.Sets-Properties
 open import UF.Subsingletons
 open import UF.Subsingletons-FunExt
 open import UF.SubtypeClassifier
diff --git a/source/UF/SubtypeClassifier.lagda b/source/UF/SubtypeClassifier.lagda
index c10a0409e..19fa043e7 100644
--- a/source/UF/SubtypeClassifier.lagda
+++ b/source/UF/SubtypeClassifier.lagda
@@ -10,6 +10,7 @@ notions and properties are in UF.SubtypeClassifier-Properties.
 module UF.SubtypeClassifier where
 
 open import MLTT.Spartan
+open import Notation.CanonicalMap
 open import UF.Base
 open import UF.Equiv
 open import UF.FunExt
@@ -24,6 +25,11 @@ open import UF.Subsingletons-FunExt
 _holds : Ω 𝓤 → 𝓤 ̇
 (P , i) holds = P
 
+module _ {𝓤 : Universe} where
+ instance
+  canonical-map-Ω-𝓤 : Canonical-Map (Ω 𝓤) (𝓤 ̇ )
+  ι {{canonical-map-Ω-𝓤}} = _holds
+
 holds-is-prop : (p : Ω 𝓤) → is-prop (p holds)
 holds-is-prop (P , i) = i
 
diff --git a/source/UF/TruncationLevels.lagda b/source/UF/TruncationLevels.lagda
new file mode 100644
index 000000000..fa1182e87
--- /dev/null
+++ b/source/UF/TruncationLevels.lagda
@@ -0,0 +1,81 @@
+Martin Escardo 11th September 2024
+
+The type ℕ₋₂ of integers ≥ -2, used for truncation levels.
+
+\begin{code}
+
+{-# OPTIONS --safe --without-K #-}
+
+module UF.TruncationLevels where
+
+open import MLTT.Spartan hiding (_+_)
+open import Naturals.Order
+open import Notation.Order
+open import Notation.Decimal
+
+data ℕ₋₂ : 𝓤₀ ̇ where
+ −2   : ℕ₋₂
+ succ : ℕ₋₂ → ℕ₋₂
+
+−1 : ℕ₋₂
+−1 = succ −2
+
+\end{code}
+
+Input "−2" in the emacs mode as "\minus 2" (and not as "-2").  And
+similarly for "−1". The two different unicode minus symbols look the
+same (good), but they are not the same (also good).
+
+The following allows us to write e.g. 3 as an element of ℕ₋₂.
+
+\begin{code}
+
+ℕ-to-ℕ₋₂ : (n : ℕ) {{_ : No-Constraint}} → ℕ₋₂
+ℕ-to-ℕ₋₂ 0              = succ −1
+ℕ-to-ℕ₋₂ (succ n) {{c}} = succ (ℕ-to-ℕ₋₂ n {{c}})
+
+instance
+ Decimal-ℕ-to-ℕ₋₂ : Decimal ℕ₋₂
+ Decimal-ℕ-to-ℕ₋₂ = make-decimal-with-no-constraint ℕ-to-ℕ₋₂
+
+\end{code}
+
+Examples.
+
+\begin{code}
+
+_ : ℕ₋₂
+_ = 3
+
+_ : succ (succ −2) ＝ 0
+_ = refl
+
+_ : succ −2 ＝ −1
+_ = refl
+
+\end{code}
+
+Addition of a natural number to an integer ≥ -2.
+
+\begin{code}
+
+_+_ : ℕ₋₂ → ℕ → ℕ₋₂
+n + 0        = n
+n + (succ m) = succ (n + m)
+
+\end{code}
+
+Order.
+
+\begin{code}
+
+_≤ℕ₋₂_ : ℕ₋₂ → ℕ₋₂ → 𝓤₀ ̇
+−2     ≤ℕ₋₂ n      = 𝟙
+succ m ≤ℕ₋₂ −2     = 𝟘
+succ m ≤ℕ₋₂ succ n = m ≤ℕ₋₂ n
+
+instance
+ Order-ℕ₋₂-ℕ₋₂ : Order ℕ₋₂ ℕ₋₂
+ _≤_ {{Order-ℕ₋₂-ℕ₋₂}} = _≤ℕ₋₂_
+
+\end{code}
diff --git a/source/UF/Truncations.lagda b/source/UF/Truncations.lagda
new file mode 100644
index 000000000..71b741ebe
--- /dev/null
+++ b/source/UF/Truncations.lagda
@@ -0,0 +1,447 @@
+Ian Ray, 23 July 2024
+
+Minor modifications by Tom de Jong on 4 September 2024
+
+Using records we define the general truncation of a type which will include
+a constructor, an induction principle and a computation rule
+(up to identification). We then proceed to develop some machinery derived from
+the induction principle and explore relationships, closure properties and finally
+characterize the identity type of truncations. Note that we explicitly include
+the assumption of univalence for the characterization of idenity types but not
+globally as many important properties hold in the absence of univalence.
+
+\begin{code}
+
+{-# OPTIONS --safe --without-K #-}
+
+open import UF.FunExt
+
+module UF.Truncations (fe : Fun-Ext)
+                       where
+
+open import MLTT.Spartan
+
+open import UF.Base
+open import UF.Equiv
+open import UF.H-Levels fe
+open import UF.PropTrunc
+open import UF.Sets
+open import UF.Subsingletons
+open import UF.Univalence
+open import UF.Yoneda
+
+\end{code}
+
+We define the notion of a n-truncation using record types.
+
+\begin{code}
+
+record H-level-truncations-exist : 𝓤ω where
+ field
+  ∥_∥[_] : 𝓤 ̇ → ℕ → 𝓤 ̇
+  ∥∥ₙ-hlevel : {X : 𝓤 ̇ } {n : ℕ} → ∥ X ∥[ n ] is-of-hlevel n
+  ∣_∣[_] :  {X : 𝓤 ̇ } → X → (n : ℕ) → ∥ X ∥[ n ]
+  ∥∥ₙ-ind : {X : 𝓤 ̇ } {n : ℕ} {P : ∥ X ∥[ n ] → 𝓥 ̇}
+          → ((s : ∥ X ∥[ n ]) → (P s) is-of-hlevel n)
+          → ((x : X) → P (∣ x ∣[ n ]))
+          → (s : ∥ X ∥[ n ]) → P s
+  ∥∥ₙ-ind-comp : {X : 𝓤 ̇ } {n : ℕ} {P : ∥ X ∥[ n ] → 𝓥 ̇ }
+               → (m : (s : ∥ X ∥[ n ]) → (P s) is-of-hlevel n)
+               → (g : (x : X) → P (∣ x ∣[ n ]))
+               → (x : X) → ∥∥ₙ-ind m g (∣ x ∣[ n ]) ＝ g x
+ infix 0 ∥_∥[_]
+ infix 0 ∣_∣[_]
+
+\end{code}
+
+We now add some some machinery that will prove useful: truncation recursion
+and uniqueness, induction/recursion for two arguments and all associated
+computation rules.
+
+\begin{code}
+
+ ∥∥ₙ-rec : {X : 𝓤 ̇ } {Y : 𝓥 ̇ } {n : ℕ}
+         → Y is-of-hlevel n
+         → (X → Y)
+         → ∥ X ∥[ n ] → Y
+ ∥∥ₙ-rec Y-h-level f s = ∥∥ₙ-ind (λ - → Y-h-level) f s
+
+ ∥∥ₙ-uniqueness : {X : 𝓤 ̇ } {Y : 𝓥 ̇ } {n : ℕ}
+                → Y is-of-hlevel n
+                → (f g : ∥ X ∥[ n ] → Y)
+                → ((x : X) → f (∣ x ∣[ n ]) ＝ g (∣ x ∣[ n ]))
+                → f ∼ g
+ ∥∥ₙ-uniqueness Y-h-lev f g =
+  ∥∥ₙ-ind (λ s → hlevels-are-closed-under-id Y-h-lev (f s) (g s))
+
+ ∥∥ₙ-rec-comp : {X : 𝓤 ̇ } {Y : 𝓥 ̇ } {n : ℕ}
+              → (m : Y is-of-hlevel n)
+              → (g : X → Y)
+              → (x : X) → ∥∥ₙ-rec m g ∣ x ∣[ n ] ＝ g x
+ ∥∥ₙ-rec-comp m = ∥∥ₙ-ind-comp (λ - → m)
+
+ ∥∥ₙ-rec₂ : {X : 𝓤 ̇ } {Y : 𝓥 ̇ } {Z : 𝓦 ̇ } {n : ℕ}
+          → Z is-of-hlevel n
+          → (X → Y → Z)
+          → ∥ X ∥[ n ] → ∥ Y ∥[ n ] → Z
+ ∥∥ₙ-rec₂ Z-h-level g = ∥∥ₙ-rec (hlevel-closed-under-→ Z-h-level)
+                                (λ x → ∥∥ₙ-rec Z-h-level (g x))
+
+ ∥∥ₙ-rec-comp₂ : {X : 𝓤 ̇ } {Y : 𝓥 ̇ } {Z : 𝓦 ̇ } {n : ℕ}
+               → (m : Z is-of-hlevel n)
+               → (g : X → Y → Z)
+               → (x : X) → (y : Y)
+               → ∥∥ₙ-rec₂ m g ∣ x ∣[ n ] ∣ y ∣[ n ] ＝ g x y
+ ∥∥ₙ-rec-comp₂ {𝓤} {𝓥} {𝓦} {X} {Y} {Z} {n} m g x y =
+  ∥∥ₙ-rec₂ m g ∣ x ∣[ n ] ∣ y ∣[ n ] ＝⟨ I ⟩
+  ∥∥ₙ-rec m (g x) ∣ y ∣[ n ] ＝⟨ ∥∥ₙ-rec-comp m (g x) y ⟩
+  g x y                              ∎
+   where
+    I = happly (∥∥ₙ-rec-comp (hlevel-closed-under-→ m)
+                (λ x → ∥∥ₙ-rec m (g x)) x)
+               ∣ y ∣[ n ]
+
+ abstract
+  ∥∥ₙ-ind₂ : {X : 𝓤 ̇ } {Y : 𝓥 ̇ } {n : ℕ}
+           → (P : ∥ X ∥[ n ] → ∥ Y ∥[ n ] → 𝓦 ̇)
+           → ((u : ∥ X ∥[ n ]) → (v : ∥ Y ∥[ n ]) → (P u v) is-of-hlevel n)
+           → ((x : X) → (y : Y) → P (∣ x ∣[ n ]) (∣ y ∣[ n ]))
+           → (u : ∥ X ∥[ n ]) → (v : ∥ Y ∥[ n ]) → P u v
+  ∥∥ₙ-ind₂ {𝓤} {𝓥} {𝓦} {X} {Y} {n} P P-h-level f =
+   ∥∥ₙ-ind (λ u → hlevel-closed-under-Π (P u) (P-h-level u))
+           (λ x → ∥∥ₙ-ind (λ v → P-h-level ∣ x ∣[ n ] v) (f x))
+  ∥∥ₙ-ind-comp₂ : {X : 𝓤 ̇ } {Y : 𝓥 ̇ } {n : ℕ}
+                → (P : ∥ X ∥[ n ] → ∥ Y ∥[ n ] → 𝓦 ̇)
+                → (m : (u : ∥ X ∥[ n ]) → (v : ∥ Y ∥[ n ])
+                 → (P u v) is-of-hlevel n)
+                → (g : (x : X) → (y : Y) → P (∣ x ∣[ n ]) (∣ y ∣[ n ]))
+                → (x : X) → (y : Y)
+                → ∥∥ₙ-ind₂ P m g ∣ x ∣[ n ] ∣ y ∣[ n ] ＝ g x y
+  ∥∥ₙ-ind-comp₂ {𝓤} {𝓥} {𝓦} {X} {Y} {n} P m g x y =
+   ∥∥ₙ-ind₂ P m g ∣ x ∣[ n ] ∣ y ∣[ n ]     ＝⟨ I ⟩
+   ∥∥ₙ-ind (m ∣ x ∣[ n ]) (g x) ∣ y ∣[ n ]  ＝⟨ II ⟩
+   g x y                                    ∎
+    where
+     I : ∥∥ₙ-ind₂ P m g ∣ x ∣[ n ] ∣ y ∣[ n ]
+       ＝ ∥∥ₙ-ind (m ∣ x ∣[ n ]) (g x) ∣ y ∣[ n ]
+     I = happly
+          (∥∥ₙ-ind-comp (λ u → hlevel-closed-under-Π (P u) (m u))
+           (λ x' → ∥∥ₙ-ind (m ∣ x' ∣[ n ]) (g x')) x)
+          ∣ y ∣[ n ]
+     II : ∥∥ₙ-ind (m ∣ x ∣[ n ]) (g x) ∣ y ∣[ n ] ＝ g x y
+     II = ∥∥ₙ-ind-comp (m ∣ x ∣[ n ]) (g x) y
+
+\end{code}
+
+We characterize the first couple levels of truncation (TODO: three-hlevel is a
+groupoid).
+
+\begin{code}
+
+ zero-trunc-is-contr : {X : 𝓤 ̇ } → is-contr (∥ X ∥[ 0 ])
+ zero-trunc-is-contr = ∥∥ₙ-hlevel
+
+ one-trunc-is-prop : {X : 𝓤 ̇ } → is-prop (∥ X ∥[ 1 ])
+ one-trunc-is-prop = is-prop'-implies-is-prop ∥∥ₙ-hlevel
+
+ two-trunc-is-set : {X : 𝓤 ̇ } → is-set (∥ X ∥[ 2 ])
+ two-trunc-is-set {𝓤} {X} {x} {y} =
+  is-prop'-implies-is-prop (∥∥ₙ-hlevel x y)
+
+\end{code}
+
+We demonstrate the equivalence of one-truncation and propositional truncation:
+ ∥ X ∥₁ ≃ ∥ X ∥
+
+\begin{code}
+
+ module _ (pt : propositional-truncations-exist)
+           where
+
+  open propositional-truncations-exist pt
+
+  one-trunc-to-prop-trunc : {X : 𝓤 ̇} → ∥ X ∥[ 1 ] → ∥ X ∥
+  one-trunc-to-prop-trunc = ∥∥ₙ-rec (is-prop-implies-is-prop' ∥∥-is-prop) ∣_∣
+
+  prop-trunc-to-one-trunc : {X : 𝓤 ̇} → ∥ X ∥ → ∥ X ∥[ 1 ]
+  prop-trunc-to-one-trunc = ∥∥-rec one-trunc-is-prop (∣_∣[ 1 ])
+
+  one-trunc-≃-prop-trunc : {X : 𝓤 ̇}
+                         → (∥ X ∥[ 1 ]) ≃ ∥ X ∥
+  one-trunc-≃-prop-trunc =
+   logically-equivalent-props-are-equivalent one-trunc-is-prop ∥∥-is-prop
+                                             one-trunc-to-prop-trunc
+                                             prop-trunc-to-one-trunc
+
+\end{code}
+
+We provide the canonical predecessor map and show truncations are closed under
+equivalence and successive applications of truncation (TODO: other closure
+conditions (?)).
+
+\begin{code}
+ canonical-pred-map : {X : 𝓤 ̇} {n : ℕ}
+                    → ∥ X ∥[ succ n ] → ∥ X ∥[ n ]
+ canonical-pred-map {𝓤} {X} {n} x =
+  ∥∥ₙ-rec (hlevels-are-upper-closed ∥∥ₙ-hlevel)
+          (λ x → ∣ x ∣[ n ]) x
+
+ canonical-pred-map-comp : {X : 𝓤 ̇} {n : ℕ} (x : X)
+                         → canonical-pred-map (∣ x ∣[ succ n ]) ＝ (∣ x ∣[ n ])
+ canonical-pred-map-comp {𝓤} {X} {n} x =
+  ∥∥ₙ-rec-comp (hlevels-are-upper-closed ∥∥ₙ-hlevel)
+               (λ _ → ∣ _ ∣[ n ]) x
+
+ to-∼-of-maps-with-truncated-domain : {X : 𝓤 ̇} {Y : 𝓥 ̇} {n : ℕ}
+                                    → (f g : ∥ X ∥[ n ] → Y)
+                                    → Y is-of-hlevel n
+                                    → ((x : X)
+                                          → f (∣ x ∣[ n ]) ＝ g (∣ x ∣[ n ]))
+                                    → f ∼ g
+ to-∼-of-maps-with-truncated-domain f g Y-hlev =
+  ∥∥ₙ-ind (λ - → hlevels-are-closed-under-id Y-hlev (f -) (g -))
+
+ to-∼-of-maps-between-truncated-types : {X : 𝓤 ̇} {Y : 𝓥 ̇} {n : ℕ}
+                                      → (f g : ∥ X ∥[ n ] → ∥ Y ∥[ n ])
+                                      → ((x : X)
+                                            → f (∣ x ∣[ n ]) ＝ g (∣ x ∣[ n ]))
+                                      → f ∼ g
+ to-∼-of-maps-between-truncated-types {𝓤} {𝓥} {X} {Y} {n} f g =
+  to-∼-of-maps-with-truncated-domain f g ∥∥ₙ-hlevel
+
+ truncation-closed-under-equiv : {X : 𝓤 ̇} {Y : 𝓥 ̇} {n : ℕ}
+                               → X ≃ Y
+                               → ∥ X ∥[ n ] ≃ ∥ Y ∥[ n ]
+ truncation-closed-under-equiv {𝓤} {𝓥} {X} {Y} {n} e = (f , (b , G) , (b , H))
+  where
+   f : ∥ X ∥[ n ] → ∥ Y ∥[ n ]
+   f = ∥∥ₙ-rec ∥∥ₙ-hlevel (λ x → ∣ ⌜ e ⌝ x ∣[ n ])
+   b : ∥ Y ∥[ n ] → ∥ X ∥[ n ]
+   b = ∥∥ₙ-rec ∥∥ₙ-hlevel (λ y → ∣ ⌜ e ⌝⁻¹ y ∣[ n ])
+   H : b ∘ f ∼ id
+   H = to-∼-of-maps-between-truncated-types (b ∘ f) id H'
+    where
+     H' : (x : X) → b (f (∣ x ∣[ n ])) ＝ (∣ x ∣[ n ])
+     H' x = b (f (∣ x ∣[ n ]))           ＝⟨ I ⟩
+            b (∣ ⌜ e ⌝ x ∣[ n ])         ＝⟨ II ⟩
+            (∣ ⌜ e ⌝⁻¹ (⌜ e ⌝ x) ∣[ n ]) ＝⟨ III ⟩
+            (∣ x ∣[ n ])                 ∎
+      where
+       I = ap b (∥∥ₙ-rec-comp ∥∥ₙ-hlevel (λ x → ∣ (⌜ e ⌝ x) ∣[ n ]) x)
+       II = ∥∥ₙ-rec-comp ∥∥ₙ-hlevel (λ y → ∣ (⌜ e ⌝⁻¹ y) ∣[ n ]) (⌜ e ⌝ x)
+       III = ap (λ x → ∣ x ∣[ n ]) (inverses-are-retractions' e x)
+   G : f ∘ b ∼ id
+   G = to-∼-of-maps-between-truncated-types (f ∘ b) id G'
+    where
+     G' : (y : Y) → f (b (∣ y ∣[ n ])) ＝ (∣ y ∣[ n ])
+     G' y = f (b (∣ y ∣[ n ]))           ＝⟨ I ⟩
+            f (∣ (⌜ e ⌝⁻¹ y) ∣[ n ])     ＝⟨ II ⟩
+            (∣ ⌜ e ⌝ (⌜ e ⌝⁻¹ y) ∣[ n ]) ＝⟨ III ⟩
+            (∣ y ∣[ n ])                 ∎
+      where
+       I = ap f (∥∥ₙ-rec-comp ∥∥ₙ-hlevel (λ y → ∣ (⌜ e ⌝⁻¹ y) ∣[ n ]) y)
+       II = ∥∥ₙ-rec-comp ∥∥ₙ-hlevel (λ x → ∣ ⌜ e ⌝ x ∣[ n ]) (⌜ e ⌝⁻¹ y)
+       III = ap (λ y → ∣ y ∣[ n ]) (inverses-are-sections' e y)
+
+ successive-truncations-equiv : {X : 𝓤 ̇} {n : ℕ}
+                              → (∥ X ∥[ n ]) ≃ (∥ (∥ X ∥[ succ n ]) ∥[ n ])
+ successive-truncations-equiv {𝓤} {X} {n} = (f , (b , G) , (b , H))
+  where
+   f : ∥ X ∥[ n ] → ∥ ∥ X ∥[ succ n ] ∥[ n ]
+   f = ∥∥ₙ-rec ∥∥ₙ-hlevel (λ x → ∣ ∣ x ∣[ succ n ] ∣[ n ])
+   b : ∥ ∥ X ∥[ succ n ] ∥[ n ] → ∥ X ∥[ n ]
+   b = ∥∥ₙ-rec ∥∥ₙ-hlevel canonical-pred-map
+   G : f ∘ b ∼ id
+   G = to-∼-of-maps-with-truncated-domain (f ∘ b) id ∥∥ₙ-hlevel
+        (to-∼-of-maps-with-truncated-domain
+          (f ∘ b ∘ ∣_∣[ n ])
+          ∣_∣[ n ]
+          (hlevels-are-upper-closed ∥∥ₙ-hlevel)
+          G')
+    where
+     G' : (x : X)
+        → f (b (∣ ∣ x ∣[ succ n ] ∣[ n ])) ＝ (∣ ∣ x ∣[ succ n ] ∣[ n ])
+     G' x = f (b (∣ ∣ x ∣[ succ n ] ∣[ n ]))         ＝⟨ I ⟩
+            f (canonical-pred-map (∣ x ∣[ succ n ])) ＝⟨ II ⟩
+            f (∣ x ∣[ n ])                           ＝⟨ III ⟩
+            (∣ ∣ x ∣[ succ n ] ∣[ n ])               ∎
+      where
+       I = ap f (∥∥ₙ-rec-comp ∥∥ₙ-hlevel canonical-pred-map
+                              (∣ x ∣[ succ n ]))
+       II = ap f (canonical-pred-map-comp x)
+       III = ∥∥ₙ-rec-comp ∥∥ₙ-hlevel (λ x → ∣ ∣ x ∣[ succ n ] ∣[ n ]) x
+   H : b ∘ f ∼ id
+   H = to-∼-of-maps-with-truncated-domain (b ∘ f) id ∥∥ₙ-hlevel H'
+    where
+     H' : (x : X) → b (f (∣ x ∣[ n ])) ＝ (∣ x ∣[ n ])
+     H' x = b (f (∣ x ∣[ n ]))                   ＝⟨ I ⟩
+            b (∣ ∣ x ∣[ succ n ] ∣[ n ])         ＝⟨ II ⟩
+            canonical-pred-map (∣ x ∣[ succ n ]) ＝⟨ canonical-pred-map-comp x ⟩
+            (∣ x ∣[ n ])                         ∎
+      where
+       I = ap b (∥∥ₙ-rec-comp ∥∥ₙ-hlevel (λ - → ∣ ∣ - ∣[ succ n ] ∣[ n ]) x)
+       II = ∥∥ₙ-rec-comp ∥∥ₙ-hlevel canonical-pred-map (∣ x ∣[ succ n ])
+
+\end{code}
+
+We now define an equivalence that characterizes the truncated identity type
+under the assumption of univalence. The following proof was inspired by
+the agda unimath library -- although the development there is more thorough --
+for details see: https://unimath.github.io/agda-unimath/foundation.truncations.
+
+\begin{code}
+
+ canonical-identity-trunc-map : {X : 𝓤 ̇} {x x' : X} {n : ℕ}
+                              → ∥ x ＝ x' ∥[ n ]
+                              → ∣ x ∣[ succ n ] ＝ ∣ x' ∣[ succ n ]
+ canonical-identity-trunc-map {𝓤} {X} {x} {x'} {n} =
+  ∥∥ₙ-rec (∥∥ₙ-hlevel ∣ x ∣[ succ n ] ∣ x' ∣[ succ n ])
+          (ap (λ x → ∣ x ∣[ (succ n) ]))
+
+ module _ {X : 𝓤 ̇} {n : ℕ}
+          (ua : is-univalent 𝓤) (x : X)
+           where
+
+  trunc-id-family : ∥ X ∥[ succ n ] → ℍ n 𝓤
+  trunc-id-family = ∥∥ₙ-rec (ℍ-is-of-next-hlevel ua)
+                            (λ x' → (∥ x ＝ x' ∥[ n ] , ∥∥ₙ-hlevel))
+
+  trunc-id-family-type : ∥ X ∥[ succ n ] → 𝓤 ̇
+  trunc-id-family-type = pr₁ ∘ trunc-id-family
+
+  trunc-id-family-level : (v : ∥ X ∥[ succ n ])
+                        → (trunc-id-family-type v) is-of-hlevel n
+  trunc-id-family-level = pr₂ ∘ trunc-id-family
+
+  trunc-id-family-computes : (x' : X)
+                           → trunc-id-family-type ∣ x' ∣[ succ n ]
+                             ＝ ∥ x ＝ x' ∥[ n ]
+  trunc-id-family-computes x' =
+    ap pr₁ (∥∥ₙ-rec-comp (ℍ-is-of-next-hlevel ua)
+                         (λ x' → (∥ x ＝ x' ∥[ n ] , ∥∥ₙ-hlevel))
+                         x')
+
+  trunc-id-forward-map : (x' : X)
+                       → trunc-id-family-type ∣ x' ∣[ succ n ]
+                       → ∥ x ＝ x' ∥[ n ]
+  trunc-id-forward-map x' = transport id (trunc-id-family-computes x')
+
+  trunc-id-backward-map : (x' : X)
+                        → ∥ x ＝ x' ∥[ n ]
+                        → trunc-id-family-type ∣ x' ∣[ succ n ]
+  trunc-id-backward-map x' = transport⁻¹ id (trunc-id-family-computes x')
+
+  trunc-id-back-is-retraction
+   : (x' : X)
+   → trunc-id-backward-map x' ∘ trunc-id-forward-map x' ∼ id
+  trunc-id-back-is-retraction x' q =
+   forth-and-back-transport (trunc-id-family-computes x')
+
+  refl-trunc-id-family : trunc-id-family-type ∣ x ∣[ succ n ]
+  refl-trunc-id-family = trunc-id-backward-map x ∣ refl ∣[ n ]
+
+  identity-on-trunc-to-family : (v : ∥ X ∥[ succ n ])
+                              → ∣ x ∣[ succ n ] ＝ v
+                              → trunc-id-family-type v
+  identity-on-trunc-to-family .(∣ x ∣[ succ n ]) refl = refl-trunc-id-family
+
+  trunc-id-family-is-identity-system : is-contr (Σ trunc-id-family-type)
+  trunc-id-family-is-identity-system =
+   ((∣ x ∣[ succ n ] , refl-trunc-id-family) , trunc-id-fam-is-central)
+   where
+    I : (x' : X) (p : x ＝ x')
+      → (∣ x ∣[ succ n ] , refl-trunc-id-family)
+       ＝[ Σ trunc-id-family-type ]
+        (∣ x' ∣[ succ n ] , trunc-id-backward-map x' ∣ p ∣[ n ])
+    I x' refl = refl
+
+    II : (x' : X) (q' : ∥ x ＝ x' ∥[ n ])
+       → (∣ x ∣[ succ n ] , refl-trunc-id-family)
+        ＝[ Σ trunc-id-family-type ]
+         (∣ x' ∣[ succ n ] , trunc-id-backward-map x' q')
+    II x' = ∥∥ₙ-ind (λ s → hlevel-closed-under-Σ
+                            trunc-id-family-type
+                            ∥∥ₙ-hlevel
+                            (λ v → hlevels-are-upper-closed
+                                    (trunc-id-family-level v))
+                            (∣ x ∣[ succ n ] , refl-trunc-id-family)
+                            (∣ x' ∣[ succ n ] , trunc-id-backward-map x' s))
+                      (I x')
+
+    III : (x' : X) (q : trunc-id-family-type ∣ x' ∣[ succ n ])
+        → (∣ x ∣[ succ n ] , refl-trunc-id-family)
+          ＝[ Σ trunc-id-family-type ]
+          (∣ x' ∣[ succ n ] , q)
+    III x' q = transport (λ - → (∣ x ∣[ succ n ] , refl-trunc-id-family)
+                                ＝[ Σ trunc-id-family-type ]
+                                (∣ x' ∣[ succ n ] , -))
+                         (trunc-id-back-is-retraction x' q)
+                         (II x' (trunc-id-forward-map x' q))
+
+    IV : (v : ∥ X ∥[ succ n ]) (q : trunc-id-family-type v)
+       → (∣ x ∣[ succ n ] , refl-trunc-id-family) ＝ (v , q)
+    IV =
+     ∥∥ₙ-ind
+      (λ s → hlevel-closed-under-Π
+              (λ q → (∣ x ∣[ succ n ] , refl-trunc-id-family) ＝ (s , q))
+              (λ q → hlevel-closed-under-Σ
+                      trunc-id-family-type
+                       (hlevels-are-upper-closed ∥∥ₙ-hlevel)
+                       (λ v → hlevels-are-upper-closed
+                               (hlevels-are-upper-closed
+                                 (trunc-id-family-level v)))
+                       (∣ x ∣[ succ n ] , refl-trunc-id-family)
+                       (s , q)))
+              III
+
+    trunc-id-fam-is-central : is-central (Σ trunc-id-family-type)
+                                         (∣ x ∣[ succ n ] , refl-trunc-id-family)
+    trunc-id-fam-is-central (v , q) = IV v q
+
+ trunc-identity-characterization : {X : 𝓤 ̇} {n : ℕ}
+                                 → (ua : is-univalent 𝓤)
+                                 → (x : X) (v : ∥ X ∥[ succ n ])
+                                 → (∣ x ∣[ succ n ] ＝ v)
+                                 ≃ trunc-id-family-type ua x v
+ trunc-identity-characterization {𝓤} {X} {n} ua x v =
+  (identity-on-trunc-to-family ua x v ,
+   Yoneda-Theorem-forth ∣ x ∣[ succ n ]
+    (identity-on-trunc-to-family ua x)
+    (trunc-id-family-is-identity-system ua x) v)
+
+ eliminated-trunc-identity-char : {X : 𝓤 ̇} {x x' : X} {n : ℕ}
+                                → (ua : is-univalent 𝓤)
+                                → ∥ x ＝ x' ∥[ n ]
+                                ≃ (∣ x ∣[ succ n ] ＝ ∣ x' ∣[ succ n ])
+ eliminated-trunc-identity-char {𝓤} {X} {x} {x'} {n} ua =
+  ≃-comp (idtoeq ∥ x ＝ x' ∥[ n ]
+                 (trunc-id-family-type ua x ∣ x' ∣[ succ n ])
+                 (trunc-id-family-computes ua x x' ⁻¹))
+         (≃-sym (trunc-identity-characterization ua x ∣ x' ∣[ succ n ]))
+
+ forth-trunc-id-char : {X : 𝓤 ̇} {x x' : X} {n : ℕ}
+                     → (ua : is-univalent 𝓤)
+                     → ∥ x ＝ x' ∥[ n ]
+                     → (∣ x ∣[ succ n ] ＝ ∣ x' ∣[ succ n ])
+ forth-trunc-id-char ua = ⌜ eliminated-trunc-identity-char ua ⌝
+
+\end{code}
+
+We show that the existence of propositional truncation follows from the existence
+of general truncations. Notice this implication manifests as a function between
+record types.
+
+\begin{code}
+
+H-level-truncations-give-propositional-truncations : H-level-truncations-exist
+                                                   → propositional-truncations-exist
+H-level-truncations-give-propositional-truncations te = record
+ { ∥_∥        = ∥_∥[ 1 ]
+ ; ∥∥-is-prop = is-prop'-implies-is-prop ∥∥ₙ-hlevel
+ ; ∣_∣        = ∣_∣[ 1 ]
+ ; ∥∥-rec     = λ - → ∥∥ₙ-rec (is-prop-implies-is-prop' -)
+ }
+ where
+  open H-level-truncations-exist te
+
+\end{code}
diff --git a/source/UF/UA-FunExt.lagda b/source/UF/UA-FunExt.lagda
index b93081704..ce1f50fca 100644
--- a/source/UF/UA-FunExt.lagda
+++ b/source/UF/UA-FunExt.lagda
@@ -16,9 +16,7 @@ depend on univalence.
 module UF.UA-FunExt where
 
 open import MLTT.Spartan
-open import UF.Base
 open import UF.Equiv
-open import UF.Equiv-FunExt
 open import UF.FunExt
 open import UF.FunExt-Properties
 open import UF.LeftCancellable
@@ -104,7 +102,6 @@ funext-from-successive-univalence : ∀ 𝓤
 funext-from-successive-univalence 𝓤 = univalence-gives-funext' 𝓤 (𝓤 ⁺)
 
 open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 
 Ω-ext-from-univalence : is-univalent 𝓤
                       → {p q : Ω 𝓤}
diff --git a/source/UF/UniverseEmbedding.lagda b/source/UF/UniverseEmbedding.lagda
index 0afa8b47c..54a4ed4af 100644
--- a/source/UF/UniverseEmbedding.lagda
+++ b/source/UF/UniverseEmbedding.lagda
@@ -172,7 +172,7 @@ prop-fiber-criterion pe fe 𝓤 𝓥 f i Q j (P , r) = d (P , r)
         (X ≃ P)      ≃⟨ ≃-sym (prop-univalent-≃ (pe 𝓤) (fe 𝓤 𝓤) X P l) ⟩
         (X ＝ P)      ■
 
-  b : (Σ X ꞉ 𝓤 ̇ , f X ＝ f P) ≃ (Σ X ꞉ 𝓤 ̇  , X ＝ P)
+  b : (Σ X ꞉ 𝓤 ̇ , f X ＝ f P) ≃ (Σ X ꞉ 𝓤 ̇ , X ＝ P)
   b = Σ-cong a
 
   c : is-prop (Σ X ꞉ 𝓤 ̇ , f X ＝ f P)
diff --git a/source/UF/Yoneda.lagda b/source/UF/Yoneda.lagda
index ceff97a8e..10b7a21b4 100644
--- a/source/UF/Yoneda.lagda
+++ b/source/UF/Yoneda.lagda
@@ -1,8 +1,23 @@
-Martin Escardo
+Martin Escardo, before 2018.
 
 A better version is in MGS.Yoneda, but currently we are using this
 one.
 
+We consider "natural transformations" Nat A B (defined elsewhere) and
+the Yoneda-machinery for them as discussed in
+http://www.cs.bham.ac.uk/~mhe/yoneda/yoneda.html (2015).
+
+See also
+
+[1] Egbert Rijke, Introduction to Homotopy Type Theory, 2022.
+    https://doi.org/10.48550/arXiv.2212.11082
+
+[2] Egbert Rijke, Introduction to Homotopy Type Theory, 2012. Master Thesis.
+    https://hottheory.files.wordpress.com/2012/08/hott2.pdf (Section 2.8).
+
+[3] Egbert Rijke, A type-theoretical Yoneda Lemma, 2012.
+    http://homotopytypetheory.org/2012/05/02/a-type-theoretical-yoneda-lemma/
+
 \begin{code}
 
 {-# OPTIONS --safe --without-K #-}
@@ -21,10 +36,6 @@ open import UF.EquivalenceExamples
 
 \end{code}
 
-We now consider "natural transformations" Nat A B (defined elsewhere)
-and the Yoneda-machinery for them as discussed in
-http://www.cs.bham.ac.uk/~mhe/yoneda/yoneda.html
-
 The Yoneda element induced by a natural transformation:
 
 \begin{code}
@@ -135,8 +146,8 @@ Yoneda-equivalence = yoneda-equivalence
 
 \end{code}
 
-Next we observe that "only elements", or centers of contraction, are
-universal elements in the sense of category theory.
+Next we observe that centers of contraction are universal elements in
+the sense of category theory.
 
 \begin{code}
 
@@ -384,8 +395,10 @@ equiv-universality : {X : 𝓤 ̇ } {A : X → 𝓥 ̇ }
                    → is-universal-element-of A (x , a)
 equiv-universality x a φ = section-universality x a (λ y → pr₁ (φ y))
 
-Yoneda-Theorem-forth : {X : 𝓤 ̇ } {A : X → 𝓥 ̇ } (x : X) (η : Nat (Id x) A)
-                     → ∃! A → is-fiberwise-equiv η
+Yoneda-Theorem-forth : {X : 𝓤 ̇ } {A : X → 𝓥 ̇ }
+                       (x : X) (η : Nat (Id x) A)
+                     → ∃! A
+                     → is-fiberwise-equiv η
 Yoneda-Theorem-forth x η i = nats-with-sections-are-equivs x η
                               (Yoneda-section-forth x η i)
 
@@ -396,7 +409,8 @@ Here is another proof, from the MGS'2019 lecture notes
 
 \begin{code}
 
-Yoneda-Theorem-forth' : {X : 𝓤 ̇ } (A : X → 𝓥 ̇ ) (x : X) (η : Nat (Id x) A)
+Yoneda-Theorem-forth' : {X : 𝓤 ̇ } (A : X → 𝓥 ̇ )
+                        (x : X) (η : Nat (Id x) A)
                       → ∃! A
                       → is-fiberwise-equiv η
 Yoneda-Theorem-forth' {𝓤} {𝓥} {X} A x η u = γ
@@ -434,7 +448,7 @@ fiberwise-equiv-criterion' A x e = fiberwise-equiv-criterion A x
 
 \end{code}
 
-This says that is there is any fiberwise equivalence whatsoever (or
+This says that if there is any fiberwise equivalence whatsoever (or
 even just a fiberwise retraction), then any natural transformation is
 a fiberwise equivalence.
 
@@ -448,6 +462,10 @@ Yoneda-Theorem-back x η φ = Yoneda-section-back x η (λ y → pr₁(φ y))
 
 \end{code}
 
+Egbert Rijke, in his book [1], refers to Yoneda-Theorem-forth and
+Yoneda-Theorem-back as "the fundamental theorem of identity types".
+See also his master thesis [2] and his blog post [3].
+
 Next we conclude that a presheaf A is representable iff Σ A is a
 singleton.
 
@@ -465,8 +483,7 @@ singleton-representable : {X : 𝓤 ̇ } {A : X → 𝓥 ̇ }
 singleton-representable {𝓤} {𝓥} {X} {A} ((x , a) , cc) =
   x ,
   yoneda-nat x A a ,
-  Yoneda-Theorem-forth x (yoneda-nat x A a) ((x , a) ,
-  cc)
+  Yoneda-Theorem-forth x (yoneda-nat x A a) ((x , a) , cc)
 
 representable-singleton : {X : 𝓤 ̇ } {A : X → 𝓥 ̇ }
                         → is-representable A
@@ -490,11 +507,12 @@ is-vv-equiv-has-adj' g φ = pr₁ γ ,
   γ : has-adj g
   γ = is-vv-equiv-has-adj g φ
 
-has-adj-is-vv-equiv' : {X : 𝓤 ̇ } {Y : 𝓥 ̇ } (g : Y → X)
-                     → (Σ f ꞉ (X → Y) , ((x : X) (y : Y) → (f x ＝ y) ≃ (g y ＝ x)))
-                     → is-vv-equiv g
+has-adj-is-vv-equiv'
+ : {X : 𝓤 ̇ } {Y : 𝓥 ̇ } (g : Y → X)
+ → (Σ f ꞉ (X → Y) , ((x : X) (y : Y) → (f x ＝ y) ≃ (g y ＝ x)))
+ → is-vv-equiv g
 has-adj-is-vv-equiv' g (f , ψ) =
- has-adj-is-vv-equiv g (f , (λ x y → pr₁(ψ x y)) , (λ x y → pr₁(pr₂(ψ x y))))
+ has-adj-is-vv-equiv g (f , (λ x y → pr₁ (ψ x y)) , (λ x y → pr₁ (pr₂(ψ x y))))
 
 \end{code}
 
@@ -504,10 +522,10 @@ extensionality holds (happly is an equivalence).
 
 \begin{code}
 
-funext-via-singletons :
-    ((X : 𝓤 ̇ ) (Y : X → 𝓥 ̇ )
-  → ((x : X) → is-singleton (Y x)) → is-singleton (Π Y))
-  → funext 𝓤 𝓥
+funext-via-singletons
+ : ((X : 𝓤 ̇ ) (Y : X → 𝓥 ̇ )
+ → ((x : X) → is-singleton (Y x)) → is-singleton (Π Y))
+ → funext 𝓤 𝓥
 funext-via-singletons {𝓤} {𝓥} φ {X} {Y} f = γ
  where
   c : is-singleton (Π x ꞉ X , Σ y ꞉ Y x , f x ＝ y)
@@ -546,17 +564,17 @@ and the proof given here via Yoneda was announced on 12th May 2015
 
 open import UF.Univalence
 
-univalence-via-singletons→ : is-univalent 𝓤 → (X : 𝓤 ̇ ) → ∃! Y ꞉ 𝓤 ̇  , X ≃ Y
+univalence-via-singletons→ : is-univalent 𝓤 → (X : 𝓤 ̇ ) → ∃! Y ꞉ 𝓤 ̇ , X ≃ Y
 univalence-via-singletons→ ua X = representable-singleton (X , (idtoeq X , ua X))
 
-univalence-via-singletons← : ((X : 𝓤 ̇ ) → ∃! Y ꞉ 𝓤 ̇  , X ≃ Y) → is-univalent 𝓤
+univalence-via-singletons← : ((X : 𝓤 ̇ ) → ∃! Y ꞉ 𝓤 ̇ , X ≃ Y) → is-univalent 𝓤
 univalence-via-singletons← φ X = universality-equiv X (≃-refl X)
                                   (central-point-is-universal
                                     (X ≃_)
                                     (X , ≃-refl X)
                                     (singletons-are-props (φ X) (X , ≃-refl X)))
 
-univalence-via-singletons : is-univalent 𝓤 ↔ ((X : 𝓤 ̇ ) → ∃! Y ꞉ 𝓤 ̇  , X ≃ Y)
+univalence-via-singletons : is-univalent 𝓤 ↔ ((X : 𝓤 ̇ ) → ∃! Y ꞉ 𝓤 ̇ , X ≃ Y)
 univalence-via-singletons = (univalence-via-singletons→ , univalence-via-singletons←)
 
 \end{code}
@@ -663,9 +681,8 @@ Yoneda-const = yoneda-const
 \end{code}
 
 The following is traditionally proved by induction on the identity
-type (as articulated by Jbased or J in the module UF.MLTT.Spartan), but
-here we use the Yoneda machinery instead, again for the sake of
-illustration.
+type (as articulated by Jbased or J), but here we use the Yoneda
+machinery instead, again for the sake of illustration.
 
 \begin{code}
 
diff --git a/source/UF/index.lagda b/source/UF/index.lagda
index 53bddffa9..8d429b5ba 100644
--- a/source/UF/index.lagda
+++ b/source/UF/index.lagda
@@ -9,6 +9,7 @@ import UF.Choice
 import UF.Classifiers
 import UF.Classifiers-Old
 import UF.Connected
+import UF.ConnectedTypes                    -- by [2]
 import UF.CumulativeHierarchy               -- by [1]
 import UF.CumulativeHierarchy-LocallySmall  -- by [1]
 import UF.DiscreteAndSeparated
@@ -67,6 +68,8 @@ import UF.Subsingletons-FunExt
 import UF.Subsingletons-Properties
 import UF.SubtypeClassifier
 import UF.SubtypeClassifier-Properties
+import UF.TruncationLevels
+import UF.Truncations                -- by [2]
 import UF.UA-FunExt
 import UF.Univalence
 import UF.UniverseEmbedding
diff --git a/source/Unsafe/CantorCompact.lagda b/source/Unsafe/CantorCompact.lagda
index 53680383a..e2b4afed6 100644
--- a/source/Unsafe/CantorCompact.lagda
+++ b/source/Unsafe/CantorCompact.lagda
@@ -10,17 +10,16 @@ and other modules.
 
 {-# OPTIONS --without-K #-}
 
-open import MLTT.Spartan
-open import MLTT.Two-Properties
 open import UF.FunExt
 
 module Unsafe.CantorCompact (fe : FunExt) where
 
-open import Unsafe.CountableTychonoff fe
+open import MLTT.Spartan
+open import MLTT.Two-Properties
 
 open import TypeTopology.CompactTypes
-open import TypeTopology.CompactTypes
-open import TypeTopology.WeaklyCompactTypes
+
+open import Unsafe.CountableTychonoff fe
 
 cantor-compact∙ : is-compact∙ (ℕ → 𝟚)
 cantor-compact∙ = countable-Tychonoff (λ i → 𝟚-is-compact∙)
diff --git a/source/Various/CantorTheoremForEmbeddings.lagda b/source/Various/CantorTheoremForEmbeddings.lagda
index 71ce31942..e76ba6fcd 100644
--- a/source/Various/CantorTheoremForEmbeddings.lagda
+++ b/source/Various/CantorTheoremForEmbeddings.lagda
@@ -17,15 +17,11 @@ module Various.CantorTheoremForEmbeddings where
 
 open import MLTT.Spartan
 
-open import MLTT.Two-Properties
-open import Naturals.Properties
 
 open import UF.Base
 open import UF.Embeddings
 open import UF.Subsingletons
 open import UF.Subsingletons-FunExt
-open import UF.Retracts
-open import UF.Equiv
 open import UF.FunExt
 open import UF.Size
 open import Various.LawvereFPT
diff --git a/source/Various/Dedekind.lagda b/source/Various/Dedekind.lagda
index 16e6f7987..f6bf9a824 100644
--- a/source/Various/Dedekind.lagda
+++ b/source/Various/Dedekind.lagda
@@ -36,7 +36,6 @@ See also the discussion at https://twitter.com/EscardoMartin/status/147339326101
 
 {-# OPTIONS --safe --without-K --lossy-unification #-}
 
-open import MLTT.Plus-Properties
 open import MLTT.Spartan
 open import Naturals.Order hiding (<-≤-trans)
 open import Notation.CanonicalMap
@@ -52,7 +51,6 @@ open import UF.Sets
 open import UF.Sets-Properties
 open import UF.Size
 open import UF.SubtypeClassifier
-open import UF.SubtypeClassifier-Properties
 open import UF.Subsingletons
 open import UF.Subsingletons-FunExt
 
diff --git a/source/Various/Hydra.lagda b/source/Various/Hydra.lagda
index 68058a896..2a786cfaa 100644
--- a/source/Various/Hydra.lagda
+++ b/source/Various/Hydra.lagda
@@ -19,7 +19,6 @@ module Various.Hydra where
 
 open import MLTT.Spartan
 open import MLTT.List
-open import Naturals.Properties
 open import Ordinals.Notions
 
 \end{code}
@@ -29,7 +28,7 @@ where empty list represent heads.
 
 \begin{code}
 
-data Hydra : 𝓤₀ ̇  where
+data Hydra : 𝓤₀ ̇ where
  Node : List Hydra → Hydra
 
 pattern Head = Node []
@@ -51,13 +50,13 @@ implementing hydra regeneration mechanism.
 
 \begin{code}
 
-data HeadLocation₀ : List Hydra → 𝓤₀ ̇  where
+data HeadLocation₀ : List Hydra → 𝓤₀ ̇ where
  here : {hs : List Hydra}
       → HeadLocation₀ (Head ∷ hs)
  next : {h : Hydra} {hs : List Hydra}
       → HeadLocation₀ hs → HeadLocation₀ (h ∷ hs)
 
-data HeadLocation₁ : List Hydra → 𝓤₀ ̇  where
+data HeadLocation₁ : List Hydra → 𝓤₀ ̇ where
  here₀ : {hs hs' : List Hydra}
        → HeadLocation₀ hs → HeadLocation₁ (Node hs ∷ hs')
  here₁ : {hs hs' : List Hydra}
diff --git a/source/Various/LawvereFPT.lagda b/source/Various/LawvereFPT.lagda
index ae0f19df5..7c2599e0d 100644
--- a/source/Various/LawvereFPT.lagda
+++ b/source/Various/LawvereFPT.lagda
@@ -255,7 +255,7 @@ module surjection-version (pt : propositional-truncations-exist) where
                               → (X : 𝓤 ̇ ) → existential-fixed-point-property X
  cantor-theorem-for-universes {𝓥} {𝓤} A φ s X f = ∥∥-functor g t
   where
-   t : ∃ B ꞉ 𝓤 ̇  , B ＝ (B → X)
+   t : ∃ B ꞉ 𝓤 ̇ , B ＝ (B → X)
    t = LFPT φ s (λ B → B → X)
 
    g : (Σ B ꞉ 𝓤 ̇ , B ＝ (B → X)) → Σ x ꞉ X , x ＝ f x
diff --git a/source/Various/NonCollapsibleFamily.lagda b/source/Various/NonCollapsibleFamily.lagda
index 4eeec2db5..6540862e8 100644
--- a/source/Various/NonCollapsibleFamily.lagda
+++ b/source/Various/NonCollapsibleFamily.lagda
@@ -1,5 +1,10 @@
 Martin Escardo, 1st April 2013
 
+Recall that a type is called collapsible if it has a weakly constant
+endomap. If every type is collapsible then every type has decidable
+equality and hence is a set by Hedberg's Theorem, and global hoice
+holds, because collapsible types have split support.
+
 \begin{code}
 
 {-# OPTIONS --safe --without-K #-}
@@ -14,7 +19,8 @@ open import UF.KrausLemma
 open import UF.Subsingletons
 
 decidable-equality-criterion : (X : 𝓤 ̇ )
-                               (a : 𝟚 → X) → ((x : X) → collapsible (Σ i ꞉ 𝟚 , a i ＝ x))
+                               (a : 𝟚 → X)
+                             → ((x : X) → collapsible (Σ i ꞉ 𝟚 , a i ＝ x))
                              → is-decidable(a ₀ ＝ a ₁)
 decidable-equality-criterion {𝓤} X a c = equal-or-different
  where
diff --git a/source/Various/Pataraia-Taylor.lagda b/source/Various/Pataraia-Taylor.lagda
index 880ed26da..dc27397f3 100644
--- a/source/Various/Pataraia-Taylor.lagda
+++ b/source/Various/Pataraia-Taylor.lagda
@@ -375,7 +375,7 @@ prove it as follows, using the above module Taylor again.
 \begin{code}
 
  lfp-induction :
-    (P : ⟨ 𝓓 ⟩ → 𝓤 ̇  )
+    (P : ⟨ 𝓓 ⟩ → 𝓤 ̇ )
   → ((x : ⟨ 𝓓 ⟩) → is-prop (P x))
   → P ⊥
   → is-closed-under-directed-sups 𝓓 P
@@ -383,7 +383,7 @@ prove it as follows, using the above module Taylor again.
   → P lfp
 
  module fixed-point-induction
-         (P : ⟨ 𝓓 ⟩ → 𝓤 ̇  )
+         (P : ⟨ 𝓓 ⟩ → 𝓤 ̇ )
          (P-is-prop-valued : (x : ⟨ 𝓓 ⟩) → is-prop (P x))
          (P-holds-at-⊥ : P ⊥)
          (P-is-closed-under-directed-sups : is-closed-under-directed-sups 𝓓 P)
diff --git a/source/Various/index.lagda b/source/Various/index.lagda
index a0eb11075..a9ccd47f5 100644
--- a/source/Various/index.lagda
+++ b/source/Various/index.lagda
@@ -9,7 +9,7 @@ module Various.index where
 import Various.CantorTheoremForEmbeddings -- by Jon Sterling
 import Various.Dedekind
 import Various.DummettDisjunction
-import Various.Hydra
+import Various.Hydra                      -- by Alice Laroche
 import Various.LawvereFPT
 import Various.Lumsdaine
 import Various.NonCollapsibleFamily
diff --git a/source/W/Numbers.lagda b/source/W/Numbers.lagda
index e8272bfed..b3e3b6ed9 100644
--- a/source/W/Numbers.lagda
+++ b/source/W/Numbers.lagda
@@ -68,7 +68,7 @@ elements of 𝓝, or, equivalently, as a partial element of 𝓝.
 
 \begin{code}
 
- _^_ : 𝓤 ̇  → Ω 𝓥 → 𝓥 ⊔ 𝓤 ̇
+ _^_ : 𝓤 ̇ → Ω 𝓥 → 𝓥 ⊔ 𝓤 ̇
  X ^ p = p holds → X
 
  Suc : (p : Ω 𝓥) → 𝓝 ^ p → 𝓝
diff --git a/source/W/Paths.lagda b/source/W/Paths.lagda
index 4f6dd67b0..a7af2f4e7 100644
--- a/source/W/Paths.lagda
+++ b/source/W/Paths.lagda
@@ -10,19 +10,11 @@ open import MLTT.Spartan
 
 module W.Paths where
 
-open import UF.Base
-open import UF.Embeddings
-open import UF.Equiv
-open import UF.EquivalenceExamples
-open import UF.FunExt
 open import UF.Logic
 open import UF.PropTrunc
-open import UF.Retracts
 open import UF.Subsingletons
-open import UF.Subsingletons-FunExt
 open import W.Type
 open import W.Numbers
-open import W.Properties
 
 module _ (X : 𝓤 ̇ ) (A : X → 𝓥 ̇ ) where
 
diff --git a/source/W/index.lagda b/source/W/index.lagda
index 8d3bef675..3baeab401 100644
--- a/source/W/index.lagda
+++ b/source/W/index.lagda
@@ -8,9 +8,9 @@ W-types.
 
 module W.index where
 
-open import W.Type
-open import W.Properties
-open import W.Numbers
-open import W.Paths
+import W.Type
+import W.Properties
+import W.Numbers
+import W.Paths
 
 \end{code}
diff --git a/source/WildCategories/Cones.lagda b/source/WildCategories/Cones.lagda
index c44cd45ad..4fc6c8cfa 100644
--- a/source/WildCategories/Cones.lagda
+++ b/source/WildCategories/Cones.lagda
@@ -26,7 +26,6 @@ module WildCategories.Cones where
 
 open import MLTT.Spartan
 open import UF.Base
-open import UF.Subsingletons
 
 open import WildCategories.Base
 open import WildCategories.Idempotents
diff --git a/source/WildCategories/Idempotents.lagda b/source/WildCategories/Idempotents.lagda
index 17d3d8a96..b392dc919 100644
--- a/source/WildCategories/Idempotents.lagda
+++ b/source/WildCategories/Idempotents.lagda
@@ -6,8 +6,6 @@ Jon Sterling and Mike Shulman, September 2023.
 module WildCategories.Idempotents where
 
 open import MLTT.Spartan
-open import UF.Base
-open import UF.Subsingletons
 
 open import WildCategories.Base
 
diff --git a/source/gist/TruncatedTypes.lagda b/source/gist/TruncatedTypes.lagda
new file mode 100644
index 000000000..3a5c98d63
--- /dev/null
+++ b/source/gist/TruncatedTypes.lagda
@@ -0,0 +1,230 @@
+Ian Ray, 2 June 2024
+
+Experimental modification by Martin Escardo and Tom de Jong 12th
+September 2024.
+
+Minor modifications by Tom de Jong on 4 September 2024
+
+We develop n-types, or n-truncated types, as defined in the HoTT book.
+
+In this file we will assume function extensionality globally but not
+univalence.  The final result of the file will be proved in the local
+presence of univalence.
+
+\begin{code}
+
+{-# OPTIONS --safe --without-K #-}
+
+open import UF.FunExt
+
+module gist.TruncatedTypes
+        (fe : Fun-Ext)
+       where
+
+open import MLTT.Spartan hiding (_+_)
+
+open import Naturals.Order
+open import Notation.Order
+open import UF.Embeddings
+open import UF.Equiv
+open import UF.EquivalenceExamples
+open import UF.Retracts
+open import UF.Singleton-Properties
+open import UF.Subsingletons
+open import UF.Subsingletons-FunExt
+open import UF.Subsingletons-Properties
+open import UF.TruncationLevels
+open import UF.Univalence
+
+private
+ fe' : FunExt
+ fe' 𝓤 𝓥 = fe {𝓤} {𝓥}
+
+_is_truncated : 𝓤 ̇ → ℕ₋₂ → 𝓤 ̇
+X is −2 truncated       = is-contr X
+X is (succ n) truncated = (x x' : X) → (x ＝ x') is n truncated
+
+being-truncated-is-prop : {𝓤 : Universe} {n : ℕ₋₂} {X : 𝓤 ̇ }
+                        → is-prop (X is n truncated)
+being-truncated-is-prop {𝓤} {−2}       = being-singleton-is-prop fe
+being-truncated-is-prop {𝓤} {succ n} =
+  Π₂-is-prop fe (λ x x' → being-truncated-is-prop)
+
+_is_truncated-map : {X : 𝓤 ̇} {Y : 𝓥 ̇} → (f : X → Y) → ℕ₋₂ → 𝓤 ⊔ 𝓥 ̇
+f is n truncated-map = each-fiber-of f (λ - → - is n truncated)
+
+\end{code}
+
+Being -1-truncated equivalent to being a proposition.
+
+\begin{code}
+
+is-prop' : (X : 𝓤 ̇) → 𝓤  ̇
+is-prop' X = X is −1 truncated
+
+being-prop'-is-prop : (X : 𝓤 ̇) → is-prop (is-prop' X)
+being-prop'-is-prop X = being-truncated-is-prop
+
+is-prop-implies-is-prop' : {X : 𝓤 ̇} → is-prop X → is-prop' X
+is-prop-implies-is-prop' X-is-prop x x' =
+ pointed-props-are-singletons (X-is-prop x x') (props-are-sets X-is-prop)
+
+is-prop'-implies-is-prop : {X : 𝓤 ̇} → is-prop' X → is-prop X
+is-prop'-implies-is-prop X-is-prop' x x' = center (X-is-prop' x x')
+
+is-prop-equiv-is-prop' : {X : 𝓤 ̇} → is-prop X ≃ is-prop' X
+is-prop-equiv-is-prop' {𝓤} {X} =
+ logically-equivalent-props-are-equivalent (being-prop-is-prop fe)
+                                           (being-prop'-is-prop X)
+                                           is-prop-implies-is-prop'
+                                           is-prop'-implies-is-prop
+
+\end{code}
+
+Truncation levels are upper closed.
+
+\begin{code}
+
+contractible-types-are-props' : {X : 𝓤 ̇} → is-contr X → is-prop' X
+contractible-types-are-props' = is-prop-implies-is-prop' ∘ singletons-are-props
+
+truncation-levels-are-upper-closed : {n : ℕ₋₂} {X : 𝓤 ̇ }
+                                   → X is n truncated
+                                   → X is (n + 1) truncated
+truncation-levels-are-upper-closed {𝓤} {−2} = contractible-types-are-props'
+truncation-levels-are-upper-closed {𝓤} {succ n} t x x' =
+ truncation-levels-are-upper-closed (t x x')
+
+truncation-levels-closed-under-Id : {n : ℕ₋₂} {X : 𝓤 ̇ }
+                                  → X is n truncated
+                                  → (x x' : X) → (x ＝ x') is n truncated
+truncation-levels-closed-under-Id {𝓤} {−2} = contractible-types-are-props'
+truncation-levels-closed-under-Id {𝓤} {succ n} t x x' =
+  truncation-levels-are-upper-closed (t x x')
+
+\end{code}
+
+We will now give some closure results about truncation levels.
+
+\begin{code}
+
+truncated-types-are-closed-under-retracts : {n : ℕ₋₂} {X : 𝓤 ̇ } {Y : 𝓥 ̇ }
+                                          → retract X of Y
+                                          → Y is n truncated
+                                          → X is n truncated
+truncated-types-are-closed-under-retracts {𝓤} {𝓥} {−2} {X} {Y} =
+ singleton-closed-under-retract X Y
+truncated-types-are-closed-under-retracts {𝓤} {𝓥} {succ n} (r , s , H) t x x' =
+ truncated-types-are-closed-under-retracts
+  (＝-retract s (r , H) x x')
+  (t (s x) (s x'))
+
+truncated-types-closed-under-equiv : {n : ℕ₋₂} {X : 𝓤 ̇ } {Y : 𝓥 ̇ }
+                                   → X ≃ Y
+                                   → Y is n truncated
+                                   → X is n truncated
+truncated-types-closed-under-equiv e =
+ truncated-types-are-closed-under-retracts (≃-gives-◁ e)
+
+\end{code}
+
+We can prove closure under embeddings as a consequence of the previous
+result.
+
+\begin{code}
+
+truncated-types-closed-under-embedding⁺ : {n : ℕ₋₂} {X : 𝓤 ̇ } {Y : 𝓥 ̇ }
+                                        → X ↪ Y
+                                        → Y is (n + 1) truncated
+                                        → X is (n + 1) truncated
+truncated-types-closed-under-embedding⁺ {𝓤} {𝓥} (e , is-emb) t x x' =
+ truncated-types-closed-under-equiv
+  (ap e , embedding-gives-embedding' e is-emb x x')
+  (t (e x) (e x'))
+
+truncated-types-closed-under-embedding : {n : ℕ₋₂}
+                                       → n ≥ −1
+                                       → {X : 𝓤 ̇ } {Y : 𝓥 ̇ }
+                                       → X ↪ Y
+                                       → Y is n truncated
+                                       → X is n truncated
+truncated-types-closed-under-embedding {𝓤} {𝓥} {succ n} _ =
+ truncated-types-closed-under-embedding⁺
+
+\end{code}
+
+Using closure under equivalence we can show closure under Σ and Π.
+
+\begin{code}
+
+truncated-types-closed-under-Σ : {n : ℕ₋₂} {X : 𝓤 ̇ } (Y : X → 𝓥 ̇ )
+                               → X is n truncated
+                               → ((x : X) → (Y x) is n truncated)
+                               → (Σ Y) is n truncated
+truncated-types-closed-under-Σ {𝓤} {𝓥} {−2} Y = Σ-is-singleton
+truncated-types-closed-under-Σ {𝓤} {𝓥} {succ n} Y l m (x , y) (x' , y') =
+ truncated-types-closed-under-equiv Σ-＝-≃
+  (truncated-types-closed-under-Σ
+   (λ p → transport Y p y ＝ y')
+   (l x x')
+   (λ p → m x' (transport Y p y) y'))
+
+truncated-types-closed-under-Π : {n : ℕ₋₂} {X : 𝓤 ̇ } (Y : X → 𝓥 ̇ )
+                               → ((x : X) → (Y x) is n truncated)
+                               → (Π Y) is n truncated
+truncated-types-closed-under-Π {𝓤} {𝓥} {−2} Y = Π-is-singleton fe
+truncated-types-closed-under-Π {𝓤} {𝓥} {succ n} Y m f g =
+ truncated-types-closed-under-equiv (happly-≃ fe)
+  (truncated-types-closed-under-Π (λ x → f x ＝ g x)
+  (λ x → m x (f x) (g x)))
+
+truncated-types-closed-under-→ : {n : ℕ₋₂} {X : 𝓤 ̇ } {Y : 𝓥 ̇ }
+                               → Y is n truncated
+                               → (X → Y) is n truncated
+truncated-types-closed-under-→ {𝓤} {𝓥} {n} {X} {Y} m =
+ truncated-types-closed-under-Π (λ - → Y) (λ - → m)
+
+\end{code}
+
+The subuniverse of types of n truncated types is defined as follows.
+
+\begin{code}
+
+𝕋 : ℕ₋₂ → (𝓤 : Universe) → 𝓤 ⁺ ̇
+𝕋 n 𝓤 = Σ X ꞉ 𝓤 ̇ , X is n truncated
+
+\end{code}
+
+From univalence we can show that 𝕋 n is n + 1 truncated,
+for all n : ℕ₋₂.
+
+\begin{code}
+
+truncation-levels-closed-under-≃⁺ : {n : ℕ₋₂} {X : 𝓤 ̇ } {Y : 𝓥 ̇ }
+                                  → Y is (n + 1) truncated
+                                  → (X ≃ Y) is (succ n) truncated
+truncation-levels-closed-under-≃⁺ {𝓤} {𝓥} {n} {X} {Y} tY =
+ truncated-types-closed-under-embedding ⋆ (equiv-embeds-into-function fe')
+  (truncated-types-closed-under-Π (λ _ → Y) (λ _ → tY))
+
+truncation-levels-closed-under-≃ : {n : ℕ₋₂} {X : 𝓤 ̇ } {Y : 𝓥 ̇ }
+                                 → X is n truncated
+                                 → Y is n truncated
+                                 → (X ≃ Y) is n truncated
+truncation-levels-closed-under-≃ {𝓤} {𝓥} {−2} = ≃-is-singleton fe'
+truncation-levels-closed-under-≃ {𝓤} {𝓥} {succ n} tX =
+ truncation-levels-closed-under-≃⁺
+
+𝕋-is-of-next-hlevel : {n : ℕ₋₂} {𝓤 : Universe}
+                    → is-univalent 𝓤
+                    → (𝕋 n 𝓤) is (n + 1) truncated
+𝕋-is-of-next-hlevel ua (X , l) (Y , l') =
+ truncated-types-closed-under-equiv I (truncation-levels-closed-under-≃ l l')
+ where
+  I = ((X , l) ＝ (Y , l')) ≃⟨ II ⟩
+       (X ＝ Y)             ≃⟨ univalence-≃ ua X Y ⟩
+       (X ≃ Y)              ■
+   where
+    II = ≃-sym (to-subtype-＝-≃ (λ _ → being-truncated-is-prop))
+
+\end{code}
diff --git a/source/gist/index.lagda b/source/gist/index.lagda
index 04601fc23..a680ca12c 100644
--- a/source/gist/index.lagda
+++ b/source/gist/index.lagda
@@ -8,6 +8,8 @@ We use this directory to include small examples for discussion.
 
 module gist.index where
 
+import gist.multiset-addendum-question
 import gist.remove-swap
+import gist.TruncatedTypes
 
 \end{code}
diff --git a/source/gist/multiset-addendum-question.lagda b/source/gist/multiset-addendum-question.lagda
new file mode 100644
index 000000000..d49f007ae
--- /dev/null
+++ b/source/gist/multiset-addendum-question.lagda
@@ -0,0 +1,202 @@
+Alice Laroche, 14th June 2024
+
+This file answers the question asked in Iterative.Multisets-Addendum
+That is : Is there a function Πᴹ of the above type that satisfies the
+following equation?
+
+Σ Πᴹ ꞉ ((X → 𝕄) → 𝕄)
+     , ((A : X → 𝕄) → Πᴹ A ＝ ssup
+                               (Π x ꞉ X , 𝕄-root (A x))
+                               (λ g → Πᴹ (λ x → 𝕄-forest (A x) (g x))))
+
+We prove that it isn't the case in general, as the existence of function for
+the empty type would allow infinite recursion.
+We then prove that the function exists up to equivalence for pointed types,
+and, admitting function extensionality, for inhabited types.
+
+
+\begin{code}
+
+{-# OPTIONS --safe --without-K --exact-split #-}
+
+open import MLTT.Spartan
+open import UF.Base
+open import UF.Equiv
+open import UF.FunExt
+open import UF.PropTrunc
+open import UF.Univalence
+open import W.Type
+
+module gist.multiset-addendum-question
+        (ua : Univalence)
+        (𝓤 : Universe)
+       where
+
+open import Iterative.Multisets 𝓤
+open import Iterative.Multisets-Addendum ua 𝓤
+
+swap-Idtofun : {X Y : 𝓤 ̇ } {Z : 𝓥 ̇ } → {f : X → Z} {g : Y → Z}
+             → (p : Y ＝ X)
+             → f ∘ Idtofun p ＝ g
+             → f ＝ g ∘ Idtofun⁻¹ p
+swap-Idtofun  refl refl = refl
+
+Question𝟘 :
+ ¬ (Σ Πᴹ ꞉ ((𝟘 {𝓤} → 𝕄) → 𝕄)
+         , ((A : 𝟘 → 𝕄) → Πᴹ A ＝ ssup
+                                  (Π x ꞉ 𝟘 , 𝕄-root (A x))
+                                  (λ g → Πᴹ (λ x → 𝕄-forest (A x) (g x)))))
+Question𝟘 (Πᴹ , eq) = recurs A (Πᴹ A) (eq A)
+ where
+  A : 𝟘 → 𝕄
+  A x = 𝟘-elim x
+
+  recurs : (A : 𝟘 → 𝕄) → (x : 𝕄)
+       → ¬(x ＝ ssup
+                (Π x ꞉ 𝟘 , 𝕄-root (A x))
+                (λ g → Πᴹ (λ x → 𝕄-forest (A x) (g x))))
+  recurs A (ssup X φ) eq' = recurs A' (φ I) II
+   where
+    I : X
+    I =  transport⁻¹ 𝕄-root eq' (λ x → 𝟘-elim x)
+
+    A' : 𝟘 → 𝕄
+    A' x = 𝕄-forest (A x) (Idtofun (pr₁ (from-𝕄-＝ eq')) I x)
+
+    II : φ I ＝ ssup
+                (Π x ꞉ 𝟘 , 𝕄-root (A' x))
+                (λ g → Πᴹ (λ x → 𝕄-forest (A' x) (g x)))
+    II = happly (pr₂ (from-𝕄-＝ eq')) I
+       ∙ (eq A')
+
+Question-is-false : ¬ Question
+Question-is-false Q = Question𝟘 (Q {𝟘})
+
+module _ {X : 𝓤 ̇ } where
+
+ data _<_ : (X → 𝕄) → (X → 𝕄) → (𝓤 ⁺) ̇ where
+  smaller : {f g : X → 𝕄} → ((x : X) → f x ⁅ g x) → f < g
+
+ open import Ordinals.Notions _<_
+
+ <-is-well-founded : X → is-well-founded
+ <-is-well-founded x f = acc (rec' x f (f x) refl)
+  where
+   rec' : (x : X) (f : X → 𝕄) (m : 𝕄) → m ＝ f x
+      → (g : X → 𝕄) → g < f
+      → is-accessible g
+   rec' x f (ssup Y φ) eq g (smaller p) =
+    acc (rec' x g (φ II) (III ∙ pr₂ (p x)))
+    where
+     I : Σ p ꞉ Y ＝ 𝕄-root (f x) , φ ＝ (𝕄-forest (f x)) ∘ Idtofun p
+     I = from-𝕄-＝ (eq ∙ 𝕄-η (f x) ⁻¹)
+
+     II : Y
+     II = Idtofun⁻¹ (pr₁ I) (pr₁ (p x))
+
+     III : φ II ＝ 𝕄-forest (f x) (pr₁ (p x))
+     III = happly'
+            (φ ∘ Idtofun⁻¹ (pr₁ I))
+            (𝕄-forest (f x))
+            (swap-Idtofun (pr₁ I) (pr₂ I ⁻¹) ⁻¹)
+            (pr₁ (p x))
+
+ module without-funext where
+
+  QuestionX :
+   X → Σ Πᴹ ꞉ ((X → 𝕄) → 𝕄)
+            , ((A : X → 𝕄) → Πᴹ A ≃ᴹ ssup
+                                      (Π x ꞉ X , 𝕄-root (A x))
+                                      (λ g → Πᴹ (λ x → 𝕄-forest (A x) (g x))))
+  QuestionX x = Πᴹ'' , eqv
+   where
+    I : (A : X → 𝕄) → ((g : X → 𝕄) → g < A → 𝕄) → 𝕄
+    I A rec = ssup
+               (Π x ꞉ X , 𝕄-root (A x))
+               (λ g → rec (λ x → 𝕄-forest (A x) (g x))
+                          (smaller λ y → (g y) , refl))
+
+    Πᴹ' : (A : X → 𝕄) → is-accessible A → 𝕄
+    Πᴹ' A = transfinite-induction'
+             (λ - → 𝕄)
+             I
+             A
+
+    Πᴹ'' : (A : X → 𝕄) → 𝕄
+    Πᴹ'' A = Πᴹ' A (<-is-well-founded x A)
+
+    II : (A : X → 𝕄) (acc₁ : is-accessible A) → Πᴹ' A acc₁ ＝ _
+    II A acc₁ =  transfinite-induction'-behaviour (λ - → 𝕄) I A acc₁
+
+    III : (A : X → 𝕄)
+        → ( (g : X → 𝕄)
+            → g < A
+            → (acc₁ acc₂ : is-accessible g)
+            → Πᴹ' g acc₁ ≃ᴹ Πᴹ' g acc₂)
+        → (acc₁ acc₂ : is-accessible A) → Πᴹ' A acc₁ ≃ᴹ Πᴹ' A acc₂
+    III A rec acc₁ acc₂ = transport₂ _≃ᴹ_ (II A acc₁ ⁻¹) (II A acc₂ ⁻¹)
+                           ((≃-refl _)
+                           , λ g → rec (λ x → 𝕄-forest (A x) (g x))
+                                       (smaller λ y → (g y) , refl)
+                                       (prev acc₁ _ _)
+                                       (prev acc₂ _ _))
+
+    IV : (A : X → 𝕄) → (acc₁ acc₂ : is-accessible A)
+        → Πᴹ' A acc₁ ≃ᴹ Πᴹ' A acc₂
+    IV A = transfinite-induction'
+            (λ A → (acc₁ acc₂ : is-accessible A) → Πᴹ' A acc₁ ≃ᴹ Πᴹ' A acc₂)
+            III
+            A
+            (<-is-well-founded x A)
+
+    eqv : (A : X → 𝕄)
+        → Πᴹ'' A ≃ᴹ ssup
+                     (Π x ꞉ X , 𝕄-root (A x))
+                     (λ g → Πᴹ'' (λ x → 𝕄-forest (A x) (g x)))
+    eqv A =
+     transport⁻¹
+      (_≃ᴹ ssup
+            (Π x ꞉ X , 𝕄-root (A x))
+            (λ g → Πᴹ'' (λ x → 𝕄-forest (A x) (g x))))
+      (transfinite-induction'-behaviour (λ - → 𝕄) I A (<-is-well-founded x A))
+      ((≃-refl _) , λ g → IV
+                           (λ x → 𝕄-forest (A x) (g x))
+                           (prev (<-is-well-founded x A) _ _)
+                           (<-is-well-founded x _))
+
+ module with-funext (pt : propositional-truncations-exist) (fe : FunExt) where
+
+  open PropositionalTruncation pt
+
+  <-is-well-founded' : ∥ X ∥ → is-well-founded
+  <-is-well-founded' x f = ∥∥-rec
+                            (accessibility-is-prop fe f)
+                            (λ x → <-is-well-founded x f)
+                            x
+
+  QuestionX :
+   ∥ X ∥ → Σ Πᴹ ꞉ ((X → 𝕄) → 𝕄)
+                , ((A : X → 𝕄) → Πᴹ A ＝ ssup
+                                         (Π x ꞉ X , 𝕄-root (A x))
+                                         (λ g → Πᴹ (λ x → 𝕄-forest (A x) (g x))))
+  QuestionX x = Πᴹ' , eq
+   where
+    I : (A : X → 𝕄) → ((g : X → 𝕄) → g < A → 𝕄) → 𝕄
+    I A rec = ssup
+               (Π x ꞉ X , 𝕄-root (A x))
+               (λ g → rec (λ x → 𝕄-forest (A x) (g x))
+                          (smaller λ y → (g y) , refl))
+
+    Πᴹ' : (X → 𝕄) → 𝕄
+    Πᴹ' A = transfinite-recursion
+             (<-is-well-founded' x)
+             I
+             A
+
+    eq : (A : X → 𝕄)
+       → Πᴹ' A ＝ ssup
+                   (Π x ꞉ X , 𝕄-root (A x))
+                 (λ g → Πᴹ' (λ x → 𝕄-forest (A x) (g x)))
+    eq A = transfinite-recursion-behaviour fe (<-is-well-founded' x) I A
+
+\end{code}
diff --git a/source/gist/remove-swap.lagda b/source/gist/remove-swap.lagda
index 01e07b8e9..28f7d457a 100644
--- a/source/gist/remove-swap.lagda
+++ b/source/gist/remove-swap.lagda
@@ -40,7 +40,6 @@ module gist.remove-swap
        where
 
 open import MLTT.List
-open import NotionsOfDecidability.Decidable
 
 \end{code}
 
diff --git a/source/index.lagda b/source/index.lagda
index 1aebe06b0..b58be4bcc 100644
--- a/source/index.lagda
+++ b/source/index.lagda
@@ -8,7 +8,7 @@
    https://www.cs.bham.ac.uk/~mhe/
    https://github.com/martinescardo/TypeTopology
 
-   Tested with Agda 2.6.4.3
+   Tested with Agda 2.6.4.3 and 2.7.0
 
    * Our main use of this development is as a personal blackboard or
      notepad for our research and that of collaborators. In
@@ -112,6 +112,12 @@ Philosophy of the repository
      computational sense (as opposed to constructivity in the sense of
      validity in any (∞-)topos).
 
+   * Although our philosophy is based on HoTT/UF and ∞-toposes, it
+     should be emphasized that much of what we do here also holds in
+     the setoid model. In particular, this model validates function
+     extensionality, the existence of propositional truncationsm and
+     the existence of quotients, and some higher inductive types.
+
 Click at the imported module names to navigate to them:
 
 \begin{code}
@@ -120,8 +126,10 @@ Click at the imported module names to navigate to them:
 
 module index where
 
+import Apartness.index
 import BinarySystems.index
 import CantorSchroederBernstein.index
+import Cardinals.index
 import Categories.index
 import Circle.index
 import CoNaturals.index
diff --git a/typetopology.agda-lib b/typetopology.agda-lib
index 7a3619182..157b3e1ad 100644
--- a/typetopology.agda-lib
+++ b/typetopology.agda-lib
@@ -1,3 +1,3 @@
 name: TypeTopology
 include: source
-flags: --without-K  --level-universe --auto-inline --exact-split --keep-pattern-variables --no-sized-types --no-guardedness --no-rewriting --no-two-level --no-erasure  --no-prop --no-cumulativity --no-cohesion --no-print-pattern-synonyms
+flags: --without-K  --level-universe --auto-inline --exact-split --keep-pattern-variables --no-sized-types --no-guardedness --no-rewriting --no-two-level --no-erasure  --no-prop --no-cumulativity --no-cohesion --no-print-pattern-synonyms --no-save-metas
diff --git a/updateurl b/updateurl
index 3a96d8f02..3c4c2c272 100755
--- a/updateurl
+++ b/updateurl
@@ -1,5 +1,7 @@
 #!/bin/bash
 
+set -euxo pipefail
+
 # Generate html files and deploy them.
 # This is to be run from TypeTopology/source.
 # It assumes that we want to deploy the html pages at ~/public_html.