Merge pull request #2096 from jdchristensen/misc-cleanups

Misc cleanups to Overture, Colimits/Quotient

STYLE.md

@@ -339,6 +339,11 @@ The inverse function can then be referred to as `foo ^-1`.  Avoid
 using `equiv_foo` unless you really do need an `Equiv` object, rather
 than a function which happens to be an equivalence.
 
+On the other hand, sometimes it is easier to define an equivalence
+by composing together existing equivalences, in which case one goes
+immediately to the last step, defining `equiv_foo`.  If the equivalence
+is used frequently as an ordinary function, one might also define `foo`
+as the underlying function of `equiv_foo`; see `path_equiv`, as an example.
 
 ## 3. Records, Structures, Typeclasses ##
 

theories/Algebra/Groups/QuotientGroup.v

@@ -30,9 +30,8 @@ Section GroupCongruenceQuotient.
     srapply Quotient_rec2.
     - intros x y.
       exact (class_of _ (x * y)).
-    - intros x x' p y y' q.
-      apply qglue.
-      by apply iscong.
+    - intros x x' y p. apply qglue. by apply iscong.
+    - intros x y y' q. apply qglue. by apply iscong.
   Defined.
 
   Global Instance congquot_mon_unit : MonUnit CongruenceQuotient.

theories/Algebra/Rings/Localization.v

@@ -166,13 +166,11 @@ Section Localization.
   Instance plus_rng_localization : Plus (Quotient fraction_eq).
   Proof.
     srapply Quotient_rec2.
-    - rapply fraction_eq_refl.
     - cbn.
       intros f1 f2.
       exact (class_of _ (frac_add f1 f2)).
-    - cbn beta.
-      intros f1 f1' p f2 f2' q.
-      by apply qglue, frac_add_wd.
+    - intros f1 f1' f2 p.  by apply qglue, frac_add_wd_l.
+    - intros f1 f2 f2' q.  by apply qglue, frac_add_wd_r.
   Defined.
 
   (** *** Multiplication operation *)
@@ -212,15 +210,13 @@ Section Localization.
   Instance mult_rng_localization: Mult (Quotient fraction_eq).
   Proof.
     srapply Quotient_rec2.
-    - rapply fraction_eq_refl.
     - cbn.
       intros f1 f2.
       exact (class_of _ (frac_mult f1 f2)).
