work on dependent smash and cup product on EM-spaces

also many small fixes

algebra/arrow_group.hlean

@@ -9,7 +9,7 @@ which are used in the definition of cohomology.
 -/
 
 import algebra.group_theory ..pointed ..pointed_pi eq2
-open pi pointed algebra group eq equiv is_trunc trunc susp
+open pi pointed algebra group eq equiv is_trunc trunc susp nat function
 namespace group
 
   /- Group of dependent functions into a loop space -/
@@ -39,13 +39,15 @@ namespace group
       { exact !con_left_inv_idp }},
   end
 
-  definition inf_group_ppi [constructor] {A : Type*} (B : A → Type*) :
+  definition inf_group_ppi [constructor] {A : Type*} (B : A → Type*) : inf_group (Π*a, Ω (B a)) :=
-    inf_group (Π*a, Ω (B a)) :=
   @inf_group_of_inf_pgroup _ (inf_pgroup_pppi B)
 
   definition gppi_loop [constructor] {A : Type*} (B : A → Type*) : InfGroup :=
   InfGroup.mk (Π*a, Ω (B a)) (inf_group_ppi B)
 
+  definition gppi_loopn [constructor] (n : ℕ) [H : is_succ n] {A : Type*} (B : A → Type*) : InfGroup :=
+  InfGroup.mk (Π*a, Ω[n] (B a)) (by induction H with n; exact inf_group_ppi (Ω[n] ∘ B))
+
   definition Group_trunc_ppi [reducible] [constructor] {A : Type*} (B : A → Type*) : Group :=
   gtrunc (gppi_loop B)
 
@@ -98,9 +100,7 @@ namespace group
     clear f g, esimp at *, exact ppi_mul_loop.lemma2 (f' pt) (g' pt) f_pt g_pt
   end
 
-  variable (k)
+  definition gloop_ppi_isomorphism_gen (k : ppi B x₀) :
-
-  definition gloop_ppi_isomorphism :
     Ωg (pointed.Mk k) ≃∞g gppi_loop (λ a, pointed.Mk (ppi.to_fun k a)) :=
   begin
     apply inf_isomorphism_of_equiv (ppi_loop_equiv k),
@@ -109,13 +109,24 @@ namespace group
     exact ppi_mul_loop (phomotopy_of_eq f) (phomotopy_of_eq g)
   end
 
-  definition trunc_ppi_loop_isomorphism_lemma :
+  definition gloop_ppi_isomorphism (B : A → Type*) : Ωg (Π*a, B a) ≃∞g gppi_loop B :=
-    gtrunc (gloop (pointed.Mk k)) ≃g gtrunc (gppi_loop (λa, pointed.Mk (k a))) :=
+  proof gloop_ppi_isomorphism_gen (ppi_const B) qed
-  gtrunc_isomorphism_gtrunc (gloop_ppi_isomorphism k)
 
-  definition trunc_ppi_loop_isomorphism {A : Type*} (B : A → Type*) :
+  definition gloopn_ppi_isomorphism (n : ℕ) [H : is_succ n] (B : A → Type*) :
+    Ωg[n] (Π*a, B a) ≃∞g gppi_loopn n B :=
+  begin
+    induction H with n, induction n with n IH,
+    { exact gloop_ppi_isomorphism B },
+    { exact Ωg≃ (pequiv_of_inf_isomorphism IH) ⬝∞g gloop_ppi_isomorphism (Ω[succ n] ∘ B) }
+  end
+
+  definition trunc_ppi_loop_isomorphism_gen (k : ppi B x₀) :
+    gtrunc (gloop (pointed.Mk k)) ≃g gtrunc (gppi_loop (λa, pointed.Mk (k a))) :=
+  gtrunc_isomorphism_gtrunc (gloop_ppi_isomorphism_gen k)
+
+  definition trunc_ppi_loop_isomorphism (B : A → Type*) :
     gtrunc (gloop (Π*(a : A), B a)) ≃g gtrunc (gppi_loop B) :=
-  proof trunc_ppi_loop_isomorphism_lemma (ppi_const B) qed
+  proof trunc_ppi_loop_isomorphism_gen (ppi_const B) qed
 
 
   /- We first define the group structure on A →* Ω B (except for truncatedness).
