From fb2aa23fefa41cb7df9888c5d1472510a68e9690 Mon Sep 17 00:00:00 2001
From: valis <valery.isaev@gmail.com>
Date: Sat, 25 May 2024 21:55:37 +0300
Subject: [PATCH] Major update and refactoring

* Define Cauchy maps and lifts for them
* Prove that minimal Cauchy filters are regular
* Define completion of uniform spaces
* Refactor the structure of the hierarchy of space
* Refactor the field structure on real numbers
* Allow several actions in 'in' meta
* Introduce a hierarchy of continuous maps
* Prove some facts about metric spaces
* Define normed abelian groups
* Define topological abelian groups
* Define products of topological spaces, topological abelian groups, and uniform spaces
* Fix some bugs in linear solver
* Implement 'defaultImpl' meta
* Define 'Refines' relation for covers
* Define Hausdorff topological spaces
---
 .../main/java/org/arend/lib/StdExtension.java |   3 +-
 .../org/arend/lib/meta/DefaultImplMeta.java   |  88 +++
 .../main/java/org/arend/lib/meta/InMeta.java  |  22 +-
 .../org/arend/lib/meta/UnfoldLetMeta.java     |   2 +-
 .../java/org/arend/lib/meta/UnfoldMeta.java   |   2 +-
 .../java/org/arend/lib/meta/UnfoldsMeta.java  |   2 +-
 .../arend/lib/meta/linear/CompiledTerm.java   |  11 +-
 .../arend/lib/meta/linear/LinearSolver.java   |  40 +-
 .../arend/lib/meta/linear/TermCompiler.java   |  76 +--
 .../main/java/org/arend/lib/util/Utils.java   |   9 +
 src/Algebra/Group/Solver.ard                  |   2 +-
 src/Algebra/Linear/Solver.ard                 |   3 +-
 src/Algebra/Ordered.ard                       |  26 +-
 src/Algebra/Ring.ard                          |   5 +-
 src/Arith/Complex.ard                         |   6 +-
 src/Arith/Nat.ard                             |   5 +-
 src/Arith/Real.ard                            | 583 ++++++++++++------
 src/Arith/Real/Field.ard                      | 208 +++++++
 src/Logic.ard                                 |   8 +-
 src/Set/Filter.ard                            |  10 +
 src/Set/Fin.ard                               |   2 +-
 src/Set/Subset.ard                            |  65 +-
 src/Topology/CoverSpace.ard                   | 277 ++++-----
 src/Topology/CoverSpace/Category.ard          |  21 +-
 src/Topology/CoverSpace/Complete.ard          | 281 +++++----
 src/Topology/CoverSpace/Convergence.ard       |  23 +-
 src/Topology/CoverSpace/Locale.ard            |  34 +-
 src/Topology/CoverSpace/Product.ard           | 153 +++++
 src/Topology/CoverSpace/Real.ard              | 481 ---------------
 src/Topology/CoverSpace/Subspace.ard          |   4 +-
 src/Topology/CoverSpace/TopSpace.ard          |   2 +-
 src/Topology/Locale.ard                       |  10 +-
 src/Topology/MetricSpace.ard                  | 234 +++++--
 src/Topology/NormedAbGroup.ard                | 103 ++++
 src/Topology/NormedAbGroup/Real.ard           | 148 +++++
 src/Topology/TopAbGroup.ard                   | 115 ++++
 src/Topology/TopAbGroup/Product.ard           |  63 ++
 src/Topology/TopSpace.ard                     |  58 +-
 src/Topology/TopSpace/Category.ard            |  10 +-
 src/Topology/TopSpace/Product.ard             |  43 ++
 src/Topology/UniformSpace.ard                 | 118 +++-
 src/Topology/UniformSpace/Complete.ard        |  66 ++
 src/Topology/UniformSpace/Product.ard         |  59 ++
 test/Algebra/LinearSolverTest.ard             |   5 +-
 44 files changed, 2283 insertions(+), 1203 deletions(-)
 create mode 100644 meta/src/main/java/org/arend/lib/meta/DefaultImplMeta.java
 create mode 100644 src/Arith/Real/Field.ard
 create mode 100644 src/Topology/CoverSpace/Product.ard
 delete mode 100644 src/Topology/CoverSpace/Real.ard
 create mode 100644 src/Topology/NormedAbGroup.ard
 create mode 100644 src/Topology/NormedAbGroup/Real.ard
 create mode 100644 src/Topology/TopAbGroup.ard
 create mode 100644 src/Topology/TopAbGroup/Product.ard
 create mode 100644 src/Topology/TopSpace/Product.ard
 create mode 100644 src/Topology/UniformSpace/Complete.ard
 create mode 100644 src/Topology/UniformSpace/Product.ard

diff --git a/meta/src/main/java/org/arend/lib/StdExtension.java b/meta/src/main/java/org/arend/lib/StdExtension.java
index 8ce67733..c0c79518 100644
--- a/meta/src/main/java/org/arend/lib/StdExtension.java
+++ b/meta/src/main/java/org/arend/lib/StdExtension.java
@@ -159,7 +159,7 @@ public void declareDefinitions(@NotNull DefinitionContributor contributor) {
         Precedence.DEFAULT, new HidingMeta());
     contributor.declare(meta, new LongName("run"), "`run { e_1, ... e_n }` is equivalent to `e_1 $ e_2 $ ... $ e_n`", Precedence.DEFAULT, new RunMeta(this));
     contributor.declare(meta, new LongName("at"), "`((f_1, ... f_n) at x) r` replaces variable `x` with `f_1 (... (f_n x) ...)` and runs `r` in the modified context", new Precedence(Precedence.Associativity.NON_ASSOC, (byte) 1, true), new AtMeta(this));
-    contributor.declare(meta, new LongName("in"), "`f in x` is equivalent to `\\let r => f x \\in r`. It is usually used with `f` a meta such that `rewrite`, `simplify`, `simp_coe`, or `unfold`.", new Precedence(Precedence.Associativity.RIGHT_ASSOC, (byte) 1, true), new InMeta(this));
+    contributor.declare(meta, new LongName("in"), "`f in x` is equivalent to `\\let r => f x \\in r`. Also, `(f_1, ... f_n) in x` is equivalent to `f_1 in ... f_n in x`. This meta is usually used with `f` being a meta such as `rewrite`, `simplify`, `simp_coe`, or `unfold`.", new Precedence(Precedence.Associativity.RIGHT_ASSOC, (byte) 1, true), new InMeta(this));
     casesMeta = new CasesMeta(this);
     contributor.declare(meta, new LongName("cases"),
       """
@@ -216,6 +216,7 @@ public void declareDefinitions(@NotNull DefinitionContributor contributor) {
         * `assumption` {n} returns the n-th variables from the context counting from the end.
         * `assumption` {n} a1 ... ak applies n-th variable from the context to arguments a1, ... ak.
         """, Precedence.DEFAULT, new AssumptionMeta(this));
+    contributor.declare(meta, new LongName("defaultImpl"), "`defaultImpl C F E` returns the default implementation of field `F` in class `C` applied to expression `E`. The third argument can be omitted, in which case either `\\this` or `_` will be used instead,", Precedence.DEFAULT, new DefaultImplMeta(this));
 
     ModulePath paths = ModulePath.fromString("Paths.Meta");
     contributor.declare(paths, new LongName("rewrite"),
diff --git a/meta/src/main/java/org/arend/lib/meta/DefaultImplMeta.java b/meta/src/main/java/org/arend/lib/meta/DefaultImplMeta.java
new file mode 100644
index 00000000..e66ccbbe
--- /dev/null
+++ b/meta/src/main/java/org/arend/lib/meta/DefaultImplMeta.java
@@ -0,0 +1,88 @@
+package org.arend.lib.meta;
+
+import org.arend.ext.concrete.ConcreteFactory;
+import org.arend.ext.concrete.expr.ConcreteArgument;
+import org.arend.ext.concrete.expr.ConcreteExpression;
+import org.arend.ext.core.context.CoreBinding;
+import org.arend.ext.core.definition.CoreClassDefinition;
+import org.arend.ext.core.definition.CoreClassField;
+import org.arend.ext.core.definition.CoreDefinition;
+import org.arend.ext.core.expr.CoreAbsExpression;
+import org.arend.ext.core.expr.CoreClassCallExpression;
+import org.arend.ext.core.expr.CoreExpression;
+import org.arend.ext.core.level.LevelSubstitution;
+import org.arend.ext.core.ops.SubstitutionPair;
+import org.arend.ext.error.TypecheckingError;
+import org.arend.ext.reference.ArendRef;
+import org.arend.ext.typechecking.BaseMetaDefinition;
+import org.arend.ext.typechecking.ContextData;
+import org.arend.ext.typechecking.ExpressionTypechecker;
+import org.arend.ext.typechecking.TypedExpression;
+import org.arend.lib.StdExtension;
+import org.arend.lib.util.Utils;
+import org.jetbrains.annotations.NotNull;
+import org.jetbrains.annotations.Nullable;
+
+import java.util.Collections;
+import java.util.List;
+
+public class DefaultImplMeta extends BaseMetaDefinition {
+  private final StdExtension ext;
+
+  public DefaultImplMeta(StdExtension ext) {
+    this.ext = ext;
+  }
+
+  @Override
+  public boolean @Nullable [] argumentExplicitness() {
+    return new boolean[] { true, true };
+  }
+
+  @Override
+  public int @Nullable [] desugarArguments(@NotNull List<? extends ConcreteArgument> arguments) {
+    if (arguments.size() <= 2) {
+      return new int[] {};
+    } else {
+      int[] result = new int[arguments.size() - 2];
+      for (int i = 2; i < arguments.size(); i++) {
+        result[i - 2] = i;
+      }
+      return result;
+    }
+  }
+
+  @Override
+  public @Nullable TypedExpression invokeMeta(@NotNull ExpressionTypechecker typechecker, @NotNull ContextData contextData) {
+    var args = contextData.getArguments();
+    ArendRef ref1 = Utils.getReference(args.get(0).getExpression(), typechecker.getErrorReporter());
+    if (ref1 == null) return null;
+    ArendRef ref2 = Utils.getReference(args.get(1).getExpression(), typechecker.getErrorReporter());
+    if (ref2 == null) return null;
+    ConcreteExpression arg = args.size() >= 3 ? args.get(2).getExpression() : null;
+
+    CoreDefinition def1 = ext.definitionProvider.getCoreDefinition(ref1);
+    if (!(def1 instanceof CoreClassDefinition classDef)) {
+      typechecker.getErrorReporter().report(new TypecheckingError("Expected a class", args.get(0).getExpression()));
+      return null;
+    }
+    CoreDefinition def2 = ext.definitionProvider.getCoreDefinition(ref2);
+    if (!(def2 instanceof CoreClassField fieldDef)) {
+      typechecker.getErrorReporter().report(new TypecheckingError("Expected a field", args.get(1).getExpression()));
+      return null;
+    }
+
+    CoreAbsExpression expr = classDef.getDefault(fieldDef);
+    if (expr == null) {
+      typechecker.getErrorReporter().report(new TypecheckingError("The default value is not defined", contextData.getMarker()));
+      return null;
+    }
+
+    ConcreteFactory factory = ext.factory.withData(contextData.getMarker());
+    if (arg == null) {
+      CoreBinding binding = typechecker.getThisBinding();
+      arg = binding != null && binding.getTypeExpr() instanceof CoreClassCallExpression classCall && classCall.getDefinition().isSubClassOf(classDef) ? factory.ref(binding) : factory.hole();
+    }
+    CoreExpression result = typechecker.substitute(expr.getExpression(), LevelSubstitution.EMPTY, Collections.singletonList(new SubstitutionPair(expr.getBinding(), arg)));
+    return result == null ? null : args.size() <= 3 ? result.computeTyped() : typechecker.typecheck(factory.app(factory.core(result.computeTyped()), args.subList(3, args.size())), contextData.getExpectedType());
+  }
+}
diff --git a/meta/src/main/java/org/arend/lib/meta/InMeta.java b/meta/src/main/java/org/arend/lib/meta/InMeta.java
index 675bb469..02031061 100644
--- a/meta/src/main/java/org/arend/lib/meta/InMeta.java
+++ b/meta/src/main/java/org/arend/lib/meta/InMeta.java
@@ -1,6 +1,9 @@
 package org.arend.lib.meta;
 
+import org.arend.ext.concrete.ConcreteFactory;
 import org.arend.ext.concrete.expr.ConcreteArgument;
+import org.arend.ext.concrete.expr.ConcreteExpression;
+import org.arend.ext.concrete.expr.ConcreteTupleExpression;
 import org.arend.ext.typechecking.BaseMetaDefinition;
 import org.arend.ext.typechecking.ContextData;
 import org.arend.ext.typechecking.ExpressionTypechecker;
@@ -9,6 +12,7 @@
 import org.jetbrains.annotations.NotNull;
 import org.jetbrains.annotations.Nullable;
 
+import java.util.ArrayList;
 import java.util.List;
 
 public class InMeta extends BaseMetaDefinition {
@@ -25,7 +29,23 @@ public boolean[] argumentExplicitness() {
 
   @Override
   public @Nullable TypedExpression invokeMeta(@NotNull ExpressionTypechecker typechecker, @NotNull ContextData contextData) {
+    ConcreteFactory factory = ext.factory.withData(contextData.getMarker());
     List<? extends ConcreteArgument> args = contextData.getArguments();
-    return typechecker.typecheck(ext.factory.withData(contextData.getMarker()).app(args.get(0).getExpression(), args.subList(1, args.size())), null);
+    ConcreteExpression arg = args.get(0).getExpression();
+    if (arg instanceof ConcreteTupleExpression tuple && tuple.getFields().size() != 1) {
+      var fields = tuple.getFields();
+      if (fields.isEmpty()) {
+        return typechecker.typecheck(factory.app(args.get(1).getExpression(), args.subList(2, args.size())), null);
+      }
+      List<ConcreteArgument> newArgs = new ArrayList<>(args);
+      newArgs.set(0, factory.arg(fields.get(0), true));
+      ConcreteExpression result = factory.app(contextData.getReferenceExpression(), newArgs);
+      for (int i = 1; i < fields.size() - 1; i++) {
+        result = factory.app(contextData.getReferenceExpression(), true, fields.get(i), result);
+      }
+      return typechecker.typecheck(factory.app(contextData.getReferenceExpression(), true, fields.get(fields.size() - 1), result), null);
+    } else {
+      return typechecker.typecheck(factory.app(arg, args.subList(1, args.size())), null);
+    }
   }
 }
diff --git a/meta/src/main/java/org/arend/lib/meta/UnfoldLetMeta.java b/meta/src/main/java/org/arend/lib/meta/UnfoldLetMeta.java
index c9bd3952..30d0d1e9 100644
--- a/meta/src/main/java/org/arend/lib/meta/UnfoldLetMeta.java
+++ b/meta/src/main/java/org/arend/lib/meta/UnfoldLetMeta.java
@@ -38,7 +38,7 @@ public boolean allowExcessiveArguments() {
       if (arg == null) {
         return null;
       }
-      return typechecker.replaceType(arg, arg.getType().normalize(NormalizationMode.RNF).unfold(Collections.emptySet(), null, true, false), contextData.getMarker());
+      return typechecker.replaceType(arg, arg.getType().normalize(NormalizationMode.RNF).unfold(Collections.emptySet(), null, true, false), contextData.getMarker(), false);
     }
   }
 }
diff --git a/meta/src/main/java/org/arend/lib/meta/UnfoldMeta.java b/meta/src/main/java/org/arend/lib/meta/UnfoldMeta.java
index 1a1c3426..16e7230e 100644
--- a/meta/src/main/java/org/arend/lib/meta/UnfoldMeta.java
+++ b/meta/src/main/java/org/arend/lib/meta/UnfoldMeta.java
@@ -110,7 +110,7 @@ public boolean allowExcessiveArguments() {
       if (arg == null) {
         return null;
       }
-      result = typechecker.replaceType(arg, arg.getType().normalize(NormalizationMode.RNF).unfold(functions, unfolded, false, unfoldFields), contextData.getMarker());
+      result = typechecker.replaceType(arg, arg.getType().normalize(NormalizationMode.RNF).unfold(functions, unfolded, false, unfoldFields), contextData.getMarker(), false);
     }
 
     if (firstArgList != null && unfolded.size() != functions.size()) {
diff --git a/meta/src/main/java/org/arend/lib/meta/UnfoldsMeta.java b/meta/src/main/java/org/arend/lib/meta/UnfoldsMeta.java
index 96582bd1..6484011b 100644
--- a/meta/src/main/java/org/arend/lib/meta/UnfoldsMeta.java
+++ b/meta/src/main/java/org/arend/lib/meta/UnfoldsMeta.java
@@ -51,7 +51,7 @@ private CoreExpression unfold(CoreExpression expr) {
       return typechecker.typecheck(contextData.getArguments().get(contextData.getArguments().size() - 1).getExpression(), unfold(contextData.getExpectedType()));
     } else {
       TypedExpression arg = typechecker.typecheck(contextData.getArguments().get(contextData.getArguments().size() - 1).getExpression(), null);
-      return arg == null ? null : typechecker.replaceType(arg, unfold(arg.getType()), contextData.getMarker());
+      return arg == null ? null : typechecker.replaceType(arg, unfold(arg.getType()), contextData.getMarker(), true);
     }
   }
 }
diff --git a/meta/src/main/java/org/arend/lib/meta/linear/CompiledTerm.java b/meta/src/main/java/org/arend/lib/meta/linear/CompiledTerm.java
index 6659edb6..e2e14634 100644
--- a/meta/src/main/java/org/arend/lib/meta/linear/CompiledTerm.java
+++ b/meta/src/main/java/org/arend/lib/meta/linear/CompiledTerm.java
@@ -4,16 +4,9 @@
 
 import java.math.BigInteger;
 import java.util.List;
+import java.util.Set;
 
-public class CompiledTerm {
-  public final ConcreteExpression concrete;
-  public final List<BigInteger> coefficients;
-
-  public CompiledTerm(ConcreteExpression concrete, List<BigInteger> coefficients) {
-    this.concrete = concrete;
-    this.coefficients = coefficients;
-  }
-
+public record CompiledTerm(ConcreteExpression concrete, List<BigInteger> coefficients, Set<Integer> vars) {
   public BigInteger getCoef(int i) {
     return i < coefficients.size() ? coefficients.get(i) : BigInteger.ZERO;
   }
diff --git a/meta/src/main/java/org/arend/lib/meta/linear/LinearSolver.java b/meta/src/main/java/org/arend/lib/meta/linear/LinearSolver.java
index b27729ec..f372239f 100644
--- a/meta/src/main/java/org/arend/lib/meta/linear/LinearSolver.java
+++ b/meta/src/main/java/org/arend/lib/meta/linear/LinearSolver.java
@@ -225,7 +225,7 @@ private List<BigInteger> solveEquations(List<? extends Equation<CompiledTerm>> e
           : equation1.operation == Equation.Operation.LESS || equation2.operation == Equation.Operation.LESS
             ? Equation.Operation.LESS
             : Equation.Operation.LESS_OR_EQUALS,
-          new CompiledTerm(null, lhs), new CompiledTerm(null, rhs)));
+          new CompiledTerm(null, lhs, Collections.emptySet()), new CompiledTerm(null, rhs, Collections.emptySet())));
       }
     }
 
@@ -274,7 +274,7 @@ private ConcreteExpression equationToConcrete(Equation<CompiledTerm> equation) {
       case LESS_OR_EQUALS -> ext.linearSolverMeta.lessOrEquals;
       case EQUALS -> ext.linearSolverMeta.equals;
     };
-    return factory.tuple(equation.lhsTerm.concrete, factory.ref(constructor.getRef()), equation.rhsTerm.concrete);
+    return factory.tuple(equation.lhsTerm.concrete(), factory.ref(constructor.getRef()), equation.rhsTerm.concrete());
   }
 
   private ConcreteExpression equationsToConcrete(List<? extends Hypothesis<CompiledTerm>> equations) {
@@ -304,17 +304,30 @@ private ConcreteExpression certificateToConcrete(List<BigInteger> certificate, L
     return factory.tuple(result, factory.number(certificate.get(0)), factory.ref(ext.prelude.getIdp().getRef()), factory.app(factory.ref(ext.prelude.getIdp().getRef()), factory.arg(factory.ref(ext.Bool.getRef()), false), factory.arg(factory.ref(ext.true_.getRef()), false)));
   }
 
+  private <E> void removeUnusedVariables(List<Hypothesis<CompiledTerm>> hypotheses, List<E> values) {
+    Set<Integer> vars = new HashSet<>();
+    for (Hypothesis<CompiledTerm> hypothesis : hypotheses) {
+      vars.addAll(hypothesis.lhsTerm.vars());
+      vars.addAll(hypothesis.rhsTerm.vars());
+    }
+    for (int i = 0; i < values.size(); i++) {
+      if (!vars.contains(i)) {
+        values.set(i, null);
+      }
+    }
+  }
+
   private ConcreteExpression makeData(CoreClassCallExpression classCall, ConcreteExpression instanceArg, RingKind kind, List<CoreExpression> valueList) {
     boolean isRing = kind != RingKind.NAT && kind != RingKind.NONE || classCall.getDefinition().isSubClassOf(ext.equationMeta.OrderedRing);
     ConcreteExpression varsArg = factory.ref(ext.prelude.getEmptyArray().getRef());
     for (int i = valueList.size() - 1; i >= 0; i--) {
-      varsArg = factory.app(factory.ref(ext.prelude.getArrayCons().getRef()), true, factory.core(null, valueList.get(i).computeTyped()), varsArg);
+      varsArg = factory.app(factory.ref(ext.prelude.getArrayCons().getRef()), true, valueList.get(i) == null ? factory.ref(ext.zro.getRef()) : factory.core(valueList.get(i).computeTyped()), varsArg);
     }
     return factory.newExpr(factory.classExt(factory.ref((kind == RingKind.RAT_ALG ? ext.linearSolverMeta.LinearRatAlgebraData : kind == RingKind.RAT ? ext.linearSolverMeta.LinearRatData : isRing ? ext.linearSolverMeta.LinearRingData : ext.linearSolverMeta.LinearSemiringData).getRef()), Arrays.asList(factory.implementation((ext.equationMeta.RingDataCarrier).getRef(), instanceArg), factory.implementation(ext.equationMeta.DataFunction.getRef(), varsArg))));
   }
 
   private Equation<CompiledTerm> makeZeroLessOne(CoreExpression instance) {
-    return new Equation<>(instance, Equation.Operation.LESS, new CompiledTerm(null, Collections.emptyList()), new CompiledTerm(null, Collections.singletonList(BigInteger.ONE)));
+    return new Equation<>(instance, Equation.Operation.LESS, new CompiledTerm(null, Collections.emptyList(), Collections.emptySet()), new CompiledTerm(null, Collections.singletonList(BigInteger.ONE), Collections.emptySet()));
   }
 
   private void makeZeroLessVar(CoreExpression instance, TermCompiler compiler, List<Hypothesis<CompiledTerm>> result) {
@@ -339,7 +352,8 @@ private void makeZeroLessVar(CoreExpression instance, TermCompiler compiler, Lis
           proof = factory.app(factory.ref(ext.linearSolverMeta.fromIntLE.getRef()), true, proof);
         }
       }
-      result.add(new Hypothesis<>(proof, instance, Equation.Operation.LESS_OR_EQUALS, new CompiledTerm(factory.ref(ext.equationMeta.zroTerm.getRef()), Collections.emptyList()), new CompiledTerm(factory.app(factory.ref(ext.equationMeta.varTerm.getRef()), true, factory.number(i - 1)), coefs), BigInteger.ONE));
+      int var = i - 1;
+      result.add(new Hypothesis<>(proof, instance, Equation.Operation.LESS_OR_EQUALS, new CompiledTerm(factory.ref(ext.equationMeta.zroTerm.getRef()), Collections.emptyList(), Collections.emptySet()), new CompiledTerm(factory.app(factory.ref(ext.equationMeta.varTerm.getRef()), true, factory.number(var)), coefs, Collections.singleton(var)), BigInteger.ONE));
     }
   }
 
@@ -471,11 +485,15 @@ public TypedExpression solve(CoreExpression expectedType, ConcreteExpression hin
             }
           }
           dropUnusedHypotheses(combinedSolutions, compiledRules);
+          List<CoreExpression> values = compiler.getValues().getValues();
+          List<Hypothesis<CompiledTerm>> newCompiledRules = new ArrayList<>(compiledRules);
+          newCompiledRules.add(new Hypothesis<>(null, null, null, compiledResults.term1, compiledResults.term2, BigInteger.ONE));
+          removeUnusedVariables(newCompiledRules, values);
           ConcreteAppBuilder builder = factory.appBuilder(factory.ref(function.getRef()))
-            .app(makeData(classCall, factory.core(instance), compiler.getKind(), compiler.getValues().getValues()), false)
+            .app(makeData(classCall, factory.core(instance), compiler.getKind(), values), false)
             .app(equationsToConcrete(compiledRules))
-            .app(compiledResults.term1.concrete)
-            .app(compiledResults.term2.concrete);
+            .app(compiledResults.term1.concrete())
+            .app(compiledResults.term2.concrete());
           for (int i = 0; i < solutions.size(); i++) {
             dropUnusedHypotheses(combinedSolutions, solutions.get(i).subList(2, solutions.get(i).size()));
             dropUnusedHypotheses(combinedSolutions, rulesSet.get(i).subList(2, rulesSet.get(i).size()));
@@ -501,7 +519,7 @@ public TypedExpression solve(CoreExpression expectedType, ConcreteExpression hin
               break;
             } else if (kind != RingKind.NAT) {
               RingKind newKind = BaseTermCompiler.getTermCompilerKind(newRules.get(0).instance, ext.equationMeta);
-              if (kind == RingKind.NONE || newKind == RingKind.NONE || kind.ordinal() > newKind.ordinal()) {
+              if (kind == RingKind.NONE && newKind != RingKind.RAT || newKind == RingKind.NONE || kind.ordinal() > newKind.ordinal() && !(newKind == RingKind.RAT && kind == RingKind.NONE)) {
                 found = true;
                 List<Hypothesis<CoreExpression>> newRules2 = new ArrayList<>(newRules.size() + 1);
                 boolean remove = true;
@@ -548,8 +566,10 @@ public TypedExpression solve(CoreExpression expectedType, ConcreteExpression hin
             dropUnusedHypotheses(subList, compiledEquations1.subList(1, compiledEquations1.size()));
             dropUnusedHypotheses(subList, subList);
             solutionFound[0] = true;
+            List<CoreExpression> values = compiler.getValues().getValues();
+            removeUnusedVariables(compiledEquations, values);
             return tc.typecheck(factory.appBuilder(factory.ref(ext.linearSolverMeta.solveContrProblem.getRef()))
-              .app(makeData(classCall, factory.core(instance), compiler.getKind(), compiler.getValues().getValues()), false)
+              .app(makeData(classCall, factory.core(instance), compiler.getKind(), values), false)
               .app(equationsToConcrete(compiledEquations))
               .app(certificateToConcrete(solution, compiledEquations1))
               .app(witnessesToConcrete(compiledEquations))
diff --git a/meta/src/main/java/org/arend/lib/meta/linear/TermCompiler.java b/meta/src/main/java/org/arend/lib/meta/linear/TermCompiler.java
index 5e2a495f..39d3bfb6 100644
--- a/meta/src/main/java/org/arend/lib/meta/linear/TermCompiler.java
+++ b/meta/src/main/java/org/arend/lib/meta/linear/TermCompiler.java
@@ -68,14 +68,16 @@ public int getNumberOfVariables() {
     return values.getValues().size();
   }
 
+  private record MyCompiledTerm(ConcreteExpression concrete, List<Ring> coefficients, Set<Integer> vars) {}
+
   @SuppressWarnings("unchecked")
   public CompiledTerms compileTerms(CoreExpression expr1, CoreExpression expr2) {
-    Pair<ConcreteExpression, List<Ring>> pair1 = compileTerm(expr1);
-    Pair<ConcreteExpression, List<Ring>> pair2 = compileTerm(expr2);
+    MyCompiledTerm term1 = compileTerm(expr1);
+    MyCompiledTerm term2 = compileTerm(expr2);
     if (kind == RingKind.RAT || kind == RingKind.RAT_ALG) {
       BigInteger lcm = BigInteger.ONE;
-      List<BigRational> list1 = (List<BigRational>) (List<?>) pair1.proj2;
-      List<BigRational> list2 = (List<BigRational>) (List<?>) pair2.proj2;
+      List<BigRational> list1 = (List<BigRational>) (List<?>) term1.coefficients;
+      List<BigRational> list2 = (List<BigRational>) (List<?>) term2.coefficients;
       for (BigRational rat : list1) {
         lcm = lcm.divide(lcm.gcd(rat.denom)).multiply(rat.denom);
       }
@@ -90,37 +92,38 @@ public CompiledTerms compileTerms(CoreExpression expr1, CoreExpression expr2) {
       for (BigRational rat : list2) {
         coefs2.add(rat.nom.multiply(lcm.divide(rat.denom)));
       }
-      return new CompiledTerms(new CompiledTerm(pair1.proj1, coefs1), new CompiledTerm(pair2.proj1, coefs2), lcm);
+      return new CompiledTerms(new CompiledTerm(term1.concrete, coefs1, term1.vars), new CompiledTerm(term2.concrete, coefs2, term2.vars), lcm);
     } else {
-      List<BigInteger> coefs1 = new ArrayList<>(pair1.proj2.size());
-      for (Ring ring : pair1.proj2) {
+      List<BigInteger> coefs1 = new ArrayList<>(term1.coefficients.size());
+      for (Ring ring : term1.coefficients) {
         coefs1.add(((IntRing) ring).number);
       }
-      List<BigInteger> coefs2 = new ArrayList<>(pair2.proj2.size());
-      for (Ring ring : pair2.proj2) {
+      List<BigInteger> coefs2 = new ArrayList<>(term2.coefficients.size());
+      for (Ring ring : term2.coefficients) {
         coefs2.add(((IntRing) ring).number);
       }
-      return new CompiledTerms(new CompiledTerm(pair1.proj1, coefs1), new CompiledTerm(pair2.proj1, coefs2), BigInteger.ONE);
+      return new CompiledTerms(new CompiledTerm(term1.concrete, coefs1, term1.vars), new CompiledTerm(term2.concrete, coefs2, term2.vars), BigInteger.ONE);
     }
   }
 
-  private Pair<ConcreteExpression, List<Ring>> compileTerm(CoreExpression expression) {
+  private MyCompiledTerm compileTerm(CoreExpression expression) {
     Map<Integer, Ring> coefficients = new HashMap<>();
     Ring[] freeCoef = new Ring[] { getZero() };
-    ConcreteExpression concrete = computeTerm(expression, coefficients, freeCoef);
+    Set<Integer> vars = new HashSet<>();
+    ConcreteExpression concrete = computeTerm(expression, coefficients, freeCoef, vars);
     List<Ring> resultCoefs = new ArrayList<>(getNumberOfVariables());
     resultCoefs.add(freeCoef[0]);
     for (int i = 0; i < getNumberOfVariables(); i++) {
       Ring coef = coefficients.get(i);
       resultCoefs.add(coef == null ? getZero() : coef);
     }
-    return new Pair<>(concrete, resultCoefs);
+    return new MyCompiledTerm(concrete, resultCoefs, vars);
   }
 
-  private ConcreteExpression computeNegative(CoreExpression arg, Map<Integer, Ring> coefficients, Ring[] freeCoef) {
+  private ConcreteExpression computeNegative(CoreExpression arg, Map<Integer, Ring> coefficients, Ring[] freeCoef, Set<Integer> vars) {
     Map<Integer, Ring> newCoefficients = new HashMap<>();
     Ring[] newFreeCoef = new Ring[] { getZero() };
-    ConcreteExpression term = computeTerm(arg, newCoefficients, newFreeCoef);
+    ConcreteExpression term = computeTerm(arg, newCoefficients, newFreeCoef, vars);
     if (term == null) return null;
     for (Map.Entry<Integer, Ring> entry : newCoefficients.entrySet()) {
       coefficients.compute(entry.getKey(), (k,v) -> v == null ? entry.getValue().negate() : v.subtract(entry.getValue()));
@@ -129,22 +132,22 @@ private ConcreteExpression computeNegative(CoreExpression arg, Map<Integer, Ring
     return factory.app(factory.ref(meta.negativeTerm.getRef()), true, term);
   }
 
-  private ConcreteExpression computePlus(CoreExpression arg1, CoreExpression arg2, Map<Integer, Ring> coefficients, Ring[] freeCoef) {
-    return factory.app(factory.ref(meta.addTerm.getRef()), true, computeTerm(arg1, coefficients, freeCoef), computeTerm(arg2, coefficients, freeCoef));
+  private ConcreteExpression computePlus(CoreExpression arg1, CoreExpression arg2, Map<Integer, Ring> coefficients, Ring[] freeCoef, Set<Integer> vars) {
+    return factory.app(factory.ref(meta.addTerm.getRef()), true, computeTerm(arg1, coefficients, freeCoef, vars), computeTerm(arg2, coefficients, freeCoef, vars));
   }
 
-  private ConcreteExpression computeMinus(CoreExpression arg1, CoreExpression arg2, Map<Integer, Ring> coefficients, Ring[] freeCoef) {
-    ConcreteExpression cArg1 = computeTerm(arg1, coefficients, freeCoef);
-    ConcreteExpression cArg2 = computeNegative(arg2, coefficients, freeCoef);
+  private ConcreteExpression computeMinus(CoreExpression arg1, CoreExpression arg2, Map<Integer, Ring> coefficients, Ring[] freeCoef, Set<Integer> vars) {
+    ConcreteExpression cArg1 = computeTerm(arg1, coefficients, freeCoef, vars);
+    ConcreteExpression cArg2 = computeNegative(arg2, coefficients, freeCoef, vars);
     return factory.app(factory.ref(meta.addTerm.getRef()), true, cArg1, cArg2);
   }
 
-  private ConcreteExpression computeMul(CoreExpression arg1, CoreExpression arg2, CoreExpression expr, Map<Integer, Ring> coefficients, Ring[] freeCoef) {
+  private ConcreteExpression computeMul(CoreExpression arg1, CoreExpression arg2, CoreExpression expr, Map<Integer, Ring> coefficients, Ring[] freeCoef, Set<Integer> vars) {
     int valuesSize = values.getValues().size();
     Map<Integer, Ring> coefficients1 = new HashMap<>(), coefficients2 = new HashMap<>();
     Ring[] freeCoef1 = new Ring[] { getZero() }, freeCoef2 = new Ring[] { getZero() };
-    ConcreteExpression leftTerm = computeTerm(arg1, coefficients1, freeCoef1);
-    ConcreteExpression rightTerm = computeTerm(arg2, coefficients2, freeCoef2);
+    ConcreteExpression leftTerm = computeTerm(arg1, coefficients1, freeCoef1, vars);
+    ConcreteExpression rightTerm = computeTerm(arg2, coefficients2, freeCoef2, vars);
     if (leftTerm == null || rightTerm == null) return null;
     if (coefficients1.isEmpty() && coefficients2.isEmpty()) {
       freeCoef[0] = freeCoef[0].add(freeCoef1[0].multiply(freeCoef2[0]));
@@ -161,12 +164,12 @@ private ConcreteExpression computeMul(CoreExpression arg1, CoreExpression arg2,
       freeCoef[0] = freeCoef[0].add(freeCoef1[0].multiply(freeCoef2[0]));
     } else {
       values.getValues().subList(valuesSize, values.getValues().size()).clear();
-      return computeVal(expr, coefficients);
+      return computeVal(expr, coefficients, vars);
     }
     return factory.app(factory.ref(meta.mulTerm.getRef()), true, leftTerm, rightTerm);
   }
 
-  private ConcreteExpression computeVal(CoreExpression expr, Map<Integer, Ring> coefficients) {
+  private ConcreteExpression computeVal(CoreExpression expr, Map<Integer, Ring> coefficients, Set<Integer> vars) {
     if (toInt) {
       expr = toPos(expr, typechecker, factory, meta.ext);
       if (expr == null) return null;
@@ -175,6 +178,7 @@ private ConcreteExpression computeVal(CoreExpression expr, Map<Integer, Ring> co
       if (expr == null) return null;
     }
     int index = values.addValue(expr);
+    vars.add(index);
     if (toInt) {
       positiveVars.add(index);
     }
@@ -182,7 +186,7 @@ private ConcreteExpression computeVal(CoreExpression expr, Map<Integer, Ring> co
     return factory.app(factory.ref(meta.varTerm.getRef()), true, factory.number(index));
   }
 
-  private ConcreteExpression computeTerm(CoreExpression expression, Map<Integer, Ring> coefficients, Ring[] freeCoef) {
+  private ConcreteExpression computeTerm(CoreExpression expression, Map<Integer, Ring> coefficients, Ring[] freeCoef, Set<Integer> vars) {
     CoreExpression expr = expression.getUnderlyingExpression();
     if (expr instanceof CoreAppExpression || expr instanceof CoreFieldCallExpression) {
       CoreFieldCallExpression fieldCall = null;
@@ -213,11 +217,11 @@ private ConcreteExpression computeTerm(CoreExpression expression, Map<Integer, R
             freeCoef[0] = freeCoef[0].add(getOne());
             return factory.ref(meta.ideTerm.getRef());
           } else if (field == meta.negative) {
-            return computeNegative(arg1, coefficients, freeCoef);
+            return computeNegative(arg1, coefficients, freeCoef, vars);
           } else if (field == meta.plus) {
-            return computePlus(arg1, arg2, coefficients, freeCoef);
+            return computePlus(arg1, arg2, coefficients, freeCoef, vars);
           } else if (field == meta.mul) {
-            return computeMul(arg1, arg2, expr, coefficients, freeCoef);
+            return computeMul(arg1, arg2, expr, coefficients, freeCoef, vars);
           }
         }
       }
@@ -230,7 +234,7 @@ private ConcreteExpression computeTerm(CoreExpression expression, Map<Integer, R
 
     List<CoreExpression> addArgs = addMatcher.match(expr);
     if (addArgs != null) {
-      return computePlus(addArgs.get(addArgs.size() - 2), addArgs.get(addArgs.size() - 1), coefficients, freeCoef);
+      return computePlus(addArgs.get(addArgs.size() - 2), addArgs.get(addArgs.size() - 1), coefficients, freeCoef, vars);
     }
 
     if (ideMatcher.match(expr) != null) {
@@ -241,14 +245,14 @@ private ConcreteExpression computeTerm(CoreExpression expression, Map<Integer, R
     if (subTermCompiler != null && subTermCompiler.minusMatcher != null) {
       List<CoreExpression> minusArgs = subTermCompiler.minusMatcher.match(expr);
       if (minusArgs != null) {
-        return getSubTermCompiler().computeMinus(minusArgs.get(0), minusArgs.get(1), coefficients, freeCoef);
+        return getSubTermCompiler().computeMinus(minusArgs.get(0), minusArgs.get(1), coefficients, freeCoef, vars);
       }
     }
 
     if (negativeMatcher != null) {
       List<CoreExpression> negativeArgs = negativeMatcher.match(expr);
       if (negativeArgs != null) {
-        return computeNegative(negativeArgs.get(0), coefficients, freeCoef);
+        return computeNegative(negativeArgs.get(0), coefficients, freeCoef, vars);
       }
     }
 
@@ -272,7 +276,7 @@ private ConcreteExpression computeTerm(CoreExpression expression, Map<Integer, R
       if (denom != null && denom.equals(BigInteger.ONE) && subTermCompiler != null) {
         Map<Integer, Ring> newCoefficients = new HashMap<>();
         Ring[] newFreeCoef = new Ring[] { IntRing.ZERO };
-        ConcreteExpression term = getSubTermCompiler().computeTerm(nomExpr, newCoefficients, newFreeCoef);
+        ConcreteExpression term = getSubTermCompiler().computeTerm(nomExpr, newCoefficients, newFreeCoef, vars);
         if (term != null) {
           for (Map.Entry<Integer, Ring> entry : newCoefficients.entrySet()) {
             BigRational value = BigRational.makeInt(((IntRing) entry.getValue()).number);
@@ -301,7 +305,7 @@ private ConcreteExpression computeTerm(CoreExpression expression, Map<Integer, R
       } else if (subTermCompiler != null) {
         Map<Integer, Ring> newCoefficients = new HashMap<>();
         Ring[] newFreeCoef = new Ring[] { getZero() };
-        ConcreteExpression term = getSubTermCompiler().computeTerm(arg, newCoefficients, newFreeCoef);
+        ConcreteExpression term = getSubTermCompiler().computeTerm(arg, newCoefficients, newFreeCoef, vars);
         if (term != null) {
           for (Map.Entry<Integer, Ring> entry : newCoefficients.entrySet()) {
             coefficients.compute(entry.getKey(), (k,v) -> v == null ? (isNeg ? entry.getValue().negate() : entry.getValue()) : isNeg ? v.subtract(entry.getValue()) : v.add(entry.getValue()));
@@ -314,10 +318,10 @@ private ConcreteExpression computeTerm(CoreExpression expression, Map<Integer, R
 
     List<CoreExpression> mulArgs = mulMatcher.match(expr);
     if (mulArgs != null) {
-      return computeMul(mulArgs.get(mulArgs.size() - 2), mulArgs.get(mulArgs.size() - 1), expr, coefficients, freeCoef);
+      return computeMul(mulArgs.get(mulArgs.size() - 2), mulArgs.get(mulArgs.size() - 1), expr, coefficients, freeCoef, vars);
     }
 
-    return computeVal(expr, coefficients);
+    return computeVal(expr, coefficients, vars);
   }
 
   public static CoreExpression toPos(CoreExpression expr, ExpressionTypechecker typechecker, ConcreteFactory factory, StdExtension ext) {
diff --git a/meta/src/main/java/org/arend/lib/util/Utils.java b/meta/src/main/java/org/arend/lib/util/Utils.java
index 8ba47d46..60edeede 100644
--- a/meta/src/main/java/org/arend/lib/util/Utils.java
+++ b/meta/src/main/java/org/arend/lib/util/Utils.java
@@ -472,4 +472,13 @@ public static ConcreteExpression resolvePrefixAsInfix(MetaResolver metaResolver,
       return normalResolve(resolver, contextData, null, null, factory);
     }
   }
+
+  public static ArendRef getReference(ConcreteExpression expr, ErrorReporter errorReporter) {
+    if (expr instanceof ConcreteReferenceExpression refExpr) {
+      return refExpr.getReferent();
+    }
+
+    errorReporter.report(new TypecheckingError("Expected a reference", expr));
+    return null;
+  }
 }
diff --git a/src/Algebra/Group/Solver.ard b/src/Algebra/Group/Solver.ard
index f66924ac..2070dc71 100644
--- a/src/Algebra/Group/Solver.ard
+++ b/src/Algebra/Group/Solver.ard
@@ -24,7 +24,7 @@
 \import Set
 \open Sort
 \open OrderedAddMonoid
-\open LinearlyOrderedSemiring \hiding (Dec)
+\open LinearlyOrderedAbMonoid
 
 \data GroupTerm (V : \Type)
   | var V
diff --git a/src/Algebra/Linear/Solver.ard b/src/Algebra/Linear/Solver.ard
index cbdb296d..fd1857a6 100644
--- a/src/Algebra/Linear/Solver.ard
+++ b/src/Algebra/Linear/Solver.ard
@@ -13,6 +13,7 @@
 \import Order.PartialOrder
 \import Order.StrictOrder
 \import Paths
+\open LinearlyOrderedAbMonoid
 
 \data Operation | Less | LessOrEquals | Equals
 
@@ -97,7 +98,7 @@
     \where \lemma aux => inv (interpretCert_certSum (map __.1 p)) *> c.3 *> interpretCert_certSum (:ide :: map __.3 p) {c.2 :: c.1}
 
   \lemma certToLess (p : Problem) (c : CorrectCert p) (q : isSuc c.2 = true) : certSum (map __.3 p) c.1 < certSum (map __.1 p) c.1
-    => transport2 (<) zro-left (inv certToLeq.aux) $ <=_+-right (transport (`< _) ide-right $ <_*_positive-left (natCoef>0 (isSuc.correct q)) zro<ide) <=-refl
+    => transport2 (<) zro-left (inv certToLeq.aux) $ LinearlyOrderedAbMonoid.<=_+-right (transport (`< _) ide-right $ <_*_positive-left (natCoef>0 (isSuc.correct q)) zro<ide) <=-refl
 
   \lemma solveContrProblem (p : Problem) (c : CorrectCert p) (h : DArray (\lam j => interpretEq (p j))) : Empty
     => \case or.toOr c.4 \with {
diff --git a/src/Algebra/Ordered.ard b/src/Algebra/Ordered.ard
index e979d3f8..3dc3b345 100644
--- a/src/Algebra/Ordered.ard
+++ b/src/Algebra/Ordered.ard
@@ -143,11 +143,20 @@
 
   \lemma negative_<-right {x y : E} (p : x < negative y) : y < negative x
     => transport (`< _) negative-isInv (negative_< p)
+
+  \lemma <-diff-mid {x y z : E} (p : x - y < z) : x < z + y
+    => simplify in <_+-left y p
+
+  \lemma <-diff-mid-conv {x y z : E} (p : x < z + y) : x - y < z
+    => simplify in <_+-left (negative y) p
 } \where {
   \type \infix 4 < {A : PreorderedAddGroup} (x y : A) => isPos (y - x)
 }
 
-\class OrderedAbGroup \extends OrderedAbMonoid, OrderedAddGroup, AbGroup
+\class OrderedAbGroup \extends OrderedAbMonoid, OrderedAddGroup, AbGroup {
+  \lemma <-diff-left {x y z : E} (p : x - y < z) : x - z < y
+    => (simplify, rewrite +-comm) in <_+-right (negative z) (<-diff-mid p)
+}
 
 \class LinearlyOrderedAbGroup \extends OrderedAbGroup, LinearlyOrderedAbMonoid {
   | <_+-comparison (x y : E) : isPos (x + y) -> isPos x || isPos y
@@ -197,6 +206,21 @@
 
   \lemma abs_+ {x y : E} : abs (x + y) <= abs x + abs y
     => join-univ (<=_+ join-left join-left) $ rewrite (negative_+,+-comm) $ <=_+ join-right join-right
+
+  \lemma abs_- {x y : E} : abs x - abs y <= abs (x - y)
+    => transport (_ <=) (+-assoc *> pmap (_ +) negative-right *> zro-right) $ <=_+ (transport (abs __ <= _) (+-assoc *> pmap (x +) negative-left *> zro-right) abs_+) <=-refl
+
+  \lemma abs_-' {x y : E} : abs y - abs x <= abs (x - y)
+    => transport (_ <=) (simplify *> abs_negative) abs_-
+
+  \lemma abs_zro : abs zro = zro
+    => <=-antisymmetric (join-univ <=-refl $ rewrite negative_zro <=-refl) abs>=0
+
+  \lemma abs_zro-ext {x : E} (p : abs x = zro) : x = zro
+    => <=-antisymmetric (transport (_ <=) p join-left) $ transport2 (<=) negative_zro negative-isInv $ negative_<= $ transport (_ <=) p join-right
+
+  \lemma abs_-_< {x y z : E} (p : x - y < z) (q : y - x < z) : abs (x - y) < z
+    => LinearOrder.<_join-univ p (simplify q)
 }
 
 \class OrderedSemiring \extends Semiring, OrderedAbMonoid {
diff --git a/src/Algebra/Ring.ard b/src/Algebra/Ring.ard
index c2758809..063c5caa 100644
--- a/src/Algebra/Ring.ard
+++ b/src/Algebra/Ring.ard
@@ -216,7 +216,7 @@
     {- 2 -} \Pi (I : Ideal \this) -> I.IsFinitelyGenerated -> ∃ (u : E) (u * u = u) (I.IsGeneratedBy1 u),
     {- 3 -} \Pi (I : Ideal \this) -> I IdealMonoid.* I = I,
     {- 4 -} \Pi (I J : Ideal \this) -> I ∧ J = I IdealMonoid.* J
-  ) => TFAE.proof $ later (
+  ) => TFAE.proof (
     ((0,1), \lam c => (\lam a => TruncP.map (c a) \lam s => (s.1, 1, equation {usingOnly s.2}),
                        \new ReducedRing { | isReduced {a} p => \case c a \with {
                          | inP (b,q) => equation
@@ -238,8 +238,7 @@
         | inP (b,p) => rewrite p $ closure-superset {_} {_} {IdealMonoid.func I J} $ later (a * b, a, ideal-right (IdealLattice.meet-left c), IdealLattice.meet-right c)
       }) IdealMonoid.product_meet),
     ((4,3), \lam f I => inv (f I I) *> IdealLattice.meet-idemp),
-    ((3,2), \lam f I Ifg => nakayama-ideal Ifg (Preorder.=_<= (inv (f I)))
-    )
+    ((3,2), \lam f I Ifg => nakayama-ideal Ifg (Preorder.=_<= (inv (f I))))
   )
   \where \open Ideal
 
diff --git a/src/Arith/Complex.ard b/src/Arith/Complex.ard
index 3ce0c479..4094e157 100644
--- a/src/Arith/Complex.ard
+++ b/src/Arith/Complex.ard
@@ -13,7 +13,7 @@
 \import Order.StrictOrder
 \import Paths
 \import Paths.Meta
-\import Topology.CoverSpace.Real
+\import Arith.Real.Field
 
 \record Complex (re im : Real)
 
@@ -49,8 +49,8 @@
                       | byRight r => byRight $ Inv.cfactor-right $ transportInv Inv Ring.negative_*-left r
                     },
           \lam p => \have d : Inv (x.re * x.re + x.im * x.im) => RealField.positive=>#0 $ RealField.>0_pos {x.re * x.re + x.im * x.im} (transport (0 <) linarith $ RealField.sum_squares_>0 {x.re,x.im} \case \elim p \with {
-                      | byLeft r => inP (0, ||.map real_<_L.2 real_<_U.2 $ #0=>eitherPosOrNeg r)
-                      | byRight r => inP (1, ||.map real_<_L.2 real_<_U.2 $ #0=>eitherPosOrNeg r)
+                      | byLeft r => inP (0, ||.map real_<_L.2 (\lam c => real_<_U.2 $ RealAbGroup.negative_L.1 c) $ #0=>eitherPosOrNeg r)
+                      | byRight r => inP (1, ||.map real_<_L.2 (\lam c => real_<_U.2 $ RealAbGroup.negative_L.1 c) $ #0=>eitherPosOrNeg r)
                     })
                     \in Inv.lmake (\new Complex (x.re * d.inv) (negative (x.im * d.inv))) $ ext (equation {usingOnly d.inv-left}, equation))
   }
\ No newline at end of file
diff --git a/src/Arith/Nat.ard b/src/Arith/Nat.ard
index 293bf9d9..0db75796 100644
--- a/src/Arith/Nat.ard
+++ b/src/Arith/Nat.ard
@@ -1,5 +1,5 @@
 \import Algebra.Monoid(Monoid)
-\import Algebra.Ordered(<_+-right, LinearlyOrderedCSemiring, LinearlyOrderedSemiring)
+\import Algebra.Ordered
 \import Data.Bool
 \import Data.Or
 \import Equiv (QEquiv)
@@ -17,6 +17,7 @@
 \import Set (==, ==_=, Dec)
 \import Set.Fin
 \open Nat
+\open LinearlyOrderedAbMonoid
 
 -- # Various operations
 
@@ -307,7 +308,7 @@
 \lemma mod_Fin=id {n : Nat} {k : Fin n} {p : 0 < n} : mod_Fin k p = k
   => fin_nat-inj $ mod_Fin_< (fin_< k)
 
-\open NatSemiring
+\open NatSemiring \hiding (<_*_positive-left, <_+-left)
 
 \lemma mod-unique {n q r q' r' : Nat} (r<n : r < n) (r'<n : r' < n) (p : n * q + r = n * q' + r') : r = r' \elim q, q'
   | 0, 0 => p
diff --git a/src/Arith/Real.ard b/src/Arith/Real.ard
index 308a0c88..9fde77e1 100644
--- a/src/Arith/Real.ard
+++ b/src/Arith/Real.ard
@@ -33,25 +33,39 @@
 
 \instance LowerRealAbMonoid : AbMonoid LowerReal
   | zro => Real.fromRat 0
-  | + (x y : LowerReal) : LowerReal \cowith {
-    | L a => ∃ (b : x.L) (c : y.L) (a < b RatField.+ c)
-    | L-inh => \case x.L-inh, y.L-inh \with {
-      | inP (a,a<x), inP (b,b<y) => inP (a RatField.+ b - 1, inP (a, a<x, b, b<y, linarith))
-    }
-    | L-closed (inP (a,a<x,b,b<y,q<a+b)) q'<q => inP (a, a<x, b, b<y, q'<q <∘ q<a+b)
-    | L-rounded {q} (inP (a,a<x,b,b<y,q<a+b)) => inP (RatField.mid q (a RatField.+ b), inP (a, a<x, b, b<y, RatField.mid<right q<a+b), RatField.mid>left q<a+b)
-  }
-  | zro-left => exts \lam a => ext (\lam (inP (b,b<0,c,c<x,a<b+c)) => L-closed c<x linarith, \lam a<x => \case L-rounded a<x \with {
-    | inP (b,b<x,a<b) => inP ((a - b) * ratio 1 2, linarith, b, b<x, linarith)
-  })
-  | +-assoc => exts \lam a => ext (\lam (inP (b, inP (d,d<x,e,e<y,b<d+e), c, c<z,a<b+c)) => inP (d, d<x, (a - d RatField.+ c RatField.+ e) * ratio 1 2, inP (e, e<y, c, c<z, linarith), linarith),
-                                   \lam (inP (b, b<x, c, inP (d,d<y,e,e<z,c<d+e), a<b+c)) => inP ((a - e RatField.+ b RatField.+ d) * ratio 1 2, inP (b, b<x, d, d<y, linarith), e, e<z, linarith))
-  | +-comm => exts \lam a => ext (\lam (inP (b,b<x,c,c<y,a<b+c)) => inP (c, c<y, b, b<x, rewrite RatField.+-comm a<b+c),
-                                  \lam (inP (c,c<y,b,b<x,a<c+b)) => inP (b, b<x, c, c<y, rewrite RatField.+-comm a<c+b))
+  | + => +
+  | zro-left => (\peval _ + _) *> exts \lam a => ext (\lam (inP (b,b<0,c,c<x,a<b+c)) => L-closed c<x linarith, \lam a<x => \case L-rounded a<x \with {
+      | inP (b,b<x,a<b) => inP ((a - b) * ratio 1 2, linarith, b, b<x, linarith)
+    })
+  | +-assoc => exts (\lam a => ext (\lam r => \case +_L.1 r \with {
+      | inP (b, r', c, c<z,a<b+c) => \case +_L.1 r' \with {
+        | inP (d,d<x,e,e<y,b<d+e) => +_L.2 $ inP (d, d<x, (a - d RatField.+ c RatField.+ e) * ratio 1 2, +_L.2 $ inP (e, e<y, c, c<z, linarith), linarith)
+      }
+    }, \lam r => \case +_L.1 r \with {
+      | inP (b, b<x, c, r', a<b+c) => \case +_L.1 r' \with {
+        | inP (d,d<y,e,e<z,c<d+e) => +_L.2 $ inP ((a - e RatField.+ b RatField.+ d) * ratio 1 2, +_L.2 $ inP (b, b<x, d, d<y, linarith), e, e<z, linarith)
+      }
+    }))
+  | +-comm => exts (\lam a => ext (\lam r => \case +_L.1 r \with {
+      | inP (b,b<x,c,c<y,a<b+c) => +_L.2 $ inP $ later (c, c<y, b, b<x, rewrite RatField.+-comm a<b+c)
+    }, \lam r => \case +_L.1 r \with {
+      | inP (c,c<y,b,b<x,a<c+b) => +_L.2 $ inP $ later (b, b<x, c, c<y, rewrite RatField.+-comm a<c+b)
+    }))
   \where {
+    \sfunc \infixl 6 + (x y : LowerReal) : LowerReal \cowith
+      | L a => ∃ (b : x.L) (c : y.L) (a < b RatField.+ c)
+      | L-inh => \case x.L-inh, y.L-inh \with {
+        | inP (a,a<x), inP (b,b<y) => inP (a RatField.+ b - 1, inP (a, a<x, b, b<y, linarith))
+      }
+      | L-closed (inP (a,a<x,b,b<y,q<a+b)) q'<q => inP (a, a<x, b, b<y, q'<q <∘ q<a+b)
+      | L-rounded {q} (inP (a,a<x,b,b<y,q<a+b)) => inP (RatField.mid q (a RatField.+ b), inP (a, a<x, b, b<y, RatField.mid<right q<a+b), RatField.mid>left q<a+b)
+
+    \lemma +_L {x y : LowerReal} {a : Rat} : Real.L {x + y} a <-> ∃ (b : x.L) (c : y.L) (a < b RatField.+ c)
+      => rewrite (\peval x + y) <->refl
+
     \lemma +-rat {x y : Rat} : Real.fromRat x + Real.fromRat y = {LowerReal} Real.fromRat (x RatField.+ y)
-      => exts \lam a => ext (\lam (inP (b,b<x,c,c<y,a<b+c)) => a<b+c <∘ OrderedAddMonoid.<_+ b<x c<y,
-                             \lam a<x+y => inP (x - (x RatField.+ y - a) * ratio 1 3, linarith, y - (x RatField.+ y - a) * ratio 1 3, linarith, linarith))
+      => (\peval _ + _) *> {LowerReal} exts \lam a => ext (\lam (inP (b,b<x,c,c<y,a<b+c)) => a<b+c <∘ OrderedAddMonoid.<_+ b<x c<y,
+            \lam a<x+y => inP (x - (x RatField.+ y - a) * ratio 1 3, linarith, y - (x RatField.+ y - a) * ratio 1 3, linarith, linarith))
   }
 
 \instance LowerRealLattice : Lattice LowerReal
@@ -59,39 +73,48 @@
   | <=-refl a<x => a<x
   | <=-transitive p q a<x => q (p a<x)
   | <=-antisymmetric p q => exts \lam a => ext (p,q)
-  | meet (x y : LowerReal) : LowerReal \cowith {
-    | L a => \Sigma (x.L a) (y.L a)
-    | L-inh => \case x.L-inh, y.L-inh \with {
-      | inP (a,a<x), inP (b,b<y) => inP (a ∧ b, (x.L_<= a<x meet-left, y.L_<= b<y meet-right))
-    }
-    | L-closed (q<x,q<y) q'<q => (x.L-closed q<x q'<q, y.L-closed q<y q'<q)
-    | L-rounded (q<x,q<y) => \case x.L-rounded q<x, y.L-rounded q<y \with {
-      | inP (r,r<x,q<r), inP (r',r'<y,q<r') => inP (r ∧ r', (x.L_<= r<x meet-left, y.L_<= r'<y meet-right), <_meet-univ q<r q<r')
-    }
+  | meet => meet
+  | meet-left s => (meet_L.1 s).1
+  | meet-right s => (meet_L.1 s).2
+  | meet-univ z<=x z<=y a<z => meet_L.2 (z<=x a<z, z<=y a<z)
+  | join => join
+  | join-left a<x => join_L.2 (byLeft a<x)
+  | join-right a<y => join_L.2 (byRight a<y)
+  | join-univ x<=z y<=z r => \case join_L.1 r \with {
+    | byLeft a<x => x<=z a<x
+    | byRight a<y => y<=z a<y
   }
-  | meet-left s => s.1
-  | meet-right s => s.2
-  | meet-univ z<=x z<=y a<z => (z<=x a<z, z<=y a<z)
-  | join (x y : LowerReal) : LowerReal \cowith {
-    | L a => x.L a || y.L a
-    | L-inh => \case x.L-inh \with {
-      | inP (a,a<x) => inP (a, byLeft a<x)
-    }
-    | L-closed e q'<q => ||.map (x.L-closed __ q'<q) (y.L-closed __ q'<q) e
-    | L-rounded => \case \elim __ \with {
-      | byLeft q<x => \case x.L-rounded q<x \with {
-        | inP (r,r<x,q<r) => inP (r, byLeft r<x, q<r)
+  \where {
+    \sfunc meet (x y : LowerReal) : LowerReal \cowith
+      | L a => \Sigma (x.L a) (y.L a)
+      | L-inh => \case x.L-inh, y.L-inh \with {
+        | inP (a,a<x), inP (b,b<y) => inP (a ∧ b, (x.L_<= a<x meet-left, y.L_<= b<y meet-right))
       }
-      | byRight q<y => \case y.L-rounded q<y \with {
-        | inP (r,r<y,q<r) => inP (r, byRight r<y, q<r)
+      | L-closed (q<x,q<y) q'<q => (x.L-closed q<x q'<q, y.L-closed q<y q'<q)
+      | L-rounded (q<x,q<y) => \case x.L-rounded q<x, y.L-rounded q<y \with {
+        | inP (r,r<x,q<r), inP (r',r'<y,q<r') => inP (r ∧ r', (x.L_<= r<x meet-left, y.L_<= r'<y meet-right), <_meet-univ q<r q<r')
       }
-    }
-  }
-  | join-left => byLeft
-  | join-right => byRight
-  | join-univ x<=z y<=z => \case \elim __ \with {
-    | byLeft a<x => x<=z a<x
-    | byRight a<y => y<=z a<y
+
+    \lemma meet_L {x y : LowerReal} {a : Rat} : Real.L {meet x y} a <-> (\Sigma (x.L a) (y.L a))
+      => rewrite (\peval meet x y) <->refl
+
+    \sfunc join (x y : LowerReal) : LowerReal \cowith
+      | L a => x.L a || y.L a
+      | L-inh => \case x.L-inh \with {
+        | inP (a,a<x) => inP (a, byLeft a<x)
+      }
+      | L-closed e q'<q => ||.map (x.L-closed __ q'<q) (y.L-closed __ q'<q) e
+      | L-rounded => \case \elim __ \with {
+        | byLeft q<x => \case x.L-rounded q<x \with {
+          | inP (r,r<x,q<r) => inP (r, byLeft r<x, q<r)
+        }
+        | byRight q<y => \case y.L-rounded q<y \with {
+          | inP (r,r<y,q<r) => inP (r, byRight r<y, q<r)
+        }
+      }
+
+    \lemma join_L {x y : LowerReal} {a : Rat} : Real.L {join x y} a <-> x.L a || y.L a
+      => rewrite (\peval join x y) <->refl
   }
 
 \record UpperReal (U : Rat -> \Prop) {
@@ -108,25 +131,39 @@
 
 \instance UpperRealAbMonoid : AbMonoid UpperReal
   | zro => Real.fromRat 0
-  | + (x y : UpperReal) : UpperReal \cowith {
-    | U a => ∃ (b : x.U) (c : y.U) (b RatField.+ c < a)
-    | U-inh => \case x.U-inh, y.U-inh \with {
-      | inP (a,x<a), inP (b,y<b) => inP (a RatField.+ b RatField.+ 1, inP (a, x<a, b, y<b, linarith))
-    }
-    | U-closed (inP (a,a<x,b,b<y,a+b<q)) q<q' => inP (a, a<x, b, b<y, a+b<q <∘ q<q')
-    | U-rounded {q} (inP (a,a<x,b,b<y,a+b<q)) => inP (RatField.mid (a RatField.+ b) q, inP (a, a<x, b, b<y, RatField.mid>left a+b<q), RatField.mid<right a+b<q)
-  }
-  | zro-left => exts \lam a => ext (\lam (inP (b,b<0,c,c<x,a<b+c)) => U-closed c<x linarith, \lam a<x => \case U-rounded a<x \with {
+  | + => +
+  | zro-left => (\peval _ + _) *> exts \lam a => ext (\lam (inP (b,b<0,c,c<x,a<b+c)) => U-closed c<x linarith, \lam a<x => \case U-rounded a<x \with {
     | inP (b,b<x,a<b) => inP ((a - b) * ratio 1 2, linarith, b, b<x, linarith)
   })
-  | +-assoc => exts \lam a => ext (\lam (inP (b, inP (d,d<x,e,e<y,b<d+e), c, c<z,a<b+c)) => inP (d, d<x, (a - d RatField.+ c RatField.+ e) * ratio 1 2, inP (e, e<y, c, c<z, linarith), linarith),
-                                   \lam (inP (b, b<x, c, inP (d,d<y,e,e<z,c<d+e), a<b+c)) => inP ((a - e RatField.+ b RatField.+ d) * ratio 1 2, inP (b, b<x, d, d<y, linarith), e, e<z, linarith))
-  | +-comm => exts \lam a => ext (\lam (inP (b,b<x,c,c<y,a<b+c)) => inP (c, c<y, b, b<x, rewrite RatField.+-comm a<b+c),
-                                  \lam (inP (c,c<y,b,b<x,a<c+b)) => inP (b, b<x, c, c<y, rewrite RatField.+-comm a<c+b))
+  | +-assoc => exts \lam a => ext (\lam r => \case +_U.1 r \with {
+    | inP (b, r', c, c<z,a<b+c) => \case +_U.1 r' \with {
+      | inP (d,d<x,e,e<y,b<d+e) => +_U.2 $ inP (d, d<x, (a - d RatField.+ c RatField.+ e) * ratio 1 2, +_U.2 $ inP (e, e<y, c, c<z, linarith), linarith)
+    }
+  }, \lam r => \case +_U.1 r \with {
+    | inP (b, b<x, c, r', a<b+c) => \case +_U.1 r' \with {
+      | inP (d,d<y,e,e<z,c<d+e) => +_U.2 $ inP ((a - e RatField.+ b RatField.+ d) * ratio 1 2, +_U.2 $ inP (b, b<x, d, d<y, linarith), e, e<z, linarith)
+    }
+  })
+  | +-comm => exts \lam a => ext (\lam r => \case +_U.1 r \with {
+    | inP (b,b<x,c,c<y,a<b+c) => +_U.2 $ inP $ later (c, c<y, b, b<x, rewrite RatField.+-comm a<b+c)
+  }, \lam r => \case +_U.1 r \with {
+    | inP (c,c<y,b,b<x,a<c+b) => +_U.2 $ inP $ later (b, b<x, c, c<y, rewrite RatField.+-comm a<c+b)
+  })
   \where {
+    \sfunc \infixl 6 + (x y : UpperReal) : UpperReal \cowith
+      | U a => ∃ (b : x.U) (c : y.U) (b RatField.+ c < a)
+      | U-inh => \case x.U-inh, y.U-inh \with {
+        | inP (a,x<a), inP (b,y<b) => inP (a RatField.+ b RatField.+ 1, inP (a, x<a, b, y<b, linarith))
+      }
+      | U-closed (inP (a,a<x,b,b<y,a+b<q)) q<q' => inP (a, a<x, b, b<y, a+b<q <∘ q<q')
+      | U-rounded {q} (inP (a,a<x,b,b<y,a+b<q)) => inP (RatField.mid (a RatField.+ b) q, inP (a, a<x, b, b<y, RatField.mid>left a+b<q), RatField.mid<right a+b<q)
+
+    \lemma +_U {x y : UpperReal} {a : Rat} : Real.U {x + y} a <-> ∃ (b : x.U) (c : y.U) (b RatField.+ c < a)
+      => rewrite (\peval x + y) <->refl
+
     \lemma +-rat {x y : Rat} : Real.fromRat x + Real.fromRat y = {UpperReal} Real.fromRat (x RatField.+ y)
-      => exts \lam a => ext (\lam (inP (b,x<b,c,y<c,b+c<a)) => OrderedAddMonoid.<_+ x<b y<c <∘ b+c<a,
-                             \lam a<x+y => inP (x - (x RatField.+ y - a) * ratio 1 3, linarith, y - (x RatField.+ y - a) * ratio 1 3, linarith, linarith))
+      => (\peval _ + _) *> {UpperReal} exts \lam a => ext (\lam (inP (b,x<b,c,y<c,b+c<a)) => OrderedAddMonoid.<_+ x<b y<c <∘ b+c<a,
+            \lam a<x+y => inP (x - (x RatField.+ y - a) * ratio 1 3, linarith, y - (x RatField.+ y - a) * ratio 1 3, linarith, linarith))
   }
 
 \instance UpperRealLattice : Lattice UpperReal
@@ -134,40 +171,49 @@
   | <=-refl x<a => x<a
   | <=-transitive p q x<a => p (q x<a)
   | <=-antisymmetric p q => exts \lam a => ext (q,p)
-  | meet (x y : UpperReal) : UpperReal \cowith {
-    | U a => x.U a || y.U a
-    | U-inh => \case x.U-inh \with {
-      | inP (a,x<a) => inP (a, byLeft x<a)
-    }
-    | U-closed e q'<q => ||.map (x.U-closed __ q'<q) (y.U-closed __ q'<q) e
-    | U-rounded => \case \elim __ \with {
-      | byLeft q<x => \case x.U-rounded q<x \with {
-        | inP (r,r<x,q<r) => inP (r, byLeft r<x, q<r)
-      }
-      | byRight q<y => \case y.U-rounded q<y \with {
-        | inP (r,r<y,q<r) => inP (r, byRight r<y, q<r)
-      }
-    }
-  }
-  | meet-left => byLeft
-  | meet-right => byRight
-  | meet-univ x<=z y<=z => \case \elim __ \with {
+  | meet => meet
+  | meet-left x<a => meet_U.2 (byLeft x<a)
+  | meet-right y<a => meet_U.2 (byRight y<a)
+  | meet-univ x<=z y<=z r => \case meet_U.1 r \with {
     | byLeft a<x => x<=z a<x
     | byRight a<y => y<=z a<y
   }
-  | join (x y : UpperReal) : UpperReal \cowith {
-    | U a => \Sigma (x.U a) (y.U a)
-    | U-inh => \case x.U-inh, y.U-inh \with {
-      | inP (a,a<x), inP (b,b<y) => inP (a ∨ b, (x.U_<= a<x join-left, y.U_<= b<y join-right))
-    }
-    | U-closed (q<x,q<y) q'<q => (x.U-closed q<x q'<q, y.U-closed q<y q'<q)
-    | U-rounded (q<x,q<y) => \case x.U-rounded q<x, y.U-rounded q<y \with {
-      | inP (r,r<x,q<r), inP (r',r'<y,q<r') => inP (r ∨ r', (x.U_<= r<x join-left, y.U_<= r'<y join-right), <_join-univ q<r q<r')
-    }
+  | join => join
+  | join-left s => (join_U.1 s).1
+  | join-right s => (join_U.1 s).2
+  | join-univ z<=x z<=y a<z => join_U.2 (z<=x a<z, z<=y a<z)
+  \where {
+    \sfunc meet (x y : UpperReal) : UpperReal \cowith
+      | U a => x.U a || y.U a
+      | U-inh => \case x.U-inh \with {
+        | inP (a,x<a) => inP (a, byLeft x<a)
+      }
+      | U-closed e q'<q => ||.map (x.U-closed __ q'<q) (y.U-closed __ q'<q) e
+      | U-rounded => \case \elim __ \with {
+        | byLeft q<x => \case x.U-rounded q<x \with {
+          | inP (r,r<x,q<r) => inP (r, byLeft r<x, q<r)
+        }
+        | byRight q<y => \case y.U-rounded q<y \with {
+          | inP (r,r<y,q<r) => inP (r, byRight r<y, q<r)
+        }
+      }
+
+    \lemma meet_U {x y : UpperReal} {a : Rat} : Real.U {meet x y} a <-> x.U a || y.U a
+      => rewrite (\peval meet x y) <->refl
+
+    \sfunc join (x y : UpperReal) : UpperReal \cowith
+      | U a => \Sigma (x.U a) (y.U a)
+      | U-inh => \case x.U-inh, y.U-inh \with {
+        | inP (a,a<x), inP (b,b<y) => inP (a ∨ b, (x.U_<= a<x join-left, y.U_<= b<y join-right))
+      }
+      | U-closed (q<x,q<y) q'<q => (x.U-closed q<x q'<q, y.U-closed q<y q'<q)
+      | U-rounded (q<x,q<y) => \case x.U-rounded q<x, y.U-rounded q<y \with {
+        | inP (r,r<x,q<r), inP (r',r'<y,q<r') => inP (r ∨ r', (x.U_<= r<x join-left, y.U_<= r'<y join-right), <_join-univ q<r q<r')
+      }
+
+    \lemma join_U {x y : UpperReal} {a : Rat} : Real.U {join x y} a <-> (\Sigma (x.U a) (y.U a))
+      => rewrite (\peval join x y) <->refl
   }
-  | join-left s => s.1
-  | join-right s => s.2
-  | join-univ z<=x z<=y a<z => (z<=x a<z, z<=y a<z)
 
 \record Real \extends LowerReal, UpperReal {
   | LU-disjoint {q : Rat} : L q -> U q -> Empty
@@ -268,126 +314,177 @@
 
   \lemma real-lu-ext {x y : Real} (p : x = {LowerReal} y) (q : x = {UpperReal} y) : x = y
     => ext (pmap (\lam (z : LowerReal) => z.L) p, pmap (\lam (z : UpperReal) => z.U) q)
+
+  \lemma fromRat-inj {x y : Rat} (p : fromRat x = fromRat y) : x = y
+    => <=-antisymmetric (rat_real_<=.2 $ RealAbGroup.=_<= p) (rat_real_<=.2 $ RealAbGroup.=_<= $ inv p)
 }
 
 \instance RealAbGroup : LinearlyOrderedAbGroup Real
   | zro => Real.fromRat 0
-  | + (x y : Real) : Real \cowith {
-    | LowerReal => x LowerRealAbMonoid.+ y
-    | UpperReal => x UpperRealAbMonoid.+ y
-    | LU-disjoint (inP (a,a<x,b,b<y,q<a+b)) (inP (c,x<c,d,y<d,c+d<q)) => linarith (x.LU-less a<x x<c, y.LU-less b<y y<d)
-    | LU-focus eps eps>0 => \case x.LU-focus (eps * ratio 1 4) linarith, y.LU-focus (eps * ratio 1 4) linarith \with {
-      | inP (a,a<x,x<a+e/4), inP (b,b<y,y<b+e/4) => inP (a RatField.+ b - eps * ratio 1 4, inP (a, a<x, b, b<y, linarith), inP (_, x<a+e/4, _, y<b+e/4, linarith))
-    }
-  }
-  | zro-left => Real.real-lu-ext zro-left zro-left
-  | +-comm => Real.real-lu-ext +-comm +-comm
-  | +-assoc => Real.real-lu-ext +-assoc +-assoc
-  | negative (x : Real) : Real \cowith {
-    | L a => x.U (RatField.negative a)
-    | L-inh => \case x.U-inh \with {
-      | inP (a,x<a) => inP (RatField.negative a, simplify x<a)
-    }
-    | L-closed x<-q q'<q => x.U-closed x<-q (RatField.negative_< q'<q)
-    | L-rounded x<-q => \case x.U-rounded x<-q \with {
-      | inP (r,x<r,r<-q) => inP (RatField.negative r, simplify x<r, RatField.negative_<-right r<-q)
-    }
-    | U a => x.L (RatField.negative a)
-    | U-inh => \case x.L-inh \with {
-      | inP (a,a<x) => inP (RatField.negative a, simplify a<x)
-    }
-    | U-closed -q<x q<q' => x.L-closed -q<x (RatField.negative_< q<q')
-    | U-rounded -q<x => \case x.L-rounded -q<x \with {
-      | inP (r,r<x,-q<r) => inP (RatField.negative r, simplify r<x, RatField.negative_<-left -q<r)
-    }
-    | LU-disjoint p q => x.LU-disjoint q p
-    | LU-located q<r => \case x.LU-located (RatField.negative_< q<r) \with {
-      | byLeft -r<x => byRight -r<x
-      | byRight x<-q => byLeft x<-q
-    }
-  }
-  | negative-left {x : Real} => exts (\lam a => ext (\lam (inP (b,x<-b,c,c<x,a<b+c)) => a<b+c <∘ linarith (x.LU-less c<x x<-b), \lam a<0 => \case x.LU-focus (a * ratio -1 2) linarith \with {
-                                        | inP (b,b<x,x<b-a/2) => inP (RatField.negative (b RatField.+ a * ratio -1 2), simplify x<b-a/2, b, b<x, linarith)
-                                      }),
-                                      \lam a => ext (\lam (inP (b,-b<x,c,x<c,b+c<a)) => linarith (x.LU-less -b<x x<c) <∘ b+c<a, \lam a>0 => \case x.LU-focus (a * ratio 1 2) linarith \with {
-                                        | inP (b,b<x,x<b+a/2) => inP (RatField.negative b, simplify b<x, _, x<b+a/2, linarith)
-                                      }))
+  | + => +
+  | zro-left => (\peval _ + _) *> Real.real-lu-ext zro-left zro-left
+  | +-comm => (\peval _ + _) *> Real.real-lu-ext (later +-comm) (later +-comm) *> inv (\peval _ + _)
+  | +-assoc => Real.real-lu-ext (+_L.lower *> {LowerReal} pmap {LowerReal} (LowerRealAbMonoid.`+ _) +_L.lower *> {LowerReal} LowerRealAbMonoid.+-assoc *> {LowerReal} pmap (_ LowerRealAbMonoid.+) (inv {LowerReal} +_L.lower) *> {LowerReal} inv {LowerReal} +_L.lower)
+                                (+_U.upper *> {UpperReal} pmap {UpperReal} (UpperRealAbMonoid.`+ _) +_U.upper *> {UpperReal} UpperRealAbMonoid.+-assoc *> {UpperReal} pmap (_ UpperRealAbMonoid.+) (inv {UpperReal} +_U.upper) *> {UpperReal} inv {UpperReal} +_U.upper)
+  | negative => negative
+  | negative-left {x : Real} => exts (
+      \lam a => ext (\lam r => \case +_L.1 r \with {
+        | inP (b,x<-b,c,c<x,a<b+c) => a<b+c <∘ linarith (x.LU-less c<x $ negative_L.1 x<-b)
+      }, \lam a<0 => \case x.LU-focus (a * ratio -1 2) linarith \with {
+        | inP (b,b<x,x<b-a/2) => +_L.2 $ inP (RatField.negative (b RatField.+ a * ratio -1 2), negative_L.2 $ simplify x<b-a/2, b, b<x, linarith)
+      }),
+      \lam a => ext (\lam r => \case +_U.1 r \with {
+        | inP (b,-b<x,c,x<c,b+c<a) => linarith (x.LU-less (negative_U.1 -b<x) x<c) <∘ b+c<a
+      }, \lam a>0 => \case x.LU-focus (a * ratio 1 2) linarith \with {
+        | inP (b,b<x,x<b+a/2) => +_U.2 $ inP (RatField.negative b, negative_U.2 $ simplify b<x, _, x<b+a/2, linarith)
+      }))
   | isPos (x : Real) => x.L 0
   | zro/>0 => \case __
   | positive_+ x>0 y>0 => \case L-rounded x>0 \with {
-    | inP (a,a<x,a>0) => inP (a, a<x, 0, y>0, simplify a>0)
+    | inP (a,a<x,a>0) => +_L.2 $ inP (a, a<x, 0, y>0, simplify a>0)
   }
-  | <_+-comparison x y (inP (b,b<x,c,c<y,b+c>0)) => \case dec<_<= 0 b \with {
-    | inl b>0 => byLeft (L-closed b<x b>0)
-    | inr b<=0 => byRight (L-closed c<y linarith)
+  | <_+-comparison x y r => \case +_L.1 r \with {
+    | inP (b,b<x,c,c<y,b+c>0) => \case dec<_<= 0 b \with {
+      | inl b>0 => byLeft (L-closed b<x b>0)
+      | inr b<=0 => byRight (L-closed c<y linarith)
+    }
   }
   | <_+-connectedness p q => exts (\lam a => ext (\lam a<x => \case dec<_<= a 0 \with {
     | inl a<0 => a<0
     | inr a>=0 => absurd $ p $ LowerReal.L_<= a<x a>=0
   }, \lam a<0 => \case LU-located a<0 \with {
     | byLeft a<x => a<x
-    | byRight x<0 => absurd $ q x<0
+    | byRight x<0 => absurd $ q $ negative_L.2 x<0
   }), \lam a => ext (\lam x<a => \case dec<_<= 0 a \with {
     | inl a>0 => a>0
-    | inr a<=0 => absurd $ q $ UpperReal.U_<= x<a a<=0
+    | inr a<=0 => absurd $ q $ negative_L.2 $ UpperReal.U_<= x<a a<=0
   }, \lam a>0 => \case LU-located a>0 \with {
     | byLeft x>0 => absurd $ p x>0
     | byRight x<a => x<a
   }))
-  | meet (x y : Real) : Real \cowith {
-    | LowerReal => LowerRealLattice.meet x y
-    | UpperReal => UpperRealLattice.meet x y
-    | LU-disjoint (q<x,q<y) => \case \elim __ \with {
-      | byLeft x<q => <-irreflexive (x.LU-less q<x x<q)
-      | byRight y<q => <-irreflexive (y.LU-less q<y y<q)
-    }
-    | LU-located q<r => \case x.LU-located q<r, y.LU-located q<r \with {
-      | byLeft q<x, byLeft q<y => byLeft (q<x,q<y)
-      | _, byRight y<r => byRight (byRight y<r)
-      | byRight x<r, _ => byRight (byLeft x<r)
-    }
-  }
-  | meet-left => \case \elim __ \with {
-    | inP (b,(b<x,_),c,x<-c,b+c>0) => <-irreflexive $ Real.LU-less b<x (U-closed x<-c linarith)
+  | meet => meet
+  | meet-left r => \case +_L.1 r \with {
+    | inP (b,s,c,x<-c,b+c>0) => <-irreflexive $ Real.LU-less (meet_L.1 s).1 (U-closed (negative_L.1 x<-c) linarith)
   }
-  | meet-right => \case \elim __ \with {
-    | inP (_,(_,b<y),c,y<-c,b+c>0) => <-irreflexive $ Real.LU-less b<y (U-closed y<-c linarith)
+  | meet-right r => \case +_L.1 r \with {
+    | inP (_,s,c,y<-c,b+c>0) => <-irreflexive $ Real.LU-less (meet_L.1 s).2 (U-closed (negative_L.1 y<-c) linarith)
   }
-  | meet-univ z<=x z<=y => \case \elim __ \with {
-    | inP (b, b<z, c, byLeft x<-c, b+c>0) => z<=x $ inP (b, b<z, c, x<-c, b+c>0)
-    | inP (b, b<z, c, byRight y<-c, b+c>0) => z<=y $ inP (b, b<z, c, y<-c, b+c>0)
-  }
-  | join (x y : Real) : Real \cowith {
-    | LowerReal => LowerRealLattice.join x y
-    | UpperReal => UpperRealLattice.join x y
-    | LU-disjoint e (x<q,y<q) => \case \elim e \with {
-      | byLeft q<x => <-irreflexive (x.LU-less q<x x<q)
-      | byRight q<y => <-irreflexive (y.LU-less q<y y<q)
-    }
-    | LU-located q<r => \case x.LU-located q<r, y.LU-located q<r \with {
-      | byLeft q<x, _ => byLeft (byLeft q<x)
-      | _, byLeft q<y => byLeft (byRight q<y)
-      | byRight x<r, byRight y<r => byRight (x<r,y<r)
+  | meet-univ z<=x z<=y r => \case +_L.1 r \with {
+    | inP (b, b<z, c, r, b+c>0) => \case meet_U.1 $ negative_L.1 r \with {
+      | byLeft x<-c => z<=x $ +_L.2 $ inP (b, b<z, c, negative_L.2 x<-c, b+c>0)
+      | byRight y<-c => z<=y $ +_L.2 $ inP (b, b<z, c, negative_L.2 y<-c, b+c>0)
     }
   }
-  | join-left => \case \elim __ \with {
-    | inP (b,b<x,c,(x<-c,y<-c),b+c>0) => LU-disjoint b<x (U-closed x<-c linarith)
+  | join => join
+  | join-left r => \case +_L.1 r \with {
+    | inP (b,b<x,c,r,b+c>0) => LU-disjoint b<x $ U-closed (join_U.1 $ negative_L.1 r).1 linarith
   }
-  | join-right => \case \elim __ \with {
-    | inP (b,b<y,c,(x<-c,y<-c),b+c>0) => LU-disjoint b<y (U-closed y<-c linarith)
+  | join-right r => \case +_L.1 r \with {
+    | inP (b,b<y,c,r,b+c>0) => LU-disjoint b<y (U-closed (join_U.1 $ negative_L.1 r).2 linarith)
   }
-  | join-univ x<=z y<=z => \case \elim __ \with {
-    | inP (b, byLeft b<x, c, z<-c, b+c>0) => x<=z $ inP (b, b<x, c, z<-c, b+c>0)
-    | inP (b, byRight b<y, c, z<-c, b+c>0) => y<=z $ inP (b, b<y, c, z<-c, b+c>0)
+  | join-univ x<=z y<=z r => \case +_L.1 r \with {
+    | inP (b, e, c, z<-c, b+c>0) => \case join_L.1 e \with {
+      | byLeft b<x => x<=z $ +_L.2 $ inP (b, b<x, c, z<-c, b+c>0)
+      | byRight b<y => y<=z $ +_L.2 $ inP (b, b<y, c, z<-c, b+c>0)
+    }
   }
   \where {
     \open OrderedSemiring
 
+    \sfunc \infixl 6 + (x y : Real) : Real \cowith
+      | LowerReal => x LowerRealAbMonoid.+ y
+      | UpperReal => x UpperRealAbMonoid.+ y
+      | LU-disjoint r r' => \case LowerRealAbMonoid.+_L.1 r, UpperRealAbMonoid.+_U.1 r' \with {
+        | inP (a,a<x,b,b<y,q<a+b), inP (c,x<c,d,y<d,c+d<q) => linarith (x.LU-less a<x x<c, y.LU-less b<y y<d)
+      }
+      | LU-focus eps eps>0 => \case x.LU-focus (eps * ratio 1 4) linarith, y.LU-focus (eps * ratio 1 4) linarith \with {
+        | inP (a,a<x,x<a+e/4), inP (b,b<y,y<b+e/4) => inP (a RatField.+ b - eps * ratio 1 4, LowerRealAbMonoid.+_L.2 $ inP (a, a<x, b, b<y, linarith), UpperRealAbMonoid.+_U.2 $ inP (_, x<a+e/4, _, y<b+e/4, linarith))
+      }
+
+    \lemma +_L {x y : Real} {a : Rat} : Real.L {x + y} a <-> ∃ (b : x.L) (c : y.L) (a < b RatField.+ c)
+      => rewrite (\peval x + y, \peval x LowerRealAbMonoid.+ y) <->refl
+      \where
+        \lemma lower {x y : Real} : x + y = {LowerReal} x LowerRealAbMonoid.+ y
+          => exts \lam a => <->_=.1 +_L *> inv (<->_=.1 LowerRealAbMonoid.+_L)
+
+    \lemma +_U {x y : Real} {a : Rat} : Real.U {x + y} a <-> ∃ (b : x.U) (c : y.U) (b RatField.+ c < a)
+      => rewrite (\peval x + y, \peval x UpperRealAbMonoid.+ y) <->refl
+      \where
+        \lemma upper {x y : Real} : x + y = {UpperReal} x UpperRealAbMonoid.+ y
+          => exts \lam a => <->_=.1 +_U *> inv (<->_=.1 UpperRealAbMonoid.+_U)
+
     \lemma +-rat {x y : Rat} : x + y = {Real} x RatField.+ y
-      => Real.real-lu-ext LowerRealAbMonoid.+-rat UpperRealAbMonoid.+-rat
+      => (\peval x + y) *> Real.real-lu-ext LowerRealAbMonoid.+-rat UpperRealAbMonoid.+-rat
+
+    \sfunc negative (x : Real) : Real \cowith
+      | L a => x.U (RatField.negative a)
+      | L-inh => \case x.U-inh \with {
+        | inP (a,x<a) => inP (RatField.negative a, simplify x<a)
+      }
+      | L-closed x<-q q'<q => x.U-closed x<-q (RatField.negative_< q'<q)
+      | L-rounded x<-q => \case x.U-rounded x<-q \with {
+        | inP (r,x<r,r<-q) => inP (RatField.negative r, simplify x<r, RatField.negative_<-right r<-q)
+      }
+      | U a => x.L (RatField.negative a)
+      | U-inh => \case x.L-inh \with {
+        | inP (a,a<x) => inP (RatField.negative a, simplify a<x)
+      }
+      | U-closed -q<x q<q' => x.L-closed -q<x (RatField.negative_< q<q')
+      | U-rounded -q<x => \case x.L-rounded -q<x \with {
+        | inP (r,r<x,-q<r) => inP (RatField.negative r, simplify r<x, RatField.negative_<-left -q<r)
+      }
+      | LU-disjoint p q => x.LU-disjoint q p
+      | LU-located q<r => \case x.LU-located (RatField.negative_< q<r) \with {
+        | byLeft -r<x => byRight -r<x
+        | byRight x<-q => byLeft x<-q
+      }
+
+    \lemma negative_L {x : Real} {a : Rat} : Real.L {negative x} a <-> x.U (RatField.negative a)
+      => rewrite (\peval negative x) <->refl
+
+    \lemma negative_U {x : Real} {a : Rat} : Real.U {negative x} a <-> x.L (RatField.negative a)
+      => rewrite (\peval negative x) <->refl
 
     \lemma negative-rat {x : Rat} : negative x = {Real} RatField.negative x
-      => exts (\lam a => ext (\lam p => linarith, \lam p => linarith), \lam a => ext (\lam p => linarith, \lam p => linarith))
+      => (\peval negative x) *> exts (\lam a => ext (\lam p => linarith, \lam p => linarith), \lam a => ext (\lam p => linarith, \lam p => linarith))
+
+    \sfunc meet (x y : Real) : Real \cowith
+      | LowerReal => LowerRealLattice.meet x y
+      | UpperReal => UpperRealLattice.meet x y
+      | LU-disjoint s r => \case UpperRealLattice.meet_U.1 r \with {
+        | byLeft x<q => <-irreflexive (x.LU-less (LowerRealLattice.meet_L.1 s).1 x<q)
+        | byRight y<q => <-irreflexive (y.LU-less (LowerRealLattice.meet_L.1 s).2 y<q)
+      }
+      | LU-located q<r => \case x.LU-located q<r, y.LU-located q<r \with {
+        | byLeft q<x, byLeft q<y => byLeft $ LowerRealLattice.meet_L.2 (q<x,q<y)
+        | _, byRight y<r => byRight $ UpperRealLattice.meet_U.2 (byRight y<r)
+        | byRight x<r, _ => byRight $ UpperRealLattice.meet_U.2 (byLeft x<r)
+      }
+
+    \lemma meet_L {x y : Real} {a : Rat} : Real.L {meet x y} a <-> (\Sigma (x.L a) (y.L a))
+      => rewrite (\peval meet x y, \peval LowerRealLattice.meet x y) <->refl
+
+    \lemma meet_U {x y : Real} {a : Rat} : Real.U {meet x y} a <-> x.U a || y.U a
+      => rewrite (\peval meet x y, \peval UpperRealLattice.meet x y) <->refl
+
+    \sfunc join (x y : Real) : Real \cowith
+      | LowerReal => LowerRealLattice.join x y
+      | UpperReal => UpperRealLattice.join x y
+      | LU-disjoint e s => \case LowerRealLattice.join_L.1 e \with {
+        | byLeft q<x => <-irreflexive $ x.LU-less q<x (UpperRealLattice.join_U.1 s).1
+        | byRight q<y => <-irreflexive $ y.LU-less q<y (UpperRealLattice.join_U.1 s).2
+      }
+      | LU-located q<r => \case x.LU-located q<r, y.LU-located q<r \with {
+        | byLeft q<x, _ => byLeft $ LowerRealLattice.join_L.2 (byLeft q<x)
+        | _, byLeft q<y => byLeft $ LowerRealLattice.join_L.2 (byRight q<y)
+        | byRight x<r, byRight y<r => byRight $ UpperRealLattice.join_U.2 (x<r,y<r)
+      }
+
+    \lemma join_L {x y : Real} {a : Rat} : Real.L {join x y} a <-> x.L a || y.L a
+      => rewrite (\peval join x y, \peval LowerRealLattice.join x y) <->refl
+
+    \lemma join_U {x y : Real} {a : Rat} : Real.U {join x y} a <-> (\Sigma (x.U a) (y.U a))
+      => rewrite (\peval join x y, \peval UpperRealLattice.join x y) <->refl
 
     \func half (x : Real) : Real \cowith
       | L a => x.L (a * 2)
@@ -410,13 +507,13 @@
       | LU-located p => x.LU-located linarith
 
     \lemma half+half {x : Real} : half x + half x = x
-      => exts (\lam a => ext (\lam (inP (b,b+b<x,c,c+c<x,a<b+c)) => \case dec<_<= a (b * 2), dec<_<= a (c * 2) \with {
+      => Real.real-lu-ext (exts \lam a => <->_=.1 +_L *> ext (\lam (inP (b,b+b<x,c,c+c<x,a<b+c)) => \case dec<_<= a (b * 2), dec<_<= a (c * 2) \with {
         | inl a<b+b, _ => x.L-closed b+b<x a<b+b
         | _, inl a<c+c => x.L-closed c+c<x a<c+c
         | inr p, inr q => absurd linarith
       }, \lam a<x => \case x.L-rounded a<x \with {
         | inP (b,b<x,a<b) => inP (b * ratio 1 2, transport x.L linarith b<x, b * ratio 1 2, transport x.L linarith b<x, linarith)
-      }), \lam a => ext (\lam (inP (b,x<b+b,c,x<c+c,b+c<a)) => \case dec<_<= (b * 2) a, dec<_<= (c * 2) a \with {
+      })) (exts \lam a => <->_=.1 +_U *> ext (\lam (inP (b,x<b+b,c,x<c+c,b+c<a)) => \case dec<_<= (b * 2) a, dec<_<= (c * 2) a \with {
         | inl b+b<a, _ => x.U-closed x<b+b b+b<a
         | _, inl c+c<a => x.U-closed x<c+c c+c<a
         | inr p, inr q => absurd linarith
@@ -427,43 +524,91 @@
     \lemma half>0 {x : Real} (x>0 : 0 RealAbGroup.< x) : 0 RealAbGroup.< half x
       => real_<_L.2 $ unfolds $ real_<_L.1 x>0
 
+    \lemma half<id {x : Real} (x>0 : 0 RealAbGroup.< x) : half x RealAbGroup.< x
+      => transport2 (RealAbGroup.<) zro-left half+half $ <_+-left (half x) (half>0 x>0)
+
+    \lemma zro<ide : 0 RealAbGroup.< 1
+      => real_<-char.2 $ inP $ later (ratio 1 2, idp, idp)
+
     {-
-    \func \infixl 7 *' {x y : Real} (x>0 : x.L 0) (y>0 : y.L 0) : Real \cowith
-      | L a => ∃ (b : x.L) (c : y.L) (0 < b) (0 < c) (a < b RatField.* c)
-      | L-inh => \case x.L-rounded x>0, y.L-rounded y>0 \with {
-        | inP (a,a<x,a>0), inP (b,b<y,b>0) => inP (a RatField.* b - 1, inP (a, a<x, b, b<y, a>0, b>0, linarith))
+    \lemma *'-char {x y : Real} {a : Rat} {b : Rat} (b<x : x.L b) {c : Rat} (c<y : y.L c) (b>=0 : 0 <= b) (c>=0 : 0 <= c) (a<=bc : a <= b * c)
+      : ∃ (b : x.L) (c : y.L) (0 < b) (0 < c) (a < b * c)
+      => \case x.L-rounded b<x, y.L-rounded c<y \with {
+        | inP (b',b'<x,b<b'), inP (c',c'<y,c<c') => inP (b', b'<x, c', c'<y, b>=0 <∘r b<b', c>=0 <∘r c<c', a<=bc <∘r RatField.<=_*_positive-left (<_<= b<b') c>=0 <∘r <_*_positive-right (b>=0 <∘r b<b') c<c')
       }
+
+    \func \infixl 7 *' {x y : Real} (x>0 : x.L 0) (y>0 : y.L 0) : Real \cowith
+      | L a => ∃ (b : x.L) (c : y.L) (0 < b) (0 < c) (a < b * c)
+      | L-inh => inP (0, *'-char x>0 y>0 <=-refl <=-refl <=-refl)
       | L-closed (inP (a,a<x,b,b<y,a>0,b>0,q<ab)) q'<q => inP (a, a<x, b, b<y, a>0, b>0, q'<q <∘ q<ab)
-      | L-rounded {q} (inP (a,a<x,b,b<y,a>0,b>0,q<ab)) => inP (RatField.mid q (a RatField.* b), inP (a, a<x, b, b<y, a>0, b>0, RatField.mid<right q<ab), RatField.mid>left q<ab)
-      | U a => ∃ (b : x.U) (c : y.U) (b RatField.* c < a)
+      | L-rounded (inP (a,a<x,b,b<y,a>0,b>0,q<ab)) => \case x.L-rounded a<x, y.L-rounded b<y \with {
+        | inP (a',a'<x,a<a'), inP (b',b'<y,b<b') => inP (a' * b', *'-char a'<x b'<y (<_<= a>0 <=∘ <_<= a<a') (<_<= b>0 <=∘ <_<= b<b') <=-refl, q<ab <∘ RatField.<_*_positive-left a<a' b>0 <∘ <_*_positive-right (a>0 <∘ a<a') b<b')
+      }
+      | U a => ∃ (b : x.U) (c : y.U) (b * c < a)
       | U-inh => \case x.U-inh, y.U-inh \with {
-        | inP (a,x<a), inP (b,y<b) => inP (a RatField.* b RatField.+ 1, inP (a, x<a, b, y<b, linarith))
+        | inP (a,x<a), inP (b,y<b) => inP (a * b RatField.+ 1, inP (a, x<a, b, y<b, linarith))
       }
       | U-closed (inP (a,a<x,b,b<y,ab<q)) q<q' => inP (a, a<x, b, b<y, ab<q <∘ q<q')
-      | U-rounded {q} (inP (a,a<x,b,b<y,ab<q)) => inP (RatField.mid (a RatField.* b) q, inP (a, a<x, b, b<y, RatField.mid>left ab<q), RatField.mid<right ab<q)
-      | LU-disjoint (inP (a,a<x,b,b<y,a>0,b>0,q<ab)) (inP (c,x<c,d,y<d,cd<q)) => <-irreflexive $ q<ab <∘ <_*_positive-left (x.LU-less a<x x<c) b>0 <∘ <_*_positive-right (x.LU-less x>0 x<c) (y.LU-less b<y y<d) <∘ cd<q
-      | LU-located {a} {b} a<b => \case dec<_<= 0 a \with {
-        | inl a>0 =>
-          \let | (inP (d,d<x,d>0)) => x.L-rounded x>0
-               | eps => (b - a) * d * finv a
-               | (inP (c,c<x,x<c+eps)) => x.LU-focus eps (<_*_positive_positive (<_*_positive_positive linarith d>0) (RatField.finv>0 a>0))
-          \in \case y.LU-located {a * finv (c ∨ d)} {b * finv (c RatField.+ eps)} {?} \with {
-            | byLeft r => byLeft \case y.L-rounded r \with {
-              | inP (e,e<y,r') => inP (c ∨ d, {?}, e, e<y, d>0 <∘l join-right, {?}, {?})
-            }
-            | byRight r => byRight {?}
+      | U-rounded {q} (inP (a,a<x,b,b<y,ab<q)) => inP (RatField.mid (a * b) q, inP (a, a<x, b, b<y, RatField.mid>left ab<q), RatField.mid<right ab<q)
+      | LU-disjoint (inP (a,a<x,b,b<y,a>0,b>0,q<ab)) (inP (c,x<c,d,y<d,cd<q)) => <-irreflexive $ q<ab <∘ RatField.<_*_positive-left (x.LU-less a<x x<c) b>0 <∘ <_*_positive-right (x.LU-less x>0 x<c) (y.LU-less b<y y<d) <∘ cd<q
+      | LU-focus eps eps>0 => \case x.LU-focus 1 idp, y.LU-focus 1 idp \with {
+        | inP (a,a<x,x<a+1), inP (b,b<y,y<b+1) =>
+          \let | d1 => (eps * ratio 1 3) * finv (b RatField.+ 1) ∧ 1
+               | d2 => finv (a RatField.+ 2) * (eps * ratio 1 3)
+               | a+2>0 => x.LU-less x>0 $ x.U-closed x<a+1 $ <_+-right a idp
+               | b+1>0 => y.LU-less y>0 y<b+1
+               | d1>0 : 0 < d1 => <_meet-univ (<_*_positive_positive linarith $ RatField.finv>0 b+1>0) RatField.zro<ide
+               | d2>0 : 0 < d2 => <_*_positive_positive (RatField.finv>0 a+2>0) linarith
+          \in \case x.LU-focus d1 d1>0, y.LU-focus d2 d2>0 \with {
+            | inP (a',a'<x,x<a'+d1), inP (b',b'<y,y<b'+d2) => inP ((a' ∨ 0) * (b' ∨ 0), *'-char (real_join_L a'<x x>0) (real_join_L b'<y y>0) join-right join-right <=-refl, inP ((a' ∨ 0) RatField.+ d1, x.U_<= x<a'+d1 $ RatField.<=_+ join-left <=-refl, (b' ∨ 0) RatField.+ d2, y.U_<= y<b'+d2 $ RatField.<=_+ join-left <=-refl,
+                \have | lem1 : (a' ∨ 0) * d2 < eps * ratio 1 3 => transport2 (<) *-assoc ide-left $ <_*_positive-left (transport (_ <) (finv-right {_} {a RatField.+ 2} $ /=-sym $ RatField.<_/= a+2>0) $ <_*_positive-left (x.LU-less (real_join_L a'<x x>0) $ x.U-closed x<a+1 $ <_+-right a idp) $ RatField.finv>0 a+2>0) linarith
+                      | lem2 : d1 * (b' ∨ 0) < eps * ratio 1 3 => RatField.<=_*_positive-left meet-left join-right <∘r transport2 (<) (inv *-assoc) ide-right (<_*_positive-right linarith $ transport (_ <) (RatField.finv-left {b RatField.+ 1} $ /=-sym $ RatField.<_/= b+1>0) $ <_*_positive-right (RatField.finv>0 b+1>0) $ y.LU-less (real_join_L b'<y y>0) y<b+1)
+                      | lem3 : d1 * d2 < eps * ratio 1 3 => RatField.<=_*_positive-left meet-right (<_<= d2>0) <∘r transport2 (<) (inv ide-left) ide-left (<_*_positive-left (RatField.finv<1 $ linarith $ x.LU-less x>0 x<a+1) linarith)
+                \in rewrite (RatField.ldistr,RatField.rdistr,RatField.+-assoc,RatField.rdistr) $ <_+-right _ linarith))
           }
-        | inr a<=0 => byLeft \case x.L-rounded x>0, y.L-rounded y>0 \with {
-          | inP (b,b<x,b>0), inP (c,c<y,c>0) => inP (b, b<x, c, c<y, b>0, c>0, a<=0 <∘r <_*_positive_positive b>0 c>0)
-        }
       }
     -}
   }
 
+{-
+\instance RealField : OrderedField Real
+  => {?}
+  \where {
+    \lemma diff-pos (x : Real) : ∃ (y z : Real) (y.L 0) (z.L 0) (x + y = z)
+      => {?}
+
+    \lemma diff-pos' (x : Real) : ∃ (y z : Real) (y.L 0) (z.L 0) (x = y - z)
+      => \case x.LU-located { -1} {1} idp \with {
+        | byLeft x>-1 => inP (x + 1, 1, unfold {?}, idp, inv zro-right *> pmap (x +) (inv negative-right) *> inv (RealAbGroup.+-assoc {_} {_} {RealAbGroup.negative 1}))
+        | byRight x<1 => inP (1, Real.fromRat 1 - x, {?}, {?}, {?})
+      }
+
+    \open RealAbGroup(*',*'-char)
+
+    \lemma \infixl 6 +' {x y : Real} (x>0 : x.L 0) (y>0 : y.L 0) : Real.L {x + y} 0
+      => \case x.L-rounded x>0, y.L-rounded y>0 \with {
+        | inP (a,a<x,a>0), inP (b,b<y,b>0) => inP (a, a<x, b, b<y, RatField.<_+ a>0 b>0)
+      }
+
+    \lemma rdistr' {x y z : Real} (x>0 : x.L 0) (y>0 : y.L 0) (z>0 : z.L 0) : (x>0 +' y>0) *' {x + y} z>0 = x>0 *' z>0 + y>0 *' z>0
+      => exts (\lam a => ext (\lam (inP (b, inP (d,d<x,e,e<y,b<d+e), c, c<z, b>0, c>0, a<bc)) => inP (d RatField.* c, *'-char (real_join_L d<x x>0) c<z join-right (<_<= c>0) $ RatField.<=_*_positive-left join-left $ <_<= c>0, e RatField.* c, {?}, a<bc <∘ <_*_positive-left b<d+e c>0 <∘l Preorder.=_<= rdistr), {?}), {?})
+
+    \lemma \infixl 7 *_ (x : Real) {y : Real} (y>0 : y.L 0)
+      => TruncP.rec-set (diff-pos x) (\lam (x1,x2,x1>0,x2>0,p1) => x1>0 *' y>0 - x2>0 *' y>0) \lam s t => {?}
+
+    \sfunc \infixl 7 * (x y : Real) : Real
+      => (TruncP.rec-set (diff-pos x) (\lam (x1,x2,x1>0,x2>0,p1) => (TruncP.rec-set (diff-pos y) (\lam (y1,y2,y1>0,y2>0,p2) => x1>0 *' y1>0 + x2>0 *' y2>0 - (x1>0 *' y2>0 + x2>0 *' y1>0)) \lam s t => {?}).1) {?}).1
+  }
+-}
+
+\open RealAbGroup(negative_L,+_L)
+
 \lemma real_<-char {x y : Real} : x < y <-> ∃ (a : Rat) (x.U a) (y.L a)
-  => (\lam (inP (b,b<y,c,x<-c,b+c>0)) => inP (b, x.U-closed x<-c linarith, b<y),
+  => (\case +_L.1 __ \with {
+        | inP (b,b<y,c,x<-c,b+c>0) => inP (b, x.U-closed (negative_L.1 x<-c) linarith, b<y)
+      },
       \lam (inP (a,x<a,a<y)) => \case y.L-rounded a<y \with {
-        | inP (b,b<y,a<b) => inP (b, b<y, negative a, simplify x<a, linarith)
+        | inP (b,b<y,a<b) => +_L.2 $ inP (b, b<y, negative a, negative_L.2 $ simplify x<a, linarith)
       })
 
 \lemma real_<_L {a : Rat} {x : Real} : (a : Real) < x <-> x.L a
@@ -474,6 +619,27 @@
 \lemma real_<_U {a : Rat} {x : Real} : x < a <-> x.U a
   => <->trans real_<-char (\lam (inP (b,x<b,b<a)) => x.U-closed x<b b<a, x.U-rounded)
 
+\lemma rat_real_< {a b : Rat} : a < b <-> Real.fromRat a < Real.fromRat b
+  => <->sym real_<_L
+
+\lemma rat_real_<= {a b : Rat} : a <= b <-> Real.fromRat a <= Real.fromRat b
+  => (\lam p q => p $ rat_real_<.2 q, \lam p q => p $ rat_real_<.1 q)
+
+\lemma rat_real_meet {a b : Rat} : Real.fromRat (a ∧ b) = Real.fromRat a ∧ Real.fromRat b
+  => <=-antisymmetric (meet-univ (rat_real_<=.1 meet-left) (rat_real_<=.1 meet-right)) \case TotalOrder.meet-isMin a b \with {
+    | byLeft p => rewrite p meet-left
+    | byRight p => rewrite p meet-right
+  }
+
+\lemma rat_real_join {a b : Rat} : Real.fromRat (a ∨ b) = Real.fromRat a ∨ Real.fromRat b
+  => <=-antisymmetric (\case TotalOrder.join-isMax a b \with {
+    | byLeft p => rewrite p RealAbGroup.join-left
+    | byRight p => rewrite p RealAbGroup.join-right
+  }) (join-univ (rat_real_<=.1 join-left) (rat_real_<=.1 join-right))
+
+\lemma rat_real_abs {a : Rat} : Real.fromRat (RatField.abs a) = RealAbGroup.abs (Real.fromRat a)
+  => rat_real_join *> pmap (_ RealAbGroup.∨) (inv RealAbGroup.negative-rat)
+
 \instance RealDenseOrder : UnboundedDenseLinearOrder
   | LinearOrder => RealAbGroup
   | isDense x<z => \case real_<-char.1 x<z \with {
@@ -506,6 +672,13 @@
     }
   }
 
+\lemma real-focus (x : Real) {eps : Real} (eps>0 : 0 < eps) : ∃ (a : Real) (a < x) (x < a + eps)
+  => \case real_<-char.1 eps>0 \with {
+    | inP (eps',eps'>0,eps'<eps) => \case x.LU-focus eps' eps'>0 \with {
+      | inP (a,a<x,x<a+eps') => inP (a, real_<_L.2 a<x, real_<_U.2 x<a+eps' <∘ rewriteI RealAbGroup.+-rat (RealAbGroup.<_+-right a $ real_<_L.2 eps'<eps))
+    }
+  }
+
 \lemma real_join_L {a b : Rat} {x : Real} (a<x : x.L a) (b<x : x.L b) : x.L (a ∨ b)
   => \case TotalOrder.join-isMax a b \with {
     | byLeft p => rewrite p a<x
diff --git a/src/Arith/Real/Field.ard b/src/Arith/Real/Field.ard
new file mode 100644
index 00000000..846af18d
--- /dev/null
+++ b/src/Arith/Real/Field.ard
@@ -0,0 +1,208 @@
+\import Algebra.Field
+\import Algebra.Group
+\import Algebra.Meta
+\import Algebra.Monoid
+\import Algebra.Ordered
+\import Algebra.Ring
+\import Algebra.Semiring
+\import Arith.Rat
+\import Arith.Real
+\import Data.Or
+\import Function.Meta
+\import Logic
+\import Logic.Meta
+\import Meta
+\import Operations
+\import Order.Lattice
+\import Order.LinearOrder
+\import Order.PartialOrder
+\import Order.StrictOrder
+\import Paths
+\import Paths.Meta
+\import Topology.CoverSpace.Complete
+\import Topology.CoverSpace.Product
+\import Topology.MetricSpace
+\import Topology.NormedAbGroup.Real
+\import Topology.NormedAbGroup
+\import Topology.TopAbGroup.Product
+\import Topology.TopSpace
+\import Topology.UniformSpace
+\import Topology.UniformSpace.Product
+\open LinearlyOrderedAbGroup
+\open ProductCoverSpace
+\open DiscreteOrderedField
+\open LinearOrder \hiding (<=)
+
+\instance RealRatAlgebra : OrderedFieldAlgebra RatField
+  | OrderedField => RealField
+  | *c a x => Real.fromRat a RealField.* x
+  | *c-assoc => pmap (RealField.`* _) (inv RealField.*-rat) *> RealField.*-assoc
+  | *c-ldistr => RealField.ldistr
+  | *c-rdistr => pmap (RealField.`* _) (inv RealAbGroup.+-rat) *> RealField.rdistr
+  | ide_*c => RealField.ide-left
+  | *c-comm-left => inv RealField.*-assoc
+  | coefMap => Real.fromRat
+  | coefMap_*c => inv RealField.ide-right
+  | coef_< p => real_<-char.2 (isDense p)
+  | coef_<-inv p => \case real_<-char.1 p \with {
+    | inP (a,x<a,a<y) => x<a <∘ a<y
+  }
+
+\instance RealField : OrderedField Real
+  | LinearlyOrderedAbGroup => RealAbGroup
+  | ide => 1
+  | * => *
+  | ide-left => unique1 (*-cover ∘ tuple (const (1 : Real)) id) id (\lam x => *-rat *> pmap Real.fromRat ide-left)
+  | *-comm => unique2 *-cover (*-cover ∘ tuple proj2 proj1) (\lam x y => *-rat *> pmap Real.fromRat *-comm *> inv *-rat)
+  | *-assoc => unique3 (*-cover ∘ prod *-cover id) (*-cover ∘ tuple (proj1 ∘ proj1) (*-cover ∘ prod proj2 id)) (\lam x y z => unfold $ unfold $ rewrite (*-rat,*-rat,*-rat,*-rat) $ pmap Real.fromRat *-assoc)
+  | ldistr => unique3 (*-cover ∘ tuple (proj1 ∘ proj1) (+-uniform ∘ prod proj2 id)) (+-uniform ∘ tuple (*-cover ∘ tuple (proj1 ∘ proj1) (proj2 ∘ proj1)) (*-cover ∘ tuple (proj1 ∘ proj1) proj2)) (\lam x y z => unfold $ unfold $ rewrite (RealAbGroup.+-rat,*-rat,*-rat,*-rat,RealAbGroup.+-rat) $ pmap Real.fromRat ldistr)
+  | ide>zro => idp
+  | positive_* x>0 y>0 => (*_positive-L x>0 y>0).2 \case L-rounded x>0, L-rounded y>0 \with {
+    | inP (a,a<x,a>0), inP (a',a'<y,a'>0) => inP (a, a', a>0, a'>0, a<x, a'<y, RatField.<_*_positive_positive a>0 a'>0)
+  }
+  | positive=>#0 {x : Real} x>0 => Monoid.Inv.lmake (pos-inv x>0) $ exts
+      (\lam c => ext (\lam l => \case (*_positive-L (pos-inv>0 x>0) x>0).1 l \with {
+        | inP (a, a', a>0, a'>0, byLeft a<=0, a'<x, c<aa') => absurd linarith
+        | inP (a, a', a>0, a'>0, byRight x<a1, a'<x, c<aa') => c<aa' <∘ transport (_ <) (finv-right $ RatField.>_/= a>0) (<_*_positive-right a>0 $ Real.LU-less a'<x x<a1)
+      }, \lam c<1 => (*_positive-L (pos-inv>0 x>0) x>0).2 $ unfold LowerReal.L \case Real.LU_*-focus-left x>0 c<1 \with {
+        | inP (b,bc<x,x<b) => \case L-rounded bc<x, L-rounded x>0 \with {
+          | inP (a',a'<x,bc<a'), inP (a'',a''<x,a''>0) =>
+            \have b>0 => Real.LU-less x>0 x<b
+            \in inP (finv b, a' ∨ a'', finv>0 b>0, a''>0 <∘l join-right, byRight $ transportInv x.U RatField.finv_finv x<b, real_join_L a'<x a''<x, transport (`< _) (inv *-assoc *> pmap (`*' c) (RatField.finv-left $ RatField.>_/= b>0) *> ide-left) (RatField.<_*_positive-right (finv>0 b>0) bc<a') <∘l LinearlyOrderedSemiring.<=_*_positive-right (<_<= $ finv>0 b>0) join-left)
+        }
+      }),
+       \lam d => ext (\lam u => \case (*_positive-U (pos-inv>0 x>0) x>0).1 u \with {
+         | inP (b,b',(b>0,b1<x),x<b',bb'<d) => transport (`< _) (finv-right $ RatField.>_/= b>0) (RatField.<_*_positive-right b>0 $ Real.LU-less b1<x x<b') <∘ bb'<d
+       }, \lam d>1 => (*_positive-U (pos-inv>0 x>0) x>0).2 \case Real.LU_*-focus-right x>0 d>1 \with {
+         | inP (a,a>0,a<x,x<ad) => \case U-rounded x<ad \with {
+           | inP (b',x<b',b'<ad) => inP (finv a, b', (finv>0 a>0, transportInv x.L RatField.finv_finv a<x), x<b', transport (_ <) (inv *-assoc *> pmap (`*' _) (RatField.finv-left $ RatField.>_/= a>0) *> ide-left) $ <_*_positive-right (finv>0 a>0) b'<ad)
+         }
+       }))
+  | #0=>eitherPosOrNeg {x} (xi : Monoid.Inv x) => \case U-inh {x * xi.inv} \with {
+    | inP (u,xy<u) => \case (real-lift2-char 0 u).1 (rewrite (\peval x * xi.inv) in (rewrite xi.inv-right idp : Real.L {x * xi.inv} 0), rewrite (\peval x * xi.inv) in xy<u) \with {
+      | inP (a',_,c1,d1,c2,d2,a'>0,_,c1<x,x<d1,c2<y,y<d2,h) => unfold at h $
+        \have | c1<d1 => Real.LU-less c1<x x<d1
+              | c2<d2 => Real.LU-less c2<y y<d2
+        \in \case dec<_<= c1 0, dec<_<= 0 d1 \with {
+          | inl c1<0, inl d1>0 => absurd $ <-irreflexive $ a'>0 <∘ transport (a' <) zro_*-left (h {0} {RatField.mid c2 d2} (c1<0,d1>0) (RatField.mid-between c2<d2)).1
+          | inl c1<0, inr d1<=0 => byRight $ RealAbGroup.negative_L.2 (UpperReal.U_<= x<d1 d1<=0)
+          | inr c1>=0, inl d1>0 => byLeft (LowerReal.L_<= c1<x c1>=0)
+          | inr c1>=0, inr d1<=0 => absurd $ <-irreflexive $ c1>=0 <∘r c1<d1 <∘l d1<=0
+        }
+    }
+  }
+  \where {
+    \open Monoid(* \as \infixl 7 *')
+    \open CoverMap
+
+    \lemma unique1 {X : SeparatedCoverSpace} (f g : CoverMap RealNormed X) (p : \Pi (x : Rat) -> f x = g x) {x : Real} : f x = g x
+      => dense-lift-unique rat_real rat_real.dense f g p x
+
+    \lemma unique2 {X : SeparatedCoverSpace} (f g : CoverMap (RealNormed ⨯ RealNormed) X) (p : \Pi (x y : Rat) -> f (x,y) = g (x,y)) {x y : Real} : f (x,y) = g (x,y)
+      => dense-lift-unique (prod rat_real rat_real) (prod.isDense rat_real.dense rat_real.dense) f g (\lam s => p s.1 s.2) (x,y)
+
+    \lemma unique3 {X : SeparatedCoverSpace} (f g : CoverMap (RealNormed ⨯ RealNormed ⨯ RealNormed) X) (p : \Pi (x y z : Rat) -> f ((x,y),z) = g ((x,y),z)) {x y z : Real} : f ((x,y),z) = g ((x,y),z)
+      => dense-lift-unique (prod (prod rat_real rat_real) rat_real) (prod.isDense (prod.isDense rat_real.dense rat_real.dense) rat_real.dense) f g (\lam s => p s.1.1 s.1.2 s.2) ((x,y),z)
+
+    \lemma *-rat-locally-uniform : LocallyUniformMap (RatNormed ⨯ RatNormed) RatNormed (\lam s => s.1 *' s.2)
+      => LocallyUniformMetricMap.makeLocallyUniformMap2 (*') \lam eps>0 => \case L-rounded (real_<_L.1 eps>0) \with {
+        | inP (eps',eps'<eps,eps'>0) => inP (1, RealAbGroup.zro<ide, \lam x0 y0 =>
+            \let | gamma => (finv (abs x0 + abs y0 + 3) *' eps') ∧ 1
+                 | lem : 0 < abs x0 + abs y0 + 3 => linarith (abs>=0 {_} {x0}, abs>=0 {_} {y0})
+                 | gamma>0 : 0 < gamma => <_meet-univ (RatField.<_*_positive_positive (RatField.finv>0 lem) eps'>0) zro<ide
+            \in inP (gamma, real_<_L.2 gamma>0, \lam {x} {x'} {y} {y'} x0x<1 y0y<1 xx'<gamma yy'<gamma =>
+              (rewrite norm-dist in, real_<_L.1, unfold) at x0x<1 $
+              (rewrite norm-dist in, real_<_L.1, unfold) at y0y<1 $
+              (rewrite norm-dist in, real_<_L.1, unfold) at xx'<gamma $
+              (rewrite norm-dist in, real_<_L.1, unfold) at yy'<gamma $
+              rewrite norm-dist $ real_<_L.2 $ L-closed eps'<eps $ later $ rewrite (equation {CRing} : x *' y - x' *' y' = x *' (y - y') + y' *' (x - x')) $
+              abs_+ <∘r rewrite (RatField.abs_*, RatField.abs_*) (RatField.<=_+ (RatField.<=_*_positive-right abs>=0 $ <_<= yy'<gamma)
+                                                                                (RatField.<=_*_positive-right abs>=0 $ <_<= xx'<gamma) <∘r
+                transport (`< _) rdistr (<_*_positive-left (linarith (abs_-' {_} {x0} {x}, abs_-' {_} {y0} {y}, abs_-' {_} {y} {y'}, meet-right : gamma <= 1) : abs x + abs y' < abs x0 + abs y0 + 3) gamma>0 <∘l
+                  RatField.<=_*_positive-right (<_<= lem) meet-left <=∘ Preorder.=_<=
+                    (inv *-assoc *> pmap (`*' _) (finv-right $ StrictPoset.>_/= $ later lem) *> ide-left)))))
+      }
+
+    \private \func *-cover-def : CoverMap (RealNormed ⨯ RealNormed) RealNormed
+      => real-lift2 (rat_real ∘ *-rat-locally-uniform)
+
+    \sfunc \infixl 7 * (x y : Real) : Real
+      => *-cover-def (x,y)
+
+    \lemma *-rat {x y : Rat} : x * y = {Real} x *' y
+      => (\peval x * y) *> dense-lift-char {_} {_} {_} {_} {prod.isDenseEmbedding rat_real.dense-coverEmbedding rat_real.dense-coverEmbedding} {rat_real ∘ *-rat-locally-uniform} (x,y)
+
+    \lemma *-cover : CoverMap (ProductCoverSpace RealNormed RealNormed) RealNormed (\lam s => s.1 * s.2)
+      => transportInv (CoverMap _ _) (ext \lam s => \peval s.1 * s.2) *-cover-def
+
+    \lemma *_positive-char {x y : Real} (x>0 : x.L 0) (y>0 : y.L 0) {c d : Rat} : open-rat-int c d (x * y) <-> ∃ (a b a' b' : Rat) (0 < a) (0 < a') (open-rat-int a b x) (open-rat-int a' b' y) (c < a *' a') (b *' b' < d)
+      => rewrite (\peval x * y) $ <->trans (real-lift2-char c d) $ unfold
+          (\lam (inP (a',b',c1,d1,c2,d2,c<a',b'<d,c1<x,x<d1,c2<y,y<d2,h)) => \case L-rounded (real_join_L c1<x x>0), U-rounded x<d1, L-rounded (real_join_L c2<y y>0), U-rounded y<d2 \with {
+            | inP (c1',c1'<x,c1_0<c1'), inP (d1',x<d1',d1'<d1), inP (c2',c2'<y,c2_0<c2'), inP (d2',y<d2',d2'<d2) =>
+              inP (c1', d1', c2', d2', join-right <∘r c1_0<c1', join-right <∘r c2_0<c2', (c1'<x,x<d1'), (c2'<y,y<d2'),
+                   c<a' <∘ (h (join-left <∘r c1_0<c1', Real.LU-less c1'<x x<d1) (join-left <∘r c2_0<c2', Real.LU-less c2'<y y<d2)).1,
+                   (h (Real.LU-less c1<x x<d1', d1'<d1) (Real.LU-less c2<y y<d2', d2'<d2)).2 <∘ b'<d)
+          }, \lam (inP (a,b,a',b',a>0,a'>0,(a<x,x<b),(a'<y,y<b'),c<aa',bb'<d)) => \case isDense c<aa', isDense bb'<d \with {
+            | inP (c',c<c',c'<aa'), inP (d',bb'<d',d'<d) => inP (c', d', a, b, a', b', c<c', d'<d, a<x, x<b, a'<y, y<b', \lam (a<x',x'<b) (a'<y',y'<b') =>
+                (c'<aa' <∘ <_*_positive-left a<x' a'>0 <∘ <_*_positive-right (a>0 <∘ a<x') a'<y',
+                 <_*_positive-left x'<b (a'>0 <∘ a'<y') <∘ <_*_positive-right (a>0 <∘ a<x' <∘ x'<b) y'<b' <∘ bb'<d'))
+          })
+
+    \lemma *_positive-L {x y : Real} (x>0 : x.L 0) (y>0 : y.L 0) {c : Rat} : LowerReal.L {x * y} c <-> ∃ (a a' : Rat) (0 < a) (0 < a') (x.L a) (y.L a') (c < a *' a')
+      => (\lam c<xy => \case U-inh {x * y} \with {
+            | inP (d,xy<d) => \case (*_positive-char x>0 y>0).1 (c<xy,xy<d) \with {
+              | inP (a,_,a',_,a>0,a'>0,(a<x,_),(a'<y,_),c<aa',_) => inP (a, a', a>0, a'>0, a<x, a'<y, c<aa')
+            }
+          }, \lam (inP (a,a',a>0,a'>0,a<x,a'<y,c<aa')) => \case x.U-inh, y.U-inh \with {
+            | inP (b,x<b), inP (b',y<b') => ((*_positive-char x>0 y>0 {c} {b *' b' + 1}).2 $ inP (a, b, a', b', a>0, a'>0, (a<x,x<b), (a'<y,y<b'), c<aa', linarith)).1
+          })
+
+    \lemma *_positive-U {x y : Real} (x>0 : x.L 0) (y>0 : y.L 0) {d : Rat} : UpperReal.U {x * y} d <-> ∃ (b b' : Rat) (x.U b) (y.U b') (b *' b' < d)
+      => (\lam xy<d => \case L-inh {x * y} \with {
+            | inP (c,c<xy) => \case (*_positive-char x>0 y>0).1 (c<xy,xy<d) \with {
+              | inP (_,b,_,b',_,_,(_,x<b),(_,y<b'),_,bb'<d) => inP (b, b', x<b, y<b', bb'<d)
+            }
+          }, \lam (inP (b,b',x<b,y<b',bb'<d)) => \case L-rounded x>0, L-rounded y>0 \with {
+            | inP (a,a<x,a>0), inP (a',a'<y,a'>0) => ((*_positive-char x>0 y>0 {a *' a' - 1} {d}).2 $ inP (a, b, a', b', a>0, a'>0, (a<x,x<b), (a'<y,y<b'), linarith, bb'<d)).2
+          })
+
+    \func pos-inv {x : Real} (x>0 : x.L 0) : Real \cowith
+      | L a => a <= 0 || x.U (finv a)
+      | L-inh => inP (0, byLeft <=-refl)
+      | L-closed {a} {b} p b<a => \case dec<_<= 0 b, \elim p \with {
+        | inl b>0, byLeft p => absurd linarith
+        | inl b>0, byRight p => byRight $ U-closed p $ finv_< b>0 b<a
+        | inr b<=0, _ => byLeft b<=0
+      }
+      | L-rounded {a} => \case dec<_<= a 0, __ \with {
+        | inl a<0, _ => inP (a *' ratio 1 2, byLeft linarith, linarith)
+        | inr a>=0, byLeft a<=0 => \case x.U-inh \with {
+          | inP (b,x<b) => inP (finv b, byRight $ transportInv x.U RatField.finv_finv x<b, rewrite (<=-antisymmetric a<=0 a>=0) $ finv>0 $ Real.LU-less x>0 x<b)
+        }
+        | inr a>=0, byRight x<a1 => \case U-rounded x<a1 \with {
+          | inP (b,x<b,b<a1) => inP (finv b, byRight $ transportInv x.U RatField.finv_finv x<b, finv_<-right (Real.LU-less x>0 x<b) b<a1)
+        }
+      }
+      | U a => \Sigma (0 < a) (x.L (finv a))
+      | U-inh => \case L-rounded x>0 \with {
+        | inP (a,a<x,a>0) => inP (finv a, (finv>0 a>0, transportInv x.L RatField.finv_finv a<x))
+      }
+      | U-closed (q>0,r) q<q' => (q>0 <∘ q<q', L-closed r $ finv_< q>0 q<q')
+      | U-rounded (q>0,q1<x) => \case L-rounded q1<x \with {
+        | inP (r,r<x,q1<r) => inP (finv r, (finv>0 $ finv>0 q>0 <∘ q1<r, transportInv x.L RatField.finv_finv r<x), finv_<-left q>0 q1<r)
+      }
+      | LU-disjoint p (q>0,r) => \case \elim p \with {
+        | byLeft p => p q>0
+        | byRight p => LU-disjoint r p
+      }
+      | LU-located {a} {b} a<b => \case dec<_<= 0 a \with {
+        | inl a>0 => \case x.LU-located (finv_< a>0 a<b) \with {
+          | byLeft p => byRight (a>0 <∘ a<b, p)
+          | byRight p => byLeft $ byRight p
+        }
+        | inr a<=0 => byLeft (byLeft a<=0)
+      }
+
+    \lemma pos-inv>0 {x : Real} (x>0 : x.L 0) : LowerReal.L {pos-inv x>0} 0
+      => byLeft <=-refl
+  }
\ No newline at end of file
diff --git a/src/Logic.ard b/src/Logic.ard
index 731182e7..946ea16d 100644
--- a/src/Logic.ard
+++ b/src/Logic.ard
@@ -103,8 +103,8 @@
 
 \func \infix 0 <-> (P Q : \Prop) => \Sigma (P -> Q) (Q -> P)
 
-\lemma <->_= {P Q : \Prop} (p : P = Q) : P <-> Q
-  => rewrite p (\lam x => x, \lam x => x)
+\lemma <->_= {P Q : \Prop} : (P <-> Q) <-> (P = Q)
+  => (\lam p => ext p, \lam p => rewrite p (\lam x => x, \lam x => x))
 
 \lemma <->refl {P : \Prop} : P <-> P
   => (\lam p => p, \lam p => p)
@@ -132,7 +132,7 @@
 \type TFAE (l : Array \Prop) : \Prop
   => \Pi (i j : Fin l.len) -> l i -> l j
   \where {
-    \lemma proof {l : Array \Prop} (p : Array (\Sigma (s : \Sigma (Fin l.len) (Fin l.len)) (l s.1 -> l s.2))) {s : So (checkConnected (map __.1 p) l.len)} : TFAE l
+    \lemma proof' {l : Array \Prop} (p : Array (\Sigma (s : \Sigma (Fin l.len) (Fin l.len)) (l s.1 -> l s.2))) {s : So (checkConnected (map __.1 p) l.len)} : TFAE l
       => \lam i j => path-proof p (checkConnected-correct (So.fromSo s) i j)
       \where {
         \func Graph (A : \Set) => Array (\Sigma A A)
@@ -274,6 +274,8 @@
           }
       }
 
+    \meta proof P => proof' (later P)
+
     \lemma cycle' {n : Nat} {l : Array \Prop (suc n)} (p : DArray {suc n} (\lam i => l i -> l (suc i Nat.mod suc n))) : TFAE l
       => aux2 (\lam i a => later $ transport l (nat_fin_= $ mod_< $ fin_< (suc i)) (p i a))
           \lam a => transport l (later $ nat_fin_= $ rewrite (mod_< id<suc) id_mod) (p n a)
diff --git a/src/Set/Filter.ard b/src/Set/Filter.ard
index 0449a33b..3e061767 100644
--- a/src/Set/Filter.ard
+++ b/src/Set/Filter.ard
@@ -23,6 +23,12 @@
 \record SetFilter (X : \Set) \extends Filter
   | A => SetLattice X
 
+\func SetFilter-map {X Y : \Set} (f : X -> Y) (F : SetFilter X) : SetFilter Y \cowith
+  | F V => F (f ^-1 V)
+  | filter-mono p d => filter-mono (p __) d
+  | filter-top => filter-top
+  | filter-meet => filter-meet
+
 \record ProperFilter \extends SetFilter
   | isProper {U : Set X} : F U -> ∃ U
 
@@ -33,6 +39,10 @@
   | filter-meet p q => (p,q)
   | isProper Ux => inP (x,Ux)
 
+\func ProperFilter-map {X Y : \Set} (f : X -> Y) (F : ProperFilter X) : ProperFilter Y \cowith
+  | SetFilter => SetFilter-map f F
+  | isProper d => TruncP.map (isProper d) \lam s => (f s.1, s.2)
+
 \instance ProperFilterSemilattice (X : \Set) : MeetSemilattice (ProperFilter X)
   | <= F G => F ⊆ G
   | <=-refl c => c
diff --git a/src/Set/Fin.ard b/src/Set/Fin.ard
index 778756d0..77ea714d 100644
--- a/src/Set/Fin.ard
+++ b/src/Set/Fin.ard
@@ -25,7 +25,7 @@
 \import Set
 \import Set.Fin.KFin
 \import Set.Fin.Pigeonhole
-\open LinearlyOrderedSemiring(<=_+)
+\open LinearlyOrderedAbMonoid(<=_+)
 
 \class FinSet \extends KFinSet, Choice, DecSet {
   | finEq : TruncP (Equiv {Fin finCard} {E})
diff --git a/src/Set/Subset.ard b/src/Set/Subset.ard
index 1d2c8a94..25b1ab61 100644
--- a/src/Set/Subset.ard
+++ b/src/Set/Subset.ard
@@ -1,33 +1,39 @@
 \import Function.Meta
 \import Logic
 \import Logic.Meta
-\import Meta
 \import Order.Lattice
 \import Order.PartialOrder
 \import Paths
 \import Paths.Meta
 \import Topology.Locale
+\open Bounded(top,top-univ)
 
-\func Set (A : \hType) => A -> \Prop
+\func Set (X : \hType) => X -> \Prop
   \where {
-    \func single {A : \Set} (a : A) : Set A
-      => a =
-
-    \lemma single_<= {A : \Set} {a : A} {U : Set A} (Ua : U a) : single a ⊆ U
-      => \lam p => rewriteI p Ua
-
-    \func Union {A : \hType} (S : Set A -> \hType) : Set A
+    \func Union {X : \hType} (S : Set X -> \hType) : Set X
       => \lam a => ∃ (U : S) (U a)
 
-    \lemma Union-cond {A : \hType} {S : Set A -> \hType} {U : Set A} (SU : S U) : U ⊆ Union S
+    \lemma Union-cond {X : \hType} {S : Set X -> \hType} {U : Set X} (SU : S U) : U ⊆ Union S
       => \lam Ux => inP (U,SU,Ux)
 
-    \func Total {A : \Type} (U : Set A) => \Sigma (x : A) (U x)
+    \func Total {X : \Type} (U : Set X) => \Sigma (x : X) (U x)
 
-    \func restrict {A : \Type} {U : Set A} (V : Set A) : Set (Total U)
+    \func restrict {X : \Type} {U : Set X} (V : Set X) : Set (Total U)
       => \lam s => V s.1
+
+    \func Prod {X Y : \hType} (U : Set X) (V : Set Y) : Set (\Sigma X Y)
+      => \lam s => \Sigma (U s.1) (V s.2)
+
+    \func CoverInter {X : \hType} (C : Set (Set X)) (D : Set (Set X)) : Set (Set X)
+      => \lam W => ∃ (U : C) (V : D) (W = U ∧ {SetLattice X} V)
   }
 
+\func single {A : \Set} (a : A) : Set A
+  => a =
+
+\lemma single_<= {A : \Set} {a : A} {U : Set A} (Ua : U a) : single a ⊆ U
+  => \lam p => rewriteI p Ua
+
 \func \infix 8 ^-1 {A B : \hType} (f : A -> B) (S : Set B) : Set A
   => \lam a => S (f a)
 
@@ -52,6 +58,38 @@
   | Join-univ d (inP (j,c)) => d j c
   | Join-ldistr>= (d, inP (j,c)) => inP (j,(d,c))
 
+\func Refines {X : \hType} (C D : Set (Set X)) : \Prop
+  => ∀ {U : C} ∃ (V : D) (U ⊆ V)
+
+\lemma Refines-cover {X : \hType} {C D : Set (Set X)} (r : Refines C D) {x : X} (p : ∃ (U : C) (U x)) : ∃ (V : D) (V x) \elim p
+  | inP (U,CU,Ux) => \case r CU \with {
+    | inP (V,DV,U<=V) => inP (V, DV, U<=V Ux)
+  }
+
+\lemma Refines-single_top {X : \hType} {C : Set (Set X)} : Refines C (single top)
+  => \lam _ => inP (top, idp, top-univ)
+
+\lemma Refines-refl {X : \hType} {C : Set (Set X)} : Refines C C
+  => \lam CU => inP (_, CU, <=-refl)
+
+\lemma Refines-trans {X : \hType} {C D E : Set (Set X)} (r1 : Refines C D) (r2 : Refines D E) : Refines C E
+  => \lam CU => \case r1 CU \with {
+    | inP (V,DV,U<=V) => \case r2 DV \with {
+      | inP (W,EW,V<=W) => inP (W, EW, U<=V <=∘ V<=W)
+    }
+  }
+
+\lemma Refines-inter-left {X : \hType} {C D : Set (Set X)} : Refines (Set.CoverInter C D) C
+  => \lam {_} (inP (U,CU,_,_,idp)) => inP (U, CU, meet-left)
+
+\lemma Refines-inter-right {X : \hType} {C D : Set (Set X)} : Refines (Set.CoverInter C D) D
+  => \lam {_} (inP (_,_,V,DV,idp)) => inP (V, DV, meet-right)
+
+\lemma Refines-inter {X : \hType} {C D C' D' : Set (Set X)} (r : Refines C D) (r' : Refines C' D') : Refines (Set.CoverInter C C') (Set.CoverInter D D')
+  => \lam {W} (inP (U,CU,U',C'U',W=UU')) => \case r CU, r' C'U' \with {
+    | inP (V,DV,U<=V), inP (V',D'V',U'<=V') => inP (V ∧ V', inP (V, DV, V', D'V', idp), rewrite W=UU' $ MeetSemilattice.meet-monotone U<=V U'<=V')
+  }
+
 \func extend {A : \Type} {U : Set A} (V : Set (Set.Total U)) : Set A
   => \lam x => \Sigma (Ux : U x) (V (x,Ux))
 
@@ -64,6 +102,9 @@
 \lemma extend_restrict {A : \Type} {U : Set A} {V : Set A} : extend (Set.restrict {A} {U} V) ⊆ V
   => __.2
 
+\lemma ^-1_<= {A B : \hType} (f : A -> B) {U V : Set B} (p : U ⊆ V) : f ^-1 U ⊆ f ^-1 V
+  => p __
+
 \func ^-1_FrameHom {A B : \hType} (f : A -> B) : FrameHom (SetLattice B) (SetLattice A) \cowith
   | func => ^-1 f
   | func-<= p {_} => p
diff --git a/src/Topology/CoverSpace.ard b/src/Topology/CoverSpace.ard
index 89a076ad..049f2405 100644
--- a/src/Topology/CoverSpace.ard
+++ b/src/Topology/CoverSpace.ard
@@ -3,7 +3,6 @@
 \import Logic
 \import Logic.Meta
 \import Meta
-\import Operations
 \import Order.Lattice
 \import Order.PartialOrder
 \import Paths
@@ -20,23 +19,26 @@
   | isCauchy : Set (Set E) -> \Prop
   | cauchy-cover {C : Set (Set E)} : isCauchy C -> \Pi (x : E) -> ∃ (U : C) (U x)
   | cauchy-top : isCauchy (single top)
-  | cauchy-extend {C D : Set (Set E)} : isCauchy C -> (\Pi {U : Set E} -> C U -> ∃ (V : D) (U ⊆ V)) -> isCauchy D
+  | cauchy-refine {C D : Set (Set E)} : isCauchy C -> Refines C D -> isCauchy D
   | cauchy-trans {C : Set (Set E)} : isCauchy C -> \Pi {D : Set E -> Set (Set E)} -> (\Pi {U : Set E} -> C U -> isCauchy (D U))
     -> isCauchy (\lam U => ∃ (V W : Set E) (C V) (D V W) (U = V ∧ W))
+  | cauchy-open {S : Set E} : isOpen S <-> ∀ {x : S} (isCauchy \lam U => U x -> U ⊆ S)
 
-  | isOpen S => ∀ {x : S} (isCauchy \lam U => U x -> U ⊆ S)
-  | open-top _ => cauchy-extend cauchy-top \lam {U} _ => inP (U, \lam _ _ => (), <=-refl)
-  | open-inter Uo Vo => \lam {x} (Ux,Vx) => cauchy-extend (cauchy-trans (Uo Ux) (\lam _ => Vo Vx))
+  \default open-top => cauchy-open.2 \lam _ => cauchy-refine cauchy-top \lam {U} _ => inP (U, \lam _ _ => (), <=-refl)
+  \default open-inter Uo Vo => cauchy-open.2 $ later \lam {x} (Ux,Vx) => cauchy-refine (cauchy-trans (cauchy-open.1 Uo Ux) (\lam _ => cauchy-open.1 Vo Vx))
       \lam (inP (U',V',Uc,Vc,W=U'V')) => inP (U' ∧ V', \lam (U'x,V'x) {y} (U'y,V'y) => (Uc U'x U'y, Vc V'x V'y), Preorder.=_<= W=U'V')
-  | open-Union So {x} (inP (U,SU,Ux)) => cauchy-extend (So SU Ux) \lam {V} Vc => inP (V, \lam Vx => Vc Vx <=∘ Set.Union-cond SU, <=-refl)
+  \default open-Union So => cauchy-open.2 $ later \lam {x} (inP (U,SU,Ux)) => cauchy-refine (cauchy-open.1 (So SU) Ux) \lam {V} Vc => inP (V, \lam Vx => Vc Vx <=∘ Set.Union-cond SU, <=-refl)
+
+  \default isOpen S : \Prop => ∀ {x : S} (isCauchy \lam U => U x -> U ⊆ S)
+  \default cauchy-open \as cauchy-open-impl {S} : isOpen S <-> _ => <->refl
 
   \lemma cauchy-trans-dep {C : Set (Set E)} {D : \Pi {U : Set E} -> C U -> Set (Set E)} (Cc : isCauchy C) (Dc : \Pi {U : Set E} (c : C U) -> isCauchy (D c))
     : isCauchy (\lam U => ∃ (V W : Set E) (c : C V) (D c W) (U = V ∧ W))
     => transport isCauchy (ext \lam U => ext (\lam (inP (V,W,CV,DW,p)) => inP (V, W, CV, transport (D __ W) prop-pi DW.2, p), \lam (inP (V,W,c,DW,p)) => inP (V, W, c, (c,DW), p))) $ cauchy-trans Cc {\lam U V => \Sigma (c : C U) (D c V)} \lam CU => transport isCauchy (ext \lam V => ext (\lam d => (CU,d), \lam s => transport (D __ V) prop-pi s.2)) (Dc CU)
 
-  \lemma open-char {S : Set E} : isOpen S <-> ∀ {x : S} (single x <=< S)
-    => (\lam So Sx => cauchy-subset (So Sx) $ later \lam f (y,(p,q)) => f $ rewrite p q,
-        \lam f {x} Sx => cauchy-subset (later $ f Sx) $ later \lam g Ux => g (x, (idp,Ux)))
+  \lemma open-char {S : Set E} : TopSpace.isOpen S <-> ∀ {x : S} (single x <=< S)
+    => (\lam So Sx => cauchy-subset (cauchy-open.1 So Sx) $ later \lam f (y,(p,q)) => f $ rewrite p q,
+        \lam f => cauchy-open.2 \lam {x} Sx => cauchy-subset (later $ f Sx) $ later \lam g Ux => g (x, (idp,Ux)))
 
   \func HasWeaklyDensePoints => \Pi {C : Set (Set E)} -> isCauchy (\lam U => (U = {Set E} bottom) || C U) -> isCauchy C
 
@@ -49,17 +51,13 @@
       }
       | (byRight CU, _) => CU
     }
-
-  \func NFilter (x : E) : ProperFilter E \cowith
-    | F U => single x <=< U
-    | filter-mono p q => RegularRatherBelow.<=<-left q p
-    | filter-top => RegularRatherBelow.<=<_top
-    | filter-meet => RegularRatherBelow.<=<_meet-same
-    | isProper p => inP (x, <=<_<= p idp)
+} \where {
+  \lemma PrecoverSpace-ext {X : \Set} {S T : PrecoverSpace X} (p : \Pi {C : Set (Set X)} -> S.isCauchy C <-> T.isCauchy C) : S = T
+    => exts (\lam U => <->_=.1 S.cauchy-open *> ext (\lam f Ux => p.1 (f Ux), \lam f Ux => p.2 (f Ux)) *> inv (<->_=.1 T.cauchy-open), \lam C => ext p)
 }
 
 \lemma cauchy-subset {X : PrecoverSpace} {C D : Set (Set X)} (Cc : isCauchy C) (e : \Pi {U : Set X} -> C U -> D U) : isCauchy D
-  => cauchy-extend Cc \lam {U} CU => inP (U, e CU, <=-refl)
+  => cauchy-refine Cc \lam {U} CU => inP (U, e CU, <=-refl)
 
 \lemma top-cauchy {X : PrecoverSpace} {C : Set (Set X)} (Ct : C top) : isCauchy C
   => cauchy-subset cauchy-top $ later \lam p => rewriteI p Ct
@@ -75,14 +73,12 @@
     | suc j => f j
   }, p *> pmap (U ∧) q)
 
-\func IsDenseSet {X : PrecoverSpace} (S : Set X) : \Prop
-  => \Pi {x : X} {U : Set X} -> single x <=< U -> ∃ (y : S) (U y)
-
-\record CoverMap \extends ContMap {
+\record PrecoverMap \extends ContMap {
   \override Dom : PrecoverSpace
   \override Cod : PrecoverSpace
   | func-cover {D : Set (Set Cod)} : isCauchy D -> isCauchy \lam U => ∃ (V : D) (U = func ^-1 V)
-  | func-cont Uo {x} Ufx => cauchy-extend (func-cover (Uo Ufx)) \lam (inP (W,c,d)) => inP (func ^-1 W, \lam a {_} => c a, Preorder.=_<= d)
+
+  \default func-cont Uo => cauchy-open.2 $ later \lam {x} Ufx => cauchy-refine (func-cover (cauchy-open.1 Uo Ufx)) \lam (inP (W,c,d)) => inP (func ^-1 W, \lam a {_} => c a, Preorder.=_<= d)
 
   \func IsEmbedding : \Prop
     => \Pi {C : Set (Set Dom)} -> isCauchy C -> isCauchy \lam V => ∃ (U : C) (func ^-1 V ⊆ U)
@@ -90,35 +86,27 @@
   -- | A map is an embedding if and only if the structure on the domain is the smallest compatible with the map.
   \lemma embedding-char : TFAE (
     {- 0 -} IsEmbedding,
-    {- 1 -} \Pi {X : PrecoverSpace Dom} -> CoverMap X Cod func -> \Pi {C : Set (Set Dom)} -> isCauchy C -> X.isCauchy C,
+    {- 1 -} \Pi {X : PrecoverSpace Dom} -> PrecoverMap X Cod func -> \Pi {C : Set (Set Dom)} -> isCauchy C -> X.isCauchy C,
     {- 2 -} \Pi {C : Set (Set Dom)} -> isCauchy C -> isCauchy {PrecoverTransfer func} C,
     {- 3 -} Dom = {PrecoverSpace Dom} PrecoverTransfer func
   ) => TFAE.cycle (
-    \lam p f Cc => cauchy-extend (func-cover {f} $ p Cc) \lam (inP (V, inP (U',CU',p), q)) => inP (U', CU', rewrite q p),
+    \lam p f Cc => cauchy-refine (func-cover {f} $ p Cc) \lam (inP (V, inP (U',CU',p), q)) => inP (U', CU', rewrite q p),
     \lam f => f PrecoverTransfer-map,
-    \lam f => exts \lam C => ext (f, PrecoverTransfer-char),
+    \lam f => PrecoverSpace.PrecoverSpace-ext {_} {Dom} {PrecoverTransfer func} \lam {C} => (f,PrecoverTransfer-char),
     \lam p => unfolds $ rewrite p \lam (inP (D,Dc,f)) => cauchy-subset Dc f)
 
-  \func IsDense : \Prop
-    => \Pi {y : Cod} {U : Set Cod} -> single y <=< U -> ∃ (x : Dom) (U (func x))
-
-  \lemma dense-char : IsDense <-> IsDenseSet (\lam y => ∃ (x : Dom) (func x = y))
-    => (\lam d p => TruncP.map (d p) \lam s => (func s.1, inP (s.1, idp), s.2), \lam d p => \case d p \with {
-      | inP (_, inP (x,idp), Ufx) => inP (x, Ufx)
-    })
-
   \func IsDenseEmbedding : \Prop
     => \Sigma IsDense IsEmbedding
 } \where {
-  \func id {X : PrecoverSpace} : CoverMap X X \cowith
+  \func id {X : PrecoverSpace} : PrecoverMap X X \cowith
     | func x => x
     | func-cover Dc => cauchy-subset Dc \lam {U} DU => inP $ later (U, DU, idp)
 
-  \func compose \alias \infixl 8 ∘ {X Y Z : PrecoverSpace} (g : CoverMap Y Z) (f : CoverMap X Y) : CoverMap X Z \cowith
+  \func compose \alias \infixl 8 ∘ {X Y Z : PrecoverSpace} (g : PrecoverMap Y Z) (f : PrecoverMap X Y) : PrecoverMap X Z \cowith
     | func x => g (f x)
     | func-cover Dc => cauchy-subset (f.func-cover $ g.func-cover Dc) \lam (inP (V, inP (W,DW,q), p)) => inP $ later (W, DW, p *> rewrite q idp)
 
-  \func const {Y X : PrecoverSpace} (x : X) : CoverMap Y X \cowith
+  \func const {Y X : PrecoverSpace} (x : X) : PrecoverMap Y X \cowith
     | func _ => x
     | func-cover Dc => top-cauchy \case cauchy-cover Dc x \with {
       | inP (U,DU,Ux) => inP $ later (U, DU, ext \lam y => ext (\lam _ => Ux, \lam _ => ()))
@@ -136,9 +124,12 @@
     | inP (W,f,Wx) => f (x, (Vx, Wx)) Wx
   }
 
-\lemma <=<_^-1 {X Y : PrecoverSpace} {f : CoverMap X Y} {U V : Set Y} (U<=<V : U <=< V) : f ^-1 U <=< f ^-1 V
+\lemma <=<_^-1 {X Y : PrecoverSpace} {f : PrecoverMap X Y} {U V : Set Y} (U<=<V : U <=< V) : f ^-1 U <=< f ^-1 V
   => cauchy-subset (f.func-cover U<=<V) \lam (inP (W,g,p)) => rewrite p $ later \lam (x,s) => g (f x, s) __
 
+\lemma <=<-cont {X : PrecoverSpace} {Y : CoverSpace} {f : ContMap X Y} {x : X} {U : Set Y} (fx<=<U : single (f x) <=< U) : single x <=< f ^-1 U
+  => RegularRatherBelow.<=<-left (PrecoverSpace.open-char.1 (f.func-cont $ Y.interior {U}) fx<=<U) (<=<_<= __ idp)
+
 \type \infix 4 s<=< {X : PrecoverSpace} (V U : Set X) : \Prop
   => isCauchy \lam W => (W = Compl V) || (W = U)
 
@@ -154,7 +145,7 @@
 \lemma s<=<_bottom {X : PrecoverSpace} {U : Set X} : bottom s<=< U
   => unfolds $ top-cauchy $ byLeft $ <=-antisymmetric (later \lam _ => \lam (inP s) => s.1) top-univ
 
-\lemma s<=<_^-1 {X Y : PrecoverSpace} {f : CoverMap X Y} {U V : Set Y} (U<=<V : U s<=< V) : f ^-1 U s<=< f ^-1 V
+\lemma s<=<_^-1 {X Y : PrecoverSpace} {f : PrecoverMap X Y} {U V : Set Y} (U<=<V : U s<=< V) : f ^-1 U s<=< f ^-1 V
   => cauchy-subset (f.func-cover U<=<V) \case __ \with {
     | inP (_, byLeft idp, p) => byLeft p
     | inP (_, byRight idp, p) => byRight p
@@ -169,15 +160,15 @@
 
 \instance StronglyRatherBelow {X : PrecoverSpace} : RatherBelow {SetLattice X} (s<=<)
   | <=<_top => unfolds $ top-cauchy $ byRight idp
-  | <=<-left p q => cauchy-extend (unfolds in p) \lam {U'} => later \case __ \with {
+  | <=<-left p q => cauchy-refine (unfolds in p) \lam {U'} => later \case __ \with {
     | byLeft r => rewrite r $ inP (_, byLeft idp, <=-refl)
     | byRight r => rewrite r $ inP (_, byRight idp, q)
   }
-  | <=<-right p q => cauchy-extend (unfolds in q) \lam {U'} => later \case __ \with {
+  | <=<-right p q => cauchy-refine (unfolds in q) \lam {U'} => later \case __ \with {
     | byLeft r => inP (_, byLeft idp, rewrite r \lam nVx Wx => nVx (p Wx))
     | byRight r => inP (U', byRight r, <=-refl)
   }
-  | <=<_meet U<=<U' V<=<V' => cauchy-extend (cauchy-inter (unfolds in U<=<U') V<=<V') $ later \lam (inP (U'', V'', t1, t2, p)) => rewrite p \case \elim t1, \elim t2 \with {
+  | <=<_meet U<=<U' V<=<V' => cauchy-refine (cauchy-inter (unfolds in U<=<U') V<=<V') $ later \lam (inP (U'', V'', t1, t2, p)) => rewrite p \case \elim t1, \elim t2 \with {
     | byLeft r, _ => inP (_, byLeft idp, rewrite r \lam (nUx,_) (Ux,_) => nUx Ux)
     | _, byLeft r => inP (_, byLeft idp, rewrite r \lam (_,nVx) (_,Vx) => nVx Vx)
     | byRight q, byRight r => inP (_, byRight $ pmap2 (∧) q r, <=-refl)
@@ -190,6 +181,17 @@
     => \case cauchy-cover (isRegular Cc) x \with {
       | inP (U, inP (V, CV, U<=<V), Ux) => inP (V, CV, <=<-right (single_<= Ux) U<=<V)
     }
+
+  \lemma interior {U : Set E} : TopSpace.isOpen \lam x => single x <=< U
+    => open-char.2 \lam x<=<U => \case <=<-inter x<=<U \with {
+      | inP (V,x<=<V,V<=<U) => <=<-left x<=<V \lam Vx => later $ <=<-right (single_<= Vx) V<=<U
+    }
+
+  \lemma cauchy-open-cover {C : Set (Set E)} (Cc : isCauchy C) : isCauchy \lam V => ∃ (U : C) (V = \lam x => single x <=< U)
+    => cauchy-refine (isRegular Cc) \lam {V} (inP (U,CU,V<=<U)) => inP $ (_, inP (U, CU, idp), \lam Vx => <=<-right (single_<= Vx) V<=<U)
+} \where {
+  \lemma CoverSpace-ext {X : \Set} {S T : CoverSpace X} (p : \Pi {C : Set (Set X)} -> S.isCauchy C <-> T.isCauchy C) : S = T
+    => exts (\lam U => <->_=.1 S.cauchy-open *> ext (\lam f Ux => p.1 (f Ux), \lam f Ux => p.2 (f Ux)) *> inv (<->_=.1 T.cauchy-open), \lam C => ext p)
 }
 
 \lemma <=<-inter {X : CoverSpace} {x : X} {U : Set X} (x<=<U : single x <=< U) : ∃ (V : Set X) (single x <=< V) (V <=< U)
@@ -202,13 +204,28 @@
     | inP (V'', inP (V', inP (V, h, V'<=<V), V''<=<V'), V''x) => inP (V', <=<-right (single_<= V''x) V''<=<V', <=<-left V'<=<V $ h (x, (idp, s<=<_<= V'<=<V $ s<=<_<= V''<=<V' V''x)))
   }
 
-\lemma denseSet-char {X : CoverSpace} {S : Set X} : IsDenseSet S <-> ∀ {C : isCauchy} (isCauchy \lam V => ∃ (U : C) (V ⊆ U) (Given V -> ∃ (x : S) (U x)))
-  => (\lam d Cc => cauchy-subset (isRegular Cc) \lam (inP (V,CV,U<=<V)) => inP $ later (V, CV, <=<_<= U<=<V, \lam (x,Ux) => d $ <=<-right (single_<= Ux) U<=<V),
-      \lam d {x} {U} x<=<U => \case cauchy-cover (d x<=<U) x \with {
-        | inP (V, inP (W,f,V<=W,g), Vx) => \case g (x,Vx) \with {
-          | inP (y,Sy,Wy) => inP (y, Sy, f (x, (idp, V<=W Vx)) Wy)
-        }
-      })
+\lemma denseSet-char {X : CoverSpace} {S : Set X} : TFAE (
+    IsDenseSet S,
+    \Pi {x : X} {U : Set X} -> single x <=< U -> ∃ (x' : S) (U x'),
+    ∀ {C : isCauchy} (isCauchy \lam V => ∃ (U : C) (V ⊆ U) (Given V -> ∃ (x : S) (U x)))
+) => TFAE.proof (
+      ((0,1), \lam d x<=<U => \case d X.interior x<=<U \with {
+        | inP (x',Sx',x'<=<U) => inP (x', Sx', <=<_<= x'<=<U idp)
+      }),
+      ((1,0), \lam d Uo Uy => d $ PrecoverSpace.open-char.1 Uo Uy),
+      ((1,2), \lam d Cc => cauchy-subset (isRegular Cc) \lam (inP (V,CV,U<=<V)) => inP $ later (V, CV, <=<_<= U<=<V, \lam (x,Ux) => d $ <=<-right (single_<= Ux) U<=<V)),
+      ((2,1), \lam d {x} {U} x<=<U => \case cauchy-cover (d x<=<U) x \with {
+         | inP (V, inP (W,f,V<=W,g), Vx) => \case g (x,Vx) \with {
+           | inP (y,Sy,Wy) => inP (y, Sy, f (x, (idp, V<=W Vx)) Wy)
+         }
+       }))
+
+\lemma dense-char {X : PrecoverSpace} {Y : CoverSpace} {f : PrecoverMap X Y} : f.IsDense <-> (\Pi {y : Y} {U : Set Y} -> single y <=< U -> ∃ (x : X) (U (f x)))
+  => (\lam d p => \case denseSet-char 0 1 d p \with {
+    | inP (y, inP (x,fx=y), Uy) => inP (x, rewrite fx=y Uy)
+  }, \lam d => denseSet-char 1 0 \lam p => \case d p \with {
+    | inP (x,Ufx) => inP (f x, inP $ later (x, idp), Ufx)
+  })
 
 \class StronglyRegularCoverSpace \extends CoverSpace
   | isStronglyRegular {C : Set (Set E)} : isCauchy C -> isCauchy \lam V => ∃ (U : C) (V s<=< U)
@@ -231,7 +248,7 @@
   | isCauchy C => C top
   | cauchy-cover Ct x => inP (top, Ct, ())
   | cauchy-top => idp
-  | cauchy-extend Ct e => \case e Ct \with {
+  | cauchy-refine Ct e => \case e Ct \with {
     | inP (V,DV,t<=V) => rewrite (<=-antisymmetric t<=V top-univ) DV
   }
   | cauchy-trans Ct e => inP (top, top, Ct, e Ct, <=-antisymmetric (\lam _ => ((), ())) top-univ)
@@ -241,7 +258,7 @@
   | isCauchy C => \Pi (x : X) -> ∃ (U : C) (U x)
   | cauchy-cover c => c
   | cauchy-top x => inP (top, idp, ())
-  | cauchy-extend c d x =>
+  | cauchy-refine c d x =>
     \have | (inP (U,CU,Ux)) => c x
           | (inP (V,DV,U<=V)) => d CU
     \in inP (V, DV, U<=V Ux)
@@ -260,7 +277,7 @@
           | (inP (U,CU,p)) => d DV
     \in inP (U, CU, p Vfx)
   | cauchy-top => inP (single top, cauchy-top, \lam p => rewriteI p $ inP (top,idp,<=-refl))
-  | cauchy-extend (inP (D,Dc,d)) e => inP (D, Dc, \lam DV =>
+  | cauchy-refine (inP (D,Dc,d)) e => inP (D, Dc, \lam DV =>
       \have | (inP (U,CU,p)) => d DV
             | (inP (W,DW,q)) => e CU
       \in inP (W, DW, p <=∘ q))
@@ -273,11 +290,11 @@
       | inP (d,Dd,s) => inP (c ∧ d, inP (c, d, Cc, Dd, idp), rewrite W=UV \lam e => (q e.1, s e.2))
     })
 
-\lemma PrecoverTransfer-map {X : \Set} {Y : PrecoverSpace} {f : X -> Y} : CoverMap (PrecoverTransfer f) Y f \cowith
+\lemma PrecoverTransfer-map {X : \Set} {Y : PrecoverSpace} {f : X -> Y} : PrecoverMap (PrecoverTransfer f) Y f \cowith
   | func-cover {D} Dc => inP (D, Dc, \lam {V} DV => inP (f ^-1 V, inP (V, DV, idp), <=-refl))
 
-\lemma PrecoverTransfer-char {X Y : PrecoverSpace} {f : CoverMap X Y} {C : Set (Set X)} (c : isCauchy {PrecoverTransfer f} C) : X.isCauchy C \elim c
-  | inP (D,Dc,De) => cauchy-extend (f.func-cover Dc) \lam {U} (inP (V,DV,p)) => \case De DV \with {
+\lemma PrecoverTransfer-char {X Y : PrecoverSpace} {f : PrecoverMap X Y} {C : Set (Set X)} (c : isCauchy {PrecoverTransfer f} C) : X.isCauchy C \elim c
+  | inP (D,Dc,De) => cauchy-refine (f.func-cover Dc) \lam {U} (inP (V,DV,p)) => \case De DV \with {
     | inP (U',CU',q) => inP (U', CU', rewrite p q)
   }
 
@@ -285,13 +302,13 @@
   | isCauchy => Closure A
   | cauchy-cover CC x => closure-filter (pointFilter x) (\lam AC => CA AC x) CC
   | cauchy-top => closure-top idp
-  | cauchy-extend => closure-extends
+  | cauchy-refine => closure-refine
   | cauchy-trans => closure-trans __ __ idp
   \where {
-    \truncated \data Closure (A : Set (Set X) -> \Prop) (C : Set (Set X)) : \Prop
+    \truncated \data Closure {X : \Set} (A : Set (Set X) -> \Prop) (C : Set (Set X)) : \Prop
       | closure (A C)
       | closure-top (C = single top)
-      | closure-extends {D : Set (Set X)} (Closure A D) (\Pi {U : Set X} -> D U -> ∃ (V : Set X) (C V) (U ⊆ V))
+      | closure-refine {D : Set (Set X)} (Closure A D) (\Pi {U : Set X} -> D U -> ∃ (V : Set X) (C V) (U ⊆ V))
       | closure-trans {D : Set (Set X)} (Closure A D) {E : \Pi (U : Set X) -> Set (Set X)} (\Pi {U : Set X} -> D U -> Closure A (E U))
                       (C = \lam U => ∃ (V W : Set X) (D V) (E V W) (U = V ∧ W))
 
@@ -299,13 +316,13 @@
       : Closure A (\lam W => ∃ (U V : Set X) (C U) (D V) (W = U ∧ V))
       => closure-trans Cc (\lam _ => Dc) idp
 
-    \lemma closure-subset {A : Set (Set X) -> \Prop} {C D : Set (Set X)} (Dc : Closure A D) (D<=C : D ⊆ C) : Closure A C
-      => closure-extends Dc \lam {V} DV => inP (V, D<=C DV, <=-refl)
+    \lemma closure-subset {X : \Set} {A : Set (Set X) -> \Prop} {C D : Set (Set X)} (Dc : Closure A D) (D<=C : D ⊆ C) : Closure A C
+      => closure-refine Dc \lam {V} DV => inP (V, D<=C DV, <=-refl)
 
     \lemma closure-filter {A : Set (Set X) -> \Prop} (F : SetFilter X) (CA : \Pi {C : Set (Set X)} -> A C -> ∃ (U : C) (F U)) {C : Set (Set X)} (CC : Closure A C) : ∃ (U : C) (F U) \elim CC
       | closure AC => CA AC
       | closure-top idp => inP (top, idp, filter-top)
-      | closure-extends {D} CD e =>
+      | closure-refine {D} CD e =>
         \have | (inP (U,DU,FU)) => closure-filter F CA CD
               | (inP (V,CV,U<=V)) => e DU
         \in inP (V, CV, filter-mono U<=V FU)
@@ -317,29 +334,58 @@
     \lemma closure-cauchy {S : PrecoverSpace X} {A : Set (Set X) -> \Prop} (AS : \Pi {C : Set (Set X)} -> A C -> S.isCauchy C) {C : Set (Set X)} (CC : Closure A C) : S.isCauchy C \elim CC
       | closure AC => AS AC
       | closure-top p => rewrite p cauchy-top
-      | closure-extends CD e => cauchy-extend (closure-cauchy AS CD) e
+      | closure-refine CD e => cauchy-refine (closure-cauchy AS CD) e
       | closure-trans CD CE idp => S.cauchy-trans-dep (closure-cauchy AS CD) \lam DU => closure-cauchy AS (CE DU)
 
     \lemma closure-univ-cover {Y : PrecoverSpace} {f : Y -> X} (Ap : ∀ {C : A} (isCauchy \lam U => ∃ (V : Set X) (C V) (U = f ^-1 V))) {C : Set (Set X)} (Cc : Closure A C) : isCauchy \lam U => ∃ (V : Set X) (C V) (U = f ^-1 V) \elim Cc
       | closure a => Ap a
       | closure-top p => cauchy-subset cauchy-top \lam q => inP $ later (top, rewrite p idp, inv q)
-      | closure-extends Cc g => cauchy-extend (closure-univ-cover {X} {A} Ap Cc) \lam (inP (V,CV,q)) => TruncP.map (g CV) \lam (V',CV',V<=V') => (f ^-1 V', inP (V', CV', idp), rewrite q \lam c => V<=V' c)
+      | closure-refine Cc g => cauchy-refine (closure-univ-cover Ap Cc) \lam (inP (V,CV,q)) => TruncP.map (g CV) \lam (V',CV',V<=V') => (f ^-1 V', inP (V', CV', idp), rewrite q \lam c => V<=V' c)
       | closure-trans {D} Cc {E} g p =>
-        \have t => cauchy-trans (closure-univ-cover {X} {A} Ap Cc) {\lam V V' => ∃ (U : Set X) (V = f ^-1 U) (D U) (U' : Set X) (E U U') (V' = f ^-1 U')}
-                    \lam (inP (V,DV,q)) => cauchy-subset (closure-univ-cover {X} {A} Ap (g DV)) \lam (inP (V',EVV',r)) => inP $ later (V, q, DV, V', EVV', r)
+        \have t => cauchy-trans (closure-univ-cover Ap Cc) {\lam V V' => ∃ (U : Set X) (V = f ^-1 U) (D U) (U' : Set X) (E U U') (V' = f ^-1 U')}
+                    \lam (inP (V,DV,q)) => cauchy-subset (closure-univ-cover Ap (g DV)) \lam (inP (V',EVV',r)) => inP $ later (V, q, DV, V', EVV', r)
         \in cauchy-subset t \lam (inP (W, W', _, inP (V2,p2,DV2,V2',EV2V2',p2'), U=WW')) => inP $ later $ rewrite p (_, inP (V2, V2', DV2, EV2V2', idp), U=WW' *> pmap2 (∧) p2 p2')
 
-    \lemma closure-univ {S : PrecoverSpace X} {Y : PrecoverSpace} (AS : \Pi {C : Set (Set X)} -> isCauchy C -> Closure A C) (f : Y -> X) (Ap : ∀ {C : A} (isCauchy \lam U => ∃ (V : Set X) (C V) (U = f ^-1 V))) : CoverMap Y S f \cowith
+    \lemma closure-univ {S : PrecoverSpace X} {Y : PrecoverSpace} (AS : \Pi {C : Set (Set X)} -> isCauchy C -> Closure A C) (f : Y -> X) (Ap : ∀ {C : A} (isCauchy \lam U => ∃ (V : Set X) (C V) (U = f ^-1 V))) : PrecoverMap Y S f \cowith
       | func-cover Cc => closure-univ-cover Ap (AS Cc)
 
-    \lemma closure-embedding {S : PrecoverSpace X} {Y : PrecoverSpace} (AS : \Pi {C : Set (Set X)} -> isCauchy C -> Closure A C) (f : CoverMap S Y)
+    \lemma closure-univ-closure {Y : \Set} {B : Set (Set Y) -> \Prop} (f : Y -> X) (Ap : ∀ {C : A} (Closure B \lam V => ∃ (U : Set X) (C U) (V = f ^-1 U))) {C : Set (Set X)} (Cc : Closure A C) : Closure B \lam U => ∃ (V : Set X) (C V) (U = f ^-1 V) \elim Cc
+      | closure a => Ap a
+      | closure-top p => closure-subset (closure-top idp) \lam q => inP $ later (top, rewrite p idp, inv q)
+      | closure-refine Cc g => closure-refine (closure-univ-closure {X} {A} _ Ap Cc) \lam (inP (V,CV,q)) => TruncP.map (g CV) \lam (V',CV',V<=V') => (f ^-1 V', inP (V', CV', idp), rewrite q \lam c => V<=V' c)
+      | closure-trans {D} Cc {E} g p =>
+        \have t => closure-trans (closure-univ-closure {X} {A} _ Ap Cc) {\lam V V' => ∃ (U : Set X) (V = f ^-1 U) (D U) (U' : Set X) (E U U') (V' = f ^-1 U')}
+            (\lam (inP (V,DV,q)) => closure-subset (closure-univ-closure {X} {A} _ Ap (g DV)) \lam (inP (V',EVV',r)) => inP $ later (V, q, DV, V', EVV', r)) idp
+        \in closure-subset t \lam (inP (W, W', _, inP (V2,p2,DV2,V2',EV2V2',p2'), U=WW')) => inP $ later $ rewrite p (_, inP (V2, V2', DV2, EV2V2', idp), U=WW' *> pmap2 (∧) p2 p2')
+
+    \lemma closure-univ-closure-id {B : Set (Set X) -> \Prop} (Ap : ∀ {C : A} (Closure B C)) {C : Set (Set X)} (Cc : Closure A C) : Closure B C
+      => closure-subset (closure-univ-closure (\lam x => x) (\lam AC => closure-subset (Ap AC) \lam {U} CU => inP (U, CU, idp)) Cc) \lam {U} (inP (V,CV,p)) => rewrite p CV
+
+    \lemma closure-map {X Y : \Set} (f : Set X -> Set Y) (ft : \Pi {y : Y} -> f top y) (fm : \Pi {U V : Set X} -> U ⊆ V -> f U ⊆ f V) (fi : \Pi {U V : Set X} -> f U ∧ f V ⊆ f (U ∧ V)) {A : Set (Set X) -> \Prop} {C : Set (Set X)} {D : Set (Set Y)} (eCD : ∀ {U : C} ∃ (V : D) (f U ⊆ V)) (CC : Closure A C) : Closure (\lam D => ∃ (C : A) ∀ {U : C} ∃ (V : D) (f U ⊆ V)) D \elim CC
+      | closure AC => closure $ inP (C, AC, eCD)
+      | closure-top p => \case eCD (rewrite p idp) \with {
+        | inP (V,DV,RtV) => closure-refine (closure-top idp) \lam q => inP (V, DV, \lam _ => RtV ft)
+      }
+      | closure-refine {E} CE e => closure-refine (closure-map f ft fm fi (\lam EU => \case e EU \with {
+        | inP (V,CV,U<=V) => \case eCD CV \with {
+          | inP (W,DW,RVW) => inP (W, DW, fm U<=V <=∘ RVW)
+        }
+      }) CE) \lam {V} DV => inP (V, DV, <=-refl)
+      | closure-trans {C'} CC' {E} CE p =>
+        closure-refine (closure-trans (closure-map f ft fm fi {_} {_} {\lam V => ∃ (U : C') (f U = V)} (\lam {U} C'U => inP (f U, inP (U, C'U, idp), <=-refl)) CC') {\lam U V => ∃ (U' : C') (V' : E U') (f U' = U) (f V' = V)}
+            (\lam (inP (U',C'U',RU'U)) => closure-subset (closure-map f ft fm fi {_} {_} {\lam V => ∃ (U : E U') (f U = V)} (\lam {U} EU'U => inP (f U, inP (U, EU'U, idp), <=-refl)) (CE C'U')) \lam {V} (inP (V',EU'V',RV'V)) => inP (U', C'U', V', EU'V', RU'U, RV'V)) idp)
+            \lam {W} (inP (U, V, _, inP (U',C'U',V',EU'V',RU'U,RV'V), W=UV)) => \case eCD (rewrite p $ inP (U', V', C'U', EU'V', idp)) \with {
+              | inP (W',DW',r) => inP (W', DW', rewrite W=UV $ rewriteI (RU'U,RV'V) $ fi <=∘ r)
+            }
+
+    \lemma closure-embedding {S : PrecoverSpace X} {Y : PrecoverSpace} (AS : \Pi {C : Set (Set X)} -> isCauchy C -> Closure A C) (f : PrecoverMap S Y)
                              (p : \Pi {C : Set (Set X)} -> A C -> isCauchy \lam V => ∃ (U : C) (f ^-1 V ⊆ U)) : f.IsEmbedding
       => \lam CC => aux (AS CC)
       \where {
         \private \lemma aux {C : Set (Set X)} (CC : Closure A C) : isCauchy \lam V => ∃ (U : C) (f ^-1 V ⊆ U) \elim CC
           | closure AC => p AC
           | closure-top q => top-cauchy $ inP $ later (top, rewrite q idp, top-univ)
-          | closure-extends CD g => cauchy-subset (aux CD) \lam (inP (V,DV,q)) => TruncP.map (g DV) \lam (V',CV',V<=V') => later (V', CV', q <=∘ V<=V')
+          | closure-refine CD g => cauchy-subset (aux CD) \lam (inP (V,DV,q)) => TruncP.map (g DV) \lam (V',CV',V<=V') => later (V', CV', q <=∘ V<=V')
           | closure-trans {D} CD {E} g q =>
             \let t => cauchy-trans (aux CD) {\lam V V' => ∃ (U U' : Set X) (D U) (f ^-1 V ⊆ U) (f ^-1 V' ⊆ U') (E U U')} \lam (inP (U,DU,r)) => cauchy-subset (aux (g DU)) \lam (inP (U',EUU',r')) => inP $ later (U, U', DU, r, r', EUU')
             \in cauchy-subset t \lam (inP (V, W, _, inP (U1,U2,DU1,r,r',EU1U2), s)) => inP $ later (U1 ∧ U2, rewrite q $ inP (U1, U2, DU1, EU1U2, idp), rewrite s $ MeetSemilattice.meet-monotone r r')
@@ -350,7 +396,7 @@
   | <= A B => \Pi {C : Set (Set X)} -> isCauchy {A} C -> isCauchy {B} C
   | <=-refl c => c
   | <=-transitive f g c => g (f c)
-  | <=-antisymmetric f g => exts \lam C => ext (f,g)
+  | <=-antisymmetric f g => PrecoverSpace.PrecoverSpace-ext \lam {C} => (f,g)
   | top => DiscreteCover X
   | top-univ {A} c => cauchy-cover {A} c
   | Join {J} f => ClosurePrecoverSpace (\lam C => ∃ (j : J) (isCauchy {f j} C))
@@ -379,7 +425,7 @@
       : Closure A (\lam V => ∃ (U : C) (RB.R V U)) \elim CC
       | closure AC => AS AC
       | closure-top idp => closure-subset (closure-top idp) \lam p => inP (top, idp, <=<_top)
-      | closure-extends CD e => closure-subset (closure-regular RB AS CD) \lam (inP (U,DU,RVU)) => \case e DU \with {
+      | closure-refine CD e => closure-subset (closure-regular RB AS CD) \lam (inP (U,DU,RVU)) => \case e DU \with {
         | inP (W,CW,U<=W) => inP (W, CW, <=<-left RVU U<=W)
       }
       | closure-trans {D} CD {E} CE idp => closure-subset
@@ -390,7 +436,7 @@
     \lemma closure-pred {X : PrecoverSpace} (P : Set X -> \Prop) (Pt : P top) (Pm : ∀ {U V : P} (P (U ∧ V))) {A : Set (Set X) -> \Prop} (AP : ∀ {C : A} {U : C} (P U)) {C : Set (Set X)} (CC : Closure A C) : ∃ (D : Closure A) (∀ {V : D} (P V)) (∀ {V : D} ∃ (U : C) (V ⊆ U)) \elim CC
       | closure AC => inP (C, closure AC, AP AC __, \lam {V} CV => inP (V, CV, <=-refl))
       | closure-top idp => inP (single top, closure-top idp, \lam p => rewriteI p Pt, \lam _ => inP (top, idp, top-univ))
-      | closure-extends CD e => \case closure-pred P Pt Pm AP CD \with {
+      | closure-refine CD e => \case closure-pred P Pt Pm AP CD \with {
         | inP (D',AD',D'P,D'r) => inP (D', AD', D'P, \lam D'V => \case D'r D'V \with {
           | inP (U,DU,V<=U) => \case e DU \with {
             | inP (U',CU',U<=U') => inP (U', CU', V<=U <=∘ U<=U')
@@ -431,13 +477,13 @@
 \func UniformlyCoverSpace {X : PrecoverSpace} (AI : \Pi {C : Set (Set X)} -> X.isCauchy C -> ∃ (D : X.isCauchy) ∀ {V : D} ∃ (U : C) ∀ {V' : D} (Given (V ∧ V') -> V' ⊆ U)) : CompletelyRegularCoverSpace X \cowith
   | PrecoverSpace => X
   | isCompletelyRegular {C} => transport (\lam (S : PrecoverSpace X) => S.isCauchy C -> S.isCauchy \lam V => ∃ (U : C) (V RatherBelow.<=<c {RegularRatherBelow {S}} U))
-      (exts \lam U => ext (closure-cauchy \lam c => c, closure)) $ isCompletelyRegular {ClosureRegularCoverSpace X.isCauchy X.cauchy-cover AI}
+      (PrecoverSpace.PrecoverSpace-ext {_} {ClosureRegularCoverSpace X.isCauchy X.cauchy-cover AI} {X} \lam {C} => (closure-cauchy \lam c => c, closure)) $ isCompletelyRegular {ClosureRegularCoverSpace X.isCauchy X.cauchy-cover AI}
 
 \instance CoverLattice (X : \Set) : CompleteLattice (CoverSpace X)
   | <= A B => \Pi {C : Set (Set X)} -> isCauchy {A} C -> isCauchy {B} C
   | <=-refl c => c
   | <=-transitive f g c => g (f c)
-  | <=-antisymmetric f g => exts \lam C => ext (f,g)
+  | <=-antisymmetric f g => CoverSpace.CoverSpace-ext \lam {C} => (f,g)
   | top => DiscreteCover X
   | top-univ {A} c => cauchy-cover {A} c
   | Join f => \new CoverSpace {
@@ -462,92 +508,11 @@
 \func RegPrecoverSpace (X : PrecoverSpace) : CoverSpace X
   => CompleteLattice.SJoin {CoverLattice X} \lam A => A <= {PrecoverLattice X} X
 
-\func regPrecoverSpace {X : PrecoverSpace} : CoverMap X (RegPrecoverSpace X) \cowith
+\func regPrecoverSpace {X : PrecoverSpace} : PrecoverMap X (RegPrecoverSpace X) \cowith
   | func x => x
   | func-cover d => CompleteLattice.SJoin-univ {PrecoverLattice X} {\lam A => A <= {PrecoverLattice X} X} (\lam p => p) $
       transport (isCauchy {RegPrecoverSpace X}) (ext \lam U => ext (\lam DU => inP (U, DU, idp), \lam (inP (V,DV,U=V)) => rewrite U=V DV)) d
 
-\lemma regPrecoverSpace-extend {X : PrecoverSpace} {Y : CoverSpace} (f : CoverMap X Y) : CoverMap (RegPrecoverSpace X) Y f \cowith
+\lemma regPrecoverSpace-extend {X : PrecoverSpace} {Y : CoverSpace} (f : PrecoverMap X Y) : PrecoverMap (RegPrecoverSpace X) Y f \cowith
   | func-cover {D} Dc => CompleteLattice.SJoin-cond {CoverLattice X} {\lam A => A <= {PrecoverLattice X} X} {CoverTransfer f} PrecoverTransfer-char $
-      inP (D, Dc, \lam {V} DV => inP (f ^-1 V, inP (V, DV, idp), <=-refl))
-
-\instance PrecoverSpaceHasProduct : HasProduct PrecoverSpace
-  | Product => ProductPrecoverSpace
-
-\instance CoverSpaceHasProduct : HasProduct CoverSpace
-  | Product => ProductCoverSpace
-
-\open CoverMap
-
-\instance ProductPrecoverSpace (X Y : PrecoverSpace) : PrecoverSpace (\Sigma X Y)
-  => PrecoverTransfer __.1 ∨ PrecoverTransfer __.2
-  \where {
-    \func proj1 {X Y : PrecoverSpace} : CoverMap (X ⨯ Y) X \cowith
-      | func s => s.1
-      | func-cover Dc => join-left {PrecoverLattice (\Sigma X Y)} $ PrecoverTransfer-map.func-cover Dc
-
-    \func proj2 {X Y : PrecoverSpace} : CoverMap (X ⨯ Y) Y \cowith
-      | func s => s.2
-      | func-cover Dc => join-right {PrecoverLattice (\Sigma X Y)} $ PrecoverTransfer-map.func-cover Dc
-
-    \func tuple {X Y Z : PrecoverSpace} (f : CoverMap Z X) (g : CoverMap Z Y) : CoverMap Z (X ⨯ Y) \cowith
-      | func z => (f z, g z)
-      | func-cover => closure-univ-cover $ later \case __ \with {
-        | inP (true, inP (D,Dc,h)) => cauchy-extend (f.func-cover Dc) \lam (inP (V,DV,p)) => \case h DV \with {
-          | inP (U',CU',q) => inP (_, inP (U',CU',idp), \lam Ux => q $ rewrite p in Ux)
-        }
-        | inP (false, inP (D,Dc,h)) => cauchy-extend (g.func-cover Dc) \lam (inP (V,DV,p)) => \case h DV \with {
-          | inP (U',CU',q) => inP (_, inP (U',CU',idp), \lam Ux => q $ rewrite p in Ux)
-        }
-      }
-
-    \lemma prodCover {X Y : PrecoverSpace} {C : Set (Set X)} (Cc : X.isCauchy C) {D : Set (Set Y)} (Dc : Y.isCauchy D)
-      : isCauchy {ProductPrecoverSpace X Y} \lam W => ∃ (U : C) (V : D) (W = \lam s => \Sigma (U s.1) (V s.2))
-      => cauchy-subset {ProductPrecoverSpace X Y} (cauchy-inter {ProductPrecoverSpace X Y} (proj1.func-cover Cc) (proj2.func-cover Dc))
-          \lam (inP (U, V, inP (U',CU',p1), inP (V',DV',p2), q)) => inP $ later (U', CU', V', DV', q *> pmap2 (∧) p1 p2)
-
-    \func prod {X Y X' Y' : PrecoverSpace} (f : CoverMap X Y) (g : CoverMap X' Y') : CoverMap (X ⨯ X') (Y ⨯ Y')
-      => tuple (f ∘ proj1) (g ∘ proj2)
-      \where {
-        \lemma isDense {X X' : PrecoverSpace} {Y Y' : CoverSpace} {f : CoverMap X Y} {g : CoverMap X' Y'} (fd : f.IsDense) (gd : g.IsDense) : IsDense {prod f g}
-          => \lam {(y,y')} yy'<=<U =>
-              \have | (inP (V,yy'<=<V,V<=<U)) => <=<-inter yy'<=<U
-                    | (inP (x,Vfxy')) => fd {y} $ transport (`<=< _) (ext \lam z => ext (pmap __.1, \lam p => ext (p, idp))) $ <=<_^-1 {Y} {Y ⨯ Y'} {tuple id (const y')} yy'<=<V
-                    | (inP (x',Ufxfx')) => gd {y'} $ transport (`<=< _) (ext \lam z => ext (pmap __.2, \lam p => ext (idp, p))) $ <=<_^-1 {Y'} {Y ⨯ Y'} {tuple (const (f x)) id} $ <=<-right (single_<= Vfxy') V<=<U
-              \in inP ((x,x'), Ufxfx')
-
-        \lemma isEmbedding {X Y X' Y' : PrecoverSpace} {f : CoverMap X Y} {g : CoverMap X' Y'} (fe : f.IsEmbedding) (ge : g.IsEmbedding) : IsEmbedding {prod f g}
-          => closure-embedding (\lam c => c) (prod f g) \case __ \with {
-            | inP (true, inP (D,Dc,f)) => closure $ inP (true, inP (_, fe Dc, \lam (inP (U,DU,p)) => TruncP.map (f DU) \lam (W,CW,q) => (_, inP (W, CW, (\lam c => p c) <=∘ q), <=-refl)))
-            | inP (false, inP (D,Dc,f)) => closure $ inP (false, inP (_, ge Dc, \lam (inP (U,DU,p)) => TruncP.map (f DU) \lam (W,CW,q) => (_, inP (W, CW, (\lam c => p c) <=∘ q), <=-refl)))
-          }
-
-        \lemma isDenseEmbedding {X X' : PrecoverSpace} {Y Y' : CoverSpace} {f : CoverMap X Y} {g : CoverMap X' Y'} (fde : f.IsDenseEmbedding) (gde : g.IsDenseEmbedding) : IsDenseEmbedding {prod f g}
-          => (isDense fde.1 gde.1, isEmbedding fde.2 gde.2)
-      }
-  }
-
-\instance ProductCoverSpace (X Y : CoverSpace) : CoverSpace (\Sigma X Y)
-  => CoverTransfer __.1 ∨ CoverTransfer __.2
-  \where {
-    \lemma prod-neighborhood {x : X} {y : Y} {W : Set (X ⨯ Y)} (xy<=<W : single (x,y) <=< {X ⨯ Y} W) : ∃ (U : Set X) (V : Set Y) (single x <=< U) (single y <=< V) ∀ {x : U} {y : V} (W (x,y))
-      => \case closure-filter (\new SetFilter {
-                  | F W => ∃ (U : Set X) (V : Set Y) (single x <=< U) (single y <=< V) ∀ {x : U} {y : V} (W (x,y))
-                  | filter-mono p (inP (U,V,x<=<U,y<=<V,q)) => inP (U, V, x<=<U, y<=<V, \lam Ux Vy => p (q Ux Vy))
-                  | filter-top => inP (top, top, <=<_top, <=<_top, \lam _ _ => ())
-                  | filter-meet (inP (U,V,x<=<U,y<=<V,q)) (inP (U',V',x<=<U',y<=<V',q')) => inP (U ∧ U', V ∧ V', RatherBelow.<=<_meet-same x<=<U x<=<U', RatherBelow.<=<_meet-same y<=<V y<=<V', \lam (Ux,U'x) (Vy,V'y) => (q Ux Vy, q' U'x V'y))
-                }) (\case __ \with {
-                      | inP (true, inP (D,Dc,h)) => \case CoverSpace.cauchy-regular-cover Dc x \with {
-                        | inP (U,DU,x<=<U) => \case h DU \with {
-                          | inP (W,CW,p) => inP (W, CW, inP (U, top, x<=<U, <=<_top, \lam Ux _ => p Ux))
-                        }
-                      }
-                      | inP (false, inP (D,Dc,h)) => \case CoverSpace.cauchy-regular-cover Dc y \with {
-                        | inP (V,DV,y<=<V) => \case h DV \with {
-                          | inP (W,CW,p) => inP (W, CW, inP (top, V, <=<_top, y<=<V, \lam _ Vy => p Vy))
-                        }
-                      }
-      }) xy<=<W \with {
-        | inP (W, h, inP (U,V,x<=<U,y<=<V,q)) => inP (U, V, x<=<U, y<=<V, \lam Ux' Vy' => h ((x,y), (idp, q (<=<_<= x<=<U idp) (<=<_<= y<=<V idp))) (q Ux' Vy'))
-      }
-  }
+      inP (D, Dc, \lam {V} DV => inP (f ^-1 V, inP (V, DV, idp), <=-refl))
\ No newline at end of file
diff --git a/src/Topology/CoverSpace/Category.ard b/src/Topology/CoverSpace/Category.ard
index 15e19a8b..fa6d5ea2 100644
--- a/src/Topology/CoverSpace/Category.ard
+++ b/src/Topology/CoverSpace/Category.ard
@@ -1,32 +1,27 @@
 \import Category
 \import Category.Meta
-\import Category.Subcat
-\import Equiv (Embedding, Retraction)
 \import Logic
-\import Logic.Meta
 \import Paths
-\import Paths.Meta
-\import Set.Subset
 \import Topology.CoverSpace
 
 \instance PrecoverSpaceCat : Cat PrecoverSpace
-  | Hom => CoverMap
-  | id X => CoverMap.id
-  | o => CoverMap.∘
+  | Hom => PrecoverMap
+  | id X => PrecoverMap.id
+  | o => PrecoverMap.∘
   | id-left => idp
   | id-right => idp
   | o-assoc => idp
-  | univalence => sip \lam c d => exts \lam C => ext
+  | univalence => sip \lam c d => PrecoverSpace.PrecoverSpace-ext \lam {C} =>
       (\lam Cc => cauchy-subset (func-cover {d} Cc) \lam (inP (V,CV,p)) => transportInv C p CV,
        \lam Cc => cauchy-subset (func-cover {c} Cc) \lam (inP (V,CV,p)) => transportInv C p CV)
 
 \instance CoverSpaceCat : Cat CoverSpace
-  | Hom => CoverMap
-  | id X => CoverMap.id
-  | o => CoverMap.∘
+  | Hom => PrecoverMap
+  | id X => PrecoverMap.id
+  | o => PrecoverMap.∘
   | id-left => idp
   | id-right => idp
   | o-assoc => idp
-  | univalence => sip \lam c d => exts \lam C => ext
+  | univalence => sip \lam c d => CoverSpace.CoverSpace-ext \lam {C} =>
       (\lam Cc => cauchy-subset (func-cover {d} Cc) \lam (inP (V,CV,p)) => transportInv C p CV,
        \lam Cc => cauchy-subset (func-cover {c} Cc) \lam (inP (V,CV,p)) => transportInv C p CV)
\ No newline at end of file
diff --git a/src/Topology/CoverSpace/Complete.ard b/src/Topology/CoverSpace/Complete.ard
index 3bf139e2..14cb22c1 100644
--- a/src/Topology/CoverSpace/Complete.ard
+++ b/src/Topology/CoverSpace/Complete.ard
@@ -1,11 +1,9 @@
-\import Data.Bool
 \import Function
 \import Function.Meta
 \import HLevel
 \import Logic
 \import Logic.Meta
 \import Meta
-\import Operations
 \import Order.Lattice
 \import Order.PartialOrder
 \import Paths
@@ -15,14 +13,59 @@
 \import Set.Subset
 \import Topology.CoverSpace
 \import Topology.RatherBelow
-\open Set
+\import Topology.TopSpace
 \open Bounded(top)
-\open ProductPrecoverSpace
 
 \record CauchyFilter (S : CoverSpace) \extends ProperFilter
   | X => S
   | isCauchyFilter {C : Set (Set S)} : isCauchy C -> ∃ (U : C) (F U)
 
+\record CauchyMap \extends ContMap {
+  \override Dom : CoverSpace
+  \override Cod : CoverSpace
+
+  | func-cauchy (F : CauchyFilter Dom) : CauchyFilter Cod { | ProperFilter => ProperFilter-map func F }
+
+  \default func-cont Uo => cauchy-open.2 \lam {x} Ufx => \case isCauchyFilter {func-cauchy (pointCF x)} $ cauchy-open.1 Uo Ufx \with {
+    | inP (V,h,fx<=<V) => cauchy-subset (unfolds in fx<=<V) $ later \lam {W} g Wx {y} Wy => h (<=<_<= fx<=<V idp) $ g (x, (idp, Wx)) Wy
+  }
+} \where {
+  \lemma fromContMap {X : CompleteCoverSpace} {Y : CoverSpace} (f : ContMap X Y) : CauchyMap X Y f \cowith
+    | func-cauchy F => \new CauchyFilter {
+      | isCauchyFilter Cc => \case Y.cauchy-regular-cover Cc (f $ X.filter-point F) \with {
+        | inP (U,CU,fx<=<U) => inP (U, CU, X.filter-point-sub $ <=<-cont fx<=<U)
+      }
+    }
+}
+
+\record CoverMap \extends PrecoverMap, CauchyMap {
+  \override Dom : CoverSpace
+  \override Cod : CoverSpace
+
+  | func-cauchy F => \new CauchyFilter {
+    | isCauchyFilter Cc => \case isCauchyFilter {F} (func-cover Cc) \with {
+      | inP (U, inP (V, CV, p), FU) => inP (V, CV, transport F p FU)
+    }
+  }
+
+  \lemma embedding->contEmbedding (e : IsEmbedding) : ContMap.IsEmbedding
+    => ContMap.embedding-char.2 \lam Uo {x} Ux => \case CoverSpace.cauchy-regular-cover (e $ cauchy-open.1 Uo Ux) (func x) \with {
+      | inP (V, inP (W,h,p), fx<=<V) => inP (_, CoverSpace.interior {_} {V}, fx<=<V, \lam {y} fy<=<V => h (p $ <=<_<= fx<=<V idp) (p $ <=<_<= fy<=<V idp))
+    }
+} \where {
+  \func id {X : CoverSpace} : CoverMap X X \cowith
+    | PrecoverMap => PrecoverMap.id
+
+  \func compose \alias \infixl 8 ∘ {X Y Z : CoverSpace} (g : CoverMap Y Z) (f : CoverMap X Y) : CoverMap X Z \cowith
+    | PrecoverMap => g PrecoverMap.∘ f
+
+  \func const {Y X : CoverSpace} (x : X) : CoverMap Y X \cowith
+    | PrecoverMap => PrecoverMap.const x
+
+  \lemma closure-univ {X : \Set} {A : Set (Set X) -> \Prop} {S : CoverSpace X} {Y : CoverSpace} (AS : \Pi {C : Set (Set X)} -> isCauchy C -> ClosurePrecoverSpace.Closure A C) (f : Y -> X) (Ap : ∀ {C : A} (isCauchy \lam U => ∃ (V : Set X) (C V) (U = f ^-1 V))) : CoverMap Y S f \cowith
+    | func-cover Cc => ClosurePrecoverSpace.closure-univ-cover Ap (AS Cc)
+}
+
 \instance CauchyFilterPoset (S : CoverSpace) : Poset (CauchyFilter S)
   | <= F G => F ⊆ G
   | <=-refl c => c
@@ -63,22 +106,30 @@
   }
   | ~-symmetric => CF~-sym
 
-\record MinCauchyFilter \extends CauchyFilter
-  | isMinFilter {G : CauchyFilter S} : G ⊆ F -> F ⊆ G
+\record RegularCauchyFilter \extends CauchyFilter
+  | isRegularFilter {U : Set S} : F U -> ∃ (V : Set S) (V <=< U) (F V)
   \where {
-    \lemma Min_CF~_<= {S : CoverSpace} {F : MinCauchyFilter S} {G : CauchyFilter S} (p : F CF~ G) : F ⊆ G
-      => F.isMinFilter {CF~_meet p} meet-left <=∘ meet-right
+    \lemma Reg_CF~_<= {X : CoverSpace} {F : RegularCauchyFilter X} {G : CauchyFilter X} (p : F CF~ G) : F ⊆ G
+      => \case isRegularFilter __ \with {
+        | inP (V,V<=<U,FV) => CF~_<=< p V<=<U FV
+      }
 
-    \lemma equiv {S : CoverSpace} {F G : MinCauchyFilter S} (p : F CF~ G) (U : Set S) : F U = G U
-      => ext (Min_CF~_<= p {_}, Min_CF~_<= (CF~-sym p) {_})
+    \lemma equality {X : CoverSpace} {F G : RegularCauchyFilter X} (p : F CF~ G) : F = G
+      => exts \lam U => ext (Reg_CF~_<= p, Reg_CF~_<= (CF~-sym p))
 
-    \lemma equality {S : CoverSpace} {F G : MinCauchyFilter S} (p : F CF~ G) : F = G
-      => exts (equiv p)
+    \lemma ratherBelow {X : CoverSpace} (R : Set X -> Set X -> \Prop) (Rl : \Pi {U V W : Set X} -> R U V -> V ⊆ W -> R U W) (Rs : \Pi {U V : Set X} -> R V U -> V ⊆ U) (Xr : ∀ {C : isCauchy} (isCauchy \lam V => ∃ (U : C) (R V U))) (F : RegularCauchyFilter X) {U : Set X} (FU : F U) : ∃ (V : Set X) (R V U) (F V)
+      => \case isRegularFilter FU \with {
+        | inP (V,V<=<U,FV) => \case F.isCauchyFilter $ Xr V<=<U \with {
+          | inP (W', inP (W,h,RW'W), FW') => \case isProper (filter-meet FV FW') \with {
+            | inP (y,(Vy,W'y)) => inP (W', Rl RW'W \lam Wx => h (y, (Vy, Rs RW'W W'y)) Wx, FW')
+          }
+        }
+      }
   }
 
--- | The unique minimal Cauchy filter equivalent to the given one.
-\func minCF {S : CoverSpace} (F : CauchyFilter S) : MinCauchyFilter S \cowith
-  | F U => \Pi {G : CauchyFilter S} -> G ⊆ F -> G U
+-- | The unique regular Cauchy filter equivalent to the given one.
+\func regCF {X : CoverSpace} (F : CauchyFilter X) : RegularCauchyFilter X \cowith
+  | F U => \Pi {G : CauchyFilter X} -> G ⊆ F -> G U
   | filter-mono p q c => filter-mono p (q c)
   | filter-top _ => filter-top
   | filter-meet p q c => filter-meet (p c) (q c)
@@ -86,39 +137,25 @@
   | isCauchyFilter c => \case F.isCauchyFilter (isRegular c) \with {
     | inP (U, inP (V, CV, U<=<V), FU) => inP (V, CV, \lam p => CF~_<=< (CF~-sym $ CF~_<= p) U<=<V FU)
   }
-  | isMinFilter p q => q \lam GU => p GU \lam c => c
+  | isRegularFilter c =>
+    \case c {\new CauchyFilter {
+                   | F U => ∃ (V W : Set X) (W <=< V) (V <=< U) (F W)
+                   | filter-mono p (inP (V,W,W<=<V,V<=<U,FW)) => inP (V, W, W<=<V, <=<-left V<=<U p, FW)
+                   | filter-top => inP (top, top, <=<_top, <=<_top, filter-top)
+                   | filter-meet (inP (V,W,W<=<V,V<=<U,FW)) (inP (V',W',W'<=<V',V'<=<U',FW')) => inP (V ∧ V', W ∧ W', <=<_meet W<=<V W'<=<V', <=<_meet V<=<U V'<=<U', filter-meet FW FW')
+                   | isProper (inP (V,W,W<=<V,V<=<U,FW)) => TruncP.map (isProper FW) \lam (x,Wx) => (x, <=<_<= V<=<U (<=<_<= W<=<V Wx))
+                   | isCauchyFilter Cc => \case F.isCauchyFilter $ isRegular $ isRegular Cc \with {
+                     | inP (W, inP (V, inP (U, CU, V<=<U), W<=<V), FW) => inP (U, CU, inP (V, W, W<=<V, V<=<U, FW))
+                   }
+                 }} (\lam {U} (inP (V,W,W<=<V,V<=<U,FW)) => filter-mono (<=<_<= W<=<V <=∘ <=<_<= V<=<U) FW) \with {
+      | inP (V,W,W<=<V,V<=<U,FW) => inP (V, V<=<U, \lam p => CF~_<=< (CF~-sym $ CF~_<= p) W<=<V FW)
+    }
 
-\lemma minCF_<= {S : CoverSpace} {F : CauchyFilter S} : minCF F ⊆ F
+\lemma regCF_<= {S : CoverSpace} {F : CauchyFilter S} : regCF F ⊆ F
   => \lam u => u <=-refl
 
-\record RegularCauchyFilter \extends MinCauchyFilter
-  | isRegularFilter {U : Set S} : F U -> ∃ (V : Set S) (V <=< U) (F V)
-  | isMinFilter {G} p FU => \case isRegularFilter FU \with {
-    | inP (V,V<=<U,FV) => CF~_<=< {_} {_} {G} (CF~-sym {_} {G} $ CF~_<= {S} p) V<=<U FV
-  }
-  \where {
-    \lemma equality {S : CoverSpace} {F G : RegularCauchyFilter S} (p : F CF~ G) : F = G
-      => exts (MinCauchyFilter.equiv p)
-  }
-
 \open RatherBelow
 
-\func regCF {S : OmegaRegularCoverSpace} (F : CauchyFilter S) : RegularCauchyFilter S \cowith
-  | F U => ∃ (V : F.F) (V <=<o U)
-  | filter-mono U<=V (inP (W,FW,W<=<oU)) => inP (W, FW, RatherBelow.Omega.<=<-left W<=<oU U<=V)
-  | filter-top => inP (top, filter-top, RatherBelow.Omega.<=<_top)
-  | filter-meet (inP (W,FW,W<=<oU)) (inP (W',FW',W'<=<oV)) => inP (W ∧ W', filter-meet FW FW', RegularRatherBelow.Omega.<=<_meet W<=<oU W'<=<oV)
-  | isProper (inP (V,FV,V<=<oU)) => TruncP.map (isProper FV) \lam (x,Vx) => (x, <=<_<= (<=<o_<=< V<=<oU) Vx)
-  | isCauchyFilter Cc => \case F.isCauchyFilter (isOmegaRegular Cc) \with {
-    | inP (U, inP (V, CV, U<=<oV), FU) => inP (V, CV, inP (U, FU, U<=<oV))
-  }
-  | isRegularFilter (inP (V,FV,V<=<oU)) => \case <=<o-inter V<=<oU \with {
-    | inP (W,V<=<oW,W<=<U) => inP (W, W<=<U, inP (V, FV, V<=<oW))
-  }
-
-\lemma regCF_<= {S : OmegaRegularCoverSpace} {F : CauchyFilter S} : regCF F ⊆ F
-  => \lam (inP (V,FV,V<=<oU)) => filter-mono (<=<_<= (<=<o_<=< V<=<oU)) FV
-
 \func pointCF {S : CoverSpace} (x : S) : RegularCauchyFilter S \cowith
   | F U => single x <=< U
   | filter-mono p q => <=<-left q p
@@ -130,8 +167,9 @@
     | inP (V, inP (W, f, V<=<W), x<=<V) => inP (V, <=<-left V<=<W $ f (x, (idp, <=<_<= V<=<W $ <=<_<= x<=<V idp)), x<=<V)
   }
 
-\class SeparatedCoverSpace \extends CoverSpace
+\class SeparatedCoverSpace \extends CoverSpace, HausdorffTopSpace
   | isSeparatedCoverSpace {x y : E} : (\Pi {C : Set (Set E)} -> isCauchy C -> ∃ (U : C) (\Sigma (U x) (U y))) -> x = y
+  | isHausdorff p => isSeparatedCoverSpace (separated-char 6 7 p)
   \where {
     \lemma separated-char {S : CoverSpace} {x y : S} : TFAE (
     {- 0 -} pointCF x ⊆ pointCF y,
@@ -140,58 +178,45 @@
     {- 3 -} \Pi {U : Set S} -> single x <=< U <-> single y <=< U,
     {- 4 -} \Pi {U : Set S} -> single x <=< U -> U y,
     {- 5 -} \Pi {U V : Set S} -> single x <=< U -> single y <=< V -> ∃ (U ∧ V),
-    {- 6 -} \Pi {C : Set (Set S)} -> isCauchy C -> ∃ (U : C) (\Sigma (U x) (U y))
+    {- 6 -} ∀ {U V : isOpen} (U x) (V y) ∃ (U ∧ V),
+    {- 7 -} \Pi {C : Set (Set S)} -> isCauchy C -> ∃ (U : C) (\Sigma (U x) (U y))
     ) => TFAE.cycle (
       CF~_<= {S},
       RegularCauchyFilter.equality {S},
-      \lam p {U} => <->_= $ path \lam i => RegularCauchyFilter.F {p i} U,
+      \lam p {U} => <->_=.2 $ path \lam i => RegularCauchyFilter.F {p i} U,
       \lam f p => <=<_<= (f.1 p) idp,
       \lam f p q => inP (y, (f p, <=<_<= q idp)),
-      \lam f Cc =>
-        \have | (inP (U, inP (W, CW, U<=<W), x<=<U)) => cauchy-regular-cover (isRegular Cc) x
-              | (inP (V, g, y<=<V)) => cauchy-regular-cover (unfolds in U<=<W) y
-              | (inP s) => f x<=<U y<=<V
-        \in inP (W, CW, (<=<_<= U<=<W $ <=<_<= x<=<U idp, g s $ <=<_<= y<=<V idp)),
+      \lam f Uo Vo Ux Vy => f (open-char.1 Uo Ux) (open-char.1 Vo Vy),
+      \lam f Cc => \have | (inP (_, inP (U', inP (U,CU,U'<=<U), idp), x<=<U')) => cauchy-cover (cauchy-open-cover $ isRegular Cc) x
+                         | (inP (_, inP (V,h,idp), y<=<V)) => cauchy-cover (cauchy-open-cover (unfolds in U'<=<U)) y
+                         | (inP (x',(x'<=<U,x'<=<V))) => f interior interior x<=<U' y<=<V
+                   \in inP (U, CU, (<=<_<= U'<=<U (<=<_<= x<=<U' idp), h (x', (<=<_<= x'<=<U idp, <=<_<= x'<=<V idp)) (<=<_<= y<=<V idp))),
       \lam f {U} p => \case f (isRegular p) \with {
         | inP (V, inP (W,g,V<=<W), (Vx,Vy)) => <=<-left (<=<-right (single_<= Vy) V<=<W) $ g (x, (idp, <=<_<= V<=<W Vx))
       })
   }
 
-\instance ProductSeparatedCoverSpace (X Y : SeparatedCoverSpace) : SeparatedCoverSpace (\Sigma X Y)
-  | CoverSpace => ProductCoverSpace X Y
-  | isSeparatedCoverSpace p => ext (
-      isSeparatedCoverSpace \lam Cc => \case p (proj1.func-cover Cc) \with {
-        | inP (U, inP (V,CV,q), s) => inP (V, CV, rewrite q in s)
-      }, isSeparatedCoverSpace \lam Cc => \case p (proj2.func-cover Cc) \with {
-        | inP (U, inP (V,CV,q), s) => inP (V, CV, rewrite q in s)
-      })
-
-\lemma embedding-inj {X : SeparatedCoverSpace} {Y : PrecoverSpace} {f : CoverMap X Y} (fe : f.IsEmbedding) : isInj f
+\lemma embedding-inj {X : SeparatedCoverSpace} {Y : PrecoverSpace} {f : PrecoverMap X Y} (fe : f.IsEmbedding) : isInj f
   => \lam {x} {y} p => isSeparatedCoverSpace \lam Cc => \case cauchy-cover (fe Cc) (f y) \with {
     | inP (V, inP (U,CU,q), Vfy) => inP (U, CU, (q $ unfolds $ rewrite p Vfy, q Vfy))
   }
 
-\lemma dense-lift-unique {X Y : PrecoverSpace} {Z : SeparatedCoverSpace} (f : CoverMap X Y) (fd : f.IsDense) (g h : CoverMap Y Z) (p : \Pi (x : X) -> g (f x) = h (f x)) (y : Y) : g y = h y
-  => isSeparatedCoverSpace $ SeparatedCoverSpace.separated-char 5 6 \lam gy<=<U hy<=<V => \case fd (<=<-right (\lam q => later $ rewrite q (idp,idp)) $ <=<_meet (<=<_^-1 gy<=<U) (<=<_^-1 hy<=<V)) \with {
-    | inP (x,(Ugfx,Vhfx)) => inP (g (f x), (Ugfx, rewrite p Vhfx))
-  }
-
-\func IsCompleteCoverSpace (S : CoverSpace) => \Pi (F : MinCauchyFilter S) -> ∃ (x : S) (pointCF x ⊆ F)
+\func IsCompleteCoverSpace (S : CoverSpace) => \Pi (F : RegularCauchyFilter S) -> ∃ (x : S) (pointCF x ⊆ F)
   \where {
     \lemma cauchyFilterToPoint (Sc : IsCompleteCoverSpace S) (F : CauchyFilter S) : ∃ (x : S) (pointCF x ⊆ F)
-      => \case Sc (minCF F) \with {
-        | inP (x,p) => inP (x, p <=∘ minCF_<=)
+      => \case Sc (regCF F) \with {
+        | inP (x,p) => inP (x, p <=∘ regCF_<=)
       }
   }
 
 \class CompleteCoverSpace \extends SeparatedCoverSpace {
-  | isCompleteCoverSpace : IsCompleteCoverSpace \this
+  | isComplete : IsCompleteCoverSpace \this
 
   \protected \lemma filter-point-unique (F : CauchyFilter \this) : isProp (\Sigma (x : E) (pointCF x ⊆ F))
-    => \lam s t => ext $ isSeparatedCoverSpace $ SeparatedCoverSpace.separated-char 1 6 $ ~-transitive {_} {_} {F} (CF~_<= {_} {_} {F} s.2) $ ~-symmetric (CF~_<= {_} {pointCF t.1} t.2)
+    => \lam s t => ext $ isSeparatedCoverSpace $ SeparatedCoverSpace.separated-char 1 7 $ ~-transitive {_} {_} {F} (CF~_<= {_} {_} {F} s.2) $ ~-symmetric (CF~_<= {_} {pointCF t.1} t.2)
 
   \protected \lemma filter-point-pair (F : CauchyFilter \this) : \Sigma (x : E) (pointCF x ⊆ F) \level filter-point-unique F
-    => \case isCompleteCoverSpace (minCF F) \with {
+    => \case isComplete (regCF F) \with {
       | inP (x,p) => (x, p <=∘ \lam u => u <=-refl)
     }
 
@@ -210,17 +235,7 @@
         }, \lam (inP (V,p,FV)) => filter-point-elem p FV)
 }
 
-\func CF-map {X Y : CoverSpace} (f : CoverMap X Y) (F : CauchyFilter X) : CauchyFilter Y \cowith
-  | F V => F (f ^-1 V)
-  | filter-mono p d => filter-mono (p __) d
-  | filter-top => filter-top
-  | filter-meet => filter-meet
-  | isProper d => TruncP.map (isProper d) \lam s => (f s.1, s.2)
-  | isCauchyFilter Cc => \case F.isCauchyFilter (f.func-cover Cc) \with {
-    | inP (U, inP (V,CV,p), FU) => inP (V, CV, rewriteI p FU)
-  }
-
-\lemma CF-map_<= {X Y : CoverSpace} {f : CoverMap X Y} (F G : CauchyFilter X) (p : F ⊆ G) : CF-map f F ⊆ CF-map f G
+\lemma func-cauchy_<= {X Y : CoverSpace} {f : CoverMap X Y} (F G : CauchyFilter X) (p : F ⊆ G) : f.func-cauchy F ⊆ f.func-cauchy G
   => p __
 
 \func dense-filter-lift {X Y : CoverSpace} (f : CoverMap X Y) (fd : f.IsDenseEmbedding) (F : CauchyFilter Y) : CauchyFilter X \cowith
@@ -229,7 +244,7 @@
   | filter-top => inP (top, top, \lam _ => (), <=<_top, filter-top)
   | filter-meet (inP (U',U,p,U'<=<U,FU')) (inP (V',V,q,V'<=<V,FV')) => inP (U' ∧ V', U ∧ V, MeetSemilattice.meet-monotone p q, <=<_meet U'<=<U V'<=<V, filter-meet FU' FV')
   | isProper (inP (V',V,p,V'<=<V,FV')) => \case F.isProper FV' \with {
-    | inP (y,V'y) => \case fd.1 (<=<-right (single_<= V'y) V'<=<V) \with {
+    | inP (y,V'y) => \case dense-char.1 fd.1 (<=<-right (single_<= V'y) V'<=<V) \with {
       | inP (x,Vfx) => inP (x, p Vfx)
     }
   }
@@ -237,21 +252,31 @@
     | inP (V', inP (V, inP (U, CU, p), V'<=<V), FV') => inP (U, CU, inP (V', V, p, V'<=<V, FV'))
   }
   \where {
-    \lemma map-equiv (fd : f.IsDenseEmbedding) : CF-map f (dense-filter-lift f fd F) CF~ F
+    \lemma map-equiv (fd : f.IsDenseEmbedding) : f.func-cauchy (dense-filter-lift f fd F) CF~ F
       => \lam {C} Cc => \case isCauchyFilter (isRegular Cc) \with {
         | inP (V', inP (V, CV, V'<=<V), FV') => inP (V, CV, (inP (V', V, <=-refl, V'<=<V, FV'), filter-mono (<=<_<= V'<=<V) FV'))
       }
   }
 
+\func dense-cauchy-lift {X Y : CoverSpace} {Z : CompleteCoverSpace} (f : CoverMap X Y) (fd : f.IsDenseEmbedding) (g : CauchyMap X Z) : CauchyMap Y Z \cowith
+  | func y => Z.filter-point $ g.func-cauchy $ dense-filter-lift f fd (pointCF y)
+  | func-cauchy F => \new CauchyFilter {
+    | isCauchyFilter Cc => \case isCauchyFilter {g.func-cauchy $ dense-filter-lift f fd F} (isRegular Cc) \with {
+      | inP (U', inP (U,CU,U'<=<U), inP (V',V,p,V'<=<V,FV')) => inP (U, CU, filter-mono (\lam {y} V'y => <=<_<= (CompleteCoverSpace.filter-point-elem U'<=<U \case <=<-inter $ <=<-right (single_<= V'y) V'<=<V \with {
+        | inP (V'',y<=<V'',V''<=<V) => inP $ later (V'', V, p, V''<=<V, y<=<V'')
+      }) idp) FV')
+    }
+  }
+
 \func dense-lift {X Y : CoverSpace} {Z : CompleteCoverSpace} (f : CoverMap X Y) (fd : f.IsDenseEmbedding) (g : CoverMap X Z) : CoverMap Y Z \cowith
-  | func y => Z.filter-point $ CF-map g $ dense-filter-lift f fd (pointCF y)
-  | func-cover Dc => cauchy-extend (isRegular $ fd.2 $ g.func-cover $ isRegular Dc) \lam {V'} (inP (V, inP (U, inP (W', inP (W, DW, W'<=<W), p), q), V'<=<V)) =>
+  | CauchyMap => dense-cauchy-lift f fd g
+  | func-cover Dc => cauchy-refine (isRegular $ fd.2 $ g.func-cover $ isRegular Dc) \lam {V'} (inP (V, inP (U, inP (W', inP (W, DW, W'<=<W), p), q), V'<=<V)) =>
                       inP (_, inP (W, DW, idp), \lam {y} V'y => <=<_<= (Z.filter-point-elem W'<=<W \case <=<-inter (<=<-right (single_<= V'y) V'<=<V) \with {
                         | inP (V'',y<=<V'',V''<=<V) => inP $ later (V'', V, rewrite p in q, V''<=<V, y<=<V'')
                       }) idp)
 
 \lemma dense-lift-char {X Y : CoverSpace} {Z : CompleteCoverSpace} {f : CoverMap X Y} {fd : f.IsDenseEmbedding} {g : CoverMap X Z} (x : X) : dense-lift f fd g (f x) = g x
-  => isSeparatedCoverSpace $ SeparatedCoverSpace.separated-char 4 6 $ later \case CompleteCoverSpace.filter-point-sub __ \with {
+  => isSeparatedCoverSpace $ SeparatedCoverSpace.separated-char 4 7 $ later \case CompleteCoverSpace.filter-point-sub __ \with {
     | inP (V',V,p,V'<=<V,fx<=<V') => p $ <=<_<= V'<=<V $ <=<_<= fx<=<V' idp
   }
 
@@ -262,50 +287,45 @@
                                              | inP (V',y<=<V',V'<=<V) => inP (W', W'<=<W, inP (V', V, p, V'<=<V, y<=<V'))
                                            })
 
-\lemma dense-complete {X Y : CoverSpace} {f : CoverMap X Y} (fd : f.IsDenseEmbedding) (p : \Pi (F : MinCauchyFilter X) -> ∃ (y : Y) (pointCF y ⊆ CF-map f F)) : IsCompleteCoverSpace Y
-  => \lam F => \case p $ minCF $ dense-filter-lift f fd F \with {
-    | inP (y,q) => inP (y, MinCauchyFilter.Min_CF~_<= {_} {pointCF y} $ ~-transitive {_} {pointCF y} (CF~_<= {_} {pointCF y} $ q <=∘ CF-map_<= (minCF $ dense-filter-lift f fd F) (dense-filter-lift f fd F) \lam u => u <=-refl) $ dense-filter-lift.map-equiv fd)
+\lemma dense-complete {X Y : CoverSpace} {f : CoverMap X Y} (fd : f.IsDenseEmbedding) (p : \Pi (F : RegularCauchyFilter X) -> ∃ (y : Y) (pointCF y ⊆ f.func-cauchy F)) : IsCompleteCoverSpace Y
+  => \lam F => \case p $ regCF $ dense-filter-lift f fd F \with {
+    | inP (y,q) => inP (y, RegularCauchyFilter.Reg_CF~_<= {_} {pointCF y} $ ~-transitive {_} {pointCF y} (CF~_<= {_} {pointCF y} $ q <=∘ func-cauchy_<= (regCF $ dense-filter-lift f fd F) (dense-filter-lift f fd F) \lam u => u <=-refl) $ dense-filter-lift.map-equiv fd)
   }
 
-\lemma dense-regular-complete {X : OmegaRegularCoverSpace} {Y : CoverSpace} {f : CoverMap X Y} (fd : f.IsDenseEmbedding) (p : \Pi (F : RegularCauchyFilter X) -> ∃ (y : Y) (pointCF y ⊆ CF-map f F)) : IsCompleteCoverSpace Y
-  => dense-complete fd \lam F => \case p (regCF F) \with {
-    | inP (y,q) => inP (y, q <=∘ CF-map_<= (regCF F) F regCF_<=)
-  }
-
-\instance Completion (S : CoverSpace) : CompleteCoverSpace (MinCauchyFilter S)
+\instance Completion (S : CoverSpace) : CompleteCoverSpace (RegularCauchyFilter S)
   | CoverSpace => coverSpace
-  | isSeparatedCoverSpace p => MinCauchyFilter.equality \lam Cc => \case p (mkCover Cc) \with {
+  | isSeparatedCoverSpace p => RegularCauchyFilter.equality \lam Cc => \case p (mkCover Cc) \with {
     | inP (_, inP (U,CU,idp), r) => inP (U,CU,r)
   }
-  | isCompleteCoverSpace => dense-complete completion.isDenseEmbedding \lam F => inP (F, completion.dense-aux {_} {F} __)
+  | isComplete => dense-complete completion.isDenseEmbedding \lam F => inP (F, completion.dense-aux {_} {F} __)
   \where {
-    \func mkSet (U : Set S) : Set (MinCauchyFilter S)
+    \func mkSet (U : Set S) : Set (RegularCauchyFilter S)
       => \lam F => F U
 
     \lemma mkSet_<= {U V : Set S} (p : U ⊆ V) : mkSet U ⊆ mkSet V
       => \lam {F} => filter-mono p
 
-    \func isCCauchy (D : Set (Set (MinCauchyFilter S)))
-      => ∃ (C : Set (Set S)) (S.isCauchy C) (\Pi {U : Set S} -> C U -> ∃ (V : D) (mkSet U ⊆ V))
+    \func isCCauchy (D : Set (Set (RegularCauchyFilter S)))
+      => ∃ (C : S.isCauchy) (∀ {U : C} ∃ (V : D) (mkSet U ⊆ V))
 
     \lemma mkCover {C : Set (Set S)} (Cc : isCauchy C) : isCCauchy \lam V => ∃ (U : C) (V = mkSet U)
       => inP (C, Cc, \lam {U} CU => inP (mkSet U, inP (U,CU,idp), <=-refl))
 
-    \func coverSpace : CoverSpace (MinCauchyFilter S) \cowith
+    \func coverSpace : CoverSpace (RegularCauchyFilter S) \cowith
       | isCauchy => isCCauchy
       | cauchy-cover {D} (inP (C,Cc,p)) F =>
         \have | (inP (U,CU,FU)) => isCauchyFilter Cc
               | (inP (V,DV,q)) => p CU
         \in inP (V, DV, q FU)
       | cauchy-top => inP (single top, cauchy-top, \lam _ => inP (top, idp, \lam _ => ()))
-      | cauchy-extend (inP (E,Ec,g)) f => inP (E, Ec, \lam EU =>
+      | cauchy-refine (inP (E,Ec,g)) f => inP (E, Ec, \lam EU =>
           \have | (inP (V,CV,p)) => g EU
                 | (inP (W,DW,q)) => f CV
           \in inP (W, DW, p <=∘ q))
       | cauchy-trans {C} (inP (C',C'c,f)) {D} Dc => inP (_, cauchy-trans C'c {\lam U' V' => ∃ (U : C) (V : D U) (mkSet U' ⊆ U) (mkSet V' ⊆ V)} \lam {U'} C'U' =>
           \have | (inP (U,CU,U'<=U)) => f C'U'
                 | (inP (D',D'c,g)) => Dc CU
-          \in cauchy-extend D'c \lam {V'} D'V' => \case g D'V' \with {
+          \in cauchy-refine D'c \lam {V'} D'V' => \case g D'V' \with {
             | inP (V,DV,V'<=V) => inP (V', inP (U, CU, V, DV, U'<=U, V'<=V), <=-refl)
           }, \lam {W'} (inP (U', V', C'U', inP (U, CU, V, DV, U'<=U, V'<=V), W'=U'V')) => inP (U ∧ V, inP (U, V, CU, DV, idp), rewrite W'=U'V' \lam {F} FU'V' => (U'<=U $ filter-mono meet-left FU'V', V'<=V $ filter-mono meet-right FU'V')))
       | isRegular {D} (inP (C,Cc,f)) =>
@@ -320,76 +340,51 @@
 
 \func completion {S : CoverSpace} : CoverMap S Completion.coverSpace \cowith
   | func => pointCF
-  | func-cover (inP (C,Cc,f)) => cauchy-extend (isRegular Cc)
+  | func-cover (inP (C,Cc,f)) => cauchy-refine (isRegular Cc)
       \case __ \with {
         | inP (U',CU',U<=<U') => \case f CU' \with {
           | inP (V,DV,p) => inP (pointCF ^-1 V, inP (V, DV, idp), \lam Ux => p $ <=<-right (single_<= Ux) U<=<U')
         }
       }
   \where {
-    \protected \lemma dense-aux {F : MinCauchyFilter S} {V : Set (MinCauchyFilter S)} (r : single F <=< {Completion.coverSpace} V) : F \lam x => V (completion x) \elim r
+    \protected \lemma dense-aux {F : RegularCauchyFilter S} {V : Set (RegularCauchyFilter S)} (r : single F <=< {Completion.coverSpace} V) : F \lam x => V (completion x) \elim r
       | inP (C,Cc,f) =>
         \have | (inP (U', inP (U, CU, U'<=<U), FU')) => isCauchyFilter {F} (isRegular Cc)
               | (inP (W,g,U<=W)) => f CU
         \in filter-mono (\lam U'x => g (F, (idp, U<=W $ filter-mono (<=<_<= U'<=<U) FU')) $ U<=W $ <=<-right (single_<= U'x) U'<=<U) FU'
 
     \lemma isDenseEmbedding : completion.IsDenseEmbedding
-      => (\lam r => isProper (dense-aux r), \lam {C} Cc => inP (C, Cc, \lam {U} CU => inP (Completion.mkSet U, inP (U, CU, <=<_<= __ idp), <=-refl)))
+      => (dense-char.2 \lam r => isProper (dense-aux r), \lam {C} Cc => inP (C, Cc, \lam {U} CU => inP (Completion.mkSet U, inP (U, CU, <=<_<= __ idp), <=-refl)))
   }
 
-\func completion-lift {X : CoverSpace} {Z : CompleteCoverSpace} (g : CoverMap X Z) : CoverMap (Completion X) Z
+\func completion-lift {X : CoverSpace} {Z : CompleteCoverSpace} (g : CoverMap X Z) : PrecoverMap (Completion X) Z
   => dense-lift completion completion.isDenseEmbedding g
 
 \lemma completion-lift-char {X : CoverSpace} {Z : CompleteCoverSpace} {g : CoverMap X Z} (x : X) : completion-lift g (pointCF x) = g x
   => dense-lift-char {_} {_} {_} {completion} {completion.isDenseEmbedding} x
 
-\lemma completion-lift-unique {X : CoverSpace} {Z : SeparatedCoverSpace} (g h : CoverMap (Completion X) Z) (p : \Pi (x : X) -> g (pointCF x) = h (pointCF x)) (y : Completion X) : g y = h y
+\lemma completion-lift-unique {X : CoverSpace} {Z : SeparatedCoverSpace} (g h : PrecoverMap (Completion X) Z) (p : \Pi (x : X) -> g (pointCF x) = h (pointCF x)) (y : Completion X) : g y = h y
   => dense-lift-unique completion completion.isDenseEmbedding.1 g h p y
 
 \lemma complete-char {X : CoverSpace} : TFAE (
     {- 0 -} CompleteCoverSpace { | CoverSpace => X },
-    {- 1 -} ∃ (g : CoverMap (Completion X) X) (\Pi (x : X) -> g (pointCF x) = x),
-    {- 2 -} ∃ (g : CoverMap (Completion X) X) (\Pi (x : X) -> g (pointCF x) = x) (\Pi (y : Completion X) -> pointCF (g y) = y)
+    {- 1 -} ∃ (g : PrecoverMap (Completion X) X) (\Pi (x : X) -> g (pointCF x) = x),
+    {- 2 -} ∃ (g : PrecoverMap (Completion X) X) (\Pi (x : X) -> g (pointCF x) = x) (\Pi (y : Completion X) -> pointCF (g y) = y)
   ) => TFAE.cycle (
     \lam c => inP (completion-lift {_} {c} CoverMap.id, completion-lift-char),
-    TruncP.map __ \lam (g,p) => (g, p, completion-lift-unique (completion CoverMap.∘ g) CoverMap.id \lam x => pmap pointCF (p x)),
+    TruncP.map __ \lam (g,p) => (g, p, completion-lift-unique (completion PrecoverMap.∘ g) PrecoverMap.id \lam x => pmap pointCF (p x)),
     \lam (inP (g,p,q)) => \new CompleteCoverSpace {
-      | isSeparatedCoverSpace {x} {y} c => inv (p x) *> pmap g (SeparatedCoverSpace.separated-char 6 2 c) *> p y
-      | isCompleteCoverSpace F => inP (g F, transportInv {MinCauchyFilter X} (`⊆ F) (q F) <=-refl)
+      | isSeparatedCoverSpace {x} {y} c => inv (p x) *> pmap g (SeparatedCoverSpace.separated-char 7 2 c) *> p y
+      | isComplete F => inP (g F, transportInv {RegularCauchyFilter X} (`⊆ F) (q F) <=-refl)
     })
 
-\instance ProductCompleteCoverSpace (X Y : CompleteCoverSpace) : CompleteCoverSpace (\Sigma X Y)
-  => complete-char 1 0 $ inP (tuple (completion-lift proj1) (completion-lift proj2),
-                              \lam s => ext (completion-lift-char s, completion-lift-char s))
-
-\func prodCF {X Y : CoverSpace} (F : CauchyFilter X) (G : CauchyFilter Y) : CauchyFilter (X ⨯ Y) \cowith
-  | F W => ∃ (U : Set X) (F U) (V : Set Y) (G V) ∀ {x : U} {y : V} (W (x,y))
-  | filter-mono p (inP (U,FU,V,GV,f)) => inP (U, FU, V, GV, \lam Ux Vy => p $ f Ux Vy)
-  | filter-top => inP (top, filter-top, top, filter-top, \lam _ _ => ())
-  | filter-meet (inP (U,FU,V,GV,f)) (inP (U',FU',V',GV',f')) => inP (U ∧ U', filter-meet FU FU', V ∧ V', filter-meet GV GV', \lam (Ux,U'x) (Vy,V'y) => (f Ux Vy, f' U'x V'y))
-  | isProper (inP (U,FU,V,GV,f)) => \case isProper FU, isProper GV \with {
-    | inP (x,Ux), inP (y,Vy) => inP ((x,y), f Ux Vy)
-  }
-  | isCauchyFilter => ClosurePrecoverSpace.closure-filter \this $ later \case __ \with {
-    | inP (true, inP (D,Dc,f)) => \case F.isCauchyFilter Dc \with {
-      | inP (V,DV,FV) => \case f DV \with {
-        | inP (U,CU,q) => inP (U, CU, inP (V, FV, top, filter-top, \lam Vx _ => q Vx))
-      }
-    }
-    | inP (false, inP (D,Dc,f)) => \case G.isCauchyFilter Dc \with {
-      | inP (V,DV,GV) => \case f DV \with {
-        | inP (U,CU,q) => inP (U, CU, inP (top, filter-top, V, GV, \lam _ Vy => q Vy))
-      }
-    }
-  }
-
 \lemma Separated-char (X : CoverSpace) : TFAE (
     {- 0 -} SeparatedCoverSpace { | CoverSpace => X },
-    {- 1 -} \Pi {Y : PrecoverSpace} {f : CoverMap X Y} -> f.IsEmbedding -> isInj f,
+    {- 1 -} \Pi {Y : PrecoverSpace} {f : PrecoverMap X Y} -> f.IsEmbedding -> isInj f,
     {- 2 -} isInj (completion {X}),
-    {- 3 -} ∃ (Y : SeparatedCoverSpace) (f : CoverMap X Y) (isInj f)
+    {- 3 -} ∃ (Y : SeparatedCoverSpace) (f : PrecoverMap X Y) (isInj f)
   ) => TFAE.cycle (
-    \lam Xs {_} {f} fe {x} {x'} fx=fx' => isSeparatedCoverSpace {Xs} $ SeparatedCoverSpace.separated-char 4 6 \lam x<=<U => \case cauchy-cover (fe x<=<U) (f x) \with {
+    \lam Xs {_} {f} fe {x} {x'} fx=fx' => isSeparatedCoverSpace {Xs} $ SeparatedCoverSpace.separated-char 4 7 \lam x<=<U => \case cauchy-cover (fe x<=<U) (f x) \with {
       | inP (V, inP (W,h,p), Vfx) => h (x, (idp, p Vfx)) (p $ rewrite fx=fx' in Vfx)
     },
     \lam c => c completion.isDenseEmbedding.2,
diff --git a/src/Topology/CoverSpace/Convergence.ard b/src/Topology/CoverSpace/Convergence.ard
index e4f5fa1f..c6afdbdd 100644
--- a/src/Topology/CoverSpace/Convergence.ard
+++ b/src/Topology/CoverSpace/Convergence.ard
@@ -15,6 +15,7 @@
 \import Set.Subset
 \import Topology.CoverSpace
 \import Topology.CoverSpace.Complete
+\import Topology.CoverSpace.Product
 \open Bounded(top)
 \open Set
 
@@ -27,7 +28,7 @@
           | inr N<=n => inP (U, CU, f N<=n)
         }
         | cauchy-top => inP (top, idp, 0, \lam _ => (), \case __)
-        | cauchy-extend (inP (U,CU,N,f,g)) e => \case e CU \with {
+        | cauchy-refine (inP (U,CU,N,f,g)) e => \case e CU \with {
           | inP (V,DV,U<=V) => inP (V, DV, N, \lam N<=n => U<=V $ f N<=n, \lam n<N => \case g n<N \with {
             | inP (U',CU',U'n) => \case e CU' \with {
               | inP (V',DV',U'<=V') => inP (V', DV', U'<=V' U'n)
@@ -77,7 +78,7 @@
 }
 
 \func IsConvergent {X : PrecoverSpace} (f : Nat -> X) : \Prop
-  => CoverMap NatCoverSpace X f
+  => PrecoverMap NatCoverSpace X f
 
 \lemma convergent-char {X : PrecoverSpace} {f : Nat -> X} (p : ∀ {C : X.isCauchy} ∃ (U : C) (N : Nat) ∀ {n} (N <= n -> U (f n))) : IsConvergent f \cowith
   | func-cover Dc => \case p Dc \with {
@@ -92,41 +93,41 @@
       }
 
 \func seqLimit {X : CompleteCoverSpace} (f : CoverMap NatCoverSpace X) : X
-  => X.filter-point $ CF-map f NatCoverSpace.atTop
+  => X.filter-point $ f.func-cauchy NatCoverSpace.atTop
 
 \func IsUniFuncConvergent {X : \Set} {Y : PrecoverSpace} (f : Nat -> X -> Y) : \Prop
   => ∀ {D : Y.isCauchy} ∃ (V : D) (N : Nat) ∀ {n} {x} (N <= n -> V (f n x))
 
-\func IsFuncConvergent {X Y : PrecoverSpace} (f : Nat -> X -> Y) : \Prop
+\func IsFuncConvergent {X Y : CoverSpace} (f : Nat -> X -> Y) : \Prop
   => CoverMap (NatCoverSpace ⨯ X) Y \lam s => f s.1 s.2
 
-\lemma funcCovergent-cover {X Y : PrecoverSpace} (f : Nat -> CoverMap X Y)
+\lemma funcCovergent-cover {X Y : CoverSpace} (f : Nat -> PrecoverMap X Y)
                            (fc : ∀ {D : Y.isCauchy} (X.isCauchy \lam U => ∃ (N : Nat) (V : D) ∀ {n} {x} (N <= n -> U x -> V (f n x))))
   : IsFuncConvergent (\lam n => f n)
   => generalized (f __) \lam Dc => cauchy-subset (fc Dc) \lam (inP (N,V,DV,h)) => inP $ later (N, V, DV, h, \lam {n} _ => func-cover {f n} Dc)
   \where
     -- | A slightly more general version of the lemma
-    \lemma generalized {X Y : PrecoverSpace} (f : Nat -> X -> Y) (fc : ∀ {D : Y.isCauchy} (X.isCauchy \lam U => ∃ (N : Nat) (V : D) (\Pi {n : Nat} {x : X} -> N <= n -> U x -> V (f n x)) (\Pi {n : Nat} -> n < N -> X.isCauchy \lam U => ∃ (V : D) (U = f n ^-1 V)))) : IsFuncConvergent f \cowith
+    \lemma generalized {X Y : CoverSpace} (f : Nat -> X -> Y) (fc : ∀ {D : Y.isCauchy} (X.isCauchy \lam U => ∃ (N : Nat) (V : D) (\Pi {n : Nat} {x : X} -> N <= n -> U x -> V (f n x)) (\Pi {n : Nat} -> n < N -> X.isCauchy \lam U => ∃ (V : D) (U = f n ^-1 V)))) : IsFuncConvergent f \cowith
       | func-cover {D} Dc =>
-        \have t => cauchy-trans {ProductPrecoverSpace NatCoverSpace X} (ProductPrecoverSpace.prodCover cauchy-top (fc Dc))
+        \have t => cauchy-trans {ProductCoverSpace NatCoverSpace X} (ProductCoverSpace.prodCover cauchy-top (fc Dc))
                     {\lam U V => ∃ (U' : Set X) (N : Nat) (W : D) (\Pi {n : Nat} {x : X} -> N <= n -> U' x -> W (f n x)) (\Pi {n : Nat} -> n < N -> X.isCauchy \lam U => ∃ (V : D) (U = f n ^-1 V)) (U = (\lam s => s.2) ^-1 U') ((V = (\lam s => s.1) ^-1 (N <=)) || Given (n : Nat) (n < N) (V' : D) ∀ {s : V} (V' (f s.1 s.2)))}
                     \lam {W} => \case __ \with {
-                      | inP (_, idp, V, inP (N,V',DV',g,h), p) => cauchy-extend {ProductPrecoverSpace NatCoverSpace X} (ProductPrecoverSpace.prodCover (later $ NatCoverSpace.makeCover N) $ cauchy-array-inter \new Array _ N \lam j => later (_, h $ fin_< j)) \lam {W'} => later \case __ \with {
+                      | inP (_, idp, V, inP (N,V',DV',g,h), p) => cauchy-refine {ProductCoverSpace NatCoverSpace X} (ProductCoverSpace.prodCover (later $ NatCoverSpace.makeCover N) $ cauchy-array-inter \new Array _ N \lam j => later (_, h $ fin_< j)) \lam {W'} => later \case __ \with {
                         | inP (U1, byLeft q, V1, inP (Us,Ush,Usp), q1) => inP (_, inP (V, N, V', DV', g, h, p *> ext \lam s => ext (__.2, \lam c => ((),c)), byLeft idp), rewrite (q1,q) __.1)
                         | inP (U1, byRight (n,n<N,q), V1, inP (Us,Ush,Usp), q1) => \case Ush (toFin n n<N) \with {
                           | inP (V'',DV'',p'') => inP (W', inP (V, N, V', DV', g, h, p *> ext \lam s => ext (__.2, \lam c => ((),c)), byRight (n, n<N, V'', DV'', rewrite (q1,q,Usp) \lam (c,d) => rewriteI c $ rewrite (p'',toFin=id) in MeetSemilattice.Big_meet-cond {_} {_} {top :: Us} {suc (toFin n n<N)} d)), <=-refl)
                         }
                       }
                     }
-        \in cauchy-extend {ProductPrecoverSpace NatCoverSpace X} t \lam {W} => hiding t \case __ \with {
+        \in cauchy-refine {ProductCoverSpace NatCoverSpace X} t \lam {W} => hiding t \case __ \with {
               | inP (U, V, _, inP (U', N, V', DV', g, h, q1, byLeft q2), p) => inP (_, inP (V',DV',idp), rewrite (p,q1,q2) \lam (c,d) => g d c)
               | inP (U, V, _, inP (U', N, _, _, g, h, q1, byRight (n,n<N,V',DV',q2)), p) => inP (_, inP (V', DV', idp), rewrite (p,q1) \lam s => q2 s.2)
             }
 
-\lemma funcCovergent-uni {X Y : PrecoverSpace} (f : Nat -> CoverMap X Y) (fc : IsUniFuncConvergent \lam n => f n) : IsFuncConvergent \lam n => f n
+\lemma funcCovergent-uni {X Y : CoverSpace} (f : Nat -> PrecoverMap X Y) (fc : IsUniFuncConvergent \lam n => f n) : IsFuncConvergent \lam n => f n
   => funcCovergent-cover f \lam Dc => \case fc Dc \with {
     | inP (V,DV,N,h) => top-cauchy $ inP $ later (N, V, DV, \lam p _ => h p)
   }
 
 \func seqFuncLimit {X : CoverSpace} {Y : CompleteCoverSpace} (f : Nat -> X -> Y) (fc : IsFuncConvergent f) (x : X) : Y
-  => Y.filter-point $ CF-map fc $ prodCF NatCoverSpace.atTop (pointCF x)
\ No newline at end of file
+  => Y.filter-point $ fc.func-cauchy $ prodCF NatCoverSpace.atTop (pointCF x)
\ No newline at end of file
diff --git a/src/Topology/CoverSpace/Locale.ard b/src/Topology/CoverSpace/Locale.ard
index 316a3322..920c790c 100644
--- a/src/Topology/CoverSpace/Locale.ard
+++ b/src/Topology/CoverSpace/Locale.ard
@@ -55,7 +55,7 @@
       | cover-basic (byLeft (p,C,Cc,h)) => cauchy-subset Cc \case h __ \with {
         | inP r => byRight r
       }
-      | cover-basic (byRight (byLeft h)) => cauchy-extend (isStronglyRegular U'<=<U) \lam {V'} (inP (V, e, V'<=<V)) => \case \elim e \with {
+      | cover-basic (byRight (byLeft h)) => cauchy-refine (isStronglyRegular U'<=<U) \lam {V'} (inP (V, e, V'<=<V)) => \case \elim e \with {
         | byLeft p => inP (_, byLeft idp, rewrite p in s<=<_<= V'<=<V)
         | byRight p => inP (V', \case h (rewrite p in V'<=<V) \with {
           | inP s => byRight s
@@ -74,13 +74,13 @@
               | inP (W, byLeft e, W'<=<W) => top-cauchy $ byLeft $ rewrite e in W'<=<W
               | inP (W, byRight (i,fi=W), W'<=<W) => cauchy-subset (cover-char (d i) (rewrite (inv fi=W) in W'<=<W)) \lam e => byRight $ later (i, rewrite fi=W W'<=<W, e)
             }
-        \in cauchy-extend t \case __ \with {
+        \in cauchy-refine t \case __ \with {
           | inP (V, W, inP (U, byLeft e, V<=<U), _, Z=VW) => inP (_, byLeft idp, rewrite Z=VW $ meet-left <=∘ s<=<_<= V<=<U <=∘ Preorder.=_<= e)
           | inP (V, W, inP (U, _, V<=<U), byLeft e2, Z=VW) => inP (_, byLeft idp, rewrite Z=VW $ meet-left <=∘ s<=<_<= e2)
           | inP (V, W, inP (U, _, V<=<U), byRight (i, V<=<fi, byLeft e), Z=VW) => inP (_, byLeft idp, rewrite (Z=VW,e) \lam (Vx,nVx) => absurd $ nVx Vx)
           | inP (V, W, inP (U, _, V<=<U), byRight (i, V<=<fi, byRight (j,gj=W)), Z=VW) => inP (_, byRight (j,idp), rewrite (Z=VW,gj=W) meet-right)
         }
-      | cover-proj1 {U1} {U2} p j q => cauchy-extend U'<=<U \lam {V} => \case __ \with {
+      | cover-proj1 {U1} {U2} p j q => cauchy-refine U'<=<U \lam {V} => \case __ \with {
         | byLeft r => inP (V, byLeft r, <=-refl)
         | byRight r => inP (U1, byRight (j,q), rewrite (r *> p) meet-left)
       }
@@ -95,7 +95,7 @@
       | cover-ldistr {W} p c q =>
         \have | t1 => cover-char c (<=<-left U'<=<U $ later $ rewrite p meet-right)
               | t2 : U' s<=< W => <=<-left U'<=<U $ later $ rewrite p meet-left
-        \in cauchy-extend (cauchy-inter t1 t2) \case __ \with {
+        \in cauchy-refine (cauchy-inter t1 t2) \case __ \with {
           | inP (V1, V2, byLeft e1, _, r) => inP (_, byLeft idp, rewrite (r,e1) meet-left)
           | inP (V1, V2, _, byLeft e2, r) => inP (_, byLeft idp, rewrite (r,e2) meet-right)
           | inP (_, _, byRight (j,idp), byRight idp, r) => inP (_, byRight (j, idp), rewrite (r, q j) $ Preorder.=_<= MeetSemilattice.meet-comm)
@@ -137,7 +137,7 @@
     }
   }
   | cauchy-top => Join-cond (later (top,top-univ)) <=∘ Join-cond (later (top, idp))
-  | cauchy-extend p e => p <=∘ Join-univ \lam (U,CU) => \case e CU \with {
+  | cauchy-refine p e => p <=∘ Join-univ \lam (U,CU) => \case e CU \with {
     | inP (V,DV,U<=V) => points_*-mono U<=V <=∘ Join-cond (later (V,DV))
   }
   | cauchy-trans p e => p <=∘ Join-univ \lam (U,CU) => meet-univ <=-refl top-univ <=∘ MeetSemilattice.meet-monotone <=-refl (e CU) <=∘
@@ -172,7 +172,7 @@
 
 \func LocaleCoverSpaceFunctor : Functor LocaleCat PrecoverSpaceCat \cowith
   | F => LocalePrecoverSpace
-  | Func f => \new CoverMap {
+  | Func f => \new PrecoverMap {
     | func => PointsSpaceFunctor.Func f
     | func-cover c => func-top>= <=∘ func-<= {f} c <=∘ func-Join>= <=∘ Join-univ \lam (V,DV) => func-Join>= <=∘ Join-univ \lam (b,p) => points^*-points_* (\lam c => later $ p $ later c) <=∘ Join-cond (later (_, inP (V, DV, idp)))
   }
@@ -186,7 +186,7 @@
             MeetSemilattice.meet-monotone <=-refl (func-top>= <=∘ g.func-<= s.2 <=∘ g.func-join>=) <=∘
             ldistr>= <=∘ join-univ (hasDensePoints-char.1 Ld (\lam {x} c => CompleteFilter.isProper $
             filter-mono (func-meet>= <=∘ func-<= Locale.eval <=∘ g.func-bottom>=) $ filter-meet (filter-mono meet-right c)
-              (propExt.dir (pmap {CoverMap _ _} (__ x s.1) p) $ filter-mono meet-left c)) <=∘ bottom-univ) meet-right
+              (propExt.dir (pmap {PrecoverMap _ _} (__ x s.1) p) $ filter-mono meet-left c)) <=∘ bottom-univ) meet-right
        \in \lam p => exts \lam a => <=-antisymmetric (r p) $ r $ inv p)
       \lam f => inP (frameHom f, exts \lam (x : CompleteFilter) => exts \lam a => ext (\case filter-Join __ \with {
         | inP ((b,b<=<a),r) => \case filter-Join r \with {
@@ -207,7 +207,7 @@
         }
       }))
   \where {
-    \protected \func frameHom (f : CoverMap (LocalePrecoverSpace L) (LocalePrecoverSpace M)) : FrameHom M L \cowith
+    \protected \func frameHom (f : PrecoverMap (LocalePrecoverSpace L) (LocalePrecoverSpace M)) : FrameHom M L \cowith
       | func a => Join \lam (s : \Sigma (b : M) (b M.<=< a)) => points_* $ f ^-1 points^* s.1
       | func-<= p => Join-univ \lam (b,b<=<x) => Join-cond $ later (b, <=<-left b<=<x p)
       | func-top>= => Join-cond (later (top, \lam _ => filter-top)) <=∘ Join-cond (later (top, <=<_top))
@@ -221,9 +221,9 @@
           }
   }
 
-\func CoverSpaceLocale-unit {X : StronglyRegularCoverSpace} (Xo : X.HasWeaklyDensePoints) : CoverMap X (LocaleCoverSpace {CoverSpaceLocale X} CoverSpaceLocale.regular) \cowith
+\func CoverSpaceLocale-unit {X : StronglyRegularCoverSpace} (Xo : X.HasWeaklyDensePoints) : PrecoverMap X (LocaleCoverSpace {CoverSpaceLocale X} CoverSpaceLocale.regular) \cowith
   | func x => framePres-point (\lam U => single x <=< U) (inP (top, <=<_top)) (\lam {a} {b} => (\lam p => (<=<-left p meet-left, <=<-left p meet-right), \lam (p,q) => <=<_meet-same p q)) (\lam b x<=<U => CoverSpaceLocale.cover-point-char (cover-basic b) x<=<U)
-  | func-cover Dc => Xo $ cauchy-extend (isRegular $ CoverSpaceLocale.cover-char (Dc ()) <=<_top) \lam {V} => \case __ \with {
+  | func-cover Dc => Xo $ cauchy-refine (isRegular $ CoverSpaceLocale.cover-char (Dc ()) <=<_top) \lam {V} => \case __ \with {
     | inP (_, byLeft idp, V<=<U) => inP (bottom, byLeft idp, <=<_<= V<=<U <=∘ \lam t => absurd $ t ())
     | inP (U, byRight (((W,DW),_,q),idp), V<=<U) => inP (_, byRight $ inP (W, DW, idp), \lam Ux => \case CoverSpaceLocale.cover-point-char q $ <=<-right (single_<= Ux) V<=<U \with {
       | inP (((W,p),U'',WU''),x<=<U'') => p $ inP $ later (U'', WU'', x<=<U'')
@@ -232,8 +232,8 @@
   \where {
     \open PresentedFrame
 
-    \lemma isDense (Xd : X.HasDensePoints) : CoverMap.IsDense {CoverSpaceLocale-unit $ X.hasDensePoints_hasWeaklyDensePoints Xd}
-      => \lam {y} {U} y<=<U => \case filter-Join {y} {_} {\lam s => points_* s.1} $ filter-mono {y} (<=<_single.1 y<=<U) filter-top \with {
+    \lemma isDense (Xd : X.HasDensePoints) : PrecoverMap.IsDense {CoverSpaceLocale-unit $ X.hasDensePoints_hasWeaklyDensePoints Xd}
+      => dense-char.2 $ later \lam {y} {U} y<=<U => \case filter-Join {y} {_} {\lam s => points_* s.1} $ filter-mono {y} (<=<_single.1 y<=<U) filter-top \with {
         | inP ((W,h),yW) => \case filter-Join yW \with {
           | inP ((V,p),yV) => \case filter-Join {y} {_} {\lam s => embed s.1} $ transport y element_join yV \with {
             | inP ((V',VV'),yV') => \case filter-Join {y} {_} {\lam _ => embed V'} $ filter-mono {y} {embed V'} {Join {CoverSpaceLocale X} {\Sigma (x : X) (single x <=< V')} \lam _ => embed V'} (embed<= $ cover-trans (CoverSpaceLocale.cover-reg-inh Xd) \lam s => cover-inj (V', later $ cover-inj (s, V', cover-inj () idp) idp) idp) yV' \with {
@@ -243,27 +243,27 @@
         }
       }
 
-    \lemma isEmbedding (Xd : X.HasWeaklyDensePoints) : CoverMap.IsEmbedding {CoverSpaceLocale-unit Xd}
+    \lemma isEmbedding (Xd : X.HasWeaklyDensePoints) : PrecoverMap.IsEmbedding {CoverSpaceLocale-unit Xd}
       => \lam {C} Cc _ => Cover.cover-trans1 (Cover.cover_<= top-univ) $ cover-trans (CoverSpaceLocale.cover-cauchy Cc)
           \lam (U,CU) => cover-inj ((points^* $ embed U, inP (U, CU, \lam (inP (V,V<=U,x<=<V)) => \case CoverSpaceLocale.cover-point-char V<=U x<=<V \with {
             | inP (_,x<=<U) => <=<_<= x<=<U idp
           })), _, cover-inj ((embed U, <=-refl), _, cover-inj () idp) idp) idp
 
-    \lemma isDenseEmbedding (Xd : X.HasDensePoints) : CoverMap.IsDenseEmbedding {CoverSpaceLocale-unit $ X.hasDensePoints_hasWeaklyDensePoints Xd}
+    \lemma isDenseEmbedding (Xd : X.HasDensePoints) : PrecoverMap.IsDenseEmbedding {CoverSpaceLocale-unit $ X.hasDensePoints_hasWeaklyDensePoints Xd}
       => (isDense Xd, isEmbedding (X.hasDensePoints_hasWeaklyDensePoints Xd))
   }
 
 \func LocaleCompleteCoverSpace {L : Locale} (Lr : L.isRegular) : CompleteCoverSpace \cowith
   | CoverSpace => LocaleCoverSpace Lr
   | isSeparatedCoverSpace {x} {y} sh => exts \lam a =>
-      \have | sh1 => separated-char {\this} 6 4 sh
-            | sh2 => separated-char 2 4 $ inv $ separated-char {\this} 6 2 sh
+      \have | sh1 => separated-char {\this} 7 4 sh
+            | sh2 => separated-char 2 4 $ inv $ separated-char {\this} 7 2 sh
       \in ext (\lam xa => \case filter-Join $ filter-mono (Lr a) xa \with {
         | inP ((b,b<=<a),xb) => sh1 $ <=<-right (\lam q => rewriteI q xb) $ s<=<_<=< $ points_<=< b<=<a
       }, \lam ya => \case filter-Join $ filter-mono (Lr a) ya \with {
         | inP ((b,b<=<a),xb) => sh2 $ <=<-right (\lam q => rewriteI q xb) $ s<=<_<=< $ points_<=< b<=<a
       })
-  | isCompleteCoverSpace F => inP (makeFilter F, \lam {V} F<=<V => \case single_<=<-char F<=<V \with {
+  | isComplete F => inP (makeFilter F, \lam {V} F<=<V => \case single_<=<-char F<=<V \with {
     | inP (a, inP (b,b<=<a,p), q) => filter-mono q $ filter-mono (points^*-mono $ Topology.Locale.<=<_<= b<=<a) p
   })
   \where {
diff --git a/src/Topology/CoverSpace/Product.ard b/src/Topology/CoverSpace/Product.ard
new file mode 100644
index 00000000..a9454b4a
--- /dev/null
+++ b/src/Topology/CoverSpace/Product.ard
@@ -0,0 +1,153 @@
+\import Data.Bool
+\import Function.Meta
+\import Logic
+\import Logic.Meta
+\import Meta
+\import Operations
+\import Order.Lattice
+\import Order.PartialOrder
+\import Paths
+\import Paths.Meta
+\import Set.Filter
+\import Set.Subset
+\import Topology.CoverSpace
+\import Topology.CoverSpace.Complete
+\import Topology.RatherBelow
+\import Topology.TopSpace
+\import Topology.TopSpace.Product
+\open Bounded(top)
+\open CoverMap
+\open ClosurePrecoverSpace \hiding (closure-univ)
+\open ProductCoverSpace
+
+\instance CoverSpaceHasProduct : HasProduct CoverSpace
+  | Product => ProductCoverSpace
+
+\instance ProductCoverSpace (X Y : CoverSpace) : CoverSpace (\Sigma X Y)
+  | TopSpace => ProductTopSpace X Y
+  | isCauchy => isCauchy {Prod X Y}
+  | cauchy-cover => cauchy-cover {Prod X Y}
+  | cauchy-top => cauchy-top {Prod X Y}
+  | cauchy-refine => cauchy-refine {Prod X Y}
+  | cauchy-trans => cauchy-trans {Prod X Y}
+  | isRegular Cc => closure-subset (isRegular {Prod X Y} Cc) \lam {V} (inP (U,CU,V<=<U)) => inP (U, CU, unfolds V<=<U)
+  | cauchy-open => (\lam f {s} Ss => \case f Ss \with {
+    | inP (U,Uo,Ux,V,Vo,Vy,h) => closure-subset (prodCover' (cauchy-open.1 Uo Ux) (cauchy-open.1 Vo Vy)) \lam {W} (inP (U',cU',V',cV',p)) => rewrite p \lam (U's,V's) {(x,y)} (U'x,V'y) => h (cU' U's U'x) (cV' V's V'y)
+  }, \lam f Ss => \case prod-neighborhood' (PrecoverSpace.open-char.1 (later f) Ss) \with {
+    | inP (U,V,x<=<U,y<=<V,h) => inP (_, X.interior {U}, x<=<U, _, Y.interior {V}, y<=<V, \lam c d => h (<=<_<= c idp) (<=<_<= d idp))
+  })
+  \where {
+    \private \meta Prod X Y => CoverTransfer {_} {X} __.1 ∨ CoverTransfer {_} {Y} __.2
+
+    \private \func proj1' {X Y : CoverSpace} : CoverMap (Prod X Y) X \cowith
+      | func s => s.1
+      | func-cover Dc => join-left {CoverLattice (\Sigma X Y)} $ PrecoverTransfer-map.func-cover Dc
+
+    \private \func proj2' {X Y : CoverSpace} : CoverMap (Prod X Y) Y \cowith
+      | func s => s.2
+      | func-cover Dc => join-right {CoverLattice (\Sigma X Y)} $ PrecoverTransfer-map.func-cover Dc
+
+    \private \lemma prodCover' {X Y : CoverSpace} {C : Set (Set X)} (Cc : X.isCauchy C) {D : Set (Set Y)} (Dc : Y.isCauchy D)
+      : isCauchy {Prod X Y} \lam W => ∃ (U : C) (V : D) (W = \lam s => \Sigma (U s.1) (V s.2))
+      => cauchy-subset {Prod X Y} (cauchy-inter {Prod X Y} (proj1'.func-cover Cc) (proj2'.func-cover Dc))
+          \lam (inP (U, V, inP (U',CU',p1), inP (V',DV',p2), q)) => inP $ later (U', CU', V', DV', q *> pmap2 (∧) p1 p2)
+
+    \private \lemma prod-neighborhood' {X Y : CoverSpace} {x : X} {y : Y} {W : Set (\Sigma X Y)} (xy<=<W : single (x,y) <=< {Prod X Y} W) : ∃ (U : Set X) (V : Set Y) (single x <=< U) (single y <=< V) ∀ {x : U} {y : V} (W (x,y))
+      => \case closure-filter (\new SetFilter {
+                  | F W => ∃ (U : Set X) (V : Set Y) (single x <=< U) (single y <=< V) ∀ {x : U} {y : V} (W (x,y))
+                  | filter-mono p (inP (U,V,x<=<U,y<=<V,q)) => inP (U, V, x<=<U, y<=<V, \lam Ux Vy => p (q Ux Vy))
+                  | filter-top => inP (top, top, <=<_top, <=<_top, \lam _ _ => ())
+                  | filter-meet (inP (U,V,x<=<U,y<=<V,q)) (inP (U',V',x<=<U',y<=<V',q')) => inP (U ∧ U', V ∧ V', RatherBelow.<=<_meet-same x<=<U x<=<U', RatherBelow.<=<_meet-same y<=<V y<=<V', \lam (Ux,U'x) (Vy,V'y) => (q Ux Vy, q' U'x V'y))
+                }) (\case __ \with {
+                      | inP (true, inP (D,Dc,h)) => \case CoverSpace.cauchy-regular-cover Dc x \with {
+                        | inP (U,DU,x<=<U) => \case h DU \with {
+                          | inP (W,CW,p) => inP (W, CW, inP (U, top, x<=<U, <=<_top, \lam Ux _ => p Ux))
+                        }
+                      }
+                      | inP (false, inP (D,Dc,h)) => \case CoverSpace.cauchy-regular-cover Dc y \with {
+                        | inP (V,DV,y<=<V) => \case h DV \with {
+                          | inP (W,CW,p) => inP (W, CW, inP (top, V, <=<_top, y<=<V, \lam _ Vy => p Vy))
+                        }
+                      }
+      }) xy<=<W \with {
+        | inP (W, h, inP (U,V,x<=<U,y<=<V,q)) => inP (U, V, x<=<U, y<=<V, \lam Ux' Vy' => h ((x,y), (idp, q (<=<_<= x<=<U idp) (<=<_<= y<=<V idp))) (q Ux' Vy'))
+      }
+
+    \lemma proj1 {X Y : CoverSpace} : CoverMap (X ⨯ Y) X __.1
+      => proj1'
+
+    \lemma proj2 {X Y : CoverSpace} : CoverMap (X ⨯ Y) Y __.2
+      => proj2'
+
+    \func tuple {X Y Z : CoverSpace} (f : CoverMap Z X) (g : CoverMap Z Y) : CoverMap Z (X ⨯ Y) \cowith
+      | func z => (f z, g z)
+      | func-cover => closure-univ-cover $ later \case __ \with {
+        | inP (true, inP (D,Dc,h)) => cauchy-refine (f.func-cover Dc) \lam (inP (V,DV,p)) => \case h DV \with {
+          | inP (U',CU',q) => inP (_, inP (U',CU',idp), \lam Ux => q $ rewrite p in Ux)
+        }
+        | inP (false, inP (D,Dc,h)) => cauchy-refine (g.func-cover Dc) \lam (inP (V,DV,p)) => \case h DV \with {
+          | inP (U',CU',q) => inP (_, inP (U',CU',idp), \lam Ux => q $ rewrite p in Ux)
+        }
+      }
+
+    \func prod {X Y X' Y' : CoverSpace} (f : CoverMap X Y) (g : CoverMap X' Y') : CoverMap (X ⨯ X') (Y ⨯ Y')
+      => tuple (f ∘ proj1) (g ∘ proj2)
+      \where {
+        \lemma isDense {X X' Y Y' : CoverSpace} {f : CoverMap X Y} {g : CoverMap X' Y'} (fd : f.IsDense) (gd : g.IsDense) : ContMap.IsDense {prod f g}
+          => (dense-char {_} {Y ⨯ Y'}).2 $ later \lam {(y,y')} yy'<=<U =>
+              \have | (inP (V,yy'<=<V,V<=<U)) => <=<-inter yy'<=<U
+                    | (inP (x,Vfxy')) => dense-char.1 fd {y} $ transport (`<=< _) (ext \lam z => ext (pmap __.1, \lam p => ext (p, idp))) $ <=<_^-1 {Y} {Y ⨯ Y'} {tuple id (const y')} yy'<=<V
+                    | (inP (x',Ufxfx')) => dense-char.1 gd {y'} $ transport (`<=< _) (ext \lam z => ext (pmap __.2, \lam p => ext (idp, p))) $ <=<_^-1 {Y'} {Y ⨯ Y'} {tuple (const (f x)) id} $ <=<-right (single_<= Vfxy') V<=<U
+              \in inP ((x,x'), Ufxfx')
+
+        \lemma isEmbedding {X Y X' Y' : CoverSpace} {f : CoverMap X Y} {g : CoverMap X' Y'} (fe : f.IsEmbedding) (ge : g.IsEmbedding) : CoverMap.IsEmbedding {prod f g}
+          => closure-embedding (\lam c => c) (prod f g) \case __ \with {
+            | inP (true, inP (D,Dc,f)) => closure $ inP (Bool.true, inP (_, fe Dc, \lam (inP (U,DU,p)) => TruncP.map (f DU) \lam (W,CW,q) => (_, inP (W, CW, (\lam c => p c) <=∘ q), <=-refl)))
+            | inP (false, inP (D,Dc,f)) => closure $ inP (false, inP (_, ge Dc, \lam (inP (U,DU,p)) => TruncP.map (f DU) \lam (W,CW,q) => (_, inP (W, CW, (\lam c => p c) <=∘ q), <=-refl)))
+          }
+
+        \lemma isDenseEmbedding {X X' Y Y' : CoverSpace} {f : CoverMap X Y} {g : CoverMap X' Y'} (fde : f.IsDenseEmbedding) (gde : g.IsDenseEmbedding) : CoverMap.IsDenseEmbedding {prod f g}
+          => (isDense fde.1 gde.1, isEmbedding fde.2 gde.2)
+      }
+
+    \lemma prod-neighborhood {X Y : CoverSpace} {x : X} {y : Y} {W : Set (\Sigma X Y)} (xy<=<W : single (x,y) <=< {X ⨯ Y} W) : ∃ (U : Set X) (V : Set Y) (single x <=< U) (single y <=< V) ∀ {x : U} {y : V} (W (x,y))
+      => prod-neighborhood' $ unfolds xy<=<W
+
+    \lemma prodCover {X Y : CoverSpace} {C : Set (Set X)} (Cc : X.isCauchy C) {D : Set (Set Y)} (Dc : Y.isCauchy D)
+      : isCauchy {X ⨯ Y} \lam W => ∃ (U : C) (V : D) (W = \lam s => \Sigma (U s.1) (V s.2))
+      => prodCover' Cc Dc
+  }
+
+\instance ProductSeparatedCoverSpace (X Y : SeparatedCoverSpace) : SeparatedCoverSpace (\Sigma X Y)
+  | CoverSpace => ProductCoverSpace X Y
+  | isSeparatedCoverSpace p => ext (
+    isSeparatedCoverSpace \lam Cc => \case p (proj1.func-cover Cc) \with {
+      | inP (U, inP (V,CV,q), s) => inP (V, CV, rewrite q in s)
+    }, isSeparatedCoverSpace \lam Cc => \case p (proj2.func-cover Cc) \with {
+      | inP (U, inP (V,CV,q), s) => inP (V, CV, rewrite q in s)
+    })
+
+\instance ProductCompleteCoverSpace (X Y : CompleteCoverSpace) : CompleteCoverSpace (\Sigma X Y)
+  => complete-char 1 0 $ inP (ProductCoverSpace.tuple (completion-lift proj1) (completion-lift proj2),
+                              \lam s => ext (completion-lift-char s, completion-lift-char s))
+
+\func prodCF {X Y : CoverSpace} (F : CauchyFilter X) (G : CauchyFilter Y) : CauchyFilter (X ⨯ Y) \cowith
+  | F W => ∃ (U : Set X) (F U) (V : Set Y) (G V) ∀ {x : U} {y : V} (W (x,y))
+  | filter-mono p (inP (U,FU,V,GV,f)) => inP (U, FU, V, GV, \lam Ux Vy => p $ f Ux Vy)
+  | filter-top => inP (top, filter-top, top, filter-top, \lam _ _ => ())
+  | filter-meet (inP (U,FU,V,GV,f)) (inP (U',FU',V',GV',f')) => inP (U ∧ U', filter-meet FU FU', V ∧ V', filter-meet GV GV', \lam (Ux,U'x) (Vy,V'y) => (f Ux Vy, f' U'x V'y))
+  | isProper (inP (U,FU,V,GV,f)) => \case isProper FU, isProper GV \with {
+    | inP (x,Ux), inP (y,Vy) => inP ((x,y), f Ux Vy)
+  }
+  | isCauchyFilter => ClosurePrecoverSpace.closure-filter \this $ later \case __ \with {
+    | inP (true, inP (D,Dc,f)) => \case F.isCauchyFilter Dc \with {
+      | inP (V,DV,FV) => \case f DV \with {
+        | inP (U,CU,q) => inP (U, CU, inP (V, FV, top, filter-top, \lam Vx _ => q Vx))
+      }
+    }
+    | inP (false, inP (D,Dc,f)) => \case G.isCauchyFilter Dc \with {
+      | inP (V,DV,GV) => \case f DV \with {
+        | inP (U,CU,q) => inP (U, CU, inP (top, filter-top, V, GV, \lam _ Vy => q Vy))
+      }
+    }
+  }
diff --git a/src/Topology/CoverSpace/Real.ard b/src/Topology/CoverSpace/Real.ard
deleted file mode 100644
index 0f868152..00000000
--- a/src/Topology/CoverSpace/Real.ard
+++ /dev/null
@@ -1,481 +0,0 @@
-\import Algebra.Field
-\import Algebra.Group
-\import Algebra.Meta
-\import Algebra.Monoid
-\import Algebra.Ordered
-\import Algebra.Ring
-\import Algebra.Semiring
-\import Arith.Rat
-\import Arith.Real
-\import Data.Or
-\import Function (flip)
-\import Function.Meta
-\import Logic
-\import Logic.Meta
-\import Meta
-\import Order.Lattice
-\import Order.LinearOrder
-\import Order.PartialOrder
-\import Order.StrictOrder
-\import Paths
-\import Paths.Meta
-\import Set.Filter
-\import Set.Subset
-\import Topology.CoverSpace
-\import Topology.CoverSpace.Complete
-\import Topology.RatherBelow
-\open Set
-\open ProductPrecoverSpace
-\open ProductCoverSpace
-\open RatCoverSpace
-\open LinearlyOrderedAbMonoid
-\open LinearlyOrderedAbGroup
-\open LinearOrder \hiding (<=)
-\open DiscreteOrderedField
-\open LinearlyOrderedSemiring.Dec
-\open MeetSemilattice
-\open LinearlyOrderedSemiring \hiding (Dec)
-\open OrderedSemiring
-\open OrderedRing \hiding (Dec, denseOrder)
-\open Real
-\open RatField (mid,mid>left,mid<right,mid-between)
-
-\instance RatCoverSpace \plevels : CoverSpace Rat
-  => ClosureRegularCoverSpace Cover covers
-      (\lam (inP (eps,eps>0,p)) => inP (\lam U => ∃ (a : Rat) (U = open-int a (a + eps * ratio 1 3)), inP (eps * ratio 1 3, linarith, idp),
-        \lam (inP (a,q)) => inP (open-int (a - eps * ratio 1 3) (a + eps * ratio 2 3), rewrite p $ inP (a - eps * ratio 1 3, pmap (open-int _) linarith),
-                                 \lam (inP (b,r)) => rewrite (q,r) \lam (x,((s,s'),(t,t'))) (u,v) => (linarith, linarith))))
-  \where {
-    \func Cover (C : Set (Set Rat)) => ∃ (eps : Rat) (0 < eps) (C = \lam U => ∃ (a : Rat) (U = open-int a (a + eps)))
-
-    \lemma covers {C : Set (Set Rat)} (Cc : Cover C) (x : Rat) : ∃ (U : Set Rat) (C U) (U x) \elim Cc
-      | inP (eps,eps>0,p) => rewrite p $ inP (_, inP (x - eps * ratio 1 3, idp), (linarith, linarith))
-
-    \lemma makeCover (eps : Rat) (eps>0 : 0 < eps) : Closure Cover \lam U => ∃ (a : Rat) (U = open-int a (a + eps))
-      => closure $ inP (eps, eps>0, idp)
-
-    \func NFilter (x : Rat) : SetFilter Rat \cowith
-      | F U => ∃ (a b : Rat) (a < x) (x < b) ∀ y (a < y -> y < b -> U y)
-      | filter-mono p (inP (a,b,q,q',f)) => inP (a, b, q, q', \lam y r r' => p (f y r r'))
-      | filter-top => inP (x - 1, x + 1, linarith, linarith, \lam _ _ _ => ())
-      | filter-meet (inP (a,b,a<x,x<b,f)) (inP (c,d,c<x,x<d,g)) => inP
-          (a ∨ c, b ∧ d, TotalOrder.join-prop (`< x) a<x c<x, TotalOrder.meet-prop (x <) x<b x<d,
-           \lam y ac<y y<bd => (f y (join-left <∘r ac<y) (y<bd <∘l meet-left),
-                                g y (join-right <∘r ac<y) (y<bd <∘l meet-right)))
-
-    \lemma <=<-open {x : Rat} {U : Set Rat} (p : single x <=< {RatCoverSpace} U) : ∃ (a b : Rat) (a < x) (x < b) ∀ y (a < y -> y < b -> U y)
-      => \case closure-filter (NFilter x) (\lam (inP (eps,eps>0,p)) => rewrite p \let a => x - eps * ratio 1 2 \in inP (_, inP (a, idp), inP (a, a + eps, linarith, linarith, \lam y p q => (p,q)))) p \with {
-        | inP (V, f, inP (a,b,a<x,x<b,g)) => inP (a, b, a<x, x<b, \lam y a<y y<b => f (x, (idp, g x a<x x<b)) (g y a<y y<b))
-      }
-  }
-
-\instance RealCoverSpace \plevels : CompleteCoverSpace Real
-  | CoverSpace => coverSpace
-  | isSeparatedCoverSpace p =>
-    \let q => SeparatedCoverSpace.separated-char 6 3 p
-    \in real-ext \lam {a} {b} => (
-      \lam s => <=<_<= (q.1 (point_<=< s.1 s.2)) idp,
-      \lam s => <=<_<= (q.2 (point_<=< s.1 s.2)) idp)
-  | isCompleteCoverSpace => dense-regular-complete rat_real-dense \lam F => inP (fromCF F, \lam {U} => \case <=<-open __ \with {
-    | inP (a, b, inP (c,Fac), inP (d,Fdb), f) => filter-mono {F} (later \lam {x} ((a<x,_),(_,x<b)) => f x a<x x<b) (filter-meet {F} Fac Fdb)
-  })
-  \where {
-    \func open-rat-int (a b : Rat) : Set Real
-      => \lam (x : Real) => \Sigma (x.L a) (x.U b)
-
-    \lemma makeRealCover (eps : Rat) (eps>0 : 0 < eps) : Closure Cover \lam U => ∃ (a : Rat) (U = open-rat-int a (a + eps))
-      => closure $ inP (eps, eps>0, idp)
-
-    \func Cover (C : Set (Set Real)) => ∃ (eps : Rat) (0 < eps) (C = \lam U => ∃ (a : Rat) (U = open-rat-int a (a + eps)))
-
-    \lemma covers {C : Set (Set Real)} (Cc : Cover C) (x : Real) : ∃ (U : Set Real) (C U) (U x) \elim Cc
-      | inP (eps,eps>0,p) => TruncP.map (LU-focus {x} eps eps>0) \lam (a,a<x,x<a+eps) => rewrite p (_, inP (a,idp), (a<x, x<a+eps))
-
-    \func NFilter (x : Real) : SetFilter Real \cowith
-      | F U => ∃ (a b : Rat) (x.L a) (x.U b) ∀ (y : Real) (y.L a -> y.U b -> U y)
-      | filter-mono p (inP (a,b,q,q',f)) => inP (a, b, q, q', \lam y r r' => p (f y r r'))
-      | filter-top => \case x.L-inh, x.U-inh \with {
-        | inP (a,p), inP (b,q) => inP (a, b, p, q, \lam _ _ _ => ())
-      }
-      | filter-meet (inP (a,b,a<x,x<b,f)) (inP (c,d,c<x,x<d,g)) => inP (a ∨ c, b ∧ d,
-          TotalOrder.join-prop x.L a<x c<x, TotalOrder.meet-prop x.U x<b x<d,
-          \lam (y : Real) l u => (f y (y.L_<= l join-left) (y.U_<= u meet-left), g y (y.L_<= l join-right) (y.U_<= u meet-right)))
-
-    \instance coverSpace : CoverSpace Real
-      => ClosureRegularCoverSpace Cover covers
-          (\lam (inP (eps,eps>0,p)) => inP (
-            \lam U => ∃ (a : Rat) (U = \lam (x : Real) => \Sigma (x.L a) (x.U (a + eps * ratio 1 3))),
-            inP (eps * ratio 1 3, linarith, idp), \lam (inP (a,q)) => inP
-                (_, rewrite p $ inP (a - eps * ratio 1 3, idp),
-                 \lam (inP (b,r)) => rewrite (q,r) \lam (y : Real, ((a<y,y<a+eps/3),(b<y,y<b+eps/3))) {x : Real} V'x => (x.L-closed V'x.1 $ linarith (y.LU-less a<y y<b+eps/3), x.U-closed V'x.2 $ linarith (y.LU-less b<y y<a+eps/3)))))
-
-    \lemma <=<-open {x : Real} {U : Set Real} (p : single x <=< U) : ∃ (a b : Rat) (x.L a) (x.U b) ∀ (y : Real) (y.L a -> y.U b -> U y)
-      => \case closure-filter (NFilter x) (\lam (inP (eps,eps>0,p)) => TruncP.map (LU-focus {x} eps eps>0) \lam (a,a<y,y<a+eps) => (_, rewrite p $ inP (a, idp), inP (a, a + eps, a<y, y<a+eps, \lam x p q => (p,q)))) p \with {
-        | inP (V, f, inP (a,b,a<x,x<b,g)) => inP (a, b, a<x, x<b, \lam y a<y y<b => f (x, (idp, g x a<x x<b)) (g y a<y y<b))
-      }
-
-    \lemma <=<_open-rat-int {a b a' b' : Rat} (a<a' : a < a') (b'<b : b' < b) : open-rat-int a' b' <=< open-rat-int a b
-      => closure-subset (makeRealCover ((a' - a) ∧ (b - b')) $ <_meet-univ linarith linarith) \lam {U} (inP (c,p)) => rewrite p $ later \lam (e : Real, ((a'<e,e<b'),(c<e,e<c+eps))) (c<x,x<c+eps) => (L-closed c<x $ linarith (e.LU-less a'<e e<c+eps <∘l <=_+ <=-refl meet-left), U-closed x<c+eps $ <=_+ <=-refl meet-right <∘r linarith (e.LU-less c<e e<b'))
-
-    \lemma point_<=< {x : Real} {a b : Rat} (a<x : x.L a) (x<b : x.U b) : single x <=< open-rat-int a b
-      => \case x.L-rounded a<x, x.U-rounded x<b \with {
-        | inP (a',a'<x,a<a'), inP (b',x<b',b'<b) => <=<-right (later \lam p => rewriteI p (a'<x,x<b')) (<=<_open-rat-int a<a' b'<b)
-      }
-
-    \func fromCF (F : RegularCauchyFilter RatCoverSpace) : Real \cowith
-      | L a => ∃ (b : Rat) (F (open-int a b))
-      | L-inh => \case F.isCauchyFilter (makeCover 1 idp) \with {
-        | inP (U, inP (a,p), FU) => inP (a, inP (a + 1, rewrite p in FU))
-      }
-      | L-closed (inP (b,Fqb)) q'<q => inP (b, filter-mono (later \lam s => (q'<q <∘ s.1, s.2)) Fqb)
-      | L-rounded {a} (inP (b,Fab)) => \case isRegularFilter Fab \with {
-        | inP (V,V<=<ab,FV) => \case cauchy-cover (isRegular $ unfolds in V<=<ab) a \with {
-          | inP (W', inP (W,f,W'<=<W), W'a) => \case RatCoverSpace.<=<-open (<=<-right (single_<= W'a) W'<=<W) \with {
-            | inP (c,d,c<a,a<d,g) => inP (mid a d, inP (b, filter-mono (\lam {x} Vx => (\case dec<_<= x d \with {
-              | inl x<d => absurd $ <-irreflexive {_} {a} (f (x, (Vx, g x (c<a <∘ (<=<_<= V<=<ab Vx).1) x<d)) $ <=<_<= W'<=<W W'a).1
-              | inr d<=x => mid<right a<d <∘l d<=x
-            }, (<=<_<= V<=<ab Vx).2)) FV), mid>left a<d)
-          }
-        }
-      }
-      | U b => ∃ (a : Rat) (F (open-int a b))
-      | U-inh => \case F.isCauchyFilter (makeCover 1 idp) \with {
-        | inP (U, inP (a,p), FU) => inP (a + 1, inP (a, rewrite p in FU))
-      }
-      | U-closed (inP (a,Faq)) q<q' => inP (a, filter-mono (later \lam s => (s.1, s.2 <∘ q<q')) Faq)
-      | U-rounded {b} (inP (a,Fab)) => \case isRegularFilter Fab \with {
-        | inP (V,V<=<ab,FV) => \case cauchy-cover (isRegular $ unfolds in V<=<ab) b \with {
-          | inP (W', inP (W,f,W'<=<W), W'b) => \case RatCoverSpace.<=<-open (<=<-right (single_<= W'b) W'<=<W) \with {
-            | inP (c,d,c<b,b<d,g) => inP (mid c b, inP (a, filter-mono (\lam {x} Vx => ((<=<_<= V<=<ab Vx).1, \case dec<_<= c x \with {
-              | inl c<x => absurd $ <-irreflexive (f (x, (Vx, g x c<x $ (<=<_<= V<=<ab Vx).2 <∘ b<d)) $ <=<_<= W'<=<W W'b).2
-              | inr x<=c => x<=c <∘r mid>left c<b
-            })) FV), mid<right c<b)
-          }
-        }
-      }
-      | LU-disjoint (inP (b,Fqb)) (inP (a,Faq)) => \case isProper (filter-meet Faq Fqb) \with {
-        | inP (x,((_,x<q),(q<x,_))) => linarith
-      }
-      | LU-focus eps eps>0 => \case F.isCauchyFilter (makeCover eps eps>0) \with {
-        | inP (_, inP (a,idp), e) => inP (a, inP (a + eps, e), inP (a, e))
-      }
-  }
-
-\lemma real-coverMap {X : PrecoverSpace} (f : X -> Real) (Ap : \Pi (eps : Rat) -> 0 < eps -> eps < 1 -> isCauchy \lam U => ∃ (a : Rat) (U = \lam x => \Sigma (Real.L {f x} a) (Real.U {f x} (a + eps)))) : CoverMap X RealCoverSpace f \cowith
-  | func-cover Dc => flip closure-univ-cover Dc \lam (inP (eps,eps>0,p)) => cauchy-extend (Ap (eps ∧ ratio 1 2) (<_meet-univ eps>0 idp) $ meet-right <∘r idp)
-                      \lam (inP (a,q)) => inP $ later (_, inP (_, rewrite p $ inP (a, idp), idp), rewrite q \lam (c,c') => (c, UpperReal.U_<= c' $ <=_+ <=-refl meet-left))
-
-\lemma rat_real-uniMap (f : Rat -> Real) (Ap : \Pi (eps : Rat) -> 0 < eps -> eps < 1 -> ∃ (d : Rat) (0 < d) ∀ a ∃ (b : Rat) (open-int a (a + d) ⊆ \lam x => \Sigma (Real.L {f x} b) (Real.U {f x} (b + eps)))) : CoverMap RatCoverSpace RealCoverSpace f
-  => real-coverMap f \lam eps eps>0 eps<1 => \case Ap eps eps>0 eps<1 \with {
-    | inP (d,d>0,g) => closure-extends (makeCover d d>0) \lam (inP (a,p)) => \case g a \with {
-      | inP (b,q) => inP (_, inP (b,idp), rewrite p q)
-    }
-  }
-
--- | A map is a cover map if, for every eps > 0, there exists e > 0 such that, for every open (w,w+e) of size e, there exists 0 < d <= e such that every open of size d inside (w,w+e) is mapped to a set of size eps.
-\lemma rat_real-coverMap (f : Rat -> Real) (Ap : \Pi (eps : Rat) -> 0 < eps -> eps < 1 -> ∃ (e : Rat) (0 < e) ∀ w ∃ (d : Rat) (0 < d) (d <= e) ∀ a (\Sigma (w <= a) (a + d <= w + e) -> ∃ (b : Rat) (open-int a (a + d) ⊆ \lam x => \Sigma (Real.L {f x} b) (Real.U {f x} (b + eps))))) : CoverMap RatCoverSpace RealCoverSpace f
-  => real-coverMap f \lam eps eps>0 eps<1 => \case Ap eps eps>0 eps<1 \with {
-    | inP (e,e>0,g) => closure-extends (closure-trans (makeCover e e>0)
-        {\lam U V => ∃ (w : Rat) (U = open-int w (w + e)) (a d : Rat) (0 < d) (d <= e) (\Pi (a : Rat) -> \Sigma (w <= a) (a + d <= w + e) -> ∃ (b : Rat) (open-int a (a + d) ⊆ (\lam x => \Sigma (LowerReal.L {f x} b) (UpperReal.U {f x} (b + eps))))) (V = open-int a (a + d))}
-        (\lam (inP (w,p)) => \case g w \with {
-          | inP (d,d>0,d<=e,h) => closure-subset (makeCover d d>0) \lam (inP (a,q)) => inP (w, p, a, d, d>0, d<=e, h, q)
-        }) idp) \lam (inP (V, W, _, inP (w,Vp,a,d,d>0,d<=e,h,Wp), q)) => \case h ((a ∨ w) ∧ (w + e - d)) (meet-univ join-right linarith, <=_+ meet-right <=-refl <=∘ linarith) \with {
-          | inP (b,r) => inP (_, inP (b,idp), rewrite (q,Vp,Wp) \lam ((w<x,x<w+e),(a<x,x<a+d)) => r (meet-left <∘r <_join-univ a<x w<x, rewrite meet_+-right $ <_meet-univ (linarith (join-left : a <= a ∨ w)) linarith))
-        }
-  }
-
-\lemma rat2_real-uniMap (f : Rat -> Rat -> Real) (Ap : \Pi (eps : Rat) -> 0 < eps -> eps < 1 -> ∃ (d1 d2 : Rat) (0 < d1) (0 < d2) (\Pi (a b : Rat) -> ∃ (c : Rat) ∀ {x} {y} (\Sigma (a < x) (x < a + d1) -> \Sigma (b < y) (y < b + d2) -> \Sigma (Real.L {f x y} c) (Real.U {f x y} (c + eps))))) : CoverMap (ProductCoverSpace RatCoverSpace RatCoverSpace) RealCoverSpace (\lam s => f s.1 s.2)
-  => real-coverMap {ProductCoverSpace _ _} (later \lam s => f s.1 s.2) \lam eps eps>0 eps<1 => \case Ap eps eps>0 eps<1 \with {
-    | inP (d1,d2,d1>0,d2>0,g) => closure-extends (closure-inter (proj1.func-cover $ makeCover d1 d1>0) (proj2.func-cover $ makeCover d2 d2>0))
-        \lam (inP (V1, V2, inP (W1, inP (a1,p1), q1), inP (W2, inP (a2,p2), q2), r)) => \case g a1 a2 \with {
-          | inP (c,h) => inP (_, inP (c, idp), rewrite (r,q1,q2,p1,p2) \lam (s1,s2) => h s1 s2)
-        }
-  }
-
-\lemma rat2_real-uniMap' (f : Rat -> Rat -> Real) (Ap : \Pi (eps : Rat) -> 0 < eps -> eps < 1 -> ∃ (d : Rat) (0 < d) ∀ a b ∃ (c : Rat) ∀ {x} {y} (\Sigma (a < x) (x < a + d) -> \Sigma (b < y) (y < b + d) -> \Sigma (Real.L {f x y} c) (Real.U {f x y} (c + eps)))) : CoverMap (ProductCoverSpace RatCoverSpace RatCoverSpace) RealCoverSpace (\lam s => f s.1 s.2)
-  => rat2_real-uniMap f \lam eps eps>0 eps<1 => TruncP.map (Ap eps eps>0 eps<1) \lam (d,d>0,g) => (d,d,d>0,d>0,g)
-
--- | A map of two arguments is a cover map if, for every eps > 0, there exist e1,e2 > 0 such that, for every open U of size e1 ⨯ e2, there exist 0 < d1 < e1, 0 < d2 < e2 such that every open of size d1 ⨯ d2 inside U is mapped to a set of size eps.
-\lemma rat2_real-coverMap (f : Rat -> Rat -> Real) (Ap : \Pi (eps : Rat) -> 0 < eps -> eps < 1 -> ∃ (e1 e2 : Rat) (0 < e1) (0 < e2) (\Pi (w1 w2 : Rat) -> ∃ (d1 d2 : Rat) (0 < d1) (d1 <= e1) (0 < d2) (d2 <= e2) (\Pi (a b : Rat) -> \Sigma (w1 <= a) (a + d1 <= w1 + e1) -> \Sigma (w2 <= b) (b + d2 <= w2 + e2) -> ∃ (c : Rat) (\Pi {x y : Rat} -> \Sigma (a < x) (x < a + d1) -> \Sigma (b < y) (y < b + d2) -> \Sigma (Real.L {f x y} c) (Real.U {f x y} (c + eps)))))) : CoverMap (ProductCoverSpace RatCoverSpace RatCoverSpace) RealCoverSpace (\lam s => f s.1 s.2)
-  => real-coverMap {ProductCoverSpace _ _} (later \lam s => f s.1 s.2) \lam eps eps>0 eps<1 => \case Ap eps eps>0 eps<1 \with {
-    | inP (e1,e2,e1>0,e2>0,g) => closure-extends (closure-trans (closure-inter (proj1.func-cover $ makeCover e1 e1>0) (proj2.func-cover $ makeCover e2 e2>0))
-        {\lam U V => ∃ (w1 w2 : Rat) (U = \lam x => \Sigma (\Sigma (w1 < x.1) (x.1 < w1 + e1)) (\Sigma (w2 < x.2) (x.2 < w2 + e2))) (a1 a2 d1 d2 : Rat) (0 < d1) (d1 <= e1) (0 < d2) (d2 <= e2) (\Pi (a1 a2 : Rat) -> \Sigma (w1 <= a1) (a1 + d1 <= w1 + e1) -> \Sigma (w2 <= a2) (a2 + d2 <= w2 + e2) -> ∃ (c : Rat) (\Pi {x y : Rat} -> \Sigma (a1 < x) (x < a1 + d1) -> \Sigma (a2 < y) (y < a2 + d2) -> \Sigma (LowerReal.L {f x y} c) (UpperReal.U {f x y} (c + eps)))) (V = \lam x => \Sigma (\Sigma (a1 < x.1) (x.1 < a1 + d1)) (\Sigma (a2 < x.2) (x.2 < a2 + d2)))}
-        (\lam (inP (V1, V2, inP (W1, inP (w1,p1), q1), inP (W2, inP (w2,p2), q2), r)) => \case g w1 w2 \with {
-          | inP (d1,d2,d1>0,d1<=e1,d2>0,d2<=e2,h) => closure-subset (closure-inter (proj1.func-cover $ makeCover d1 d1>0) (proj2.func-cover $ makeCover d2 d2>0))
-              \lam {W} (inP (V1', V2', inP (W1', inP (a1,p1'), q1'), inP (W2', inP (a2,p2'), q2'), r')) => inP (w1, w2, rewrite (r,q1,q2,p1,p2) idp, a1, a2, d1, d2, d1>0, d1<=e1, d2>0, d2<=e2, h, rewrite (r',q1',q2',p1',p2') idp)
-        }) idp)
-        \lam (inP (U', V', _, inP (w1, w2, p, a1, a2, d1, d2, d1>0, d1<=e1, d2>0, d2<=e2, h, r'), r)) => hiding (Ap,eps,eps>0,eps<1,g) \case h ((a1 ∨ w1) ∧ (w1 + e1 - d1)) ((a2 ∨ w2) ∧ (w2 + e2 - d2)) (meet-univ join-right linarith, <=_+ meet-right <=-refl <=∘ linarith) (meet-univ join-right linarith, <=_+ meet-right <=-refl <=∘ linarith) \with {
-          | inP (c,k) => inP (_, inP (c,idp), rewrite (r,p,r') \lam (((w1<x,x<w1+e1),(w2<y,y<w2+e2)),((a1<x,x<a1+d1),(a2<y,y<a2+d2))) =>
-              k (meet-left <∘r <_join-univ a1<x w1<x, rewrite meet_+-right $ <_meet-univ (linarith (join-left : a1 <= a1 ∨ w1)) linarith)
-                (meet-left <∘r <_join-univ a2<y w2<y, rewrite meet_+-right $ <_meet-univ (linarith (join-left : a2 <= a2 ∨ w2)) linarith))
-        }
-  }
-
-\open ClosurePrecoverSpace
-\open CoverMap
-
-\func rat_real : CoverMap RatCoverSpace RealCoverSpace.coverSpace
-  => closure-univ (\lam c => c) Real.fromRat $ later
-      \lam (inP (eps,eps>0,p)) => closure-subset (closure $ inP (eps, eps>0, idp)) \lam (inP (a,q)) => inP (_, rewrite p $ inP (a, idp), q)
-
-\lemma rat_real-dense : rat_real.IsDenseEmbedding
-  => (\lam {y : Real} y<=<U => \case RealCoverSpace.<=<-open y<=<U \with {
-        | inP (a,b,a<y,y<b,f) => \have a<b => y.LU-less a<y y<b \in inP (mid a b, f _ (mid>left a<b) (mid<right a<b))
-      }, closure-embedding (\lam c => c) rat_real (\lam (inP (eps,eps>0,p)) =>
-          closure-subset (closure $ inP (eps, eps>0, idp)) \lam (inP (a,q)) => inP (_, rewrite p $ inP (a, idp), rewrite q \lam s => s)))
-
-\instance RealRatAlgebra : OrderedFieldAlgebra RatField
-  | OrderedField => RealField
-  | *c a x => Real.fromRat a RealField.* x
-  | *c-assoc => pmap (RealField.`* _) (inv RealField.*-rat) *> RealField.*-assoc
-  | *c-ldistr => RealField.ldistr
-  | *c-rdistr => pmap (RealField.`* _) (inv RealAbGroup.+-rat) *> RealField.rdistr
-  | ide_*c => RealField.ide-left
-  | *c-comm-left => inv RealField.*-assoc
-  | coefMap => Real.fromRat
-  | coefMap_*c => inv RealField.ide-right
-  | coef_< p => real_<-char.2 (isDense p)
-  | coef_<-inv p => \case real_<-char.1 p \with {
-    | inP (a,x<a,a<y) => x<a <∘ a<y
-  }
-
-\instance RealField : OrderedField Real
-  | LinearlyOrderedAbGroup => RealAbGroup
-  | ide => 1
-  | * => *
-  | ide-left => unique (*-cover ∘ tuple (const (1 : Real)) id) id \lam x => *-rat *> pmap Real.fromRat ide-left
-  | *-assoc => unique3 (*-cover ∘ prod *-cover id) (*-cover ∘ tuple (proj1 ∘ proj1) (*-cover ∘ prod proj2 id)) \lam x y z => unfold $ unfold $ rewrite (*-rat,*-rat,*-rat,*-rat) $ pmap Real.fromRat *-assoc
-  | ldistr => unique3 (*-cover ∘ tuple (proj1 ∘ proj1) (+-cover ∘ prod proj2 id)) (+-cover ∘ tuple (*-cover ∘ tuple (proj1 ∘ proj1) (proj2 ∘ proj1)) (*-cover ∘ tuple (proj1 ∘ proj1) proj2)) \lam x y z => unfold $ unfold $ rewrite (RealAbGroup.+-rat,*-rat,*-rat,*-rat,RealAbGroup.+-rat) $ pmap Real.fromRat ldistr
-  | *-comm => unique2 *-cover (*-cover ∘ tuple proj2 proj1) \lam x y => *-rat *> pmap Real.fromRat *-comm *> inv *-rat
-  | ide>zro => idp
-  | positive_* x>0 y>0 => (*_positive-L x>0 y>0).2 \case L-rounded x>0, L-rounded y>0 \with {
-    | inP (a,a<x,a>0), inP (a',a'<y,a'>0) => inP (a, a', a>0, a'>0, a<x, a'<y, <_*_positive_positive a>0 a'>0)
-  }
-  | positive_*-cancel {x : Real} {y : Real} (xy>0 : LowerReal.L {x * y} 0) : (\Sigma (x.L 0) (y.L 0)) || (\Sigma (LowerReal.L {negative x} 0) (LowerReal.L {negative y} 0)) => \case U-inh {x * y} \with {
-    | inP (u,xy<u) => \case (lift2-char 0 u).1 (rewrite (\peval x * y) in xy>0, rewrite (\peval x * y) in xy<u) \with {
-      | inP (a',_,c1,d1,c2,d2,a'>0,_,c1<x,x<d1,c2<y,y<d2,h) => unfold at h $
-        \have | c1<d1 => LU-less c1<x x<d1
-              | c2<d2 => LU-less c2<y y<d2
-        \in \case dec<_<= c1 0, dec<_<= 0 d1 \with {
-          | inl c1<0, inl d1>0 => absurd $ <-irreflexive $ a'>0 <∘ (rewrite zro_*-left in (h {0} {mid c2 d2} (c1<0,d1>0) (mid-between c2<d2)).1)
-          | inl c1<0, inr d1<=0 => byRight (UpperReal.U_<= x<d1 d1<=0, \case dec<_<= 0 d2 \with {
-            | inl d2>0 => absurd $ <-irreflexive $ a'>0 <∘ (h {mid c1 d1} {(d2 *' ratio 1 2) ∨ mid c2 d2} (mid-between c1<d1) (mid>left c2<d2 <∘l join-right, <_join-univ linarith $ mid<right c2<d2)).1 <∘ <_*_negative_positive (mid<right c1<d1 <∘l d1<=0) (linarith <∘l join-left)
-            | inr d2<=0 => UpperReal.U_<= y<d2 d2<=0
-          })
-          | inr c1>=0, inl d1>0 => byLeft (LowerReal.L_<= c1<x c1>=0, \case dec<_<= c2 0 \with {
-            | inl c2<0 => absurd $ <-irreflexive $ a'>0 <∘ \have t => (h {mid c1 d1} {(c2 *' ratio 1 2) ∧ mid c2 d2} (mid-between c1<d1) (<_meet-univ linarith $ mid>left c2<d2, meet-right <∘r mid<right c2<d2)).1
-                                                           \in t <∘l <=_*_positive_negative (c1>=0 <=∘ <_<= (mid>left c1<d1)) (meet-left <=∘ linarith)
-            | inr c2>=0 => LowerReal.L_<= c2<y c2>=0
-          })
-          | inr c1>=0, inr d1<=0 => absurd $ <-irreflexive $ c1>=0 <∘r c1<d1 <∘l d1<=0
-        }
-    }
-  }
-  | positive=>#0 {x : Real} x>0 => Monoid.Inv.lmake (pos-inv x>0) $ exts
-      (\lam c => ext (\lam l => \case (*_positive-L (pos-inv>0 x>0) x>0).1 l \with {
-        | inP (a, a', a>0, a'>0, byLeft a<=0, a'<x, c<aa') => absurd linarith
-        | inP (a, a', a>0, a'>0, byRight x<a1, a'<x, c<aa') => c<aa' <∘ transport (_ <) (finv-right $ RatField.>_/= a>0) (<_*_positive-right a>0 $ LU-less a'<x x<a1)
-      }, \lam c<1 => (*_positive-L (pos-inv>0 x>0) x>0).2 $ unfold LowerReal.L \case LU_*-focus-left x>0 c<1 \with {
-        | inP (b,bc<x,x<b) => \case L-rounded bc<x, L-rounded x>0 \with {
-          | inP (a',a'<x,bc<a'), inP (a'',a''<x,a''>0) =>
-            \have b>0 => LU-less x>0 x<b
-            \in inP (finv b, a' ∨ a'', finv>0 b>0, a''>0 <∘l join-right, byRight $ transportInv x.U RatField.finv_finv x<b, real_join_L a'<x a''<x, transport (`< _) (inv *-assoc *> pmap (`*' c) (RatField.finv-left $ RatField.>_/= b>0) *> ide-left) (RatField.<_*_positive-right (finv>0 b>0) bc<a') <∘l <=_*_positive-right (<_<= $ finv>0 b>0) join-left)
-        }
-      }),
-       \lam d => ext (\lam u => \case (*_positive-U (pos-inv>0 x>0) x>0).1 u \with {
-         | inP (b,b',(b>0,b1<x),x<b',bb'<d) => transport (`< _) (finv-right $ RatField.>_/= b>0) (RatField.<_*_positive-right b>0 $ LU-less b1<x x<b') <∘ bb'<d
-       }, \lam d>1 => (*_positive-U (pos-inv>0 x>0) x>0).2 \case LU_*-focus-right x>0 d>1 \with {
-         | inP (a,a>0,a<x,x<ad) => \case U-rounded x<ad \with {
-           | inP (b',x<b',b'<ad) => inP (finv a, b', (finv>0 a>0, transportInv x.L RatField.finv_finv a<x), x<b', transport (_ <) (inv *-assoc *> pmap (`*' _) (RatField.finv-left $ RatField.>_/= a>0) *> ide-left) $ <_*_positive-right (finv>0 a>0) b'<ad)
-         }
-       }))
-  | #0=>eitherPosOrNeg {x} (xi : Monoid.Inv x) => \case positive_*-cancel (rewrite xi.inv-right idp) \with {
-    | byLeft (x>0,_) => byLeft x>0
-    | byRight (-x>0,_) => byRight -x>0
-  }
-  \where {
-    \open RealCoverSpace
-
-    \lemma dense-lift-real-char {X Y : CoverSpace} {f : CoverMap X Y} (fd : f.IsDenseEmbedding) {g : CoverMap X RealCoverSpace} (y : Y) (a b : Rat)
-      : open-rat-int a b (dense-lift f fd g y) <-> ∃ (a' b' : Rat) (a < a') (b' < b) (V : Set Y) (f ^-1 V ⊆ g ^-1 open-rat-int a' b') (single y <=< V)
-      => (\lam (a<z,z<b) => \case L-rounded a<z, U-rounded z<b \with {
-        | inP (a',a'<z,a<a'), inP (b',z<b',b'<b) => \case (dense-lift-neighborhood fd y (open-rat-int a' b')).1 (point_<=< a'<z z<b') \with {
-          | inP (W,W<=<a'b',V,q,y<=<V) => inP (a', b', a<a', b'<b, V, q <=∘ <=<_<= (<=<_^-1 W<=<a'b'), y<=<V)
-        }
-      }, \lam (inP (a',b',a<a',b'<b,V,h,y<=<V)) => <=<_<= ((dense-lift-neighborhood fd y (\lam x => open-rat-int a b x)).2 $ inP (open-rat-int a' b', <=<_open-rat-int a<a' b'<b, V, h, y<=<V)) idp)
-
-    \func lift {X : CompleteCoverSpace} (f : CoverMap RatCoverSpace X) : CoverMap RealCoverSpace X
-      => dense-lift rat_real rat_real-dense f
-
-    \lemma lift-rat {X : CompleteCoverSpace} {f : CoverMap RatCoverSpace X} {x : Rat} : lift f x = f x
-      => dense-lift-char {_} {_} {_} {rat_real} {rat_real-dense} x
-
-    \lemma lift-char {f : CoverMap RatCoverSpace RealCoverSpace} {y : Real} (a b : Rat)
-      : open-rat-int a b (lift f y) <-> ∃ (a' b' c d : Rat) (a < a') (b' < b) (y.L c) (y.U d) (open-int c d ⊆ f ^-1 open-rat-int a' b')
-      => <->trans (dense-lift-real-char rat_real-dense y a b) $ later
-          (\lam (inP (a',b',a<a',b'<b,V,q,y<=<V)) => \case <=<-open y<=<V \with {
-             | inP (c,d,c<y,y<d,h) => inP (a', b', c, d, a<a', b'<b, c<y, y<d, (\lam {x} (c<x,x<d) => h x c<x x<d) <=∘ q)
-           }, \lam (inP (a',b',c,d,a<a',b'<b,c<y,y<d,q)) => inP (a', b', a<a', b'<b, open-rat-int c d, q, point_<=< c<y y<d))
-
-    \func lift2 {X : CompleteCoverSpace} (f : CoverMap (ProductCoverSpace RatCoverSpace RatCoverSpace) X) : CoverMap (ProductCoverSpace RealCoverSpace RealCoverSpace) X
-      => dense-lift (prod rat_real rat_real) (prod.isDenseEmbedding rat_real-dense rat_real-dense) f
-
-    \lemma lift2-rat {X : CompleteCoverSpace} {f : CoverMap (ProductCoverSpace RatCoverSpace RatCoverSpace) X} {x y : Rat} : lift2 f (x,y) = f (x,y)
-      => dense-lift-char {ProductCoverSpace _ _} {_} {_} {prod rat_real rat_real} {prod.isDenseEmbedding rat_real-dense rat_real-dense} (x,y)
-
-    \lemma lift2-char {f : CoverMap (ProductCoverSpace RatCoverSpace RatCoverSpace) RealCoverSpace} {x y : Real} (a b : Rat)
-      : open-rat-int a b (lift2 f (x,y)) <-> ∃ (a' b' c1 d1 c2 d2 : Rat) (a < a') (b' < b) (x.L c1) (x.U d1) (y.L c2) (y.U d2) (\Pi {x y : Rat} -> \Sigma (c1 < x) (x < d1) -> \Sigma (c2 < y) (y < d2) -> open-rat-int a' b' (f (x,y)))
-      => <->trans (dense-lift-real-char {ProductCoverSpace _ _} (prod.isDenseEmbedding rat_real-dense rat_real-dense) (x,y) a b) $ later
-          (\lam (inP (a',b',a<a',b'<b,V,q,xy<=<V)) => \case prod-neighborhood xy<=<V \with {
-            | inP (U,V,x<=<U,y<=<V,h) => \case <=<-open x<=<U, <=<-open y<=<V \with {
-              | inP (c1,d1,c1<x,x<d1,p1), inP (c2,d2,c2<y,y<d2,p2) => inP (a', b', c1, d1, c2, d2, a<a', b'<b, c1<x, x<d1, c2<y, y<d2, \lam {x'} {y'} (c1<x',x'<d1) (c2<y',y'<d2) => q $ h (p1 x' c1<x' x'<d1) (p2 y' c2<y' y'<d2))
-            }
-          }, \lam (inP (a',b',c1,d1,c2,d2,a<a',b'<b,c1<x,x<d1,c2<y,y<d2,q)) => inP (a', b', a<a', b'<b, \lam z => \Sigma (open-rat-int c1 d1 z.1) (open-rat-int c2 d2 z.2),
-              \lam s => q s.1 s.2, RatherBelow.<=<_meet-same (<=<-right (later \lam s => pmap __.1 s) $ <=<_^-1 {_} {_} {proj1} $ RealCoverSpace.point_<=< c1<x x<d1) (<=<-right (later \lam s => pmap __.2 s) $ <=<_^-1 {_} {_} {proj2} $ RealCoverSpace.point_<=< c2<y y<d2)))
-
-    \lemma unique {X : SeparatedCoverSpace} (f g : CoverMap RealCoverSpace X) (p : \Pi (x : Rat) -> f x = g x) {x : Real} : f x = g x
-      => dense-lift-unique rat_real rat_real-dense.1 f g p x
-
-    \lemma unique2 {X : SeparatedCoverSpace} (f g : CoverMap (ProductCoverSpace RealCoverSpace RealCoverSpace) X) (p : \Pi (x y : Rat) -> f (x,y) = g (x,y)) {x y : Real} : f (x,y) = g (x,y)
-      => dense-lift-unique (prod rat_real rat_real) (prod.isDenseEmbedding rat_real-dense rat_real-dense).1 f g (\lam s => p s.1 s.2) (x,y)
-
-    \lemma unique3 {X : SeparatedCoverSpace} (f g : CoverMap (ProductCoverSpace (ProductCoverSpace RealCoverSpace RealCoverSpace) RealCoverSpace) X) (p : \Pi (x y z : Rat) -> f ((x,y),z) = g ((x,y),z)) {x y z : Real} : f ((x,y),z) = g ((x,y),z)
-      => dense-lift-unique (prod (prod rat_real rat_real) rat_real) (prod.isDenseEmbedding (prod.isDenseEmbedding rat_real-dense rat_real-dense) rat_real-dense).1 f g (\lam s => p s.1.1 s.1.2 s.2) ((x,y),z)
-
-    \open AddMonoid
-    \open Monoid(* \as \infixl 7 *')
-
-    \lemma +-cover : CoverMap (ProductCoverSpace RealCoverSpace RealCoverSpace) RealCoverSpace (\lam s => s.1 + s.2)
-      => real-coverMap _ \lam eps eps>0 eps<1 => closure-extends (prodCover (RealCoverSpace.makeRealCover (eps *' ratio 1 3) linarith) (RealCoverSpace.makeRealCover (eps *' ratio 1 3) linarith))
-          \lam (inP (_, inP (a,idp), _, inP (b,idp), p)) => later $ inP (_, inP (a + b, idp), rewrite p \lam {x} ((a<x,x<a+eps),(b<y,y<b+eps)) => (\case L-rounded a<x \with {
-            | inP (a',a'<x,a<a') => inP (a', a'<x, b, b<y, <_+-left b a<a')
-          }, inP (_, x<a+eps, _, y<b+eps, linarith)))
-
-    \lemma negative-cover : CoverMap RealCoverSpace RealCoverSpace negative
-      => real-coverMap negative \lam eps eps>0 _ => closure-subset (RealCoverSpace.makeRealCover eps eps>0) \lam (inP (a,p)) =>
-          inP (negative (a + eps), ext \lam x => simplify $ rewrite p $ ext (\lam (s,t) => (t,s), \lam (t,s) => (s,t)))
-
-    \sfunc \infixl 7 * (x y : Real) : Real
-      => cover (x,y)
-      \where \protected {
-        \func cover => lift2 $ rat2_real-coverMap (__ *' __) \lam eps eps>0 eps<1 => inP (1, 1, idp, idp,
-          \let | d w => (eps *' finv (abs w + 2)) *' finv 2
-               | d<=1 w : d w <= 1 => rewrite (*-assoc, inv $ RatField.finv_* {2}) $ <_<= $ RatField.<_*_positive-right eps>0 (finv<1 $ linarith $ RatField.abs>=0) <∘ simplify eps<1
-          \in \lam w1 w2 => inP (d w2, d w1,
-            hiding d<=1 $ <_*_positive_positive (<_*_positive_positive eps>0 $ finv>0 $ linarith $ RatField.abs>=0) (RatField.finv>0 {2} idp), d<=1 w2,
-            hiding d<=1 $ <_*_positive_positive (<_*_positive_positive eps>0 $ finv>0 $ linarith $ RatField.abs>=0) (RatField.finv>0 {2} idp), d<=1 w1,
-            \lam a b (w1<=a,a+d1<=w1+1) (w2<=b,b+d2<=w2+1) => inP ((a *' b) ∧ (a *' (b + d w1)) ∧ ((a + d w2) *' b) ∧ ((a + d w2) *' (b + d w1)),
-                \lam {x} {y} (a<x,x<a+d1) (b<y,y<b+d2) => (\case trichotomy y 0 \with {
-                  | less y<0 => meet-monotone meet-right <=-refl <∘r \case dec<_<= (a + d w2) 0 \with {
-                    | inl a+d1<0 => meet-right <∘r RatField.<_*_negative-right a+d1<0 y<b+d2 <∘ RatField.<_*_negative-left x<a+d1 y<0
-                    | inr a+d1>=0 => meet-left <∘r <=_*_positive-right a+d1>=0 (<_<= b<y) <∘r RatField.<_*_negative-left x<a+d1 y<0
-                  }
-                  | equals y=0 => meet-left <∘r meet-monotone meet-right <=-refl <∘r rewrite (y=0,Ring.zro_*-right) \case dec<_<= a 0 \with {
-                    | inl a<0 => meet-left <∘r <_*_negative_positive a<0 (rewrite y=0 in y<b+d2)
-                    | inr a>=0 => meet-right <∘r <_*_positive_negative (a>=0 <∘r a<x <∘ x<a+d1) (rewrite y=0 in b<y)
-                  }
-                  | greater y>0 => (meet-left <=∘ meet-left) <∘r \case dec<_<= a 0 \with {
-                    | inl a<0 => meet-right <∘r RatField.<_*_negative-right a<0 y<b+d2 <∘ <_*_positive-left a<x y>0
-                    | inr a>=0 => meet-left <∘r <=_*_positive-right a>=0 (<_<= b<y) <∘r <_*_positive-left a<x y>0
-                  }
-                }, \have | lem' {x'} {y'} (y'p : w2 <= y') (y'q : y' <= w2 + 1) (p : abs (x - x') < d w2) (q : abs (y - y') < d w1) : x *' y < x' *' y' + eps
-                            => \have | lem {z} {w} (p : w <= z) (q : z <= w + 1) : abs z < abs w + 2 => <_join-univ (q <∘r linarith (RatField.abs>=id {w})) (RatField.negative_<= p <∘r abs>=neg <∘r linarith)
-                                     | |w1|+2/=0 : abs w1 + 2 /= 0 => RatField.>_/= $ RatField.<=_+-left {_} {0} abs>=0 (later idp)
-                                     | |w2|+2/=0 : abs w2 + 2 /= 0 => RatField.>_/= $ RatField.<=_+-left {_} {0} abs>=0 (later idp)
-                                     | t : x *' (y - y') + (x - x') *' y' < eps
-                                        => rewrite *-comm $ abs>=id <∘r abs_+ <∘r rewrite (abs_*,abs_*) (transport (_ <) (
-                                              equation {usingOnly (RatField.finv-left |w1|+2/=0, RatField.finv-left |w2|+2/=0)}
-                                                       (ratio 1 2 *' eps + ratio 1 2 *' eps)
-                                                       {linarith})
-                                              (RatField.<_+ (<=_*_positive-left (<_<= q) abs>=0 <∘r <_*_positive-right (abs>=0 <∘r q) (lem (w1<=a <=∘ <_<= a<x) (<_<= x<a+d1 <=∘ a+d1<=w1+1)))
-                                                            (<=_*_positive-left (<_<= p) abs>=0 <∘r <_*_positive-right (abs>=0 <∘r p) (lem y'p y'q))))
-                               \in linarith $ rewrite (Ring.ldistr_-, Ring.rdistr_-) in t
-                         | lem1 : abs (x - a) < d w2 => rewrite (abs-ofPos linarith) linarith
-                         | lem2 : abs (y - b) < d w1 => rewrite (abs-ofPos linarith) linarith
-                         | lem3 : abs (x - (a + d w2)) < d w2 => rewrite (abs-ofNeg linarith) linarith
-                         | lem4 : abs (y - (b + d w1)) < d w1 => rewrite (abs-ofNeg linarith) linarith
-                         | b<=w2+1 : b <= w2 + 1 => linarith
-                         | w2<=b+d2 : w2 <= b + d w1 => linarith
-                   \in rewrite (meet_+-right,meet_+-right,meet_+-right) $ <_meet-univ (<_meet-univ (<_meet-univ (lem' w2<=b b<=w2+1 lem1 lem2) (lem' w2<=b+d2 b+d2<=w2+1 lem1 lem4)) (lem' w2<=b b<=w2+1 lem3 lem2)) (lem' w2<=b+d2 b+d2<=w2+1 lem3 lem4)))))
-
-        \lemma def : (\lam s => s.1 * s.2) = cover
-          => ext \lam s => later \peval s.1 * s.2
-      }
-
-    \lemma *-rat {x y : Rat} : x * y = {Real} x *' y
-      => (\peval x * y) *> lift2-rat
-
-    \lemma *-cover : CoverMap (ProductCoverSpace RealCoverSpace RealCoverSpace) RealCoverSpace (\lam s => s.1 * s.2)
-      => rewrite *.def *.cover
-
-    \lemma *_positive-char {x y : Real} (x>0 : x.L 0) (y>0 : y.L 0) {c d : Rat} : open-rat-int c d (x * y) <-> ∃ (a b a' b' : Rat) (0 < a) (0 < a') (open-rat-int a b x) (open-rat-int a' b' y) (c < a *' a') (b *' b' < d)
-      => rewrite (\peval x * y) $ <->trans (lift2-char c d) $ unfold
-          (\lam (inP (a',b',c1,d1,c2,d2,c<a',b'<d,c1<x,x<d1,c2<y,y<d2,h)) => \case L-rounded (real_join_L c1<x x>0), U-rounded x<d1, L-rounded (real_join_L c2<y y>0), U-rounded y<d2 \with {
-            | inP (c1',c1'<x,c1_0<c1'), inP (d1',x<d1',d1'<d1), inP (c2',c2'<y,c2_0<c2'), inP (d2',y<d2',d2'<d2) =>
-                inP (c1', d1', c2', d2', join-right <∘r c1_0<c1', join-right <∘r c2_0<c2', (c1'<x,x<d1'), (c2'<y,y<d2'),
-                     c<a' <∘ (h (join-left <∘r c1_0<c1', LU-less c1'<x x<d1) (join-left <∘r c2_0<c2', LU-less c2'<y y<d2)).1,
-                     (h (LU-less c1<x x<d1', d1'<d1) (LU-less c2<y y<d2', d2'<d2)).2 <∘ b'<d)
-          }, \lam (inP (a,b,a',b',a>0,a'>0,(a<x,x<b),(a'<y,y<b'),c<aa',bb'<d)) => \case isDense c<aa', isDense bb'<d \with {
-             | inP (c',c<c',c'<aa'), inP (d',bb'<d',d'<d) => inP (c', d', a, b, a', b', c<c', d'<d, a<x, x<b, a'<y, y<b', \lam (a<x',x'<b) (a'<y',y'<b') =>
-                 (c'<aa' <∘ <_*_positive-left a<x' a'>0 <∘ <_*_positive-right (a>0 <∘ a<x') a'<y',
-                  <_*_positive-left x'<b (a'>0 <∘ a'<y') <∘ <_*_positive-right (a>0 <∘ a<x' <∘ x'<b) y'<b' <∘ bb'<d'))
-           })
-
-    \lemma *_positive-L {x y : Real} (x>0 : x.L 0) (y>0 : y.L 0) {c : Rat} : LowerReal.L {x * y} c <-> ∃ (a a' : Rat) (0 < a) (0 < a') (x.L a) (y.L a') (c < a *' a')
-      => (\lam c<xy => \case U-inh {x * y} \with {
-            | inP (d,xy<d) => \case (*_positive-char x>0 y>0).1 (c<xy,xy<d) \with {
-              | inP (a,_,a',_,a>0,a'>0,(a<x,_),(a'<y,_),c<aa',_) => inP (a, a', a>0, a'>0, a<x, a'<y, c<aa')
-            }
-          }, \lam (inP (a,a',a>0,a'>0,a<x,a'<y,c<aa')) => \case x.U-inh, y.U-inh \with {
-            | inP (b,x<b), inP (b',y<b') => ((*_positive-char x>0 y>0 {c} {b *' b' + 1}).2 $ inP (a, b, a', b', a>0, a'>0, (a<x,x<b), (a'<y,y<b'), c<aa', linarith)).1
-          })
-
-    \lemma *_positive-U {x y : Real} (x>0 : x.L 0) (y>0 : y.L 0) {d : Rat} : UpperReal.U {x * y} d <-> ∃ (b b' : Rat) (x.U b) (y.U b') (b *' b' < d)
-      => (\lam xy<d => \case L-inh {x * y} \with {
-            | inP (c,c<xy) => \case (*_positive-char x>0 y>0).1 (c<xy,xy<d) \with {
-              | inP (_,b,_,b',_,_,(_,x<b),(_,y<b'),_,bb'<d) => inP (b, b', x<b, y<b', bb'<d)
-            }
-          }, \lam (inP (b,b',x<b,y<b',bb'<d)) => \case L-rounded x>0, L-rounded y>0 \with {
-            | inP (a,a<x,a>0), inP (a',a'<y,a'>0) => ((*_positive-char x>0 y>0 {a *' a' - 1} {d}).2 $ inP (a, b, a', b', a>0, a'>0, (a<x,x<b), (a'<y,y<b'), linarith, bb'<d)).2
-          })
-
-    \func pos-inv {x : Real} (x>0 : x.L 0) : Real \cowith
-      | L a => a <= 0 || x.U (finv a)
-      | L-inh => inP (0, byLeft <=-refl)
-      | L-closed {a} {b} p b<a => \case dec<_<= 0 b, \elim p \with {
-        | inl b>0, byLeft p => absurd linarith
-        | inl b>0, byRight p => byRight $ U-closed p $ finv_< b>0 b<a
-        | inr b<=0, _ => byLeft b<=0
-      }
-      | L-rounded {a} => \case dec<_<= a 0, __ \with {
-        | inl a<0, _ => inP (a *' ratio 1 2, byLeft linarith, linarith)
-        | inr a>=0, byLeft a<=0 => \case x.U-inh \with {
-          | inP (b,x<b) => inP (finv b, byRight $ transportInv x.U RatField.finv_finv x<b, rewrite (<=-antisymmetric a<=0 a>=0) $ finv>0 $ LU-less x>0 x<b)
-        }
-        | inr a>=0, byRight x<a1 => \case U-rounded x<a1 \with {
-          | inP (b,x<b,b<a1) => inP (finv b, byRight $ transportInv x.U RatField.finv_finv x<b, finv_<-right (LU-less x>0 x<b) b<a1)
-        }
-      }
-      | U a => \Sigma (0 < a) (x.L (finv a))
-      | U-inh => \case L-rounded x>0 \with {
-        | inP (a,a<x,a>0) => inP (finv a, (finv>0 a>0, transportInv x.L RatField.finv_finv a<x))
-      }
-      | U-closed (q>0,r) q<q' => (q>0 <∘ q<q', L-closed r $ finv_< q>0 q<q')
-      | U-rounded (q>0,q1<x) => \case L-rounded q1<x \with {
-        | inP (r,r<x,q1<r) => inP (finv r, (finv>0 $ finv>0 q>0 <∘ q1<r, transportInv x.L RatField.finv_finv r<x), finv_<-left q>0 q1<r)
-      }
-      | LU-disjoint p (q>0,r) => \case \elim p \with {
-        | byLeft p => p q>0
-        | byRight p => LU-disjoint r p
-      }
-      | LU-located {a} {b} a<b => \case dec<_<= 0 a \with {
-        | inl a>0 => \case x.LU-located (finv_< a>0 a<b) \with {
-          | byLeft p => byRight (a>0 <∘ a<b, p)
-          | byRight p => byLeft $ byRight p
-        }
-        | inr a<=0 => byLeft (byLeft a<=0)
-      }
-
-    \lemma pos-inv>0 {x : Real} (x>0 : x.L 0) : LowerReal.L {pos-inv x>0} 0
-      => byLeft <=-refl
-  }
\ No newline at end of file
diff --git a/src/Topology/CoverSpace/Subspace.ard b/src/Topology/CoverSpace/Subspace.ard
index 18243cf7..d531c9c5 100644
--- a/src/Topology/CoverSpace/Subspace.ard
+++ b/src/Topology/CoverSpace/Subspace.ard
@@ -47,7 +47,7 @@
         }
       }
 
-    \func func (X : CoverSpace) {S : Set X} (So : X.isOpen S) : CoverMap (OpenCoverSpace X So) X __.1 \cowith
+    \func func (X : CoverSpace) {S : Set X} (So : X.isOpen S) : PrecoverMap (OpenCoverSpace X So) X __.1 \cowith
       | func-cover Dc => makeBasicCover (byLeft Dc)
 
     \lemma <=<-conv (X : CoverSpace) {S : Set X} (So : X.isOpen S) {x' : Total S} {U' : Set (Total S)} (x'<=<U' : single x' <=< {OpenCoverSpace X So} U') : single x'.1 <=< extend U'
@@ -86,7 +86,7 @@
 
 \func OpenCompleteCoverSpace {X : CompleteCoverSpace} {S : Set X} (So : X.isOpen S) : CompleteCoverSpace (Total S) \cowith
   | SeparatedCoverSpace => Separated-char (OpenCoverSpace X So) 3 0 $ inP (X, func X So, \lam p => ext p)
-  | isCompleteCoverSpace F =>
+  | isComplete F =>
     \let | F' => cauchy-filter-extend X So F
          | x => X.filter-point F'
          | (inP (U', inP (U, inP (_, idp, U<=<S), U'=U), FU')) => isCauchyFilter {F} $ makeBasicCover $ byRight $ regular-closure-extends (regular-closure idp) idp
diff --git a/src/Topology/CoverSpace/TopSpace.ard b/src/Topology/CoverSpace/TopSpace.ard
index 7a50139c..ce66d108 100644
--- a/src/Topology/CoverSpace/TopSpace.ard
+++ b/src/Topology/CoverSpace/TopSpace.ard
@@ -14,7 +14,7 @@
     | inP (U,CU,V,_,Vx,V<=U) => inP (U, CU, V<=U Vx)
   }
   | cauchy-top x => inP (top, idp, top, open-top, (), <=-refl)
-  | cauchy-extend f e x => \case f x \with {
+  | cauchy-refine f e x => \case f x \with {
     | inP (U,CU,V,Vo,Vx,V<=U) => \case e CU \with {
       | inP (W,DW,U<=W) => inP (W, DW, V, Vo, Vx, \lam c => U<=W $ V<=U c)
     }
diff --git a/src/Topology/Locale.ard b/src/Topology/Locale.ard
index 76d6b42f..1a7655f2 100644
--- a/src/Topology/Locale.ard
+++ b/src/Topology/Locale.ard
@@ -1286,7 +1286,7 @@
       => f.surjective-split sur (f x)
   }
 
-\type isHausdorff (L : Locale) => generalized L (LocaleCat.Bprod L L) LocaleCat.proj1 LocaleCat.proj2
+\type isHausdorffLocale (L : Locale) => generalized L (LocaleCat.Bprod L L) LocaleCat.proj1 LocaleCat.proj2
   \where {
     \open CartesianPrecat
     \open FrameUPresCocompleteCat
@@ -1316,7 +1316,7 @@
                 \have m => colimit-univ _ $ Product.fromLimit.cone $ later \case __ \with { | 0 => id _ | 1 => id _ }
                 \in (meet-univ <=-refl <=-refl <=∘ locale_cover (map {m} k.2) <=∘ Join-univ (\lam _ => <=-refl)) <=∘ j.3)), _, cover-inj () idp) idp) idp
 
-    \lemma diagonal-isClosed {L : Locale} (h : isHausdorff L) : Nucleus.isClosed {FrameHom.image {diagonal L}}
+    \lemma diagonal-isClosed {L : Locale} (h : isHausdorffLocale L) : Nucleus.isClosed {FrameHom.image {diagonal L}}
       => \lam {U} => rewrite (diagonal_direct, diagonal_direct, diagonal_func, FrameHom.func-bottom {diagonal L}) $ closure<= $ later \lam j =>
           \have t => h j.1 j.2 U (j.3 <=∘ Join-univ (\lam k => Join-cond $ later (_, \lam {x} c => U.2 x (cover-trans c \lam (a,b,a<=k,b<=k) => run {
                        rewrite coneMap_finj at a<=k,
@@ -1331,13 +1331,13 @@
   }
 
 -- | Regular locales are Hausdorff
-\lemma regular_Hausdorff {L : Locale} (reg : L.isRegular) : isHausdorff L
+\lemma regular_Hausdorff {L : Locale} (reg : L.isRegular) : isHausdorffLocale L
   => generalized reg (LocaleCat.Bprod L L) LocaleCat.proj1 LocaleCat.proj2
   \where {
-    \open isHausdorff(extend)
+    \open isHausdorffLocale (extend)
     \open FrameHom
 
-    \lemma generalized {L : Locale} (reg : L.isRegular) (M : Locale) (p1 p2 : LocaleCat.Hom M L) : isHausdorff.generalized L M p1 p2
+    \lemma generalized {L : Locale} (reg : L.isRegular) (M : Locale) (p1 p2 : LocaleCat.Hom M L) : isHausdorffLocale.generalized L M p1 p2
       => \lam a b U p =>
          \have | lem1 {d x y : L} (p : d <=< x) (q : p1 (y ∧ x) ∧ p2 d <= extend p1 p2 U) : p1 y ∧ p2 d <= extend p1 p2 U
                  => meet-monotone (func-<= (meet-univ <=-refl (top-univ <=∘ later p) <=∘ ldistr>=) <=∘ func-Join>=) <=-refl <=∘ Join-rdistr>= <=∘ Join-univ (\case \elim __ \with {
diff --git a/src/Topology/MetricSpace.ard b/src/Topology/MetricSpace.ard
index e7817d39..56951176 100644
--- a/src/Topology/MetricSpace.ard
+++ b/src/Topology/MetricSpace.ard
@@ -1,86 +1,234 @@
-\import Algebra.Linear.Solver
+\import Algebra.Group
 \import Algebra.Monoid
 \import Algebra.Ordered
 \import Algebra.Pointed
-\import Algebra.Ring.Solver
 \import Arith.Real
 \import Function.Meta
 \import Logic
 \import Logic.Meta
 \import Meta
+\import Operations
 \import Order.Lattice
 \import Order.LinearOrder
 \import Order.PartialOrder
 \import Order.StrictOrder
 \import Paths
 \import Paths.Meta
+\import Set.Filter
 \import Set.Subset
 \import Topology.CoverSpace
 \import Topology.CoverSpace.Complete
+\import Topology.RatherBelow
+\import Topology.TopSpace
 \import Topology.UniformSpace
+\import Topology.UniformSpace.Complete
+\import Topology.UniformSpace.Product
 \open Bounded(top)
-\open RealAbGroup(half,half+half,half>0)
+\open RealAbGroup \hiding (+, join, meet, negative, zro<ide)
+\open PseudoMetricSpace \hiding (NFilter, isUniform)
 
 \class PseudoMetricSpace \extends UniformSpace, StronglyRegularCoverSpace {
   | dist : E -> E -> Real
   | dist-refl {x : E} : dist x x = zro
   | dist-symm {x y : E} : dist x y = dist y x
   | dist-triang {x y z : E} : dist x z <= dist x y + dist y z
+  | dist-uniform {C : Set (Set E)} : isUniform C <-> ∃ (eps : Real) (0 < eps) ∀ x ∃ (U : C) ∀ {y} (dist x y < eps -> U y)
 
-  | isUniform C => ∃ (eps : Real) (0 < eps) ∀ x ∃ (U : C) ∀ {y} (dist x y < eps -> U y)
-  | uniform-cover (inP (eps,eps>0,h)) x => \case h x \with {
-    | inP (U,CU,g) => inP (U, CU, g $ rewrite dist-refl eps>0)
-  }
-  | uniform-top => inP (3, inP (2, idp, -1, idp, idp), \lam x => inP (top, idp, \lam _ => ()))
-  | uniform-extend (inP (eps,eps>0,h)) e => inP (eps, eps>0, \lam x => \case h x \with {
-    | inP (U,CU,g) => \case e CU \with {
-      | inP (V,DV,U<=V) => inP (V, DV, \lam d => U<=V $ g d)
+  | uniform-cover Cu x => \case dist-uniform.1 Cu \with {
+    | inP (eps,eps>0,h) => \case h x \with {
+      | inP (U,CU,g) => inP (U, CU, g $ rewrite dist-refl eps>0)
     }
-  })
-  | uniform-inter (inP (eps,eps>0,h)) (inP (eps',eps'>0,h')) => inP (eps ∧ eps', LinearOrder.<_meet-univ eps>0 eps'>0, \lam x => \case h x, h' x \with {
-    | inP (U,CU,g), inP (U',DU',g') => inP (U ∧ U', inP (U, CU, U', DU', idp), \lam d => (g $ d <∘l meet-left, g' $ d <∘l meet-right))
-  })
-  | uniform-star (inP (eps,eps>0,h)) => inP (\lam V => \Sigma (∃ V) (∀ {x y : V} (dist x y < half eps)), inP (half (half eps), half>0 (half>0 eps>0), \lam x => inP (\lam y => dist x y < half (half eps), (inP (x, rewrite dist-refl (half>0 (half>0 eps>0))), \lam {z} p q => dist-triang {_} {z} {x} <∘r rewrite dist-symm (OrderedAddMonoid.<_+ p q <∘l Preorder.=_<= (half+half {half eps}))), \lam c => c)), \case __ \with {
-    | (inP (x,Vx),g) => \case h x \with {
-      | inP (U,CU,f) => inP (U, CU, \case __ \with {
-        | (inP (y,V'y),g') => \lam (z,(Vz,V'z)) => \lam {w} V'w => f $ dist-triang <∘r OrderedAddMonoid.<_+ (g Vx Vz) (g' V'z V'w) <∘l Preorder.=_<= half+half
-      })
-    }
-  })
-  | isStronglyRegular => ClosureCoverSpace.closure-regular {ClosurePrecoverSpace isUniform uniform-cover} StronglyRatherBelow $ later \case __ \with {
-    | inP (eps,eps>0,h) => ClosurePrecoverSpace.closure $ inP (half (half eps), half>0 (half>0 eps>0), \lam x => \case h x \with {
-      | inP (U,CU,f) => inP (\lam y => dist x y < half (half eps), inP (U, CU, ClosurePrecoverSpace.closure $ uniform-extend {_} {\lam U => ∃ (x : E) (U = \lam y => dist x y < half (half eps))} (inP (half (half eps), half>0 (half>0 eps>0), \lam x => inP (_, inP (x, idp), \lam r => r))) \lam {W} => \case __ \with {
-        | inP (y,p) => rewrite p \case real-located {dist x y} {half eps} {half eps + half (half eps)} (transport (RealAbGroup.`< _) zro-right $ <_+-right _ $ half>0 $ half>0 eps>0) \with {
+  }
+  | uniform-top => dist-uniform.2 $ inP (1, RealAbGroup.zro<ide, \lam x => inP (top, idp, \lam _ => ()))
+  | uniform-refine Cu e => \case dist-uniform.1 Cu \with {
+    | inP (eps,eps>0,h) => dist-uniform.2 $ inP (eps, eps>0, \lam x => \case h x \with {
+      | inP (U,CU,g) => \case e CU \with {
+        | inP (V,DV,U<=V) => inP (V, DV, \lam d => U<=V $ g d)
+      }
+    })
+  }
+  | uniform-inter Cu C'u => \case dist-uniform.1 Cu, dist-uniform.1 C'u \with {
+    | inP (eps,eps>0,h), inP (eps',eps'>0,h') => dist-uniform.2 $ inP (eps ∧ eps', LinearOrder.<_meet-univ eps>0 eps'>0, \lam x => \case h x, h' x \with {
+      | inP (U,CU,g), inP (U',DU',g') => inP (U ∧ U', inP $ later (U, CU, U', DU', idp), \lam d => (g $ d <∘l meet-left, g' $ d <∘l meet-right))
+    })
+  }
+  | uniform-star Cu => \case dist-uniform.1 Cu \with {
+    | inP (eps,eps>0,h) => inP (\lam V => \Sigma (∃ V) (∀ {x y : V} (dist x y < half eps)), dist-uniform.2 $ inP (half (half eps), half>0 (half>0 eps>0), \lam x => inP (\lam y => dist x y < half (half eps), later (inP (x, rewrite dist-refl (half>0 (half>0 eps>0))), \lam {z} p q => dist-triang {_} {z} {x} <∘r rewrite dist-symm (OrderedAddMonoid.<_+ p q <∘l Preorder.=_<= (half+half {half eps}))), \lam c => c)), \case __ \with {
+      | (inP (x,Vx),g) => \case h x \with {
+        | inP (U,CU,f) => inP (U, CU, \case __ \with {
+          | (inP (y,V'y),g') => \lam (z,(Vz,V'z)) => \lam {w} V'w => f $ dist-triang <∘r OrderedAddMonoid.<_+ (g Vx Vz) (g' V'z V'w) <∘l Preorder.=_<= half+half
+        })
+      }
+    })
+  }
+  | isStronglyRegular Cc => cauchy-subset (uniform-cauchy.2 $ ClosureCoverSpace.closure-regular {ClosurePrecoverSpace isUniform uniform-cover} StronglyRatherBelow (\case dist-uniform.1 __ \with {
+    | inP (eps,eps>0,h) => ClosurePrecoverSpace.closure $ dist-uniform.2 $ inP $ later (half (half eps), half>0 (half>0 eps>0), \lam x => \case h x \with {
+      | inP (U,CU,f) => inP (\lam y => dist x y < half (half eps), inP (U, CU, ClosurePrecoverSpace.closure $ uniform-refine {_} {\lam U => ∃ (x : E) (U = \lam y => dist x y < half (half eps))} (dist-uniform.2 $ inP (half (half eps), half>0 (half>0 eps>0), \lam x => inP $ later (_, inP (x, idp), \lam r => r))) \lam {W} => \case __ \with {
+        | inP (y,p) => rewrite p \case real-located {dist x y} {half eps} {half eps + half (half eps)} (transport (`< _) zro-right $ <_+-right _ $ half>0 $ half>0 eps>0) \with {
           | byLeft xy>1/2 => inP (_, byLeft idp, \lam {z} yz<1/4 => \lam xz<1/4 => <-irreflexive $ xy>1/2 <∘ (rewrite (half+half {half eps}) in dist-triang <∘r OrderedAddMonoid.<_+ xz<1/4 (rewrite dist-symm in yz<1/4)))
           | byRight xy<3/4 => inP (_, byRight idp, \lam {z} yz<1/4 => f $ dist-triang <∘r OrderedAddMonoid.<_+ xy<3/4 yz<1/4 <∘l Preorder.=_<= (+-assoc *> pmap (_ +) (half+half {half eps}) *> half+half))
         }
       }), \lam r => r)
     })
-  }
+  }) (uniform-cauchy.1 Cc)) \lam {V} (inP (U,CU,V<=<U)) => inP $ later (U, CU, uniform-cauchy.2 V<=<U)
 
-  \lemma dist>=0 {x y : E} : 0 <= dist x y
-    => \have t => rewrite (dist-refl,dist-symm) in dist-triang {_} {y} {x} {y}
-       \in \lam d => t $ OrderedAddMonoid.<_+ d d <∘l Preorder.=_<= zro-left
+  \default isUniform C : \Prop => ∃ (eps : Real) (0 < eps) ∀ x ∃ (U : C) ∀ {y} (dist x y < eps -> U y)
+  \default dist-uniform \as dist-uniform-impl {C} : isUniform C <-> _ => <->refl
 
-  \lemma makeUniform {eps : Real} (eps>0 : 0 < eps) : isUniform \lam U => ∃ (x : E) (U = \lam y => dist x y < eps)
-    => inP (eps, eps>0, \lam x => inP (_, inP (x, idp), \lam r => r))
+  \lemma halving {z x y : E} {eps : Real} (d1 : dist z x < half eps) (d2 : dist z y < half eps) : dist x y < eps
+    => dist-triang <∘r OrderedAddMonoid.<_+ (rewrite dist-symm in d1) d2 <∘l Preorder.=_<= half+half
 
-  \func OBall (eps : Real) (x : E) : Set E
-    => \lam y => dist x y < eps
+  \lemma makeUniform {eps : Real} (eps>0 : 0 < eps) : UniformSpace.isUniform \lam U => ∃ (x : E) (U = \lam y => dist x y < eps)
+    => dist-uniform.2 $ inP $ later (eps, eps>0, \lam x => inP (_, inP (x, idp), \lam r => r))
 
-  \func CBall (eps : Real) (x : E) : Set E
-    => \lam y => dist x y <= eps
+  \func NFilter (x : E) : SetFilter E \cowith
+    | F U => ∃ (eps : Real) (0 < eps) (OBall eps x ⊆ U)
+    | filter-mono p (inP (eps,eps>0,q)) => inP (eps, eps>0, q <=∘ p)
+    | filter-top => inP (1, RealAbGroup.zro<ide, \lam _ => ())
+    | filter-meet (inP (eps,eps>0,p)) (inP (eps',eps'>0,p')) => inP (eps ∧ eps', LinearOrder.<_meet-univ eps>0 eps'>0, \lam d => (p $ d <∘l meet-left, p' $ d <∘l meet-right))
 }
 
-\class LinearBaseRingData \extends LinearData, BaseRingData {
-  \override R : OrderedRing
-}
+\lemma dist>=0 {X : PseudoMetricSpace} {x y : X} : 0 <= dist x y
+  => \have t => rewrite (dist-refl,dist-symm) in dist-triang {_} {y} {x} {y}
+     \in \lam d => t $ OrderedAddMonoid.<_+ d d <∘l Preorder.=_<= zro-left
+
+\func OBall {X : PseudoMetricSpace} (eps : Real) (x : X) : Set X =>
+  \lam y => dist x y < eps
+
+\lemma OBall-center {X : PseudoMetricSpace} {eps : Real} (eps>0 : 0 < eps) {x : X} : OBall eps x x =>
+  transportInv (`< _) dist-refl eps>0
+
+\lemma OBall-open {X : PseudoMetricSpace} {eps : Real} {x : X} : isOpen (OBall eps x)
+  => cauchy-open.2 \lam {y} xy<eps => uniform-cauchy.2 $ ClosurePrecoverSpace.closure $ uniform-refine (X.makeUniform $ half>0 {eps - dist x y} $ transport (`< _) negative-right $ <_+-left (negative (dist x y)) xy<eps) \lam {_} (inP (z,idp)) => inP (_, later \lam d {w} e => dist-triang <∘r <_+-right (dist x y) (X.halving d e) <∘l Preorder.=_<= (+-comm *> +-assoc *> pmap (eps +) negative-left *> zro-right), <=-refl)
+
+\lemma dist_open {X : PseudoMetricSpace} {U : Set X} : isOpen U <-> ∀ {x : U} ∃ (eps : Real) (0 < eps) (OBall eps x ⊆ U)
+  => (\lam Uo {x} Ux => \case cauchy-ball (cauchy-open.1 Uo Ux) x \with {
+    | inP (eps,eps>0,V,h,p) => inP (eps, eps>0, p <=∘ h (p $ OBall-center eps>0))
+  }, \lam f => X.cover-open \lam Ux => \case f Ux \with {
+    | inP (eps,eps>0,h) => inP (_, OBall-open, OBall-center eps>0, h)
+  })
+
+\lemma cauchy-ball {X : PseudoMetricSpace} {C : Set (Set X)} (Cc : isCauchy C) (x : X) : ∃ (eps : Real) (0 < eps) (U : C) (OBall eps x ⊆ U)
+  => \case ClosurePrecoverSpace.closure-filter (X.NFilter x) (\lam {D} Du => \case dist-uniform.1 Du \with {
+    | inP (eps,eps>0,h) => \case h x \with {
+      | inP (U,DU,p) => inP (U, DU, inP (eps, eps>0, p __))
+    }
+  }) (uniform-cauchy.1 Cc) \with {
+    | inP (U, CU, inP (eps,eps>0,p)) => inP (eps, eps>0, U, CU, p)
+  }
+
+\lemma <=<-ball {X : PseudoMetricSpace} {x : X} {U : Set X} (x<=<U : single x <=< U) : ∃ (eps : Real) (0 < eps) (OBall eps x ⊆ U)
+  => \case cauchy-ball (unfolds in x<=<U) x \with {
+    | inP (eps,eps>0,V,h,p) => inP (eps, eps>0, p <=∘ h (x, (idp, p $ OBall-center eps>0)))
+  }
+
+\lemma OBall_<=* {X : PseudoMetricSpace} {x : X} {eps delta : Real} (delta<eps : delta < eps) : OBall delta x <=* OBall eps x
+  => inP (_, makeUniform $ half>0 $ transport (`< _) negative-right $ <_+-left (negative delta) delta<eps,
+          \lam {y} (inP (_, (inP (z,idp), (w,(xw<delta,zw<eps-delta))), zy<eps-delta)) => transport (_ <) (+-comm *> +-assoc *> pmap (eps +) negative-left *> zro-right) $ dist-triang <∘r OrderedAddMonoid.<_+ xw<delta (halving zw<eps-delta zy<eps-delta))
 
 \class MetricSpace \extends PseudoMetricSpace, SeparatedCoverSpace
   | dist-ext {x y : E} : dist x y = zro -> x = y
-  | isSeparatedCoverSpace {x} {y} f => dist-ext $ <=-antisymmetric (\lam d>0 => \case f (ClosurePrecoverSpace.closure $ makeUniform {\this} {half (dist x y)} (half>0 d>0)) \with {
+  | isSeparatedCoverSpace {x} {y} f => dist-ext $ <=-antisymmetric (\lam d>0 => \case f (uniform-cauchy.2 $ ClosurePrecoverSpace.closure $ makeUniform (half>0 d>0)) \with {
     | inP (U, inP (z,p), (Ux,Uy)) =>
-      \have | U'x => rewrite (p,dist-symm) Ux
+      \have | U'x => rewrite p Ux
             | U'y => rewrite p Uy
-      \in <-irreflexive $ rewrite half+half in dist-triang <∘r OrderedAddMonoid.<_+ U'x U'y
-  }) dist>=0
\ No newline at end of file
+      \in <-irreflexive (halving U'x U'y)
+  }) dist>=0
+
+\record LocallyUniformMetricMap \extends LocallyUniformMap {
+  \override Dom : PseudoMetricSpace
+  \override Cod : PseudoMetricSpace
+
+  | func-dist-locally-uniform : ∀ {eps : Real} (0 < eps) ∃ (delta : Real) (0 < delta) ∀ (x0 : Dom) ∃ (gamma : Real) (0 < gamma) ∀ {x x' : Dom} (dist x0 x < delta -> dist x x' < gamma -> dist (func x) (func x') < eps)
+  | func-locally-uniform Eu => \case dist-uniform.1 Eu \with {
+    | inP (eps,eps>0,h) => \case func-dist-locally-uniform eps>0 \with {
+      | inP (delta,delta>0,g) => inP (_, makeUniform delta>0, \lam (inP (x0,p)) => \case g x0 \with {
+        | inP (gamma,gamma>0,g') => dist-uniform.2 $ inP (gamma, gamma>0, \lam x => \case h (func x) \with {
+          | inP (W,EW,e) => inP (\lam x' => dist x x' < gamma, inP $ later (W, EW, \lam {x'} c => e $ rewrite dist-symm $ g' (rewrite p in c.1) $ rewrite dist-symm c.2), \lam d => d)
+        })
+      })
+    }
+  }
+} \where {
+  \lemma fromLocallyUniformMap {X Y : PseudoMetricSpace} (f : LocallyUniformMap X Y) : LocallyUniformMetricMap X Y f \cowith
+    | func-dist-locally-uniform eps>0 => \case f.func-locally-uniform (makeUniform $ half>0 eps>0) \with {
+      | inP (C,Cu,h) => \case dist-uniform.1 Cu \with {
+        | inP (delta,delta>0,g) => inP (half delta, half>0 delta>0, \lam x0 => \case g x0 \with {
+          | inP (U,CU,e) => \case dist-uniform.1 (h CU) \with {
+            | inP (gamma,gamma>0,g') => inP (gamma ∧ half delta, LinearOrder.<_meet-univ gamma>0 (half>0 delta>0), \lam {x} {x'} d1 d2 => \case g' x \with {
+              | inP (V, inP (W, inP (y, q), p), r) => rewrite q at p $ halving (p (e $ d1 <∘ half<id delta>0, r $ rewrite dist-refl gamma>0)) (p (e $ halving (rewrite dist-symm in d1) $ d2 <∘l meet-right, r $ d2 <∘l meet-left))
+            })
+          }
+        })
+      }
+    }
+
+  \lemma makeLocallyUniformMap2 {X Y Z : PseudoMetricSpace} (f : X -> Y -> Z) (fc : ∀ {eps : Real} (0 < eps) ∃ (delta : Real) (0 < delta) ∀ x0 y0 ∃ (gamma : Real) (0 < gamma) ∀ {x x'} {y y'} (dist x0 x < delta -> dist y0 y < delta -> dist x x' < gamma -> dist y y' < gamma -> dist (f x y) (f x' y') < eps))
+    : LocallyUniformMap (X ⨯ Y) Z (\lam s => f s.1 s.2) \cowith
+    | func-locally-uniform Eu => \case dist-uniform.1 Eu \with {
+      | inP (eps,eps>0,h) => \case fc eps>0 \with {
+        | inP (delta,delta>0,g) => inP (_, ProductUniformSpace.prodCover (makeUniform delta>0) (makeUniform delta>0), \lam {_} (inP (_, inP (x0,idp), _, inP (y0,idp), idp)) => \case g x0 y0 \with {
+          | inP (gamma,gamma>0,g') => inP (_, makeUniform gamma>0, _, makeUniform gamma>0, \lam {_} (inP (_, inP (x,idp), _, inP (y,idp), idp)) => \case h (f x y) \with {
+            | inP (W,EW,e) => inP (\lam s => \Sigma (dist x s.1 < gamma) (dist y s.2 < gamma), inP (W, EW, \lam {s} (c,d) => e $ rewrite dist-symm $ g' c.1 c.2 (rewrite dist-symm d.1) (rewrite dist-symm d.2)), \lam d => d)
+          })
+        })
+      }
+    }
+}
+
+\record UniformMetricMap \extends LocallyUniformMetricMap, UniformMap {
+  \override Dom : PseudoMetricSpace
+  \override Cod : PseudoMetricSpace
+
+  | func-dist-uniform : ∀ {eps : Real} (0 < eps) ∃ (delta : Real) (0 < delta) ∀ {x x' : Dom} (dist x x' < delta -> dist (func x) (func x') < eps)
+  | func-dist-locally-uniform eps>0 => \case func-dist-uniform eps>0 \with {
+    | inP (delta,delta>0,h) => inP (delta, delta>0, \lam x0 => inP (delta, delta>0, \lam _ => h))
+  }
+  | func-uniform Eu => \case dist-uniform.1 Eu \with {
+    | inP (eps,eps>0,h) => \case func-dist-uniform eps>0 \with {
+      | inP (delta,delta>0,g) => dist-uniform.2 $ inP (delta, delta>0, \lam x => \case h (func x) \with {
+        | inP (U,EU,e) => inP (_, inP $ later (U, EU, idp), \lam d => e (g d))
+      })
+    }
+  }
+} \where {
+  \lemma fromUniformMap {X Y : PseudoMetricSpace} (f : UniformMap X Y) : UniformMetricMap X Y f \cowith
+    | func-dist-uniform eps>0 => \case dist-uniform.1 $ f.func-uniform (makeUniform $ half>0 eps>0) \with {
+      | inP (delta,delta>0,h) => inP (delta, delta>0, \lam {x} d => \case h x \with {
+        | inP (U, inP (V, inP (y, q), p), g) => rewrite (p,q) at g $ halving (g $ rewrite dist-refl delta>0) (g d)
+      })
+    }
+}
+
+\record MetricMap \extends UniformMetricMap
+  | func-dist {x y : Dom} : dist (func x) (func y) <= dist x y
+  | func-dist-uniform {eps} eps>0 => inP (eps, eps>0, \lam d => func-dist <∘r d)
+  | func-cont {U} => defaultImpl PrecoverMap func-cont {_} {U}
+
+\record IsometricMap \extends MetricMap {
+  | func-isometry {x y : Dom} : dist (func x) (func y) = dist x y
+  | func-dist => Preorder.=_<= func-isometry
+
+  \lemma dense->uniformEmbedding (d : IsDense) : UniformMap.IsDenseEmbedding
+    => (d, \lam Cu => \case dist-uniform.1 Cu \with {
+      | inP (eps,eps>0,h) => dist-uniform.2 $ inP (half eps, half>0 eps>0, \lam y => \case d {y} OBall-open (OBall-center (half>0 eps>0)) \with {
+        | inP (_, inP (x,idp), yfx<eps/2) => \case h x \with {
+          | inP (U,CU,g) => inP (OBall (half eps) y, inP $ later (U, CU, \lam {x'} yfx'<eps/2 => g $ rewrite func-isometry in halving yfx<eps/2 yfx'<eps/2), \lam d => d)
+        }
+      })
+    })
+}
+
+\class CompleteMetricSpace \extends MetricSpace, CompleteUniformSpace
+
+\lemma cauchyFilter-metric-char {X : PseudoMetricSpace} {F : SetFilter X} : ∀ {C : isCauchy} ∃ (U : C) (F U) <->
+  (\Pi {eps : Real} -> 0 < eps -> ∃ (x : X) (F (OBall eps x)))
+  => <->trans cauchyFilter-uniform-char $ later (\lam f eps>0 => \case f $ makeUniform eps>0 \with {
+    | inP (_, inP (x, idp), FB) => inP (x, FB)
+  }, \lam f Cu => \case dist-uniform.1 Cu \with {
+    | inP (eps,eps>0,h) => \case f eps>0 \with {
+      | inP (x,FB) => \case h x \with {
+        | inP (U,CU,g) => inP (U, CU, filter-mono (g __) FB)
+      }
+    }
+  })
\ No newline at end of file
diff --git a/src/Topology/NormedAbGroup.ard b/src/Topology/NormedAbGroup.ard
new file mode 100644
index 00000000..f823a3cc
--- /dev/null
+++ b/src/Topology/NormedAbGroup.ard
@@ -0,0 +1,103 @@
+\import Algebra.Group
+\import Algebra.Group.Category
+\import Algebra.Ordered
+\import Arith.Real
+\import Function.Meta
+\import Logic
+\import Logic.Meta
+\import Meta
+\import Order.LinearOrder
+\import Order.PartialOrder
+\import Order.StrictOrder
+\import Paths
+\import Paths.Meta
+\import Set.Subset
+\import Topology.CoverSpace
+\import Topology.MetricSpace
+\import Topology.TopAbGroup
+\import Topology.UniformSpace
+\import Topology.UniformSpace.Product
+
+\class PseudoNormedAbGroup \extends PseudoMetricSpace, TopAbGroup {
+  | norm : E -> Real
+  | norm_zro : norm zro = (0 : Real)
+  | norm_negative {x : E} : norm (negative x) = norm x
+  | norm_+ {x y : E} : norm (x + y) <= norm x RealAbGroup.+ norm y
+  | norm-dist {x y : E} : dist x y = norm (x - y)
+
+  | +-cont => \new UniformMap (ProductUniformSpace \this \this) \this {
+    | func s => s.1 + s.2
+    | func-uniform Eu => \case dist-uniform.1 Eu \with {
+      | inP (eps,eps>0,h) => inP (_, makeUniform (RealAbGroup.half>0 eps>0), _, makeUniform (RealAbGroup.half>0 eps>0),
+        \lam (inP (_, inP (x,idp), _, inP (y,idp), p)) => \case h (x + y) \with {
+          | inP (V,EV,g) => inP (_, inP (V, EV, idp), rewrite p \lam {(x',y')} (xx'<eps/2,yy'<eps/2) =>
+              \have lem : x - x' + (y - y') = x + y - (x' + y') => +-assoc *> pmap (x +) (+-comm *> +-assoc *> pmap (y +) (inv negative_+)) *> inv +-assoc
+              \in g $ transport (_ <) RealAbGroup.half+half $ later (repeat {3} (rewrite norm-dist) $ transport (norm __ <= _) lem norm_+) <∘r OrderedAddMonoid.<_+ xx'<eps/2 yy'<eps/2)
+        })
+    }
+  }
+  | negative-cont => \new MetricMap {
+    | func-dist => rewrite (norm-dist, norm-dist, inv norm_negative, +-comm) $ simplify <=-refl
+  }
+  | neighborhood-uniform =>
+    \have lem {x} {y} : dist 0 (x - y) = dist x y => norm-dist *> inv norm_negative *> pmap norm simplify *> inv norm-dist
+    \in (\lam Cu => \case dist-uniform.1 Cu \with {
+           | inP (eps,eps>0,h) => inP (OBall eps 0, OBall-open, OBall-center eps>0, \lam x => \case h x \with {
+             | inP (U,CU,g) => inP (U, CU, \lam d => g $ transport (`< _) lem d)
+           })
+         }, \lam (inP (U,Uo,U0,h)) => \case dist_open.1 Uo U0 \with {
+           | inP (eps,eps>0,p) => dist-uniform.2 $ inP (eps, eps>0, \lam x => \case h x \with {
+             | inP (U,CU,g) => inP (U, CU, \lam d => g $ p $ transportInv (`< _) lem d)
+           })
+         })
+  | open-top => defaultImpl PrecoverSpace open-top
+  | open-inter {U} {V} => defaultImpl PrecoverSpace open-inter {_} {U} {V}
+  | open-Union {S} => defaultImpl PrecoverSpace open-Union {_} {S}
+  | dist-refl => norm-dist *> pmap norm negative-right *> norm_zro
+  | dist-symm => norm-dist *> simplify *> norm_negative *> inv norm-dist
+  | dist-triang => repeat {3} (rewrite norm-dist) $ transport (norm __ <= _) simplify norm_+
+
+  \default dist x y : Real => norm (x - y)
+  \default norm-dist \as norm-dist-impl {x} {y} : dist x y = norm (x - y) => idp
+}
+
+\class NormedAbGroup \extends PseudoNormedAbGroup, MetricSpace
+  | norm-ext {x : E} : norm x = (0 : Real) -> x = zro
+  | dist-ext p => fromZero $ norm-ext $ inv norm-dist *> p
+
+\lemma norm_dist {X : PseudoNormedAbGroup} {x : X} : norm x = dist 0 x
+  => inv norm_negative *> simplify *> inv norm-dist
+
+\record UniformNormedAbGroupMap \extends UniformMetricMap, TopAbGroupMap {
+  \override Dom : PseudoNormedAbGroup
+  \override Cod : PseudoNormedAbGroup
+
+  | func-norm-uniform : ∀ {eps : Real} (0 < eps) ∃ (delta : Real) (0 < delta) ∀ {x : Dom} (norm x < delta -> norm (func x) < eps)
+  | func-dist-uniform eps>0 => \case func-norm-uniform eps>0 \with {
+    | inP (delta,delta>0,h) => inP (delta, delta>0, unfold \lam d => rewrite (norm-dist, inv AddGroupHom.func-minus) $ h $ rewriteI norm-dist d)
+  }
+
+  \default func-norm-uniform eps>0 => \case dist_open.1 (func-cont OBall-open) $ rewrite func-zro $ OBall-center eps>0 \with {
+    | inP (delta,delta>0,h) => inP (delta, delta>0, \lam d => rewrite (norm_dist, inv func-zro) $ h $ rewrite norm_dist in d)
+  }
+}
+
+\record NormedAbGroupMap \extends UniformNormedAbGroupMap, MetricMap {
+  \override Dom : PseudoNormedAbGroup
+  \override Cod : PseudoNormedAbGroup
+
+  | func-norm {x : Dom} : norm (func x) <= norm x
+  | func-norm-uniform {eps} eps>0 => inP (eps, eps>0, \lam d => func-norm <∘r d)
+  | func-dist => unfold $ rewrite (norm-dist, norm-dist, inv AddGroupHom.func-minus) func-norm
+}
+
+\record NormedIsometricMap \extends NormedAbGroupMap, IsometricMap {
+  \override Dom : PseudoNormedAbGroup
+  \override Cod : PseudoNormedAbGroup
+
+  | func-norm-isometry {x : Dom} : norm (func x) = norm x
+  | func-norm => Preorder.=_<= func-norm-isometry
+  | func-isometry => norm-dist *> pmap norm (inv func-minus) *> func-norm-isometry *> inv norm-dist
+}
+
+\class CompleteNormedAbGroup \extends NormedAbGroup, CompleteMetricSpace
diff --git a/src/Topology/NormedAbGroup/Real.ard b/src/Topology/NormedAbGroup/Real.ard
new file mode 100644
index 00000000..05026511
--- /dev/null
+++ b/src/Topology/NormedAbGroup/Real.ard
@@ -0,0 +1,148 @@
+\import Algebra.Group
+\import Algebra.Meta
+\import Algebra.Monoid
+\import Algebra.Ordered
+\import Arith.Rat
+\import Arith.Real
+\import Function.Meta
+\import Logic
+\import Logic.Meta
+\import Meta
+\import Operations
+\import Order.Lattice
+\import Order.LinearOrder
+\import Order.PartialOrder
+\import Order.StrictOrder
+\import Paths
+\import Paths.Meta
+\import Set.Filter
+\import Set.Subset
+\import Topology.CoverSpace
+\import Topology.CoverSpace.Complete
+\import Topology.CoverSpace.Product
+\import Topology.MetricSpace
+\import Topology.NormedAbGroup
+\import Topology.RatherBelow
+\import Topology.UniformSpace
+\open LinearlyOrderedAbGroup
+\open RealNormed
+\open ProductCoverSpace
+\open OrderedAbGroup
+
+\instance RatNormed : NormedAbGroup
+  | AbGroup => RatField
+  | norm a => abs a
+  | norm_zro => pmap Real.fromRat abs_zro
+  | norm_negative => pmap Real.fromRat abs_negative
+  | norm_+ => transportInv (_ <=) RealAbGroup.+-rat $ rat_real_<=.1 abs_+
+  | norm-ext p => abs_zro-ext $ Real.fromRat-inj p
+
+\instance RealNormed : CompleteNormedAbGroup
+  | NormedAbGroup => RealNormedAbGroup
+  | isComplete => dense-complete (rat_real.dense, rat_real.embedding->coverEmbedding (rat_real.dense->uniformEmbedding rat_real.dense).2)
+      \lam F => inP (fromCF F, \lam {U} => \case <=<-ball __ \with {
+        | inP (eps,eps>0,p) =>
+          \let | x => fromCF F
+               | (inP (a, x-eps<a, inP (y1,eps1,eps1>0,Fy1,a<y1-eps1))) => (real_<-char {x - eps} {x}).1 $ transport (_ <) zro-right $ <_+-right x $ RealAbGroup.positive_negative eps>0
+               | (inP (b, inP (y2,eps2,eps2>0,Fy2,y2+eps2<b), b<x+eps)) => (real_<-char {x} {x + eps}).1 $ transport {Real} (`< _) zro-right $ <_+-right x eps>0
+          \in filter-mono ((later \lam {z} (|y1-z|<eps1,|y2-z|<eps2) => abs_-_<
+            (RealAbGroup.<-diff-left $ real_<_U.2 x-eps<a <∘ real_<_L.2 (linarith $ abs>=id <∘r real_<_L.1 (transport (`< _) norm-dist |y1-z|<eps1)))
+            (RealAbGroup.<-diff-mid-conv $ rewrite +-comm $ real_<_L.2 (linarith $ RatField.abs>=neg {y2 - z} <∘r real_<_L.1 (transport (`< _) norm-dist |y2-z|<eps2)) <∘ real_<_L.2 b<x+eps)) <=∘ ^-1_<= rat_real p) (filter-meet Fy1 Fy2)
+      })
+  \where {
+    \func RealNormedAbGroup : NormedAbGroup \cowith
+      | AbGroup => RealAbGroup
+      | norm => abs
+      | norm_zro => abs_zro
+      | norm_negative => abs_negative
+      | norm_+ => abs_+
+      | norm-ext => abs_zro-ext
+
+    \func fromCF (F : RegularCauchyFilter RatNormed) : Real \cowith
+      | L a => ∃ (x eps : Rat) (0 < eps) (F (OBall eps x)) (a < x - eps)
+      | L-inh => \case cauchyFilter-metric-char.1 F.isCauchyFilter {1} RealAbGroup.zro<ide \with {
+        | inP (x,FB) => inP (x - 2, inP (x, 1, idp, FB, linarith))
+      }
+      | L-closed (inP (x,eps,eps>0,FB,q<x-eps)) q'<q => inP (x, eps, eps>0, FB, q'<q <∘ q<x-eps)
+      | L-rounded {a} (inP (x,eps,eps>0,FB,a<x-eps)) => inP (RatField.mid a (x - eps), inP (x, eps, eps>0, FB, RatField.mid<right a<x-eps), RatField.mid>left a<x-eps)
+      | U b => ∃ (x eps : Rat) (0 < eps) (F (OBall eps x)) (x + eps < b)
+      | U-inh => \case cauchyFilter-metric-char.1 F.isCauchyFilter {1} RealAbGroup.zro<ide \with {
+        | inP (x,FB) => inP (x + 2, inP (x, 1, idp, FB, linarith))
+      }
+      | U-closed (inP (x,eps,eps>0,FB,x+eps<q)) q<q' => inP (x, eps, eps>0, FB, x+eps<q <∘ q<q')
+      | U-rounded {a} (inP (x,eps,eps>0,FB,x+eps<a)) => inP (RatField.mid (x + eps) a, inP (x, eps, eps>0, FB, RatField.mid>left x+eps<a), RatField.mid<right x+eps<a)
+      | LU-disjoint (inP (x,eps,eps>0,Feps,q<x-eps)) (inP (y,delta,delta>0,Fdelta,x+eps<q)) => \case F.isProper (F.filter-meet Feps Fdelta) \with {
+        | inP (z,(|x-z|<eps,|y-z|<delta)) =>
+          \have | t => abs>=id <∘r real_<_L.1 (transport (`< _) norm-dist |x-z|<eps)
+                | s => RatField.abs>=neg {y - z} <∘r real_<_L.1 (transport (`< _) norm-dist |y-z|<delta)
+          \in linarith
+      }
+      | LU-focus eps eps>0 => \case cauchyFilter-metric-char.1 F.isCauchyFilter {eps * ratio 1 4} (real_<_L.2 linarith) \with {
+        | inP (x,FB) => inP (x - eps * ratio 1 2, inP (x, _, linarith, FB, linarith), inP (x, _, linarith, FB, linarith))
+      }
+  }
+
+\func rat_real : NormedIsometricMap RatNormed RealNormedAbGroup Real.fromRat \cowith
+  | func-+ => inv RealAbGroup.+-rat
+  | func-norm-isometry => inv rat_real_abs
+  \where {
+    \lemma dense : rat_real.IsDense
+      => \lam {y} {U} Uo Uy => \case (dist_open {RealNormedAbGroup} {U}).1 Uo Uy \with {
+        | inP (eps,eps>0,p) => \case real_<-char.1 $ transport (`< _) zro-right $ <_+-right y eps>0 \with {
+          | inP (x,y<x,x<y+eps) => inP (x, inP (x, idp), p $ unfold OBall $ rewrite norm-dist $ abs_-_< (transport (_ <) negative-right (RealAbGroup.<_+-left _ $ real_<_U.2 y<x) <∘ eps>0) $ transport2 (<) +-comm (inv +-assoc *> pmap (`+ _) negative-left *> zro-left) $ <_+-right (negative y) $ real_<_L.2 x<y+eps)
+        }
+      }
+
+    \lemma dense-coverEmbedding : CoverMap.IsDenseEmbedding {rat_real}
+      => (dense, rat_real.embedding->coverEmbedding (rat_real.dense->uniformEmbedding dense).2)
+  }
+
+\func open-rat-int (a b : Rat) : Set Real
+  => \lam (x : Real) => \Sigma (x.L a) (x.U b)
+
+\lemma dense-lift-real-char {X Y : CoverSpace} {f : CoverMap X Y} (fd : f.IsDenseEmbedding) {g : CoverMap X RealNormed} (y : Y) (a b : Rat)
+  : open-rat-int a b (dense-lift f fd g y) <-> ∃ (a' b' : Rat) (a < a') (b' < b) (V : Set Y) (f ^-1 V ⊆ g ^-1 open-rat-int a' b') (single y <=< V)
+  => (\lam (a<z,z<b) => \case L-rounded a<z, U-rounded z<b \with {
+    | inP (a',a'<z,a<a'), inP (b',z<b',b'<b) => \case (dense-lift-neighborhood fd y (open-rat-int a' b')).1 (point_<=< a'<z z<b') \with {
+      | inP (W,W<=<a'b',V,q,y<=<V) => inP (a', b', a<a', b'<b, V, q <=∘ <=<_<= (<=<_^-1 W<=<a'b'), y<=<V)
+    }
+  }, \lam (inP (a',b',a<a',b'<b,V,h,y<=<V)) => <=<_<= ((dense-lift-neighborhood fd y (\lam x => open-rat-int a b x)).2 $ inP (open-rat-int a' b', <=<_open-rat-int a<a' b'<b, V, h, y<=<V)) idp)
+  \where {
+    \open ClosurePrecoverSpace
+
+    \lemma makeRealCover (eps : Rat) (eps>0 : 0 < eps) : RealNormed.isCauchy \lam U => ∃ (a : Rat) (U = open-rat-int a (a + eps))
+      => uniform-cauchy.2 $ closure $ dist-uniform.2 $ inP (eps * ratio 1 4, real_<_L.2 linarith, \lam x => later \case (real_<-char {x - eps * ratio 1 2} {x - eps * ratio 1 4}).1 $ <_+-right x $ RealAbGroup.negative_< $ real_<_L.2 linarith \with {
+        | inP (a,x-eps/2<a,a<x-eps/4) => inP (_, inP (a, idp), \lam d => (
+            real_<_L.1 $ real_<_L.2 a<x-eps/4 <∘ RealAbGroup.<-diff-left (abs>=id <∘r (rewrite norm-dist in d)),
+            real_<_U.1 $ RealAbGroup.<-diff-mid (simplify in abs>=neg <∘r (rewrite norm-dist in d)) <∘
+              <_+-right _ (RealAbGroup.<-diff-mid (real_<_U.2 x-eps/2<a)) <∘ rewrite (RealAbGroup.+-rat,RealAbGroup.+-rat) (real_<_L.2 linarith)))
+      })
+
+    \lemma <=<_open-rat-int {a b a' b' : Rat} (a<a' : a < a') (b'<b : b' < b) : open-rat-int a' b' <=< open-rat-int a b
+      => closure-subset (makeRealCover ((a' - a) ∧ (b - b')) $ LinearOrder.<_meet-univ linarith linarith) \lam {U} (inP (c,p)) => rewrite p $ later \lam (e : Real, ((a'<e,e<b'),(c<e,e<c+eps))) (c<x,x<c+eps) => (L-closed c<x $ linarith (e.LU-less a'<e e<c+eps <∘l RatField.<=_+ <=-refl meet-left), U-closed x<c+eps $ RatField.<=_+ <=-refl meet-right <∘r linarith (e.LU-less c<e e<b'))
+
+    \lemma point_<=< {x : Real} {a b : Rat} (a<x : x.L a) (x<b : x.U b) : single x <=< open-rat-int a b
+      => \case x.L-rounded a<x, x.U-rounded x<b \with {
+        | inP (a',a'<x,a<a'), inP (b',x<b',b'<b) => <=<-right (later \lam p => rewriteI p (a'<x,x<b')) (<=<_open-rat-int a<a' b'<b)
+      }
+  }
+
+\lemma <=<-open-int {x : Real} {U : Set Real} (p : single x <=< U) : ∃ (a b : Rat) (x.L a) (x.U b) ∀ (y : Real) (y.L a -> y.U b -> U y)
+  => \case <=<-ball p \with {
+    | inP (eps,eps>0,q) => \case (real_<-char {x - eps} {x}).1 $ transport (_ <) zro-right $ <_+-right x $ RealAbGroup.positive_negative eps>0, (real_<-char {x} {x + eps}).1 $ transport (`< _) zro-right $ <_+-right x eps>0 \with {
+      | inP (a,x-eps<a,a<x), inP (b,x<b,b<x+eps) => inP (a, b, a<x, x<b, \lam y a<y y<b => q $ transportInv (`< _) norm-dist $ abs_-_< (RealAbGroup.<-diff-left $ real_<_U.2 x-eps<a <∘ real_<_L.2 a<y) $ RealAbGroup.<-diff-mid-conv $ rewrite +-comm $ real_<_U.2 y<b <∘ real_<_L.2 b<x+eps)
+    }
+  }
+
+\func real-lift2 {X : CompleteCoverSpace} (f : CoverMap (RatNormed ⨯ RatNormed) X) : CoverMap (RealNormed ⨯ RealNormed) X
+  => dense-lift (prod rat_real rat_real) (prod.isDenseEmbedding rat_real.dense-coverEmbedding rat_real.dense-coverEmbedding) f
+
+\lemma real-lift2-char {f : CoverMap (RatNormed ⨯ RatNormed) RealNormed} {x y : Real} (a b : Rat)
+  : open-rat-int a b (real-lift2 f (x,y)) <-> ∃ (a' b' c1 d1 c2 d2 : Rat) (a < a') (b' < b) (x.L c1) (x.U d1) (y.L c2) (y.U d2) (\Pi {x y : Rat} -> \Sigma (c1 < x) (x < d1) -> \Sigma (c2 < y) (y < d2) -> open-rat-int a' b' (f (x,y)))
+  => <->trans (dense-lift-real-char {RatNormed ⨯ RatNormed} {_} {prod rat_real rat_real} (prod.isDenseEmbedding rat_real.dense-coverEmbedding rat_real.dense-coverEmbedding) (x,y) a b) $ later
+      (\lam (inP (a',b',a<a',b'<b,V,q,xy<=<V)) => \case prod-neighborhood xy<=<V \with {
+        | inP (U,V,x<=<U,y<=<V,h) => \case <=<-open-int x<=<U, <=<-open-int y<=<V \with {
+          | inP (c1,d1,c1<x,x<d1,p1), inP (c2,d2,c2<y,y<d2,p2) => inP (a', b', c1, d1, c2, d2, a<a', b'<b, c1<x, x<d1, c2<y, y<d2, \lam {x'} {y'} (c1<x',x'<d1) (c2<y',y'<d2) => q $ h (p1 x' c1<x' x'<d1) (p2 y' c2<y' y'<d2))
+        }
+      }, \lam (inP (a',b',c1,d1,c2,d2,a<a',b'<b,c1<x,x<d1,c2<y,y<d2,q)) => inP (a', b', a<a', b'<b, \lam z => \Sigma (open-rat-int c1 d1 z.1) (open-rat-int c2 d2 z.2),
+          \lam s => q s.1 s.2, RatherBelow.<=<_meet-same (<=<-right (later \lam s => pmap __.1 s) $ <=<_^-1 {_} {_} {proj1} $ dense-lift-real-char.point_<=< c1<x x<d1) (<=<-right (later \lam s => pmap __.2 s) $ <=<_^-1 {_} {_} {proj2} $ dense-lift-real-char.point_<=< c2<y y<d2)))
\ No newline at end of file
diff --git a/src/Topology/TopAbGroup.ard b/src/Topology/TopAbGroup.ard
new file mode 100644
index 00000000..03901b2c
--- /dev/null
+++ b/src/Topology/TopAbGroup.ard
@@ -0,0 +1,115 @@
+\import Algebra.Group
+\import Algebra.Group.Category
+\import Algebra.Monoid
+\import Function.Meta
+\import Logic
+\import Logic.Meta
+\import Meta
+\import Order.Lattice
+\import Order.PartialOrder
+\import Paths
+\import Paths.Meta
+\import Set.Subset
+\import Topology.CoverSpace
+\import Topology.TopSpace
+\import Topology.TopSpace.Product
+\import Topology.UniformSpace
+\open Bounded(top)
+
+\class TopAbGroup \extends TopSpace, AbGroup, UniformSpace {
+  | +-cont : ContMap (ProductTopSpace \this \this) \this \lam s => s.1 + s.2
+  | negative-cont : ContMap \this \this negative
+  | neighborhood-uniform {C : Set (Set E)} : isUniform C <-> ∃ (U : isOpen) (U 0) ∀ x ∃ (V : C) ∀ {y} (U (x - y) -> V y)
+  | uniform-cover Cu x => \case neighborhood-uniform.1 Cu \with {
+    | inP (U,Uo,U0,h) => \case h x \with {
+      | inP (V,CV,g) => inP (V, CV, g $ transportInv U negative-right U0)
+    }
+  }
+  | uniform-top => neighborhood-uniform.2 $ inP (top, open-top, (), \lam x => inP (top, idp, \lam _ => ()))
+  | uniform-refine Cu e => \case neighborhood-uniform.1 Cu \with {
+    | inP (U,Uo,U0,h) => neighborhood-uniform.2 $ inP (U, Uo, U0, \lam x => \case h x \with {
+      | inP (V,CV,g) => \case e CV \with {
+        | inP (W,DW,V<=W) => inP (W, DW, \lam u => V<=W $ g u)
+      }
+    })
+  }
+  | uniform-inter Cu Du => \case neighborhood-uniform.1 Cu, neighborhood-uniform.1 Du \with {
+    | inP (U,Uo,U0,g), inP (V,Vo,V0,h) => neighborhood-uniform.2 $ inP (U ∧ V, open-inter Uo Vo, (U0,V0), \lam x => \case g x, h x \with {
+      | inP (W,CW,f), inP (W',DW',f') => inP (W ∧ W', inP $ later (W, CW, W', DW', idp), \lam (u,u') => (f u, f' u'))
+    })
+  }
+  | uniform-star Cu => \case neighborhood-uniform.1 Cu \with {
+    | inP (U,Uo,U0,g) => \case shrink' +-cont negative-cont Uo U0 \with {
+      | inP (V',V'o,V'0,h') => \case shrink' +-cont negative-cont V'o V'0 \with {
+        | inP (V,Vo,V0,h) => inP (\lam W => ∃ (x : E) (W = \lam y => V (x - y)), neighborhood-uniform.2 $ inP (V, Vo, V0, \lam x => inP (\lam y => V (x - y), inP $ later (x, idp), \lam v => v)),
+                                  \lam {_} (inP (x,idp)) => \case g x \with {
+                                    | inP (U',CU',g') => inP (U', CU', \lam {_} (inP (x',idp)) (y,(Wy,W'y)) {z} W'z => g' $ simplify in h' (h Wy W'y) (h V0 W'z))
+                                  })
+      }
+    }
+  }
+
+  \default cauchy-open {S} => (\lam So {x} Sx => uniform-cauchy.2 $ ClosurePrecoverSpace.closure $ neighborhood-uniform.2 \case shrink' +-cont negative-cont (func-cont {+-cont ∘ tuple id (const x)} So) (transportInv S zro-left Sx) \with {
+    | inP (U',U'o,U'0,h') => \case shrink' +-cont negative-cont U'o U'0 \with {
+      | inP (U,Uo,U0,h) => inP (U, Uo, U0, \lam y => inP (\lam z => U (y - z), later \lam Uyx {z} Uyz => simplify in h' (h U0 Uyz) (h U0 Uyx), \lam u => u))
+    }
+  }, \lam f => cover-open \lam {x} Sx => \case ClosurePrecoverSpace.closure-filter (NFilter x) (\lam Cu => \case neighborhood-uniform.1 Cu \with {
+    | inP (U,Uo,U0,h) => \case h x \with {
+      | inP (V,CV,g) => inP (V, CV, inP (\lam y => U (x - y), func-cont {+-cont ∘ prod (const x) negative-cont ∘ tuple id id} Uo, transportInv U negative-right U0, g __))
+    }
+  }) $ uniform-cauchy.1 $ f Sx \with {
+    | inP (U, e, inP (V,Vo,Vx,V<=U)) => inP (V, Vo, Vx, V<=U <=∘ e (V<=U Vx))
+  })
+
+  \default isUniform C : \Prop => ∃ (U : isOpen) (U 0) ∀ x ∃ (V : C) ∀ {y} (U (x - y) -> V y)
+  \default neighborhood-uniform \as neighborhood-uniform-impl {C} : _ <-> _ => <->refl {isUniform C}
+
+  \func makeUniform {U : Set E} (Uo : isOpen U) (U0 : U 0) : UniformSpace.isUniform \lam V => ∃ (x : E) (V = \lam y => U (x - y))
+    => neighborhood-uniform.2 $ inP (U, Uo, U0, \lam x => inP (_, inP $ later (x, idp), \lam u => u))
+
+  \lemma shrink {U : Set E} (Uo : isOpen U) (U0 : U 0) : ∃ (V : isOpen) (V 0) ∀ {x y : V} (U (x - y))
+    => shrink' +-cont negative-cont Uo U0
+
+  \func UBall (U : Set E) (x : E) : Set E => \lam x' => U (x - x')
+
+  \lemma UBall-open {U : Set E} (Uo : isOpen U) {x : E} : isOpen (UBall U x)
+    => func-cont {+-cont ∘ tuple (const x) negative-cont} Uo
+
+  \lemma UBall-center {U : Set E} (U0 : U 0) {x : E} : UBall U x x
+    => transportInv U negative-right U0
+} \where {
+  \open ContMap
+  \open ProductTopSpace
+
+  \private \lemma shrink' {X : TopSpace} {A : AddGroup X} (+-cont : ContMap (ProductTopSpace X X) X \lam s => s.1 + s.2) (negative-cont : ContMap X X negative)
+                          {U : Set X} (Uo : isOpen U) (U0 : U 0) : ∃ (V : isOpen) (V 0) ∀ {x y : V} (U (x - y))
+    => \case func-cont {+-cont ∘ prod id negative-cont} Uo {0,0} (transportInv U negative-right U0) \with {
+      | inP (V,Vo,V0,W,Wo,W0,h) => inP (V ∧ W, open-inter Vo Wo, (V0,W0), \lam (Vx,_) (_,Wy) => h Vx Wy)
+    }
+}
+
+\record TopAbGroupMap \extends ContMap, AddGroupHom, UniformMap {
+  \override Dom : TopAbGroup
+  \override Cod : TopAbGroup
+
+  | func-uniform Eu => \case neighborhood-uniform.1 Eu \with {
+    | inP (U,Uo,U0,h) => neighborhood-uniform.2 $ inP (func ^-1 U, func-cont Uo, transportInv U func-zro U0, \lam x => \case h (func x) \with {
+      | inP (V,EV,g) => inP (func ^-1 V, inP $ later (V, EV, idp), \lam u => g $ transport U func-minus u)
+    })
+  }
+
+  \lemma embedding->uniformEmbedding (e : ContMap.IsDenseEmbedding) : UniformMap.IsDenseEmbedding
+    => (e.1, \lam Cu => \case neighborhood-uniform.1 Cu \with {
+      | inP (U,Uo,U0,h) => \case e.2 Uo \with {
+        | inP (V,Vo,p) => neighborhood-uniform.2 \case TopAbGroup.shrink Vo $ transport V func-zro $ rewrite p in U0 \with {
+          | inP (V',V'o,V'0,g) => inP (V', V'o, V'0, \lam y => inP (\lam y' => V' (y - y'), \case e.1 (UBall-open V'o {y}) (UBall-center {Cod} {V'} V'0) \with {
+            | inP (_, inP (x,idp),V'yfx) => \case h x \with {
+              | inP (W,CW,q) => inP $ later (W, CW, \lam {x'} V'yfx' => q $ rewrite p $ transport V (pmap (`- _) +-comm *> simplify +-comm *> inv func-minus) $ g V'yfx' V'yfx)
+            }
+          }, \lam v => v))
+        }
+      }
+    })
+} \where {
+  \open TopAbGroup
+}
\ No newline at end of file
diff --git a/src/Topology/TopAbGroup/Product.ard b/src/Topology/TopAbGroup/Product.ard
new file mode 100644
index 00000000..d80a5611
--- /dev/null
+++ b/src/Topology/TopAbGroup/Product.ard
@@ -0,0 +1,63 @@
+\import Algebra.Group
+\import Algebra.Meta
+\import Algebra.Monoid
+\import Function.Meta
+\import Logic
+\import Meta
+\import Operations
+\import Paths
+\import Paths.Meta
+\import Set.Subset
+\import Topology.TopAbGroup
+\import Topology.TopSpace
+\import Topology.TopSpace.Product
+\import Topology.UniformSpace.Product
+
+\instance ProductTopAbGroup (X Y : TopAbGroup) : TopAbGroup (\Sigma X Y)
+  | UniformSpace => ProductUniformSpace X Y
+  | zro => (0, 0)
+  | + s t => (s.1 + t.1, s.2 + t.2)
+  | zro-left => ext (zro-left, zro-left)
+  | +-assoc => ext (+-assoc, +-assoc)
+  | negative s => (negative s.1, negative s.2)
+  | negative-left => ext (negative-left, negative-left)
+  | +-comm => ext (+-comm, +-comm)
+  | +-cont => \new ContMap {
+    | func-cont {W} f {(s,t)} Wst => \case f Wst \with {
+      | inP (U,Uo,Ust,V,Vo,Vst,g) => \case +-cont.func-cont Uo {s.1,t.1} Ust, +-cont.func-cont Vo {s.2,t.2} Vst \with {
+        | inP (U1,U1o,U1s1,V1,V1o,V1t1,f1), inP (U2,U2o,U2s2,V2,V2o,V2t2,f2) => inP (Set.Prod U1 U2, Prod-open U1o U2o, (U1s1,U2s2), Set.Prod V1 V2, Prod-open V1o V2o, (V1t1,V2t2), \lam c d => g (f1 c.1 d.1) (f2 c.2 d.2))
+      }
+    }
+  }
+  | negative-cont => \new ContMap {
+    | func-cont {W} f {(s,t)} Wst => \case f Wst \with {
+      | inP (U,Uo,Us,V,Vo,Vt,g) => inP (_, negative-cont.func-cont Uo, Us, _, negative-cont.func-cont Vo, Vt, g __ __)
+    }
+  }
+  | neighborhood-uniform => (
+    \case \elim __ \with {
+      | inP (D,Du,E,Eu,r) => \case neighborhood-uniform.1 Du, neighborhood-uniform.1 Eu \with {
+        | inP (U,Uo,U0,f), inP (V,Vo,V0,g) => inP (Set.Prod U V, Prod-open Uo Vo, (U0,V0), \lam (x,y) => \case f x, g y \with {
+          | inP (U',DU',h1), inP (V',EV',h2) => \case r $ inP (U',DU',V',EV',idp) \with {
+            | inP (W,CW,p) => inP (W, CW, \lam c => p (h1 c.1, h2 c.2))
+          }
+        })
+      }
+    }, \case \elim __ \with {
+      | inP (W,Wo,W0,h) => \case Wo W0 \with {
+        | inP (U,Uo,U0,V,Vo,V0,g) => inP (_, X.makeUniform Uo U0, _, Y.makeUniform Vo V0, \lam {_} (inP (_, inP (x,idp), _, inP (y,idp), idp)) => \case h (x,y) \with {
+          | inP (W',CW',h') => inP (W', CW', \lam {s} (c,d) => h' $ g c d)
+        })
+      }
+    })
+
+\instance TopAbGroupHasProduct : HasProduct TopAbGroup
+  | Product => ProductTopAbGroup
+
+\lemma negative-map {X : TopAbGroup} : TopAbGroupMap X X negative \cowith
+  | func-+ => X.negative_+ *> +-comm
+  | func-cont => negative-cont.func-cont
+
+\lemma +-uniform {X : TopAbGroup} : TopAbGroupMap (X ⨯ X) X \lam s => s.1 + s.2 \cowith
+  | func-+ => equation
+  | func-cont => +-cont.func-cont
\ No newline at end of file
diff --git a/src/Topology/TopSpace.ard b/src/Topology/TopSpace.ard
index 2ea3fad8..a356427e 100644
--- a/src/Topology/TopSpace.ard
+++ b/src/Topology/TopSpace.ard
@@ -1,11 +1,15 @@
 \import Logic
 \import Logic.Meta
+\import Meta
 \import Order.Lattice
+\import Order.PartialOrder
 \import Paths
 \import Paths.Meta
 \import Set
 \import Set.Category
+\import Set.Filter
 \import Set.Subset
+\open Bounded(top)
 
 \class TopSpace \extends BaseSet {
   | isOpen : Set E -> \Prop
@@ -27,8 +31,58 @@
   \func IsRegular => ∀ {U : isOpen} {x : U} ∃ (V : isOpen) (V x) (V <=<T U)
 }
 
+\func NFilter {X : TopSpace} (x : X) : ProperFilter X \cowith
+  | F U => ∃ (V : isOpen) (V x) (V ⊆ U)
+  | filter-mono p (inP (W,Wo,Wx,q)) => inP (W, Wo, Wx, q <=∘ p)
+  | filter-top => inP (top, open-top, (), <=-refl)
+  | filter-meet (inP (U,Uo,Ux,p)) (inP (V,Vo,Vx,q)) => inP (U ∧ V, open-inter Uo Vo, (Ux,Vx), MeetSemilattice.meet-monotone p q)
+  | isProper (inP (V,Vo,Vx,p)) => inP (x, p Vx)
+
+\func IsDenseSet {X : TopSpace} (S : Set X) : \Prop
+  => \Pi {x : X} {U : Set X} -> isOpen U -> U x -> ∃ (y : S) (U y)
+
 \class ContMap \extends SetHom {
   \override Dom : TopSpace
   \override Cod : TopSpace
-  | func-cont {U : Cod -> \Prop} : isOpen U -> isOpen (\lam x => U (func x))
-}
\ No newline at end of file
+
+  | func-cont {U : Cod -> \Prop} : isOpen U -> isOpen \lam x => U (func x)
+
+  \func IsDense : \Prop
+    => IsDenseSet (\lam y => ∃ (x : Dom) (func x = y))
+
+  \func IsEmbedding : \Prop
+    => ∀ {U : isOpen} ∃ (V : isOpen) (U = func ^-1 V)
+
+  \lemma embedding-char : IsEmbedding <-> ∀ {U : isOpen} {x : U} ∃ (V : isOpen) (V (func x)) (func ^-1 V ⊆ U)
+    => (\lam e Uo Ux => \case e Uo \with {
+      | inP (V,Vo,p) => inP (V, Vo, rewrite p in Ux, rewrite p <=-refl)
+    }, \lam e {U} Uo => inP (_, open-Union {_} {\lam V => \Sigma (isOpen V) (func ^-1 V ⊆ U)} __.1, ext \lam x => ext (\lam Ux => \case e Uo Ux \with {
+      | inP (V,Vo,Vfx,p) => inP (V, (Vo, p), Vfx)
+    }, \lam (inP (V,(Vo,p),Vfx)) => p Vfx)))
+
+  \func IsDenseEmbedding : \Prop
+    => \Sigma IsDense IsEmbedding
+} \where {
+  \func id {X : TopSpace} : ContMap X X \cowith
+    | func x => x
+    | func-cont Uo => Uo
+
+  \func compose \alias \infixl 8 ∘ {X Y Z : TopSpace} (g : ContMap Y Z) (f : ContMap X Y) : ContMap X Z \cowith
+    | func x => g (f x)
+    | func-cont Uo => f.func-cont (g.func-cont Uo)
+
+  \func const {Y X : TopSpace} (x : X) : ContMap Y X \cowith
+    | func _ => x
+    | func-cont _ => Y.cover-open \lam Ux => inP (top, open-top, (), \lam _ => Ux)
+}
+
+\class HausdorffTopSpace \extends TopSpace
+  | isHausdorff {x y : E} : ∀ {U V : isOpen} (U x) (V y) ∃ (U ∧ V) -> x = y
+
+\lemma denseSet-lift-unique {X : TopSpace} {Y : HausdorffTopSpace} {S : Set X} (Sd : IsDenseSet S) (f g : ContMap X Y) (p : \Pi {x : X} -> S x -> f x = g x) (x : X) : f x = g x
+  => isHausdorff \lam {U} Uo Vo Ufx Vgx => \case Sd {x} (open-inter (f.func-cont Uo) (g.func-cont Vo)) (Ufx,Vgx) \with {
+    | inP (y,Sy,(Ufy,Vgy)) => inP (g y, (transport U (p Sy) Ufy, Vgy))
+  }
+
+\lemma dense-lift-unique {X Y : TopSpace} {Z : HausdorffTopSpace} (f : ContMap X Y) (fd : f.IsDense) (g h : ContMap Y Z) (p : \Pi (x : X) -> g (f x) = h (f x)) (y : Y) : g y = h y
+  => denseSet-lift-unique fd g h (\lam (inP (x,q)) => rewriteI q (p x)) y
\ No newline at end of file
diff --git a/src/Topology/TopSpace/Category.ard b/src/Topology/TopSpace/Category.ard
index e6e431ed..54f23326 100644
--- a/src/Topology/TopSpace/Category.ard
+++ b/src/Topology/TopSpace/Category.ard
@@ -5,14 +5,8 @@
 
 \instance TopCat : Cat TopSpace
   | Hom => ContMap
-  | id X => \new ContMap {
-    | func x => x
-    | func-cont t => t
-  }
-  | o g f => \new ContMap {
-    | func x => g (f x)
-    | func-cont t => func-cont {f} (func-cont {g} t)
-  }
+  | id X => ContMap.id
+  | o => ContMap.∘
   | id-left => idp
   | id-right => idp
   | o-assoc => idp
diff --git a/src/Topology/TopSpace/Product.ard b/src/Topology/TopSpace/Product.ard
new file mode 100644
index 00000000..1cf93446
--- /dev/null
+++ b/src/Topology/TopSpace/Product.ard
@@ -0,0 +1,43 @@
+\import Logic
+\import Logic.Meta
+\import Operations
+\import Order.Lattice
+\import Set.Subset
+\import Topology.TopSpace
+\open Bounded(top)
+
+\instance TopSpaceHasProduct : HasProduct TopSpace
+  | Product => ProductTopSpace
+
+\instance ProductTopSpace (X Y : TopSpace) : TopSpace (\Sigma X Y)
+  | isOpen W => ∀ {s : W} ∃ (U : X.isOpen) (U s.1) (V : Y.isOpen) (V s.2) ∀ {x : U} {y : V} (W (x,y))
+  | open-top _ => inP (top, open-top, (), top, open-top, (), \lam _ _ => ())
+  | open-inter {W} {W'} f g (Ws,W's) => \case f Ws, g W's \with {
+    | inP (U,Uo,Ux,V,Vo,Vy,h), inP (U',U'o,U'x,V',V'o,V'y,h') => inP (U ∧ U', open-inter Uo U'o, (Ux,U'x), V ∧ V', open-inter Vo V'o, (Vy,V'y), \lam (Ux,U'x) (Vy,V'y) => (h Ux Vy, h' U'x V'y))
+  }
+  | open-Union So (inP (W,SW,Ws)) => \case So SW Ws \with {
+    | inP (U,Uo,Ux,V,Vo,Vy,h) => inP (U, Uo, Ux, V, Vo, Vy, \lam Ux Vy => inP (W, SW, h Ux Vy))
+  }
+  \where {
+    \open ContMap
+
+    \func proj1 {X Y : TopSpace} : ContMap (X ⨯ Y) X \cowith
+      | func s => s.1
+      | func-cont Uo => \lam Ux => inP (_, Uo, Ux, top, open-top, (), \lam Ux _ => Ux)
+
+    \func proj2 {X Y : TopSpace} : ContMap (X ⨯ Y) Y \cowith
+      | func s => s.2
+      | func-cont Uo => \lam Uy => inP (top, open-top, (), _, Uo, Uy, \lam _ Uy => Uy)
+
+    \func tuple {X Y Z : TopSpace} (f : ContMap X Y) (g : ContMap X Z) : ContMap X (Y ⨯ Z) \cowith
+      | func x => (f x, g x)
+      | func-cont {W} Wo => X.cover-open \lam w => \case Wo w \with {
+        | inP (U,Uo,Ufx,V,Vo,Vgx,h) => inP (_, open-inter (f.func-cont Uo) (g.func-cont Vo), (Ufx,Vgx), \lam (Ufx,Vgx) => h Ufx Vgx)
+      }
+
+    \func prod {X X' Y Y' : TopSpace} (f : ContMap X Y) (f' : ContMap X' Y') : ContMap (X ⨯ X') (Y ⨯ Y')
+      => tuple (f ∘ proj1) (f' ∘ proj2)
+  }
+
+\lemma Prod-open {X Y : TopSpace} {U : Set X} (Uo : isOpen U) {V : Set Y} (Vo : isOpen V) : isOpen (Set.Prod U V)
+  => \lam {s} (Us,Vs) => inP (U, Uo, Us, V, Vo, Vs, \lam Ux Vy => (Ux,Vy))
\ No newline at end of file
diff --git a/src/Topology/UniformSpace.ard b/src/Topology/UniformSpace.ard
index acc51590..4d802a04 100644
--- a/src/Topology/UniformSpace.ard
+++ b/src/Topology/UniformSpace.ard
@@ -4,43 +4,105 @@
 \import Meta
 \import Order.Lattice
 \import Order.PartialOrder
+\import Paths.Meta
 \import Set.Filter
 \import Set.Subset
 \import Topology.CoverSpace
+\import Topology.CoverSpace.Complete
+\import Topology.RatherBelow
 \open Set
-\open Bounded(top)
+\open Bounded(top,top-univ)
 \open ClosurePrecoverSpace
 
-\class UniformSpace \extends CompletelyRegularCoverSpace
+\class UniformSpace \extends CompletelyRegularCoverSpace {
   | isUniform : Set (Set E) -> \Prop
   | uniform-cover {C : Set (Set E)} : isUniform C -> \Pi (x : E) -> ∃ (U : C) (U x)
   | uniform-top : isUniform (single top)
-  | uniform-extend {C D : Set (Set E)} : isUniform C -> (\Pi {U : Set E} -> C U -> ∃ (V : D) (U ⊆ V)) -> isUniform D
-  | uniform-inter {C D : Set (Set E)} : isUniform C -> isUniform D -> isUniform \lam U => ∃ (V : C) (W : D) (U = V ∧ W)
+  | uniform-refine {C D : Set (Set E)} : isUniform C -> Refines C D -> isUniform D
+  | uniform-inter {C D : Set (Set E)} : isUniform C -> isUniform D -> isUniform (CoverInter C D)
   | uniform-star {C : Set (Set E)} : isUniform C -> ∃ (D : isUniform) ∀ {V : D} ∃ (U : C) ∀ {W : D} (Given (V ∧ W) -> W ⊆ U)
+  | uniform-cauchy {C : Set (Set E)} : isCauchy C <-> Closure isUniform C
 
-  | isCauchy => Closure isUniform
-  | cauchy-cover Cc x => closure-filter (pointFilter x) (\lam Cu => uniform-cover Cu x) Cc
-  | cauchy-top => closure-top idp
-  | cauchy-extend => closure-extends
-  | cauchy-trans Cc e => closure-trans Cc e idp
-  | isCompletelyRegular => isCompletelyRegular {ClosureRegularCoverSpace isUniform uniform-cover uniform-star}
-  \where {
-    \func star {X : \Set} (V : Set X) (C : Set (Set X)) : Set X
-      => Union \lam W => \Sigma (C W) (Given (V ∧ W))
-
-    \func \infix 4 <=* {X : UniformSpace} (V U : Set X) : \Prop
-      => ∃ (C : isUniform) (star V C ⊆ U)
-
-    \lemma <=*_<=< {X : UniformSpace} {V U : Set X} (p : V <=* U) : V <=< U \elim p
-      | inP (C,Cc,p) => closure $ uniform-extend Cc \lam {W} CW => inP (W, \lam s => Union-cond (CW,s) <=∘ p, <=-refl)
-
-    \lemma <=*-inter {X : UniformSpace} {V U : Set X} (p : V <=* U) : ∃ (V' : Set X) (V <=* V') (V' <=* U) \elim p
-      | inP (C,Cc,p) => \case uniform-star Cc \with {
-        | inP (D,Dc,g) => inP (star V D, inP (D, Dc, <=-refl), inP (D, Dc, (\case __ \with {
-          | inP (W, (DW, (y, (inP (V', (DV', (z, (Vz, V'z))), V'y), Wy))), Wx) => \case g DV' \with {
-            | inP (U',CU',h) => inP $ later (U', (CU', (z, (Vz, h DV' (z,(V'z,V'z)) V'z))), h DW (y, (V'y, Wy)) Wx)
-          }
-        }) <=∘ p))
+  | cauchy-cover Cc x => closure-filter (pointFilter x) (\lam Cu => uniform-cover Cu x) $ uniform-cauchy.1 Cc
+  | cauchy-top => uniform-cauchy.2 $ closure-top idp
+  | cauchy-refine Cc e => uniform-cauchy.2 $ closure-refine (uniform-cauchy.1 Cc) e
+  | cauchy-trans Cc e => uniform-cauchy.2 $ closure-trans (uniform-cauchy.1 Cc) (\lam CU => uniform-cauchy.1 $ e CU) idp
+  | isCompletelyRegular Cc => cauchy-subset (uniform-cauchy.2 $ isCompletelyRegular {ClosureRegularCoverSpace isUniform uniform-cover uniform-star} (uniform-cauchy.1 Cc))
+      \lam {V} (inP (U,CU,V<=<U)) => inP $ later (U, CU, unfolds $ unfolds at V<=<U $ TruncP.map V<=<U \lam (R',c,d,e) => (R', \lam r => uniform-cauchy.2 $ c r, d, e))
+
+  \default isCauchy : Set (Set E) -> \Prop => Closure isUniform
+  \default uniform-cauchy \as uniform-cauchy-impl {C} : isCauchy C <-> Closure isUniform C => <->refl
+
+  \lemma <=*-inter {V U : Set E} (p : V <=* U) : ∃ (V' : Set E) (V <=* V') (V' <=* U) \elim p
+    | inP (C,Cc,p) => \case uniform-star Cc \with {
+      | inP (D,Dc,g) => inP (star V D, inP (D, Dc, <=-refl), inP (D, Dc, (\case __ \with {
+        | inP (W, (DW, (y, (inP (V', (DV', (z, (Vz, V'z))), V'y), Wy))), Wx) => \case g DV' \with {
+          | inP (U',CU',h) => inP $ later (U', (CU', (z, (Vz, h DV' (z,(V'z,V'z)) V'z))), h DW (y, (V'y, Wy)) Wx)
+        }
+      }) <=∘ p))
+    }
+
+  \lemma <=*-regular {C : Set (Set E)} (Cu : isUniform C) : isUniform \lam V => ∃ (U : C) (V <=* U)
+    => \case uniform-star Cu \with {
+      | inP (D,Du,h) => uniform-subset Du \lam {V} DV => \case h DV \with {
+        | inP (U,CU,g) => inP $ later (U, CU, inP (D, Du, \lam {y} (inP (W,(DW,s),Wy)) => g DW s Wy))
       }
-  }
\ No newline at end of file
+    }
+
+  \lemma <=*-cauchy-regular {C : Set (Set E)} (Cc : CoverSpace.isCauchy C) : CoverSpace.isCauchy \lam V => ∃ (U : C) (V <=* U)
+    => uniform-cauchy.2 $ ClosureCoverSpace.closure-regular StarRatherBelow (\lam Cu => closure $ <=*-regular Cu) (uniform-cauchy.1 Cc)
+
+  \lemma <=<-regular {C : Set (Set E)} (Cu : isUniform C) : isUniform \lam V => ∃ (U : C) (V <=< U)
+    => uniform-subset (<=*-regular Cu) \lam {V} (inP (U,CU,p)) => inP $ later (U, CU, <=*_<=< p)
+} \where {
+  \func star {X : \Set} (V : Set X) (C : Set (Set X)) : Set X
+    => Union \lam W => \Sigma (C W) (Given (V ∧ W))
+
+  \lemma star-monotone {X : \Set} {V U : Set X} (p : V ⊆ U) {C D : Set (Set X)} (r : Refines C D) : star V C ⊆ star U D
+    => \lam (inP (W',(CW',(y,(Vy,W'y))),W'x)) => \case r CW' \with {
+      | inP (W,DW,W'<=W) => inP (W, (DW, (y, (p Vy, W'<=W W'y))), W'<=W W'x)
+    }
+}
+
+\func \infix 4 <=* {X : UniformSpace} (V U : Set X) : \Prop
+  => ∃ (C : isUniform) (UniformSpace.star V C ⊆ U)
+
+\lemma <=*_<=< {X : UniformSpace} {V U : Set X} (p : V <=* U) : V <=< U \elim p
+  | inP (C,Cc,p) => uniform-cauchy.2 $ closure $ uniform-refine Cc \lam {W} CW => inP (W, \lam s => Union-cond (CW,s) <=∘ p, <=-refl)
+
+\instance StarRatherBelow {X : UniformSpace} : RatherBelow (<=* {X})
+  | <=<-left (inP (C,Cu,p)) q => inP (C, Cu, p <=∘ q)
+  | <=<-right p (inP (C,Cu,q)) => inP (C, Cu, UniformSpace.star-monotone p Refines-refl <=∘ q)
+  | <=<_top => inP (single top, uniform-top, top-univ)
+  | <=<_meet (inP (C,Cu,p)) (inP (D,Du,q)) => inP (_, uniform-inter Cu Du, meet-univ (UniformSpace.star-monotone meet-left Refines-inter-left <=∘ p) (UniformSpace.star-monotone meet-right Refines-inter-right <=∘ q))
+
+\lemma uniform-subset {X : UniformSpace} {C D : Set (Set X)} (Cc : isUniform C) (e : \Pi {U : Set X} -> C U -> D U) : isUniform D
+  => uniform-refine Cc \lam {U} CU => inP (U, e CU, <=-refl)
+
+\lemma uniform-embedding-char {X : UniformSpace} {Y : PrecoverSpace} {f : PrecoverMap X Y}
+  : f.IsEmbedding <-> ∀ {C : isUniform} (isCauchy \lam V => ∃ (U : C) (f ^-1 V ⊆ U))
+  => (\lam e Cu => e $ uniform-cauchy.2 $ closure Cu, closure-embedding (uniform-cauchy.1 __) f)
+
+\record LocallyUniformMap \extends CoverMap {
+  \override Dom : UniformSpace
+  \override Cod : UniformSpace
+
+  | func-locally-uniform {E : Set (Set Cod)} : isUniform E -> ∃ (C : isUniform) (∀ {U : C} (isUniform \lam V => ∃ (W : E) (U ∧ V ⊆ func ^-1 W)))
+  | func-cover {E'} E'c => closure-univ-cover (\lam {E} Eu => uniform-cauchy.2 \case func-locally-uniform Eu \with {
+    | inP (C,Cu,e) => closure-refine (closure-trans (closure Cu) (\lam CU => closure (e CU)) idp) \lam {Z} (inP (U, V, CU, inP (W, EW, q), p)) => inP $ later (_, inP (W, EW, idp), rewrite p q)
+  }) (uniform-cauchy.1 E'c)
+}
+
+\record UniformMap \extends LocallyUniformMap {
+  | func-uniform {E : Set (Set Cod)} : isUniform E -> isUniform \lam U => ∃ (V : E) (U = func ^-1 V)
+  | func-locally-uniform Eu => inP (_, func-uniform Eu, \lam (inP (V,EV,p)) => uniform-subset (func-uniform Eu) \lam _ => inP $ later (V, EV, rewrite p meet-left))
+
+  \func IsEmbedding : \Prop
+    => \Pi {C : Set (Set Dom)} -> isUniform C -> isUniform \lam V => ∃ (U : C) (func ^-1 V ⊆ U)
+
+  \lemma embedding->coverEmbedding (e : IsEmbedding) : CoverMap.IsEmbedding
+    => closure-embedding {_} {isUniform} (uniform-cauchy.1 __) \this \lam Cu => uniform-cauchy.2 (closure (e Cu))
+
+  \func IsDenseEmbedding : \Prop
+    => \Sigma IsDense IsEmbedding
+}
\ No newline at end of file
diff --git a/src/Topology/UniformSpace/Complete.ard b/src/Topology/UniformSpace/Complete.ard
new file mode 100644
index 00000000..344e99bf
--- /dev/null
+++ b/src/Topology/UniformSpace/Complete.ard
@@ -0,0 +1,66 @@
+\import Function.Meta
+\import Logic
+\import Logic.Meta
+\import Meta
+\import Order.Lattice
+\import Order.PartialOrder
+\import Paths.Meta
+\import Set.Filter
+\import Set.Subset
+\import Topology.CoverSpace
+\import Topology.CoverSpace.Complete
+\import Topology.RatherBelow
+\import Topology.UniformSpace
+\open ClosurePrecoverSpace
+\open Bounded(top)
+\open Completion
+
+\class CompleteUniformSpace \extends UniformSpace, CompleteCoverSpace
+
+\func dense-uniform-lift {X Y : UniformSpace} {Z : CompleteUniformSpace} (f : UniformMap X Y) (fd : f.IsDenseEmbedding) (g : UniformMap X Z) : UniformMap Y Z \cowith
+  | CoverMap => dense-lift f (fd.1, f.embedding->coverEmbedding fd.2) g
+  | func-uniform Dc => uniform-refine (Y.<=<-regular $ fd.2 $ g.func-uniform $ Z.<=<-regular Dc) \lam {V'} (inP (V, inP (U, inP (W', inP (W, DW, W'<=<W), p), q), V'<=<V)) =>
+      inP (_, inP (W, DW, idp), \lam {y} V'y => <=<_<= (Z.filter-point-elem W'<=<W \case <=<-inter (<=<-right (single_<= V'y) V'<=<V) \with {
+        | inP (V'',y<=<V'',V''<=<V) => inP $ later (V'', V, rewrite p in q, V''<=<V, y<=<V'')
+      }) idp)
+
+\instance UniformCompletion (X : UniformSpace) : CompleteUniformSpace
+  | CompleteCoverSpace => Completion X
+  | isUniform D => ∃ (C : isUniform) (∀ {U : C} ∃ (V : D) (mkSet U ⊆ V))
+  | uniform-cover (inP (C,Cu,p)) F =>
+    \have | (inP (U,CU,FU)) => isCauchyFilter (uniform-cauchy.2 $ closure Cu)
+          | (inP (V,DV,q)) => p CU
+    \in inP (V, DV, q FU)
+  | uniform-top => inP (single top, uniform-top, \lam _ => inP (top, idp, \lam _ => ()))
+  | uniform-refine (inP (E,Eu,g)) f => inP (E, Eu, \lam EU =>
+      \have | (inP (V,CV,p)) => g EU
+            | (inP (W,DW,q)) => f CV
+      \in inP (W, DW, p <=∘ q))
+  | uniform-inter (inP (C',C'u,f)) (inP (D',D'u,g)) => inP (_, uniform-inter C'u D'u, \lam {U} (inP (V',C'V',W',D'W',p)) => \case f C'V', g D'W' \with {
+    | inP (V,CV,eV), inP (W,DW,eW) => inP (V ∧ W, inP (V, CV, W, DW, idp), rewrite p \lam {F} c => (eV $ filter-mono meet-left c, eW $ filter-mono meet-right c))
+  })
+  | uniform-star (inP (C',C'u,f)) => \case uniform-star C'u \with {
+    | inP (D',D'u,g) => inP (\lam V => ∃ (V' : D') (V = mkSet V'), inP (D', D'u, \lam {V'} D'V' => inP (mkSet V', inP (V', D'V', idp), <=-refl)), \lam (inP (V',D'V',p)) => \case g D'V' \with {
+      | inP (U',C'U',e) => \case f C'U' \with {
+        | inP (U,CU,q) => inP (U, CU, \lam (inP (V'',D'V'',p')) (F,(VF,WF)) => \case isProper (filter-meet (rewrite p in VF) (rewrite p' in WF)) \with {
+          | inP s => rewrite p' $ mkSet_<= (e D'V'' s) <=∘ q
+        })
+      }
+    })
+  }
+  | uniform-cauchy => (\lam (inP (C',C'c,f)) => closure-map mkSet (\lam {F} => filter-top) mkSet_<= (\lam s => filter-meet s.1 s.2) f $ uniform-cauchy.1 C'c, closure-cauchy $ later \lam (inP (C',C'u,f)) => inP (C', uniform-cauchy.2 $ closure C'u, f))
+
+\func uniform-completion {X : UniformSpace} : UniformMap X (UniformCompletion X) \cowith
+  | CoverMap => completion
+  | func-uniform (inP (C,Cu,f)) => uniform-refine (X.<=<-regular Cu)
+      \case __ \with {
+        | inP (U',CU',U<=<U') => \case f CU' \with {
+          | inP (V,DV,p) => inP (pointCF ^-1 V, inP (V, DV, idp), \lam Ux => p $ <=<-right (single_<= Ux) U<=<U')
+        }
+      }
+
+\lemma cauchyFilter-uniform-char {X : UniformSpace} {F : SetFilter X} : ∀ {C : isCauchy} ∃ (U : C) (F U) <-> ∀ {C : isUniform} ∃ (U : C) (F U)
+  => (\lam Fc Cu => Fc $ uniform-cauchy.2 $ closure Cu, \lam f Cc => closure-filter F f (uniform-cauchy.1 Cc))
+
+\lemma regularFilter-uniform-char {X : UniformSpace} {F : CauchyFilter X} : ∀ {U : F.F} ∃ (V : Set X) (V <=< U) (F V) <-> ∀ {U : F.F} ∃ (V : Set X) (V <=* U) (F V)
+  => (\lam Fr => RegularCauchyFilter.ratherBelow StarRatherBelow StarRatherBelow.<=<-left (\lam p => <=<_<= (<=*_<=< p)) X.<=*-cauchy-regular (\new RegularCauchyFilter { | CauchyFilter => F | isRegularFilter => Fr }), \lam f FU => TruncP.map (f FU) \lam (V,p,FV) => (V, <=*_<=< p, FV))
diff --git a/src/Topology/UniformSpace/Product.ard b/src/Topology/UniformSpace/Product.ard
new file mode 100644
index 00000000..beba8ba7
--- /dev/null
+++ b/src/Topology/UniformSpace/Product.ard
@@ -0,0 +1,59 @@
+\import Data.Bool
+\import Function.Meta
+\import Logic
+\import Logic.Meta
+\import Meta
+\import Operations
+\import Order.Lattice
+\import Order.PartialOrder
+\import Paths
+\import Paths.Meta
+\import Set.Subset
+\import Topology.CoverSpace
+\import Topology.CoverSpace.Product
+\import Topology.UniformSpace
+\open ClosurePrecoverSpace
+\open Set
+\open Bounded(top)
+
+\instance UniformSpaceHasProduct : HasProduct UniformSpace
+  | Operations.HasProduct.Product => ProductUniformSpace
+
+\instance ProductUniformSpace (X Y : UniformSpace) : UniformSpace (\Sigma X Y)
+  | CoverSpace => ProductCoverSpace X Y
+  | isUniform E => ∃ (C : X.isUniform) (D : Y.isUniform) (Refines (\lam W => ∃ (U : C) (V : D) (W = Prod U V)) E)
+  | uniform-cover {E} (inP (C,Cu,D,Du,r)) s => \case uniform-cover Cu s.1, uniform-cover Du s.2 \with {
+    | inP (U,CU,Ux), inP (V,DV,Vy) => Refines-cover r $ inP (Prod U V, inP (U, CU, V, DV, idp), (Ux,Vy))
+  }
+  | uniform-top => inP (single top, uniform-top, single top, uniform-top, Refines-single_top)
+  | uniform-refine (inP (C',C'u,D',D'u,r')) r => inP (C', C'u, D', D'u, Refines-trans r' r)
+  | uniform-inter (inP (C1,C1u,D1,D1u,r1)) (inP (C2,C2u,D2,D2u,r2)) => inP (_, uniform-inter C1u C2u, _, uniform-inter D1u D2u, Refines-trans (later \lam {W} (inP (U, inP (U1,C1U1,U2,C2U2,U=U1U2), V, inP (V1,D1V1,V2,D2V2,V=V1V2), W=UV)) => inP (_, inP (Prod U1 V1, inP (U1, C1U1, V1, D1V1, idp), Prod U2 V2, inP (U2, C2U2, V2,D2V2, idp), idp), rewrite (W=UV,U=U1U2,V=V1V2) \lam {s} ((U1x,U2x),(V1y,V2y)) => ((U1x,V1y),(U2x,V2y)))) (Refines-inter r1 r2))
+  | uniform-star {E} (inP (C,Cu,C',C'u,r)) => \case uniform-star Cu, uniform-star C'u \with {
+    | inP (D,Du,h), inP (D',D'u,h') => inP (\lam W => ∃ (U : D) (V : D') (W = Prod U V), inP (D, Du, D', D'u, Refines-refl), \lam {_} (inP (V,DV,V',D'V',idp)) => \case h DV, h' D'V' \with {
+      | inP (U,CU,g), inP (U',C'U',g') => \case r (inP (U,CU,U',C'U',idp)) \with {
+        | inP (W,EW,UU'<=W) => inP (W, EW, \lam {_} (inP (V2,DV2,V'2,D'V'2,idp)) (t,((Vt,V't),(V2t,V'2t))) => (\lam {s} (V2s,V'2s) => (g DV2 (t.1,(Vt,V2t)) V2s, g' D'V'2 (t.2,(V't,V'2t)) V'2s)) <=∘ UU'<=W)
+      }
+    })
+  }
+  | uniform-cauchy => (closure-univ-closure-id $ later \case \elim __ \with {
+    | inP (true, inP (D,Dc,h)) => closure-refine (closure-univ-closure __.1 (\lam {C} Cu => closure $ inP (C, Cu, single top, uniform-top, \lam {_} (inP (U,CU,_,idp,idp)) => inP (_, inP (U, CU, idp), __.1))) $ uniform-cauchy.1 Dc) \lam (inP (V,DV,p)) => \case h DV \with {
+      | inP (W,CW,q) => inP (W, CW, rewrite p q)
+    }
+    | inP (false, inP (D,Dc,h)) => closure-refine (closure-univ-closure __.2 (\lam {C} Cu => closure $ inP (single top, uniform-top, C, Cu, \lam {_} (inP (_,idp,U,CU,idp)) => inP (_, inP (U, CU, idp), __.2))) $ uniform-cauchy.1 Dc) \lam (inP (V,DV,p)) => \case h DV \with {
+      | inP (W,CW,q) => inP (W, CW, rewrite p q)
+    }
+  }, closure-univ-closure-id $ later \lam {E} (inP (C,Cu,D,Du,r)) => closure-refine (ProductCoverSpace.prodCover (uniform-cauchy.2 $ closure Cu) (uniform-cauchy.2 $ closure Du)) r)
+  \where {
+    \func proj1 {X Y : UniformSpace} : UniformMap (X ⨯ Y) X \cowith
+      | func s => s.1
+      | func-uniform {D} Du => inP (D, Du, single top, uniform-top, \lam {_} (inP (U,DU,V,_,idp)) => inP (_, inP (U, DU, idp), __.1))
+
+    \func proj2 {X Y : UniformSpace} : UniformMap (X ⨯ Y) Y \cowith
+      | func s => s.2
+      | func-uniform {D} Du => inP (single top, uniform-top, D, Du, \lam {_} (inP (U,_,V,DV,idp)) => inP (_, inP (V, DV, idp), __.2))
+
+    \lemma prodCover {X Y : UniformSpace} {C : Set (Set X)} (Cu : X.isUniform C) {D : Set (Set Y)} (Du : Y.isUniform D)
+      : isUniform {X ⨯ Y} \lam W => ∃ (U : C) (V : D) (W = \lam s => \Sigma (U s.1) (V s.2))
+      => uniform-subset {X ⨯ Y} (uniform-inter {X ⨯ Y} (proj1.func-uniform Cu) (proj2.func-uniform Du))
+          \lam {_} (inP (_, inP (U,CU,idp), _, inP (V,DV,idp), idp)) => inP $ later (U, CU, V, DV, idp)
+  }
\ No newline at end of file
diff --git a/test/Algebra/LinearSolverTest.ard b/test/Algebra/LinearSolverTest.ard
index 0a022d3f..6c3430c1 100644
--- a/test/Algebra/LinearSolverTest.ard
+++ b/test/Algebra/LinearSolverTest.ard
@@ -13,7 +13,7 @@
 \import Order.Lattice
 \import Order.PartialOrder
 \import Order.StrictOrder
-\import Topology.CoverSpace.Real
+\import Arith.Real.Field
 
 \lemma contrTest0 {R : LinearlyOrderedSemiring} {a : R} (p : a < a) : Empty
   => linarith
@@ -177,6 +177,9 @@
 \lemma unusedHypothesis3 {R : LinearlyOrderedSemiring} {a b c : R} (p : Nat -> a < b) (q : b <= c) (s : c <= b) : b = c
   => linarith
 
+\lemma unusedVariables {R A : LinearlyOrderedSemiring} {a b c : R} {x y : A} (q : x < y) (p : a < b) : a <= b
+  => linarith
+
 \lemma realTest {x : Real} (p : 0 < x) : 0 < x * ratio 1 2
   => linarith