-    - cbn beta.
-      intros f1 f1' p f2 f2' q.
-      transitivity (class_of fraction_eq (frac_mult f1' f2)).
-      + by apply qglue, frac_mult_wd_l.
-      + by apply qglue, frac_mult_wd_r.
+    - intros f1 f1' f2 p; cbn beta.
+      by apply qglue, frac_mult_wd_l.
+    - intros f1 f2 f2' q; cbn beta.
+      by apply qglue, frac_mult_wd_r.
   Defined.
 
   (** *** Zero element *)

theories/Algebra/Rings/QuotientRing.v

@@ -42,9 +42,8 @@ Section QuotientRing.
   Proof.
     srapply Quotient_rec2.
     - exact (fun x y => class_of _ (x * y)).
-    - intros x x' p y y' q; simpl.
-      apply qglue.
-      by rapply iscong.
+    - intros x x' y p. apply qglue. by apply iscong.
+    - intros x y y' q. apply qglue. by apply iscong.
   Defined.
 
   Instance one_quotient_abgroup : One (QuotientAbGroup R I) := class_of _ one.

theories/Basics/Overture.v

@@ -655,10 +655,9 @@ Existing Class Funext.
 Axiom isequiv_apD10 : forall `{Funext} (A : Type) (P : A -> Type) f g, IsEquiv (@apD10 A P f g).
 Global Existing Instance isequiv_apD10.
 
-Definition path_forall `{Funext} {A : Type} {P : A -> Type} (f g : forall x : A, P x) :
-  f == g -> f = g
-  :=
-  (@apD10 A P f g)^-1.
+Definition path_forall `{Funext} {A : Type} {P : A -> Type} (f g : forall x : A, P x)
+  : f == g -> f = g
+  := (@apD10 A P f g)^-1.
 
 Global Arguments path_forall {_ A%_type_scope P} (f g)%_function_scope _.
 
@@ -674,9 +673,6 @@ Global Arguments path_forall {_ A%_type_scope P} (f g)%_function_scope _.
 #[export] Hint Resolve idpath inverse : path_hints.
 #[export] Hint Resolve idpath : core.
 
-Ltac path_via mid :=
-  apply @concat with (y := mid); auto with path_hints.
-
 (** ** Natural numbers *)
 
 (**  Natural numbers. *)
@@ -688,13 +684,6 @@ Scheme nat_ind := Induction for nat Sort Type.
 Scheme nat_rect := Induction for nat Sort Type.
 Scheme nat_rec := Induction for nat Sort Type.
 
-(** These schemes are therefore defined in Spaces.Nat *)
-(*
-Scheme nat_ind := Induction for nat Sort Type.
-Scheme nat_rect := Induction for nat Sort Type.
-Scheme nat_rec := Minimality for nat Sort Type.
- *)
-
 Declare Scope nat_scope.
 Delimit Scope nat_scope with nat.
 Bind Scope nat_scope with nat.

theories/Basics/Tactics.v

@@ -6,6 +6,10 @@ Require Import Basics.Overture.
 
 (** This module implements various tactics used in the library. *)
 
+(** If the goal is [x = z], [path_via y] will replace this with two goals, [x = y] and [y = z]. *)
+Ltac path_via mid :=
+  apply @concat with (y := mid); auto with path_hints.
+
 (** The following tactic is designed to be more or less interchangeable with [induction n as [ | n' IH ]] whenever [n] is a [nat] or a [trunc_index].  The difference is that it produces proof terms involving [fix] explicitly rather than [nat_ind] or [trunc_index_ind], and therefore does not introduce higher universe parameters. It works if [n] is in the context or in the goal. *)
 Ltac simple_induction n n' IH :=
   try generalize dependent n;

theories/Colimits/Quotient.v

@@ -8,7 +8,7 @@ Require Import PropResizing.
 
 Local Open Scope path_scope.
 
-(** * The set-quotient of a type by an hprop-valued relation
+(** * The set-quotient of a type by a relation
 
 We aim to model:
 <<
@@ -19,7 +19,10 @@ Inductive Quotient R : Type :=
 >>
 We do this by defining the quotient as a 0-truncated graph quotient. 
 
-Throughout this file [a], [b] and [c] are elements of [A], [R] is a relation on [A], [x], [y] and [z] are elements of [Quotient R], [p] is a proof of [R a b]. *)
+Some results require additional assumptions, for example, that the relation be hprop-valued, or that the relation be reflexive, transitive or symmetric.
+
+Throughout this file [a], [b] and [c] are elements of [A], [R] is a relation on [A], [x], [y] and [z] are elements of [Quotient R], [p] is a proof of [R a b].
+*)
 
 Definition Quotient@{i j k} {A : Type@{i}} (R : Relation@{i j} A) : Type@{k}
   := Trunc@{k} 0 (GraphQuotient@{i j k} R).
@@ -92,7 +95,7 @@ Arguments Quotient_rec_beta_qglue : simpl never.
 
 Notation "A / R" := (Quotient (A:=A) R).
 
-(* Quotient induction into a hprop. *)
+(** Quotient induction into an hprop. *)
 Definition Quotient_ind_hprop {A : Type@{i}} (R : Relation@{i j} A)
   (P : A / R -> Type) `{forall x, IsHProp (P x)}
   (dclass : forall a, P (class_of R a))
@@ -122,12 +125,51 @@ Proof.
   exact (dclass a b c).
 Defined.
 
+Definition Quotient_ind2 {A : Type} (R : Relation A)
+  (P : A / R -> A / R -> Type) `{forall x y, IsHSet (P x y)}
+  (dclass : forall a b, P (class_of R a) (class_of R b))
+  (dequiv_l : forall a a' b (p : R a a'),
+    transport (fun x => P x _) (qglue p) (dclass a b) = dclass a' b)
+  (dequiv_r : forall a b b' (p : R b b'), qglue p # dclass a b = dclass a b')
+  : forall x y, P x y.
+Proof.
+  intro x.
+  srapply Quotient_ind.
+  - intro b.
+    revert x.
+    srapply Quotient_ind.
+    + intro a.
+      exact (dclass a b).
+    + cbn beta.
+      intros a a' p.
+      by apply dequiv_l.
+  - cbn beta.
+    intros b b' p.
+    revert x.
+    srapply Quotient_ind_hprop; simpl.
+    intro a; by apply dequiv_r.
+Defined.
+
+Definition Quotient_rec2 {A : Type} (R : Relation A) (B : Type) `{IsHSet B}
+  (dclass : A -> A -> B)
+  (dequiv_l : forall a a' b, R a a' -> dclass a b = dclass a' b)
+  (dequiv_r : forall a b b', R b b' -> dclass a b = dclass a b')
+  : A / R -> A / R -> B.
+Proof.
+  srapply Quotient_ind2.
+  - exact dclass.
+  - intros; lhs nrapply transport_const.
+    by apply dequiv_l.
+  - intros; lhs nrapply transport_const.
+    by apply dequiv_r.
+Defined.
+
 Section Equiv.
 
   Context `{Univalence} {A : Type} (R : Relation A) `{is_mere_relation _ R}
     `{Transitive _ R} `{Symmetric _ R} `{Reflexive _ R}.
 
-  (* The proposition of being in a given class in a quotient. *)
+  (** The proposition of being in a given class in a quotient. This requires [Univalence] so that we know that [HProp] is a set. *)
   Definition in_class : A / R -> A -> HProp.
   Proof.
     intros x b; revert x.
@@ -140,20 +182,20 @@ Section Equiv.
     apply (transitivity p).
   Defined.
 
-  (* Being in a class is decidable if the Relation is decidable. *)
+  (** Being in a class is decidable if the relation is decidable. *)
   Global Instance decidable_in_class `{forall a b, Decidable (R a b)}
   : forall x a, Decidable (in_class x a).
   Proof.
     by srapply Quotient_ind_hprop.
   Defined.
 
-  (* if x is in a class q, then the class of x is equal to q. *)
+  (** If [a] is in a class [x], then the class of [a] is equal to [x]. *)
   Lemma path_in_class_of : forall x a, in_class x a -> x = class_of R a.
   Proof.
     srapply Quotient_ind.
-    { intros x y p.
+    { intros a b p.
       exact (qglue p). }
-    intros x y p.
+    intros a b p.
     funext ? ?.
     apply hset_path2.
   Defined.
@@ -167,7 +209,7 @@ Section Equiv.
     cbv; reflexivity.
   Defined.
 
-  (** Thm 10.1.8 *)
+  (** Theorem 10.1.8. *)
   Theorem path_quotient (a b : A)
     : R a b <~> (class_of R a = class_of R b).
   Proof.
@@ -176,33 +218,7 @@ Section Equiv.
     - apply related_quotient_paths.
   Defined.
 
-  Definition Quotient_rec2 {B : Type} `{IsHSet B} {dclass : A -> A -> B}
-    {dequiv : forall a a', R a a' -> forall b b',
-      R b b' -> dclass a b = dclass a' b'}
-    : A / R -> A / R -> B.
-  Proof.
-    clear H. (* Ensure that we don't use Univalence. *)
-    intro x.
-    srapply Quotient_rec.
-    - intro b.
-      revert x.
-      srapply Quotient_rec.
-      + intro a.
-        exact (dclass a b).
-      + cbn beta.
-        intros a a' p.
-        by apply (dequiv a a' p b b).
-    - cbn beta.
-      intros b b' p.
-      revert x.
-      srapply Quotient_ind.
-      + cbn; intro a.
-        by apply dequiv.
-      + intros a a' q.
-        apply path_ishprop.
-  Defined.
-
-  (** The map class_of : A -> A/R is a surjection. *)
+  (** The map [class_of : A -> A/R] is a surjection. *)
   Global Instance issurj_class_of : IsSurjection (class_of R).
   Proof.
     apply BuildIsSurjection.
@@ -212,8 +228,7 @@ Section Equiv.
     by exists a.
   Defined.
 
-  (* Universal property of quotient *)
-  (* Lemma 6.10.3 *)
+  (** The universal property of the quotient.  This is Lemma 6.10.3. *)
   Theorem equiv_quotient_ump (B : Type) `{IsHSet B}
     : (A / R -> B) <~> {f : A -> B & forall a b, R a b -> f a = f b}.
   Proof.

theories/Diagrams/CommutativeSquares.v

@@ -1,4 +1,4 @@
-Require Import Basics.Overture Basics.PathGroupoids.
+Require Import Basics.Overture Basics.PathGroupoids Basics.Tactics.
 
 (** * Comutative squares *)