move naturality of loop-susp-adjunction to standard library

homotopy/realprojective.hlean

@@ -249,7 +249,7 @@ definition theorem_III_3 (n : ℕ)
   : sphere n ≃ sigma (realprojective_cov n) :=
 begin
   induction n with n IH,
-  { symmetry, apply sorry /-sigma_empty_left-/ },
+  { symmetry, exact sorry },
   { apply equiv.trans (join_bool (sphere n))⁻¹ᵉ,
     apply equiv.trans (join_equiv_join erfl IH),
     symmetry, refine equiv.trans _ !join_symm,

homotopy/smash_adjoint.hlean

@@ -510,10 +510,10 @@ namespace smash
     ppmap (A ∧ susp B) X ≃* ppmap (susp (A ∧ B)) X :=
   calc
     ppmap (A ∧ susp B) X ≃* ppmap (susp B) (ppmap A X) : smash_adjoint_pmap A (susp B) X
-    ... ≃* ppmap B (Ω (ppmap A X)) : susp_adjoint_loop' B (ppmap A X)
+    ... ≃* ppmap B (Ω (ppmap A X)) : susp_adjoint_loop B (ppmap A X)
     ... ≃* ppmap B (ppmap A (Ω X)) : pequiv_ppcompose_left (loop_ppmap_commute A X)
     ... ≃* ppmap (A ∧ B) (Ω X) : smash_adjoint_pmap A B (Ω X)
-    ... ≃* ppmap (susp (A ∧ B)) X : susp_adjoint_loop' (A ∧ B) X
+    ... ≃* ppmap (susp (A ∧ B)) X : susp_adjoint_loop (A ∧ B) X
 
   definition smash_susp_elim_natural_right (A B : Type*) (f : X →* X') :
     psquare (smash_susp_elim_equiv A B X) (smash_susp_elim_equiv A B X')

homotopy/susp.hlean

@@ -5,63 +5,6 @@ open susp eq pointed function is_equiv lift equiv is_trunc nat
 namespace susp
   variables {X X' Y Y' Z : Type*}
 
-  definition susp_functor_pconst_homotopy [unfold 3] {X Y : Type*} (x : susp X) :
-    susp_functor (pconst X Y) x = pt :=
-  begin
-    induction x,
-    { reflexivity },
-    { exact (merid pt)⁻¹ },
-    { apply eq_pathover, refine !elim_merid ⬝ph _ ⬝hp !ap_constant⁻¹, exact square_of_eq !con.right_inv⁻¹ }
-  end
-
-  definition susp_functor_pconst [constructor] (X Y : Type*) : susp_functor (pconst X Y) ~* pconst (susp X) (susp Y) :=
-  begin
-    fapply phomotopy.mk,
-    { exact susp_functor_pconst_homotopy },
-    { reflexivity }
-  end
-
-  definition susp_pfunctor [constructor] (X Y : Type*) : ppmap X Y →* ppmap (susp X) (susp Y) :=
-  pmap.mk susp_functor (eq_of_phomotopy !susp_functor_pconst)
-
-  definition susp_pelim [constructor] (X Y : Type*) : ppmap X (Ω Y) →* ppmap (susp X) Y :=
-  ppcompose_left (loop_susp_counit Y) ∘* susp_pfunctor X (Ω Y)
-
-  definition loop_susp_pintro [constructor] (X Y : Type*) : ppmap (susp X) Y →* ppmap X (Ω Y) :=
-  ppcompose_right (loop_susp_unit X) ∘* pap1 (susp X) Y
-
-  definition loop_susp_pintro_natural_left (f : X' →* X) :
-    psquare (loop_susp_pintro X Y) (loop_susp_pintro X' Y)
-            (ppcompose_right (susp_functor f)) (ppcompose_right f) :=
-  !pap1_natural_left ⬝h* ppcompose_right_psquare (loop_susp_unit_natural f)⁻¹*
-
-  definition loop_susp_pintro_natural_right (f : Y →* Y') :
-    psquare (loop_susp_pintro X Y) (loop_susp_pintro X Y')
-            (ppcompose_left f) (ppcompose_left (Ω→ f)) :=
-  !pap1_natural_right ⬝h* !ppcompose_left_ppcompose_right⁻¹*
-
-  definition is_equiv_loop_susp_pintro [constructor] (X Y : Type*) :
-    is_equiv (loop_susp_pintro X Y) :=
-  begin
-    fapply adjointify,
-    { exact susp_pelim X Y },
-    { intro g, apply eq_of_phomotopy, exact susp_adjoint_loop_right_inv g },
-    { intro f, apply eq_of_phomotopy, exact susp_adjoint_loop_left_inv f }
-  end
-
-  definition susp_adjoint_loop' [constructor] (X Y : Type*) : ppmap (susp X) Y ≃* ppmap X (Ω Y) :=
-  pequiv_of_pmap (loop_susp_pintro X Y) (is_equiv_loop_susp_pintro X Y)
-
-  definition susp_adjoint_loop_natural_right (f : Y →* Y') :
-    psquare (susp_adjoint_loop' X Y) (susp_adjoint_loop' X Y')
-            (ppcompose_left f) (ppcompose_left (Ω→ f)) :=
-  loop_susp_pintro_natural_right f
-
-  definition susp_adjoint_loop_natural_left (f : X' →* X) :
-    psquare (susp_adjoint_loop' X Y) (susp_adjoint_loop' X' Y)
-            (ppcompose_right (susp_functor f)) (ppcompose_right f) :=
-  loop_susp_pintro_natural_left f
-
   definition iterate_susp_iterate_susp_rev (n m : ℕ) (A : Type*) :
     iterate_susp n (iterate_susp m A) ≃* iterate_susp (m + n) A :=
   begin