@@ -169,10 +180,10 @@ namespace group
     loop_susp_intro (pmap_mul f g) ~* pmap_mul (loop_susp_intro f) (loop_susp_intro g) :=
   pwhisker_right _ !ap1_pmap_mul ⬝* !pmap_mul_pcompose
 
-  definition InfGroup_pmap [reducible] [constructor] (A B : Type*) : InfGroup :=
+  definition gpmap_loop [reducible] [constructor] (A B : Type*) : InfGroup :=
   InfGroup.mk (A →* Ω B) !inf_group_ppi
 
-  definition InfGroup_pmap' [reducible] [constructor] (A : Type*) {B C : Type*} (e : Ω C ≃* B) :
+  definition gpmap_loop' [reducible] [constructor] (A : Type*) {B C : Type*} (e : Ω C ≃* B) :
     InfGroup :=
   InfGroup.mk (A →* B)
     (@inf_group_of_inf_pgroup _ (inf_pgroup_pequiv_closed (ppmap_pequiv_ppmap_right e)

archive/smash_assoc.hlean

@@ -1,7 +1,7 @@
 -- Authors: Floris van Doorn
 -- In collaboration with Stefano, Robin
 
-import ..homotopy.smash
+import ..homotopy.smash homotopy.red_susp
 
 open bool pointed eq equiv is_equiv sum bool prod unit circle cofiber prod.ops wedge is_trunc
      function red_susp unit sigma

homotopy/EM.hlean

@@ -346,7 +346,13 @@ namespace EM
   /- properties about EM -/
 
   definition gEM (G : AbGroup) (n : ℕ) : InfGroup :=
-  InfGroup.mk (EM G n) (inf_group_equiv_closed (loop_EM G n) _)
+  InfGroup_equiv_closed (Ωg (EMadd1 G n)) (loop_EM G n)
+
+  definition gloop_EM1 [constructor] (G : Group) : Ωg (EM1 G) ≃∞g InfGroup_of_Group G :=
+  inf_isomorphism_of_equiv (EM.base_eq_base_equiv G) groupoid_quotient.encode_con
+
+  definition gEM0_isomorphism (G : AbGroup) : gEM G 0 ≃∞g InfGroup_of_Group G :=
+  !InfGroup_equiv_closed_isomorphism⁻¹ᵍ⁸ ⬝∞g gloop_EM1 G
 
   definition gEM_functor {G H : AbGroup} (φ : G →g H) (n : ℕ) : gEM G n →∞g gEM H n :=
   inf_homomorphism.mk (EM_functor φ n) sorry
@@ -359,6 +365,14 @@ namespace EM
     { have is_trunc (n.+1) X, from H, exact EMadd1_pmap n e }
   end
 
+  definition EM_homomorphism_gloop [unfold 8] {G : AbGroup} (X : Type*) (n : ℕ)
+    (e : AbInfGroup_of_AbGroup G →∞g Ωg[succ n] X) [H : is_trunc n X] : gEM G n →∞g Ωg X :=
+  Ωg→ (EMadd1_pmap n e) ∘∞g !InfGroup_equiv_closed_isomorphism⁻¹ᵍ⁸
+
+  -- definition EM_homomorphism [unfold 8] {G : AbGroup} {X : Type*} (Y : Type*) (e : Ω Y ≃* X) (n : ℕ)
+  --   (e : AbInfGroup_of_AbGroup G →∞g Ωg[succ n] X) [H : is_trunc n X] : gEM G n →∞g X :=
+  -- _
+
   -- definition gEM_gfunctor {G H : AbGroup} (n : ℕ) : (G →gg H) →∞g (gEM G n →∞g gEM H n) :=
   -- inf_homomorphism.mk (EM_functor _ n) sorry
 

homotopy/EMRing.hlean

@@ -38,7 +38,7 @@ begin
   --     EM0EMadd1product φ m
 end
 
-definition EMproduct {A B C : AbGroup} (φ : A →g B →gg C) (n m : ℕ) :
+definition EMproduct1 {A B C : AbGroup} (φ : A →g B →gg C) (n m : ℕ) :
   EM A n →* EM B m →** EM C (m + n) :=
 begin
   cases n with n,
@@ -51,17 +51,29 @@ begin
     { exact ppcompose_left (ptransport (EMadd1 C) !succ_add⁻¹) ∘* EMadd1product φ n m }}
 end
 
-definition EMproduct' {A B C : AbGroup} (φ : A →g B →gg C) (n m : ℕ) :
+definition EMproduct2 {A B C : AbGroup} (φ : A →g B →gg C) (n m : ℕ) :
   EM A n →* EM B m →** EM C (m + n) :=
 begin
-  assert H1 : is_trunc n (InfGroup_pmap' (EM B m) (loop_EM C (m + n))),
+  assert H1 : is_trunc n (gpmap_loop' (EM B m) (loop_EM C (m + n))),
   { exact is_trunc_pmap_of_is_conn_nat _ m !is_conn_EM _ _ _ !le.refl !is_trunc_EM },
-  apply EM_pmap (InfGroup_pmap' (EM B m) (loop_EM C (m + n))) n,
+  apply EM_pmap (gpmap_loop' (EM B m) (loop_EM C (m + n))) n,
   exact sorry
   -- exact _ /- (loopn_ppmap_pequiv _ _ _)⁻¹ᵉ* -/ ∘∞g _ /-ppcompose_left !loopn_EMadd1_add⁻¹ᵉ*-/ ∘∞g
   --      _ ∘∞g inf_homomorphism_of_homomorphism φ
 
 end
 
+definition EMproduct3' {A B C : AbGroup} (φ : A →g B →gg C) (n m : ℕ) :
+  gEM A n →∞g gpmap_loop' (EM B m) (loop_EM C (m + n)) :=
+begin
+  assert H1 : is_trunc n (gpmap_loop' (EM B m) (loop_EM C (m + n))),
+  { exact is_trunc_pmap_of_is_conn_nat _ m !is_conn_EM _ _ _ !le.refl !is_trunc_EM },
+--   refine EM_homomorphism _ _ _,
+-- --(gmap_loop' (EM B m) (loop_EM C (m + n))) n,
+--   exact _ /- (loopn_ppmap_pequiv _ _ _)⁻¹ᵉ* -/ ∘∞g _ /-ppcompose_left !loopn_EMadd1_add⁻¹ᵉ*-/ ∘∞g
+--        _ ∘∞g inf_homomorphism_of_homomorphism φ
+  exact sorry
+end
+
 
 end EM

homotopy/degree.hlean

@@ -1,6 +1,6 @@
 import homotopy.sphere2 ..move_to_lib
 
-open fin eq equiv group algebra sphere.ops pointed nat int trunc is_equiv function circle
+open fin eq equiv group algebra sphere.ops pointed trunc is_equiv function circle int nat
 
   protected definition nat.eq_one_of_mul_eq_one {n : ℕ} (m : ℕ) (q : n * m = 1) : n = 1 :=
   begin
@@ -83,7 +83,8 @@ namespace sphere
 --                 (pair 1 2))
 --              (tr surf))
 
-  definition πnSn_surf (n : ℕ) : πnSn (n+1) (tr surf) = 1 :> ℤ :=
+  attribute gloopn [reducible]
+  definition πnSn_surf (n : ℕ) : πnSn (n+1) (tr (@surf (n+1))) = 1 :=
   begin
     cases n with n IH,
     { refine ap (πnSn _ ∘ tr) surf_eq_loop ⬝ _, apply transport_code_loop },
@@ -91,7 +92,7 @@ namespace sphere
   end
 
   definition deg {n : ℕ} [H : is_succ n] (f : S n →* S n) : ℤ :=
-  by induction H with n; exact πnSn (n+1) (π→g[n+1] f (tr surf))
+  by induction H with n; exact πnSn (n+1) (π→g[n+1] f (tr (@surf (n+1))))
 
   definition deg_id (n : ℕ) [H : is_succ n] : deg (pid (S n)) = (1 : ℤ) :=
   by induction H with n;

homotopy/smash.hlean

@@ -1,9 +1,9 @@
 -- Authors: Floris van Doorn
 
-import homotopy.smash types.pointed2 .pushout homotopy.red_susp ..pointed
+import homotopy.smash types.pointed2 .pushout ..pointed
 
 open bool pointed eq equiv is_equiv sum bool prod unit circle cofiber prod.ops wedge is_trunc
-     function red_susp unit
+     function unit
 
   /- To prove: Σ(X × Y) ≃ ΣX ∨ ΣY ∨ Σ(X ∧ Y) (notation means suspension, wedge, smash) -/
 

homotopy/spherical_fibrations.hlean

@@ -20,7 +20,7 @@ namespace spherical_fibrations
   definition G_char (n : ℕ) [is_succ n] : G n ≃ (S (pred n) ≃ S (pred n)) :=
   calc
     G n ≃ Σ(p : pType.carrier (S (pred n)) = pType.carrier (S (pred n))), _ : sigma_eq_equiv
-    ... ≃ (pType.carrier (S (pred n)) = pType.carrier (S (pred n))) : sigma_equiv_of_is_contr_right
+    ... ≃ (pType.carrier (S (pred n)) = pType.carrier (S (pred n))) : sigma_equiv_of_is_contr_right _ _
     ... ≃ (S (pred n) ≃ S (pred n)) : eq_equiv_equiv
 
   definition mirror (n : ℕ) [is_succ n] : S (pred n) → G n :=

move_to_lib.hlean

@@ -125,7 +125,7 @@ namespace sigma
   definition sigma_equiv_of_is_embedding_left_contr [constructor] {X Y : Type} {P : Y → Type}
     (f : X → Y) (Hf : is_embedding f) (HP : Πx, is_contr (P (f x))) (H : Πy, P y → fiber f y) :
     (Σy, P y) ≃ X :=
-  sigma_equiv_of_is_embedding_left f Hf _ H ⬝e !sigma_equiv_of_is_contr_right
+  sigma_equiv_of_is_embedding_left f Hf _ H ⬝e sigma_equiv_of_is_contr_right _ _
 
 end sigma open sigma
 

pointed_binary.hlean

@@ -10,6 +10,7 @@ open eq pointed equiv sigma is_equiv trunc option pi function fiber sigma.ops
 
 namespace pointed
 
+section bpmap
 /- binary pointed maps -/
 structure bpmap (A B C : Type*) : Type :=
   (f : A → B →* C)
@@ -159,6 +160,99 @@ begin
     { exact sorry }},
   { exact sorry }
 end
+end bpmap
 
+/- fiberwise pointed maps -/
+structure dbpmap {A : Type*} (B C : A → Type*) : Type :=
+  (f : Πa, B a →* C a)
+  (q : Πb, f pt b = pt)
+  (r : q pt = respect_pt (f pt))
+
+attribute [coercion] dbpmap.f
+variables {A A' : Type*} {B C : A → Type*} {B' C' : A' → Type*} {f f' : dbpmap B C}
+definition respect_ptd1 [unfold 4] (f : dbpmap B C) (b : B pt) : f pt b = pt :=
+dbpmap.q f b
+
+definition respect_ptd2 [unfold 4] (f : dbpmap B C) (a : A) : f a pt = pt :=
+respect_pt (f a)
+
+definition respect_dptpt [unfold 4] (f : dbpmap B C) : respect_ptd1 f pt = respect_ptd2 f pt :=
+dbpmap.r f
+
+definition dbpconst [constructor] (B C : A → Type*) : dbpmap B C :=
+dbpmap.mk (λa, pconst (B a) (C a)) (λb, idp) idp
+
+definition dbppmap [constructor] (B C : A → Type*) : Type* :=
+pointed.MK (dbpmap B C) (dbpconst B C)
+
+definition ppi_of_dbpmap [constructor] (f : dbppmap B C) : Π*a, B a →** C a :=
+begin
+  fapply ppi.mk,
+  { intro a, exact pmap.mk (f a) (respect_ptd2 f a) },
+  { exact eq_of_phomotopy (phomotopy.mk (respect_ptd1 f) (respect_dptpt f)) }
+end
+
+definition dbpmap_of_ppi [constructor] (f : Π*a, B a →** C a) : dbppmap B C :=
+begin
+  apply dbpmap.mk (λa, f a) (ap010 pmap.to_fun (respect_pt f)),
+  exact respect_pt (phomotopy_of_eq (respect_pt f))
+end
+
+protected definition dbpmap.sigma_char [constructor] (B C : A → Type*) :
+  dbpmap B C ≃ Σ(f : Πa, B a →* C a) (q : Πb, f pt b = pt), q pt = respect_pt (f pt) :=
+begin
+  fapply equiv.MK,
+  { intro f, exact ⟨f, respect_ptd1 f, respect_dptpt f⟩ },
+  { intro fqr, exact dbpmap.mk fqr.1 fqr.2.1 fqr.2.2 },
+  { intro fqr, induction fqr with f qr, induction qr with q r, reflexivity },
+  { intro f, induction f, reflexivity }
+end
+
+definition dbpmap_eq_equiv [constructor] (f f' : dbpmap B C):
+  f = f' ≃ Σ(h : Πa, f a ~* f' a) (q : Πb, square (respect_ptd1 f b) (respect_ptd1 f' b) (h pt b) idp), cube (vdeg_square (respect_dptpt f)) (vdeg_square (respect_dptpt f'))
+       vrfl ids
+       (q pt) (to_homotopy_pt_square (h pt)) :=
+begin
+  refine eq_equiv_fn_eq (dbpmap.sigma_char B C) f f' ⬝e _,
+  refine !sigma_eq_equiv ⬝e _, esimp,
+  refine sigma_equiv_sigma (!eq_equiv_homotopy ⬝e pi_equiv_pi_right (λa, !pmap_eq_equiv)) _,
+  intro h, exact sorry
+end
+
+definition dbpmap_eq [constructor] (h : Πa, f a ~* f' a)
+  (q : Πb, square (respect_ptd1 f b) (respect_ptd1 f' b) (h pt b) idp)
+  (r : cube (vdeg_square (respect_dptpt f)) (vdeg_square (respect_dptpt f'))
+       vrfl ids
+       (q pt) (to_homotopy_pt_square (h pt))) : f = f' :=
+(dbpmap_eq_equiv f f')⁻¹ᵉ ⟨h, q, r⟩
+
+definition ppi_equiv_dbpmap [constructor] (B C : A → Type*) : (Π*a, B a →** C a) ≃ dbpmap B C :=
+begin
+  refine !ppi.sigma_char ⬝e _ ⬝e !dbpmap.sigma_char⁻¹ᵉ,
+  refine sigma_equiv_sigma_right (λf, pmap_eq_equiv (f pt) !pconst) ⬝e _,
+  refine sigma_equiv_sigma_right (λf, !phomotopy.sigma_char)
+end
+
+definition ppi_equiv_dbpmap' [constructor] (B C : A → Type*) : (Π*a, B a →** C a) ≃ dbpmap B C :=
+begin
+  refine equiv_change_fun (ppi_equiv_dbpmap B C) _,
+  exact dbpmap_of_ppi, intro f, reflexivity
+end
+
+definition pppi_pequiv_dbppmap [constructor] (B C : A → Type*) :
+  (Π*a, B a →** C a) ≃* dbppmap B C :=
+pequiv_of_equiv (ppi_equiv_dbpmap' B C) idp
+
+definition dbpmap_functor [constructor] (f : A' →* A) (g : Πa, B' a →* B (f a)) (h : Πa, C (f a) →* C' a)
+  (k : dbpmap B C) : dbpmap B' C' :=
+begin
+  fapply dbpmap.mk (λa', h a' ∘* k (f a') ∘* g a'),
+  { intro b', refine ap (h pt) _ ⬝ respect_pt (h pt),
+    exact sorry }, --ap010 (λa b, k a b) (respect_pt f) (g pt b') ⬝ respect_ptd1 k (g pt b') },
+  { exact sorry },
+    -- apply whisker_right, apply ap02 h, esimp,
+    -- induction A with A a₀, induction B with B b₀, induction f with f f₀, induction g with g g₀,
+    -- esimp at *, induction f₀, induction g₀, esimp, apply whisker_left, exact respect_dptpt k },
+end
 
 end pointed

pointed_pi.hlean

@@ -699,7 +699,7 @@ namespace pointed
   definition psigma_gen_assoc [constructor] {A : Type*} {B : A → Type} (C : Πa, B a → Type)
     (b₀ : B pt) (c₀ : C pt b₀) :
     psigma_gen (λa, Σb, C a b) ⟨b₀, c₀⟩ ≃* @psigma_gen (psigma_gen B b₀) (λv, C v.1 v.2) c₀ :=
-  pequiv_of_equiv !sigma_assoc_equiv idp
+  pequiv_of_equiv !sigma_assoc_equiv' idp
 
   definition psigma_gen_swap [constructor] {A : Type*} {B B' : A → Type}
     (C : Π⦃a⦄, B a → B' a → Type) (b₀ : B pt) (b₀' : B' pt) (c₀ : C b₀ b₀') :

spectrum/basic.hlean

@@ -562,7 +562,7 @@ namespace spectrum
 
   definition shomotopy_group_isomorphism_of_pequiv (n : ℤ) {E F : spectrum} (f : Πn, E n ≃* F n) :
     πₛ[n] E ≃g πₛ[n] F :=
-  proof homotopy_group_isomorphism_of_pequiv 1 (f (2 - n)) qed
+  by rexact homotopy_group_isomorphism_of_pequiv 1 (f (2 - n))
 
   definition shomotopy_group_isomorphism_of_pequiv_nat (n : ℕ) {E F : spectrum}
     (f : Πn, E n ≃* F n) : πₛ[n] E ≃g πₛ[n] F :=
@@ -699,8 +699,8 @@ namespace spectrum
   definition shomotopy_groups_fun : Π(v : +3ℤ), shomotopy_groups (S v) →g shomotopy_groups v
   | (n, fin.mk 0 H) := proof πₛ→[n] f qed
   | (n, fin.mk 1 H) := proof πₛ→[n] (spoint f) qed
-  | (n, fin.mk 2 H) := proof homomorphism_LES_of_homotopy_groups_fun (f (2 - n)) (nat.succ nat.zero, 2) ∘g
+  | (n, fin.mk 2 H) := by rexact homomorphism_LES_of_homotopy_groups_fun (f (2 - n)) (nat.succ nat.zero, 2) ∘g
-                             πg_glue Y n ∘g (by reflexivity) qed
+                             πg_glue Y n
   | (n, fin.mk (k+3) H) := begin exfalso, apply lt_le_antisymm H, apply le_add_left end
 --(homomorphism_LES_of_homotopy_groups_fun (f (2 - n)) (1, 2) ∘g πg_glue Y n)
 
@@ -724,13 +724,15 @@ namespace spectrum
 
   /- homotopy group of a prespectrum -/
 
+  local attribute [reducible] agtrunc aghomotopy_group ghomotopy_group gtrunc
   definition pshomotopy_group_hom (n : ℤ) (E : prespectrum) (k : ℕ)
     : πag[k + 2] (E (-n + 2 + k)) →g πag[k + 3] (E (-n + 2 + (k + 1))) :=
   begin
+    change πg[k + 2] (E (-n + 2 + k)) →g πg[k + 3] (E (-n + 2 + (k + 1))),
     refine _ ∘g π→g[k+2] (glue E _),
     refine (ghomotopy_group_succ_in (k+1) _)⁻¹ᵍ ∘g _,
-    refine homotopy_group_isomorphism_of_pequiv (k+1)
+    refine homotopy_group_isomorphism_of_pequiv (k+1) _,
-      (loop_pequiv_loop (pequiv_of_eq (ap E (add.assoc (-n + 2) k 1))))
+    exact (loop_pequiv_loop (pequiv_of_eq (ap E (add.assoc (-n + 2) k 1))))
   end
 
   definition pshomotopy_group (n : ℤ) (E : prespectrum) : AbGroup :=

univalent_subcategory.hlean

@@ -166,7 +166,7 @@ repeat (fconstructor; assumption), assumption, intro b,
 open sigma.ops
 
 definition sigma_prod_equiv_sigma_sigma {A} {B C : A→Type} : (Σa, B a × C a) ≃ Σ p : (Σa, B a), C p.1 :=
-sigma_equiv_sigma_right (λa, !sigma.equiv_prod⁻¹ᵉ) ⬝e !sigma_assoc_equiv
+sigma_equiv_sigma_right (λa, !sigma.equiv_prod⁻¹ᵉ) ⬝e !sigma_assoc_equiv'
 
 definition ab_group_equiv_group_comm (A : Type) : ab_group A ≃ Σ (g : group A), ∀ a b : A, a * b = b * a :=
 begin
@@ -232,7 +232,7 @@ end
     ((sigma_char2 G).2 =[p] (sigma_char2 H).2) ≃
     (is_mul_hom (equiv_of_eq (proof p qed : Group.carrier G = Group.carrier H))) :=
   begin
-    refine !sigma_pathover_equiv_of_is_prop ⬝e _,
+    refine sigma_pathover_equiv_of_is_prop _ _ _ _ _ ⬝e _,
     induction G with G g, induction H with H h,
     esimp [sigma_char2] at p,
 esimp [sigma_functor] at p, esimp [Group_sigma] at *,