feat(hott): small fixes in hit and cubical.square

hott/hit/pushout.hlean

@@ -78,7 +78,7 @@ parameters {TL BL TR : Type} (f : TL → BL) (g : TL → TR)
   elim_type Pinl Pinr Pglue y
 
   theorem elim_type_glue (Pinl : BL → Type) (Pinr : TR → Type)
-    (Pglue : Π(x : TL), Pinl (f x) ≃ Pinr (g x)) (y : pushout) (x : TL)
+    (Pglue : Π(x : TL), Pinl (f x) ≃ Pinr (g x)) (x : TL)
     : transport (elim_type Pinl Pinr Pglue) (glue x) = Pglue x :=
   by rewrite [tr_eq_cast_ap_fn,↑elim_type,elim_glue];apply cast_ua_fn
 

hott/hit/suspension.hlean

@@ -27,7 +27,7 @@ namespace suspension
   protected definition rec {P : suspension A → Type} (PN : P !north) (PS : P !south)
     (Pm : Π(a : A), PN =[merid a] PS) (x : suspension A) : P x :=
   begin
-    fapply (pushout.rec_on _ _ x),
+    fapply pushout.rec_on _ _ x,
     { intro u, cases u, exact PN},
     { intro u, cases u, exact PS},
     { exact Pm},
@@ -66,7 +66,7 @@ namespace suspension
   suspension.elim_type PN PS Pm x
 
   theorem elim_type_merid (PN : Type) (PS : Type) (Pm : A → PN ≃ PS)
-    (x : suspension A) (a : A) : transport (suspension.elim_type PN PS Pm) (merid a) = Pm a :=
+    (a : A) : transport (suspension.elim_type PN PS Pm) (merid a) = Pm a :=
   by rewrite [tr_eq_cast_ap_fn,↑suspension.elim_type,elim_merid];apply cast_ua_fn
 
 end suspension

hott/hit/type_quotient.hlean

@@ -6,7 +6,12 @@ Authors: Floris van Doorn
 Type quotients (quotient without truncation)
 -/
 
-/- The hit type_quotient is primitive, declared in init.hit. -/
+/-
+  The hit type_quotient is primitive, declared in init.hit.
+  The constructors are
+    class_of : A → A / R (A implicit, R explicit)
+    eq_of_rel : R a a' → a = a' (R explicit)
+-/
 
 open eq equiv sigma.ops
 

hott/types/prod.hlean

@@ -7,28 +7,21 @@ Ported from Coq HoTT
 Theorems about products
 -/
 
-open eq equiv is_equiv is_trunc prod prod.ops
+open eq equiv is_equiv is_trunc prod prod.ops unit
 
 variables {A A' B B' C D : Type}
           {a a' a'' : A} {b b₁ b₂ b' b'' : B} {u v w : A × B}
 
 namespace prod
 
-  -- prod.eta is already used for the eta rule for strict equality
-  protected definition eta (u : A × B) : (pr₁ u , pr₂ u) = u :=
+  protected definition eta (u : A × B) : (pr₁ u, pr₂ u) = u :=
   by cases u; apply idp
 
-  definition pair_eq (pa : a = a') (pb : b = b') : (a , b) = (a' , b') :=
+  definition pair_eq (pa : a = a') (pb : b = b') : (a, b) = (a', b') :=
   by cases pa; cases pb; apply idp
 
   definition prod_eq (H₁ : pr₁ u = pr₁ v) (H₂ : pr₂ u = pr₂ v) : u = v :=
-  begin
-    cases u with a₁ b₁,
-    cases v with a₂ b₂,
-    apply transport _ (prod.eta (a₁, b₁)),
-    apply transport _ (prod.eta (a₂, b₂)),
-    apply pair_eq H₁ H₂,
-  end
+  by cases u; cases v; exact pair_eq H₁ H₂
 
   /- Symmetry -/
 
@@ -41,6 +34,15 @@ namespace prod
   definition prod_comm_equiv (A B : Type) : A × B ≃ B × A :=
   equiv.mk flip _
 
+  definition prod_contr_equiv (A B : Type) [H : is_contr B] : A × B ≃ A :=
+  equiv.MK pr1
+           (λx, (x, !center))
+           (λx, idp)
+           (λx, by cases x with a b; exact pair_eq idp !center_eq)
+
+  definition prod_unit_equiv (A : Type) : A × unit ≃ A :=
+  !prod_contr_equiv
+
   -- is_trunc_prod is defined in sigma
 
 end prod

hott/types/square.hlean

@@ -64,6 +64,18 @@ namespace cubical
   definition square_of_eq (r : p₁₀ ⬝ p₂₁ = p₀₁ ⬝ p₁₂) : square p₁₀ p₁₂ p₀₁ p₂₁ :=
   by cases p₁₂; (esimp [concat] at r); cases r; cases p₂₁; cases p₁₀; exact ids
 
+  definition aps {B : Type} (f : A → B) (s₁₁ : square p₁₀ p₁₂ p₀₁ p₂₁)
+    : square (ap f p₁₀) (ap f p₁₂) (ap f p₀₁) (ap f p₂₁) :=
+  by cases s₁₁;exact ids
+
+  definition square_of_homotopy {B : Type} {f g : A → B} (H : f ∼ g) (p : a = a')
+    : square (H a) (H a') (ap f p) (ap g p) :=
+  by cases p; apply vrefl
+
+  definition square_of_homotopy' {B : Type} {f g : A → B} (H : f ∼ g) (p : a = a')
+    : square (ap f p) (ap g p) (H a) (H a') :=
+  by cases p; apply hrefl
+
   definition square_equiv_eq (t : a₀₀ = a₀₂) (b : a₂₀ = a₂₂) (l : a₀₀ = a₂₀) (r : a₀₂ = a₂₂)
     : square t b l r ≃ t ⬝ r = l ⬝ b :=
   begin