diff --git a/.github/workflows/push.yml b/.github/workflows/push.yml
index eba1e6f1..02941bc6 100644
--- a/.github/workflows/push.yml
+++ b/.github/workflows/push.yml
@@ -14,22 +14,25 @@ jobs:
     name: Lint style
     runs-on: ubuntu-latest
     steps:
+      - name: Checkout project
+        uses: actions/checkout@v4
+
       - name: Check for long lines
         if: always()
         run: |
-          ! (find HoTTLean -name "*.lean" -type f -exec grep -E -H -n '^.{101,}$' {} \; | grep -v -E 'https?://')
+          ! (grep -E -H -n '^.{101,}$' HoTTLean.lean HoTTLeanTest.lean lakefile.lean $(find HoTTLean HoTTLeanTest -name '*.lean') | grep -v -E 'https?://')
 
       - name: Don't 'import Mathlib', use precise imports
         if: always()
         run: |
-          ! (find HoTTLean -name "*.lean" -type f -print0 | xargs -0 grep -E -n '^import Mathlib$')
+          ! grep -E -H -n '^import Mathlib$' HoTTLean.lean HoTTLeanTest.lean lakefile.lean $(find HoTTLean HoTTLeanTest -name '*.lean')
 
   build_project:
     runs-on: ubuntu-latest
     name: Build project
     steps:
       - name: Checkout project
-        uses: actions/checkout@v2
+        uses: actions/checkout@v4
         with:
           fetch-depth: 0
 
diff --git a/.github/workflows/push_pr.yml b/.github/workflows/push_pr.yml
index a38a4eb1..8dc19568 100644
--- a/.github/workflows/push_pr.yml
+++ b/.github/workflows/push_pr.yml
@@ -2,12 +2,29 @@ on:
   pull_request:
 
 jobs:
+  style_lint:
+    name: Lint style
+    runs-on: ubuntu-latest
+    steps:
+      - name: Checkout project
+        uses: actions/checkout@v4
+
+      - name: Check for long lines
+        if: always()
+        run: |
+          ! (grep -E -H -n '^.{101,}$' HoTTLean.lean HoTTLeanTest.lean lakefile.lean $(find HoTTLean HoTTLeanTest -name '*.lean') | grep -v -E 'https?://')
+
+      - name: Don't 'import Mathlib', use precise imports
+        if: always()
+        run: |
+          ! grep -E -H -n '^import Mathlib$' HoTTLean.lean HoTTLeanTest.lean lakefile.lean $(find HoTTLean HoTTLeanTest -name '*.lean')
+
   build_project:
     runs-on: ubuntu-latest
     name: Build project
     steps:
       - name: Checkout project
-        uses: actions/checkout@v2
+        uses: actions/checkout@v4
         with:
           fetch-depth: 0
 
diff --git a/.gitignore b/.gitignore
index 193bae23..2d5201a5 100644
--- a/.gitignore
+++ b/.gitignore
@@ -15,6 +15,7 @@ blueprint/src/chapter/auto
 blueprint/lean_decls
 blueprint/print/
 home_page/blueprint
+home_page/_site/
 *.pdf
 ## Docs
 docs/_includes/sorries.md
diff --git a/HoTTLean/ForMathlib.lean b/HoTTLean/ForMathlib.lean
index 0d1cd8c9..289437f3 100644
--- a/HoTTLean/ForMathlib.lean
+++ b/HoTTLean/ForMathlib.lean
@@ -1,10 +1,10 @@
 import Mathlib.CategoryTheory.Limits.Shapes.Pullback.PullbackCone
 import Mathlib.CategoryTheory.Groupoid.Discrete
-import Mathlib.CategoryTheory.Limits.Shapes.Pullback.CommSq
+import Mathlib.CategoryTheory.Limits.Shapes.Pullback.IsPullback.Basic
 import Mathlib.CategoryTheory.Category.ULift
 import Mathlib.Logic.Function.ULift
 import Mathlib.CategoryTheory.Category.Cat
-import Mathlib.CategoryTheory.Category.Grpd
+import Mathlib.CategoryTheory.Groupoid.Grpd.Basic
 import Mathlib.Data.Part
 import Mathlib.CategoryTheory.Monoidal.Cartesian.Basic
 import Mathlib.CategoryTheory.Core
@@ -19,8 +19,10 @@ to be upstreamed. -/
 This comment space is for notes about mathlib definitions/theorems that should be fixed, refactored,
 or redesigned.
 
-- AsSmall.down and AsSmall.up should have their universe level order changed so that the third value comes first.
-- currently I often write AsSmall.{_,_,w} because the first two can be inferred but not the max universe.
+- AsSmall.down and AsSmall.up should have their universe level order changed
+  so that the third value comes first.
+- currently I often write AsSmall.{_,_,w} because the first two can be inferred
+  but not the max universe.
 
 -/
 
@@ -35,8 +37,13 @@ theorem Limits.PullbackCone.IsLimit.comp_lift {C : Type*} [Category C]
     (σ : W' ⟶ W) (ht : Limits.IsLimit t) (h : W ⟶ X) (k : W ⟶ Y) (w : h ≫ f = k ≫ g) :
     σ ≫ ht.lift (PullbackCone.mk h k w) =
       ht.lift (PullbackCone.mk (σ ≫ h) (σ ≫ k) (by simp [w])) := by
-  refine ht.hom_ext fun j => ?_
-  rcases j with _ | _ | _ <;> simp
+  apply PullbackCone.IsLimit.hom_ext ht
+  · exact (Category.assoc _ _ _).trans
+      ((congrArg (σ ≫ ·) (ht.fac _ WalkingCospan.left)).trans
+        (ht.fac (PullbackCone.mk (σ ≫ h) (σ ≫ k) (by simp [w])) WalkingCospan.left).symm)
+  · exact (Category.assoc _ _ _).trans
+      ((congrArg (σ ≫ ·) (ht.fac _ WalkingCospan.right)).trans
+        (ht.fac (PullbackCone.mk (σ ≫ h) (σ ≫ k) (by simp [w])) WalkingCospan.right).symm)
 
 end CategoryTheory
 
@@ -101,29 +108,29 @@ namespace CategoryTheory.Cat
 
 /-- This is the proof of equality used in the eqToHom in `Cat.eqToHom_hom` -/
 theorem eqToHom_hom_aux {C1 C2 : Cat.{v,u}} (x y: C1) (eq : C1 = C2) :
-    (x ⟶ y) = ((eqToHom eq).obj x ⟶ (eqToHom eq).obj y) := by
+    (x ⟶ y) = ((eqToHom eq).toFunctor.obj x ⟶ (eqToHom eq).toFunctor.obj y) := by
   cases eq
-  simp[CategoryStruct.id]
+  rfl
 
 /-- This is the turns the hom part of eqToHom functors into a cast-/
 theorem eqToHom_hom {C1 C2 : Cat.{v,u}} {x y: C1} (f : x ⟶ y) (eq : C1 = C2) :
-    (eqToHom eq).map f = (cast (Cat.eqToHom_hom_aux x y eq) f) := by
+    (eqToHom eq).toFunctor.map f = (cast (Cat.eqToHom_hom_aux x y eq) f) := by
   cases eq
   simp[CategoryStruct.id]
 
 /-- This turns the object part of eqToHom functors into casts -/
 theorem eqToHom_obj {C1 C2 : Cat.{v,u}} (x : C1) (eq : C1 = C2) :
-    (eqToHom eq).obj x = cast (congrArg Bundled.α eq) x := by
+    (eqToHom eq).toFunctor.obj x = cast (congrArg Bundled.α eq) x := by
   cases eq
   simp[CategoryStruct.id]
 
 abbrev homOf {C D : Type u} [Category.{v} C] [Category.{v} D] (F : C ⥤ D) :
-    Cat.of C ⟶ Cat.of D := F
+    Cat.of C ⟶ Cat.of D := F.toCatHom
 
 @[simps] def ULift_lte_iso_self {C : Type (max u u₁)} [Category.{v} C] :
     Cat.of (ULift.{u} C) ≅ Cat.of C where
-  hom := ULift.downFunctor
-  inv := ULift.upFunctor
+  hom := ULift.downFunctor.toCatHom
+  inv := ULift.upFunctor.toCatHom
 
 @[simp] def ULift_succ_iso_self {C : Type (u + 1)} [Category.{v} C] :
     of (ULift.{u, u + 1} C) ≅ of C := ULift_lte_iso_self.{v,u,u+1}
@@ -136,7 +143,7 @@ def ofULift (C : Type u) [Category.{v} C] : Cat.{v, max u w} :=
 
 def uLiftFunctor : Cat.{v,u} ⥤ Cat.{v, max u w} where
   obj X := Cat.ofULift.{w} X
-  map F := Cat.homOf $ ULift.downFunctor ⋙ F ⋙ ULift.upFunctor
+  map F := Cat.homOf $ ULift.downFunctor ⋙ F.toFunctor ⋙ ULift.upFunctor
 
 end CategoryTheory.Cat
 
@@ -171,7 +178,7 @@ variable {C : Type u₁} [Category.{v₁} C]
 variable {P X Y Z : C} {fst : P ⟶ X} {snd : P ⟶ Y} {f : X ⟶ Z} {g : Y ⟶ Z}
 
 theorem of_iso_isPullback (h : IsPullback fst snd f g) {Q} (i : Q ≅ P) :
-      IsPullback (i.hom ≫ fst) (i.hom ≫ snd) f g := by
+    IsPullback (i.hom ≫ fst) (i.hom ≫ snd) f g := by
   have : HasPullback f g := ⟨ h.cone , h.isLimit ⟩
   refine IsPullback.of_iso_pullback (by simp [h.w]) (i ≪≫ h.isoPullback) (by simp) (by simp)
 
@@ -210,26 +217,26 @@ namespace AsSmall
   AsSmall.up.map (AsSmall.down.map f) = f := rfl
 
 theorem comp_up_inj {C : Type u} [Category.{v} C]
-  {D : Type u₁} [Category.{v₁} D]
+    {D : Type u₁} [Category.{v₁} D]
     {F G : C ⥤ D}
     (h : F ⋙ (AsSmall.up : D ⥤ AsSmall.{w} D) =
-      G ⋙ AsSmall.up)
-    : F = G := by
-  convert_to F ⋙ (AsSmall.up : D ⥤ AsSmall.{w} D)
-    ⋙ AsSmall.down
-    = G ⋙ (AsSmall.up : D ⥤ AsSmall.{w} D)
-    ⋙ AsSmall.down
-  simp only [← Functor.assoc, h]
+      G ⋙ AsSmall.up) :
+    F = G := by
+  have h' := congrArg (fun K : C ⥤ AsSmall.{w} D => K ⋙ AsSmall.down) h
+  have h'' : F ⋙ (AsSmall.up ⋙ AsSmall.down) =
+      G ⋙ (AsSmall.up ⋙ AsSmall.down) := by
+    simpa only [← Functor.assoc] using h'
+  have h₀ : AsSmall.up ⋙ AsSmall.down = Functor.id D := rfl
+  rw [h₀, Functor.comp_id] at h''
+  exact h''
 
 theorem comp_down_inj {C : Type u} [Category.{v} C]
-  {D : Type u₁} [Category.{v₁} D]
+    {D : Type u₁} [Category.{v₁} D]
     {F G : C ⥤ AsSmall.{w} D}
-    (h : F ⋙ AsSmall.down = G ⋙ AsSmall.down)
-    : F = G := by
-  convert_to F ⋙ AsSmall.down
-    ⋙ AsSmall.up
-    = G ⋙ AsSmall.down ⋙ AsSmall.up
-  simp only [← Functor.assoc, h]
+    (h : F ⋙ AsSmall.down = G ⋙ AsSmall.down) :
+    F = G := by
+  have h' := congrArg (fun K : C ⥤ D => K ⋙ AsSmall.up) h
+  convert h' using 1 <;> rfl
 
 @[simp] theorem up_comp_down
     {C : Type u₁} [Category.{v₁, u₁} C] :
@@ -250,6 +257,16 @@ namespace Groupoid
 instance asSmallGroupoid (Γ : Type u) [Groupoid.{v} Γ] :
     Groupoid (AsSmall.{w} Γ) where
   inv f := AsSmall.up.map (inv (AsSmall.down.map f))
+  inv_comp f := by
+    cases f with
+    | up f =>
+      change ULift.up (inv f ≫ f) = ULift.up (𝟙 _)
+      simp
+  comp_inv f := by
+    cases f with
+    | up f =>
+      change ULift.up (f ≫ inv f) = ULift.up (𝟙 _)
+      simp
 
 end Groupoid
 
@@ -330,9 +347,9 @@ def isLimitProdCone (X Y : D) : IsLimit (e.prodCone X Y) :=
   BinaryFan.isLimitCompLeftIso _ (e.counit.app _) (
   isLimitCartesianMonoidalCategoryOfPreservesLimits e.functor
     (e.inverse.obj X) (e.inverse.obj Y))))
-  (BinaryFan.ext (eqToIso rfl) (by aesop_cat) (by aesop_cat))
+  (BinaryFan.ext (eqToIso rfl) (by simp [prodCone]) (by simp [prodCone]))
 
-def chosenFiniteProducts [CartesianMonoidalCategory C] : CartesianMonoidalCategory D :=
+abbrev chosenFiniteProducts : CartesianMonoidalCategory D :=
   .ofChosenFiniteProducts
     { cone := asEmptyCone e.chosenTerminal
       isLimit := e.chosenTerminalIsTerminal }
@@ -345,8 +362,8 @@ end Equivalence
 
 section equivalence
 
-def functorToAsSmallEquiv {D : Type u₁} [Category.{v₁} D] {C : Type u} [Category.{v} C]
-    : D ⥤ AsSmall.{w} C ≃ D ⥤ C where
+def functorToAsSmallEquiv {D : Type u₁} [Category.{v₁} D] {C : Type u} [Category.{v} C] :
+    D ⥤ AsSmall.{w} C ≃ D ⥤ C where
   toFun A := A ⋙ AsSmall.down
   invFun A := A ⋙ AsSmall.up
   left_inv _ := rfl
@@ -376,7 +393,7 @@ lemma functorToAsSmallEquiv_symm_apply_comp_right (F : C ⥤ E) :
 
 end
 
-open ULift
+open _root_.CategoryTheory.ULift
 
 instance (C : Type u) [Category.{v} C] :
     (downFunctor : ULift.{w} C ⥤ C).ReflectsIsomorphisms :=
@@ -401,16 +418,16 @@ variable {Γ : Type u₂} [Category.{v₂} Γ] {A : Γ ⥤ Grpd.{v₁,u₁}}
 
 @[simp] theorem Cat.map_id_obj {A : Γ ⥤ Cat.{v₁,u₁}}
     {x : Γ} {a : A.obj x} :
-    (A.map (𝟙 x)).obj a = a := by
-  have : A.map (𝟙 x) = 𝟙 (A.obj x) := by simp
-  exact Functor.congr_obj this a
+    (A.map (𝟙 x)).toFunctor.obj a = a := by
+  have h : (A.map (𝟙 x)).toFunctor = (𝟭 (A.obj x)) := by simp
+  exact Functor.congr_obj h a
 
 theorem Cat.map_id_map {A : Γ ⥤ Cat.{v₁,u₁}}
     {x : Γ} {a b : A.obj x} {f : a ⟶ b} :
-    (A.map (𝟙 x)).map f = eqToHom Cat.map_id_obj
+    (A.map (𝟙 x)).toFunctor.map f = eqToHom Cat.map_id_obj
       ≫ f ≫ eqToHom Cat.map_id_obj.symm := by
-  have : A.map (𝟙 x) = 𝟙 (A.obj x) := by simp
-  exact Functor.congr_hom this f
+  have h : (A.map (𝟙 x)).toFunctor = 𝟭 (A.obj x) := by simp
+  exact Functor.congr_hom h f
 
 end
 
@@ -442,9 +459,9 @@ def psigmaCongrProp {α₁ α₂} {β₁ : α₁ → Prop} {β₂ : α₂ → Pr
     (F : ∀ a, β₁ a ≃ β₂ (f a)) (x : Sigma β₁) : (sigmaCongr f F x).fst = f x.fst := by
   simp [sigmaCongr]
 
-@[simp] def sigmaCongr_apply_snd {α₁ α₂} {β₁ : α₁ → Sort _} {β₂ : α₂ → Sort _} (f : α₁ ≃ α₂)
+@[simp] theorem sigmaCongr_apply_snd {α₁ α₂} {β₁ : α₁ → Sort _} {β₂ : α₂ → Sort _} (f : α₁ ≃ α₂)
     (F : ∀ a, β₁ a ≃ β₂ (f a)) (x : Sigma β₁) : (sigmaCongr f F x).snd = F x.fst x.snd := by
-  simp [sigmaCongr]
+  rfl
 
 end Equiv
 
@@ -457,8 +474,20 @@ noncomputable def pullbackHomEquiv {A B C: 𝒞} {Γ : 𝒞} {f : A ⟶ C} {g :
     (fst : Γ ⟶ A) × (snd : Γ ⟶ B) ×' (fst ≫ f = snd ≫ g) where
   toFun h := ⟨h ≫ pullback.fst f g, h ≫ pullback.snd f g, by simp[pullback.condition]⟩
   invFun x := pullback.lift x.1 x.2.1 x.2.2
-  left_inv _ := pullback.hom_ext (by simp) (by simp)
-  right_inv := by rintro ⟨_,_,_⟩; congr!; simp; simp
+  left_inv _ := pullback.hom_ext (pullback.lift_fst _ _ _) (pullback.lift_snd _ _ _)
+  right_inv := by
+    rintro ⟨a, b, h⟩
+    change (⟨pullback.lift a b h ≫ pullback.fst f g,
+      pullback.lift a b h ≫ pullback.snd f g, _⟩ :
+      (fst : Γ ⟶ A) × (snd : Γ ⟶ B) ×' (fst ≫ f = snd ≫ g)) = ⟨a, b, h⟩
+    have aux : ∀ (x y : Γ ⟶ A) (z w : Γ ⟶ B)
+        (p : x ≫ f = z ≫ g) (q : y ≫ f = w ≫ g), x = y → z = w →
+        (⟨x, z, p⟩ : (fst : Γ ⟶ A) × (snd : Γ ⟶ B) ×' (fst ≫ f = snd ≫ g)) = ⟨y, w, q⟩ := by
+      intro x y z w p q hx hz
+      cases hx
+      cases hz
+      rfl
+    exact aux _ _ _ _ _ _ (pullback.lift_fst a b h) (pullback.lift_snd a b h)
 
 end CategoryTheory.Limits
 
@@ -524,12 +553,19 @@ lemma ofYoneda_isPullback {C : Type u} [Category.{v} C] {TL TR BL BR : C}
   apply IsPullback.of_isLimit (c := c)
   apply c.isLimitAux (fun s => lift (PullbackCone.fst s) (PullbackCone.snd s) (by
       simp [PullbackCone.condition s]))
-  · simp [c, top_lift]
-  · simp [c, lift_comp_left]
+  · intro s
+    change _ ≫ ofYoneda top top_comp = _
+    rw [ofYoneda_comp_left]
+    exact top_lift _ _ _
+  · intro s
+    exact lift_comp_left _ _ _
   · intro s m h
+    change s.pt ⟶ TL at m
     apply lift_uniq
     · specialize h (some .left)
-      simpa [c] using h
+      change m ≫ ofYoneda top top_comp = s.fst at h
+      rw [ofYoneda_comp_left top top_comp] at h
+      exact h
     · specialize h (some .right)
       exact h
 
@@ -545,11 +581,13 @@ variable (F) in
 -/
 def yonedaIso : yoneda.op ⋙ yoneda.obj F ≅ F :=
   NatIso.ofComponents (fun _ => Equiv.toIso yonedaEquiv)
-    (fun f => by ext : 1; dsimp; rw [yonedaEquiv_naturality'])
+    (fun f => by
+      ext α
+      exact (yonedaEquiv_naturality' α f).symm)
 
 def yonedaIsoMap : yoneda.op ⋙ yoneda.obj F ⟶ yoneda.op ⋙ yoneda.obj G where
-  app _ := app
-  naturality _ _ _ := by ext : 1; apply naturality
+  app _ := ↾app
+  naturality _ _ _ := by ext α; apply naturality
 
 /-- Build natural transformations between presheaves on a small category
   by defining their action when precomposing by a morphism with
@@ -564,7 +602,8 @@ theorem NatTrans.yonedaMk_app {X : C} (α : yoneda.obj X ⟶ F) :
 
 namespace Functor
 
-theorem precomp_heq_of_heq_id {A B : Type u} {C : Type*} [Category.{v} A] [Category.{v} B] [Category C]
+theorem precomp_heq_of_heq_id {A B : Type u} {C : Type*}
+    [Category.{v} A] [Category.{v} B] [Category C]
     (hAB : A = B) (h0 : HEq (inferInstance : Category A) (inferInstance : Category B)) {F : A ⥤ B}
     (h : HEq F (𝟭 B)) (G : B ⥤ C) : HEq (F ⋙ G) G := by
   subst hAB
@@ -620,11 +659,10 @@ lemma Discrete.functor_eq {X C : Type*} [Category C] {F : Discrete X ⥤ C} :
   fapply CategoryTheory.Functor.ext
   · aesop
   · intro x y f
-    cases x ; rcases f with ⟨⟨h⟩⟩
-    cases h
+    cases x; rcases f with ⟨⟨h⟩⟩
     simp
 
-lemma Discrete.functor_ext {X C : Type*} [Category C] (F G : Discrete X ⥤ C)
+lemma Discrete.functor_ext_explicit {X C : Type*} [Category C] (F G : Discrete X ⥤ C)
     (h : ∀ x : X, F.obj ⟨x⟩ = G.obj ⟨x⟩) :
     F = G :=
   calc F
@@ -640,7 +678,7 @@ lemma Discrete.Hom.hext {α β : Type u} {x y : Discrete α} (x' y' : Discrete 
     (hx : x ≍ x') (hy : y ≍ y') (f : x ⟶ y) (f' : x' ⟶ y') : f ≍ f' := by
   aesop_cat
 
-open Prod in
+open _root_.CategoryTheory.Prod in
 lemma Prod.sectR_comp_snd {C : Type u₁} [Category.{v₁} C] (Z : C)
     (D : Type u₂) [Category.{v₂} D] : sectR Z D ⋙ snd C D = 𝟭 D :=
   rfl
diff --git a/HoTTLean/ForMathlib/CategoryTheory/Bicategory/Grothendieck.lean b/HoTTLean/ForMathlib/CategoryTheory/Bicategory/Grothendieck.lean
index 3f256088..eb5e6ac4 100644
--- a/HoTTLean/ForMathlib/CategoryTheory/Bicategory/Grothendieck.lean
+++ b/HoTTLean/ForMathlib/CategoryTheory/Bicategory/Grothendieck.lean
@@ -58,29 +58,45 @@ variable (F : Pseudofunctor B Cat) {a b : B}
 
 @[simp] lemma _root_.CategoryTheory.LocallyDiscrete.Iso.hom_inv {C : Type u₁} [Category C]
     (X Y : LocallyDiscrete C) (e : X ≅ Y) : e.hom.toLoc ≫ e.inv.toLoc = 𝟙 _ :=
-  LocallyDiscrete.eq_of_hom ⟨⟨by simp⟩⟩
+  LocallyDiscrete.eq_of_hom ⟨by simp⟩
 
-attribute [reassoc] StrongTrans.naturality_comp_inv_app
+-- The reassociated lemma is supplied by Mathlib.
 
 end
 
-lemma _root_.CategoryTheory.Functor.toPseudofunctor'_map₂ {C : Type u₁} [Category.{v₁} C] (F : C ⥤ Cat)
+lemma _root_.CategoryTheory.Functor.toPseudofunctor'_map₂
+    {C : Type u₁} [Category.{v₁} C] (F : C ⥤ Cat)
     {a b : LocallyDiscrete C} {f g : a ⟶ b} (η : f ⟶ g) :
-    F.toPseudoFunctor'.map₂ η = eqToHom (by simp [eq_of_hom η]) := by
-  simp [Functor.toPseudoFunctor', pseudofunctorOfIsLocallyDiscrete]
+    F.toPseudofunctor'.map₂ η = eqToHom (by
+      obtain ⟨f⟩ := f
+      obtain ⟨g⟩ := g
+      exact congrArg F.map (eq_of_hom η)) := by
+  rfl
 
+-- Match the bundled Cat operations while elaborating these coherence laws.
+set_option backward.isDefEq.respectTransparency false in
 @[simps]
-def _root_.CategoryTheory.NatTrans.toStrongTrans' {C : Type u₁} [Category.{v₁} C] (F G : C ⥤ Cat) (α : F ⟶ G) :
-    F.toPseudoFunctor' ⟶ G.toPseudoFunctor' where
+def _root_.CategoryTheory.NatTrans.toStrongTrans' {C : Type u₁} [Category.{v₁} C]
+    (F G : C ⥤ Cat) (α : F ⟶ G) :
+    F.toPseudofunctor' ⟶ G.toPseudofunctor' where
   app x := α.app x.as
   naturality _ := eqToIso (α.naturality _)
-  naturality_naturality η := by simp [Functor.toPseudofunctor'_map₂]
-  naturality_id _ := by ext; simp [Bicategory.leftUnitor, Bicategory.rightUnitor]
-  naturality_comp _ _ := by ext; simp [Bicategory.associator]
+  naturality_naturality {a b} f g η := by
+    have h : f = g := Discrete.ext (eq_of_hom η)
+    subst g
+    simp [Functor.toPseudofunctor'_map₂]
+  naturality_id _ := by
+    ext
+    dsimp
+    simp [Cat.Hom₂.eqToHom_toNatTrans, eqToHom_map]
+  naturality_comp _ _ := by
+    ext
+    dsimp
+    simp [Cat.Hom₂.eqToHom_toNatTrans, eqToHom_map]
 
 /-- An `eqToHom` in the category `Cat` is a functor that acts on maps by casts. -/
 theorem _root_.CategoryTheory.Cat.map_eqToHom {C1 C2 : Cat} {x y : C1} (f : x ⟶ y) (eq : C1 = C2) :
-    (eqToHom eq).map f = (cast (by subst eq; rfl) f) := by
+    (eqToHom eq).toFunctor.map f = (cast (by subst eq; rfl) f) := by
   cases eq
   simp [CategoryStruct.id]
 
@@ -101,24 +117,24 @@ scoped prefix:75 "∫ " => Grothendieck
 
 /-- A morphism in the Grothendieck construction `∫ F` between two points `X Y : ∫ F` consists of
 a morphism in the base category `base : X.base ⟶ Y.base` and
-a morphism in a fiber `f.fiber : (F.map base).obj X.fiber ⟶ Y.fiber`.
+a morphism in a fiber `f.fiber : (F.map base).toFunctor.obj X.fiber ⟶ Y.fiber`.
 -/
 structure Hom (X Y : ∫ F) where
   /-- The morphism between base objects. -/
   base : X.base ⟶ Y.base
   /-- The morphism in the fiber over the domain. -/
-  fiber : (F.map base.toLoc).obj X.fiber ⟶ Y.fiber
+  fiber : (F.map base.toLoc).toFunctor.obj X.fiber ⟶ Y.fiber
 
 @[simps! id_base id_fiber comp_base comp_fiber]
 instance categoryStruct : CategoryStruct (∫ F) where
   Hom X Y := Hom X Y
   id X := {
     base := 𝟙 X.base
-    fiber := (F.mapId ⟨X.base⟩).hom.app X.fiber }
+    fiber := (F.mapId ⟨X.base⟩).hom.toNatTrans.app X.fiber }
   comp {X _ _} f g := {
     base := f.base ≫ g.base
-    fiber := (F.mapComp f.base.toLoc g.base.toLoc).hom.app X.fiber ≫
-      (F.map g.base.toLoc).map f.fiber ≫ g.fiber }
+    fiber := (F.mapComp f.base.toLoc g.base.toLoc).hom.toNatTrans.app X.fiber ≫
+      (F.map g.base.toLoc).toFunctor.map f.fiber ≫ g.fiber }
 
 instance (X : ∫ F) : Inhabited (Hom X X) :=
   ⟨𝟙 X⟩
@@ -151,14 +167,17 @@ end
 instance category : Category (∫ F) where
   toCategoryStruct := Pseudofunctor.Grothendieck.categoryStruct
   id_comp {a b} f := by
-    ext
-    · simp
-    · simp [F.mapComp_id_left_hom_app, PrelaxFunctor.map₂_eqToHom, Strict.leftUnitor_eqToIso,
-        ← Functor.map_comp_assoc]
+    -- Match transports through bundled Cat operations.
+    set_option backward.isDefEq.respectTransparency false in
+      ext
+      · simp
+      · simp [F.mapComp_id_left_hom_app, PrelaxFunctor.map₂_eqToHom, Strict.leftUnitor_eqToIso,
+          ← Functor.map_comp_assoc]
   comp_id {a b} f := by
-    ext
-    · simp
-    · simp [F.mapComp_id_right_hom_app, PrelaxFunctor.map₂_eqToHom, Strict.rightUnitor_eqToIso]
+    set_option backward.isDefEq.respectTransparency false in
+      ext
+      · simp
+      · simp [F.mapComp_id_right_hom_app, PrelaxFunctor.map₂_eqToHom, Strict.rightUnitor_eqToIso]
   assoc f g h := by
     ext
     · simp
@@ -189,26 +208,34 @@ induces a functor `Grothendieck.map : ∫ F ⥤ ∫ G`.
 def map (α : F ⟶ G) : ∫ F ⥤ ∫ G where
   obj a := {
     base := a.base
-    fiber := (α.app ⟨a.base⟩).obj a.fiber }
+    fiber := (α.app ⟨a.base⟩).toFunctor.obj a.fiber }
   map {a b} f := {
     base := f.1
-    fiber := (α.naturality f.1.toLoc).inv.app a.fiber ≫ (α.app ⟨b.base⟩).map f.2 }
+    fiber := (α.naturality f.1.toLoc).inv.toNatTrans.app a.fiber ≫
+      (α.app ⟨b.base⟩).toFunctor.map f.2 }
   map_id a := by
-    ext
-    · dsimp
-    · simp [StrongTrans.naturality_id_inv_app, ← Functor.map_comp]
+    set_option backward.isDefEq.respectTransparency false in
+      ext
+      · dsimp
+      · simp [StrongTrans.naturality_id_inv_app, ← Functor.map_comp]
   map_comp {a b c} f g := by
-    ext
-    · dsimp
-    · simp only [categoryStruct_comp_base, Quiver.Hom.comp_toLoc,
+    set_option backward.isDefEq.respectTransparency false in
+      ext
+      · dsimp
+      · simp only [categoryStruct_comp_base, Quiver.Hom.comp_toLoc,
         StrongTrans.naturality_comp_inv_app_assoc, ← Functor.map_comp]
-      have := (α.naturality g.base.toLoc).inv.naturality_assoc
-      simp only [Cat.comp_map] at this
-      simp [this]
+        have := (α.naturality g.base.toLoc).inv.toNatTrans.naturality_assoc
+        simp only [Cat.Hom.comp_map] at this
+        simp [this]
 
 @[simp]
 lemma map_id_map {x y : ∫ F} (f : x ⟶ y) : (map (𝟙 F)).map f = f := by
-  ext <;> simp
+  -- Unfold the bundled Cat identity when checking the dependent fiber equation.
+  set_option backward.isDefEq.respectTransparency false in
+    apply Hom.ext ((map (𝟙 F)).map f) f (by rfl)
+    simp [map]
+    change 𝟙 _ ≫ f.fiber = f.fiber
+    simp
 
 @[simp]
 theorem map_comp_forget (α : F ⟶ G) : map α ⋙ forget G = forget F := rfl
@@ -219,7 +246,11 @@ variable (F)
 
 /-- The natural isomorphism witnessing the pseudo-unity constraint of `Grothendieck.map`. -/
 def mapIdIso : map (𝟙 F) ≅ 𝟭 (∫ F) :=
-  NatIso.ofComponents (fun _ ↦ eqToIso (by aesop_cat))
+  NatIso.ofComponents (fun _ ↦ eqToIso (by aesop_cat)) (by
+    intro X Y f
+    -- The components are equality isomorphisms between bundled Cat identities.
+    set_option backward.isDefEq.respectTransparency false in
+      simp)
 
 lemma map_id_eq : map (𝟙 F) = 𝟭 (∫ F) :=
   Functor.ext_of_iso (mapIdIso F) (fun x ↦ by simp [map]) (fun x ↦ by simp [mapIdIso])
@@ -229,9 +260,11 @@ end
 /-- The natural isomorphism witnessing the pseudo-functoriality of `Grothendieck.map`. -/
 def mapCompIso (α : F ⟶ G) (β : G ⟶ H) : map (α ≫ β) ≅ map α ⋙ map β :=
   NatIso.ofComponents (fun _ ↦ eqToIso (by aesop_cat)) (fun f ↦ by
-    dsimp
-    simp only [comp_id, id_comp]
-    ext <;> simp)
+    -- Expose bundled Cat composition when normalizing equality transports.
+    set_option backward.isDefEq.respectTransparency false in
+      dsimp
+      simp only [comp_id, id_comp]
+      ext <;> simp [map])
 
 lemma map_comp_eq (α : F ⟶ G) (β : G ⟶ H) : map (α ≫ β) = map α ⋙ map β :=
   Functor.ext_of_iso (mapCompIso α β) (fun _ ↦ by simp [map]) (fun _ ↦ by simp [mapCompIso])
@@ -247,7 +280,7 @@ If `F : Pseudofunctor (LocallyDiscrete 𝒮) Cat` is a pseudofunctor and `t : c
 -/
 @[simps]
 def transport (t : x.base ⟶ c) : ∫ F :=
-  ⟨c, (F.map t.toLoc).obj x.fiber⟩
+  ⟨c, (F.map t.toLoc).toFunctor.obj x.fiber⟩
 
 /--
 If `F : Pseudofunctor (LocallyDiscrete 𝒮) Cat` is a pseudofunctor and `t : c ⟶ d` is a morphism in
@@ -323,7 +356,7 @@ gives a category whose
 * objects `X` consist of `X.base : C` and `X.fiber : F.obj base`
 * morphisms `f : X ⟶ Y` consist of
   `base : X.base ⟶ Y.base` and
-  `f.fiber : (F.map base).obj X.fiber ⟶ Y.fiber`
+  `f.fiber : (F.map base).toFunctor.obj X.fiber ⟶ Y.fiber`
 -/
 structure Grothendieck where
   /-- The underlying object in `C` -/
@@ -341,7 +374,7 @@ attribute [local simp] eqToHom_map
 variable {F}
 
 lemma ext {x y : ∫ F} (hbase : x.base = y.base)
-    (hfiber : (F.map (eqToHom hbase)).obj x.fiber = y.fiber) : x = y := by
+    (hfiber : (F.map (eqToHom hbase)).toFunctor.obj x.fiber = y.fiber) : x = y := by
   cases x; cases y
   congr
   · simp only [eqToHom_map] at hbase hfiber
@@ -349,24 +382,26 @@ lemma ext {x y : ∫ F} (hbase : x.base = y.base)
     simp [← hfiber]
 
 /-- A morphism in the Grothendieck category `F : C ⥤ Cat` consists of
-`base : X.base ⟶ Y.base` and `f.fiber : (F.map base).obj X.fiber ⟶ Y.fiber`.
+`base : X.base ⟶ Y.base` and `f.fiber : (F.map base).toFunctor.obj X.fiber ⟶ Y.fiber`.
 -/
 structure Hom (X Y : ∫ F) where
   /-- The morphism between base objects. -/
   base : X.base ⟶ Y.base
   /-- The morphism from the pushforward to the source fiber object to the target fiber object. -/
-  fiber : (F.map base).obj X.fiber ⟶ Y.fiber
+  fiber : (F.map base).toFunctor.obj X.fiber ⟶ Y.fiber
 
 namespace Hom
 
 variable {X Y : ∫ F} (f g : Hom X Y)
 
 @[simp]
-lemma mk_base (b : X.base ⟶ Y.base) (f : (F.map b).obj X.fiber ⟶ Y.fiber) : (mk b f).base = b :=
+lemma mk_base (b : X.base ⟶ Y.base)
+    (f : (F.map b).toFunctor.obj X.fiber ⟶ Y.fiber) : (mk b f).base = b :=
   rfl
 
 @[simp]
-lemma mk_fiber (b : X.base ⟶ Y.base) (f : (F.map b).obj X.fiber ⟶ Y.fiber) : (mk b f).fiber = f :=
+lemma mk_fiber (b : X.base ⟶ Y.base)
+    (f : (F.map b).toFunctor.obj X.fiber ⟶ Y.fiber) : (mk b f).fiber = f :=
   rfl
 
 @[ext (iff := false)]
@@ -399,12 +434,15 @@ instance (X : ∫ F) : Inhabited (Hom X X) :=
 def comp {X Y Z : ∫ F} (f : Hom X Y) (g : Hom Y Z) : Hom X Z where
   base := f.base ≫ g.base
   fiber :=
-    eqToHom (by simp) ≫ (F.map g.base).map f.fiber ≫ g.fiber
+    eqToHom (by simp) ≫ (F.map g.base).toFunctor.map f.fiber ≫ g.fiber
 
 end Hom
 
 attribute [local simp] eqToHom_map
 
+-- Cat functor projections in these dependent transport laws require the
+-- legacy elaborator transparency.
+set_option backward.isDefEq.respectTransparency false in
 instance : Category (∫ F) where
   Hom X Y := Hom X Y
   id X := Hom.id X
@@ -413,14 +451,14 @@ instance : Category (∫ F) where
     ext
     · simp [Hom.comp, Hom.id]
     · dsimp [Hom.comp, Hom.id]
-      rw [← NatIso.naturality_2 (eqToIso (F.map_id Y.base)) f.fiber]
+      rw [← NatIso.naturality_2 (eqToIso (congrArg Cat.Hom.toFunctor (F.map_id Y.base))) f.fiber]
       simp
   id_comp f := by ext <;> simp [Hom.comp, Hom.id]
   assoc f g h := by
     ext
     · simp [Hom.comp]
     · dsimp [Hom.comp, Hom.id]
-      rw [← NatIso.naturality_2 (eqToIso (F.map_comp _ _)) f.fiber]
+      rw [← NatIso.naturality_2 (eqToIso (congrArg Cat.Hom.toFunctor (F.map_comp _ _))) f.fiber]
       simp
 
 namespace Hom
@@ -442,7 +480,7 @@ lemma comp_base {X Y Z : ∫ F} (f : X ⟶ Y) (g : Y ⟶ Z) :
 
 @[simp]
 lemma comp_fiber {X Y Z : ∫ F} (f : X ⟶ Y) (g : Y ⟶ Z) :
-    Hom.fiber (f ≫ g) = eqToHom (by simp) ≫ (F.map g.base).map f.fiber ≫ g.fiber :=
+    Hom.fiber (f ≫ g) = eqToHom (by simp) ≫ (F.map g.base).toFunctor.map f.fiber ≫ g.fiber :=
   rfl
 
 end Hom
@@ -520,8 +558,8 @@ theorem Hom.hext' (h : F = F') {X Y : ∫ F} {X' Y' : ∫ F'} (hX : HEq X X') (h
 theorem FunctorTo.hext (G H : D ⥤ ∫ F)
     (hbase : G ⋙ forget _ = H ⋙ forget _)
     (hfiber_obj : ∀ x : D, HEq (G.obj x).fiber (H.obj x).fiber)
-    (hfiber_map : ∀ {x y : D} (f : x ⟶ y), HEq (G.map f).fiber (H.map f).fiber)
-    : G = H := by
+    (hfiber_map : ∀ {x y : D} (f : x ⟶ y), HEq (G.map f).fiber (H.map f).fiber) :
+    G = H := by
   fapply CategoryTheory.Functor.ext
   · intro x
     apply Grothendieck.hext
@@ -544,15 +582,15 @@ If `F : C ⥤ Cat` is a functor and `t : c ⟶ d` is a morphism in `C`, then `tr
 `c`-based element of `∫ F` to a `d`-based element.
 -/
 def transport (x : ∫ F) {c : C} (t : x.base ⟶ c) : ∫ F :=
-  mk c ((F.map t).obj x.fiber)
+  mk c ((F.map t).toFunctor.obj x.fiber)
 
 @[simp]
-def transport_base (x : ∫ F) {c : C} (t : x.base ⟶ c) : (transport x t).base = c :=
+theorem transport_base (x : ∫ F) {c : C} (t : x.base ⟶ c) : (transport x t).base = c :=
   rfl
 
 @[simp]
-def transport_fiber (x : ∫ F) {c : C} (t : x.base ⟶ c) :
-    (transport x t).fiber = (F.map t).obj x.fiber :=
+theorem transport_fiber (x : ∫ F) {c : C} (t : x.base ⟶ c) :
+    (transport x t).fiber = (F.map t).toFunctor.obj x.fiber :=
   rfl
 
 /--
@@ -565,36 +603,44 @@ def toTransport (x : ∫ F) {c : C} (t : x.base ⟶ c) : x ⟶ x.transport t :=
   Hom.mk t (𝟙 _)
 
 @[simp]
-def toTransport_base (x : ∫ F) {c : C} (t : x.base ⟶ c) : (toTransport x t).base = t :=
+theorem toTransport_base (x : ∫ F) {c : C} (t : x.base ⟶ c) : (toTransport x t).base = t :=
   rfl
 
 @[simp]
-def toTransport_fiber (x : ∫ F) {c : C} (t : x.base ⟶ c) :
+theorem toTransport_fiber (x : ∫ F) {c : C} (t : x.base ⟶ c) :
     (toTransport x t).fiber = 𝟙 _ :=
   rfl
 
+-- These dependent transport proofs simplify through the bundled Cat functor projections.
+-- Permit the elaborator to unfold them while matching the existing simp lemmas.
+set_option backward.isDefEq.respectTransparency false in
 lemma transport_id {x : ∫ F} :
     transport x (𝟙 x.base) = x := by
   fapply Grothendieck.ext <;> simp [transport]
 
+set_option backward.isDefEq.respectTransparency false in
 lemma transport_eqToHom {X: C} {X' : ∫ F} (hX': (forget F).obj X' = X):
     X'.transport (eqToHom hX') = X' := by
   subst hX'
   simp [transport_id]
 
+set_option backward.isDefEq.respectTransparency false in
 lemma toTransport_id {X : ∫ F} :
     toTransport X (𝟙 X.base) = eqToHom transport_id.symm := by
   apply Grothendieck.Hom.ext <;> simp
 
+set_option backward.isDefEq.respectTransparency false in
 lemma toTransport_eqToHom {X: C} {X' : ∫ F} (hX': (forget F).obj X' = X):
     toTransport X' (eqToHom hX') = eqToHom (by subst hX'; simp[transport_id]) := by
   subst hX'
   simp [toTransport_id]
 
+set_option backward.isDefEq.respectTransparency false in
 lemma transport_comp (x : ∫ F) {c d: C} (t : x.base ⟶ c) (t': c ⟶ d):
-      transport x (t ≫ t') = transport (c:= d) (transport x t) t' := by
+    transport x (t ≫ t') = transport (c:= d) (transport x t) t' := by
   simp [transport]
 
+set_option backward.isDefEq.respectTransparency false in
 lemma toTransport_comp (x : ∫ F) {c d: C} (t : x.base ⟶ c) (t': c ⟶ d):
     toTransport x (t ≫ t') =
     toTransport x t ≫ toTransport (transport x t) t' ≫ eqToHom (transport_comp x t t').symm := by
@@ -610,45 +656,47 @@ lemma toTransport_comp (x : ∫ F) {c d: C} (t : x.base ⟶ c) (t': c ⟶ d):
     symm
     apply eqToHom_heq_id_dom
 
+-- Allow simplification to unfold the bundled Cat functors in transport coherence.
+set_option backward.isDefEq.respectTransparency false in
 /--
 Construct an isomorphism in a Grothendieck construction from isomorphisms in its base and fiber.
 -/
 def isoMk {X Y : ∫ F} (e₁ : X.base ≅ Y.base)
-    (e₂ : (F.map e₁.hom).obj X.fiber ≅ Y.fiber) :
+    (e₂ : (F.map e₁.hom).toFunctor.obj X.fiber ≅ Y.fiber) :
     X ≅ Y where
   hom := Hom.mk e₁.hom e₂.hom
-  inv := Hom.mk e₁.inv ((F.map e₁.inv).map e₂.inv ≫
-    eqToHom (Functor.congr_obj (F.mapIso e₁).hom_inv_id X.fiber))
+  inv := Hom.mk e₁.inv ((F.map e₁.inv).toFunctor.map e₂.inv ≫
+    eqToHom (Functor.congr_obj (congrArg Cat.Hom.toFunctor (F.mapIso e₁).hom_inv_id) X.fiber))
   hom_inv_id := by apply Hom.ext; all_goals simp
   inv_hom_id := by
     apply Hom.ext
-    · have := Functor.congr_hom (F.mapIso e₁).inv_hom_id e₂.inv
-      simp only [mapIso_inv, mapIso_hom, Cat.comp_map] at this
+    · have := Functor.congr_hom (congrArg Cat.Hom.toFunctor (F.mapIso e₁).inv_hom_id) e₂.inv
+      simp only [mapIso_inv, mapIso_hom, Cat.Hom.comp_map] at this
       simp [this]
     · simp
 
 @[simp]
 lemma isoMk_hom_base {X Y : ∫ F} (e₁ : X.base ≅ Y.base)
-    (e₂ : (F.map e₁.hom).obj X.fiber ≅ Y.fiber) :
+    (e₂ : (F.map e₁.hom).toFunctor.obj X.fiber ≅ Y.fiber) :
     (isoMk e₁ e₂).hom.base = e₁.hom :=
   rfl
 
 @[simp]
 lemma isoMk_hom_fiber {X Y : ∫ F} (e₁ : X.base ≅ Y.base)
-    (e₂ : (F.map e₁.hom).obj X.fiber ≅ Y.fiber) :
+    (e₂ : (F.map e₁.hom).toFunctor.obj X.fiber ≅ Y.fiber) :
     (isoMk e₁ e₂).hom.fiber = e₂.hom :=
   rfl
 
 @[simp]
 lemma isoMk_inv_base {X Y : ∫ F} (e₁ : X.base ≅ Y.base)
-    (e₂ : (F.map e₁.hom).obj X.fiber ≅ Y.fiber) :
+    (e₂ : (F.map e₁.hom).toFunctor.obj X.fiber ≅ Y.fiber) :
     (isoMk e₁ e₂).inv.base = e₁.inv :=
   rfl
 
 @[simp]
 lemma isoMk_inv_fiber {X Y : ∫ F} (e₁ : X.base ≅ Y.base)
-    (e₂ : (F.map e₁.hom).obj X.fiber ≅ Y.fiber) :
-    (isoMk e₁ e₂).inv.fiber = (F.map e₁.inv).map e₂.inv ≫ eqToHom (by
+    (e₂ : (F.map e₁.hom).toFunctor.obj X.fiber ≅ Y.fiber) :
+    (isoMk e₁ e₂).inv.fiber = (F.map e₁.inv).toFunctor.map e₂.inv ≫ eqToHom (by
       simp [← Functor.comp_obj, ← Cat.comp_eq_comp, ← Functor.map_comp]) :=
   rfl
 
@@ -664,11 +712,17 @@ lemma transportIso_hom_base (x : ∫ F) {c : C} (α : x.base ≅ c) :
     (x.transportIso α).hom.base = α.inv :=
   rfl
 
+-- Allow simplification to see through the bundled Cat and transport projections.
+set_option backward.isDefEq.respectTransparency false in
 @[simp]
 lemma transportIso_hom_fiber (x : ∫ F) {c : C} (α : x.base ≅ c) :
     (x.transportIso α).hom.fiber =
-    eqToHom (by simp [transportIso, ← Functor.comp_obj, ← Cat.comp_eq_comp]) := by
-  simp only [transportIso, CategoryTheory.Iso.symm_hom, isoMk_inv_fiber, CategoryTheory.Iso.refl_inv]
+    eqToHom (by
+      change (F.map α.inv).toFunctor.obj ((F.map α.hom).toFunctor.obj x.fiber) = x.fiber
+      rw [← Cat.Hom.comp_obj, ← F.map_comp, α.hom_inv_id, F.map_id]
+      rfl) := by
+  simp only [transportIso, CategoryTheory.Iso.symm_hom, isoMk_inv_fiber,
+    CategoryTheory.Iso.refl_inv]
   erw [Functor.map_id]
   simp
 
@@ -679,21 +733,21 @@ lemma transportIso_inv_base (x : ∫ F) {c : C} (α : x.base ≅ c) :
 
 @[simp]
 lemma transportIso_inv_fiber (x : ∫ F) {c : C} (α : x.base ≅ c) :
-    (x.transportIso α).inv.fiber = 𝟙 ((F.map α.hom).obj x.fiber) :=
+    (x.transportIso α).inv.fiber = 𝟙 ((F.map α.hom).toFunctor.obj x.fiber) :=
   rfl
 
 end Transport
 
 section functorTo
 variable (A : D ⥤ C) (fibObj : (x : D) → (A ⋙ F).obj x)
-    (fibMap : {x y : D} → (f : x ⟶ y) → ((A ⋙ F).map f).obj (fibObj x) ⟶ fibObj y)
+    (fibMap : {x y : D} → (f : x ⟶ y) → ((A ⋙ F).map f).toFunctor.obj (fibObj x) ⟶ fibObj y)
 
-theorem functorTo_map_id_aux (x : D) : ((A ⋙ F).map (𝟙 x)).obj (fibObj x) = fibObj x := by
+theorem functorTo_map_id_aux (x : D) : ((A ⋙ F).map (𝟙 x)).toFunctor.obj (fibObj x) = fibObj x := by
   simp
 
 theorem functorTo_map_comp_aux {x y z : D} (f : x ⟶ y) (g : y ⟶ z) :
-    ((A ⋙ F).map (f ≫ g)).obj (fibObj x)
-    = (F.map (A.map g)).obj (((A ⋙ F).map f).obj (fibObj x)) := by
+    ((A ⋙ F).map (f ≫ g)).toFunctor.obj (fibObj x)
+    = (F.map (A.map g)).toFunctor.obj (((A ⋙ F).map f).toFunctor.obj (fibObj x)) := by
   simp
 
 section
@@ -702,8 +756,10 @@ variable
       = eqToHom (functorTo_map_id_aux A fibObj x))
     (map_comp : {x y z : D} → (f : x ⟶ y) → (g : y ⟶ z) → fibMap (f ≫ g)
       = eqToHom (functorTo_map_comp_aux A fibObj f g)
-      ≫ (F.map (A.map g)).map (fibMap f) ≫ fibMap g)
+      ≫ (F.map (A.map g)).toFunctor.map (fibMap f) ≫ fibMap g)
 
+-- Wrapped Cat functors require the older transparency behavior for transport simplification.
+set_option backward.isDefEq.respectTransparency false in
 /--
 Define a functor into `∫ F` by providing a functor into the base cateogry,
 as well as the actions on fibers. -/
@@ -733,14 +789,20 @@ a functor `Grothendieck.map : Grothendieck F ⥤ Grothendieck G`.
 @[simps!]
 def map (α : F ⟶ G) : Grothendieck F ⥤ Grothendieck G :=
   functorTo (forget F)
-  (fun X => (α.app X.base).obj X.fiber)
-  (fun {X Y} f => (eqToHom (α.naturality f.base).symm).app X.fiber ≫ (α.app Y.base).map f.fiber)
-  (by intro x; simp)
+  (fun X => (α.app X.base).toFunctor.obj X.fiber)
+  (fun {X Y} f =>
+    (eqToHom (congrArg Cat.Hom.toFunctor (α.naturality f.base).symm)).app X.fiber ≫
+      (α.app Y.base).toFunctor.map f.fiber)
+  (by
+    -- Normalize the wrapped Cat functor transports during elaboration.
+    set_option backward.isDefEq.respectTransparency false in
+      intro x; simp)
   (by
+    set_option backward.isDefEq.respectTransparency false in
     intro x y z f g
-    have := Functor.congr_hom (α.naturality g.base).symm f.fiber
+    have := Functor.congr_hom (congrArg Cat.Hom.toFunctor (α.naturality g.base).symm) f.fiber
     simp at this
-    simp [this])
+    simp [forget, this, Category.assoc])
 
 /-- The functor `Grothendieck.map α : ∫ F ⥤ ∫ G` lies over `C`. -/
 @[simp]
@@ -748,18 +810,27 @@ theorem map_comp_forget {α : F ⟶ G} :
     Grothendieck.map α ⋙ Grothendieck.forget G = Grothendieck.forget F :=
   rfl
 
-theorem map_id_eq : map (𝟙 F) = 𝟙 (Cat.of <| Grothendieck <| F) := by
+theorem map_id_eq : map (𝟙 F) = 𝟭 (Grothendieck F) := by
+  -- Unfold the wrapped Cat functors when comparing dependent fiber maps.
+  set_option backward.isDefEq.respectTransparency false in
   apply FunctorTo.hext
-  all_goals simp [Cat.id_eq_id, Functor.id_comp]
+  · simp [Functor.id_comp]
+  · simp [map, functorTo, forget]
+  · intro x y f
+    simp [map, functorTo, forget]
 
 /-- Making the equality of functors into an isomorphism. Note: we should avoid equality of functors
 if possible, and we should prefer `mapIdIso` to `map_id_eq` whenever we can. -/
-def mapIdIso : map (𝟙 F) ≅ 𝟙 (Cat.of <| Grothendieck <| F) := eqToIso map_id_eq
+def mapIdIso : map (𝟙 F) ≅ 𝟭 (Grothendieck F) := eqToIso map_id_eq
 
 theorem map_comp_eq (α : F ⟶ G) (β : G ⟶ H) :
     map (α ≫ β) = map α ⋙ map β := by
+  -- The fiber equality requires the same local transparency compatibility.
+  set_option backward.isDefEq.respectTransparency false in
   apply FunctorTo.hext
-  all_goals simp [Functor.assoc]
+  · simp [Functor.assoc]
+  · simp [map, functorTo, forget]
+  · simp [map, functorTo, forget]
 
 /-- Making the equality of functors into an isomorphism. Note: we should avoid equality of functors
 if possible, and we should prefer `map_comp_iso` to `map_comp_eq` whenever we can. -/
@@ -770,8 +841,10 @@ end
 /-- The Grothendieck construction as a functor from the functor category `E ⥤ Cat` to the
 over category `Over E`. -/
 def functor {E : Cat.{v, u}} : (E ⥤ Cat.{v,u}) ⥤ Over (T := Cat.{v,u}) E where
-  obj F := Over.mk (X := E) (Y := Cat.of (∫ F)) (Grothendieck.forget F)
-  map {_ _} α := Over.homMk (X:= E) (Grothendieck.map α) Grothendieck.map_comp_forget
+  obj F := Over.mk (X := E) (Y := Cat.of (∫ F)) (Grothendieck.forget F).toCatHom
+  map {_ _} α :=
+    Over.homMk (X := E) (Grothendieck.map α).toCatHom
+      (congrArg Functor.toCatHom Grothendieck.map_comp_forget)
   map_id F := by
     ext
     exact Grothendieck.map_id_eq (F := F)
@@ -785,27 +858,27 @@ variable (G : C ⥤ Type w)
 /-- Auxiliary definition for `grothendieckTypeToCat`, to speed up elaboration. -/
 @[simps!]
 def grothendieckTypeToCatFunctor : ∫(G ⋙ typeToCat) ⥤ G.Elements where
-  obj X := ⟨X.1, X.2.as⟩
-  map f := ⟨f.1, f.2.1.1⟩
+  obj X := ⟨X.fiber.as⟩
+  map f := ⟨f.base, f.fiber.eq⟩
 
 /-- Auxiliary definition for `grothendieckTypeToCat`, to speed up elaboration. -/
 def grothendieckTypeToCatInverse : G.Elements ⥤ ∫(G ⋙ typeToCat) where
-  obj X := mk X.1 ⟨X.2⟩
-  map f := Hom.mk f.1 ⟨⟨f.2⟩⟩
+  obj X := mk X.obj ⟨X.val⟩
+  map f := Hom.mk f.hom ⟨f.map_val⟩
 
 @[simp]
 lemma grothendieckTypeToCatInverse_obj_base (X : G.Elements) :
-    ((grothendieckTypeToCatInverse G).obj X).base = X.1 :=
+    ((grothendieckTypeToCatInverse G).obj X).base = X.obj :=
   rfl
 
 @[simp]
 lemma grothendieckTypeToCatInverse_obj_fiber_as (X : G.Elements) :
-    ((grothendieckTypeToCatInverse G).obj X).fiber.as = X.2 :=
+    ((grothendieckTypeToCatInverse G).obj X).fiber.as = X.val :=
   rfl
 
 @[simp]
 lemma grothendieckTypeToCatInverse_map_base {X Y : G.Elements} (f : X ⟶ Y) :
-    ((grothendieckTypeToCatInverse G).map f).base = f.1 :=
+    ((grothendieckTypeToCatInverse G).map f).base = f.hom :=
   rfl
 
 /-- The Grothendieck construction applied to a functor to `Type`
@@ -822,24 +895,29 @@ def grothendieckTypeToCat : ∫(G ⋙ typeToCat) ≌ G.Elements where
         rcases X with ⟨_, ⟨⟩⟩
         exact CategoryTheory.Iso.refl _)
       (by
-        rintro ⟨_, ⟨⟩⟩ ⟨_, ⟨⟩⟩ ⟨base, ⟨⟨f⟩⟩⟩
-        dsimp at *
-        simp
-        rfl)
+        intro X Y f
+        refine Hom.ext _ _ ?_ ?_
+        · rcases X with ⟨_, ⟨⟩⟩
+          rcases Y with ⟨_, ⟨⟩⟩
+          change f.base ≫ 𝟙 _ = 𝟙 _ ≫ f.base
+          simp
+        · change @Eq (Discrete.mk _ ⟶ Discrete.mk _) _ _
+          exact Subsingleton.elim _ _)
   counitIso :=
     NatIso.ofComponents
       (fun X => by
         cases X
         exact CategoryTheory.Iso.refl _)
       (by
-        rintro ⟨⟩ ⟨⟩ ⟨f, e⟩
-        dsimp at *
-        simp
-        rfl)
+        intro X Y f
+        apply Functor.Elements.hom_ext
+        change f.hom ≫ 𝟙 _ = 𝟙 _ ≫ f.hom
+        simp)
   functor_unitIso_comp := by
     rintro ⟨_, ⟨⟩⟩
+    apply Functor.Elements.hom_ext
+    change 𝟙 _ ≫ 𝟙 _ = 𝟙 _
     simp
-    rfl
 
 end Elements
 
@@ -847,25 +925,36 @@ section Pseudofunctor
 
 variable (F)
 
+-- Match the bundled Cat transports when elaborating the identity laws.
 @[simps!]
-def toPseudoFunctor'Iso.hom : ∫ F ⥤ F.toPseudoFunctor'.Grothendieck where
+def toPseudoFunctor'Iso.hom : ∫ F ⥤ F.toPseudofunctor'.Grothendieck where
   obj x := ⟨ x.base, x.fiber ⟩
   map f := ⟨ f.base, f.fiber ⟩
-  map_id x := by apply Pseudofunctor.Grothendieck.Hom.ext <;> simp
-  map_comp f g := by apply Pseudofunctor.Grothendieck.Hom.ext <;> simp
+  map_id x := by
+    set_option backward.isDefEq.respectTransparency false in
+      apply Pseudofunctor.Grothendieck.Hom.ext <;> simp
+  map_comp f g := by
+    set_option backward.isDefEq.respectTransparency false in
+      apply Pseudofunctor.Grothendieck.Hom.ext <;> simp
+      all_goals rfl
 
 @[simps!]
-def toPseudoFunctor'Iso.inv : F.toPseudoFunctor'.Grothendieck ⥤ ∫ F where
+def toPseudoFunctor'Iso.inv : F.toPseudofunctor'.Grothendieck ⥤ ∫ F where
   obj x := ⟨ x.base, x.fiber ⟩
   map f := ⟨ f.base, f.fiber ⟩
-  map_id x := by apply Hom.ext <;> simp
-  map_comp f g := by apply Hom.ext <;> simp
+  map_id x := by
+    set_option backward.isDefEq.respectTransparency false in
+      apply Hom.ext <;> simp
+  map_comp f g := by
+    set_option backward.isDefEq.respectTransparency false in
+      apply Hom.ext <;> simp
+      all_goals rfl
 
-def toPseudoFunctor'Iso : ∫ F ≅≅ F.toPseudoFunctor'.Grothendieck where
+def toPseudoFunctor'Iso : ∫ F ≅≅ F.toPseudofunctor'.Grothendieck where
   hom := toPseudoFunctor'Iso.hom F
   inv := toPseudoFunctor'Iso.inv F
 
-def toPseudoFunctor'Equivalence : ∫ F ≌ F.toPseudoFunctor'.Grothendieck :=
+def toPseudoFunctor'Equivalence : ∫ F ≌ F.toPseudofunctor'.Grothendieck :=
   (toPseudoFunctor'Iso F).toEquivalence
 
 lemma toPseudoFunctor'Iso.hom_comp_forget : toPseudoFunctor'Iso.hom F ⋙
@@ -876,13 +965,40 @@ lemma toPseudoFunctor'Iso.inv_comp_forget : toPseudoFunctor'Iso.inv F ⋙ forget
     Pseudofunctor.Grothendieck.forget _ :=
   rfl
 
+-- Keep the migration spelling available to downstream code while restoring the
+-- original project API (including the `simps` lemmas generated above).
+abbrev toPseudofunctor'Iso.hom : ∫ F ⥤ F.toPseudofunctor'.Grothendieck :=
+  toPseudoFunctor'Iso.hom F
+abbrev toPseudofunctor'Iso.inv : F.toPseudofunctor'.Grothendieck ⥤ ∫ F :=
+  toPseudoFunctor'Iso.inv F
+abbrev toPseudofunctor'Iso : ∫ F ≅≅ F.toPseudofunctor'.Grothendieck :=
+  toPseudoFunctor'Iso F
+abbrev toPseudofunctor'Equivalence : ∫ F ≌ F.toPseudofunctor'.Grothendieck :=
+  toPseudoFunctor'Equivalence F
+
+lemma toPseudofunctor'Iso.hom_comp_forget : toPseudofunctor'Iso.hom F ⋙
+    Pseudofunctor.Grothendieck.forget _ = forget _ :=
+  toPseudoFunctor'Iso.hom_comp_forget F
+lemma toPseudofunctor'Iso.inv_comp_forget : toPseudofunctor'Iso.inv F ⋙ forget _ =
+    Pseudofunctor.Grothendieck.forget _ :=
+  toPseudoFunctor'Iso.inv_comp_forget F
+
 lemma map_eq_pseudofunctor_map {G} (α : F ⟶ G) : map α = (toPseudoFunctor'Iso F).hom ⋙
     Pseudofunctor.Grothendieck.map α.toStrongTrans' ⋙
     (toPseudoFunctor'Iso G).inv := by
   fapply Functor.ext
   · aesop
-  · intro _
-    aesop
+  · intro X Y f
+    -- Match the wrapped Cat transports before applying naturality.
+    set_option backward.isDefEq.respectTransparency false in
+      apply Hom.ext
+      · simp [map, toPseudoFunctor'Iso, toPseudoFunctor'Iso.hom, toPseudoFunctor'Iso.inv,
+          Pseudofunctor.Grothendieck.map, NatTrans.toStrongTrans']
+        rw [← NatIso.naturality_2 (eqToIso (congrArg Cat.Hom.toFunctor (G.map_id Y.base)))
+          ((α.app Y.base).toFunctor.map f.fiber)]
+        simp
+      · simp [map, toPseudoFunctor'Iso, toPseudoFunctor'Iso.hom, toPseudoFunctor'Iso.inv,
+          Pseudofunctor.Grothendieck.map, NatTrans.toStrongTrans']
 
 end Pseudofunctor
 
@@ -907,6 +1023,8 @@ variable (F)
 section
 
 variable {G H : D ⥤ C} (α : G ≅ H)
+-- The bundled Cat projections require the earlier backward elaboration behavior here.
+set_option backward.isDefEq.respectTransparency false in
 /--
 An natural isomorphism between functors `G ≅ H` induces a natural isomorphism between the canonical
 morphism `pre F G` and `pre F H`, up to composition with
@@ -922,40 +1040,48 @@ def preNatIso : pre F G ≅ map (whiskerRight α.hom F) ⋙ (pre F H) :=
         Hom.comp_fiber, pre_map_fiber,
         eqToHom_trans_assoc, map_map_fiber, whiskerRight_app]
         erw [Category.comp_id, Functor.map_id,
-          Functor.congr_hom (F.congr_map (transportIso_inv_base (mk (G.obj Y.base) Y.fiber)
-          (α.app Y.base)))]
+          Functor.congr_hom (congrArg Cat.Hom.toFunctor
+            (F.congr_map (transportIso_inv_base (mk (G.obj Y.base) Y.fiber)
+              (α.app Y.base))))]
         simp)
 
+set_option backward.isDefEq.respectTransparency false in
 @[simp] theorem preNatIso_hom_app_base (x) :
     ((preNatIso F α).hom.app x).base = α.hom.app x.base := by
   simp [preNatIso]
 
+set_option backward.isDefEq.respectTransparency false in
 @[simp] theorem preNatIso_hom_app_fiber (x) :
     ((preNatIso F α).hom.app x).fiber = 𝟙 _ := by
-  simp [preNatIso]
+  simp [preNatIso, pre, functorTo]
 
 theorem preNatIso_congr {G H : D ⥤ C} {α β : G ≅ H} (h : α = β) :
     preNatIso F α = preNatIso F β ≪≫ eqToIso (by subst h; simp) := by
   subst h
   simp
 
+set_option backward.isDefEq.respectTransparency false in
 @[simp] theorem preNatIso_eqToIso {G H : D ⥤ C} {h : G = H} :
     preNatIso F (eqToIso h) =
-    eqToIso (by subst h; simp [map_id_eq, Cat.id_eq_id, Functor.id_comp]) := by
+    eqToIso (by subst h; simp [map_id_eq, Functor.id_comp]) := by
   subst h
   ext
   fapply Hom.ext
   · simp
+    rfl
   · simp only [eqToIso_refl, comp_obj, eqToIso.hom, preNatIso_hom_app_fiber,
       Category.comp_id]
     rw! [eqToHom_app, fiber_eqToHom]
+    rfl
 
+set_option backward.isDefEq.respectTransparency false in
 theorem preNatIso_comp {G1 G2 G3 : D ⥤ C} (α : G1 ≅ G2) (β : G2 ≅ G3) :
     preNatIso F (α ≪≫ β) = preNatIso F α ≪≫ isoWhiskerLeft _ (preNatIso F β) ≪≫
     eqToIso (by simp [map_comp_eq, Functor.assoc]) := by
   ext
   fapply Hom.ext
   · simp
+    rfl
   · simp only [CategoryTheory.Iso.trans_hom, eqToIso.hom, NatTrans.comp_app]
     rw! [eqToHom_app]
     simp
@@ -1012,9 +1138,11 @@ def preEquivalence (G : D ≌ C) : ∫ (G.functor ⋙ F) ≌ ∫ F where
       Equivalence.counitInv_functor_comp]
   counitIso := preNatIso F G.counitIso.symm |>.symm
   functor_unitIso_comp X := by
-    simp only [preInv, Grothendieck.preUnitIso, pre_id, CategoryTheory.Iso.trans_hom,
-      eqToIso.hom, eqToHom_app, eqToHom_refl, isoWhiskerLeft_hom, NatTrans.comp_app]
-    fapply Hom.ext <;> simp [preNatIso, transportIso]
+    -- Reduce the dependent Cat transport in this triangle only.
+    set_option backward.isDefEq.respectTransparency false in
+      simp only [preInv, Grothendieck.preUnitIso, pre_id, CategoryTheory.Iso.trans_hom,
+        eqToIso.hom, eqToHom_app, eqToHom_refl, isoWhiskerLeft_hom, NatTrans.comp_app]
+      fapply Hom.ext <;> simp [preNatIso, transportIso, isoMk, pre, map, functorTo, forget]
 
 variable {F} in
 /--
@@ -1039,12 +1167,14 @@ section FunctorFrom
 
 variable {E : Type*} [Category E] (c : C)
 
+-- Cat identity functors are bundled; permit the local dependent transport simplification.
+set_option backward.isDefEq.respectTransparency false in
 /-- The inclusion of a fiber `F.obj c` of a functor `F : C ⥤ Cat` into its Grothendieck
 construction. -/
 @[simps!]
 def ι : F.obj c ⥤ ∫ F :=
   functorTo ((const (F.obj c)).obj c) id (fun f => eqToHom (by simp) ≫ f) (by simp)
-  (by simp [Functor.congr_hom (F.map_id _)])
+  (by simp [Functor.congr_hom (congrArg Cat.Hom.toFunctor (F.map_id _))])
 
 instance faithful_ι (c : C) : (ι F c).Faithful where
   map_injective f := by
@@ -1054,13 +1184,15 @@ instance faithful_ι (c : C) : (ι F c).Faithful where
 theorem ι_comp_forget : ι F c ⋙ forget _ = (const (F.obj c)).obj c :=
   rfl
 
-@[simp] theorem ι_comp_pre (G : D ⥤ C) (x : D)
-    : ι (G ⋙ F) x ⋙ pre F G = ι F (G.obj x) := by
+-- Match the wrapped Cat functors during dependent fiber comparison.
+set_option backward.isDefEq.respectTransparency false in
+@[simp] theorem ι_comp_pre (G : D ⥤ C) (x : D) :
+    ι (G ⋙ F) x ⋙ pre F G = ι F (G.obj x) := by
   apply Grothendieck.FunctorTo.hext
   · rw [ι_comp_forget, Functor.assoc, pre_comp_forget, ← Functor.assoc, ι_comp_forget]
     apply Functor.ext <;> simp
-  · simp
-  · simp
+  · intro a; rfl
+  · intro a b f; simp
 
 variable {F}
 
@@ -1068,23 +1200,29 @@ section ιNatTrans
 
 variable {X Y : C} (f : X ⟶ Y)
 
+-- Unfold bundled Cat morphisms locally when simplifying dependent transports.
+set_option backward.isDefEq.respectTransparency false in
 /-- Every morphism `f : X ⟶ Y` in the base category induces a natural transformation from the fiber
 inclusion `ι F X` to the composition `F.map f ⋙ ι F Y`. -/
 @[simps!]
-def ιNatTrans : ι F X ⟶ F.map f ⋙ ι F Y where
+def ιNatTrans : ι F X ⟶ (F.map f).toFunctor ⋙ ι F Y where
   app _ := Hom.mk f (𝟙 _)
-  naturality _ _ _ := Hom.ext _ _ (by simp) (by simp [eqToHom_map])
+  naturality _ _ _ := Hom.ext _ _
+    (by exact (Category.id_comp f).trans (Category.comp_id f).symm)
+    (by simp [eqToHom_map])
 
+set_option backward.isDefEq.respectTransparency false in
 @[simp]
 theorem ιNatTrans_id_app {X : C} {a : F.obj X} :
     (@ιNatTrans _ _ F _ _ (𝟙 X)).app a = eqToHom (by simp) :=
-  Hom.ext _ _ (by simp) (by simp)
+  Hom.ext _ _ (by simp [ιNatTrans]; change 𝟙 X = 𝟙 X; rfl) (by simp [ι, ιNatTrans])
 
+set_option backward.isDefEq.respectTransparency false in
 lemma ιNatTrans_comp_app {X Y Z : C} {f : X ⟶ Y} {g : Y ⟶ Z} {a} :
     (@ιNatTrans _ _ F _ _ (f ≫ g)).app a =
     (@ιNatTrans _ _ F _ _ f).app a ≫
-    (@ιNatTrans _ _ F _ _ g).app ((F.map f).obj a) ≫ eqToHom (by simp) :=
-  Hom.ext _ _ (by simp) (by simp)
+    (@ιNatTrans _ _ F _ _ g).app ((F.map f).toFunctor.obj a) ≫ eqToHom (by simp) :=
+  Hom.ext _ _ (by simp) (by simp [ιNatTrans])
 
 end ιNatTrans
 
@@ -1097,11 +1235,14 @@ theorem cast_eq {F G : C ⥤ Cat}
 
 section
 
-variable (fib : ∀ c, F.obj c ⥤ E) (hom : ∀ {c c' : C} (f : c ⟶ c'), fib c ⟶ F.map f ⋙ fib c')
+variable (fib : ∀ c, F.obj c ⥤ E)
+  (hom : ∀ {c c' : C} (f : c ⟶ c'), fib c ⟶ (F.map f).toFunctor ⋙ fib c')
 variable (hom_id : ∀ c, hom (𝟙 c) = eqToHom (by simp only [Functor.map_id]; rfl))
 variable (hom_comp : ∀ c₁ c₂ c₃ (f : c₁ ⟶ c₂) (g : c₂ ⟶ c₃), hom (f ≫ g) =
-  hom f ≫ whiskerLeft (F.map f) (hom g) ≫ eqToHom (by simp only [Functor.map_comp]; rfl))
+  hom f ≫ whiskerLeft (F.map f).toFunctor (hom g) ≫ eqToHom (by simp only [Functor.map_comp]; rfl))
 
+-- Cat functor projections in transport equations need the legacy transparency behavior.
+set_option backward.isDefEq.respectTransparency false in
 /-- Construct a functor from `∫ F` to another category `E` by providing a family of
 functors on the fibers of `∫ F`, a family of natural transformations on morphisms in the
 base of `∫ F` and coherence data for this family of natural transformations. -/
@@ -1115,12 +1256,12 @@ def functorFrom : ∫ F ⥤ E where
 theorem map_eqToHom_base_pf {G1 G2 : Grothendieck F} (eq : G1 = G2) :
     F.obj G1.base = F.obj G2.base := by subst eq; rfl
 
-theorem map_eqToHom_base {G1 G2 : Grothendieck F} (eq : G1 = G2)
-    : F.map (eqToHom eq).base = eqToHom (map_eqToHom_base_pf eq) := by
+theorem map_eqToHom_base {G1 G2 : Grothendieck F} (eq : G1 = G2) :
+    F.map (eqToHom eq).base = eqToHom (map_eqToHom_base_pf eq) := by
   simp [eqToHom_map]
 
 theorem map_eqToHom_obj_base {F G : C ⥤ Cat.{v,u}} (h : F = G)
-  (x) : ((Grothendieck.map (eqToHom h)).obj x).base = x.base := rfl
+    (x) : ((Grothendieck.map (eqToHom h)).obj x).base = x.base := rfl
 
 theorem map_forget {F G : C ⥤ Cat.{v,u}} (α : F ⟶ G) :
     Grothendieck.map α ⋙ Grothendieck.forget G =
@@ -1132,7 +1273,7 @@ variable (K : Grothendieck F ⥤ E)
 abbrev asFunctorFromFib (c : C) : (F.obj c) ⥤ E := ι F c ⋙ K
 
 abbrev asFunctorFromHom {c c' : C} (f: c ⟶ c') :
-    asFunctorFromFib K c ⟶ F.map f ⋙ asFunctorFromFib K c' :=
+    asFunctorFromFib K c ⟶ (F.map f).toFunctor ⋙ asFunctorFromFib K c' :=
   Functor.whiskerRight (ιNatTrans f) K
 
 lemma asFunctorFromHom_app {c c' : C} (f: c ⟶ c') (p : F.obj c) :
@@ -1146,24 +1287,28 @@ lemma asFunctorFromHom_id (c : C) : asFunctorFromHom K (𝟙 c) =
 
 lemma asFunctorFromHom_comp (c₁ c₂ c₃ : C) (f : c₁ ⟶ c₂) (g: c₂ ⟶ c₃) :
     asFunctorFromHom K (f ≫ g) =
-    asFunctorFromHom K f ≫ Functor.whiskerLeft (F.map f) (asFunctorFromHom K g) ≫ eqToHom
-    (by simp[← Functor.assoc]; congr) := by
+    asFunctorFromHom K f ≫ Functor.whiskerLeft (F.map f).toFunctor (asFunctorFromHom K g) ≫ eqToHom
+    (by simp[← Functor.assoc]) := by
   ext p
   simp [asFunctorFromHom, eqToHom_map, ιNatTrans_comp_app]
 
+-- Normalize dependent wrapped Cat projections in the reconstruction proof.
+set_option backward.isDefEq.respectTransparency false in
 theorem asFunctorFrom : Grothendieck.functorFrom (asFunctorFromFib K) (asFunctorFromHom K)
     (asFunctorFromHom_id K) (asFunctorFromHom_comp K) = K := by
   fapply CategoryTheory.Functor.ext
   · intro X
     rfl
   · intro x y f
-    simp only [functorFrom_obj, asFunctorFromFib, Functor.comp_obj, functorFrom_map,
+    simp only [asFunctorFromFib, Functor.comp_obj, functorFrom_map,
       asFunctorFromHom, Functor.whiskerRight_app, Functor.comp_map, ← Functor.map_comp,
       eqToHom_refl, Category.comp_id, Category.id_comp]
-    congr
+    change K.map ((ιNatTrans f.base).app x.fiber ≫ (ι F y.base).map f.fiber) = K.map f
+    apply congrArg K.map
     fapply Hom.ext
-    · simp
-    · simp
+    · change f.base ≫ 𝟙 y.base = f.base
+      exact Category.comp_id _
+    · simp [ι, ιNatTrans, Functor.map_id]
 
 section
 
@@ -1172,24 +1317,30 @@ variable {D : Type*} [Category D] (G : E ⥤ D)
 def functorFromCompFib (c : C) : F.obj c ⥤ D := fib c ⋙ G
 
 def functorFromCompHom {c c' : C} (f : c ⟶ c') :
-    functorFromCompFib fib G c ⟶ F.map f ⋙ functorFromCompFib fib G c' :=
+    functorFromCompFib fib G c ⟶ (F.map f).toFunctor ⋙ functorFromCompFib fib G c' :=
   Functor.whiskerRight (hom f) G
 
+-- Normalize the dependent Cat functor projection transports locally.
+set_option backward.isDefEq.respectTransparency false in
 include hom_id in
 lemma functorFromCompHom_id (c : C) : functorFromCompHom fib hom G (𝟙 c)
-    = eqToHom (by simp [Cat.id_eq_id, Functor.id_comp]) := by
+    = eqToHom (by simp [Functor.id_comp]) := by
   ext x
   simp [hom_id, functorFromCompHom]
 
+-- Normalize the dependent Cat functor projection transports locally.
+set_option backward.isDefEq.respectTransparency false in
 include hom_comp in
 lemma functorFromCompHom_comp (c₁ c₂ c₃ : C) (f : c₁ ⟶ c₂) (g : c₂ ⟶ c₃):
     functorFromCompHom fib hom G (f ≫ g)
     = functorFromCompHom fib hom G f ≫
-    Functor.whiskerLeft (F.map f) (functorFromCompHom fib hom G g) ≫
-    eqToHom (by simp[Cat.comp_eq_comp, Functor.map_comp, Functor.assoc]) := by
+    Functor.whiskerLeft (F.map f).toFunctor (functorFromCompHom fib hom G g) ≫
+    eqToHom (by simp[Functor.map_comp, Functor.assoc]) := by
   ext
   simp [functorFromCompHom, hom_comp]
 
+-- Normalize the dependent Cat functor projection transports locally.
+set_option backward.isDefEq.respectTransparency false in
 theorem functorFrom_comp : functorFrom fib hom hom_id hom_comp ⋙ G =
     functorFrom (functorFromCompFib fib G) (functorFromCompHom fib hom G)
   (functorFromCompHom_id fib hom hom_id G)
@@ -1203,10 +1354,12 @@ theorem functorFrom_comp : functorFrom fib hom hom_id hom_comp ⋙ G =
 end
 
 section
-variable (fib' : ∀ c, F.obj c ⥤ E) (hom' : ∀ {c c' : C} (f : c ⟶ c'), fib' c ⟶ F.map f ⋙ fib' c')
+variable (fib' : ∀ c, F.obj c ⥤ E)
+  (hom' : ∀ {c c' : C} (f : c ⟶ c'), fib' c ⟶ (F.map f).toFunctor ⋙ fib' c')
 variable (hom_id' : ∀ c, hom' (𝟙 c) = eqToHom (by simp only [Functor.map_id]; rfl))
 variable (hom_comp' : ∀ c₁ c₂ c₃ (f : c₁ ⟶ c₂) (g : c₂ ⟶ c₃), hom' (f ≫ g) =
-  hom' f ≫ Functor.whiskerLeft (F.map f) (hom' g) ≫ eqToHom (by simp only [Functor.map_comp]; rfl))
+  hom' f ≫ Functor.whiskerLeft (F.map f).toFunctor (hom' g) ≫
+    eqToHom (by simp only [Functor.map_comp]; rfl))
 
 theorem functorFrom_eq_of (ef : fib = fib')
     (hhom : ∀ {c c' : C} (f : c ⟶ c'), hom f ≫ eqToHom (by rw[ef]) = eqToHom (by rw[ef]) ≫ hom' f) :
@@ -1236,8 +1389,8 @@ theorem functorFrom_ext {K K' : Grothendieck F ⥤ E}
 theorem functorFrom_hext {K K' : Grothendieck F ⥤ E}
     (hfib : ∀ c, ι F c ⋙ K = ι F c ⋙ K')
     (hhom : ∀ {c c' : C} (f : c ⟶ c'), Functor.whiskerRight (ιNatTrans f) K ≍
-      Functor.whiskerRight (ιNatTrans f) K')
-    : K = K' := by
+      Functor.whiskerRight (ιNatTrans f) K') :
+    K = K' := by
   fapply functorFrom_ext
   · assumption
   · intros
@@ -1250,7 +1403,12 @@ end
 /-- `Grothendieck.ι F c` composed with `Grothendieck.functorFrom` is isomorphic a functor on a fiber
 on `F` supplied as the first argument to `Grothendieck.functorFrom`. -/
 def ιCompFunctorFrom (c : C) : ι F c ⋙ (functorFrom fib hom hom_id hom_comp) ≅ fib c :=
-  NatIso.ofComponents (fun _ => CategoryTheory.Iso.refl _) (fun f => by simp [hom_id])
+  NatIso.ofComponents (fun _ => CategoryTheory.Iso.refl _) (fun f => by
+    -- Normalize the dependent fiber inclusion projections.
+    set_option backward.isDefEq.respectTransparency false in
+      simp only [CategoryTheory.Iso.refl_hom, Category.comp_id, Category.id_comp]
+      change (hom (𝟙 c)).app _ ≫ (fib c).map (eqToHom _ ≫ f) = (fib c).map f
+      simp [hom_id])
 
 @[simp]
 lemma ι_comp_functorFrom (c : C) : ι F c ⋙ (functorFrom fib hom hom_id hom_comp) = fib c :=
@@ -1260,17 +1418,20 @@ lemma whiskerRight_ιNatTrans_functorFrom {x y} (f : x ⟶ y) :
     Functor.whiskerRight (ιNatTrans f) (functorFrom fib hom hom_id hom_comp) =
     eqToHom (ι_comp_functorFrom ..) ≫ hom f ≫
     eqToHom (by rw [Functor.assoc, ι_comp_functorFrom]) := by
-  ext; simp
+  set_option backward.isDefEq.respectTransparency false in
+    ext; simp [ιNatTrans, ι]; rfl
 
 section
 variable (A : E ⥤ C) (fibObj : (x : E) → (A ⋙ F).obj x)
-    (fibMap : {x y : E} → (f : x ⟶ y) → ((A ⋙ F).map f).obj (fibObj x) ⟶ fibObj y)
+    (fibMap : {x y : E} → (f : x ⟶ y) → ((A ⋙ F).map f).toFunctor.obj (fibObj x) ⟶ fibObj y)
     (map_id : (x : E) → fibMap (CategoryStruct.id x)
       = eqToHom (functorTo_map_id_aux A fibObj x))
     (map_comp : {x y z : E} → (f : x ⟶ y) → (g : y ⟶ z) → fibMap (f ≫ g)
       = eqToHom (functorTo_map_comp_aux A fibObj f g)
-      ≫ (F.map (A.map g)).map (fibMap f) ≫ fibMap g)
+      ≫ (F.map (A.map g)).toFunctor.map (fibMap f) ≫ fibMap g)
 
+-- Allow reduction of the dependent Cat projections in this equivalence proof.
+set_option backward.isDefEq.respectTransparency false in
 @[simps!]
 def functorIsoFrom (fib_comp : ∀ c, fib c ⋙ A = ι F c ⋙ forget F)
     (fibObj_fib_obj : ∀ c x, fibObj ((fib c).obj x) ≍ x)
@@ -1280,7 +1441,8 @@ def functorIsoFrom (fib_comp : ∀ c, fib c ⋙ A = ι F c ⋙ forget F)
       (fib (A.obj y)).map (fibMap f) ≍ f)
     (obj_fib_obj : ∀ c x, A.obj ((fib c).obj x) = c)
     (map_hom_app : ∀ {c c'} (f : c ⟶ c') x, A.map ((hom f).app x) ≍ f)
-    (fibMap_hom_app : ∀ {c c'} (f : c ⟶ c') x, fibMap ((hom f).app x) ≍ 𝟙 ((F.map f).obj x)) :
+    (fibMap_hom_app : ∀ {c c'} (f : c ⟶ c') x,
+      fibMap ((hom f).app x) ≍ 𝟙 ((F.map f).toFunctor.obj x)) :
     ∫ F ≅≅ E where
   hom := functorFrom fib hom hom_id hom_comp
   inv := functorTo A fibObj fibMap map_id map_comp
@@ -1291,53 +1453,61 @@ def functorIsoFrom (fib_comp : ∀ c, fib c ⋙ A = ι F c ⋙ forget F)
       apply FunctorTo.hext
       · simp only [Functor.assoc, functorTo_forget, Functor.id_comp, fib_comp]
       · apply fibObj_fib_obj
-      · intro x y f
-        simp only [comp_obj, functorTo_obj_base, comp_map, functorTo_map_base, functorTo_obj_fiber,
-          functorTo_map_fiber, id_obj, ι_obj_base, id_map, ι_map_base, ι_obj_fiber, ι_map_fiber]
+      · simp only [comp_obj, comp_map, functorTo_map_fiber, id_obj, id_map, ι_map_fiber]
+        intro x y f
         rw! [eqToHom_comp_heq, heq_cast_iff_heq]
         apply fibMap_fib_map
     · intro c c' f
       apply NatTrans.ext
       ext x
-      simp only [comp_obj, functorFrom_obj, ι_obj_base, ι_obj_fiber, id_obj, comp_whiskerRight,
+      simp only [comp_obj, id_obj, comp_whiskerRight,
         whiskerRight_ιNatTrans_functorFrom, whiskerRight_comp, eqToHom_whiskerRight, Category.assoc,
         eqToHom_trans, NatTrans.comp_app, eqToHom_app, eqToHom_refl, whiskerRight_app,
         Category.id_comp, id_whiskerRight, ← heq_eq_eq, heq_eqToHom_comp_iff, comp_eqToHom_heq_iff]
       apply Grothendieck.Hom.hext' rfl
       any_goals apply Grothendieck.hext' rfl
-      all_goals simp [obj_fib_obj, fibObj_fib_obj, fibMap_hom_app, map_hom_app]
+      all_goals simp [functorTo, ι, obj_fib_obj, fibObj_fib_obj, fibMap_hom_app, map_hom_app]
   inv_hom_id := by
     fapply Functor.ext
     · intro x
-      simp [fib_obj_fibObj]
+      simp [functorTo, fib_obj_fibObj]
     · intro x y f
-      simp [← heq_eq_eq, hom_map_app_fibObj]
+      simp [functorTo, ← heq_eq_eq, hom_map_app_fibObj]
 
 end
 end
 
 end FunctorFrom
 
-/-- The fiber inclusion `ι F c` composed with `map α` is isomorphic to `α.app c ⋙ ι F' c`. -/
+-- Normalize wrapped Cat projections in the inclusion naturality equation.
+set_option backward.isDefEq.respectTransparency false in
+/-- The fiber inclusion `ι F c` composed with `map α` is isomorphic to
+`(α.app c).toFunctor ⋙ ι F' c`.
+-/
 @[simps!]
-def ιCompMap {F' : C ⥤ Cat} (α : F ⟶ F') (c : C) : ι F c ⋙ map α ≅ α.app c ⋙ ι F' c :=
+def ιCompMap {F' : C ⥤ Cat} (α : F ⟶ F') (c : C) : ι F c ⋙ map α ≅ (α.app c).toFunctor ⋙ ι F' c :=
   NatIso.ofComponents (fun X => CategoryTheory.Iso.refl _) (fun f => by
     simp only [CategoryTheory.Iso.refl_hom, Category.comp_id]
-    apply Hom.ext <;> simp)
+    apply Hom.ext <;> simp [map, functorTo, ι, forget])
 
-lemma ι_comp_map {F' : C ⥤ Cat} (α : F ⟶ F') (c : C) : ι F c ⋙ map α = α.app c ⋙ ι F' c :=
+lemma ι_comp_map {F' : C ⥤ Cat} (α : F ⟶ F') (c : C) :
+    ι F c ⋙ map α = (α.app c).toFunctor ⋙ ι F' c :=
   Functor.ext_of_iso (ιCompMap ..) (by intro; rfl)
 
 section AsSmall
 
 attribute [-simp] AsSmall.down_obj AsSmall.down_map
 
+-- Normalize the wrapped Cat projections in the dependent transport equations.
+set_option backward.isDefEq.respectTransparency false in
 /-- The inverse functor to build the equivalence `compAsSmallFunctorEquivalence`. -/
 @[simp] def compAsSmallFunctorEquivalenceInverse :
     ∫ F ⥤ ∫(F ⋙ Cat.asSmallFunctor.{w}) :=
   functorTo (forget _) (fun X => (AsSmall.up.obj X.fiber)) (fun f => (AsSmall.up.map f.fiber))
-  (by simp) (by intros; simp)
+  (by intro X; simp [eqToHom_map])
+  (by intros; simp [Functor.map_comp, eqToHom_map, Cat.asSmallFunctor, forget])
 
+set_option backward.isDefEq.respectTransparency false in
 /-- The functor to build the equivalence `compAsSmallFunctorEquivalence`. -/
 @[simp] def compAsSmallFunctorEquivalenceFunctor :
     ∫(F ⋙ Cat.asSmallFunctor.{w}) ⥤ ∫ F :=
@@ -1345,7 +1515,7 @@ attribute [-simp] AsSmall.down_obj AsSmall.down_map
   (by intros; simp; apply eqToHom_map) -- FIXME: eqToHom_map does not fire under simp
   (by
     intros
-    simp [Functor.map_comp])
+    simp [Functor.map_comp, eqToHom_map, Cat.asSmallFunctor, forget])
   -- FIXME: these AsSmall goals are awful. Need to add some evil lemmas for AsSmall.up, AsSmall.down
 
 /-- Taking the Grothendieck construction on `F ⋙ asSmallFunctor`, where
@@ -1358,6 +1528,10 @@ def compAsSmallFunctorEquivalence :
   inverse := compAsSmallFunctorEquivalenceInverse F
   counitIso := CategoryTheory.Iso.refl _
   unitIso := CategoryTheory.Iso.refl _
+  functor_unitIso_comp := by
+    intro X
+    change (compAsSmallFunctorEquivalenceFunctor F).map (𝟙 X) ≫ 𝟙 _ = 𝟙 _
+    rw [Functor.map_id, Category.comp_id]
 
 namespace AsSmall
 
@@ -1371,23 +1545,20 @@ namespace AsSmall
   AsSmall.up.map (AsSmall.down.map f) = f := rfl
 
 theorem comp_up_inj {C : Type u} [Category.{v} C]
-  {D : Type u₁} [Category.{v₁} D] {F G : C ⥤ D}
+    {D : Type u₁} [Category.{v₁} D] {F G : C ⥤ D}
     (h : F ⋙ (AsSmall.up : D ⥤ AsSmall.{w} D) = G ⋙ AsSmall.up) : F = G := by
-  convert_to F ⋙ (AsSmall.up : D ⥤ AsSmall.{w} D)
-    ⋙ AsSmall.down
-    = G ⋙ (AsSmall.up : D ⥤ AsSmall.{w} D)
-    ⋙ AsSmall.down
-  rw [← Functor.assoc, h, Functor.assoc]
+  have h' := congrArg (fun H : C ⥤ AsSmall.{w} D => H ⋙ AsSmall.down) h
+  change F = G at h'
+  exact h'
 
 theorem comp_down_inj {C : Type u} [Category.{v} C]
-  {D : Type u₁} [Category.{v₁} D]
+    {D : Type u₁} [Category.{v₁} D]
     {F G : C ⥤ AsSmall.{w} D}
-    (h : F ⋙ AsSmall.down = G ⋙ AsSmall.down)
-    : F = G := by
-  convert_to F ⋙ AsSmall.down
-    ⋙ AsSmall.up
-    = G ⋙ AsSmall.down ⋙ AsSmall.up
-  rw [← Functor.assoc, h, Functor.assoc]
+    (h : F ⋙ AsSmall.down = G ⋙ AsSmall.down) :
+    F = G := by
+  have h' := congrArg (fun H : C ⥤ D => H ⋙ (AsSmall.up : D ⥤ AsSmall.{w} D)) h
+  change F = G at h'
+  exact h'
 
 @[simp] theorem up_comp_down
     {C : Type u₁} [Category.{v₁, u₁} C] :
@@ -1403,6 +1574,8 @@ instance {C : Type u} [Category.{v} C] :
 
 end AsSmall
 
+-- Allow simplification to unfold the bundled Cat functors in the naturality proof.
+set_option backward.isDefEq.respectTransparency false in
 variable {F G} in
 /-- Mapping a Grothendieck construction along the whiskering of any natural transformation
 `α : F ⟶ G` with the functor `asSmallFunctor : Cat ⥤ Cat` is naturally isomorphic to conjugating
@@ -1414,11 +1587,11 @@ def mapWhiskerRightAsSmallFunctor (α : F ⟶ G) :
   NatIso.ofComponents
     (fun X => CategoryTheory.Iso.refl _)
     (fun f => by
-      simp only [compAsSmallFunctorEquivalence_functor, compAsSmallFunctorEquivalenceFunctor,
-        comp_obj, forget_obj, comp_map, forget_map, compAsSmallFunctorEquivalence_inverse,
-        compAsSmallFunctorEquivalenceInverse, CategoryTheory.Iso.refl_hom, Category.comp_id,
-        Category.id_comp]
-      apply Hom.ext <;> simp
+      simp only [comp_obj, comp_map, CategoryTheory.Iso.refl_hom,
+        Category.comp_id, Category.id_comp]
+      apply Hom.ext <;> simp [compAsSmallFunctorEquivalence,
+        compAsSmallFunctorEquivalenceInverse, compAsSmallFunctorEquivalenceFunctor, functorTo, map]
+      rfl
       )
 
 end AsSmall
@@ -1432,18 +1605,20 @@ instance : IsIso f.base := by
   · simp [← Grothendieck.Hom.comp_base]
   · simp [← Grothendieck.Hom.comp_base]
 
-def invFiber : y.fiber ⟶ (F.map f.base).obj x.fiber :=
+def invFiber : y.fiber ⟶ (F.map f.base).toFunctor.obj x.fiber :=
   eqToHom (by simp [← Functor.comp_obj, ← Cat.comp_eq_comp, ← Functor.map_comp,
       ← Grothendieck.Hom.comp_base]) ≫
-    (F.map f.base).map (CategoryTheory.inv f).fiber
+    (F.map f.base).toFunctor.map (CategoryTheory.inv f).fiber
 
+-- Normalize dependent transports through the wrapped Cat functor.
+set_option backward.isDefEq.respectTransparency false in
 @[simp]
-lemma fiber_comp_invFiber : f.fiber ≫ invFiber f = 𝟙 ((F.map f.base).obj x.fiber) := by
+lemma fiber_comp_invFiber : f.fiber ≫ invFiber f = 𝟙 ((F.map f.base).toFunctor.obj x.fiber) := by
   have h := Functor.Grothendieck.Hom.comp_fiber f (CategoryTheory.inv f)
   rw! [IsIso.hom_inv_id] at h
-  have h0 : F.map (CategoryTheory.inv f).base ⋙ F.map f.base = 𝟭 _ := by
-    simp [← Cat.comp_eq_comp, ← Functor.map_comp, ← Grothendieck.Hom.comp_base, Cat.id_eq_id]
-  have h1 := Functor.congr_map (F.map f.base) h
+  have h0 : (F.map (CategoryTheory.inv f).base).toFunctor ⋙ (F.map f.base).toFunctor = 𝟭 _ := by
+    simp [← Cat.comp_eq_comp, ← Functor.map_comp, ← Grothendieck.Hom.comp_base]
+  have h1 := Functor.congr_map (F.map f.base).toFunctor h
   simp [← heq_eq_eq, eqToHom_map, ← Functor.comp_map, Functor.congr_hom h0] at h1
   dsimp [invFiber]
   rw! [← h1]
diff --git a/HoTTLean/ForMathlib/CategoryTheory/Core.lean b/HoTTLean/ForMathlib/CategoryTheory/Core.lean
index bd136ad0..e4898c3b 100644
--- a/HoTTLean/ForMathlib/CategoryTheory/Core.lean
+++ b/HoTTLean/ForMathlib/CategoryTheory/Core.lean
@@ -22,15 +22,15 @@ variable {C : Type u} [Category.{v} C] {D : Type u₁} [Category.{v₁} D]
   subst h
   rfl
 
-def comp_inclusion_injective {l0 l1 : D ⥤ Core C} (hl : l0 ⋙ inclusion C = l1 ⋙ inclusion C) : l0 = l1 := by
+theorem comp_inclusion_injective {l0 l1 : D ⥤ Core C}
+    (hl : l0 ⋙ inclusion C = l1 ⋙ inclusion C) : l0 = l1 := by
   fapply Functor.ext
   · intro x
     ext
     exact Functor.congr_obj hl x
   · intro x y f
-    ext
-    convert Functor.congr_hom hl f
-    simp
+    apply (inclusion C).map_injective
+    simpa [Functor.comp_map, inclusion, eqToHom_iso] using Functor.congr_hom hl f
 
 lemma core_comp_inclusion (F : C ⥤ D) :
     F.core ⋙ inclusion D = inclusion C ⋙ F :=
@@ -38,7 +38,7 @@ lemma core_comp_inclusion (F : C ⥤ D) :
 
 def map : Cat.{v,u} ⥤ Grpd.{v,u} where
   obj C := Grpd.of (Core C)
-  map F := Grpd.homOf (F.core)
+  map F := Grpd.homOf (F.toFunctor.core)
 
 variable {Γ : Type u} [Groupoid.{v} Γ]
 
@@ -50,9 +50,8 @@ def functorToCoreEquiv : Γ ⥤ D ≃ Γ ⥤ Core D where
   invFun := forgetFunctorToCore.obj
   left_inv _ := rfl
   right_inv _ := by
-    fapply Functor.ext
-    · aesop_cat
-    · aesop_cat
+    apply comp_inclusion_injective
+    rfl
 
 variable {C : Type u₁} [Category.{v₁} C]
 variable {G : Type u₂} [Groupoid.{v₂} G]
@@ -61,18 +60,7 @@ variable {C' : Type u₃} [Category.{v₃} C']
 
 @[simp]
 theorem functorToCore_comp_inclusion (H : G ⥤ C) :
-  functorToCore H ⋙ inclusion _ = H := rfl
-
-theorem functorToCore_comp_left (H : G ⥤ C) (F : G' ⥤ G) :
-    functorToCore (F ⋙ H) = F ⋙ functorToCore H := by
-  apply Functor.ext
-  · simp [functorToCore]
-  · intro
-    rfl
-
-theorem functorToCore_comp_right (H : G ⥤ C) (F : C ⥤ C') :
-    functorToCore (H ⋙ F) = functorToCore H ⋙ F.core := by
-  rfl
+    functorToCore H ⋙ inclusion _ = H := rfl
 
 theorem functorToCoreEquiv_symm_apply_comp_left (H : G ⥤ Core C) (F : G' ⥤ G) :
     functorToCoreEquiv.symm (F ⋙ H) = F ⋙ functorToCoreEquiv.symm H :=
@@ -83,7 +71,7 @@ theorem functorToCoreEquiv_symm_apply_comp_right (H : G ⥤ Core C) (F : C ⥤ C
   rfl
 
 theorem eqToIso_iso_hom {a b : Core C} (h1 : a = b)
-  (h2 : (inclusion C).obj a = (inclusion C).obj b) :
+    (h2 : (inclusion C).obj a = (inclusion C).obj b) :
     (eqToHom h1).iso.hom = eqToHom h2 := by
   cases h1
   rfl
@@ -94,23 +82,12 @@ def adjunction : Grpd.forgetToCat ⊣ Core.map where
   unit := {
     app G := Grpd.homOf (Core.functorToCore (Functor.id _))
     naturality _ _ F := by
-      simp [Core.map, Grpd.comp_eq_comp,
-        ← functorToCore_comp_left,
+      change F ⋙ functorToCore (𝟭 _) = functorToCore (𝟭 _) ⋙ F.core
+      simp [← functorToCore_comp_left,
         ← functorToCore_comp_right,
-        Functor.id_comp, Functor.comp_id, Grpd.forgetToCat]}
+        Functor.id_comp, Functor.comp_id]}
   counit := {app C := Cat.homOf (Core.inclusion C)}
 
-/-- Mildly evil. -/
-theorem inclusion_comp_functorToCore : inclusion G ⋙ functorToCore (𝟭 G) = Functor.id (Core G) := by
-    apply Functor.ext
-    · intro x y f
-      simp only [Core.inclusion, Core.functorToCore, Functor.id_map,
-        Functor.comp_map, Groupoid.inv_eq_inv, IsIso.Iso.inv_hom,
-        eqToHom_refl, Category.comp_id, Category.id_comp]
-      rfl
-    · intro
-      rfl
-
 theorem functorToCore_inclusion_apply {C : Type u} [Category.{v} C] :
     Core.functorToCore (Core.inclusion C) = Functor.id (Core C) :=
   rfl
@@ -129,7 +106,7 @@ instance {G : Type u} [Groupoid.{v} G] :
 
 end Adjunction
 
-open Functor
+open _root_.CategoryTheory.Functor
 
 instance : IsLeftAdjoint Grpd.forgetToCat :=
   IsLeftAdjoint.mk ⟨ Core.map , ⟨ adjunction ⟩ ⟩
@@ -146,34 +123,31 @@ variable {C : Type u} [Category.{v} C] {D : Type u} [Category.{v} D]
 variable {E : Type*} [Category E] (En : E ⥤ C) (Ew : E ⥤ Core D)
   (hE : En ⋙ F = Ew ⋙ inclusion D)
 
+-- The equality transports in this dependent construction require reducible type transparency.
+set_option backward.isDefEq.respectTransparency.types false in
 def lift : E ⥤ Core C where
   obj x := ⟨ En.obj x ⟩
   map {x y} f := ⟨ @asIso _ _ _ _ (En.map f) $ by
     let f' : F.obj (En.obj x) ≅ F.obj (En.obj y) :=
       (eqToIso hE).app x ≪≫ (Ew.map f).iso ≪≫ (eqToIso hE.symm).app y
     have hnat : F.map (En.map f) ≫ _
-      = _ ≫ (inclusion D).map (Ew.map f)
-      := (eqToHom hE).naturality f
+      = _ ≫ (inclusion D).map (Ew.map f) :=
+      (eqToHom hE).naturality f
     have h : F.map (En.map f) = f'.hom := by
       simp only [eqToHom_app, comp_eqToHom_iff] at hnat
       simp [hnat, f', Core.inclusion]
     have : IsIso (F.map (En.map f)) := by rw [h]; exact Iso.isIso_hom f'
     exact Functor.ReflectsIsomorphisms.reflects F (En.map f) ⟩
 
-def fac_left : lift F En Ew hE ⋙ inclusion C = En := rfl
+theorem fac_left : lift F En Ew hE ⋙ inclusion C = En := rfl
 
-def fac_right : lift F En Ew hE ⋙ F.core = Ew := by
-  fapply Functor.ext
-  · intro x
-    ext
-    exact Functor.congr_obj hE x
-  · intro x y f
-    ext
-    convert Functor.congr_hom hE f
-    simp
+theorem fac_right : lift F En Ew hE ⋙ F.core = Ew := by
+  apply comp_inclusion_injective
+  exact hE
 
 def universal : (lift : E ⥤ Core C) ×' lift ⋙ inclusion C = En ∧ lift ⋙ F.core = Ew ∧
-    ∀ {l0 l1 : E ⥤ Core C}, l0 ⋙ inclusion C = l1 ⋙ inclusion C → l0 ⋙ F.core = l1 ⋙ F.core → l0 = l1 :=
+    ∀ {l0 l1 : E ⥤ Core C}, l0 ⋙ inclusion C = l1 ⋙ inclusion C →
+      l0 ⋙ F.core = l1 ⋙ F.core → l0 = l1 :=
   ⟨ lift F En Ew hE, fac_left _ _ _ _, fac_right _ _ _ _,
     fun hl _ => comp_inclusion_injective hl ⟩
 
@@ -182,7 +156,7 @@ end IsPullback
 variable {C : Type u} [Category.{v} C] {D : Type u} [Category.{v} D]
   (F : C ⥤ D) [F.ReflectsIsomorphisms]
 
-open IsPullback
+open _root_.CategoryTheory.Core.IsPullback
 
 /--
   In the category of categories,
diff --git a/HoTTLean/ForMathlib/CategoryTheory/FreeGroupoid.lean b/HoTTLean/ForMathlib/CategoryTheory/FreeGroupoid.lean
index e853e0c4..19e502ef 100644
--- a/HoTTLean/ForMathlib/CategoryTheory/FreeGroupoid.lean
+++ b/HoTTLean/ForMathlib/CategoryTheory/FreeGroupoid.lean
@@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Joseph Hua
 -/
 import Mathlib.CategoryTheory.Groupoid.FreeGroupoid
-import Mathlib.CategoryTheory.Category.Grpd
+import Mathlib.CategoryTheory.Groupoid.Grpd.Basic
 import Mathlib.CategoryTheory.Adjunction.Reflective
 import Mathlib.CategoryTheory.Localization.Predicate
 import Mathlib.CategoryTheory.Monad.Limits
@@ -62,9 +62,9 @@ open Quiver in
 promotes the prefunctor `C ⥤q FreeGroupoid C` into a functor
 `C ⥤ Quotient (FreeGroupoid.homRel C)`. -/
 inductive FreeGroupoid.homRel : HomRel (Quiver.FreeGroupoid C) where
-| map_id (X : C) : homRel ((FreeGroupoid.of C).map (𝟙 X)) (𝟙 ((FreeGroupoid.of C).obj X))
-| map_comp {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) : homRel ((FreeGroupoid.of C).map (f ≫ g))
-  ((FreeGroupoid.of C).map f ≫ (FreeGroupoid.of C).map g)
+  | map_id (X : C) : homRel ((FreeGroupoid.of C).map (𝟙 X)) (𝟙 ((FreeGroupoid.of C).obj X))
+  | map_comp {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) : homRel ((FreeGroupoid.of C).map (f ≫ g))
+    ((FreeGroupoid.of C).map f ≫ (FreeGroupoid.of C).map g)
 
 /-- The underlying type of the free groupoid on a category,
 defined by quotienting the free groupoid on the underlying quiver of `C`
@@ -102,35 +102,36 @@ lemma of.map_comp {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) :
 /-- The localization map from the category `C` to the groupoid `Category.FreeGroupoid C` -/
 def of : C ⥤ Category.FreeGroupoid C where
   __ := Quiver.FreeGroupoid.of C ⋙q (Quotient.functor (FreeGroupoid.homRel C)).toPrefunctor
-  map_id X := by simp
-  map_comp {X Y Z} f g := by simp
+  map_id X := of.map_id C X
+  map_comp f g := of.map_comp C f g
 
 section UniversalProperty
 
 variable {C} {G : Type u₁} [Groupoid.{v₁} G]
 
+-- The lift uses the same local transparency setting as the Mathlib quiver lift.
+set_option backward.isDefEq.respectTransparency false in
 /-- The lift of a functor from `C` to a groupoid to a functor from
 `FreeGroupoid C` to the groupoid -/
 def lift (φ : C ⥤ G) : Category.FreeGroupoid C ⥤ G :=
   Quotient.lift (FreeGroupoid.homRel C) (Quiver.FreeGroupoid.lift φ.toPrefunctor) (by
     intros X Y f g r
     rcases r with X | ⟨ f , g ⟩
-    · simpa using Prefunctor.congr_hom (Quiver.FreeGroupoid.lift_spec φ.toPrefunctor) (𝟙 X)
+    · change _ = 𝟙 (φ.obj X)
+      simpa using Prefunctor.congr_hom (Quiver.FreeGroupoid.lift_spec φ.toPrefunctor) (𝟙 X)
     · have hf := Prefunctor.congr_hom (Quiver.FreeGroupoid.lift_spec φ.toPrefunctor) f
       have hg := Prefunctor.congr_hom (Quiver.FreeGroupoid.lift_spec φ.toPrefunctor) g
       have hfg := Prefunctor.congr_hom (Quiver.FreeGroupoid.lift_spec φ.toPrefunctor) (f ≫ g)
-      simp only [Functor.toPrefunctor_obj, Prefunctor.comp_obj, Prefunctor.comp_map,
+      simp only [Prefunctor.comp_map,
         Functor.toPrefunctor_map, Quiver.homOfEq_rfl, Functor.map_comp] at *
       rw [hf, hg, hfg])
 
+set_option backward.isDefEq.respectTransparency false in
 theorem lift_spec (φ : C ⥤ G) : of C ⋙ lift φ = φ := by
-  have : Quiver.FreeGroupoid.of C ⋙q (Quotient.functor (FreeGroupoid.homRel C)).toPrefunctor ⋙q
-      (lift φ).toPrefunctor = φ.toPrefunctor := by
-    simp [lift, Quotient.lift_spec, Quiver.FreeGroupoid.lift_spec]
-  fapply Functor.ext
-  · apply Prefunctor.congr_obj this
-  · intro _ _
-    simpa using Prefunctor.congr_hom this
+  apply Functor.toPrefunctor_injective
+  change Quiver.FreeGroupoid.of C ⋙q
+    ((Quotient.functor (FreeGroupoid.homRel C)) ⋙ lift φ).toPrefunctor = _
+  rw [lift, Quotient.lift_spec, Quiver.FreeGroupoid.lift_spec]
 
 theorem lift_unique (φ : C ⥤ G) (Φ : Category.FreeGroupoid C ⥤ G) (hΦ : of C ⋙ Φ = φ) :
     Φ = lift φ := by
@@ -190,22 +191,25 @@ open Category.FreeGroupoid
 @[simps]
 def free : Cat.{u,u} ⥤ Grpd.{u,u} where
   obj C := Grpd.of <| Category.FreeGroupoid C
-  map {C D} F := map F
-  map_id C := by simp [Grpd.id_eq_id, ← map_id]; rfl
-  map_comp F G := by simp [Grpd.comp_eq_comp, ← map_comp]; rfl
+  map {_ _} F := map F.toFunctor
+  map_id _ := Category.FreeGroupoid.map_id
+  map_comp F G := Category.FreeGroupoid.map_comp F.toFunctor G.toFunctor
 
 /-- The unit of the free-forgetful adjunction between `Grpd` and `Cat`. -/
 @[simps]
 def freeForgetAdjunction.unit : 𝟭 Cat ⟶ free ⋙ forgetToCat where
-  app C := Category.FreeGroupoid.of C
-  naturality C D F := by simp [forgetToCat, Cat.comp_eq_comp, map, lift_spec]
+  app C := (Category.FreeGroupoid.of C).toCatHom
+  naturality C D F := by
+    apply Cat.Hom.ext
+    exact (lift_spec (F.toFunctor ⋙ Category.FreeGroupoid.of D)).symm
 
 /-- The counit of the free-forgetful adjunction between `Grpd` and `Cat`. -/
 @[simps]
 def freeForgetAdjunction.counit : forgetToCat ⋙ free ⟶ 𝟭 Grpd where
   app G := lift (𝟭 G)
   naturality G H φ := by
-    simp [map, Grpd.comp_eq_comp, ← lift_comp, forgetToCat, Functor.id_comp, Functor.assoc,
+    change lift (φ ⋙ Category.FreeGroupoid.of H) ⋙ lift (𝟭 H) = lift (𝟭 G) ⋙ φ
+    simp [← lift_comp, Functor.id_comp, Functor.assoc,
       lift_spec, Functor.comp_id]
 
 /-- The free-forgetful adjunction between `Grpd` and `Cat`. -/
@@ -213,12 +217,15 @@ def freeForgetAdjunction : free ⊣ Grpd.forgetToCat where
   unit := freeForgetAdjunction.unit
   counit := freeForgetAdjunction.counit
   left_triangle_components C := by
-    simp only [free_obj, free_map, map, coe_of, comp_eq_comp, ← lift_comp]
+    change lift (Category.FreeGroupoid.of C ⋙ Category.FreeGroupoid.of _) ⋙ lift (𝟭 _) = 𝟭 _
+    rw [← lift_comp]
+    simp only [Functor.assoc, lift_spec, Functor.comp_id]
     symm
     apply lift_unique
-    simp [Functor.assoc, lift_spec, Grpd.id_eq_id]
+    rfl
   right_triangle_components G := by
-    simp [forgetToCat, Cat.comp_eq_comp, lift_spec, Cat.id_eq_id]
+    apply Cat.Hom.ext
+    exact lift_spec (𝟭 G)
 
 instance : Reflective Grpd.forgetToCat where
   L := free
diff --git a/HoTTLean/ForMathlib/CategoryTheory/Functor/IsPullback.lean b/HoTTLean/ForMathlib/CategoryTheory/Functor/IsPullback.lean
index 0dc8f53e..66a9d3da 100644
--- a/HoTTLean/ForMathlib/CategoryTheory/Functor/IsPullback.lean
+++ b/HoTTLean/ForMathlib/CategoryTheory/Functor/IsPullback.lean
@@ -61,15 +61,20 @@ end ChosenObjects
   whose two components are sent to equal maps in the base category `Sudan`.
 -/
 def morphismProperty : MorphismProperty (ChosenObjects east south) :=
-  fun {x y} f => east.map f.1
-    = eqToHom x.property ≫ south.map f.2 ≫ eqToHom y.property.symm
+  fun {x y} f => east.map f.hom.1
+    = eqToHom x.property ≫ south.map f.hom.2 ≫ eqToHom y.property.symm
 
 instance : MorphismProperty.IsMultiplicative (morphismProperty east south) where
   id_mem x := by
-    simp [morphismProperty, ChosenObjects, ObjectProperty.FullSubcategory.id_def]
+    change east.map (𝟙 x.obj.1) =
+      eqToHom x.property ≫ south.map (𝟙 x.obj.2) ≫ eqToHom x.property.symm
+    simp
   comp_mem f g hf hg := by
-    simp only [morphismProperty, ChosenObjects,
-      ObjectProperty.FullSubcategory.comp_def] at *
+    change east.map (f.hom.1 ≫ g.hom.1) =
+      eqToHom _ ≫ south.map (f.hom.2 ≫ g.hom.2) ≫ eqToHom _
+    change east.map f.hom.1 = _ at hf
+    change east.map g.hom.1 = _ at hg
+    simp only [Functor.map_comp]
     simp [hg, hf]
 
 /--
@@ -144,11 +149,13 @@ The universal lift of the chosen pullback `Chosen` commutes with projections.
 theorem fac_right : lift Cn Cw hC ⋙ west = Cw :=
   rfl
 
+-- The projection equations unfold the chosen wide subcategory during rewriting.
+set_option backward.isDefEq.respectTransparency false in
 /--
 Lifts of the chosen pullback `Chosen` are unique.
 -/
 theorem hom_ext {l0 l1 : C ⥤ Chosen east south} (hnorth : l0 ⋙ north = l1 ⋙ north)
-   (hwest : l0 ⋙ west = l1 ⋙ west) : l0 = l1 := by
+    (hwest : l0 ⋙ west = l1 ⋙ west) : l0 = l1 := by
   fapply Functor.ext
   · intro x
     apply WideSubcategory.ext
@@ -159,20 +166,20 @@ theorem hom_ext {l0 l1 : C ⥤ Chosen east south} (hnorth : l0 ⋙ north = l1 
   · intro x y f
     apply (wideSubcategory.faithful _).map_injective
     apply (ObjectProperty.faithful_ι _).map_injective
-    apply prod.hom_ext
-    · convert congr_hom hnorth f
-      simp only [Functor.map_comp, eqToHom_map]
-      simp [north]
-    · convert congr_hom hwest f
-      simp only [Functor.map_comp, eqToHom_map]
-      simp [west]
+    apply Prod.hom_ext
+    · change (l0 ⋙ north).map f = north.map (eqToHom _ ≫ l1.map f ≫ eqToHom _)
+      rw [Functor.map_comp, Functor.map_comp, eqToHom_map, eqToHom_map]
+      exact congr_hom hnorth f
+    · change (l0 ⋙ west).map f = west.map (eqToHom _ ≫ l1.map f ≫ eqToHom _)
+      rw [Functor.map_comp, Functor.map_comp, eqToHom_map, eqToHom_map]
+      exact congr_hom hwest f
 
 end Chosen
 
 end IsPullback
 
 
-open IsPullback
+open _root_.CategoryTheory.Functor.IsPullback
 
 /--
 A pullback structure on a type `Libya` over a pair of functors
@@ -387,7 +394,7 @@ variable {Libya Egypt Chad Sudan : Type*} [Category Libya]
 
 variable {north} in
 lemma Iso.inv_comp_eq_comp_inv {north'} (lib : Iso Chad Libya) (egy : Iso Sudan Egypt)
-(hnorth : north' ⋙ egy.hom = lib.hom ⋙ north): lib.inv ⋙ north' = north ⋙ egy.inv
+    (hnorth : north' ⋙ egy.hom = lib.hom ⋙ north): lib.inv ⋙ north' = north ⋙ egy.inv
     ↔ north' ⋙ egy.hom = lib.hom ⋙ north := by
     rw [lib.inv_comp_eq, ← Functor.assoc, egy.eq_comp_inv, hnorth]
 
@@ -420,16 +427,15 @@ def ofIso'Lift {C : Type*} [Category C] (Cn : C ⥤ Egypt') (Cw : C ⥤ Chad')
   ⋙ lib.inv
 
 def ofIso'Universal {C : Type*} [Category C]
-    (Cn : C ⥤ Egypt') (Cw : C ⥤ Chad') (hC : Cn ⋙ east' = Cw ⋙ south')
-    : (lift : C ⥤ Libya') ×' lift ⋙ north' = Cn ∧ lift ⋙ west' = Cw ∧
+    (Cn : C ⥤ Egypt') (Cw : C ⥤ Chad') (hC : Cn ⋙ east' = Cw ⋙ south') :
+    (lift : C ⥤ Libya') ×' lift ⋙ north' = Cn ∧ lift ⋙ west' = Cw ∧
     ∀ {l0 l1 : C ⥤ Libya'}, l0 ⋙ north' = l1 ⋙ north' → l0 ⋙ west' = l1 ⋙ west'
     → l0 = l1 :=
   ⟨ ofIso'Lift north west east south pb east' south' lib egy cha sud heast hsouth Cn Cw hC,
     by rw [ofIso'Lift, Functor.assoc, (Iso.inv_comp_eq_comp_inv lib egy hnorth).mpr hnorth,
         ← Functor.assoc, pb.fac_left, Functor.assoc, egy.hom_inv_id, Functor.comp_id],
     by rw [ofIso'Lift, Functor.assoc, (Iso.inv_comp_eq_comp_inv lib cha hwest.symm).mpr hwest.symm,
-        ← Functor.assoc, pb.fac_right, Functor.assoc, cha.hom_inv_id, Functor.comp_id],
-    by
+        ← Functor.assoc, pb.fac_right, Functor.assoc, cha.hom_inv_id, Functor.comp_id], by
       intro l0 l1 hn hw
       have : l0 ⋙ lib.hom = l1 ⋙ lib.hom := by
         apply pb.hom_ext
@@ -593,8 +599,7 @@ def universal : (lift : C ⥤ Algeria) ×'
     l0 ⋙ west = l1 ⋙ west → l0 = l1 :=
   ⟨ lift wsah_pb esah_pb Cn Cw hC,
     by rw [lift, ← Functor.assoc, wsah_pb.fac_left, esah_pb.fac_left],
-    wsah_pb.fac_right _ _ _,
-    by
+    wsah_pb.fac_right _ _ _, by
       intro l0 l1 hnorth hwest
       apply wsah_pb.hom_ext
       · apply esah_pb.hom_ext
@@ -647,8 +652,9 @@ namespace ofRight
 variable {C : Type u} [Category.{v} C] (Cn : C ⥤ Libya) (Cw : C ⥤ Niger)
   (hC : Cn ⋙ sah = Cw ⋙ so)
 
-def hCLeft : (Cn ⋙ rth) ⋙ east = Cw ⋙ so ⋙ uth :=
-  by calc
+include esah hC in
+theorem hCLeft : (Cn ⋙ rth) ⋙ east = Cw ⋙ so ⋙ uth := by
+  calc
     (Cn ⋙ rth) ⋙ east = Cn ⋙ (sah ⋙ uth) := by rw [Functor.assoc, esah]
     _ = (Cn ⋙ sah) ⋙ uth := by rw[← Functor.assoc]
     _ = (Cw ⋙ so) ⋙ uth := by rw [hC]
@@ -705,7 +711,7 @@ end no_rth
 section north
 /-
                north
-    ⌐-------------------------¬
+    +-------------------------¬
     |                  rth    V
   Algeria        Libya ----> Egypt
     |              |          |
@@ -731,7 +737,7 @@ variable {C : Type u} [Category.{v} C] (Cn : C ⥤ Libya) (Cw : C ⥤ Niger)
   (hC : Cn ⋙ sah = Cw ⋙ so)
 
 def universal : (lift : C ⥤ Algeria) ×'
-  lift ⋙ esah_pb.lift north (west ⋙ so) outer = Cn ∧
+    lift ⋙ esah_pb.lift north (west ⋙ so) outer = Cn ∧
   lift ⋙ west = Cw ∧
   ∀ {l0 l1 : C ⥤ Algeria},
     l0 ⋙ esah_pb.lift north (west ⋙ so) outer = l1 ⋙ esah_pb.lift north (west ⋙ so) outer →
@@ -740,23 +746,32 @@ def universal : (lift : C ⥤ Algeria) ×'
   by constructor
      . apply esah_pb.hom_ext
        . calc
-          (outer_pb.lift (Cn ⋙ rth) Cw (ofRight.hCLeft esah Cn Cw hC) ⋙ esah_pb.lift north (west ⋙ so) outer) ⋙ rth =
-            outer_pb.lift (Cn ⋙ rth) Cw (ofRight.hCLeft esah Cn Cw hC) ⋙ esah_pb.lift north (west ⋙ so) outer ⋙ rth := by rw[Functor.assoc]
-          _ = outer_pb.lift (Cn ⋙ rth) Cw (ofRight.hCLeft esah Cn Cw hC) ⋙ north := by rw[esah_pb.fac_left north (west ⋙ so) outer]
-          _ = Cn ⋙ rth := by rw[outer_pb.fac_left (Cn ⋙ rth) Cw (ofRight.hCLeft esah Cn Cw hC)]
+          (outer_pb.lift (Cn ⋙ rth) Cw (ofRight.hCLeft esah Cn Cw hC) ⋙
+            esah_pb.lift north (west ⋙ so) outer) ⋙ rth =
+            outer_pb.lift (Cn ⋙ rth) Cw (ofRight.hCLeft esah Cn Cw hC) ⋙
+              esah_pb.lift north (west ⋙ so) outer ⋙ rth := by rw [Functor.assoc]
+          _ = outer_pb.lift (Cn ⋙ rth) Cw (ofRight.hCLeft esah Cn Cw hC) ⋙ north := by
+            rw [esah_pb.fac_left north (west ⋙ so) outer]
+          _ = Cn ⋙ rth := by
+            rw [outer_pb.fac_left (Cn ⋙ rth) Cw (ofRight.hCLeft esah Cn Cw hC)]
        . calc
-          (outer_pb.lift (Cn ⋙ rth) Cw (ofRight.hCLeft esah Cn Cw hC) ⋙ esah_pb.lift north (west ⋙ so) outer) ⋙ sah =
-            outer_pb.lift (Cn ⋙ rth) Cw (ofRight.hCLeft esah Cn Cw hC) ⋙ esah_pb.lift north (west ⋙ so) outer ⋙ sah := by rw[Functor.assoc]
-          _ = outer_pb.lift (Cn ⋙ rth) Cw (ofRight.hCLeft esah Cn Cw hC) ⋙ (west ⋙ so) := by rw[esah_pb.fac_right north (west ⋙ so) outer]
-          _ = Cw ⋙ so := by rw[← Functor.assoc, outer_pb.fac_right (Cn ⋙ rth) Cw (ofRight.hCLeft esah Cn Cw hC)]
-          _ = Cn ⋙ sah := by rw[hC]
+          (outer_pb.lift (Cn ⋙ rth) Cw (ofRight.hCLeft esah Cn Cw hC) ⋙
+            esah_pb.lift north (west ⋙ so) outer) ⋙ sah =
+            outer_pb.lift (Cn ⋙ rth) Cw (ofRight.hCLeft esah Cn Cw hC) ⋙
+              esah_pb.lift north (west ⋙ so) outer ⋙ sah := by rw [Functor.assoc]
+          _ = outer_pb.lift (Cn ⋙ rth) Cw (ofRight.hCLeft esah Cn Cw hC) ⋙ (west ⋙ so) := by
+            rw [esah_pb.fac_right north (west ⋙ so) outer]
+          _ = Cw ⋙ so := by
+            rw [← Functor.assoc,
+              outer_pb.fac_right (Cn ⋙ rth) Cw (ofRight.hCLeft esah Cn Cw hC)]
+          _ = Cn ⋙ sah := by rw [hC]
      . constructor
        . exact outer_pb.fac_right (Cn⋙rth) Cw (ofRight.hCLeft esah Cn Cw hC)
        . intro l0 l1 hll hlw
          apply outer_pb.hom_ext
          . calc
-            l0 ⋙ north = l0 ⋙ (esah_pb.lift north (west ⋙ so) outer ⋙ rth) :=
-              by rw [esah_pb.fac_left north (west ⋙ so) outer ]
+            l0 ⋙ north = l0 ⋙ (esah_pb.lift north (west ⋙ so) outer ⋙ rth) := by
+              rw [esah_pb.fac_left north (west ⋙ so) outer ]
             _ = (l0 ⋙ esah_pb.lift north (west ⋙ so) outer) ⋙ rth := by rw [Functor.assoc]
             _ = (l1 ⋙ esah_pb.lift north (west ⋙ so) outer) ⋙ rth := by rw [hll]
             _ = l1 ⋙ north := by rw [Functor.assoc, esah_pb.fac_left north (west ⋙ so) outer]
@@ -772,7 +787,7 @@ and the top map `north : Algberia ⥤ Egypt`.
 The left square is a pullback when the right and outer squares
 are both pullbacks.
                north
-    ⌐-------------------------¬
+    +-------------------------¬
     |                  rth    V
   Algeria        Libya ----> Egypt
     |              |          |
@@ -783,16 +798,15 @@ are both pullbacks.
            so           uth
 -/
 def ofRight' {north : Algeria ⥤ Egypt} {rth : Libya ⥤ Egypt}
-  {west : Algeria ⥤ Niger} {sah : Libya ⥤ Chad} {east : Egypt ⥤ Sudan}
+    {west : Algeria ⥤ Niger} {sah : Libya ⥤ Chad} {east : Egypt ⥤ Sudan}
   {so : Niger ⥤ Chad} {uth : Chad ⥤ Sudan}
   (outer : north ⋙ east = west ⋙ so ⋙ uth)
   (outer_pb : IsPullback north west east (so ⋙ uth))
   (esah : rth ⋙ east = sah ⋙ uth)
   (esah_pb : IsPullback rth sah east uth)
   (no : Algeria ⥤ Libya := esah_pb.lift north (west ⋙ so) outer)
-  (no_eq : no = esah_pb.lift north (west ⋙ so) outer)
-  :
-  IsPullback no west sah so :=
+  (no_eq : no = esah_pb.lift north (west ⋙ so) outer) :
+      IsPullback no west sah so :=
   no_eq ▸
   IsPullback.ofUniversal (esah_pb.lift north (west ⋙ so) outer) west sah so
   (esah_pb.fac_right _ _ _)
@@ -829,8 +843,7 @@ def ofHorizIso.universal {C : Type*} [Category C] (Cn : C ⥤ Egypt) (Cw : C ⥤
     _ = (Cw ⋙ south.hom) ⋙ south.inv := by
       rw [← hC, Functor.assoc, ofHorizIso.inv_comm_sq _ _ _ _ comm_sq, lift, Functor.assoc]
     _ = Cw := by
-      simp [Functor.assoc, Functor.comp_id],
-    by
+      simp [Functor.assoc, Functor.comp_id], by
       intro _ _ h0 _
       simpa [Functor.Iso.cancel_iso_hom_right] using h0 ⟩
 
@@ -848,7 +861,7 @@ end CategoryTheory
 
 namespace CategoryTheory.Cat
 
-open Functor Limits
+open _root_.CategoryTheory.Functor Limits
 
 section
 variable {Libya Egypt Chad Sudan : Type u} [Category.{v} Libya]
@@ -859,25 +872,28 @@ variable {Libya Egypt Chad Sudan : Type u} [Category.{v} Libya]
   (h : Functor.IsPullback north west east south)
   (s : Limits.PullbackCone (homOf east) (homOf south))
 
-def lift : s.pt ⟶ of Libya := h.lift s.fst s.snd s.condition
+def lift : s.pt ⟶ of Libya :=
+  homOf (h.lift s.fst.toFunctor s.snd.toFunctor (congrArg Cat.Hom.toFunctor s.condition))
 
-def fac_left : lift h s ≫ (homOf north) = s.fst :=
-  h.fac_left _ _ _
+theorem fac_left : lift h s ≫ (homOf north) = s.fst :=
+  Cat.Hom.ext (h.fac_left _ _ _)
 
-def fac_right : lift h s ≫ (homOf west) = s.snd :=
-  h.fac_right _ _ _
+theorem fac_right : lift h s ≫ (homOf west) = s.snd :=
+  Cat.Hom.ext (h.fac_right _ _ _)
 
-def uniq (m : s.pt ⟶ of Libya) (hl : m ≫ homOf north = s.fst)
+theorem uniq (m : s.pt ⟶ of Libya) (hl : m ≫ homOf north = s.fst)
     (hr : m ≫ homOf west = s.snd) : m = lift h s := by
+  apply Cat.Hom.ext
   apply h.hom_ext
-  · convert (fac_left h s).symm
-  · convert (fac_right h s).symm
+  · exact (congrArg Cat.Hom.toFunctor hl).trans (congrArg Cat.Hom.toFunctor (fac_left h s)).symm
+  · exact (congrArg Cat.Hom.toFunctor hr).trans (congrArg Cat.Hom.toFunctor (fac_right h s)).symm
 
 variable (comm_sq) in
-def isPullback : IsPullback (homOf north) (homOf west) (homOf east)
+include comm_sq h in
+theorem isPullback : IsPullback (homOf north) (homOf west) (homOf east)
     (homOf south) :=
   IsPullback.of_isLimit (PullbackCone.IsLimit.mk
-    comm_sq (lift h) (fac_left _) (fac_right _) (uniq _))
+    (Cat.Hom.ext comm_sq) (lift h) (fac_left _) (fac_right _) (uniq _))
 
 noncomputable def functorIsPullback
     (h : IsPullback (homOf north) (homOf west) (homOf east) (homOf south)) :
@@ -887,20 +903,20 @@ noncomputable def functorIsPullback
     (homOf south) :=
     isPullback Functor.IsPullback.Chosen.comm_sq (Functor.IsPullback.Chosen.isPullback east south)
   let i := IsPullback.isoIsPullback _ _ h hChosen
-  convert Functor.IsPullback.ofIsoChosen east south i.hom i.inv ?_ ?_
-  · symm
-    exact IsPullback.isoIsPullback_hom_fst _ _ h hChosen
-  · symm
-    exact IsPullback.isoIsPullback_hom_snd _ _ h hChosen
-  · exact i.hom_inv_id
-  · exact i.inv_hom_id
+  have hn : i.hom.toFunctor ⋙ IsPullback.Chosen.north = north :=
+    congrArg Cat.Hom.toFunctor (IsPullback.isoIsPullback_hom_fst _ _ h hChosen)
+  have hw : i.hom.toFunctor ⋙ IsPullback.Chosen.west = west :=
+    congrArg Cat.Hom.toFunctor (IsPullback.isoIsPullback_hom_snd _ _ h hChosen)
+  rw [← hn, ← hw]
+  exact Functor.IsPullback.ofIsoChosen east south i.hom.toFunctor i.inv.toFunctor
+    (congrArg Cat.Hom.toFunctor i.hom_inv_id) (congrArg Cat.Hom.toFunctor i.inv_hom_id)
 
 end
 end Cat
 
 namespace Grpd
 
-open Functor Limits
+open _root_.CategoryTheory.Functor Limits
 
 variable {Libya Egypt Chad Sudan : Type u} [Groupoid.{v} Libya]
   [Groupoid.{v} Egypt] [Groupoid.{v} Chad] [Groupoid.{v} Sudan]
@@ -911,19 +927,20 @@ variable {Libya Egypt Chad Sudan : Type u} [Groupoid.{v} Libya]
 
 def lift : s.pt ⟶ of Libya := h.lift s.fst s.snd s.condition
 
-def fac_left : lift h s ≫ (homOf north) = s.fst :=
+theorem fac_left : lift h s ≫ (homOf north) = s.fst :=
   h.fac_left _ _ _
 
-def fac_right : lift h s ≫ (homOf west) = s.snd :=
+theorem fac_right : lift h s ≫ (homOf west) = s.snd :=
   h.fac_right _ _ _
 
-def uniq (m : s.pt ⟶ of Libya) (hl : m ≫ homOf north = s.fst)
+theorem uniq (m : s.pt ⟶ of Libya) (hl : m ≫ homOf north = s.fst)
     (hr : m ≫ homOf west = s.snd) : m = lift h s := by
   apply h.hom_ext
-  · convert (fac_left h s).symm
-  · convert (fac_right h s).symm
+  · exact hl.trans (fac_left h s).symm
+  · exact hr.trans (fac_right h s).symm
 
-def isPullback : IsPullback (homOf north) (homOf west) (homOf east) (homOf south) :=
+include h in
+theorem isPullback : IsPullback (homOf north) (homOf west) (homOf east) (homOf south) :=
   IsPullback.of_isLimit (PullbackCone.IsLimit.mk
     h.comm_sq (lift h) (fac_left _) (fac_right _) (uniq _))
 
diff --git a/HoTTLean/ForMathlib/CategoryTheory/Groupoid.lean b/HoTTLean/ForMathlib/CategoryTheory/Groupoid.lean
index 0f73aff6..b065a7d4 100644
--- a/HoTTLean/ForMathlib/CategoryTheory/Groupoid.lean
+++ b/HoTTLean/ForMathlib/CategoryTheory/Groupoid.lean
@@ -3,15 +3,10 @@ import Mathlib.CategoryTheory.MorphismProperty.Basic
 
 namespace CategoryTheory
 
+-- Mathlib now provides this theorem. Check the original interface here.
 open MorphismProperty in
-lemma isGroupoid_iff_isomorphisms_eq_top (C : Type*) [Category C] :
-    IsGroupoid C ↔ isomorphisms C = ⊤ := by
-  constructor
-  · rw [eq_top_iff]
-    intro _ _
-    simp only [isomorphisms.iff, top_apply]
-    infer_instance
-  · intro h
-    exact ⟨of_eq_top h⟩
+example (C : Type*) [Category C] :
+    IsGroupoid C ↔ isomorphisms C = ⊤ :=
+  isGroupoid_iff_isomorphisms_eq_top C
 
 end CategoryTheory
diff --git a/HoTTLean/ForMathlib/CategoryTheory/Grpd.lean b/HoTTLean/ForMathlib/CategoryTheory/Grpd.lean
index 5d3d85cc..e08b7c76 100644
--- a/HoTTLean/ForMathlib/CategoryTheory/Grpd.lean
+++ b/HoTTLean/ForMathlib/CategoryTheory/Grpd.lean
@@ -40,7 +40,7 @@ instance : CartesianMonoidalCategory Grpd :=
       isLimit := isLimitProdCone X Y })
 
 theorem eqToHom_obj
-  {C1 C2 : Grpd.{v,u}} (x : C1) (eq : C1 = C2) :
+    {C1 C2 : Grpd.{v,u}} (x : C1) (eq : C1 = C2) :
     (eqToHom eq).obj x = cast (congrArg Bundled.α eq) x := by
   cases eq
   simp [id_eq_id]
@@ -80,8 +80,7 @@ variable {Γ : Type u₂} [Category.{v₂} Γ] {A : Γ ⥤ Grpd.{v₁,u₁}}
 theorem map_comp_map'
     {x y z : Γ} {f : x ⟶ y} {g : y ⟶ z} {a b : A.obj x} {φ : a ⟶ b} :
     (A.map g).map ((A.map f).map φ)
-    = eqToHom Grpd.map_comp_obj.symm ≫ (A.map (f ≫ g)).map φ ≫ eqToHom Grpd.map_comp_obj
-    := by
+    = eqToHom Grpd.map_comp_obj.symm ≫ (A.map (f ≫ g)).map φ ≫ eqToHom Grpd.map_comp_obj := by
   simp [Grpd.map_comp_map]
 end
 
@@ -110,7 +109,8 @@ theorem eqToHom_hom_aux {C1 C2 : Grpd.{v,u}} (x y: C1) (eq : C1 = C2) :
 theorem eqToHom_hom {C1 C2 : Grpd.{v,u}} {x y: C1} (f : x ⟶ y) (eq : C1 = C2) :
     (eqToHom eq).map f = (cast (Grpd.eqToHom_hom_aux x y eq) f) := by
   cases eq
-  simp only [eqToHom_refl, id_eq_id, Functor.id_map, cast_eq]
+  simp only [eqToHom_refl, id_eq_id, Functor.id_map]
+  rfl
 
 @[simp] theorem map_eqToHom_map {x y : Γ} (h : x = y) {t s} (f : t ⟶ s) :
     (F.map (eqToHom h)).map f =
@@ -150,12 +150,12 @@ def Grpd.Functor.iso (A : Γ ⥤ Grpd) {x y : Γ} (f : x ⟶ y) : A.obj x ≅≅
 
 -- Note: this should not be a simp lemma, because we want simp to
 -- see the Functor.Iso structure
-def Grpd.Functor.iso_hom (A : Γ ⥤ Grpd) {x y : Γ} (f : x ⟶ y) :
+theorem Grpd.Functor.iso_hom (A : Γ ⥤ Grpd) {x y : Γ} (f : x ⟶ y) :
     (iso A f).hom = A.map f := rfl
 
 -- Note: this should not be a simp lemma, because we want simp to
 -- see the Functor.Iso structure
-def Grpd.Functor.iso_inv (A : Γ ⥤ Grpd) {x y : Γ} (f : x ⟶ y) :
+theorem Grpd.Functor.iso_inv (A : Γ ⥤ Grpd) {x y : Γ} (f : x ⟶ y) :
     (iso A f).inv = A.map (inv f) := rfl
 
 @[simp]
@@ -191,8 +191,8 @@ lemma Grpd.whiskerLeft_hcongr_right {C D : Type*} [Category C] [Category D]
 
 lemma Grpd.comp_hcongr {C C' D D' E E' : Grpd.{v,u}} (hC : C ≍ C') (hD : D ≍ D')
     (hE : E ≍ E') {F : C ⥤ D} {F' : C' ⥤ D'} {G : D ⥤ E} {G' : D' ⥤ E'}
-    (hF : F ≍ F') (hG : G ≍ G')
-    : F ⋙ G ≍ F' ⋙ G' := by
+    (hF : F ≍ F') (hG : G ≍ G') :
+    F ⋙ G ≍ F' ⋙ G' := by
   subst hC hD hE hF hG
   rfl
 
@@ -228,8 +228,8 @@ attribute [simp] comp_eq_comp id_eq_id in
 def mkIso {Δ Γ : Grpd} (F : Δ ≅≅ Γ) : Δ ≅ Γ where
   hom := F.hom
   inv := F.inv
-  hom_inv_id := by simp
-  inv_hom_id := by simp
+  hom_inv_id := F.hom_inv_id
+  inv_hom_id := F.inv_hom_id
 
 attribute [simp] comp_eq_comp id_eq_id in
 @[simps]
@@ -237,8 +237,8 @@ def mkIso' {Δ Γ : Type u} [Groupoid.{v} Δ] [Groupoid.{v} Γ] (F : Δ ≅≅ 
     Grpd.of Δ ≅ Grpd.of Γ where
   hom := F.hom
   inv := F.inv
-  hom_inv_id := by simp
-  inv_hom_id := by simp
+  hom_inv_id := F.hom_inv_id
+  inv_hom_id := F.inv_hom_id
 
 open MonoidalCategory
 
diff --git a/HoTTLean/ForMathlib/CategoryTheory/Localization/Predicate.lean b/HoTTLean/ForMathlib/CategoryTheory/Localization/Predicate.lean
index 70dc3771..833ac61f 100644
--- a/HoTTLean/ForMathlib/CategoryTheory/Localization/Predicate.lean
+++ b/HoTTLean/ForMathlib/CategoryTheory/Localization/Predicate.lean
@@ -6,7 +6,7 @@ import HoTTLean.ForMathlib.CategoryTheory.MorphismProperty.Basic
 noncomputable section
 
 namespace CategoryTheory.Localization
-open Category Functor
+open Category CategoryTheory.Functor
 
 variable {C D : Type*} [Category C] [Category D] (L : C ⥤ D) (W : MorphismProperty C) (E : Type*)
   [Category E]
@@ -14,43 +14,20 @@ variable {C D : Type*} [Category C] [Category D] (L : C ⥤ D) (W : MorphismProp
 variable {D₁ D₂ : Type _} [Category D₁] [Category D₂] (L₁ : C ⥤ D₁) (L₂ : C ⥤ D₂)
   (W' : MorphismProperty C) [L₁.IsLocalization W'] [L₂.IsLocalization W']
 
-lemma morphismProperty_eq_top [L.IsLocalization W] (P : MorphismProperty D) [P.RespectsIso]
+-- Mathlib now supplies these declarations. Check the original interfaces here.
+example [L.IsLocalization W] (P : MorphismProperty D) [P.RespectsIso]
     [P.IsMultiplicative] (h₁ : ∀ ⦃X Y : C⦄ (f : X ⟶ Y), P (L.map f))
     (h₂ : ∀ ⦃X Y : C⦄ (f : X ⟶ Y) (hf : W f), P (isoOfHom L W f hf).inv) :
-    P = ⊤ := by
-  let P' : MorphismProperty W.Localization :=
-    P.inverseImage (Construction.lift L Functor.IsLocalization.inverts)
-  have hP' : P' = ⊤ := by
-    apply Construction.morphismProperty_is_top
-    · intros
-      simp only [MorphismProperty.inverseImage_iff, Construction.lift_obj, ← Functor.comp_map,
-        Functor.congr_hom (Construction.fac L Functor.IsLocalization.inverts), Functor.comp_obj,
-        eqToHom_refl, Category.comp_id, Category.id_comp, h₁, P']
-    · intro X Y w hw
-      simp only [P', MorphismProperty.inverseImage_iff]
-      convert h₂ w hw
-      convert Functor.map_inv (Construction.lift L Functor.IsLocalization.inverts)
-        (Construction.wIso w hw).hom
-      · simp
-      · have : (Construction.wIso w hw).hom = W.Q.map w := rfl
-        simp only [this, ← Functor.comp_map,
-          Functor.congr_hom (Construction.fac L Functor.IsLocalization.inverts)]
-        simp [isoOfHom]
-  have : P'.map _ = P := MorphismProperty.map_inverseImage_eq_of_isEquivalence ..
-  simp [← this, hP']
-
-lemma isGroupoid [L.IsLocalization ⊤] :
-    IsGroupoid D := by
-  rw [isGroupoid_iff_isomorphisms_eq_top]
-  exact morphismProperty_eq_top L ⊤ _
-    (fun _ _ f ↦ inverts L ⊤ _ (by simp))
-    (fun _ _ f hf ↦ Iso.isIso_inv _)
-
-instance : IsGroupoid (⊤ : MorphismProperty C).Localization :=
-  isGroupoid <| MorphismProperty.Q ⊤
-
-/-- Localization of a category with respect to all morphisms results in a groupoid. -/
-def groupoid : Groupoid (⊤ : MorphismProperty C).Localization :=
-  Groupoid.ofIsGroupoid
+    P = ⊤ :=
+  morphismProperty_eq_top L W P h₁ h₂
+
+example [L.IsLocalization ⊤] : IsGroupoid D :=
+  isGroupoid L
+
+example : IsGroupoid (⊤ : MorphismProperty C).Localization :=
+  inferInstance
+
+example : Groupoid (⊤ : MorphismProperty C).Localization :=
+  groupoid
 
 end CategoryTheory.Localization
diff --git a/HoTTLean/ForMathlib/CategoryTheory/MorphismProperty/Basic.lean b/HoTTLean/ForMathlib/CategoryTheory/MorphismProperty/Basic.lean
index 8773745c..2682efe6 100644
--- a/HoTTLean/ForMathlib/CategoryTheory/MorphismProperty/Basic.lean
+++ b/HoTTLean/ForMathlib/CategoryTheory/MorphismProperty/Basic.lean
@@ -6,14 +6,9 @@ namespace CategoryTheory.MorphismProperty
 
 variable {C : Type u} [Category.{v} C] {D : Type*} [Category D]
 
-@[simp]
-lemma map_top_eq_top_of_essSurj_of_full (F : C ⥤ D) [F.EssSurj] [F.Full] :
+-- Mathlib now supplies the original public theorem. Keep this statement as a check.
+lemma map_top_eq_top_of_essSurj_of_full_compat (F : C ⥤ D) [F.EssSurj] [F.Full] :
     (⊤ : MorphismProperty C).map F = ⊤ := by
-  rw [eq_top_iff]
-  intro X Y f _
-  refine ⟨F.objPreimage X, F.objPreimage Y, F.preimage ?_, ⟨⟨⟩, ⟨?_⟩⟩⟩
-  · exact (Functor.objObjPreimageIso F X).hom ≫ f ≫ (Functor.objObjPreimageIso F Y).inv
-  · exact Arrow.isoMk' _ _ (Functor.objObjPreimageIso F X) (Functor.objObjPreimageIso F Y)
-      (by simp)
+  exact map_top_eq_top_of_essSurj_of_full F
 
 end CategoryTheory.MorphismProperty
diff --git a/HoTTLean/ForMathlib/CategoryTheory/MorphismProperty/WideSubcategory.lean b/HoTTLean/ForMathlib/CategoryTheory/MorphismProperty/WideSubcategory.lean
index d9792de1..256318be 100644
--- a/HoTTLean/ForMathlib/CategoryTheory/MorphismProperty/WideSubcategory.lean
+++ b/HoTTLean/ForMathlib/CategoryTheory/MorphismProperty/WideSubcategory.lean
@@ -135,7 +135,7 @@ lemma WideSubcategory.hext {X X' : P.WideSubcategory} (hX : X.1 ≍ X'.1) : X 
 lemma WideSubcategory.hom_hext {X X' Y Y' : P.WideSubcategory} (hX : X.1 ≍ X'.1)
     (hY : Y.1 ≍ Y'.1) (f : X ⟶ Y) (f' : X' ⟶ Y') (hf : f.1 ≍ f'.1) : f ≍ f' := by
   cases X; cases X'; cases Y; cases Y'; subst hX hY
-  simp only [Set.mem_setOf_eq, heq_eq_eq] at *
+  simp only [Set.mem_ofPred_eq, heq_eq_eq] at *
   apply hom_ext
   assumption
 
diff --git a/HoTTLean/ForMathlib/CategoryTheory/NatTrans.lean b/HoTTLean/ForMathlib/CategoryTheory/NatTrans.lean
index aee6e9a4..6769e3f2 100644
--- a/HoTTLean/ForMathlib/CategoryTheory/NatTrans.lean
+++ b/HoTTLean/ForMathlib/CategoryTheory/NatTrans.lean
@@ -1,6 +1,6 @@
 import Mathlib.CategoryTheory.NatTrans
 import Mathlib.CategoryTheory.Functor.TwoSquare
-import Mathlib.CategoryTheory.Limits.Shapes.Pullback.CommSq
+import Mathlib.CategoryTheory.Limits.Shapes.Pullback.IsPullback.Basic
 import HoTTLean.ForMathlib
 
 universe w v u v₁ u₁ v₂ u₂ v₃ u₃
@@ -29,7 +29,7 @@ def inv : G ⟶ F := h.isoOfCodGroupoid.inv
 
 end
 
-open Functor
+open _root_.CategoryTheory.Functor
 
 lemma hext {A : Type u} [Category.{v} A] {B : Type u₁} [Category.{v₁} B]
     {F F' G G' : A ⥤ B} (α : F ⟶ G) (β : F' ⟶ G')
diff --git a/HoTTLean/ForMathlib/CategoryTheory/RepPullbackCone.lean b/HoTTLean/ForMathlib/CategoryTheory/RepPullbackCone.lean
index acffbd24..ede76784 100644
--- a/HoTTLean/ForMathlib/CategoryTheory/RepPullbackCone.lean
+++ b/HoTTLean/ForMathlib/CategoryTheory/RepPullbackCone.lean
@@ -1,7 +1,7 @@
 import Mathlib.CategoryTheory.Limits.Yoneda
 import Mathlib.CategoryTheory.Functor.KanExtension.Adjunction
 import Mathlib.CategoryTheory.Limits.Preserves.Finite
-import Mathlib.CategoryTheory.Limits.Shapes.Pullback.CommSq
+import Mathlib.CategoryTheory.Limits.Shapes.Pullback.IsPullback.Basic
 import HoTTLean.ForMathlib.CategoryTheory.WeakPullback
 
 /-!
@@ -20,7 +20,7 @@ variable {J : Type u₁} [Category.{v₁} J] {K : Type u₂} [Category.{v₂} K]
 variable {C : Type u₃} [Category.{v₃} C]
 
 open CategoryTheory
-open Functor
+open _root_.CategoryTheory.Functor
 
 /-- A `c : RepCone F` is:
 * an object `c.pt` and
@@ -78,19 +78,17 @@ def lift' (c : C) (x' : yoneda.obj c ⟶ s.pt) : yoneda.obj c ⟶ t.pt :=
   rfl
 
 def lift''_app (s : Cone F) (c : C) :
-    s.pt.obj (Opposite.op c) → t.pt.obj (Opposite.op c) :=
-  yonedaEquiv ∘ lift' P c ∘ yonedaEquiv.symm
+    s.pt.obj (Opposite.op c) ⟶ t.pt.obj (Opposite.op c) :=
+  TypeCat.ofHom (yonedaEquiv ∘ lift' P c ∘ yonedaEquiv.symm)
 
 theorem lift''_app_naturality {c d : C} (f : c ⟶ d) :
     s.pt.map (f.op) ≫ lift''_app P s c
       = lift''_app P s d ≫ t.pt.map (Opposite.op f) := by
   ext x
-  simp[lift''_app, lift']
-  rw[yonedaEquiv_naturality']
-  have h := lift'_naturality P f (yonedaEquiv.symm x)
-  simp[lift'] at h
-  simp
-  rw[← h, yonedaEquiv_symm_naturality_left]
+  change yonedaEquiv (lift' P c (yonedaEquiv.symm (s.pt.map f.op x))) =
+    t.pt.map f.op (yonedaEquiv (lift' P d (yonedaEquiv.symm x)))
+  rw [yonedaEquiv_naturality, ← lift'_naturality,
+    yonedaEquiv_symm_naturality_left]
 
 variable (s)
 
@@ -104,9 +102,9 @@ def lift'' : s.pt ⟶ t.pt := {
 theorem fac_ext (j : J) (c : C) (x) :
     (lift'' P s ≫ t.π.app j).app (Opposite.op c) x
     = (s.π.app j).app (Opposite.op c) x := by
-  dsimp [lift'',lift', lift''_app, ← yonedaEquiv_comp]
-  rw [P.fac (repConeOfConeMap s c (yonedaEquiv.symm x)) j]
-  simp [repConeOfConeMap, yonedaEquiv_comp, Equiv.apply_symm_apply yonedaEquiv x]
+  have h := congrArg (fun α : yoneda.obj c ⟶ (F.obj j) => yonedaEquiv α)
+    (P.fac (repConeOfConeMap s c (yonedaEquiv.symm x)) j)
+  simpa [yonedaEquiv_comp, repConeOfConeMap, lift'', lift''_app, lift'] using h
 
 theorem uniq_ext (m : s.pt ⟶ t.pt)
     (hm : ∀ (j : J), m ≫ t.π.app j = s.π.app j) (c : C) (x) :
@@ -116,7 +114,9 @@ theorem uniq_ext (m : s.pt ⟶ t.pt)
   have hj : (∀ (j : J), (x' ≫ m) ≫ t.π.app j = x' ≫ s.π.app j) := by simp[hm]
   have h := P.uniq (repConeOfConeMap s c x') (x' ≫ m) hj
   dsimp [lift'', lift''_app, lift']
-  rw [← h, yonedaEquiv_comp, Equiv.apply_symm_apply yonedaEquiv x]
+  rw [← h]
+  change m.app (Opposite.op c) x = yonedaEquiv (x' ≫ m)
+  simp [yonedaEquiv_comp, x']
 
 def IsLimit {t : Cone F} (P : RepIsLimit t) : IsLimit t where
   lift := lift'' P
@@ -170,7 +170,8 @@ lemma snd_mk (W : C) (fst : yoneda.obj W ⟶ X) (snd : yoneda.obj W ⟶ Y)
 theorem condition : t.fst ≫ f = t.snd ≫ g :=
   t.pullbackCone.condition
 
-open WalkingSpan.Hom WalkingCospan.Hom WidePullbackShape.Hom WidePushoutShape.Hom Limits.PullbackCone
+open WalkingSpan.Hom WalkingCospan.Hom
+open WidePullbackShape.Hom WidePushoutShape.Hom Limits.PullbackCone
 
 def repIsLimitAux (t : PullbackCone f g) (lift : ∀ s : RepPullbackCone f g, yoneda.obj s.pt ⟶ t.pt)
     (fac_left : ∀ s : RepPullbackCone f g, lift s ≫ t.fst = s.fst)
@@ -185,8 +186,9 @@ def repIsLimitAux (t : PullbackCone f g) (lift : ∀ s : RepPullbackCone f g, yo
       fun j' => WalkingPair.casesOn j' (fac_left s) (fac_right s)
     uniq := uniq }
 
-/-- To show that a `PullbackCone` in a presheaf category constructed using `PullbackCone.mk` is a limit cone,
-  it suffices to show its universal property among representable cones.
+/-- To show that a `PullbackCone` in a presheaf category constructed using
+`PullbackCone.mk` is a limit cone, it suffices to show its universal property
+among representable cones.
 -/
 def RepIsLimit.mk {fst : W ⟶ X} {snd : W ⟶ Y} (eq : fst ≫ f = snd ≫ g)
     (lift : ∀ s : RepPullbackCone f g, yoneda.obj s.pt ⟶ W)
@@ -229,23 +231,27 @@ open Opposite
 
 def repPullbackCone (c : C) (x : G.obj (op c)) : RepPullbackCone f g :=
   .mk c (yonedaEquiv.symm $ a.app (op c) x) (yonedaEquiv.symm $ b.app (op c) x) (by
-    simpa [yonedaEquiv_symm_naturality_right] using congr_fun (NatTrans.congr_app hab (op c)) x)
+    simpa [yonedaEquiv_symm_naturality_right] using
+      ConcreteCategory.congr_hom (NatTrans.congr_app hab (op c)) x)
 
 def lift'.app (c : C) : G.obj (op c) ⟶ W.obj (op c) :=
-  fun x => yonedaEquiv (lift (repPullbackCone a b hab c x))
+  TypeCat.ofHom fun x => yonedaEquiv (lift (repPullbackCone a b hab c x))
 
 include lift_naturality in
 lemma lift'.naturality ⦃c d : C⦄ (σ : c ⟶ d) : G.map σ.op ≫ lift'.app lift a b hab c =
     lift'.app lift a b hab d ≫ W.map σ.op := by
   ext x
-  dsimp only [types_comp_apply, app]
-  rw [yonedaEquiv_naturality, lift_naturality (repPullbackCone a b hab d x) σ]
+  change yonedaEquiv (lift (repPullbackCone a b hab c (G.map σ.op x))) =
+    W.map σ.op (yonedaEquiv (lift (repPullbackCone a b hab d x)))
+  change yonedaEquiv (lift (repPullbackCone a b hab c (G.map σ.op x))) =
+    W.map σ.op (yonedaEquiv (show yoneda.obj d ⟶ W from lift (repPullbackCone a b hab d x)))
+  erw [yonedaEquiv_naturality, lift_naturality (repPullbackCone a b hab d x) σ]
   dsimp only [repPullbackCone, π_app_left, fst_mk, π_app_right, snd_mk]
   congr 3
-  · rw [yonedaEquiv_symm_naturality_left σ]
-    simpa using congr_fun (a.naturality σ.op) x
-  · rw [yonedaEquiv_symm_naturality_left σ]
-    simpa using congr_fun (b.naturality σ.op) x
+  · erw [yonedaEquiv_symm_naturality_left σ]
+    simp
+  · erw [yonedaEquiv_symm_naturality_left σ]
+    simp
 
 include lift_naturality in
 def lift' : G ⟶ W where
diff --git a/HoTTLean/ForMathlib/CategoryTheory/WeakPullback.lean b/HoTTLean/ForMathlib/CategoryTheory/WeakPullback.lean
index 90acf3dd..a723a316 100644
--- a/HoTTLean/ForMathlib/CategoryTheory/WeakPullback.lean
+++ b/HoTTLean/ForMathlib/CategoryTheory/WeakPullback.lean
@@ -33,17 +33,19 @@ def coherentLift [HasPullbacks C] : W ⟶ P :=
 
 @[simp]
 lemma coherentLift_fst [HasPullbacks C] : wp.coherentLift a b h ≫ fst = a := by
-  simp [coherentLift]
+  simp only [coherentLift, Category.assoc, wp.lift_fst, pullback.lift_fst]
 
 @[simp]
 lemma coherentLift_snd [HasPullbacks C] : wp.coherentLift a b h ≫ snd = b := by
-  simp [coherentLift]
+  simp only [coherentLift, Category.assoc, wp.lift_snd, pullback.lift_snd]
 
 lemma coherentLift_comp_left [HasPullbacks C] {W'} (σ : W' ⟶ W) :
     σ ≫ wp.coherentLift a b h =
     wp.coherentLift (σ ≫ a) (σ ≫ b) (by simp [h]) := by
   simp only [coherentLift, ← Category.assoc]
-  congr 1; ext <;> simp
+  congr 1
+  apply pullback.hom_ext <;>
+    simp only [Category.assoc, pullback.lift_fst, pullback.lift_snd]
 
 end WeakPullback
 end CategoryTheory
diff --git a/HoTTLean/ForMathlib/Tactic/CategoryTheory/FunctorMap.lean b/HoTTLean/ForMathlib/Tactic/CategoryTheory/FunctorMap.lean
index d03c7c5b..f0fe66fe 100644
--- a/HoTTLean/ForMathlib/Tactic/CategoryTheory/FunctorMap.lean
+++ b/HoTTLean/ForMathlib/Tactic/CategoryTheory/FunctorMap.lean
@@ -56,24 +56,25 @@ def functorMapExpr (e : Expr) (lvl_params : Bool) : MetaM (Expr × List Level) :
     let some (hom, _, _) := eTp.eq? | throwError "expected an equality, got{indentD eTp}"
     if !hom.isAppOf ``Quiver.Hom then
       throwError "expected an equality of morphisms, got{indentD eTp}"
-    let [.succ v₁, u₁] := hom.getAppFn.constLevels! |
+    -- Quiver.Hom uses the hom universe directly, not its successor.
+    let [v₁, u₁] := hom.getAppFn.constLevels! |
       throwError "unexpected universe levels in{indentD hom.getAppFn}"
     let e' ← mkAppM' (.const ``eq_functor_map [v₁, u₁, v₂, u₂]) #[e]
     simpType categorySimp' e'
   return (e, [v₂, u₂])
 
-syntax (name := functor_map) "functor_map" (" (" &"attr" ":=" Parser.Term.attrInstance,* ")")? : attr
+syntax (name := functor_map) "functor_map" optAttrArg : attr
 
 initialize registerBuiltinAttribute {
   name := `functor_map
   descr := ""
   applicationTime := .afterCompilation
   add := fun src ref kind => match ref with
-  | `(attr| functor_map $[(attr := $stx?,*)]?) => MetaM.run' do
+  | `(attr| functor_map $optAttr) => MetaM.run' do
     if (kind != AttributeKind.global) then
       throwError "`functor_map` can only be used as a global attribute"
-    addRelatedDecl src "_functor_map" ref stx? fun type value levels => do
-      let (e, levels') ← functorMapExpr (← mkExpectedTypeHint value type) true
+    addRelatedDecl src (src.appendAfter "_functor_map") ref optAttr fun value levels => do
+      let (e, levels') ← functorMapExpr value true
       pure (e, levels ++ levels'.map fun | .param n => n | _ => panic! "")
   | _ => throwUnsupportedSyntax }
 
diff --git a/HoTTLean/ForPoly.lean b/HoTTLean/ForPoly.lean
index b9a44a91..b511eef5 100644
--- a/HoTTLean/ForPoly.lean
+++ b/HoTTLean/ForPoly.lean
@@ -11,6 +11,9 @@ open Limits PartialProduct
 universe v u
 variable {C : Type u} [Category.{v} C] [HasPullbacks C]
 
+-- These local settings let simp reduce the slice functor types in the mate construction.
+set_option backward.defeqAttrib.useBackward true in
+set_option backward.isDefEq.respectTransparency false in
 theorem η_naturality {E B E' B' : C} {P : UvPoly E B} {P' : UvPoly E' B'}
     (e : E ⟶ E') (b : B ⟶ B') (hp : IsPullback P.p e b P'.p) :
     Functor.whiskerLeft (Over.pullback P.p) (Over.mapPullbackAdj e).unit ≫
@@ -20,8 +23,9 @@ theorem η_naturality {E B E' B' : C} {P : UvPoly E B} {P' : UvPoly E' B'}
         |>.trans (Over.pullbackComp e P'.p)).inv =
     Functor.whiskerRight (Over.mapPullbackAdj b).unit (Over.pullback P.p) := by
   ext X
-  simp [pullbackMapIsoSquare, ← pullback_map_eq_eqToHom rfl hp.w.symm, Over.pullbackComp]
-  ext <;> simp [pullback.condition]
+  simp [pullbackMapIsoSquare, asIso, ← pullback_map_eq_eqToHom rfl hp.w.symm,
+    Over.pullbackComp, Over.pullback, Over.map]
+  ext <;> simp [Category.assoc, pullback.map, pullback.condition]
 
 theorem η_naturality' {E B E' B' : C} {P : UvPoly E B} {P' : UvPoly E' B'}
     (e : E ⟶ E') (b : B ⟶ B')
@@ -40,22 +44,7 @@ theorem η_naturality' {E B E' B' : C} {P : UvPoly E B} {P' : UvPoly E' B'}
     Functor.whiskerRight α.hom ebk ≫
     Functor.whiskerLeft bmap bb.inv =
     Functor.whiskerRight (Over.mapPullbackAdj b).unit pbk := by
-  intro bmap emap pbk ebk bbk p'bk α bb
-  ext X
-  simp[bb,α,pullbackMapIsoSquare,pbk,bmap,ebk,emap,bbk,Category.assoc]
-  ext
-  · simp[← Category.assoc,← pullback_map_eq_eqToHom rfl hp.w.symm]
-    simp[Over.pullbackComp]
-    slice_lhs 2 3 => apply pullback.lift_fst
-    simp[← Category.assoc]
-  · rw[← pullback_map_eq_eqToHom rfl hp.w.symm]
-    simp[Over.pullbackComp]
-    slice_lhs 2 3 => apply pullback.lift_snd
-    simp[← Category.assoc,pullback.condition]
-  rw[← Category.assoc,← pullback_map_eq_eqToHom rfl hp.w.symm]
-  simp[Over.pullbackComp,pullback.map]
-  slice_lhs 2 3 => apply pullback.lift_snd
-  simp
+  exact η_naturality e b hp
 
 
 open ExponentiableMorphism in
@@ -69,9 +58,9 @@ theorem pushforwardPullbackIsoSquare_eq {C} [Category C] [HasPullbacks C] {X Y Z
       ((adj f).comp (Over.mapPullbackAdj h))
       (asIso (Over.pullbackMapTwoSquare h f g k pb.toCommSq)) := by
   simp [pushforwardPullbackIsoSquare, Over.pushforwardPullbackTwoSquare]
-  ext1; simp
+  ext1; rfl
 
-open ExponentiableMorphism Functor in
+open ExponentiableMorphism CategoryTheory.Functor in
 theorem ev_naturality {E B E' B' : C} {P : UvPoly E B} {P' : UvPoly E' B'}
     (e : E ⟶ E') (b : B ⟶ B')
     (hp : IsPullback P.p e b P'.p) :
@@ -99,7 +88,10 @@ theorem ev_naturality {E B E' B' : C} {P : UvPoly E B} {P' : UvPoly E' B'}
   rw [← isoWhiskerLeft_inv, ← Category.assoc, Iso.comp_inv_eq,
     ← isoWhiskerRight_hom, ← Iso.eq_comp_inv] at this
   simp [β, pushforwardPullbackIsoSquare_eq, ev] at this ⊢
-  rw [show inv _ (I := _) = α.inv by simp [α, pullbackMapIsoSquare]]
+  change whiskerRight (conjugateEquiv ((adj P.p).comp (Over.mapPullbackAdj e))
+    ((Over.mapPullbackAdj b).comp (adj P'.p)) α.inv) pbk ≫
+    whiskerLeft p'fwd bb.hom ≫ whiskerRight (adj P'.p).counit ebk =
+    whiskerLeft ebk (adj P.p).counit
   generalize Over.mapPullbackAdj e = adje, Over.mapPullbackAdj b = adjb at *
   ext X : 2; simp
   have := congr(
@@ -127,24 +119,24 @@ theorem ev_naturality {E B E' B' : C} {P : UvPoly E B} {P' : UvPoly E' B'}
 theorem associator_eq_id {C D E E'} [Category C] [Category D] [Category E] [Category E']
     (F : C ⥤ D) (G : D ⥤ E) (H : E ⥤ E') : Functor.associator F G H = Iso.refl (F ⋙ G ⋙ H) := rfl
 
-open Functor in
+open CategoryTheory.Functor in
 theorem whiskerRight_left' {C D E B} [Category C] [Category D] [Category E] [Category B]
     (F : B ⥤ C) {G H : C ⥤ D} (α : G ⟶ H) (K : D ⥤ E) :
     whiskerRight (whiskerLeft F α) K = whiskerLeft F (whiskerRight α K) := by
   aesop_cat
 
-open Functor in
+open CategoryTheory.Functor in
 theorem id_whiskerLeft' {C D} [Category C] [Category D] {G H : C ⥤ D} (α : G ⟶ H) :
     whiskerLeft (𝟭 C) α = α := by
   aesop_cat
 
-open Functor in
+open CategoryTheory.Functor in
 theorem whiskerLeft_twice' {C D E B} [Category C] [Category D] [Category E] [Category B]
     (F : B ⥤ C) (G : C ⥤ D) {H K : D ⥤ E} (α : H ⟶ K) :
     whiskerLeft F (whiskerLeft G α) = whiskerLeft (F ⋙ G) α := by
   aesop_cat
 
-open Functor in
+open CategoryTheory.Functor in
 theorem whiskerRight_twice' {C D E B} [Category C] [Category D] [Category E] [Category B]
     {H K : B ⥤ C} (F : C ⥤ D) (G : D ⥤ E) (α : H ⟶ K) :
     whiskerRight (whiskerRight α F) G = whiskerRight α (F ⋙ G) := by
@@ -152,20 +144,26 @@ theorem whiskerRight_twice' {C D E B} [Category C] [Category D] [Category E] [Ca
 
 variable [HasTerminal C]
 
-open Over ExponentiableMorphism Functor in
+-- This local setting lets simp reduce the mate through the TwoSquare wrapper.
+open Over ExponentiableMorphism CategoryTheory.Functor in
+set_option backward.isDefEq.respectTransparency false in
 @[simp]
 lemma cartesianNatTrans_fstProj {E B E' B' : C} (P : UvPoly E B) (P' : UvPoly E' B')
     (e : E ⟶ E') (b : B ⟶ B') (pb : IsPullback P.p e b P'.p) (X : C) :
     (P.cartesianNatTrans P' b e pb).app X ≫ P'.fstProj X = P.fstProj X ≫ b := by
   let m := whiskerRight (Over.starPullbackIsoStar e).inv (pushforward P.p) ≫
     whiskerLeft (Over.star E') (pushforwardPullbackIsoSquare pb.flip).inv
-  simp [cartesianNatTrans, pullbackForgetTwoSquare, Adjunction.id, Over.mapForget]
+  simp [UvPoly.apply, fstProj, functor, cartesianNatTrans, pullbackForgetTwoSquare,
+    Adjunction.id, Over.mapForget, TwoSquare.vComp, TwoSquare.mk, TwoSquare.natTrans, mateEquiv]
   rw [← Category.assoc]
   change (m.app X).left ≫ pullback.fst (P'.fstProj X) b ≫ P'.fstProj X = P.fstProj X ≫ b
   rw [pullback.condition, ← Category.assoc]; congr 1
-  simpa using Over.w (m.app X)
+  simpa [fstProj, UvPoly.apply, functor] using Over.w (m.app X)
 
-open ExponentiableMorphism Functor in
+open ExponentiableMorphism CategoryTheory.Functor in
+-- Let tactics reduce the slice functor objects in this mate calculation.
+set_option backward.defeqAttrib.useBackward true in
+set_option backward.isDefEq.respectTransparency false in
 set_option maxHeartbeats 300000 in
 theorem fan_snd_map' {E B E' B' : C} {P : UvPoly E B} {P' : UvPoly E' B'}
     (e : E ⟶ E') (b : B ⟶ B') (A : C) (hp : IsPullback P.p e b P'.p) :
@@ -211,15 +209,15 @@ theorem fan_snd_map' {E B E' B' : C} {P : UvPoly E B} {P' : UvPoly E' B'}
       TwoSquare.natTrans]
     slice_lhs 5 5 => exact (pullback_map_eq_eqToHom rfl hp.w).symm
     slice_lhs 10 10 => enter [2,2,2,2]; apply Category.comp_id
-    ext <;> simp
-    · conv_rhs => apply pullback.lift_fst
-      slice_lhs 1 2 => apply pullback.lift_fst
-      simp [← p_eq, UB, bγ, p'fwd, pfwd, Over.pullbackForgetTriangle,
-        Over.pullbackForgetTwoSquare, Adjunction.id, TwoSquare.natTrans, Over.mapForget]
+    ext <;> simp [pullback.map, Category.assoc, ← p_eq, UB, bγ,
+      Over.pullbackForgetTriangle, Over.pullbackForgetTwoSquare, Adjunction.id,
+      TwoSquare.natTrans, Over.mapForget]
+    all_goals simp [fstProj, UvPoly.apply, functor, pfwd, p'fwd, sE, sE']
+    · erw [pullback.lift_fst_assoc]
+      simp only [Category.assoc]
       congr 2
-      symm; apply Category.id_comp
-    · slice_lhs 1 2 => apply pullback.lift_snd
-      symm; apply pullback.lift_snd
+      exact (Category.id_comp _).symm
+    · erw [pullback.lift_snd_assoc]
   let Z : sE ⋙ pfwd ⋙ pbk ⋙ UE ⟶ sE ⋙ UE :=
     whiskerRight (sE.whiskerLeft (ev P.p)) UE
   let Z' : sE' ⋙ p'fwd ⋙ p'bk ⋙ UE' ⟶ sE' ⋙ UE' :=
@@ -256,9 +254,11 @@ theorem fan_snd_map' {E B E' B' : C} {P : UvPoly E B} {P' : UvPoly E' B'}
   slice_lhs 1 2 => rw [← this]
   slice_lhs 2 3 => apply Category.comp_id
   simp [α, Over.starPullbackIsoStar]
-  slice_lhs 5 6 => apply pullback.lift_fst
-  simp [Over.mapForget]
+  simp [pullback.map, sE', Over.star]
 
+-- The slice functor and polynomial application reduce to the same object.
+set_option backward.defeqAttrib.useBackward true in
+set_option backward.isDefEq.respectTransparency false in
 open ExponentiableMorphism in
 theorem fan_snd_map {E B A E' B' A' : C} {P : UvPoly E B} {P' : UvPoly E' B'}
     (e : E ⟶ E') (b : B ⟶ B') (a : A ⟶ A')
@@ -282,6 +282,9 @@ theorem fan_snd_map {E B A E' B' A' : C} {P : UvPoly E B} {P' : UvPoly E' B'}
   · slice_rhs 2 3 => apply pullback.lift_snd
     slice_rhs 1 2 => apply pullback.lift_snd
 
+-- Reduce polynomial application to the slice functor object for this proof.
+set_option backward.defeqAttrib.useBackward true in
+set_option backward.isDefEq.respectTransparency false in
 open ExponentiableMorphism in
 theorem ε_map {E B A E' B' A' : C} {P : UvPoly E B} {P' : UvPoly E' B'}
     (e : E ⟶ E') (b : B ⟶ B') (a : A ⟶ A')
@@ -289,11 +292,16 @@ theorem ε_map {E B A E' B' A' : C} {P : UvPoly E B} {P' : UvPoly E' B'}
     pullback.map (P.fstProj A) P.p (P'.fstProj A') P'.p
       ((P.cartesianNatTrans P' b e hp).app A ≫ P'.functor.map a) e b (by simp) hp.w ≫ ε P' A' =
     ε P A ≫ prod.map e a := by
-  ext
-  · simp
-    slice_rhs 1 2 => apply by simpa using ((ev P.p).app ((Over.star E).obj A)).w
-    slice_lhs 2 3 => apply by simpa using ((ev P'.p).app ((Over.star E').obj A')).w
-    apply pullback.lift_snd
+  have h (E B X : C) (Q : UvPoly E B) :
+      ε Q X ≫ prod.fst = pullback.snd (Q.fstProj X) Q.p := by
+    simpa [ε, fstProj, Over.star_obj_hom] using ((ev Q.p).app ((Over.star E).obj X)).w
+  apply prod.hom_ext
+  · simp only [Category.assoc, prod.map_fst]
+    rw [h]
+    calc
+      _ = pullback.snd (P.fstProj A) P.p ≫ e := pullback.lift_snd _ _ _
+      _ = (ε P A ≫ prod.fst) ≫ e := congrArg (fun f => f ≫ e) (h E B A P).symm
+      _ = _ := Category.assoc _ _ _
   · simpa [fan_snd] using fan_snd_map e b a hp
 
 namespace Equiv
@@ -304,7 +312,7 @@ def fst (pair : Γ ⟶ P @ X) :
     Γ ⟶ B :=
   fan P X |>.extend pair |>.fst
 
-lemma fst_eq (pair : Γ ⟶ P @ X) : fst P X pair = pair ≫ P.fstProj X := by simp [fst]
+lemma fst_eq (pair : Γ ⟶ P @ X) : fst P X pair = pair ≫ P.fstProj X := rfl
 
 def snd (pair : Γ ⟶ P @ X) :
     pullback (fst P X pair) P.p ⟶ X :=
@@ -329,7 +337,7 @@ theorem mk_eq_mk' (b : Γ ⟶ B) (x : pullback b P.p ⟶ X) :
 @[simp]
 lemma fst_mk (b : Γ ⟶ B) (x : pullback b P.p ⟶ X) :
     fst P X (mk P X b x) = b := by
-  simp [fst, mk]
+  exact UvPoly.lift_fst (P := P) (b := b) (e := x)
 
 @[simp]
 lemma fst_mk' (b : Γ ⟶ B) {R f g} (H : IsPullback (P := R) f g b P.p) (x : R ⟶ X) :
@@ -345,10 +353,14 @@ theorem fst_comp_left (pair : Γ ⟶ P @ X) {Δ} (f : Δ ⟶ Γ) :
     fst P X (f ≫ pair) = f ≫ fst P X pair := by simp [fst_eq]
 
 theorem fst_comp_right (pair : Γ ⟶ P @ X) : fst P Y (pair ≫ P.functor.map f) = fst P X pair := by
-  simp [fst_eq]
+  exact (Category.assoc pair (P.functor.map f) (P.fstProj Y)).trans
+    (congrArg (fun k => pair ≫ k) (UvPoly.map_fstProj P f))
 
+-- Simplification must see the apex of the polynomial fan.
+set_option backward.isDefEq.respectTransparency false in
 lemma snd'_eq (pair : Γ ⟶ P @ X) {R f g} (H : IsPullback (P := R) f g (fst P X pair) P.p) :
-    snd' P X pair H = pullback.lift (f ≫ pair) g (by simpa using H.w) ≫ (fan P X).snd := by
+    snd' P X pair H = pullback.lift (f ≫ pair) g
+      (by simpa only [fst_eq, fan_fst, Category.assoc] using H.w) ≫ (fan P X).snd := by
   simp [snd', snd]
   simp only [← Category.assoc]; congr! 2
   ext <;> simp
@@ -356,14 +368,18 @@ lemma snd'_eq (pair : Γ ⟶ P @ X) {R f g} (H : IsPullback (P := R) f g (fst P
     exact H.isoPullback_hom_fst
   · exact H.isoPullback_hom_snd
 
+-- The fan apex is definitionally the polynomial object; expose it during elaboration.
+set_option backward.isDefEq.respectTransparency false in
 /-- Switch the selected pullback `R` used in `UvPoly.Equiv.snd'` with a different pullback `R'`. -/
 lemma snd'_eq_snd' (pair : Γ ⟶ P @ X) {R f g} (H : IsPullback (P := R) f g (fst P X pair) P.p)
     {R' f' g'} (H' : IsPullback (P := R') f' g' (fst P X pair) P.p) :
     snd' P X pair H = (H.isoIsPullback _ _ H').hom ≫ snd' P X pair H' := by
-  simp [snd'_eq, ← Category.assoc]
-  congr 2
-  ext <;> simp
+  simp only [snd'_eq]
+  simp only [← Category.assoc]
+  apply congrArg (fun k => k ≫ (fan P X).snd)
+  apply pullback.hom_ext <;> simp
 
+set_option backward.isDefEq.respectTransparency false in
 @[simp]
 lemma snd'_mk' (b : Γ ⟶ B) {R f g} (H : IsPullback (P := R) f g b P.p) (x : R ⟶ X) :
     snd' P X (mk' P X b H x) (by rwa [fst_mk']) = x := by
@@ -391,6 +407,8 @@ lemma snd_mk (b : Γ ⟶ B) (x : pullback b P.p ⟶ X) :
     snd P X (mk P X b x) = eqToHom (by simp) ≫ x := by
   apply eq_of_heq; rw [heq_eqToHom_comp_iff]; apply snd_mk_heq
 
+-- The fan point is definitionally the polynomial object.
+set_option backward.isDefEq.respectTransparency false in
 theorem snd'_comp_left (pair : Γ ⟶ P @ X)
     {R f g} (H : IsPullback (P := R) f g (fst P X pair) P.p)
     {Δ} (σ : Δ ⟶ Γ)
@@ -398,11 +416,10 @@ theorem snd'_comp_left (pair : Γ ⟶ P @ X)
     snd' P X (σ ≫ pair) (by convert H'; rw [fst_comp_left]) =
     H.lift (f' ≫ σ) g' (by simp [H'.w]) ≫ snd' P X pair H := by
   simp only [snd'_eq, ← Category.assoc]
-  congr 2
-  ext
-  · simp
-  · simp
+  apply congrArg (fun k => k ≫ (fan P X).snd)
+  apply pullback.hom_ext <;> simp [Category.assoc]
 
+set_option backward.isDefEq.respectTransparency false in
 theorem snd'_comp_right (pair : Γ ⟶ P @ X)
     {R f1 f2} (H : IsPullback (P := R) f1 f2 (fst P X pair) P.p) :
     snd' P Y (pair ≫ P.functor.map f) (by rwa [fst_comp_right]) =
@@ -424,24 +441,27 @@ theorem snd_comp_right (pair : Γ ⟶ P @ X) : snd P Y (pair ≫ P.functor.map f
   rw [snd_eq_snd', snd'_comp_right, snd', Category.assoc, ← eqToIso.hom]; congr! 2
   exact IsPullback.isoPullback_eq_eqToIso_left (fst_comp_right _ _ _ f pair) P.p
 
+-- Expose the fan apex when comparing the chosen pullback projections.
+set_option backward.isDefEq.respectTransparency false in
 lemma ext' {pair₁ pair₂ : Γ ⟶ P @ X}
     {R f g} (H : IsPullback (P := R) f g (fst P X pair₁) P.p)
     (h1 : fst P X pair₁ = fst P X pair₂)
     (h2 : snd' P X pair₁ H = snd' P X pair₂ (by rwa [h1] at H)) :
     pair₁ = pair₂ := by
   simp [fst_eq] at h1 H
-  apply partialProd.hom_ext ⟨fan P X, isLimitFan P X⟩ h1
+  apply UvPoly.hom_ext (P := P) (X := X) h1
   refine (cancel_epi H.isoPullback.hom).1 ?_
-  convert h2 using 1 <;> (
-    simp [snd'_eq, comparison_pullback.map, partialProd.snd, partialProd.cone]
-    simp only [← Category.assoc]; congr! 2
-    ext <;> simp)
-  · slice_lhs 2 3 => apply pullback.lift_fst
-    slice_lhs 1 2 => apply H.isoPullback_hom_fst
-    simp
-  · slice_lhs 2 3 => apply pullback.lift_snd
-    slice_lhs 1 2 => apply H.isoPullback_hom_snd
-    simp
+  convert h2 using 1 <;>
+    simp only [snd'_eq, comparison_pullback.map, ← Category.assoc] <;>
+    congr 1 <;>
+    apply pullback.hom_ext <;>
+    simp [Category.assoc] <;>
+    first
+    | exact H.isoPullback_hom_snd
+    | exact (Category.assoc _ _ _).symm.trans
+        (congrArg (fun k => k ≫ pair₁) H.isoPullback_hom_fst)
+    | exact (Category.assoc _ _ _).symm.trans
+        (congrArg (fun k => k ≫ pair₂) H.isoPullback_hom_fst)
 
 /-- Switch the selected pullback `R` used in `UvPoly.Equiv.mk'` with a different pullback `R'`. -/
 theorem mk'_eq_mk' (b : Γ ⟶ B) {R f g} (H : IsPullback (P := R) f g b P.p) (x : R ⟶ X)
@@ -466,12 +486,19 @@ lemma eta (pair : Γ ⟶ P @ X) :
 
 lemma mk'_comp_right (b : Γ ⟶ B) {R f1 f2} (H : IsPullback (P := R) f1 f2 b P.p) (x : R ⟶ X) :
     mk' P X b H x ≫ P.functor.map f = mk' P Y b H (x ≫ f) := by
-  refine .symm <| ext' _ _ (by rwa [fst_mk']) (by simp [fst_comp_right]) ?_
-  rw [snd'_comp_right (H := by rwa [fst_mk'])]; simp
+  have hfst : fst P Y (mk' P Y b H (x ≫ f)) =
+      fst P Y (mk' P X b H x ≫ P.functor.map f) :=
+    (fst_mk' P Y b H (x ≫ f)).trans
+      ((fst_comp_right P X Y f (mk' P X b H x)).trans (fst_mk' P X b H x)).symm
+  refine .symm <| ext' _ _ (by rwa [fst_mk']) hfst ?_
+  exact (snd'_mk' P Y b H (x ≫ f)).trans
+    ((snd'_comp_right P X Y f (mk' P X b H x) (by rwa [fst_mk'])).trans
+      (congrArg (fun k => k ≫ f) (snd'_mk' P X b H x))).symm
 
 lemma mk_comp_right (b : Γ ⟶ B) (x : pullback b P.p ⟶ X) :
     mk P X b x ≫ P.functor.map f = mk P Y b (x ≫ f) := by
-  simp [mk_eq_mk', mk'_comp_right]
+  simpa only [mk_eq_mk'] using
+    (mk'_comp_right P X Y f b (.of_hasPullback b P.p) x)
 
 theorem mk'_comp_left {Δ}
     (b : Γ ⟶ B) {R f g} (H : IsPullback (P := R) f g b P.p) (x : R ⟶ X) (σ : Δ ⟶ Γ)
@@ -490,8 +517,20 @@ theorem mk_comp_left {Δ} (b : Γ ⟶ B) (x : pullback b P.p ⟶ X) (σ: Δ ⟶
       (pullback.map _ _ _ _ σ (𝟙 _) (𝟙 _) (by simp) (by simp) ≫ x) := by
   simp only [mk_eq_mk']
   rw [mk'_comp_left (H := .of_hasPullback _ _) (H' := .of_hasPullback _ _) (eq := rfl)]
-  congr 2; ext <;> simp
-
+  congr 2
+  apply pullback.hom_ext
+  · simp only [IsPullback.lift_fst]
+    exact (pullback.lift_fst (f := b) (g := P.p)
+      (pullback.fst (σ ≫ b) P.p ≫ σ)
+      (pullback.snd (σ ≫ b) P.p ≫ 𝟙 E) _).symm
+  · simp only [IsPullback.lift_snd]
+    exact (Category.comp_id _).symm.trans
+      (pullback.lift_snd (f := b) (g := P.p)
+        (pullback.fst (σ ≫ b) P.p ≫ σ)
+        (pullback.snd (σ ≫ b) P.p ≫ 𝟙 E) _).symm
+
+-- Expose the polynomial objects in the natural transformation components.
+set_option backward.isDefEq.respectTransparency false in
 lemma mk'_comp_cartesianNatTrans_app {E' B' Γ X : C} {P' : UvPoly E' B'}
     (y : Γ ⟶ B) (R f g) (H : IsPullback (P := R) f g y P.p)
     (x : R ⟶ X) (e : E ⟶ E') (b : B ⟶ B')
@@ -505,7 +544,17 @@ lemma mk'_comp_cartesianNatTrans_app {E' B' Γ X : C} {P' : UvPoly E' B'}
   have := snd'_mk' P X y H x
   rw [snd'_eq, ← fan_snd_map' _ _ X hp] at this
   refine .trans ?_ this
-  simp only [← Category.assoc]; congr 1; ext <;> simp
+  simp only [← Category.assoc]; congr 1; ext
+  · change _ = _ ≫ pullback.fst (P'.fstProj X) P'.p
+    simp only [pullback.map, pullback.lift_fst, Category.assoc]
+    symm
+    slice_lhs 1 2 => apply pullback.lift_fst
+    exact Category.assoc _ _ _
+  · change _ = _ ≫ pullback.snd (P'.fstProj X) P'.p
+    simp only [pullback.map, pullback.lift_snd, Category.assoc]
+    rw [← Category.assoc]
+    exact congrArg (fun k => k ≫ e)
+      (pullback.lift_snd (f := P.fstProj X) (g := P.p) (f ≫ mk' P X y H x) g _).symm
 
 end Equiv
 
@@ -534,8 +583,8 @@ def compDomEquiv {Γ E B D A : 𝒞} {P : UvPoly E B} {Q : UvPoly D A} :
           apply Eq.congr_right
           congr 1
           apply pullback.hom_ext
-          · simp [pullbackHomEquiv]
-          · simp [pullbackHomEquiv]))
+          · exact (pullback.lift_fst (f := P.fstProj A) (g := P.p) _ _ _).symm
+          · exact (pullback.lift_snd (f := P.fstProj A) (g := P.p) _ _ _).symm))
   _ ≃ _ := {
       -- TODO should be general tactic for this?
       toFun x := ⟨ x.2.1.1, x.2.1.2.1 , x.1 , x.2.1.2.2, x.2.2 ⟩
@@ -551,9 +600,16 @@ def compP {E B D A : C} (P : UvPoly E B) (Q : UvPoly D A) : compDom P Q ⟶ P @
     (β : Γ ⟶ D) (w : AB ≫ P.fstProj A = α ≫ P.p)
     (h : β ≫ Q.p = pullback.lift AB α w ≫ (PartialProduct.fan P A).snd) :
     compDomEquiv.symm ⟨AB, α, β, w, h⟩ ≫ P.compP Q = AB := by
-   simp [compDomEquiv, compP, Equiv.psigmaCongrProp, Equiv.sigmaCongrRight_symm,
-    Equiv.coe_fn_symm_mk, pullbackHomEquiv]
-
+  change pullback.lift β (pullback.lift AB α w) h ≫
+    (pullback.snd Q.p (fan P A).snd ≫ pullback.fst (P.fstProj A) P.p) = AB
+  exact (Category.assoc _ _ _).symm.trans
+    ((congrArg (fun k => k ≫ pullback.fst (P.fstProj A) P.p)
+      (pullback.lift_snd (f := Q.p) (g := (fan P A).snd) β
+        (pullback.lift AB α w) h)).trans
+      (pullback.lift_fst (f := P.fstProj A) (g := P.p) AB α w))
+
+-- Reduce the polynomial functor objects when elaborating the pullback squares.
+set_option backward.isDefEq.respectTransparency false in
 def compDomMap {E B D A E' B' D' A' : 𝒞} {P : UvPoly E B} {Q : UvPoly D A}
     {P' : UvPoly E' B'} {Q' : UvPoly D' A'}
     (e : E ⟶ E') (d : D ⟶ D') (b : B ⟶ B') (a : A ⟶ A')
@@ -564,6 +620,8 @@ def compDomMap {E B D A E' B' D' A' : 𝒞} {P : UvPoly E B} {Q : UvPoly D A}
   let r := pullback.map (P.fstProj A) P.p (P'.fstProj A') P'.p pa e b (by simp [pa, p]) hp.w
   refine pullback.map _ _ _ _ d r a hq.w (fan_snd_map _ _ _ hp).symm
 
+-- Reduce the same functor objects in the pasted pullback squares.
+set_option backward.isDefEq.respectTransparency false in
 theorem compDomMap_isPullback {E B D A E' B' D' A' : 𝒞} {P : UvPoly E B} {Q : UvPoly D A}
     {P' : UvPoly E' B'} {Q' : UvPoly D' A'}
     (e : E ⟶ E') (d : D ⟶ D') (b : B ⟶ B') (a : A ⟶ A')
@@ -578,7 +636,7 @@ theorem compDomMap_isPullback {E B D A E' B' D' A' : 𝒞} {P : UvPoly E B} {Q :
   · refine hq.flip.back_face_of_comm_cube _ _ _ _ _ _ _ _ _ _ _ _ (by simp [compDomMap]) ?_ ?_
       (.of_hasPullback ..) (.of_hasPullback ..)
     · exact ⟨fan_snd_map _ _ a hp⟩
-    · constructor; simp [compDomMap]; ext <;> simp [p]
+    · constructor; simp [compDomMap]; ext <;> simp [p, fan]
   · exact hp.flip.back_face_of_comm_cube _ _ _ _ _ _ _ _ _ _ _ _
       (by simp) (by simp [p]) (by simp) (.flip (.of_hasPullback ..)) (.flip (.of_hasPullback ..))
 
@@ -623,7 +681,7 @@ instance preservesConnectedLimitsOfShape_of_hasLimitsOfShape {J : Type v₁} [Sm
   unfold UvPoly.functor
   infer_instance
 
-instance preservesPullbacks (P : UvPoly E B)
+theorem preservesPullbacks (P : UvPoly E B)
     {Pb X Y Z : C} (fst : Pb ⟶ X) (snd : Pb ⟶ Y)
     (f : X ⟶ Z) (g : Y ⟶ Z)
     (h: IsPullback fst snd f g) :
diff --git a/HoTTLean/Frontend/Commands.lean b/HoTTLean/Frontend/Commands.lean
index 2f349ac6..28b3e017 100644
--- a/HoTTLean/Frontend/Commands.lean
+++ b/HoTTLean/Frontend/Commands.lean
@@ -21,16 +21,16 @@ def envDiff (old new : Environment) : Array ConstantInfo := Id.run do
 and return them as an axiom environment.
 Assumes that all such axioms are present in the ambient environment
 as definitions of type `CheckedAx _` under the same name. -/
-def computeAxioms (thyEnv : Environment) (constNm : Name) : MetaM ((E : Q(Axioms Name)) × Q(($E).Wf)) := do
-  let (_, st) ← (CollectAxioms.collect constNm).run thyEnv |>.run {}
-  let axioms := st.axioms
+def computeAxioms (thyEnv : Environment) (constNm : Name) :
+    MetaM ((E : Q(Axioms Name)) × Q(($E).Wf)) := do
+  let axioms ← withEnv thyEnv <| collectAxioms constNm
   -- The output includes `constNm` if it is itself an axiom.
   let axioms := axioms.filter (· != constNm)
   -- Order the axioms by '`a` uses `b`'.
   let mut axiomAxioms : Std.HashMap Name (Array Name) := {}
   for axNm in axioms do
-    let (_, st) ← (CollectAxioms.collect axNm).run thyEnv |>.run {}
-    let axioms := st.axioms.filter (· != axNm)
+    let axioms ← withEnv thyEnv <| collectAxioms axNm
+    let axioms := axioms.filter (· != axNm)
     axiomAxioms := axiomAxioms.insert axNm axioms
   let mut axioms := axioms.qsort (fun a b => axiomAxioms[b]!.contains a)
   -- HACK: replace `sorryAx` with our universe-monomorphic versions.
diff --git a/HoTTLean/Frontend/EnvExt.lean b/HoTTLean/Frontend/EnvExt.lean
index 3d71ccf3..b23634b8 100644
--- a/HoTTLean/Frontend/EnvExt.lean
+++ b/HoTTLean/Frontend/EnvExt.lean
@@ -26,7 +26,7 @@ namespace SynthLean
 open Lean Qq
 
 variable {m : Type → Type} [Monad m] [MonadLiftT IO m]
-  [MonadOptions m] [MonadEnv m] [MonadError m] [MonadQuotation m]
+  [MonadOptions m] [MonadEnv m] [MonadError m]
 
 /-- A theory-updating entry.
 
@@ -70,8 +70,33 @@ For the initial shallow environment,
 we pull in a custom prelude with `Type`-valued identity types. -/
 def mkInitTheoryData (modNm mainModule : Name) : m TheoryData := do
   -- TODO: check if the `.olean` exists and print a better error if not.
-  let mut thyEnv ← importModules #[{ module := `HoTTLean.Prelude }]
-    (← getOptions) (leakEnv := true) (loadExts := true)
+  let opts ← getOptions
+  let imports := #[{ module := `HoTTLean.Prelude : Import }]
+  -- Read module data without changing the process-wide import flags.
+  let (_, state) ← liftM (m := IO) <| (importModulesCore imports).run
+  let mut thyEnv ← finalizeImport state imports opts (leakEnv := true) (loadExts := false)
+  -- Lean has already initialized Init in the host process. The custom prelude
+  -- must not require more initializers. Check this before restoring extensions.
+  for mod in thyEnv.header.modules, i in [0:thyEnv.header.modules.size] do
+    if mod.module == `HoTTLean.Prelude then
+      let preludeImports := thyEnv.header.moduleData[i]!.imports
+      if preludeImports.isEmpty || preludeImports.any (·.module != `Init) then
+        liftM (m := IO) <| throw <| IO.userError "the theory prelude must import only Init"
+      if !(regularInitAttr.ext.getModuleEntries thyEnv i).isEmpty ||
+          !(regularInitAttr.ext.getModuleIREntries thyEnv i).isEmpty ||
+          !(builtinInitAttr.ext.getModuleEntries thyEnv i).isEmpty ||
+          !(builtinInitAttr.ext.getModuleIREntries thyEnv i).isEmpty then
+        liftM (m := IO) <| throw <| IO.userError "the theory prelude must not contain initializers"
+    else if !(`Init).isPrefixOf mod.module then
+      liftM (m := IO) <| throw <| IO.userError s!"unsupported theory prelude import '{mod.module}'"
+  -- Restore only extension data from Init and the custom prelude. Do not run
+  -- module initializers, load native code, or change global import flags here.
+  -- These operations must also work inside another extension's addImportedFn.
+  for ext in (← liftM (m := IO) persistentEnvExtensionsRef.get) do
+    let s := ext.toEnvExtension.getState (asyncMode := .sync) thyEnv
+    if s.importedEntries.all Array.isEmpty then continue
+    let newState ← ext.addImportedFn s.importedEntries { env := thyEnv, opts }
+    thyEnv := ext.toEnvExtension.setState (asyncMode := .sync) thyEnv { s with state := newState }
   thyEnv := thyEnv.setMainModule mainModule
   return {
     modNm
@@ -107,7 +132,7 @@ private initialize theoryExt : TheoryExt ←
               | .axiomInfo i => pure <| .axiomDecl i | .defnInfo i => pure <| .defnDecl i
               | _ => throwThe IO.Error s!"unsupported constant kind at '{ci.name}'"
             -- Q: no extension entries added after the prelude; will this break elaboration?
-            let .ok thyEnv := thyData.env.addDeclCore 0 decl none (doCheck := false)
+            let .ok thyEnv := thyData.env.addDeclCore 0 0 decl none (doCheck := false)
               | throwThe IO.Error "internal error" /- cannot happen with `doCheck := false` -/
             thyMap := thyMap.insert thyNm { thyData with env := thyEnv }
       return ([], thyMap)
@@ -116,7 +141,7 @@ private initialize theoryExt : TheoryExt ←
     -- Note: because we `cons` local entries onto the list,
     -- this array has the latest entry first
     -- and has to be read in reverse order when imported.
-    exportEntriesFnEx _ s _ := s.1.toArray
+    exportEntriesFnEx _ s := .uniform s.1.toArray
     -- TODO: statsFn, asyncMode, replay?
   }
 
diff --git a/HoTTLean/Grothendieck/Groupoidal/Basic.lean b/HoTTLean/Grothendieck/Groupoidal/Basic.lean
index 5103064e..d5576825 100644
--- a/HoTTLean/Grothendieck/Groupoidal/Basic.lean
+++ b/HoTTLean/Grothendieck/Groupoidal/Basic.lean
@@ -73,7 +73,7 @@ def comp {x y z : ∫(F)} (f : Hom x y) (g : Hom y z) : Hom x z := Grothendieck.
 attribute [local simp] eqToHom_map
 
 instance : Category (∫ F) := {
-  (inferInstanceAs $ Category (Grothendieck (F ⋙ Grpd.forgetToCat))) with
+  (inferInstance : Category (Grothendieck (F ⋙ Grpd.forgetToCat))) with
   Hom := Hom
   id := id
   comp := comp
@@ -126,8 +126,8 @@ def objMk (c : C) (x : F.obj c) : ∫(F) where
   making a path in the fiber so that it does not show the
   composition with `Grpd.forgetToCat`
 -/
-def homMk {X Y : ∫(F)} (fb : X.base ⟶ Y.base) (ff : (F.map fb).obj X.fiber ⟶ Y.fiber)
-    : X ⟶ Y where
+def homMk {X Y : ∫(F)} (fb : X.base ⟶ Y.base) (ff : (F.map fb).obj X.fiber ⟶ Y.fiber) :
+    X ⟶ Y where
   base := fb
   fiber := ff
 
@@ -185,8 +185,8 @@ section
 
 variable {C : Type u₁} [Groupoid.{v₁,u₁} C] {F : C ⥤ Grpd.{v₂,u₂}}
 
-instance (X : C) : Groupoid (F ⋙ Grpd.forgetToCat |>.obj X) where
-  inv f := ((F.obj X).str').inv f
+instance (X : C) : Groupoid (F ⋙ Grpd.forgetToCat |>.obj X) :=
+  (F.obj X).str'
 
 /--
 If `F : C ⥤ Grpd` is a functor and `t : c ⟶ d` is a morphism in `C`,
@@ -236,7 +236,7 @@ lemma toTransport_id {X : ∫ F} :
   apply Grothendieck.toTransport_id
 
 lemma toTransport_eqToHom {X: C} {X' : ∫ F} (hX': forget.obj X' = X):
-    toTransport X' (eqToHom hX') = eqToHom (by subst hX'; simp [transport_id]) := by
+    toTransport X' (eqToHom hX') = eqToHom (by subst hX'; exact transport_id.symm) := by
   apply Grothendieck.toTransport_eqToHom
 
 lemma transport_comp (x : ∫ F) {c d : C} (t : x.base ⟶ c) (t' : c ⟶ d):
@@ -378,8 +378,8 @@ variable {D : Type*} [Category D]
 theorem FunctorTo.hext (G H : D ⥤ ∫ F)
     (hbase : G ⋙ forget = H ⋙ forget)
     (hfiber_obj : ∀ x : D, HEq (G.obj x).fiber (H.obj x).fiber)
-    (hfiber_map : ∀ {x y : D} (f : x ⟶ y), HEq (G.map f).fiber (H.map f).fiber)
-    : G = H :=
+    (hfiber_map : ∀ {x y : D} (f : x ⟶ y), HEq (G.map f).fiber (H.map f).fiber) :
+    G = H :=
   Grothendieck.FunctorTo.hext _ _ hbase hfiber_obj hfiber_map
 
 end ext
@@ -482,7 +482,7 @@ on `F` supplied as the first argument to `Groupoidal.functorFrom`. -/
 def ιCompFunctorFrom (c : C) : ι F c ⋙ (functorFrom fib hom hom_id hom_comp) ≅ fib c :=
   Grothendieck.ιCompFunctorFrom _ _ _ _ _
 
-def ι_comp_functorFrom (c : C) : ι F c ⋙ (functorFrom fib hom hom_id hom_comp) = fib c :=
+theorem ι_comp_functorFrom (c : C) : ι F c ⋙ (functorFrom fib hom hom_id hom_comp) = fib c :=
   Grothendieck.ι_comp_functorFrom _ _ _ _ _
 
 lemma whiskerRight_ιNatTrans_functorFrom {x y} (f : x ⟶ y) :
@@ -498,7 +498,8 @@ variable {D : Type*} [Category D]
 def fib' (c) : (F ⋙ Grpd.forgetToCat).obj c ⥤ E := fib c
 
 variable {fib} in
-def hom' {c c' : C} (f : c ⟶ c') : fib' fib c ⟶ (F ⋙ Grpd.forgetToCat).map f ⋙ fib' fib c' :=
+def hom' {c c' : C} (f : c ⟶ c') :
+    fib' fib c ⟶ ((F ⋙ Grpd.forgetToCat).map f).toFunctor ⋙ fib' fib c' :=
   hom f
 
 variable (G : E ⥤ D)
@@ -510,7 +511,8 @@ def functorFromCompFib (c : C) : F.obj c ⥤ D :=
  functorFromCompFib' fib G c
 
 def functorFromCompHom' {c c' : C}  (f : c ⟶ c') :
-    functorFromCompFib' fib G c ⟶ (F ⋙ Grpd.forgetToCat).map f ⋙ functorFromCompFib' fib G c' :=
+    functorFromCompFib' fib G c ⟶
+      ((F ⋙ Grpd.forgetToCat).map f).toFunctor ⋙ functorFromCompFib' fib G c' :=
   Grothendieck.functorFromCompHom (fib' fib) (hom' hom) _ _
 
 def functorFromCompHom {c c' : C}  (f : c ⟶ c') :
@@ -527,7 +529,7 @@ lemma functorFromCompHom_comp (c₁ c₂ c₃ : C) (f : c₁ ⟶ c₂) (g : c₂
     functorFromCompHom fib (fun {c c'} ↦ hom) G (f ≫ g)
     = functorFromCompHom fib (fun {c c'} ↦ hom) G f ≫
     Functor.whiskerLeft (F.map f) (functorFromCompHom fib hom G g) ≫
-    eqToHom (by simp) :=
+    eqToHom (by simp only [Functor.map_comp, Grpd.comp_eq_comp]; rfl) :=
   Grothendieck.functorFromCompHom_comp _ _ hom_comp _ _ _ _ _ _
 
 
@@ -564,7 +566,7 @@ lemma asFunctorFromFib_functorFrom :
   rw [ι_comp_functorFrom]
 
 lemma asFunctorFromHom' {c c' : C} (f: c ⟶ c') :
-  asFunctorFromHom K f = whiskerRight (ιNatTrans f) K := rfl
+    asFunctorFromHom K f = whiskerRight (ιNatTrans f) K := rfl
 
 lemma asFunctorFromHom_app {c c' : C} (f: c ⟶ c') (p : F.obj c) :
     (asFunctorFromHom K f).app p = K.map ((ιNatTrans f).app p) :=
@@ -589,15 +591,15 @@ theorem functorFrom_ext {K K' : ∫(F) ⥤ E}
     (hfib : ∀ c, ι F c ⋙ K = ι F c ⋙ K')
     (hhom : ∀ {c c' : C} (f : c ⟶ c'), Functor.whiskerRight (ιNatTrans f) K ≫
       eqToHom (by simp [Functor.assoc, hfib])
-      = eqToHom (by rw[hfib]) ≫ Functor.whiskerRight (ιNatTrans f) K')
-    : K = K' :=
+      = eqToHom (by rw[hfib]) ≫ Functor.whiskerRight (ιNatTrans f) K') :
+    K = K' :=
   Grothendieck.functorFrom_ext hfib hhom
 
 theorem functorFrom_hext {K K' : ∫(F) ⥤ E}
     (hfib : ∀ c, ι F c ⋙ K = ι F c ⋙ K')
     (hhom : ∀ {c c' : C} (f : c ⟶ c'), Functor.whiskerRight (ιNatTrans f) K ≍
-      Functor.whiskerRight (ιNatTrans f) K')
-    : K = K' :=
+      Functor.whiskerRight (ιNatTrans f) K') :
+    K = K' :=
   Grothendieck.functorFrom_hext hfib hhom
 
 section
@@ -659,8 +661,8 @@ theorem map_forget (α : F ⟶ G) : map α ⋙ forget = forget :=
 
 variable {X} {Y : ∫(F)} (f : X ⟶ Y)
 
-@[simp] theorem map_map_base : ((Groupoidal.map α).map f).base = f.base
-    := Grothendieck.map_map_base _ _
+@[simp] theorem map_map_base : ((Groupoidal.map α).map f).base = f.base :=
+    Grothendieck.map_map_base _ _
 
 @[simp] theorem map_map_fiber :
   ((Groupoidal.map α).map f).fiber =
@@ -760,14 +762,16 @@ lemma pre_comp (G : D ⥤ C) (H : E ⥤ D) : pre F (H ⋙ G) = pre (G ⋙ F) H 
 theorem pre_comp_forget (α : D ⥤ C) (A : C ⥤ Grpd) :
     pre A α ⋙ forget = forget ⋙ α := rfl
 
-@[simp] theorem ι_comp_pre {D : Type*} [Category D] (G : D ⥤ C) (x : D)
-    : ι (G ⋙ F) x ⋙ pre F G = ι F (G.obj x) := by
+@[simp] theorem ι_comp_pre {D : Type*} [Category D] (G : D ⥤ C) (x : D) :
+    ι (G ⋙ F) x ⋙ pre F G = ι F (G.obj x) := by
   apply FunctorTo.hext
   · rw [ι_comp_forget, Functor.assoc, pre_comp_forget, ← Functor.assoc, ι_comp_forget]
     apply Functor.ext <;> simp
   · intro
-    simp
-  · simp
+    rfl
+  · intros
+    simp only [Functor.comp_map, pre_map_fiber, ι_map_fiber]
+    exact (eqToHom_comp_heq _ _).trans (eqToHom_comp_heq _ _).symm
 
 noncomputable section
 
@@ -783,18 +787,6 @@ def invFiber : y.fiber ⟶ (F.map f.base).obj x.fiber :=
       ← Groupoidal.comp_base]) ≫
     (F.map f.base).map (CategoryTheory.inv f).fiber
 
-@[simp]
-lemma fiber_comp_invFiber : f.fiber ≫ invFiber f = 𝟙 ((F.map f.base).obj x.fiber) := by
-  have h := comp_fiber f (CategoryTheory.inv f)
-  rw! [IsIso.hom_inv_id] at h
-  have h0 : F.map (CategoryTheory.inv f).base ⋙ F.map f.base = 𝟭 _ := by
-    simp [← Grpd.comp_eq_comp, ← Functor.map_comp, ← comp_base]
-  have h1 := Functor.congr_map (F.map f.base) h
-  simp [← heq_eq_eq, eqToHom_map, ← Functor.comp_map, Functor.congr_hom h0] at h1
-  dsimp [invFiber]
-  rw! [← h1]
-  simp
-
 @[simp]
 lemma invFiber_comp_fiber : invFiber f ≫ f.fiber = 𝟙 _ := by
   have h := comp_fiber (CategoryTheory.inv f) f
@@ -805,6 +797,11 @@ lemma invFiber_comp_fiber : invFiber f ≫ f.fiber = 𝟙 _ := by
   · simp
   · simpa using (eqToHom_heq_id_cod _ _ _).symm
 
+@[simp]
+lemma fiber_comp_invFiber : f.fiber ≫ invFiber f = 𝟙 ((F.map f.base).obj x.fiber) := by
+  apply (cancel_mono f.fiber).1
+  simp only [Category.assoc, invFiber_comp_fiber, Category.comp_id, Category.id_comp]
+
 instance : IsIso f.fiber :=
   ⟨invFiber f , fiber_comp_invFiber f, invFiber_comp_fiber f⟩
 
@@ -831,24 +828,14 @@ lemma comp_forget_naturality {α : F ⟶ G} {X Y : Γ} (f : X ⟶ Y) :
   simp
 
 lemma map_map_eqToHom {α : F ⟶ G} {X Y : ∫(F)} (f : X ⟶ Y) :
-    ((G ⋙ Grpd.forgetToCat).map f.base).obj ((map α).obj X).fiber =
-  (α.app Y.base).obj (((F ⋙ Grpd.forgetToCat).map f.base).obj X.fiber) := by
-    apply Eq.symm
-    have equ1 :
-      (α.app Y.base).obj ((Grpd.forgetToCat.map (F.map f.base)).obj X.fiber) =
-      ((Grpd.forgetToCat.map (F.map f.base)) ⋙ (α.app Y.base)).obj X.fiber := by simp
-    have equ2 :
-      (Grpd.forgetToCat.map (G.map f.base)).obj ((α.app X.base).obj X.fiber) =
-      ((α.app X.base) ⋙ (Grpd.forgetToCat.map (G.map f.base))).obj X.fiber := by simp
-    simp only [Functor.comp_obj, Functor.comp_map, map_obj_fiber]
-    rw[equ1, equ2]
-    refine Functor.congr_obj ?_ X.fiber
-    apply comp_forget_naturality
+    ((G ⋙ Grpd.forgetToCat).map f.base).toFunctor.obj ((map α).obj X).fiber =
+  (α.app Y.base).obj (((F ⋙ Grpd.forgetToCat).map f.base).toFunctor.obj X.fiber) := by
+  exact (Functor.congr_obj (α.naturality f.base) X.fiber).symm
 
 @[simp] theorem eqToHom_comp_fiber {C : Type u} [Category.{v} C] {A : C ⥤ Grpd.{v₁, u₁}}
     {p q r : ∫(A)} (h : p = q) {f : q ⟶ r} :
     (eqToHom h ≫ f).fiber = eqToHom (by subst h; simp) ≫ f.fiber := by
-  simp [eqToHom_map]
+  simp only [comp_fiber, fiber_eqToHom, eqToHom_map, eqToHom_trans_assoc]
 
 end
 
@@ -866,6 +853,7 @@ variable {C : Type u} [Category.{v} C] {D : Type u₁} [Category.{v₁} D]
 theorem map_comp_eq {G H : C ⥤ Grpd.{v₂,u₂}} (α : F ⟶ G) (β : G ⟶ H) :
     map (α ≫ β) = map α ⋙ map β := by
   simp [map, Grothendieck.map_comp_eq]
+  rfl
 
 theorem preNatIso_comp {G1 G2 G3 : D ⥤ C} (α : G1 ≅ G2) (β : G2 ≅ G3) :
     preNatIso F (α ≪≫ β) = preNatIso F α ≪≫ Functor.isoWhiskerLeft _ (preNatIso F β) ≪≫
@@ -877,51 +865,15 @@ end
 section
 variable {Γ : Type u} [Groupoid.{v} Γ] (A : Γ ⥤ Grpd.{v₁,u₁})
 
-theorem map_eqToHom_base {G1 G2 : ∫(A)} (eq : G1 = G2)
-    : A.map (eqToHom eq).base = eqToHom (by subst eq; simp) := by
+theorem map_eqToHom_base {G1 G2 : ∫(A)} (eq : G1 = G2) :
+    A.map (eqToHom eq).base = eqToHom (by subst eq; simp) := by
   aesop_cat
 
 open CategoryTheory.Functor in
 /-- Every morphism `f : X ⟶ Y` in the base category induces a natural transformation from the fiber
 inclusion `ι F X` to the composition `F.map f ⋙ ι F Y`. -/
-def ιNatIso {X Y : Γ} (f : X ⟶ Y) : ι A X ≅ A.map f ⋙ ι A Y where
-  hom := ιNatTrans f
-  inv := whiskerLeft (A.map f) (ιNatTrans (Groupoid.inv f)) ≫ eqToHom (by
-    convert_to A.map (f ≫ Groupoid.inv f) ⋙ ι A X = ι A X
-    · simp only [Functor.map_comp, Grpd.comp_eq_comp, Functor.assoc]
-    · simp)
-  hom_inv_id := by
-    ext a
-    apply Groupoidal.Hom.hext
-    · simp
-    . simp only [NatTrans.comp_app, whiskerLeft_app, comp_base,  comp_fiber, Grpd.map_comp_map,
-        Category.assoc, eqToHom_trans_assoc, eqToHom_refl, Category.id_comp,
-        NatTrans.id_app, id_fiber, eqToHom_comp_heq_iff]
-      -- FIXME: `transparency := default` is like `erw` and should be avoided
-      rw! (castMode := .all) (transparency := .default)
-        [eqToHom_app, map_eqToHom_base, Category.id_comp]
-      -- FIXME: `occs` is fragile
-      rw! (transparency := .default) (occs := .pos [4]) [Functor.map_id]
-      rw! (transparency := .default) [Category.id_comp]
-      simp only [eqToHom_refl, fiber_eqToHom, eqRec_heq_iff_heq]
-      -- these should be automated
-      apply HEq.trans (eqToHom_heq_id_cod _ _ _)
-      apply HEq.symm (eqToHom_heq_id_cod _ _ _)
-  inv_hom_id := by
-    ext a
-    apply Groupoidal.Hom.hext
-    · simp
-    . simp only [NatTrans.comp_app, whiskerLeft_app, comp_fiber, ιNatTrans_app_fiber,
-        map_comp, eqToHom_map, Category.assoc, eqToHom_trans_assoc, NatTrans.id_app,
-        id_fiber, eqToHom_comp_heq_iff]
-      -- FIXME: `transparency := default` is like `erw` and should be avoided
-      -- FIXME: `occs` is fragile
-      rw! (transparency := .default) (occs := .pos [6]) [Functor.map_id]
-      rw! (transparency := .default) (occs := .pos [4]) [Functor.map_id]
-      rw! (transparency := .default) [eqToHom_app]
-      simp only [comp_obj, fiber_eqToHom, eqToHom_map, Category.id_comp, id_base,
-        eqToHom_comp_heq_iff]
-      exact (eqToHom_heq_id_cod _ _ _).symm
+noncomputable def ιNatIso {X Y : Γ} (f : X ⟶ Y) : ι A X ≅ A.map f ⋙ ι A Y :=
+  asIso (ιNatTrans f)
 
 theorem ιNatIso_hom {x y : Γ} (f : x ⟶ y) :
     (ιNatIso A f).hom = ιNatTrans f := by
@@ -946,14 +898,8 @@ section
 lemma eqToHom_eq_homOf_map {Γ : Type*} [Groupoid Γ] {F G : Γ ⥤ Grpd} (h : F = G) :
     eqToHom (by rw [h]) = Grpd.homOf (map (eqToHom h)) := by
   subst h
-  fapply CategoryTheory.Functor.ext
-  · intro x
-    apply hext
-    · simp
-    · simp
-  · intro x y f
-    simp only [eqToHom_refl, Category.id_comp]
-    apply Hom.ext <;> simp
+  change 𝟭 (∫ F) = map (𝟙 F)
+  exact map_id_eq.symm
 
 -- TODO factor through Grothendieck
 theorem map_eqToHom_heq_id_dom {Γ : Type*} [Category Γ] {A A' : Γ ⥤ Grpd}
@@ -996,19 +942,22 @@ lemma fiber_eqToHom_comp_heq {Γ : Type*} [Category Γ]
     {F : Γ ⥤ Grpd} {x' x y : ∫ F} (h : x' = x) (f : x ⟶ y) :
     (eqToHom h ≫ f).fiber ≍ f.fiber := by
   subst h
-  simp [eqToHom_map]
+  simp only [eqToHom_refl]
+  rw [Category.id_comp]
 
 lemma fiber_eq_eqToHom_comp_heq {Γ : Type*} [Category Γ]
     {F : Γ ⥤ Grpd} {x' x y : ∫ F} (g : x' ⟶ x) (h : x' = x) (hg : g = eqToHom h)
     (f : x ⟶ y) : (eqToHom h ≫ f).fiber ≍ f.fiber := by
   subst h
-  simp [eqToHom_map]
+  simp only [eqToHom_refl]
+  rw [Category.id_comp]
 
 lemma fiber_comp_eqToHom_heq {Γ : Type*} [Category Γ]
     {F : Γ ⥤ Grpd} {x y y' : ∫ F} (h : y = y') (f : x ⟶ y) :
     (f ≫ eqToHom h).fiber ≍ f.fiber := by
   subst h
-  simp
+  simp only [eqToHom_refl]
+  rw [Category.comp_id]
 
 
 end
diff --git a/HoTTLean/Grothendieck/Groupoidal/IsPullback.lean b/HoTTLean/Grothendieck/Groupoidal/IsPullback.lean
index 20f2df7c..6a7f8e30 100644
--- a/HoTTLean/Grothendieck/Groupoidal/IsPullback.lean
+++ b/HoTTLean/Grothendieck/Groupoidal/IsPullback.lean
@@ -51,7 +51,7 @@ variable {Γ : Type u} [Category.{v} Γ] (A : Γ ⥤ Grpd.{v₁,u₁})
 -/
 def toPGrpd : ∫(A) ⥤ PGrpd.{v₁,u₁} :=
   PGrpd.functorTo (forget ⋙ A) (fun x => x.fiber) (fun f => f.fiber)
-    (by simp) (by simp [forget_map, Hom.base])
+    (by intro x; exact id_fiber x) (by intros; exact comp_fiber _ _)
 
 @[simp] theorem toPGrpd_obj_base (x) :
     ((toPGrpd A).obj x).base = A.obj x.base := rfl
@@ -71,6 +71,8 @@ theorem toPGrpd_forgetToGrpd : toPGrpd A ⋙ PGrpd.forgetToGrpd = forget ⋙ A :
 theorem toPGrpd_forgetToPCat : toPGrpd A ⋙ PGrpd.forgetToPCat = (Grothendieck.toPCat _) :=
   rfl
 
+-- The two Grothendieck domains use definitionally equal category instances.
+set_option backward.isDefEq.respectTransparency false in
 /--
 We also provide a definition of `toPGrpd` as the universal lift
 of the pullback `PGrpd`.
@@ -152,9 +154,7 @@ variable (A : Γ ⥤ Grpd.{v₁,u₁}) (α : Γ ⥤ PGrpd.{v₁,u₁}) (h : α 
 -/
 def sec : Γ ⥤ ∫(A) :=
   Groupoidal.functorTo (𝟭 _) (fun x => PGrpd.objFiber' h x) (fun f => PGrpd.mapFiber' h f)
-  (fun x => by simp) (fun f g => by
-    subst h
-    simp [PGrpd.mapFiber', PGrpd.mapFiber'EqToHom])
+  (fun _ => PGrpd.mapFiber'_id h) (fun f g => PGrpd.mapFiber'_comp' h f g)
 
 @[simp] lemma sec_obj_base (x) : ((sec A α h).obj x).base = x :=
   rfl
@@ -170,20 +170,16 @@ def sec : Γ ⥤ ∫(A) :=
     ((sec A α h).map f).fiber = PGrpd.mapFiber' h f :=
   rfl
 
-@[simp] def sec_toPGrpd : sec A α h ⋙ toPGrpd _ = α := by
+@[simp] theorem sec_toPGrpd : sec A α h ⋙ toPGrpd _ = α := by
   apply Grothendieck.FunctorTo.hext
   · rw [Functor.assoc, toPGrpd_forgetToGrpd, sec, ← Functor.assoc, h]
     rfl
   · intro x
-    simp [toPGrpd_obj_fiber, PGrpd.objFiber', PGrpd.objFiber, Grpd.eqToHom_obj,
-      PGrpd.objFiber'EqToHom]
+    exact PGrpd.objFiber'_heq h
   · intro x y f
-    simp only [Functor.comp_map, toPGrpd_map_fiber, sec_map_fiber, PGrpd.mapFiber',
-      Grpd.eqToHom_hom, PGrpd.mapFiber'EqToHom, PGrpd.objFiber'EqToHom]
-    rw! [eqToHom_comp_heq]
-    simp
+    exact PGrpd.mapFiber'_heq h f
 
-@[simp] def sec_forget : sec A α h ⋙ forget = 𝟭 _ :=
+@[simp] theorem sec_forget : sec A α h ⋙ forget = 𝟭 _ :=
   rfl
 
 theorem sec_eq_lift : sec A α h = (isPullback A).lift α (𝟭 _) (by simp [h, Functor.id_comp]) := by
diff --git a/HoTTLean/Grothendieck/IsPullback.lean b/HoTTLean/Grothendieck/IsPullback.lean
index 7b02d643..ebaf4e45 100644
--- a/HoTTLean/Grothendieck/IsPullback.lean
+++ b/HoTTLean/Grothendieck/IsPullback.lean
@@ -1,6 +1,6 @@
 import Mathlib.CategoryTheory.Limits.Yoneda
 import Mathlib.CategoryTheory.Limits.Preserves.Finite
-import Mathlib.CategoryTheory.Limits.Shapes.Pullback.CommSq
+import Mathlib.CategoryTheory.Limits.Shapes.Pullback.IsPullback.Basic
 
 import HoTTLean.Pointed.Basic
 import HoTTLean.ForMathlib
@@ -12,7 +12,7 @@ namespace CategoryTheory
 
 namespace Functor.Grothendieck
 
-open Functor.IsPullback
+open _root_.CategoryTheory.Functor.IsPullback
 
 section
 
@@ -21,9 +21,11 @@ variable {Γ : Type u} [Category.{v} Γ] {A : Γ ⥤ Cat.{v₁,u₁}}
 
 variable (A)
 
+-- The Grothendieck fiber equations reduce through bundled category morphisms.
+set_option backward.isDefEq.respectTransparency false in
 def toPCat : ∫ A ⥤ PCat.{v₁,u₁} :=
   functorTo (forget _ ⋙ A) (fun x => x.fiber) (fun f => f.fiber)
-    (by simp) (by intros; simp)
+    (by simp) (by intros; simp [forget])
 
 @[simp] theorem toPCat_obj_base (x) :
     ((toPCat A).obj x).base = A.obj x.base := by
@@ -43,7 +45,7 @@ def toPCat : ∫ A ⥤ PCat.{v₁,u₁} :=
 
 -- formerly duplicated as `toPCat_comp_forgetPoint` and `comm_sq`
 theorem toPCat_forgetToCat : toPCat A ⋙ PCat.forgetToCat
-  = Grothendieck.forget A ⋙ A :=
+    = Grothendieck.forget A ⋙ A :=
   rfl
 
 namespace IsPullback
@@ -56,34 +58,41 @@ variable {C : Type*} [Category C]
 abbrev pt (x : C) := (fst.obj x).fiber
 
 abbrev point {x y : C} (f : x ⟶ y) :
-    (fst.map f)⟱.obj (pt fst x) ⟶ pt fst y :=
+    (fst.map f)⟱.toFunctor.obj (pt fst x) ⟶ pt fst y :=
   (fst.map f).fiber
 
 variable {A} {fst} {snd}
 
 @[simp] def liftObjFiber (x : C) : A.obj (snd.obj x) :=
-  ((eqToHom w).app x).obj (pt fst x)
+  ((eqToHom w).app x).toFunctor.obj (pt fst x)
 
 variable {x y : C} (f : x ⟶ y)
 
-@[simp] def liftMapFiber : ((snd ⋙ A).map f).obj (liftObjFiber w x) ⟶ liftObjFiber w y :=
-  let m1 := ((eqToHom w).app y).map (point fst f)
-  let m2 := (eqToHom ((eqToHom w).naturality f).symm).app
+@[simp] def liftMapFiber : ((snd ⋙ A).map f).toFunctor.obj (liftObjFiber w x) ⟶ liftObjFiber w y :=
+  let m1 := ((eqToHom w).app y).toFunctor.map (point fst f)
+  let m2 := (eqToHom ((eqToHom w).naturality f).symm).toNatTrans.app
     (pt fst x)
   m2 ≫ m1
 
+-- The fiber transports reduce through bundled category morphisms.
+set_option backward.isDefEq.respectTransparency false in
 theorem liftMapFiber_id (x : C) : liftMapFiber w (𝟙 x) = eqToHom (by simp) := by
-  simp [eqToHom_map]
+  simp
+  rw [eqToHom_map]
+  simp
 
+-- As for the identity law, the fiber transport crosses bundled Cat morphisms.
+set_option backward.isDefEq.respectTransparency false in
 theorem liftMapFiber_comp {x y z} (f : x ⟶ y) (g : y ⟶ z) :
     liftMapFiber w (f ≫ g) =
     eqToHom (by simp)
-    ≫ (A.map (snd.map g)).map (liftMapFiber w f)
+    ≫ (A.map (snd.map g)).toFunctor.map (liftMapFiber w f)
     ≫ liftMapFiber w g := by
-  have hgNatNatF := (eqToHom ((eqToHom w).naturality g).symm).naturality (fst.map f).fiber
-  have h := congr_arg (λ x ↦ x ≫ ((eqToHom w).app z).map (fst.map g).fiber) hgNatNatF
+  have hgNatNatF :=
+    (eqToHom ((eqToHom w).naturality g).symm).toNatTrans.naturality (fst.map f).fiber
+  have h := congr_arg (λ x ↦ x ≫ ((eqToHom w).app z).toFunctor.map (fst.map g).fiber) hgNatNatF
   dsimp at h
-  simp only [Category.assoc, eqToHom_app ((eqToHom w).naturality g).symm] at h
+  simp only [Category.assoc, Cat.Hom₂.eqToHom_toNatTrans, eqToHom_app] at h
   simp [eqToHom_map, h]
 
 variable (fst) (snd)
@@ -100,27 +109,27 @@ def lift : C ⥤ Grothendieck A := functorTo snd
 
 @[simp] theorem lift_obj_fiber (x) :
     ((lift fst snd w).obj x).fiber = liftObjFiber w x := by
-  simp [lift]
+  rfl
 
 @[simp] theorem lift_map_base {x y} (f : x ⟶ y) :
     ((lift fst snd w).map f).base = snd.map f := by
-  simp [lift]
+  rfl
 
 @[simp] theorem lift_map_fiber {x y} (f : x ⟶ y) :
     ((lift fst snd w).map f).fiber = liftMapFiber w f := by
-  simp [lift]
+  rfl
 
 @[simp] theorem fac_right : lift fst snd w ⋙ Grothendieck.forget A = snd := by
-  apply CategoryTheory.Functor.ext
-  · simp
-  · simp
+  exact CategoryTheory.Functor.hext (fun _ => rfl) (fun _ _ _ => HEq.rfl)
 
+-- Match the bundled Cat projections in the fiber transport equations.
+set_option backward.isDefEq.respectTransparency false in
 @[simp] theorem fac_left : lift fst snd w ⋙ Grothendieck.toPCat A = fst := by
   apply CategoryTheory.Functor.ext
   · intro x y f
     apply Grothendieck.Hom.ext
     · simp [eqToHom_map, PCat.eqToHom_base_map,
-        Functor.congr_hom (eqToHom_app w y) (point fst f)]
+        Functor.congr_hom (congrArg Cat.Hom.toFunctor (eqToHom_app w y)) (point fst f)]
     · have h := Functor.congr_hom w f
       simp only [PCat.forgetToCat_map, Functor.comp_map] at h
       simp [h]
@@ -131,6 +140,8 @@ def lift : C ⥤ Grothendieck A := functorTo snd
     · simp [h]
     · simp [Cat.eqToHom_obj]
 
+-- Reduce the bundled fiber maps of identity transports.
+set_option backward.isDefEq.respectTransparency false in
 theorem lift_uniq (m : C ⥤ Grothendieck A)
     (hl : m ⋙ Grothendieck.toPCat A = fst)
     (hr : m ⋙ Grothendieck.forget A = snd) :
@@ -144,13 +155,12 @@ theorem hom_ext {m n : C ⥤ Grothendieck A}
     (hl : m ⋙ Grothendieck.toPCat A = n ⋙ Grothendieck.toPCat A)
     (hr : m ⋙ Grothendieck.forget A = n ⋙ Grothendieck.forget A) :
     m = n := by
-  rw [lift_uniq (m ⋙ toPCat A) (m ⋙ forget A) ?_ m rfl rfl,
-    lift_uniq (n ⋙ toPCat A) (n ⋙ forget A) ?_ n rfl rfl]
-  rw! [hl, hr]
-  . show n ⋙ (toPCat A ⋙ PCat.forgetToCat) = _
-    rw [toPCat_forgetToCat, Functor.assoc]
-  . show m ⋙ (toPCat A ⋙ PCat.forgetToCat) = _
-    rw [toPCat_forgetToCat, Functor.assoc]
+  have wm : (m ⋙ toPCat A) ⋙ PCat.forgetToCat = (m ⋙ forget A) ⋙ A := by
+    rw [Functor.assoc, toPCat_forgetToCat, Functor.assoc]
+  have wn : (n ⋙ toPCat A) ⋙ PCat.forgetToCat = (n ⋙ forget A) ⋙ A := by
+    rw [Functor.assoc, toPCat_forgetToCat, Functor.assoc]
+  rw [lift_uniq _ _ wm m rfl rfl, lift_uniq _ _ wn n rfl rfl]
+  congr 1
 
 def aux {C : Type*} [inst : Category C] (Cn : C ⥤ PCat) (Cw : C ⥤ Γ)
     (hC : Cn ⋙ forget (𝟭 Cat) = Cw ⋙ A) :
@@ -163,7 +173,7 @@ def aux {C : Type*} [inst : Category C] (Cn : C ⥤ PCat) (Cw : C ⥤ Γ)
 
 end IsPullback
 
-open IsPullback
+open _root_.CategoryTheory.Functor.Grothendieck.IsPullback
 
 /--
 The following square is a (meta-theoretic) pullback of functors
@@ -288,14 +298,16 @@ end
 --     (s.snd ⋙ downFunctor)
 --     condition'
 
--- theorem lift_uniq (s : PullbackCone uLiftPCatForgetToCat.{v,u} (uLiftA.{v,u} A)) (m : s.pt ⥤ Grothendieck A)
+-- theorem lift_uniq (s : PullbackCone uLiftPCatForgetToCat.{v,u}
+--     (uLiftA.{v,u} A)) (m : s.pt ⥤ Grothendieck A)
 --     (hl : m ⋙ Grothendieck.toPCat A = s.fst ⋙ downFunctor)
 --     (hr : m ⋙ Grothendieck.forget A = s.snd ⋙ downFunctor) :
 --     m = lift s :=
 --   IsMegaPullback.lift_uniq
 --     (s.fst ⋙ downFunctor) (s.snd ⋙ downFunctor) condition' m hl hr
 
--- theorem lift_uniq' (s : PullbackCone uLiftPCatForgetToCat.{v,u} (uLiftA.{v,u} A)) (m : s.pt ⟶ uLiftGrothendieck A)
+-- theorem lift_uniq' (s : PullbackCone uLiftPCatForgetToCat.{v,u}
+--     (uLiftA.{v,u} A)) (m : s.pt ⟶ uLiftGrothendieck A)
 --     (hl : m ≫ uLiftToPCat A = s.fst) (hr : m ≫ uLiftGrothendieckForget A = s.snd) :
 --     m = lift' s := by
 --   unfold lift'
diff --git a/HoTTLean/Groupoids/Basic.lean b/HoTTLean/Groupoids/Basic.lean
index c5dedf2c..cf77872e 100644
--- a/HoTTLean/Groupoids/Basic.lean
+++ b/HoTTLean/Groupoids/Basic.lean
@@ -21,28 +21,28 @@ namespace CategoryTheory.PGrpd
 def pGrpdToGroupoidalAsSmallFunctor : PGrpd.{v, v} ⥤
     ∫(Grpd.asSmallFunctor.{w, v, v}) :=
   Grothendieck.functorTo PGrpd.forgetToGrpd
-  (fun x => AsSmall.up.obj.{v, v, w} x.fiber)
-  (fun f => AsSmall.up.map f.fiber)
+  (fun x => ⟨x.fiber⟩)
+  (fun f => ⟨f.fiber⟩)
   (by aesop_cat)
   (by aesop_cat)
 
 def groupoidalAsSmallFunctorToPGrpd :
     ∫(Grpd.asSmallFunctor.{w, v, v}) ⥤ PGrpd.{v,v} :=
   PGrpd.functorTo Groupoidal.forget
-  (fun x => AsSmall.down.obj.{v, v, w} x.fiber)
+  (fun x => AsSmall.down.obj x.fiber)
   (fun f => AsSmall.down.map f.fiber)
   (by aesop_cat)
   (by aesop_cat)
 
-@[simp] def pGrpdToGroupoidalAsSmallFunctor_groupoidalAsSmallFunctorToPGrpd :
+@[simp] theorem pGrpdToGroupoidalAsSmallFunctor_groupoidalAsSmallFunctorToPGrpd :
     groupoidalAsSmallFunctorToPGrpd ⋙ pGrpdToGroupoidalAsSmallFunctor = 𝟭 _ :=
   rfl
 
-@[simp] def groupoidalAsSmallFunctorToPGrpd_pGrpdToGroupoidalAsSmallFunctor :
+@[simp] theorem groupoidalAsSmallFunctorToPGrpd_pGrpdToGroupoidalAsSmallFunctor :
     pGrpdToGroupoidalAsSmallFunctor ⋙ groupoidalAsSmallFunctorToPGrpd = 𝟭 _ :=
   rfl
 
-@[simp] def pGrpdToGroupoidalAsSmallFunctor_forget : pGrpdToGroupoidalAsSmallFunctor
+@[simp] theorem pGrpdToGroupoidalAsSmallFunctor_forget : pGrpdToGroupoidalAsSmallFunctor
     ⋙ Groupoidal.forget = PGrpd.forgetToGrpd :=
   rfl
 
@@ -100,6 +100,8 @@ theorem toCoreAsSmallEquiv_apply_comp_right (A : Γ ⥤ coreAsSmall C) (F : C 
     toCoreAsSmallEquiv (A ⋙ coreAsSmallFunctor F) = toCoreAsSmallEquiv A ⋙ F := by
   rfl
 
+-- Restore transparency for the bundled groupoid coercion in this rewrite.
+set_option backward.isDefEq.respectTransparency false in
 theorem toCoreAsSmallEquiv_symm_apply_comp_left (A : Γ ⥤ C) :
     toCoreAsSmallEquiv.symm (σ ⋙ A) = σ ⋙ toCoreAsSmallEquiv.symm A := by
   dsimp only [toCoreAsSmallEquiv, Equiv.symm_trans_apply, Equiv.symm_symm, Grpd.comp_eq_comp]
diff --git a/HoTTLean/Groupoids/ClovenIsofibration.lean b/HoTTLean/Groupoids/ClovenIsofibration.lean
index e78e16d8..8adc3d07 100644
--- a/HoTTLean/Groupoids/ClovenIsofibration.lean
+++ b/HoTTLean/Groupoids/ClovenIsofibration.lean
@@ -26,13 +26,12 @@ lemma functor_obj_fiberInclusion_obj (a : Fiber p S) :
 lemma functor_map_fiberInclusion_map {a b : Fiber p S}
     (f : a ⟶ b) :
     p.map (Fiber.fiberInclusion.map f) = eqToHom (by simp) := by
-  have H := f.2
-  simpa using IsHomLift.fac' p (𝟙 S) f.1
+  simp [IsHomLift.fac' p (𝟙 S) (Fiber.fiberInclusion.map f)]
 
 lemma hext {S'} (hS : S' ≍ S) {a : Fiber p S}
     {a' : Fiber p S'} (h : Fiber.fiberInclusion.obj a ≍ Fiber.fiberInclusion.obj a') : a ≍ a' := by
   subst hS
-  simpa using Subtype.ext h.eq
+  exact heq_of_eq (Subtype.ext h.eq)
 
 lemma hom_hext {S'} (hS : S' ≍ S) {a b : Fiber p S}
     {a' b' : Fiber p S'} (ha : a ≍ a') (hb : b ≍ b') {φ : a ⟶ b}
@@ -47,7 +46,13 @@ instance {X : Γ} : IsGroupoid (F.Fiber X) where
   all_isIso f := {
     out :=
     have := f.2
-    ⟨Fiber.homMk F _ (CategoryTheory.inv f.1), by cat_disch, by cat_disch⟩ }
+    ⟨Fiber.homMk F _ (CategoryTheory.inv f.1), by
+      apply Subtype.ext
+      change f.1 ≫ CategoryTheory.inv f.1 = 𝟙 _
+      simp, by
+      apply Subtype.ext
+      change CategoryTheory.inv f.1 ≫ f.1 = 𝟙 _
+      simp⟩ }
 
 instance {X : Γ} : Groupoid (F.Fiber X) := Groupoid.ofIsGroupoid
 
@@ -146,14 +151,17 @@ variable {Γ : Type u} {E : Type u} [Groupoid.{v} Γ] [Groupoid.{v} E] {F : E 
 def classifier.map.obj {X Y : Γ} (f : X ⟶ Y) (a : F.Fiber X) : F.Fiber Y :=
   ⟨I.liftObj f a.2, ClovenIsofibration.obj_liftObj ..⟩
 
+-- Fiber is a semireducible subtype; allow its projections to elaborate in this proof.
+set_option backward.isDefEq.respectTransparency false in
 def classifier.map.map  {X Y} (f: X ⟶ Y) {a b : F.Fiber X} (m : a ⟶ b) :
     map.obj I f a ⟶ map.obj I f b :=
   let i1 : a.1 ⟶ I.liftObj f a.2 := I.liftIso f a.2
   let i2 := I.liftIso f b.2
   let i := Groupoid.inv i1 ≫ Fiber.fiberInclusion.map m ≫ i2
   have e :𝟙 Y = eqToHom (by simp[obj_liftObj]) ≫
-     F.map (CategoryTheory.inv i1 ≫ Fiber.fiberInclusion.map m ≫ i2) ≫ eqToHom (by simp[obj_liftObj])
-     := by simp[i1, i2, Fiber.functor_map_fiberInclusion_map, Functor.map_inv,map_liftIso']
+      F.map (CategoryTheory.inv i1 ≫ Fiber.fiberInclusion.map m ≫ i2) ≫
+        eqToHom (by simp[obj_liftObj]) := by
+       simp [i1, i2, Fiber.functor_map_fiberInclusion_map, Functor.map_inv, map_liftIso']
   have : F.IsHomLift (𝟙 Y) i := by
     simp only[i, e]
     apply IsHomLift.of_fac _ _ _ (ClovenIsofibration.obj_liftObj ..)
@@ -162,16 +170,18 @@ def classifier.map.map  {X Y} (f: X ⟶ Y) {a b : F.Fiber X} (m : a ⟶ b) :
   Fiber.homMk F _ i
 
 lemma classifier.map.map_id {X Y} (f : X ⟶ Y) (a: F.Fiber X):
-  map.map I f (𝟙 a) = 𝟙 (map.obj I f a) := by
+    map.map I f (𝟙 a) = 𝟙 (map.obj I f a) := by
    ext
-   simp only [map, Fiber.fiberInclusion_homMk, Groupoid.inv_eq_inv, Functor.map_id,
-     IsIso.inv_comp_eq]
-   simp [Fiber.fiberInclusion, classifier.map.obj]
+   simp [map, Fiber.homMk, Fiber.fiberInclusion, classifier.map.obj]
+   rfl
 
+-- Allow fiber projections to reduce when simplifying the conjugated composite.
+set_option backward.isDefEq.respectTransparency false in
 lemma classifier.map.map_comp {X Y} (f: X ⟶ Y) {a b c: F.Fiber X} (m1 : a ⟶ b) (m2: b ⟶ c):
-  map.map I f (m1 ≫ m2) = map.map I f m1 ≫ map.map I f m2 := by
+    map.map I f (m1 ≫ m2) = map.map I f m1 ≫ map.map I f m2 := by
    ext
-   simp[classifier.map.map]
+   simp only [Functor.map_comp]
+   simp [classifier.map.map, Fiber.homMk, Fiber.fiberInclusion, Category.assoc]
 
 @[simps]
 def classifier.map {X Y} (f : X ⟶ Y) : F.Fiber X ⥤ F.Fiber Y where
@@ -182,6 +192,8 @@ def classifier.map {X Y} (f : X ⟶ Y) : F.Fiber X ⥤ F.Fiber Y where
 
 variable [IsSplit I]
 
+-- Fiber projections must unfold for the dependent functor extensionality proof.
+set_option backward.isDefEq.respectTransparency false in
 lemma classifier.map_id (X : Γ) : classifier.map I (𝟙 X) = 𝟙 (Grpd.of (F.Fiber X)) := by
   fapply Functor.ext
   · intro a
@@ -192,8 +204,10 @@ lemma classifier.map_id (X : Γ) : classifier.map I (𝟙 X) = 𝟙 (Grpd.of (F.
     ext
     simp [map.map, liftIso_id, eqToHom_map]
 
+-- Reduce fiber projections in the dependent composition proof.
+set_option backward.isDefEq.respectTransparency false in
 lemma classifier.map_comp {X Y Z: Γ} (f : X⟶ Y) (g : Y ⟶ Z):
- classifier.map I (f ≫ g) = classifier.map I f ⋙ classifier.map I g := by
+    classifier.map I (f ≫ g) = classifier.map I f ⋙ classifier.map I g := by
   fapply Functor.ext
   · intro a
     simp[map.obj, liftObj_comp]
@@ -215,7 +229,7 @@ def classifier : Γ ⥤ Grpd.{v,u} where
 @[simp]
 lemma fiberInclusion_obj_classifier_map_obj {x y} (f : x ⟶ y) (p) :
     Fiber.fiberInclusion.obj ((I.classifier.map f).obj p) = I.liftObj f p.2 := by
-  simp [classifier, classifier.map.obj, Fiber.fiberInclusion]
+  rfl
 
 open CategoryTheory.Functor.Groupoidal
 
@@ -223,10 +237,10 @@ def grothendieckClassifierIso.hom.obj (pair: ∫ I.classifier) : E := pair.fiber
 
 lemma grothendieckClassifierIso.hom.map_aux {X Y: Γ} (f: X ⟶ Y) (a: I.classifier.obj X) :
     (I.classifier.map f).obj a = ⟨I.liftObj (X' := a.1) f a.2, obj_liftObj ..⟩ := by
-  simp[classifier,classifier.map.obj]
+  rfl
 
 lemma grothendieckClassifierIso.hom.map_aux2
- (X: Γ) (a: I.classifier.obj X) : F.obj a.1 = X := by
+    (X: Γ) (a: I.classifier.obj X) : F.obj a.1 = X := by
   simp[classifier] at a
   simp[a.2]
 
@@ -241,15 +255,25 @@ def grothendieckClassifierIso.hom.map' {p1 p2: ∫ I.classifier} (h: p1 ⟶ p2)
   (eqToHom (by simp[grothendieckClassifierIso.hom.map_aux,Fiber.fiberInclusion] )) ≫
   Fiber.fiberInclusion.map h.fiber ≫ (eqToHom (by simp[Fiber.fiberInclusion] ))
 
+-- The fiber inclusion and classifier objects are definitionally equal at full transparency.
+set_option backward.isDefEq.respectTransparency false in
 lemma grothendieckClassifierIso.hom.map_id (X : ∫ I.classifier) :
     hom.map I (𝟙 X) = 𝟙 _ := by
-  convert_to _ ≫ _ ≫ Fiber.fiberInclusion.map (Hom.fiber (𝟙 X)) = _
-  simp [liftIso_id, eqToHom_map]
+  change I.liftIso (Hom.base (𝟙 X)) (hom.map_aux2 ..) ≫
+     eqToHom (by simp [liftObj_id, Fiber.fiberInclusion]) ≫
+       Fiber.fiberInclusion.map (Hom.fiber (𝟙 X)) = 𝟙 _
+  simp only [Groupoidal.id_base, liftIso_id, Groupoidal.id_fiber]
+  rw [eqToHom_map]
+  simp
 
+-- Reduce classifier and fiber projections in the dependent composition proof.
+set_option backward.isDefEq.respectTransparency false in
 lemma grothendieckClassifierIso.hom.map_comp {X Y Z: ∫ I.classifier} (f : X ⟶ Y) (g : Y ⟶ Z) :
     hom.map' I (f ≫ g) = hom.map' I f ≫ hom.map' I g := by
   simp [map', liftIso_comp, eqToHom_map, classifier, classifier.map.map]
 
+-- Reduce fiber projections in the naturality equation.
+set_option backward.isDefEq.respectTransparency false in
 @[simps!]
 def grothendieckClassifierIso.hom.hom {X Y} (f : X ⟶ Y) :
     Fiber.fiberInclusion ⟶ I.classifier.map f ⋙ Fiber.fiberInclusion where
@@ -258,6 +282,8 @@ def grothendieckClassifierIso.hom.hom {X Y} (f : X ⟶ Y) :
    intro a b g
    simp[Fiber.fiberInclusion,classifier,classifier.map.map,Fiber.homMk]
 
+-- Reduce dependent classifier and fiber projections in the functor laws.
+set_option backward.isDefEq.respectTransparency false in
 def grothendieckClassifierIso.hom : ∫ I.classifier ⥤ E :=
   Groupoidal.functorFrom (fun x => Fiber.fiberInclusion)
   (grothendieckClassifierIso.hom.hom I)
@@ -265,7 +291,7 @@ def grothendieckClassifierIso.hom : ∫ I.classifier ⥤ E :=
   (by intro X Y Z f g; ext; simp[hom.hom,liftIso_comp])
 
 def grothendieckClassifierIso.inv.fibMap {X Y}(f : X ⟶ Y) :
- ((F ⋙ I.classifier).map f).obj ⟨X,rfl⟩  ⟶ ⟨Y, rfl⟩  := by
+    ((F ⋙ I.classifier).map f).obj ⟨X,rfl⟩  ⟶ ⟨Y, rfl⟩  := by
   refine @Fiber.homMk _ _ _ _ F (F.obj Y) _ _ ?_ ?_
   · exact CategoryTheory.inv (I.liftIso (F.map f) rfl) ≫ f
   · simp
@@ -274,6 +300,8 @@ def grothendieckClassifierIso.inv.fibMap {X Y}(f : X ⟶ Y) :
     · rfl
     · simp[Functor.map_inv,ClovenIsofibration.map_liftIso']
 
+-- Reduce the bundled fiber projections in this dependent identity proof.
+set_option backward.isDefEq.respectTransparency false in
 lemma grothendieckClassifierIso.inv.fibMap_id (x : E) :
     inv.fibMap I (𝟙 x) = eqToHom (by simp) := by
   apply Fiber.hom_ext
@@ -281,6 +309,8 @@ lemma grothendieckClassifierIso.inv.fibMap_id (x : E) :
   rw![Functor.map_id,liftIso_id]
   simp[inv_eqToHom,eqToHom_map]
 
+-- Reduce the same bundled fiber projections in the composition law.
+set_option backward.isDefEq.respectTransparency false in
 lemma grothendieckClassifierIso.inv.fibMap_comp {x y z : E} (f : x ⟶ y) (g : y ⟶ z) :
     inv.fibMap I (f ≫ g) =
     eqToHom (by simp) ≫
@@ -290,13 +320,16 @@ lemma grothendieckClassifierIso.inv.fibMap_comp {x y z : E} (f : x ⟶ y) (g : y
   rw! [Functor.map_comp]
   simp [liftIso_comp, eqToHom_map,classifier,classifier.map.map]
 
+-- Reduce classifier and fiber projections while comparing functor maps.
+set_option backward.isDefEq.respectTransparency false in
 lemma ι_classifier_comp_forget {x} : ι I.classifier x ⋙ Groupoidal.forget =
     Fiber.fiberInclusion ⋙ F := by
   fapply Functor.ext
   · intro p
     exact p.2.symm
   · intro p q f
-    simpa using IsHomLift.fac ..
+    let : F.IsHomLift (𝟙 x) (Fiber.fiberInclusion.map f) := f.2
+    simpa using IsHomLift.fac F (𝟙 x) (Fiber.fiberInclusion.map f)
 
 @[simp]
 lemma liftObj_map_fiberInclusion_map {S} {X Y : Fiber F S} {X' : E} (f : X ⟶ Y)
@@ -304,6 +337,7 @@ lemma liftObj_map_fiberInclusion_map {S} {X Y : Fiber F S} {X' : E} (f : X ⟶ Y
     I.liftObj (F.map (Fiber.fiberInclusion.map f)) (X' := X') (by simp [hX'])
     = Fiber.fiberInclusion.obj X := by
   rw! [Fiber.functor_map_fiberInclusion_map, liftObj_eqToHom, hX']
+  rfl
 
 @[simp]
 lemma liftIso_map_fiberInclusion_map {S} {X Y : Fiber F S} {X' : E} (f : X ⟶ Y)
@@ -311,7 +345,10 @@ lemma liftIso_map_fiberInclusion_map {S} {X Y : Fiber F S} {X' : E} (f : X ⟶ Y
     I.liftIso (F.map (Fiber.fiberInclusion.map f)) (X' := X') (by simp [hX'])
     = eqToHom (by simp [hX']) := by
   rw! [Fiber.functor_map_fiberInclusion_map, liftIso_eqToHom]
+  rfl
 
+-- Reduce bundled fiber projections in the classifier isomorphism laws.
+set_option backward.isDefEq.respectTransparency false in
 open grothendieckClassifierIso in
 /-- A split isofibration `F : E ⥤ Γ` is classified by the functor `I.classifier : Γ ⥤ Grpd`.
 This means that the (groupoidal) Grothendieck construction on `I.classifier` is isomorphic to
@@ -348,7 +385,8 @@ def grothendieckClassifierIso : ∫ I.classifier ≅≅ E :=
     any_goals simp
     · rw! [map_liftIso', liftObj_comp _ _ _ rfl, liftObj_comp _ _ _ rfl]
       simp [liftObj_eqToHom]
-    · rw! [map_liftIso', liftIso_comp _ _ _ rfl, liftIso_comp _ _ _ rfl]
+    · simp only [hom.hom]
+      rw! (castMode := .all) [map_liftIso', liftIso_comp _ _ _ rfl, liftIso_comp _ _ _ rfl]
       simp only [liftIso_eqToHom, eqToHom_refl, eqToHom_trans, Category.id_comp, Category.assoc,
         IsIso.inv_comp, inv_eqToHom, eqToHom_comp_liftIso, IsIso.inv_hom_id_assoc]
       rw! [eqToHom_heq_id_cod]
@@ -382,7 +420,10 @@ def iso {A : Type u} [Category.{v} A] {B : Type u₁} [Category.{v₁} B] (F : A
    intro X Y f i X' hX'
    apply IsIso.comp_isIso
 
-instance {A : Type u} [Category.{v} A] {B : Type u₁} [Category.{v₁} B] (F : A ≅≅ B) : IsSplit (iso F) where
+-- The split laws simplify dependent transports through the semireducible `iso` definition.
+set_option backward.isDefEq.respectTransparency false in
+ instance {A : Type u} [Category.{v} A] {B : Type u₁} [Category.{v₁} B]
+     (F : A ≅≅ B) : IsSplit (iso F) where
   liftObj_id h := by simp [← h, ← Functor.comp_obj]
   liftIso_id := by simp
   liftObj_comp := by simp
@@ -400,12 +441,15 @@ def forget.liftIso {X Y: C} (f : X ⟶ Y) {X' : F.Groupoidal} (hX': Groupoidal.f
     X' ⟶ forget.liftObj f hX' :=
   Groupoidal.toTransport X' (eqToHom (by subst hX'; simp) ≫ f)
 
+-- Unfold the semireducible transport and forgetful functor in the lift equation.
+set_option backward.isDefEq.respectTransparency false in
 lemma forget.isHomLift {X Y: C} (f : X ⟶ Y) {X' : F.Groupoidal}
     (hX': Groupoidal.forget.obj X' = X) : Groupoidal.forget.IsHomLift f (forget.liftIso f hX') := by
-  apply IsHomLift.of_fac' (ha := hX') (hb := by simp[liftObj])
-  simp[liftIso]
+  subst X
+  apply IsHomLift.of_fac' (ha := rfl) (hb := by simp [liftObj])
+  simp [liftIso, Groupoidal.forget_map, Groupoidal.toTransport_base]
 
-def toTransport_IsIso (x : F.Groupoidal) {c : C} (t : x.base ⟶ c) :
+theorem toTransport_IsIso (x : F.Groupoidal) {c : C} (t : x.base ⟶ c) :
     IsIso (Groupoidal.toTransport x t) :=
   inferInstance
 
@@ -421,33 +465,31 @@ instance {X Y: C} (f : X ⟶ Y) [IsIso f] {X' : F.Groupoidal}
     (hX': Groupoidal.forget.obj X' = X) : IsIso (forget.liftIso f hX') := by
   apply toTransport_IsIso
 
-def forget.liftObj_id {X: C} {X' : F.Groupoidal} (hX': Groupoidal.forget.obj X' = X) :
+theorem forget.liftObj_id {X: C} {X' : F.Groupoidal} (hX': Groupoidal.forget.obj X' = X) :
     forget.liftObj (𝟙 X) hX' = X' := by
   simp [liftObj, Groupoidal.transport_eqToHom]
 
-def forget.liftIso_id {X: C} {X' : F.Groupoidal} (hX': Groupoidal.forget.obj X' = X) :
+-- The cast and transport equations require unfolding semireducible definitions.
+set_option backward.isDefEq.respectTransparency false in
+theorem forget.liftIso_id {X: C} {X' : F.Groupoidal} (hX': Groupoidal.forget.obj X' = X) :
     forget.liftIso (𝟙 X) hX' = eqToHom (by simp [forget.liftObj_id]) := by
   dsimp [liftIso]
   rw! (castMode :=.all)[Category.comp_id]
-  simp only [Groupoidal.toTransport_eqToHom, ← heq_eq_eq, eqRec_heq_iff_heq]
+  simp only [Groupoidal.toTransport_eqToHom, ← heq_eq_eq, eqRec_heq_iff]
   congr!
 
+-- Unfold transport projections when simplifying dependent casts.
+set_option backward.isDefEq.respectTransparency false in
 lemma forget.liftObj_comp {X Y Z: C} (f : X ⟶ Y) (g : Y ⟶ Z)
     {X' : F.Groupoidal} (hX' : X'.base = X)
     {Y' : F.Groupoidal} (hY' : forget.liftObj f hX' = Y') :
     forget.liftObj (f ≫ g) hX' = forget.liftObj g (liftObj_comp_aux (forget F) f hX' Y' hY') := by
-  simp only [liftObj,Groupoidal.transport_comp]
-  simp only [Groupoidal.transport, Grothendieck.transport, comp_obj, comp_map]
-  fapply Grothendieck.ext
-  · simp
-  simp only [Grpd.forgetToCat, Cat.of_α, id_eq, comp_obj, eqToHom_refl, comp_map, map_id,
-    Grpd.id_eq_id, id_obj]
-  congr!
-  simp only [← comp_obj,← Grpd.comp_eq_comp,← Functor.map_comp]
-  rw! [eqToHom_map]
-  subst hY'
-  simp [liftObj,Groupoidal.transport]
+  subst hX' hY'
+  simp [liftObj, Groupoidal.transport, Grothendieck.transport, Functor.map_comp,
+    Grpd.comp_eq_comp, Grpd.forgetToCat]
 
+-- Unfold transport projections when rewriting dependent casts.
+set_option backward.isDefEq.respectTransparency false in
 lemma forget.liftIso_comp {X Y Z: C} (f : X ⟶ Y) (g : Y ⟶ Z) {X' : F.Groupoidal}
     (hX' : X'.base = X) {Y' : F.Groupoidal} (hY' : forget.liftObj f hX' = Y') :
     forget.liftIso (f ≫ g) hX' = forget.liftIso f hX' ≫ eqToHom hY' ≫
@@ -497,16 +539,13 @@ def comp.liftIso {X Y: C} (f: X ⟶ Y) [IsIso f] {X': A} (hX': (F ⋙ G).obj X'
   let f1 := IG.liftIso (X' := F.obj X') f (by simp at hX'; assumption)
   IF.liftIso (X' := X') f1 rfl
 
+-- The composite lift contains dependent projections that must unfold during unification.
+set_option backward.isDefEq.respectTransparency false in
 lemma comp.isHomLift {X Y: C} (f: X ⟶ Y) [IsIso f] {X': A} (hX': (F ⋙ G).obj X' = X) :
     (F ⋙ G).IsHomLift f (comp.liftIso IF IG f hX') := by
-  apply IsHomLift.of_fac
-  · let e := ClovenIsofibration.map_liftIso' (F := F)
-    simp only [comp_obj, liftIso, comp_map, e, eqToHom_refl, Category.id_comp, map_comp,
-      map_liftIso', eqToHom_map, Category.assoc, eqToHom_trans, eqToHom_trans_assoc]
-    rw![liftObj]
-    simp
-  · assumption
-  · simp [liftObj,ClovenIsofibration.obj_liftObj]
+  refine IsHomLift.of_fac (F ⋙ G) f (comp.liftIso IF IG f hX') hX'
+    (comp.obj_liftObj IF IG f hX') ?_
+  simp [comp.liftIso, comp.liftObj, map_liftIso', eqToHom_map, Category.assoc]
 
 /-- `IsMultiplicative` 1/2 -/
 @[simps!]
@@ -534,9 +573,13 @@ lemma comp.liftIso_id {X : C} {X' : A} (hX' : (F ⋙ G).obj X' = X) :
     comp.liftIso IF IG (𝟙 X) hX' = eqToHom (by simp[comp.liftObj_id]) := by
   dsimp [comp.liftIso]
   rw! (castMode := .all) [IsSplit.liftIso_id]
-  simp only [liftIso_eqToHom, ← heq_eq_eq, eqRec_heq_iff_heq]
+  simp only [liftIso_eqToHom]
+  apply eq_of_heq
+  apply (eqRec_heq_iff).2
   apply HEq.trans (eqToHom_heq_id_dom _ _ _) (eqToHom_heq_id_dom _ _ _).symm
 
+-- The congruence proof compares dependent lifts after unfolding the composite.
+set_option backward.isDefEq.respectTransparency false in
 lemma comp.liftObj_comp {X Y Z : C} (f : X ⟶ Y) [IsIso f] (g : Y ⟶ Z) [IsIso g] {X' : A}
     (hX' : (F ⋙ G).obj X' = X) :
     comp.liftObj IF IG (f ≫ g) hX' =
@@ -547,6 +590,8 @@ lemma comp.liftObj_comp {X Y Z : C} (f : X ⟶ Y) [IsIso f] (g : Y ⟶ Z) [IsIso
   congr!
   simp
 
+-- The dependent rewrite compares casts whose definitions need semireducible unfolding.
+set_option backward.isDefEq.respectTransparency false in
 lemma comp.liftIso_comp {X Y Z : C} (f : X ⟶ Y) [IsIso f] (g : Y ⟶ Z) [IsIso g] {X' : A}
     (hX' : (F ⋙ G).obj X' = X) (Y' : A)
     (hY' : comp.liftObj IF IG f hX' = Y') :
@@ -652,8 +697,10 @@ def tpClovenIsofibration : (GroupoidModel.U.{u}.tp).ClovenIsofibration :=
   isoComp (Functor.ClovenIsofibration.forget _) i
   _ (Functor.IsPullback.isoIsPullback.hom_comp_right ..).symm
 
+-- Instance search must unfold the functor data to match the split iso-composite.
+set_option backward.isDefEq.respectTransparency false in
 instance : IsSplit tpClovenIsofibration := by
-  dsimp [tpClovenIsofibration]
+  dsimp only [tpClovenIsofibration]
   infer_instance
 
 end GroupoidModel
diff --git a/HoTTLean/Groupoids/Id.lean b/HoTTLean/Groupoids/Id.lean
index 6b418552..70a0e2a2 100644
--- a/HoTTLean/Groupoids/Id.lean
+++ b/HoTTLean/Groupoids/Id.lean
@@ -31,35 +31,21 @@ lemma IdMap_id (X : Γ) : IdMap a0_tp a1_tp (𝟙 X) = 𝟙 (IdObj a0_tp a1_tp X
   intro g
   apply Discrete.ext
   simp [IdMap]
+  rfl
 
 lemma IdMap_comp {X Y Z : Γ} (f1 : X ⟶ Y) (f2 : Y ⟶ Z) : IdMap a0_tp a1_tp (f1 ≫ f2) =
     IdMap a0_tp a1_tp f1 ⋙ IdMap a0_tp a1_tp f2 := by
-  subst a0_tp
   apply Discrete.functor_ext
   intro g
   apply Discrete.ext
-  simp only [Functor.comp_obj, Functor.Grothendieck.forget_obj, PGrpd.objFiber'_rfl, IdMap,
-    Functor.comp_map, Functor.Grothendieck.forget_map, PGrpd.mapFiber'_rfl,
-    Discrete.functor_obj_eq_as, Functor.map_comp, Functor.map_inv,
-    Category.assoc, IsIso.eq_inv_comp]
-  simp only [PGrpd.mapFiber, PGrpd.map_comp_fiber, Functor.Grothendieck.forget_obj,
-    Functor.Grothendieck.forget_map, ← Category.assoc, IsIso.inv_comp, inv_eqToHom,
-    PGrpd.mapFiber', Functor.comp_obj, Functor.comp_map, PGrpd.objFiber'EqToHom,
-    PGrpd.mapFiber'EqToHom, Functor.map_comp, eqToHom_map, eqToHom_trans, IsIso.hom_inv_id,
-    Category.id_comp, Functor.Grothendieck.Hom.comp_base, Grpd.comp_eq_comp, eqToHom_naturality,
-    Category.comp_id, ← heq_eq_eq]
-  congr 1
-  rw! [Functor.map_comp]
-  simp only [Functor.Grothendieck.Hom.comp_base, Grpd.comp_eq_comp, Functor.comp_obj,
-    eqToHom_refl, Functor.comp_map, Category.id_comp, Category.assoc, ← heq_eq_eq]
-  congr 1
-  have h := Functor.congr_hom a1_tp f2
-  simp only [Functor.comp_obj, Functor.Grothendieck.forget_obj, Functor.comp_map,
-    Functor.Grothendieck.forget_map, Grpd.comp_eq_comp] at h
-  rw! [h]
-  simp only [← Grpd.comp_eq_comp, Grpd.comp_obj, ← Functor.comp_map, ← heq_eq_eq,
-    heq_eqToHom_comp_iff, heq_comp_eqToHom_iff, eqToHom_comp_heq_iff]
-  simp [Grpd.eqToHom_hom]
+  change inv (PGrpd.mapFiber' a0_tp (f1 ≫ f2)) ≫ (A.map (f1 ≫ f2)).map g ≫
+      PGrpd.mapFiber' a1_tp (f1 ≫ f2) =
+    inv (PGrpd.mapFiber' a0_tp f2) ≫
+      (A.map f2).map (inv (PGrpd.mapFiber' a0_tp f1) ≫ (A.map f1).map g ≫
+        PGrpd.mapFiber' a1_tp f1) ≫ PGrpd.mapFiber' a1_tp f2
+  simp only [PGrpd.mapFiber'_comp', Grpd.map_comp_map, Functor.map_comp,
+    Functor.map_inv, IsIso.inv_comp, inv_eqToHom, Category.assoc]
+  simp only [← Category.assoc, eqToHom_trans, eqToHom_refl, Category.id_comp]
 
 @[simps!]
 def Id : Γ ⥤ Grpd where
@@ -97,16 +83,20 @@ variable {p} (p_tp : p ⋙ PGrpd.forgetToGrpd = snd _ _ ⋙ A)
 include p_tp in
 @[simp]
 lemma path0_comp_forgetToGrpd : path0 p ⋙ PGrpd.forgetToGrpd = A := by
-  rw [Functor.assoc, p_tp, ← Functor.assoc, sectR_comp_snd, Functor.id_comp]
+  rw [Functor.assoc, p_tp]
+  rfl
 
 include p_tp in
 @[simp]
 lemma path1_comp_forgetToGrpd : path1 p ⋙ PGrpd.forgetToGrpd = A := by
-  rw [Functor.assoc, p_tp, ← Functor.assoc, sectR_comp_snd, Functor.id_comp]
+  rw [Functor.assoc, p_tp]
+  rfl
 
 lemma objFiber'_path0 (x) : PGrpd.objFiber' (path0_comp_forgetToGrpd p_tp) x =
     PGrpd.objFiber' p_tp (ff x) := by
-  dsimp [PGrpd.objFiber', PGrpd.objFiber]
+  apply heq_iff_eq.mp
+  exact HEq.trans (PGrpd.objFiber'_heq (path0_comp_forgetToGrpd p_tp))
+    (HEq.symm (PGrpd.objFiber'_heq p_tp))
 
 @[simp]
 abbrev pathId : Γ ⥤ Grpd :=
@@ -122,10 +112,13 @@ lemma pathFibObj_comp (x : Δ) : pathFibObj (A := σ ⋙ A) (p := Functor.prod (
     (by simp [Functor.assoc, p_tp]; rfl) x = pathFibObj p_tp (σ.obj x) := by
   apply Discrete.ext
   simp only [Functor.comp_obj, pathFibObj_as, Functor.comp_map, PGrpd.mapFiber', snd_obj, snd_map,
-    Functor.prod_obj, Functor.id_obj, Functor.Grothendieck.forget_obj, PGrpd.objFiber'EqToHom,
-    Functor.prod_map, Functor.id_map, PGrpd.mapFiber'EqToHom, Grpd.eqToHom_hom, eqToHom_trans_assoc]
+    Functor.prod_obj, PGrpd.objFiber'EqToHom,
+    Functor.prod_map, PGrpd.mapFiber'EqToHom]
   rw! [CategoryTheory.Functor.map_id]
+  rfl
 
+-- The path proof unfolds bundled groupoid coercions during dependent simplification.
+set_option backward.isDefEq.respectTransparency false in
 lemma IdMap_path {x y} (f : x ⟶ y) :
     ((IdMap (path0_comp_forgetToGrpd p_tp) (path1_comp_forgetToGrpd p_tp) f).obj
       (pathFibObj p_tp x)).as = (pathFibObj p_tp y).as := by
@@ -136,16 +129,20 @@ lemma IdMap_path {x y} (f : x ⟶ y) :
   simp only [Functor.comp_obj, snd_obj, prod_comp, Functor.comp_map, snd_map, Grpd.map_id_map,
     Category.assoc, eqToHom_trans_assoc, ← heq_eq_eq, heq_eqToHom_comp_iff,
     eqToHom_comp_heq_iff] at h1
-  simp only [PGrpd.mapFiber'_naturality p_tp (sectR ⟨⟨.false⟩⟩ _), sectR_obj, sectR_map,
-    Functor.map_comp, eqToHom_map, PGrpd.mapFiber'_naturality p_tp (sectR ⟨⟨.true⟩⟩ _),
-    Category.assoc, IsIso.inv_comp_eq]
+  simp only [PGrpd.mapFiber'_naturality p_tp (sectR ⟨⟨.false⟩⟩ _),
+      PGrpd.mapFiber'_naturality p_tp (sectR ⟨⟨.true⟩⟩ _),
+     IsIso.inv_comp_eq]
+  simp only [pathFibObj_as, Functor.map_comp, eqToHom_map, Category.assoc]
+  change eqToHom _ ≫ ((A.map f).map (PGrpd.mapFiber' p_tp (ft x)) ≫
+    PGrpd.mapFiber' p_tp (ttm f)) =
+    PGrpd.mapFiber' p_tp (ffm f) ≫ eqToHom _ ≫ PGrpd.mapFiber' p_tp (ft y)
   rw! [h1]
   simp
 
 def pathFibMap {x y : Γ} (f : x ⟶ y) :
     (IdMap (path0_comp_forgetToGrpd p_tp) (path1_comp_forgetToGrpd p_tp) f).obj
     (pathFibObj p_tp x) ⟶ pathFibObj p_tp y :=
-  ⟨⟨IdMap_path ..⟩⟩
+  ⟨IdMap_path ..⟩
 
 lemma pathFibMap_id (x : Γ) : pathFibMap p_tp (𝟙 x) = eqToHom (by simp [IdMap_id]) := by
   aesop_cat
@@ -158,7 +155,7 @@ lemma pathFibMap_comp {x y z : Γ} (f1 : x ⟶ y) (f2 : y ⟶ z) :
 
 def path : Γ ⥤ PGrpd :=
   PGrpd.functorTo (pathId p_tp) (pathFibObj p_tp) (pathFibMap p_tp)
-    (pathFibMap_id p_tp) (fun f1 f2 => by dsimp only; aesop_cat)
+    (pathFibMap_id p_tp) (fun f1 f2 => by aesop_cat)
 
 lemma path_comp : path (A := σ ⋙ A) (p := Functor.prod (𝟭 _) σ ⋙ p)
     (by simp [Functor.assoc, p_tp]; rfl) = σ ⋙ path p_tp := by
@@ -166,21 +163,19 @@ lemma path_comp : path (A := σ ⋙ A) (p := Functor.prod (𝟭 _) σ ⋙ p)
   apply PGrpd.Functor.hext
   · rfl
   · intro x
-    simp only [path, Functor.comp_obj, heq_eq_eq]
-    -- rw [PGrpd.functorTo_obj_fiber] --FIXME why timeout?
-    convert_to pathFibObj (A := σ ⋙ A) (p := Functor.prod (𝟭 _) σ ⋙ p)
-      (by simp [Functor.assoc, p_tp]; rfl) x =
-      pathFibObj (A := A) (p := p) p_tp (σ.obj x)
-    rw [pathFibObj_comp]
+    dsimp only [path, Functor.comp_obj]
+    apply HEq.trans (heq_of_eq (PGrpd.functorTo_obj_fiber _ _ _ _ (pathFibMap_comp _) _))
+    apply HEq.trans _ (heq_of_eq (PGrpd.functorTo_obj_fiber _ _ _ _ (pathFibMap_comp _) _).symm)
+    exact heq_of_eq (pathFibObj_comp σ p_tp x)
   · intro x y f
-    simp only [path, Functor.comp_map]
-    -- rw [PGrpd.functorTo_map_fiber]
-    convert_to pathFibMap (A := σ ⋙ A) (p := Functor.prod (𝟭 _) σ ⋙ p)
-      (by simp [Functor.assoc, p_tp]; rfl) f ≍
-      pathFibMap (A := A) (p := p) p_tp (σ.map f)
-    rw! (castMode := .all) [pathFibObj_comp _ p_tp]
-    rw! (castMode := .all) [pathFibObj_comp _ p_tp]
-    rfl
+    dsimp only [path, Functor.comp_map]
+    apply HEq.trans (heq_of_eq (PGrpd.functorTo_map_fiber _ _ _ _ (pathFibMap_comp _) _))
+    apply HEq.trans _ (heq_of_eq (PGrpd.functorTo_map_fiber _ _ _ _ (pathFibMap_comp _) _).symm)
+    apply Discrete.Hom.hext
+    · rfl
+    · rw! [pathFibObj_comp σ p_tp x]
+      rfl
+    · exact heq_of_eq (pathFibObj_comp σ p_tp y)
 
 @[simp]
 lemma path_comp_forgetToGrpd : path p_tp ⋙ PGrpd.forgetToGrpd =
@@ -196,26 +191,31 @@ variable {p : Γ ⥤ PGrpd}
   (p_tp : p ⋙ PGrpd.forgetToGrpd = FunctorOperation.Id a0_tp a1_tp)
 
 def unpathFibObj : (x : Grpd.Interval × Γ) → A.obj x.2
-| ⟨⟨⟨.false⟩⟩, x2⟩ => PGrpd.objFiber' a0_tp x2
-| ⟨⟨⟨.true⟩⟩, x2⟩ => PGrpd.objFiber' a1_tp x2
+  | ⟨⟨⟨.false⟩⟩, x2⟩ => PGrpd.objFiber' a0_tp x2
+  | ⟨⟨⟨.true⟩⟩, x2⟩ => PGrpd.objFiber' a1_tp x2
 
+-- The inverse uses the groupoid structure through the bundled fiber coercion.
+set_option backward.isDefEq.respectTransparency false in
 def unpathFibMap : {x y : Grpd.Interval × Γ} → (f : x ⟶ y) →
     ((A.map f.2).obj (unpathFibObj a0_tp a1_tp x) ⟶ unpathFibObj a0_tp a1_tp y)
-| ⟨⟨⟨.false⟩⟩, _⟩, ⟨⟨⟨.false⟩⟩, _⟩, f => PGrpd.mapFiber' a0_tp f.2
-| ⟨⟨⟨.false⟩⟩, _⟩, ⟨⟨⟨.true⟩⟩, y2⟩, f => (PGrpd.mapFiber' a0_tp f.2) ≫ (PGrpd.objFiber' p_tp y2).1
-| ⟨⟨⟨.true⟩⟩, _⟩, ⟨⟨⟨.false⟩⟩, y2⟩, f =>
-  (PGrpd.mapFiber' a1_tp f.2) ≫ inv (PGrpd.objFiber' p_tp y2).1
-| ⟨⟨⟨.true⟩⟩, _⟩, ⟨⟨⟨.true⟩⟩, _⟩, f => PGrpd.mapFiber' a1_tp f.2
+  | ⟨⟨⟨.false⟩⟩, _⟩, ⟨⟨⟨.false⟩⟩, _⟩, f => PGrpd.mapFiber' a0_tp f.2
+  | ⟨⟨⟨.false⟩⟩, _⟩, ⟨⟨⟨.true⟩⟩, y2⟩, f => (PGrpd.mapFiber' a0_tp f.2) ≫ (PGrpd.objFiber' p_tp y2).1
+  | ⟨⟨⟨.true⟩⟩, _⟩, ⟨⟨⟨.false⟩⟩, y2⟩, f =>
+    (PGrpd.mapFiber' a1_tp f.2) ≫ inv (PGrpd.objFiber' p_tp y2).1
+  | ⟨⟨⟨.true⟩⟩, _⟩, ⟨⟨⟨.true⟩⟩, _⟩, f => PGrpd.mapFiber' a1_tp f.2
 
 lemma unpathFibMap_id (x : Grpd.Interval × Γ) : unpathFibMap a0_tp a1_tp p_tp (𝟙 x) =
     eqToHom (by simp) := by
-  rcases x with ⟨⟨⟨_|_⟩⟩ , x⟩ <;> simp [unpathFibMap]
+  rcases x with ⟨⟨⟨_|_⟩⟩ , x⟩ <;> simp [unpathFibMap] <;> rfl
 
 open PGrpd in
 lemma map_objFiber'_mapFiber' {x y} (f : x ⟶ y) :
     (A.map f).map (objFiber' p_tp x).as ≫ mapFiber' a1_tp f =
     mapFiber' a0_tp f ≫ (objFiber' p_tp y).as := by
-  simpa using (mapFiber' p_tp f).1.1
+  have h := (mapFiber' p_tp f).eq
+  change inv (mapFiber' a0_tp f) ≫ (A.map f).map (objFiber' p_tp x).as ≫
+    mapFiber' a1_tp f = (objFiber' p_tp y).as at h
+  simpa [IsIso.inv_comp_eq] using h
 
 open PGrpd in
 lemma map_objFiber'_mapFiber'_inv_objFiber' {x y} (f : x ⟶ y) :
@@ -231,6 +231,8 @@ lemma mapFiber'_inv_objFiber' {x y} (f : x ⟶ y) : mapFiber' a1_tp f ≫ inv (o
   slice_lhs 1 2 => rw [map_objFiber'_mapFiber']
   simp
 
+-- The bundled groupoid coercion requires unfolding while rewriting inverses.
+set_option backward.isDefEq.respectTransparency false in
 attribute [simp] unpathFibMap unpathFibObj PGrpd.mapFiber'_comp' Grpd.forgetToCat in
 lemma unpathFibMap_comp {x y z : Grpd.Interval × Γ} (f : x ⟶ y) (g : y ⟶ z) :
     unpathFibMap a0_tp a1_tp p_tp (f ≫ g) =
@@ -259,62 +261,66 @@ def unpath : Grpd.Interval × Γ ⥤ PGrpd :=
 lemma unpath_comp_forgetToGrpd : unpath a0_tp a1_tp p_tp ⋙ PGrpd.forgetToGrpd = snd _ _ ⋙ A := by
   rfl
 
+-- Unfold bundled functor projections when comparing dependent fibers.
+set_option backward.isDefEq.respectTransparency false in
 @[simp]
 lemma sectR_false_comp_unpath : sectR ⟨⟨.false⟩⟩ _ ⋙ unpath a0_tp a1_tp p_tp = a0 := by
   apply Functor.Grothendieck.FunctorTo.hext
-  · rw [Functor.assoc, unpath, Functor.Grothendieck.functorTo_forget, ← Functor.assoc,
-      sectR_comp_snd, a0_tp, Functor.id_comp]
+  · change (sectR ⟨⟨.false⟩⟩ _ ⋙ unpath a0_tp a1_tp p_tp) ⋙ PGrpd.forgetToGrpd = _
+    rw [Functor.assoc, unpath_comp_forgetToGrpd, ← Functor.assoc,
+      sectR_comp_snd, Functor.id_comp, a0_tp]
   · intro x
-    simp [unpath, PGrpd.objFiber', PGrpd.objFiber, Grpd.eqToHom_obj]
+    change HEq (PGrpd.objFiber' a0_tp x) (a0.obj x).fiber
+    exact PGrpd.objFiber'_heq a0_tp
   · intro x y f
-    simp [unpath, PGrpd.mapFiber', PGrpd.mapFiber'EqToHom, Grpd.eqToHom_hom]
-    apply HEq.trans (eqToHom_comp_heq _ _)
-    simp
+    change HEq (PGrpd.mapFiber' a0_tp f) (a0.map f).fiber
+    exact PGrpd.mapFiber'_heq a0_tp f
 
+-- Unfold bundled functor projections when comparing dependent fibers.
+set_option backward.isDefEq.respectTransparency false in
 @[simp]
 lemma sectR_true_comp_unpath : sectR ⟨⟨.true⟩⟩ _ ⋙ unpath a0_tp a1_tp p_tp = a1 := by
   apply Functor.Grothendieck.FunctorTo.hext
-  · rw [Functor.assoc, unpath, Functor.Grothendieck.functorTo_forget, ← Functor.assoc,
-      sectR_comp_snd, a1_tp, Functor.id_comp]
+  · change (sectR ⟨⟨.true⟩⟩ _ ⋙ unpath a0_tp a1_tp p_tp) ⋙ PGrpd.forgetToGrpd = _
+    rw [Functor.assoc, unpath_comp_forgetToGrpd, ← Functor.assoc,
+      sectR_comp_snd, Functor.id_comp, a1_tp]
   · intro x
-    simp [unpath, PGrpd.objFiber', PGrpd.objFiber, Grpd.eqToHom_obj]
+    change HEq (PGrpd.objFiber' a1_tp x) (a1.obj x).fiber
+    exact PGrpd.objFiber'_heq a1_tp
   · intro x y f
-    simp [unpath, PGrpd.mapFiber', PGrpd.mapFiber'EqToHom, Grpd.eqToHom_hom]
-    apply HEq.trans (eqToHom_comp_heq _ _)
-    simp
+    change HEq (PGrpd.mapFiber' a1_tp f) (a1.map f).fiber
+    exact PGrpd.mapFiber'_heq a1_tp f
 
 lemma path0_unpath : path0 (unpath a0_tp a1_tp p_tp) = a0 := by
-  apply Functor.Grothendieck.FunctorTo.hext
-  · simp
-  · intro x
-    simpa [unpath] using PGrpd.objFiber'_heq a0_tp
-  · intro x y f
-    simpa [unpath] using PGrpd.mapFiber'_heq a0_tp f
+  exact sectR_false_comp_unpath a0_tp a1_tp p_tp
 
 lemma path1_unpath : path1 (unpath a0_tp a1_tp p_tp) = a1 := by
-  apply Functor.Grothendieck.FunctorTo.hext
-  · simp
-  · intro x
-    simpa [unpath] using PGrpd.objFiber'_heq a1_tp
-  · intro x y f
-    simpa [unpath] using PGrpd.mapFiber'_heq a1_tp f
+  exact sectR_true_comp_unpath a0_tp a1_tp p_tp
 
+-- Allow unfolding bundled functor projections in dependent fiber simplification.
+set_option backward.isDefEq.respectTransparency false in
 lemma pathFibObj_unpath (x) : pathFibObj (unpath_comp_forgetToGrpd a0_tp a1_tp p_tp) x =
     PGrpd.objFiber' p_tp x := by
   dsimp only [pathFibObj]
   apply Discrete.ext
   simp [PGrpd.mapFiber, unpath]
 
+-- Unfold bundled functor projections for the dependent fiber equality.
+set_option backward.isDefEq.respectTransparency false in
 lemma mapFiber_unpath_ft (x) : PGrpd.mapFiber (unpath a0_tp a1_tp p_tp) (ft x) =
     eqToHom (by simp [PGrpd.mapObjFiber, unpath, PGrpd.objFiber]) ≫
     (PGrpd.objFiber' p_tp x).as := by
   dsimp [unpath, PGrpd.mapFiber]
   simp
 
+-- Unfold bundled functor projections in the dependent fiber comparison.
+set_option backward.isDefEq.respectTransparency false in
 lemma path_unpath : path (A := A) (unpath_comp_forgetToGrpd a0_tp a1_tp p_tp) = p := by
   apply Functor.Grothendieck.FunctorTo.hext
   · rw [path_comp_forgetToGrpd, p_tp]
-    rw! [path0_unpath, path1_unpath]
+    congr 1
+    · exact path0_unpath ..
+    · exact path1_unpath ..
   · intro x
     exact heq_of_eq_of_heq (pathFibObj_unpath ..) (PGrpd.objFiber'_heq p_tp)
   · intro x y f
@@ -338,59 +344,59 @@ variable {p : Grpd.Interval × Γ ⥤ PGrpd} (p_tp : p ⋙ PGrpd.forgetToGrpd =
 
 include δ0_p p_tp in
 lemma a0_comp_forgetToGrpd : a0 ⋙ PGrpd.forgetToGrpd = A := by
-  rw [← δ0_p, path0, Functor.assoc, p_tp, ← Functor.assoc, sectR_comp_snd, Functor.id_comp]
+  rw [← δ0_p]
+  exact path0_comp_forgetToGrpd p_tp
 
 include δ1_p p_tp in
 lemma a1_comp_forgetToGrpd : a1 ⋙ PGrpd.forgetToGrpd = A := by
-  rw [← δ1_p, path1, Functor.assoc, p_tp, ← Functor.assoc, sectR_comp_snd, Functor.id_comp]
+  rw [← δ1_p]
+  exact path1_comp_forgetToGrpd p_tp
 
 lemma obj_ff_fiber (x) : (p.obj (ff x)).fiber ≍
     PGrpd.objFiber' (a0_comp_forgetToGrpd p_tp δ0_p) x := by
   symm
   convert PGrpd.objFiber'_heq (path0_comp_forgetToGrpd p_tp) (x := x)
   rw [← δ0_p]
+  all_goals rfl
 
 lemma obj_tt_fiber (x) : (p.obj (tt x)).fiber ≍
     PGrpd.objFiber' (a1_comp_forgetToGrpd p_tp δ1_p) x := by
   symm
   convert PGrpd.objFiber'_heq (path1_comp_forgetToGrpd p_tp) (x := x)
   rw [← δ1_p]
+  all_goals rfl
 
 lemma map_ff_fiber {x y : Γ} (f : ff x ⟶ ff y) : (p.map f).fiber ≍
     PGrpd.mapFiber' (a0_comp_forgetToGrpd p_tp δ0_p) f.2 := by
-  symm
-  convert PGrpd.mapFiber'_heq p_tp f
-  · rw! [← obj_ff_fiber p_tp δ0_p x]
-    rw! [PGrpd.objFiber'_heq p_tp]
-  · rw! [← obj_ff_fiber p_tp δ0_p y]
-    rw! [PGrpd.objFiber'_heq p_tp]
-  · rw! [← δ0_p, path0, PGrpd.mapFiber'_naturality p_tp (sectR { down := { as := false } } Γ)]
-    rw! [PGrpd.mapFiber'_heq p_tp]
-    rw! [PGrpd.mapFiber'_heq p_tp f]
-    rfl
+  subst a0
+  have hf : f = ffm f.2 := by
+    ext
+    · rfl
+    · rfl
+  rw! [hf]
+  exact (PGrpd.mapFiber'_heq (path0_comp_forgetToGrpd p_tp) _).symm
 
 lemma map_tt_fiber {x y : Γ} (f : tt x ⟶ tt y) : (p.map f).fiber ≍
     PGrpd.mapFiber' (a1_comp_forgetToGrpd p_tp δ1_p) f.2 := by
-  symm
-  convert PGrpd.mapFiber'_heq p_tp f
-  · rw! [← obj_tt_fiber p_tp δ1_p x]
-    rw! [PGrpd.objFiber'_heq p_tp]
-  · rw! [← obj_tt_fiber p_tp δ1_p y]
-    rw! [PGrpd.objFiber'_heq p_tp]
-  · rw! [← δ1_p, path1, PGrpd.mapFiber'_naturality p_tp (sectR { down := { as := true } } Γ)]
-    rw! [PGrpd.mapFiber'_heq p_tp]
-    rw! [PGrpd.mapFiber'_heq p_tp f]
-    rfl
+  subst a1
+  have hf : f = ttm f.2 := by
+    ext
+    · rfl
+    · rfl
+  rw! [hf]
+  exact (PGrpd.mapFiber'_heq (path1_comp_forgetToGrpd p_tp) _).symm
 
 lemma mapFiber'_ffm {x y : Γ} (f : x ⟶ y) : PGrpd.mapFiber' p_tp (ffm f) ≍
     PGrpd.mapFiber' (a0_comp_forgetToGrpd p_tp δ0_p) f := by
-  rw! [← δ0_p, PGrpd.mapFiber'_naturality p_tp (sectR ..)]
-  simp
+  subst a0
+  exact (PGrpd.mapFiber'_heq p_tp _).trans
+    (PGrpd.mapFiber'_heq (path0_comp_forgetToGrpd p_tp) f).symm
 
 lemma mapFiber'_ttm {x y : Γ} (f : x ⟶ y) : PGrpd.mapFiber' p_tp (ttm f) ≍
     PGrpd.mapFiber' (a1_comp_forgetToGrpd p_tp δ1_p) f := by
-  rw! [← δ1_p, PGrpd.mapFiber'_naturality p_tp (sectR ..)]
-  simp
+  subst a1
+  exact (PGrpd.mapFiber'_heq p_tp _).trans
+    (PGrpd.mapFiber'_heq (path1_comp_forgetToGrpd p_tp) f).symm
 
 @[simp]
 lemma objFiber_path (x) : PGrpd.objFiber (path p_tp) x = pathFibObj p_tp x :=
@@ -405,11 +411,14 @@ lemma mapFiber_ft (x) : PGrpd.mapFiber p (ft x) ≍
   symm
   rw [objFiber'_path_as]
   simp only [Functor.comp_obj, snd_obj, Functor.comp_map, snd_map, PGrpd.mapFiber',
-    Grpd.forgetToCat, Functor.Grothendieck.forget_obj, PGrpd.objFiber'EqToHom,
-    PGrpd.mapFiber'EqToHom, Grpd.eqToHom_hom, eqToHom_trans_assoc, PGrpd.mapFiber]
+    Grpd.forgetToCat, PGrpd.objFiber'EqToHom,
+    PGrpd.mapFiber'EqToHom, PGrpd.mapFiber]
   apply HEq.trans (eqToHom_comp_heq ..)
-  simp
+  apply HEq.trans (eqToHom_comp_heq ..)
+  exact (Grpd.eqToHom_hom _ _).heq.trans (cast_heq _ _)
 
+-- The functor congruence reduces through the bundled forgetful functor.
+set_option backward.isDefEq.respectTransparency false in
 include p_tp in
 lemma map_ft_base (x) : (p.map (ft x)).base = eqToHom (by
     have h0 := Functor.congr_obj p_tp (ff x)
@@ -418,6 +427,7 @@ lemma map_ft_base (x) : (p.map (ft x)).base = eqToHom (by
     rw [h0, h1]) := by
   simpa using Functor.congr_hom p_tp (ft x)
 
+set_option backward.isDefEq.respectTransparency false in
 include p_tp in
 lemma map_tf_base (x) : (p.map (tf x)).base = eqToHom (by
     have h0 := Functor.congr_obj p_tp (ff x)
@@ -426,6 +436,8 @@ lemma map_tf_base (x) : (p.map (tf x)).base = eqToHom (by
     rw [h0, h1]) := by
   simpa using Functor.congr_hom p_tp (tf x)
 
+-- Matching `eqToHom` through the bundled groupoid functor requires reducible projections.
+set_option backward.isDefEq.respectTransparency false in
 include p_tp in
 lemma inv_mapFiber_tf_heq (y : Γ) :
     inv (PGrpd.mapFiber p (tf y)) ≍ PGrpd.mapFiber p (ft y) := by
@@ -436,28 +448,33 @@ lemma inv_mapFiber_tf_heq (y : Γ) :
   rw [PGrpd.mapFiber_inv]
   apply HEq.trans _ (eqToHom_comp_heq ..).symm
   rw! [PGrpd.inv_mapFiber_heq]
-  simp only [Grpd.forgetToCat, Functor.Grothendieck.forget_obj, Functor.comp_obj, Functor.comp_map,
-    Functor.Grothendieck.forget_map, Cat.of_α, id_eq, cast_heq_iff_heq]
+  simp only [Grpd.forgetToCat, Functor.comp_obj, Functor.comp_map,
+     Cat.of_α, cast_heq_iff_heq]
+  dsimp only [PGrpd.forgetToGrpd, Functor.Grothendieck.forget]
   rw! [map_tf_base p_tp, Grpd.eqToHom_hom]
   simp only [Grpd.forgetToCat, PGrpd.mapFiber, cast_heq_iff_heq]
   rw! (castMode := .all) [Functor.map_inv]
   simp
 
+-- Dependent fiber rewrites need the bundled functor projections to reduce.
+set_option backward.isDefEq.respectTransparency false in
 open PGrpd in
 lemma unpath_map_ft_fiber {x y} (f : ff x ⟶ tt y) :
     ((unpath (a0_comp_forgetToGrpd p_tp δ0_p) (a1_comp_forgetToGrpd p_tp δ1_p)
     (p := FunctorOperation.Path.path p_tp)
     (by rw [path_comp_forgetToGrpd]; congr)).map f).fiber ≍ (p.map f).fiber := by
-  simp only [Grpd.forgetToCat, unpath, Functor.Grothendieck.functorTo_obj_base,
-    Functor.comp_obj, snd_obj, Cat.of_α, Functor.Grothendieck.functorTo_map_base,
-    Functor.comp_map, snd_map, id_eq, Functor.Grothendieck.functorTo_obj_fiber, unpathFibObj,
+  simp only [Grpd.forgetToCat, unpath,
+      Cat.of_α,
+        unpathFibObj,
     Functor.Grothendieck.functorTo_map_fiber, unpathFibMap]
   -- have hf : f = ttm f.2 ≫ ft y := by aesop_cat
   -- TODO: mwe and report: this should not type check
   have hf : f = ffm f.2 ≫ ft y := by aesop_cat
-  conv => rhs; rw! (castMode := .all) [hf]
-  simp only [heq_eqRec_iff_heq]
-  convert_to _ ≍ mapFiber _ _
+  have hmap (g h : ff x ⟶ tt y) (e : g = h) :
+      mapFiber p h ≍ (p.map g).fiber := by
+    cases e
+    rfl
+  apply HEq.trans _ (hmap f _ hf)
   erw [mapFiber_comp]
   rw! [← mapFiber'_ffm p_tp δ0_p]
   apply HEq.trans _ (eqToHom_comp_heq ..).symm
@@ -465,25 +482,26 @@ lemma unpath_map_ft_fiber {x y} (f : ff x ⟶ tt y) :
   · erw [Functor.congr_obj p_tp (tt y)]
     simp
   · have H := Functor.congr_hom p_tp (ffm f.2)
-    simp only [Grpd.forgetToCat, Functor.comp_obj, Functor.Grothendieck.forget_obj,
+    simp only [Grpd.forgetToCat, Functor.comp_obj,
       Functor.comp_map, Functor.Grothendieck.forget_map, snd_obj, snd_map,
       Grpd.comp_eq_comp] at H
     erw [Functor.congr_hom p_tp (ft y)]
     rw! [← δ0_p, path0, objFiber'_naturality (sectR ..) p_tp, objFiber'_heq]
     simp [mapObjFiber, Grpd.eqToHom_obj, objFiber, Functor.congr_obj H,
-      Grpd.eqToHom_obj]
+      Grpd.eqToHom_obj]; rfl
   · simp only [Functor.Grothendieck.forget_map]
     rw! [← δ0_p, path0, objFiber'_naturality (sectR ..) p_tp, objFiber'_heq,
       map_ft_base p_tp, Grpd.eqToHom_obj]
-    simp [objFiber]
+    simp [objFiber]; rfl
   · rw! [← δ1_p, path1, objFiber'_naturality (sectR ..) p_tp, objFiber'_heq]
-    simp [objFiber]
-  · simp only [Functor.comp_obj, snd_obj, Functor.comp_map, snd_map, Grpd.forgetToCat,
-      Functor.Grothendieck.forget_obj, Functor.Grothendieck.forget_map, cast_heq_iff_heq]
+    simp [objFiber]; rfl
+  · simp only [Functor.comp_obj, snd_obj, Functor.comp_map, snd_map,
+        cast_heq_iff_heq]
+    change _ ≍ (p.map (ft y)).base.map _
     rw! [map_ft_base p_tp, mapFiber'_heq]
     simp [Grpd.eqToHom_hom, mapFiber]
   · rw! [mapFiber_ft p_tp y]
-    simp only [Grpd.forgetToCat, Functor.Grothendieck.forget_obj, Functor.Grothendieck.forget_map,
+    simp only [
       objFiber'_rfl, heq_cast_iff_heq]
     apply Discrete.as_heq_as
     · congr
@@ -492,43 +510,48 @@ lemma unpath_map_ft_fiber {x y} (f : ff x ⟶ tt y) :
     · apply (objFiber'_heq ..).trans
       simp [objFiber]
 
+-- Dependent fiber rewrites need the bundled functor projections to reduce.
+set_option backward.isDefEq.respectTransparency false in
 open PGrpd in
 lemma unpath_map_tf_fiber {x y} (f : tt x ⟶ ff y) :
     ((unpath (a0_comp_forgetToGrpd p_tp δ0_p) (a1_comp_forgetToGrpd p_tp δ1_p)
     (p := FunctorOperation.Path.path p_tp)
     (by rw [path_comp_forgetToGrpd]; congr)).map f).fiber ≍ (p.map f).fiber := by
-  simp only [Grpd.forgetToCat, unpath, Functor.Grothendieck.functorTo_obj_base, Functor.comp_obj,
-    snd_obj, Cat.of_α, Functor.Grothendieck.functorTo_map_base, Functor.comp_map, snd_map, id_eq,
-    Functor.Grothendieck.functorTo_obj_fiber, unpathFibObj, Functor.Grothendieck.functorTo_map_fiber,
+  simp only [Grpd.forgetToCat, unpath,
+     Cat.of_α,
+     unpathFibObj, Functor.Grothendieck.functorTo_map_fiber,
     unpathFibMap]
   have hf : f = ttm f.2 ≫ tf y := by aesop_cat
-  conv => rhs; rw! (castMode := .all) [hf]
-  simp only [heq_eqRec_iff_heq]
-  convert_to _ ≍ mapFiber _ _
+  have hmap (g h : tt x ⟶ ff y) (e : g = h) :
+      mapFiber p h ≍ (p.map g).fiber := by
+    cases e
+    rfl
+  apply HEq.trans _ (hmap f _ hf)
   erw [mapFiber_comp]
   rw! [← mapFiber'_ttm p_tp δ1_p f.2]
   apply HEq.trans _ (eqToHom_comp_heq ..).symm
   have : A.obj y ≍ forgetToGrpd.obj (p.obj (ff y)) := by erw [Functor.congr_obj p_tp (ff y)]; simp
   have : objFiber' (a0_comp_forgetToGrpd p_tp δ0_p) y ≍ objFiber p (ff y) := by
     rw! [← δ0_p, path0, objFiber'_naturality (sectR ..) p_tp, objFiber'_heq]
-    simp [objFiber]
+    simp [objFiber]; rfl
   apply Grpd.comp_heq_comp
   · assumption
   · have H := Functor.congr_hom p_tp (ttm f.2)
-    simp only [Grpd.forgetToCat, Functor.comp_obj, Functor.Grothendieck.forget_obj,
+    simp only [Grpd.forgetToCat, Functor.comp_obj,
       Functor.comp_map, Functor.Grothendieck.forget_map, snd_obj, snd_map,
       Grpd.comp_eq_comp] at H
     erw [Functor.congr_hom p_tp (tf y)]
     rw! [← δ1_p, path1, objFiber'_naturality (sectR ..) p_tp, objFiber'_heq]
     simp [mapObjFiber, Grpd.eqToHom_obj, objFiber, Functor.congr_obj H,
-      Grpd.eqToHom_obj]
+      Grpd.eqToHom_obj]; rfl
   · simp only [Functor.Grothendieck.forget_map]
     rw! [← δ1_p, path1, objFiber'_naturality (sectR ..) p_tp, objFiber'_heq,
       map_tf_base p_tp, Grpd.eqToHom_obj]
-    simp [objFiber]
+    simp [objFiber]; rfl
   · assumption
-  · simp only [Functor.comp_obj, snd_obj, Functor.comp_map, snd_map, Grpd.forgetToCat,
-      Functor.Grothendieck.forget_obj, Functor.Grothendieck.forget_map, cast_heq_iff_heq]
+  · simp only [Functor.comp_obj, snd_obj, Functor.comp_map, snd_map,
+        cast_heq_iff_heq]
+    change _ ≍ (p.map (tf y)).base.map _
     rw! [map_tf_base p_tp, mapFiber'_heq]
     simp [Grpd.eqToHom_hom, mapFiber]
   · apply Grpd.inv_heq_of_heq_inv
@@ -550,6 +573,8 @@ lemma unpath_map_tf_fiber {x y} (f : tt x ⟶ ff y) :
         rw! [inv_mapFiber_tf_heq p_tp, mapFiber'_heq]
         simp [mapFiber]
 
+-- Dependent fiber projections must unfold when comparing the two functors.
+set_option backward.isDefEq.respectTransparency false in
 lemma unpath_path : unpath (a0_comp_forgetToGrpd p_tp δ0_p) (a1_comp_forgetToGrpd p_tp δ1_p)
     (p := FunctorOperation.Path.path p_tp) (by rw [path_comp_forgetToGrpd]; congr) = p := by
   apply Functor.Grothendieck.FunctorTo.hext
@@ -586,7 +611,10 @@ variable {Γ Δ : Grpd} (σ : Δ ⟶ Γ) {A : Γ ⟶ U.{v}.Ty} (a0 a1 : Γ ⟶ U
 
 include a0_tp in
 lemma pt_tp : toCoreAsSmallEquiv a0 ⋙ PGrpd.forgetToGrpd = toCoreAsSmallEquiv A := by
-  rw [← a0_tp, Grpd.comp_eq_comp, U.tp, toCoreAsSmallEquiv_apply_comp_right]
+  have h := congrArg toCoreAsSmallEquiv a0_tp
+  change toCoreAsSmallEquiv (a0 ⋙ Ctx.coreAsSmallFunctor PGrpd.forgetToGrpd) =
+    toCoreAsSmallEquiv A at h
+  exact (toCoreAsSmallEquiv_apply_comp_right a0 PGrpd.forgetToGrpd).symm.trans h
 
 def Id : Γ ⟶ U.{v}.Ty :=
   toCoreAsSmallEquiv.symm (FunctorOperation.Id (A := toCoreAsSmallEquiv A)
@@ -594,9 +622,11 @@ def Id : Γ ⟶ U.{v}.Ty :=
     (pt_tp a0 a0_tp)
     (pt_tp a1 a1_tp))
 
+-- Restore transparency for the bundled groupoid coercion in the composition rewrites.
+set_option backward.isDefEq.respectTransparency false in
 lemma Id_comp :
-    UId.Id (A := σ ≫ A) (σ ≫ a0) (σ ≫ a1) (by simp only [Category.assoc, a0_tp, U_Ty])
-      (by simp only [Category.assoc, a1_tp, U_Ty]) = σ ≫ UId.Id a0 a1 a0_tp a1_tp := by
+    UId.Id (A := σ ≫ A) (σ ≫ a0) (σ ≫ a1) (by simp only [Category.assoc, a0_tp])
+      (by simp only [Category.assoc, a1_tp]) = σ ≫ UId.Id a0 a1 a0_tp a1_tp := by
   dsimp only [U_Ty, comp_eq_comp, Id]
   rw [← toCoreAsSmallEquiv_symm_apply_comp_left, ← FunctorOperation.Id_comp]
 
@@ -606,17 +636,22 @@ variable (p : cylinder.I.obj Γ ⟶ U.Tm) (p_tp : p ≫ U.tp = cylinder.π.app 
 
 def path : Γ ⟶ U.{v}.Tm := toCoreAsSmallEquiv.symm <|
   FunctorOperation.Path.path (A := toCoreAsSmallEquiv A) (p := toCoreAsSmallEquiv p) (by
-    rw [← toCoreAsSmallEquiv_apply_comp_left]
-    rw [← toCoreAsSmallEquiv_apply_comp_right,
-      EmbeddingLike.apply_eq_iff_eq]
-    exact p_tp)
-
+    have h := congrArg toCoreAsSmallEquiv p_tp
+    change toCoreAsSmallEquiv (p ⋙ Ctx.coreAsSmallFunctor PGrpd.forgetToGrpd) =
+      toCoreAsSmallEquiv (CategoryTheory.Prod.snd Interval Γ ⋙ A) at h
+    exact (toCoreAsSmallEquiv_apply_comp_right p PGrpd.forgetToGrpd).symm.trans
+      (h.trans (toCoreAsSmallEquiv_apply_comp_left _ _)))
+
+-- The composition rewrite needs the same bundled groupoid transparency as Id_comp.
+set_option backward.isDefEq.respectTransparency false in
 lemma path_comp : path (A := σ ≫ A) (cylinder.I.map σ ≫ p) (by rw [Category.assoc, p_tp,
     ← Category.assoc, cylinder.π.naturality, Category.assoc, Functor.id_map]) =
     σ ≫ path p p_tp := by
   dsimp [path]
   rw [← toCoreAsSmallEquiv_symm_apply_comp_left, ← FunctorOperation.Path.path_comp]
 
+-- The endpoint composition rewrites require bundled groupoid transparency.
+set_option backward.isDefEq.respectTransparency false in
 lemma path_tp (δ0_p : cylinder.δ0.app Γ ≫ p = a0) (δ1_p : cylinder.δ1.app Γ ≫ p = a1) :
     path p p_tp ≫ U.tp = UId.Id (A := A) a0 a1
     (by rw [← δ0_p, Category.assoc, p_tp, Cylinder.δ0_π'_app_assoc])
@@ -635,6 +670,8 @@ section
 
 variable (p : Γ ⟶ U.Tm) (p_tp : p ≫ U.tp = UId.Id a0 a1 a0_tp a1_tp)
 
+-- The composition rewrite needs bundled groupoid transparency.
+set_option backward.isDefEq.respectTransparency false in
 def unpath : cylinder.I.obj Γ ⟶ U.{v}.Tm :=
   have p_tp' : toCoreAsSmallEquiv p ⋙ PGrpd.forgetToGrpd =
       FunctorOperation.Id (pt_tp a0 a0_tp) (pt_tp a1 a1_tp) := by
@@ -642,22 +679,30 @@ def unpath : cylinder.I.obj Γ ⟶ U.{v}.Tm :=
     rw [← toCoreAsSmallEquiv_apply_comp_right, p_tp, Equiv.apply_symm_apply]
   toCoreAsSmallEquiv.symm <| FunctorOperation.Path.unpath _ _ p_tp'
 
+-- The unpath composition rewrites require bundled groupoid transparency.
+set_option backward.isDefEq.respectTransparency false in
 lemma unpath_tp : unpath a0 a1 a0_tp a1_tp p p_tp ≫ U.tp = cylinder.π.app Γ ≫ A := by
   dsimp [unpath, U.tp]
   rw [← toCoreAsSmallEquiv_symm_apply_comp_right, toCoreAsSmallEquiv.symm_apply_eq,
     toCoreAsSmallEquiv_apply_comp_left, FunctorOperation.Path.unpath_comp_forgetToGrpd]
   rfl
 
+-- The unpath composition rewrites require bundled groupoid transparency.
+set_option backward.isDefEq.respectTransparency false in
 lemma δ0_unpath : cylinder.δ0.app Γ ≫ unpath a0 a1 a0_tp a1_tp p p_tp = a0 := by
   dsimp [unpath]
   rw [← toCoreAsSmallEquiv_symm_apply_comp_left, toCoreAsSmallEquiv.symm_apply_eq]
   apply FunctorOperation.Path.sectR_false_comp_unpath
 
+-- The unpath composition rewrites require bundled groupoid transparency.
+set_option backward.isDefEq.respectTransparency false in
 lemma δ1_unpath : cylinder.δ1.app Γ ≫ unpath a0 a1 a0_tp a1_tp p p_tp = a1 := by
   dsimp [unpath]
   rw [← toCoreAsSmallEquiv_symm_apply_comp_left, toCoreAsSmallEquiv.symm_apply_eq]
   apply FunctorOperation.Path.sectR_true_comp_unpath
 
+-- The unpath composition rewrites require bundled groupoid transparency.
+set_option backward.isDefEq.respectTransparency false in
 lemma path_unpath : path (A := A) (unpath a0 a1 a0_tp a1_tp p p_tp) (unpath_tp ..) = p := by
   dsimp [path, unpath]
   rw [toCoreAsSmallEquiv.symm_apply_eq]
@@ -666,6 +711,8 @@ lemma path_unpath : path (A := A) (unpath a0 a1 a0_tp a1_tp p p_tp) (unpath_tp .
 
 end
 
+-- The unpath composition rewrites require bundled groupoid transparency.
+set_option backward.isDefEq.respectTransparency false in
 lemma unpath_path (p : cylinder.I.obj Γ ⟶ U.Tm) (p_tp : p ≫ U.tp = cylinder.π.app Γ ≫ A)
     (δ0_p : cylinder.δ0.app Γ ≫ p = a0) (δ1_p : cylinder.δ1.app Γ ≫ p = a1) :
     unpath (A := A) a0 a1 (by simp [← δ0_p, - Grpd.comp_eq_comp, p_tp])
@@ -687,26 +734,30 @@ attribute [local irreducible] tpClovenIsofibration
 variable (σ : Δ ⟶ Γ) (p0 : Γ ⟶ U.{v}.Tm) (p : cylinder.I.obj Γ ⟶ U.Ty)
     (p0_tp : p0 ≫ U.tp = cylinder.δ0.app Γ ≫ p)
 
+-- Unfold bundled groupoid instances while elaborating the lift.
+set_option backward.isDefEq.respectTransparency false in
 @[simp]
 def liftObj : Grpd.Interval × Γ → U.{v}.Tm
-| ⟨⟨⟨.false⟩⟩, x2⟩ => p0.obj x2
-| ⟨⟨⟨.true⟩⟩, x2⟩ => tpClovenIsofibration.liftObj (p.map (FunctorOperation.Path.ft x2))
-    (Functor.congr_obj p0_tp x2)
+  | ⟨⟨⟨.false⟩⟩, x2⟩ => p0.obj x2
+  | ⟨⟨⟨.true⟩⟩, x2⟩ => tpClovenIsofibration.liftObj (p.map (FunctorOperation.Path.ft x2))
+      (Functor.congr_obj p0_tp x2)
 
+set_option backward.isDefEq.respectTransparency false in
 @[simp]
 abbrev liftMap0 {x2 : Γ} {y : Grpd.Interval × Γ} (f : FunctorOperation.Path.ff x2 ⟶ y) :=
   tpClovenIsofibration.liftIso (X' := p0.obj x2) (p.map f) (Functor.congr_obj p0_tp x2)
 
 open FunctorOperation.Path
 
+set_option backward.isDefEq.respectTransparency false in
 @[simp]
 def liftMap : {x y : Grpd.Interval × Γ} → (f : x ⟶ y) →
     liftObj p0 p p0_tp x ⟶ liftObj p0 p p0_tp y
-| ⟨⟨⟨.false⟩⟩, _⟩, ⟨⟨⟨.false⟩⟩, _⟩, f => p0.map f.2
-| ⟨⟨⟨.false⟩⟩, _⟩, ⟨⟨⟨.true⟩⟩, y2⟩, f => p0.map f.2 ≫ liftMap0 p0 p p0_tp (ft y2)
-| ⟨⟨⟨.true⟩⟩, x2⟩, ⟨⟨⟨.false⟩⟩, _⟩, f => inv (liftMap0 p0 p p0_tp (ft x2)) ≫ p0.map f.2
-| ⟨⟨⟨.true⟩⟩, x2⟩, ⟨⟨⟨.true⟩⟩, y2⟩, f => inv (liftMap0 p0 p p0_tp (ft x2)) ≫
-  p0.map f.2 ≫ liftMap0 p0 p p0_tp (ft y2)
+  | ⟨⟨⟨.false⟩⟩, _⟩, ⟨⟨⟨.false⟩⟩, _⟩, f => p0.map f.2
+  | ⟨⟨⟨.false⟩⟩, _⟩, ⟨⟨⟨.true⟩⟩, y2⟩, f => p0.map f.2 ≫ liftMap0 p0 p p0_tp (ft y2)
+  | ⟨⟨⟨.true⟩⟩, x2⟩, ⟨⟨⟨.false⟩⟩, _⟩, f => inv (liftMap0 p0 p p0_tp (ft x2)) ≫ p0.map f.2
+  | ⟨⟨⟨.true⟩⟩, x2⟩, ⟨⟨⟨.true⟩⟩, y2⟩, f => inv (liftMap0 p0 p p0_tp (ft x2)) ≫
+    p0.map f.2 ≫ liftMap0 p0 p p0_tp (ft y2)
 
 lemma liftMap_id (x) : liftMap p0 p p0_tp (𝟙 x) = 𝟙 (liftObj p0 p p0_tp x) := by
   rcases x with ⟨⟨⟨_|_⟩⟩, _⟩ <;> simp
@@ -725,23 +776,25 @@ def lift : cylinder.I.obj Γ ⟶ U.{v}.Tm where
   map_id := liftMap_id p0 p p0_tp
   map_comp := liftMap_comp p0 p p0_tp
 
+-- These functor equations need bundled groupoid instances unfolded during elaboration.
+set_option backward.isDefEq.respectTransparency false in
 lemma lift_comp_tp :
     hurewiczUTp.lift p0 p p0_tp ≫ U.tp = p := by
   fapply CategoryTheory.Functor.ext
   · intro x
     rcases x with ⟨⟨⟨_|_⟩⟩, x⟩
-    · simpa using Functor.congr_obj p0_tp x
-    · simp
+    · exact Functor.congr_obj p0_tp x
+    · exact Functor.ClovenIsofibration.obj_liftObj tpClovenIsofibration _ _
   · intro x y f
     rcases x with ⟨⟨⟨_|_⟩⟩, x⟩
     · rcases y with ⟨⟨⟨_|_⟩⟩, y⟩
       · erw [Functor.congr_hom p0_tp f.2]
         simp
         rfl
-      · simp only [U_Tm, comp_eq_comp, Functor.comp_obj, lift_obj, liftObj, U_Ty, U_tp,
+      · simp only [comp_eq_comp, Functor.comp_obj, liftObj,
           Functor.comp_map, lift_map, liftMap, liftMap0, Functor.map_comp]
         erw [Functor.congr_hom p0_tp f.2]
-        simp only [U_Tm, comp_eq_comp, Functor.comp_obj, Functor.id_obj, Functor.comp_map,
+        simp only [comp_eq_comp, Functor.comp_obj, Functor.id_obj, Functor.comp_map,
           Category.assoc]
         have : f = ffm f.2 ≫ ft y := by aesop
         conv => rhs; rw [this]
@@ -750,24 +803,24 @@ lemma lift_comp_tp :
         simp [← Category.assoc]
         rfl
     · rcases y with ⟨⟨⟨_|_⟩⟩, y⟩
-      · simp only [U_Tm, comp_eq_comp, Functor.comp_obj, lift_obj, liftObj, U_Ty, U_tp,
+      · simp only [comp_eq_comp, Functor.comp_obj, liftObj,
           Functor.comp_map, lift_map, liftMap, liftMap0, Functor.map_comp, Functor.map_inv,
           IsIso.inv_comp_eq]
         erw [Functor.congr_hom p0_tp f.2]
         have : f = tf x ≫ ffm f.2 := by aesop
         slice_rhs 2 3 => rw [this]
         rw [Functor.ClovenIsofibration.map_liftIso', Functor.map_comp]
-        simp only [U_Tm, comp_eq_comp, Functor.comp_obj, Functor.id_obj, Functor.comp_map,
+        simp only [comp_eq_comp, Functor.comp_obj, Functor.id_obj, Functor.comp_map,
           Category.assoc, eqToHom_trans_assoc, eqToHom_refl, Category.id_comp]
         have : ft x ≫ tf x = 𝟙 _ := by aesop
         slice_rhs 2 3 => rw [← Functor.map_comp, this, CategoryTheory.Functor.map_id]
         rfl
-      · simp only [U_Tm, comp_eq_comp, Functor.comp_obj, lift_obj, liftObj, U_Ty, U_tp,
+      · simp only [comp_eq_comp, Functor.comp_obj, liftObj,
           Functor.comp_map, lift_map, liftMap, liftMap0, Functor.map_comp, Functor.map_inv,
           IsIso.inv_comp_eq]
         erw [Functor.congr_hom p0_tp f.2]
         rw [Functor.ClovenIsofibration.map_liftIso', Functor.ClovenIsofibration.map_liftIso']
-        simp only [U_Tm, comp_eq_comp, Functor.comp_obj, Functor.id_obj, Functor.comp_map,
+        simp only [comp_eq_comp, Functor.comp_obj, Functor.id_obj, Functor.comp_map,
           ← Category.assoc, ← heq_eq_eq, heq_comp_eqToHom_iff, comp_eqToHom_heq_iff]
         simp only [Category.assoc, eqToHom_trans, eqToHom_refl, Category.comp_id,
           ← Functor.map_comp, heq_eq_eq]
@@ -775,65 +828,74 @@ lemma lift_comp_tp :
         conv => rhs; rw [this]
         rfl
 
+-- As above, expose the bundled instances locally when comparing functor components.
+set_option backward.isDefEq.respectTransparency false in
 lemma δ0_comp_lift : cylinder.δ0.app Γ ≫ hurewiczUTp.lift p0 p p0_tp = p0 := by
   fapply CategoryTheory.Functor.ext
   · intro x
-    convert_to (lift p0 p p0_tp).obj ⟨⟨⟨.false⟩⟩, x⟩ = _
-    simp
+    rfl
   · intro x y f
-    convert_to (lift p0 p p0_tp).map (ffm f) = _
-    simp
+    simp only [eqToHom_refl, Category.id_comp, Category.comp_id]
+    rfl
 
 @[simp]
 lemma I_map_obj_ff (x : Δ) : (cylinder.I.map σ).obj ({ down := { as := false } }, x) =
     ({ down := { as := false } }, σ.obj x) := by
   rfl
 
+-- The following component equations also elaborate through bundled groupoid instances.
+set_option backward.isDefEq.respectTransparency false in
 lemma lift_map_ffm {x y : Δ} (f : x ⟶ y) : (lift p0 p p0_tp).map (ffm (σ.map f)) =
     p0.map (σ.map f) := by
   simp [liftMap]
 
+set_option backward.isDefEq.respectTransparency false in
 lemma lift_map_ft (x : Δ) : (lift p0 p p0_tp).map (ft (σ.obj x)) =
     tpClovenIsofibration.liftIso (p.map (ft (σ.obj x)))
-    (by simpa using Functor.congr_obj p0_tp (σ.obj x)) := by
+    (by exact Functor.congr_obj p0_tp (σ.obj x)) := by
   simp [liftObj, liftMap]
 
+set_option backward.isDefEq.respectTransparency false in
 lemma lift_map_ft' (x : Δ) : (lift p0 p p0_tp).map (ft (σ.obj x)) =
     tpClovenIsofibration.liftIso (p.map (⟨⟨⟨⟩⟩, σ.map (𝟙 _)⟩ : ff (σ.obj x) ⟶ tt (σ.obj x)))
-    (by simpa using Functor.congr_obj p0_tp (σ.obj x)) ≫ eqToHom (by simp) := by
-  simp only [U_Tm, lift_obj, liftObj, U_Ty, U_tp, ft, lift_map, liftMap,
+    (by exact Functor.congr_obj p0_tp (σ.obj x)) ≫ eqToHom (by simp) := by
+  simp only [liftObj, ft, lift_map, liftMap,
     CategoryTheory.Functor.map_id, liftMap0, Category.id_comp, ← heq_eq_eq, heq_comp_eqToHom_iff]
   rw! (castMode := .all) [← CategoryTheory.Functor.map_id]
   rfl
 
+set_option backward.isDefEq.respectTransparency false in
 lemma lift_map_tf (x : Δ) : (lift p0 p p0_tp).map (tf (σ.obj x)) =
     eqToHom (by simp; rfl) ≫ inv (tpClovenIsofibration.liftIso (p.map (ft (σ.obj x)))
-      (by simpa using Functor.congr_obj p0_tp (σ.obj x))) := by
+      (by exact Functor.congr_obj p0_tp (σ.obj x))) := by
   simp [liftMap]
 
+set_option backward.isDefEq.respectTransparency false in
 lemma lift_map_tf' (x : Δ) : (lift p0 p p0_tp).map (tf (σ.obj x)) =
     eqToHom (by simp [ft]; rfl) ≫
     inv (tpClovenIsofibration.liftIso (p.map (⟨⟨⟨⟩⟩, σ.map (𝟙 _)⟩ : ff (σ.obj x) ⟶ tt (σ.obj x)))
-    (by simpa using Functor.congr_obj p0_tp (σ.obj x))) := by
-  simp only [U_Tm, lift_obj, liftObj, U_Ty, U_tp, ft, tf, lift_map, liftMap, liftMap0,
+    (by exact Functor.congr_obj p0_tp (σ.obj x))) := by
+  simp only [liftObj, ft, tf, lift_map, liftMap, liftMap0,
     CategoryTheory.Functor.map_id, Category.comp_id, ← heq_eq_eq, heq_eqToHom_comp_iff]
   rw! (castMode := .all) [← CategoryTheory.Functor.map_id]
   rfl
 
+-- Expose bundled groupoid instances while elaborating cylinder components.
+set_option backward.isDefEq.respectTransparency false in
 lemma lift_comp : lift (σ ≫ p0) (cylinder.I.map σ ≫ p)
     (by simp [p0_tp, - Grpd.comp_eq_comp, ← cylinder.δ0.naturality_assoc]) =
     cylinder.I.map σ ≫ lift p0 p p0_tp := by
   fapply CategoryTheory.Functor.ext
   · intro x
     rcases x with ⟨⟨⟨_|_⟩⟩, x⟩
-    · convert_to _ = (lift p0 p p0_tp).obj (ff (σ.obj x))
-      simp
-    · convert_to _ = (lift p0 p p0_tp).obj (tt (σ.obj x))
-      simp only [U_Tm, comp_eq_comp, lift_obj, liftObj, U_Ty, U_tp, Functor.comp_obj,
-        Functor.comp_map]
-      congr
-      conv => rhs; rw [ft, ← CategoryTheory.Functor.map_id]
-      rfl
+    · rfl
+    · simp only [comp_eq_comp, lift_obj, liftObj, Functor.comp_obj, Functor.comp_map]
+      congr 1
+      change p.map ((cylinder.I.map σ).map (ft x)) = p.map (ft (σ.obj x))
+      congr 1
+      simp only [ft]
+      change (⟨⟨⟨⟩⟩, σ.map (𝟙 x)⟩ : ff (σ.obj x) ⟶ tt (σ.obj x)) = _
+      exact congrArg (fun g => (⟨⟨⟨⟩⟩, g⟩ : ff (σ.obj x) ⟶ tt (σ.obj x))) (σ.map_id x)
   · intro x y f
     rcases x with ⟨⟨⟨_|_⟩⟩, x⟩
     · rcases y with ⟨⟨⟨_|_⟩⟩, y⟩
@@ -854,41 +916,70 @@ lemma lift_comp : lift (σ ≫ p0) (cylinder.I.map σ ≫ p)
       · have : (cylinder.I.map σ).map f = tf (σ.obj x) ≫ ffm (σ.map f.2) ≫ ft (σ.obj y) := by aesop
         slice_rhs 2 3 => simp only [Grpd.comp_eq_comp, Functor.comp_map, this, Functor.map_comp,
           lift_map_ffm, lift_map_tf', lift_map_ft']
-        simp only [U_Tm, comp_eq_comp, lift_obj, liftObj, U_Ty, U_tp, Functor.comp_obj, ft,
+        simp only [comp_eq_comp, liftObj, Functor.comp_obj, ft,
           Functor.comp_map, lift_map, liftMap, liftMap0, Category.assoc, eqToHom_trans,
           eqToHom_refl, Category.comp_id, eqToHom_trans_assoc, Category.id_comp, IsIso.eq_inv_comp]
         erw [IsIso.hom_inv_id_assoc]
         rfl
 
+-- Unfold bundled groupoid instances for the component equations.
+set_option backward.isDefEq.respectTransparency false in
 open Functor.ClovenIsofibration.IsSplit in
 lemma isNormal (A : Γ ⟶ U.Ty) (π_A : p = CategoryTheory.Prod.snd _ Γ ≫ A) :
     lift p0 p p0_tp = CategoryTheory.Prod.snd _ Γ ≫ p0 := by
   have : tpClovenIsofibration.IsSplit := inferInstance -- FIXME
   subst π_A
-  fapply CategoryTheory.Functor.ext
+  have norm (z : Γ) (g : A.obj z ⟶ A.obj z) [IsIso g] (hg : g = 𝟙 _)
+      (hh : U.tp.obj (p0.obj z) = A.obj z) :
+      tpClovenIsofibration.liftIso g hh ≍ 𝟙 (p0.obj z) := by
+    subst g
+    rw [liftIso_id]
+    exact eqToHom_heq_id_dom _ _ _
+  have norm_inv (z : Γ) (g : A.obj z ⟶ A.obj z) [IsIso g] (hg : g = 𝟙 _)
+      (hh : U.tp.obj (p0.obj z) = A.obj z) :
+      inv (tpClovenIsofibration.liftIso g hh) ≍ 𝟙 (p0.obj z) := by
+    subst g
+    simp only [liftIso_id, inv_eqToHom]
+    exact eqToHom_heq_id_cod _ _ _
+  fapply CategoryTheory.Functor.hext
   · intro x
     rcases x with ⟨⟨⟨_|_⟩⟩, x⟩
-    · simp
-    · simp [ft]
-      rw [liftObj_id]
+    · rfl
+    · change tpClovenIsofibration.liftObj (A.map (𝟙 x)) _ = p0.obj x
+      exact (congrArg (fun f => tpClovenIsofibration.liftObj f _) (A.map_id x)).trans (liftObj_id _)
   · intro x y f
     rcases x with ⟨⟨⟨_|_⟩⟩, x⟩
     · rcases y with ⟨⟨⟨_|_⟩⟩, y⟩
       · simp
-      · simp only [U_Tm, comp_eq_comp, lift_obj, liftObj, U_Ty, U_tp, Functor.comp_obj,
-          Prod.snd_obj, Functor.comp_map, Prod.snd_map, lift_map, liftMap, liftMap0,
-          eqToHom_refl, Category.id_comp]
-        rw! [CategoryTheory.Functor.map_id, liftIso_id]
+      · simp only [comp_eq_comp, liftObj, Functor.comp_obj,
+          Prod.snd_obj, Functor.comp_map, Prod.snd_map, lift_map, liftMap, liftMap0]
+        have hy : U.tp.obj (p0.obj y) = A.obj y := Functor.congr_obj p0_tp y
+        have hh := norm y (A.map (𝟙 y)) (A.map_id y) hy
+        have ho := (congrArg (fun g => tpClovenIsofibration.liftObj g hy)
+          (A.map_id y)).trans (liftObj_id hy)
+        have hc := heq_comp rfl rfl ho (show p0.map f.2 ≍ p0.map f.2 from HEq.rfl) hh
+        simpa using hc
     · rcases y with ⟨⟨⟨_|_⟩⟩, y⟩
-      · simp only [U_Tm, comp_eq_comp, lift_obj, liftObj, U_Ty, U_tp, Functor.comp_obj,
-          Prod.snd_obj, Functor.comp_map, Prod.snd_map, lift_map, liftMap, liftMap0,
-          eqToHom_refl, Category.comp_id, IsIso.inv_comp_eq]
-        rw! [CategoryTheory.Functor.map_id, liftIso_id]
-        simp
+      · simp only [comp_eq_comp, liftObj, Functor.comp_obj,
+          Prod.snd_obj, Functor.comp_map, Prod.snd_map, lift_map, liftMap, liftMap0]
+        have hx : U.tp.obj (p0.obj x) = A.obj x := Functor.congr_obj p0_tp x
+        have hi := norm_inv x (A.map (𝟙 x)) (A.map_id x) hx
+        have ho := (congrArg (fun g => tpClovenIsofibration.liftObj g hx)
+          (A.map_id x)).trans (liftObj_id hx)
+        have hc := heq_comp ho rfl rfl hi (show p0.map f.2 ≍ p0.map f.2 from HEq.rfl)
+        simpa using hc
       · simp
-        rw! [CategoryTheory.Functor.map_id, liftIso_id]
-        slice_rhs 1 2 => rw! [CategoryTheory.Functor.map_id, liftIso_id]
-        simp
+        have hx : U.tp.obj (p0.obj x) = A.obj x := Functor.congr_obj p0_tp x
+        have hy : U.tp.obj (p0.obj y) = A.obj y := Functor.congr_obj p0_tp y
+        have hi := norm_inv x (A.map (𝟙 x)) (A.map_id x) hx
+        have hj := norm y (A.map (𝟙 y)) (A.map_id y) hy
+        have ho := (congrArg (fun g => tpClovenIsofibration.liftObj g hx)
+          (A.map_id x)).trans (liftObj_id hx)
+        have hp := (congrArg (fun g => tpClovenIsofibration.liftObj g hy)
+          (A.map_id y)).trans (liftObj_id hy)
+        have hc := heq_comp ho rfl rfl hi (show p0.map f.2 ≍ p0.map f.2 from HEq.rfl)
+        have hd := heq_comp ho rfl hp hc hj
+        simpa using hd
 
 end hurewiczUTp
 
diff --git a/HoTTLean/Groupoids/IsPullback.lean b/HoTTLean/Groupoids/IsPullback.lean
index c6b7383b..6f8affa9 100644
--- a/HoTTLean/Groupoids/IsPullback.lean
+++ b/HoTTLean/Groupoids/IsPullback.lean
@@ -32,7 +32,7 @@ def tp' : AsSmall.{max u (v+1)} PGrpd.{v,v}
   AsSmall.down ⋙ PGrpd.forgetToGrpd ⋙ AsSmall.up
 
 theorem liftTm'_tp' : Cat.homOf liftTm'.{v,u} ≫ Cat.homOf tp'.{v+1, max u (v+2)} =
-  Cat.homOf tp'.{v, max u (v+2)} ≫ Cat.homOf liftTy'.{v,u} := rfl
+    Cat.homOf tp'.{v, max u (v+2)} ≫ Cat.homOf liftTy'.{v,u} := rfl
 
 /--
 The following square is a meta-theoretic pullback
@@ -88,11 +88,13 @@ def isPullback_liftTm' : Functor.IsPullback
 
 theorem isPullback_liftTm'_in_Cat : IsPullback
     (Cat.homOf liftTm'.{v,max u (v+2)})
-    tp'.{_,max u (v+2)}
-    tp'.{v+1,max u (v+2)}
+    (Cat.homOf tp'.{_,max u (v+2)})
+    (Cat.homOf tp'.{v+1,max u (v+2)})
     (Cat.homOf liftTy'.{v,max u (v+2)}) :=
   Cat.isPullback rfl isPullback_liftTm'
 
+-- Core.map and the bundled groupoid definitions need the earlier elaboration transparency.
+set_option backward.isDefEq.respectTransparency false in
 /--
 The small universes form pullbacks
       Tm.{v} ------------ liftTm ---------> Tm.{v+1}
@@ -105,7 +107,7 @@ The small universes form pullbacks
 -/
 theorem liftTm_isPullback : IsPullback liftTm.{v,max u (v+2)} U.tp.{v, max u (v+2)}
     U.tp.{v+1, max u (v+2)} liftTy.{v,max u (v+2)} := by
-  convert Functor.map_isPullback Core.map isPullback_liftTm'_in_Cat.{v,u}
+  exact Functor.map_isPullback Core.map isPullback_liftTm'_in_Cat.{v,u}
 
 variable {Γ : Ctx} (A : Γ ⥤ Grpd)
 
@@ -148,7 +150,7 @@ def isPullbackClassifierOfAsSmall :
     Functor.Groupoidal.forget (AsSmall.down ⋙ PGrpd.forgetToGrpd ⋙ AsSmall.up)
     (functorToAsSmallEquiv.symm A) :=
   Functor.IsPullback.Paste.ofRight
-    (by simp [functorToAsSmallEquiv, ← Functor.assoc, ← toPGrpd_forgetToGrpd]; rfl)
+    (by simp [functorToAsSmallEquiv, ← Functor.assoc]; rfl)
     (by rfl) isPullbackAsSmall
     (isPullbackClassifier A)
 
@@ -180,6 +182,8 @@ def isPullbackCoreAsSmall' :
     (PGrpd.forgetToGrpd) (Core.inclusion _ ⋙ AsSmall.down) :=
   Functor.IsPullback.Paste.horiz rfl rfl isPullbackCoreAsSmall isPullbackAsSmall
 
+-- The classifier paste uses bundled groupoids and core functor conversions.
+set_option backward.isDefEq.respectTransparency false in
 /--
 ∫ toCo...iv A ----> coreAsSmall PGrpd
      |                  |
@@ -194,8 +198,12 @@ def isPullbackClassifierOfCoreAsSmall (A : Γ ⟶ Ty) :
   (by
     dsimp [functorToAsSmallEquiv]
     convert_to (toPGrpd (toCoreAsSmallEquiv A) ⋙ forgetToGrpd) ⋙ AsSmall.up = _
-    erw [toPGrpd_forgetToGrpd, Core.functorToCoreEquiv_apply, Core.functorToCore_comp_inclusion,
-      Functor.assoc])
+    · apply CategoryTheory.Functor.ext
+      · intros X Y f
+        simp
+      · intro x; rfl
+    · erw [toPGrpd_forgetToGrpd, Core.functorToCoreEquiv_apply, Core.functorToCore_comp_inclusion,
+        Functor.assoc])
   (isPullbackClassifierOfAsSmall (toCoreAsSmallEquiv A))
   (by
     dsimp [Ctx.coreAsSmallFunctor, Grpd.homOf]
@@ -209,6 +217,8 @@ def isPullbackClassifierOfCoreAsSmall (A : Γ ⟶ Ty) :
     · rw [U.var, ← toCoreAsSmallEquiv_symm_apply_comp_left,
         ← toCoreAsSmallEquiv_symm_apply_comp_right, toPGrpd_forgetToGrpd])
 
+-- Unfold bundled groupoid morphisms when transferring the classifier square.
+set_option backward.isDefEq.respectTransparency false in
 /--
   The following square is a pullback in `Ctx`
   Ty.ext A --- Ty.var A ---> Tm
@@ -222,8 +232,10 @@ def isPullbackClassifierOfCoreAsSmall (A : Γ ⟶ Ty) :
      Γ --------- A ------> Ty
 -/
 theorem disp_pullback (A : Γ ⟶ Ty) : IsPullback (var A) forget tp A := by
-  convert Grpd.isPullback (isPullbackClassifierOfCoreAsSmall A)
-  simp
+  have h := Grpd.isPullback (isPullbackClassifierOfCoreAsSmall A)
+  change IsPullback (var A) forget tp (toCoreAsSmallEquiv.symm (toCoreAsSmallEquiv A)) at h
+  rw [toCoreAsSmallEquiv.symm_apply_apply] at h
+  exact h
 
 end IsPullback
 end GroupoidModel
diff --git a/HoTTLean/Groupoids/Pi.lean b/HoTTLean/Groupoids/Pi.lean
index 2c5f2ef0..4c8230e2 100644
--- a/HoTTLean/Groupoids/Pi.lean
+++ b/HoTTLean/Groupoids/Pi.lean
@@ -33,8 +33,10 @@ variable {A B : Type*} [Category A] [Category B] (F : B ⥤ A)
 def IsSection : ObjectProperty (A ⥤ B) := fun s => s ⋙ F = Functor.id A
 
 def IsOverId : MorphismProperty ((IsSection F).FullSubcategory) :=
-  fun s t α => Functor.whiskerRight α F = eqToHom s.property ≫ 𝟙 (𝟭 A) ≫ eqToHom t.property.symm
+  fun s t α => Functor.whiskerRight α.hom F = eqToHom s.property ≫ 𝟙 (𝟭 A) ≫ eqToHom t.property.symm
 
+-- Let transport simplification unfold the section predicate in proof types.
+set_option backward.isDefEq.respectTransparency false in
 instance : (IsOverId F).IsMultiplicative where
   id_mem := by
     intro s
@@ -58,15 +60,18 @@ instance {A B : Type*} [Category A] [Groupoid B] (F : B ⥤ A) :
     IsGroupoid ((IsSection F).FullSubcategory) :=
   InducedCategory.isGroupoid (A ⥤ B) (ObjectProperty.ι _).obj
 
+-- Let transport simplification unfold the section predicate in proof types.
+set_option backward.isDefEq.respectTransparency false in
 instance {A B : Type*} [Category A] [Groupoid B] (F : B ⥤ A) :
     IsGroupoid (Section F) where
   all_isIso {x y} f := {
-    out := ⟨⟨ CategoryTheory.inv f.1,
-      by
-        simp only [IsOverId, Category.id_comp, eqToHom_trans, Set.mem_setOf_eq]
-        erw [← Functor.inv_whiskerRight]
+    out := ⟨⟨ CategoryTheory.inv f.1, by
+        simp only [IsOverId, Category.id_comp, eqToHom_trans, Set.mem_ofPred_eq]
+        change Functor.whiskerRight ((ObjectProperty.ι (IsSection F)).map (inv f.1)) F = _
+        rw [Functor.map_inv, ← Functor.inv_whiskerRight]
+        change inv (Functor.whiskerRight f.1.hom F) = _
         rw! [f.2]
-        simp⟩,
+        simp only [Category.id_comp, eqToHom_trans, inv_eqToHom]⟩,
       by apply MorphismProperty.WideSubcategory.hom_ext; simp,
       by apply MorphismProperty.WideSubcategory.hom_ext; simp⟩
   }
@@ -86,9 +91,9 @@ lemma ι_mono {T C : Type u} [Category.{v} C] [Category.{v} T]
     ext
     exact Functor.congr_obj e X
   · intro X
-    simp only [Functor.fullyFaithfulCancelRight_hom_app, Functor.preimage, ι_obj, ι_map,
-      eqToIso.hom, eqToHom_app, Functor.comp_obj, Classical.choose_eq]
-    rfl
+    apply (ι Z).map_injective
+    simp only [Functor.fullyFaithfulCancelRight_hom_app, Functor.map_preimage,
+      eqToIso.hom, eqToHom_map, eqToHom_app, Functor.comp_obj]
 
 end ObjectProperty
 
@@ -212,14 +217,16 @@ lemma conjugatingObjNatTransEquiv'_id (x : Γ) (S) (T) (g) :
     conjugatingObjNatTransEquiv' A B (𝟙 x) S T g =
     eqToHom (by simp) ≫ g ≫ eqToHom (by simp) := by
   ext
-  simp [conjugatingObjNatTransEquiv', Grpd.Functor.iso]
+  change (eqToHom _ ≫ whiskerLeft (Grpd.Functor.iso A (𝟙 x)).hom g).app _ = _
+  simp [Grpd.Functor.iso_id]
 
 lemma conjugatingObjNatTransEquiv'_comp {x y z : Γ} (f1 : x ⟶ y) (f2 : y ⟶ z) (S) (T) (g) :
     conjugatingObjNatTransEquiv' A B (f1 ≫ f2) S T g =
     eqToHom (by simp [Grpd.Functor.iso, ← Grpd.comp_eq_comp]) ≫
     (A.map f1 ⋙ A.map f2).whiskerLeft g ≫
     eqToHom (by simp [Grpd.Functor.iso, ← Grpd.comp_eq_comp]) := by
-  simp [conjugatingObjNatTransEquiv', Grpd.Functor.iso]
+  dsimp only [conjugatingObjNatTransEquiv', Equiv.coe_fn_mk]
+  simp [Grpd.Functor.iso, Grpd.functorIsoOfIso]
   rw! [Functor.map_comp A f1 f2]
   simp
 
@@ -251,6 +258,8 @@ theorem whiskerLeft_twice' {A B C D : Type*} [Category A] [Category B] [Category
     whiskerLeft (F ⋙ G) α :=
   rfl
 
+-- The proof unfolds bundled groupoid coercions during dependent rewriting.
+set_option backward.isDefEq.respectTransparency false in
 lemma conjugatingObjNatTransEquiv'_comp' {x y z : Γ} (f1 : x ⟶ y) (f2 : y ⟶ z)
     (S0 : (A.obj x) ⥤ (B.obj x))
     (S1 : (A.obj y) ⥤ (B.obj y))
@@ -267,11 +276,12 @@ lemma conjugatingObjNatTransEquiv'_comp' {x y z : Γ} (f1 : x ⟶ y) (f2 : y ⟶
     (whiskerLeft (A.map f1) (conjugatingObjNatTransEquiv' A B f2 S1 S2 g12)) ≫
     eqToHom (by simp [← Grpd.comp_eq_comp, Grpd.Functor.iso]) := by
   subst h
-  simp only [Grpd.Functor.iso, Grpd.functorIsoOfIso_hom, mapIso_hom, asIso_hom,
-    Grpd.functorIsoOfIso_inv, mapIso_inv, asIso_inv, conjugatingObjNatTransEquiv', eqToHom_refl,
+  simp only [Grpd.Functor.iso,
+       conjugatingObjNatTransEquiv', eqToHom_refl,
     Category.id_comp, Equiv.coe_fn_mk, whiskerLeft_comp, whiskerLeft_eqToHom, eqToHom_trans_assoc,
     whiskerRight_comp, eqToHom_whiskerRight, whiskerLeft_twice, associator_eq,
     CategoryTheory.Iso.refl_inv, CategoryTheory.Iso.refl_hom, Category.comp_id, Category.assoc] at *
+  dsimp only [Grpd.functorIsoOfIso, Functor.mapIso, asIso] at *
   erw [Category.id_comp]
   rw [whiskerLeft_map_comp, whiskerLeft_map_comp]
   simp only [← Category.assoc, eqToHom_trans]
@@ -294,6 +304,8 @@ def conjugatingObjNatTransEquiv₁ {x y : Γ} (f : x ⟶ y) (S) (T) :
     (S ⋙ B.map f ≅ A.map f ⋙ T) := (conjugatingObjNatTransEquiv' A B f S T).trans
     (Groupoid.isoEquivHom (S ⋙ B.map f) (A.map f ⋙ T)).symm
 
+-- Dependent rewriting unfolds bundled groupoid coercions.
+set_option backward.isDefEq.respectTransparency false in
 @[simp]
 lemma conjugatingObjNatTransEquiv₁_id_inv {x : Γ} (S) (T)
     (g : A.map (inv (𝟙 x)) ⋙ S ⋙ B.map (𝟙 x) ⟶ T) :
@@ -303,8 +315,10 @@ lemma conjugatingObjNatTransEquiv₁_id_inv {x : Γ} (S) (T)
   erw [conjugatingObjNatTransEquiv'_id]
   simp [Groupoid.isoEquivHom]
 
+-- Dependent rewriting unfolds bundled groupoid coercions.
+set_option backward.isDefEq.respectTransparency false in
 lemma conjugatingObjNatTransEquiv₁_comp_inv {x y z : Γ} (f1 : x ⟶ y) (f2 : y ⟶ z)
-      (S0 : (A.obj x) ⥤ (B.obj x))
+    (S0 : (A.obj x) ⥤ (B.obj x))
       (S1 : (A.obj y) ⥤ (B.obj y))
       (S2 : (A.obj z) ⥤ (B.obj z))
       (g01 : A.map (inv f1) ⋙ S0 ⋙ B.map f1 ⟶ S1)
@@ -318,7 +332,7 @@ lemma conjugatingObjNatTransEquiv₁_comp_inv {x y z : Γ} (f1 : x ⟶ y) (f2 :
       whiskerLeft (A.map f1) (conjugatingObjNatTransEquiv₁ A B f2 S1 S2 g12).inv ≫
       whiskerRight ((conjugatingObjNatTransEquiv₁ A B f1 S0 S1 g01).inv) (B.map f2) ≫
       eqToHom (by simp [← Grpd.comp_eq_comp]) := by
-  dsimp [conjugatingObjNatTransEquiv₁]
+  simp only [conjugatingObjNatTransEquiv₁, Equiv.trans_apply]
   erw [conjugatingObjNatTransEquiv'_comp' A B f1 f2 S0 S1 S2 g01 g12 g02 h]
   simp [Groupoid.isoEquivHom]
   rfl
@@ -332,12 +346,12 @@ variable {Γ : Type u₂} [Groupoid.{v₂} Γ] {A : Γ ⥤ Grpd.{u₁,u₁}}
 
 def functorObj (x : Γ) : Grpd.{u₁,u₁} := Grpd.of (Section (φ.app x))
 
-def obj_hext {A A' : Grpd.{u₁,u₁}} (hA : A ≍ A') {B B' : Grpd.{u₁,u₁}} (hB : B ≍ B')
+theorem obj_hext {A A' : Grpd.{u₁,u₁}} (hA : A ≍ A') {B B' : Grpd.{u₁,u₁}} (hB : B ≍ B')
     {F : A ⟶ B} {F' : A' ⟶ B'} (hF : F ≍ F') (x : Section F) (x' : Section F')
     (hx : x.obj.obj ≍ x'.obj.obj) : x ≍ x' := by
   aesop
 
-def hom_hext {A A' : Grpd.{u₁,u₁}} (hA : A ≍ A') {B B' : Grpd.{u₁,u₁}} (hB : B ≍ B')
+theorem hom_hext {A A' : Grpd.{u₁,u₁}} (hA : A ≍ A') {B B' : Grpd.{u₁,u₁}} (hB : B ≍ B')
     {F : A ⟶ B} {F' : A' ⟶ B'} (hF : F ≍ F') {x y : Section F} {x' y' : Section F'}
     {f : x ⟶ y} {f' : x' ⟶ y'} (hx : x ≍ x')
     (hy : y ≍ y') (hf : f.1 ≍ f'.1) :
@@ -347,14 +361,15 @@ def hom_hext {A A' : Grpd.{u₁,u₁}} (hA : A ≍ A') {B B' : Grpd.{u₁,u₁}}
   apply MorphismProperty.WideSubcategory.hom_ext
   apply hf
 
-def hom_hext' {A A' : Grpd.{u₁,u₁}} (hA : A ≍ A') {B B' : Grpd.{u₁,u₁}} (hB : B ≍ B')
+theorem hom_hext' {A A' : Grpd.{u₁,u₁}} (hA : A ≍ A') {B B' : Grpd.{u₁,u₁}} (hB : B ≍ B')
     {F : A ⟶ B} {F' : A' ⟶ B'} (hF : F ≍ F') {x y : Section F} {x' y' : Section F'}
     {f : x ⟶ y} {f' : x' ⟶ y'} (hx : x ≍ x')
-    (hy : y ≍ y') (hf : ∀ k k', k ≍ k' → f.1.app k ≍ f'.1.app k') :
+    (hy : y ≍ y') (hf : ∀ k k', k ≍ k' → f.1.hom.app k ≍ f'.1.hom.app k') :
     f ≍ f' := by
   subst hA hB hF hx hy
   simp at *
   apply MorphismProperty.WideSubcategory.hom_ext
+  apply InducedCategory.hom_ext
   apply NatTrans.ext
   ext
   apply hf
@@ -363,6 +378,8 @@ section
 
 variable {x y : Γ} (f : x ⟶ y)
 
+-- Allow the bundled groupoid projections to unfold when elaborating section maps.
+set_option backward.isDefEq.respectTransparency false in
 /-- The functorial action of `pi` on a morphism `f : x ⟶ y` in `Γ`
 is given by "conjugation".
 Since `piObj B x` is a subcategory of `sigma A B x ⥤ A x`,
@@ -384,30 +401,37 @@ def functorMap : functorObj φ x ⥤ functorObj φ y :=
   ((Section.ι _ ⋙ conjugating A B f))
   (by
     intro s
-    have := s.obj.property
-    simp only [IsSection, ← Grpd.comp_eq_comp, ← Grpd.id_eq_id, Functor.comp_obj,
-      MorphismProperty.wideSubcategoryInclusion.obj, ObjectProperty.ι_obj, conjugating_obj,
-      Functor.map_inv, Category.assoc, NatTrans.naturality] at *
-    slice_lhs 2 3 => rw [this]
-    simp [- Grpd.comp_eq_comp, - Grpd.id_eq_id]))
+    have hsec := s.obj.property
+    change (A.map (inv f) ⋙ s.obj.obj ⋙ B.map f) ⋙ φ.app y = 𝟭 _
+    change s.obj.obj ⋙ φ.app x = 𝟭 _ at hsec
+    have hn : B.map f ⋙ φ.app y = φ.app x ⋙ A.map f := by
+      simpa only [Grpd.comp_eq_comp] using φ.naturality f
+    calc
+      _ = A.map (inv f) ⋙ (s.obj.obj ⋙ φ.app x) ⋙ A.map f := by
+        rw [Functor.assoc, Functor.assoc, hn]
+        simp only [Functor.assoc]
+      _ = _ := by rw [hsec]; simp [← Grpd.comp_eq_comp]
+    )
+  )
   (by
     intro s t α
-    have := α.property
-    simp only [IsOverId, ← Grpd.comp_eq_comp, Category.id_comp, eqToHom_trans, Set.mem_setOf_eq,
-      ObjectProperty.lift_obj_obj, Functor.comp_obj, MorphismProperty.wideSubcategoryInclusion.obj,
-      ObjectProperty.ι_obj, ObjectProperty.lift_map, Functor.comp_map,
+    have h := α.property
+    ext a
+    simp only [IsOverId, Set.mem_ofPred_eq] at h ⊢
+    simp only [ObjectProperty.lift_map, Functor.comp_map,
       MorphismProperty.wideSubcategoryInclusion.map, ObjectProperty.ι_map, conjugating_map,
-      Functor.whiskerRight_twice, Functor.associator_eq, Iso.refl_hom, Iso.refl_inv] at *
-    rw [Functor.whiskerRight_whiskerLeft]
-    conv => left; left; rw! (castMode := .all) [φ.naturality, Grpd.comp_eq_comp]
-    erw [Functor.comp_whiskerRight, this, Category.comp_id]
-    simp only [Grpd.comp_eq_comp, Functor.eqToHom_whiskerRight, Functor.whiskerLeft_eqToHom,
-      ← heq_eq_eq, eqRec_heq_iff_heq]
-    congr! 1
-    · simp only [← Grpd.comp_eq_comp, ← φ.naturality]
-      rfl
-    · simp only [← Grpd.comp_eq_comp, ← φ.naturality]
-      rfl)
+      Functor.whiskerRight_app, NatTrans.comp_app,
+        Category.id_comp, eqToHom_app] at *
+    dsimp only [ObjectProperty.homMk] at *
+    simp only [
+        Functor.whiskerRight_app, Functor.whiskerLeft_app] at *
+    have hn : B.map f ⋙ φ.app y = φ.app x ⋙ A.map f := by
+      simpa only [Grpd.comp_eq_comp] using φ.naturality f
+    have hh := congrArg (fun η => η.app ((A.map (inv f)).obj a)) h
+    simp only [Functor.whiskerRight_app, NatTrans.comp_app, eqToHom_app] at hh
+    rw [← Functor.comp_map, Functor.congr_hom hn, Functor.comp_map, hh]
+    simp only [eqToHom_map, eqToHom_trans]
+    )
 
 def functor : Γ ⥤ Grpd.{u₁,u₁} where
   obj := functorObj φ
@@ -420,13 +444,17 @@ lemma functor_comp {Δ : Type u₃} [Groupoid.{v₃} Δ] (σ : Δ ⥤ Γ) :
     σ ⋙ functor φ := by
   fapply CategoryTheory.Functor.ext
   · intro x
-    simp [functor, functorObj]
+    rfl
   · intro x y f
-    simp [functor, functorMap]
+    -- The object equalities above are definitionally reflexive at full transparency.
+    set_option backward.isDefEq.respectTransparency false in
+      simp [functor, functorMap]
 
+-- Unfold bundled groupoid projections while elaborating this dependent equation.
+set_option backward.isDefEq.respectTransparency false in
 @[simp]
-lemma functor_map_map {s t} (α : s ⟶ t) : (((functor φ).map f).map α).1 =
-    Functor.whiskerRight (Functor.whiskerLeft (A.map (inv f)) α.1) (B.map f) := by
+lemma functor_map_map {s t} (α : s ⟶ t) : (((functor φ).map f).map α).1.hom =
+    Functor.whiskerRight (Functor.whiskerLeft (A.map (inv f)) α.1.hom) (B.map f) := by
   simp [functor, functorMap, conjugating, MorphismProperty.lift]
 
 end
@@ -443,37 +471,48 @@ variable (app : (x : Γ) → A.obj x ⥤ B.obj x)
     Functor.whiskerRight (naturality f).hom (B.map g)
     ≫ eqToHom (by simp [Functor.assoc]))
 
-def strongTrans : (A ⋙ Grpd.forgetToCat).toPseudoFunctor'.StrongTrans
-    (B ⋙ Grpd.forgetToCat).toPseudoFunctor' where
-  app x := app x.as
-  naturality f := naturality f.as
+-- Cat 2-cell projections require bundled pseudofunctor coercions to unfold during rewriting.
+set_option backward.isDefEq.respectTransparency false in
+def strongTrans : (A ⋙ Grpd.forgetToCat).toPseudofunctor'.StrongTrans
+    (B ⋙ Grpd.forgetToCat).toPseudofunctor' where
+  app x := (app x.as).toCatHom
+  naturality f := Cat.Hom.isoMk (naturality f.as)
   naturality_naturality := by
     intro x y f g η
     have := LocallyDiscrete.eq_of_hom η
     subst this
-    simp only [Functor.toPseudoFunctor', Functor.comp_obj, Functor.comp_map, LocallyDiscrete.id_as,
-      LocallyDiscrete.comp_as, pseudofunctorOfIsLocallyDiscrete, Bicategory.whiskerRight,
+    simp only [Functor.toPseudofunctor', Functor.comp_obj, Functor.comp_map,
+       pseudofunctorOfIsLocallyDiscrete, Bicategory.whiskerRight,
       eqToHom_refl, Bicategory.whiskerLeft]
-    aesop
+    apply Cat.Hom₂.ext
+    simp [Cat.Hom.toNatTrans_comp]
   naturality_id := by
     intro x
-    simp only [Functor.toPseudoFunctor', Functor.comp_obj, Functor.comp_map, LocallyDiscrete.id_as,
-      LocallyDiscrete.comp_as, pseudofunctorOfIsLocallyDiscrete, Bicategory.whiskerLeft,
+    apply Cat.Hom₂.ext
+    simp only [Functor.toPseudofunctor', Functor.comp_obj, Functor.comp_map, LocallyDiscrete.id_as,
+       pseudofunctorOfIsLocallyDiscrete, Bicategory.whiskerLeft,
       eqToIso.hom, Bicategory.whiskerRight, Bicategory.leftUnitor, Bicategory.rightUnitor]
+    simp only [Cat.Hom.toNatTrans_comp, Cat.Hom₂.eqToHom_toNatTrans] at *
+    dsimp only [Cat.Hom.isoMk, NatTrans.toCatHom₂, Functor.toCatHom]
     rw [Functor.eqToHom_whiskerRight, Functor.leftUnitor_hom_comp_rightUnitor_inv,
       Functor.whiskerLeft_eqToHom, naturality_id]
-    simp
-    conv => right; apply Category.comp_id
+    simp []
   naturality_comp := by
     intro x y z f g
-    simp only [Grpd.forgetToCat, Functor.toPseudoFunctor', Functor.comp_obj, Functor.comp_map,
-      id_eq, LocallyDiscrete.id_as, LocallyDiscrete.comp_as, pseudofunctorOfIsLocallyDiscrete,
-      naturality_comp, eqToHom_refl, Category.id_comp, Bicategory.whiskerLeft, Cat.of_α,
-      eqToIso.hom, Category.assoc, Bicategory.whiskerRight, Bicategory.associator,
-      Functor.associator_eq, Iso.refl_hom, Iso.refl_inv]
+    change Discrete (x.as ⟶ y.as) at f
+    change Discrete (y.as ⟶ z.as) at g
+    cases f with | mk f =>
+    cases g with | mk g =>
+    apply Cat.Hom₂.ext
+    simp only [Grpd.forgetToCat, Functor.toPseudofunctor', Functor.comp_obj, Functor.comp_map,
+        LocallyDiscrete.comp_as, pseudofunctorOfIsLocallyDiscrete,
+         Bicategory.whiskerLeft, Cat.of_α,
+      eqToIso.hom, Bicategory.whiskerRight, Bicategory.associator,
+      Functor.associator_eq]
+    simp only [Cat.Hom.toNatTrans_comp, Cat.Hom₂.eqToHom_toNatTrans] at *
     rw [Functor.eqToHom_whiskerRight, Functor.whiskerLeft_eqToHom]
     erw [Category.id_comp, Category.id_comp, Category.comp_id]
-    simp
+    simp [Cat.Hom.toNatTrans_comp, naturality_comp]
 
 lemma strongTrans_comp_toStrongTrans'_self_aux (happ : ∀ x, app x ⋙ φ.app x = 𝟭 _)
     {x y} (f : x ⟶ y) (a : A.obj x) :
@@ -484,6 +523,8 @@ lemma strongTrans_comp_toStrongTrans'_self_aux (happ : ∀ x, app x ⋙ φ.app x
   erw [Functor.congr_obj (happ x)]
   simp
 
+-- Unfold bundled groupoid projections in the Cat 2-cell equations.
+set_option backward.isDefEq.respectTransparency false in
 open CategoryTheory.Pseudofunctor.StrongTrans in
 lemma strongTrans_comp_toStrongTrans'_self (happ : ∀ x, app x ⋙ φ.app x = 𝟭 _)
     (hnaturality : ∀ {x y} (f : x ⟶ y) (a : A.obj x),
@@ -493,29 +534,46 @@ lemma strongTrans_comp_toStrongTrans'_self (happ : ∀ x, app x ⋙ φ.app x = 
     (Functor.whiskerRight φ Grpd.forgetToCat).toStrongTrans' = 𝟙 _ := by
   fapply Pseudofunctor.StrongTrans.ext
   · intro x
-    simp only [Grpd.forgetToCat, Functor.toPseudoFunctor'_obj, Functor.comp_obj, strongTrans,
-      comp_app, NatTrans.toStrongTrans'_app, Functor.whiskerRight_app, id_eq, categoryStruct_id_app]
-    apply happ
+    simp only [Grpd.forgetToCat, strongTrans,
+      comp_app, NatTrans.toStrongTrans'_app, Functor.whiskerRight_app, categoryStruct_id_app]
+    apply Cat.ext
+    exact happ x.as
   · intro x y f
+    change Discrete (x.as ⟶ y.as) at f
+    obtain ⟨g⟩ := f
+    apply Cat.Hom₂.ext
     ext a
-    simp only [Grpd.forgetToCat, Functor.toPseudoFunctor'_obj, Functor.comp_obj, Cat.of_α,
-      Functor.toPseudoFunctor'_map, Functor.comp_map, id_eq, strongTrans, comp_app,
-      NatTrans.toStrongTrans'_app, Functor.whiskerRight_app, Cat.comp_obj, categoryStruct_id_app,
-      Cat.id_obj, categoryStruct_comp_naturality_hom, Bicategory.associator,
+    simp only [Grpd.forgetToCat,
+         strongTrans, comp_app,
+       Functor.whiskerRight_app,
+      categoryStruct_comp_naturality_hom, Bicategory.associator,
       NatTrans.toStrongTrans'_naturality, eqToIso.hom, Bicategory.whiskerLeft_eqToHom,
-      Category.assoc, Cat.comp_app, Functor.associator_inv_app, Cat.whiskerRight_app,
-      Functor.associator_hom_app, Cat.eqToHom_app, Category.id_comp, eqToHom_trans,
+      Cat.Hom.toNatTrans_comp, Cat.Hom₂.eqToHom_toNatTrans,
+       Cat.whiskerRight_toNatTrans,
+      NatTrans.comp_app, Functor.whiskerRight_app,
+      Category.assoc,
+       eqToHom_app,
       categoryStruct_id_naturality_hom, Bicategory.rightUnitor, Bicategory.leftUnitor,
-      Functor.rightUnitor_hom_app, Functor.leftUnitor_inv_app, Category.comp_id, ← heq_eq_eq,
-      comp_eqToHom_heq_iff]
+         ← heq_eq_eq]
+    dsimp only [Cat.Hom.isoMk, NatTrans.toCatHom₂, Functor.toCatHom,
+      NatTrans.toStrongTrans', Functor.whiskerRight, Functor.toPseudofunctor',
+      pseudofunctorOfIsLocallyDiscrete, Grpd.forgetToCat]
+    simp only [Functor.associator_inv_app, Functor.associator_hom_app,
+      Functor.leftUnitor_inv_app, Functor.rightUnitor_hom_app, Category.comp_id]
     rw! [hnaturality]
+    dsimp only [Functor.comp_map, Grpd.forgetToCat, Functor.toCatHom, Functor.comp_obj]
+    -- Fix the category before simplifying the identity and transport maps.
+    change (𝟙 _ ≫ eqToHom _ ≫ 𝟙 _ ≫ eqToHom _ ≫ 𝟙 _ ≫ eqToHom _ :
+      _ ⟶ (A.map g).obj a) ≍
+      (eqToHom _ ≫ 𝟙 _ : _ ⟶ (A.map g).obj a)
+    simp only [Category.id_comp, Category.comp_id, eqToHom_trans]
     apply eqToHom_heq_eqToHom
     rfl
 
 def mapStrongTrans : ∫ A ⥤ ∫ B :=
-  (Functor.Grothendieck.toPseudoFunctor'Iso _).hom ⋙
+  (Functor.Grothendieck.toPseudofunctor'Iso _).hom ⋙
   Pseudofunctor.Grothendieck.map (strongTrans app naturality naturality_id naturality_comp) ⋙
-  (Functor.Grothendieck.toPseudoFunctor'Iso _).inv
+  (Functor.Grothendieck.toPseudofunctor'Iso _).inv
 
 @[simp]
 lemma mapStrongTrans_obj_base (x) :
@@ -539,6 +597,8 @@ lemma mapStrongTrans_map_fiber {x y} (f : x ⟶ y) :
     (naturality f.base).inv.app x.fiber ≫ (app y.base).map f.fiber :=
   rfl
 
+-- The Grothendieck functor coercions require backward transparency for these rewrites.
+set_option backward.isDefEq.respectTransparency false in
 lemma mapStrongTrans_comp_map_self (happ : ∀ x, app x ⋙ φ.app x = 𝟭 _)
     (hnaturality : ∀ {x y} (f : x ⟶ y) (a : A.obj x),
       (φ.app y).map ((naturality f).hom.app a) =
@@ -563,26 +623,30 @@ section
 
 def sigma.fstNatTrans : sigma A B ⟶ A where
   app x := forget
-  naturality x y f:= by simp [sigmaMap_forget]
+  naturality x y f := by rfl
 
 @[simp]
 lemma sigma.fstNatTrans_app (x) : (fstNatTrans A B).app x = Functor.Groupoidal.forget :=
   rfl
 
+-- The associator projections cross bundled groupoid coercions.
+set_option backward.isDefEq.respectTransparency false in
 lemma sigma.map_fstNatTrans_eq : map (fstNatTrans A B) = (assoc B).inv ⋙ forget := by
   apply Functor.Groupoidal.FunctorTo.hext
   · simp [Functor.assoc, assoc_inv_comp_forget_comp_forget, map_forget]
   · intro x
-    simp only [fstNatTrans, map_obj_fiber, sigma_obj, Functor.Groupoidal.forget_obj, assoc,
-      Functor.Iso.symm_inv, Functor.comp_obj, functorIsoFrom_hom_obj, assocFib, heq_eq_eq]
+    simp only [fstNatTrans, map_obj_fiber, Functor.Groupoidal.forget_obj, assoc,
+      Functor.Iso.symm_inv, Functor.comp_obj, functorIsoFrom,
+      Functor.Grothendieck.functorIsoFrom, Functor.Grothendieck.functorFrom, assocFib, heq_eq_eq]
     rw! (castMode := .all) [pre_obj_base]
     simp
     rfl
   · intro x y f
-    simp only [fstNatTrans, map_map_fiber, sigma_obj, Grpd.comp_eq_comp, Functor.comp_obj,
-      Functor.Groupoidal.forget_obj, sigma_map, sigmaMap_obj_base, eqToHom_refl, forget_map,
-      Category.id_comp, assoc, Functor.Iso.symm_inv, functorIsoFrom_hom_obj, assocFib,
-      Functor.comp_map, functorIsoFrom_hom_map, comp_base, Functor.Groupoidal.comp_fiber,
+    simp only [fstNatTrans, map_map_fiber, Grpd.comp_eq_comp, Functor.comp_obj,
+      Functor.Groupoidal.forget_obj, eqToHom_refl, forget_map,
+      Category.id_comp, assoc, Functor.Iso.symm_inv, functorIsoFrom,
+      Functor.Grothendieck.functorIsoFrom, Functor.Grothendieck.functorFrom, assocFib,
+      Functor.comp_map, comp_base, Functor.Groupoidal.comp_fiber,
       heq_eqToHom_comp_iff]
     rw! [pre_map_base]
     simp only [ι_map_base, ι_obj_base, assocHom, assocFib, assocIso, ι_map_fiber, ι_obj_fiber]
@@ -618,7 +682,9 @@ as the induced map in the following diagram
 lemma pi.obj_hext {A A' : Γ ⥤ Grpd.{u₁,u₁}} (hA : A ≍ A') {B : ∫ A ⥤ Grpd.{u₁,u₁}}
     {B' : ∫ A' ⥤ Grpd.{u₁,u₁}} (hB : B ≍ B') (x : Γ)
     (f : (pi A B).obj x) (f' : (pi A' B').obj x) (hf : f.obj.obj ≍ f'.obj.obj) : f ≍ f' := by
-  aesop
+  subst hA hB
+  simp at *
+  exact eq_of_heq (Section.obj_hext HEq.rfl HEq.rfl HEq.rfl f f' (heq_of_eq hf))
 
 end
 
@@ -643,8 +709,8 @@ lemma comm_sq_of_comp_mono {C : Type*} [Category C]
     (hh : h ≫ mW = mX ≫ h')
     (hg : g ≫ mZ = mY ≫ g')
     (hi : i ≫ mZ = mW ≫ i')
-    [e : Mono mZ]
-    : f ≫ g = h ≫ i := by
+    [e : Mono mZ] :
+    f ≫ g = h ≫ i := by
   apply e.right_cancellation
   calc (f ≫ g) ≫ mZ
     _ = f ≫ mY ≫ g' := by aesop
@@ -664,7 +730,7 @@ theorem pi_comp : pi (σ ⋙ A) (pre A σ ⋙ B) = σ ⋙ pi A B := by
       apply sigma_naturality
     · rfl
     · intro x
-      simp only [sigma_obj, Functor.comp_obj, sigma.fstNatTrans, Functor.whiskerLeft_app]
+      simp only [Functor.comp_obj, sigma.fstNatTrans, Functor.whiskerLeft_app]
       congr 1
       rw [← Functor.assoc, ι_comp_pre]
 
@@ -693,42 +759,50 @@ lemma strongTrans.app_map_base (y) {a a'} (f : a ⟶ a') :
     ((strongTrans.app B s hs y).map f).base = eqToHom (by simp) ≫
     f ≫ eqToHom (by simp) := by
   have := Functor.congr_hom (PGrpd.objFiber' hs y).obj.property f
-  simp at this
-  simp [strongTrans.app, this]
+  exact this
 
 def strongTrans.twoCell {x y : Γ} (g : x ⟶ y) :
     A.map (CategoryTheory.inv g) ⋙ strongTrans.app B s hs x ⋙ sigmaMap B g ⟶
-  strongTrans.app B s hs y := (PGrpd.mapFiber' hs g).1
+  strongTrans.app B s hs y := (PGrpd.mapFiber' hs g).1.hom
 
+-- The equality crosses the bundled groupoid coercion in functor composition.
+set_option backward.isDefEq.respectTransparency false in
 lemma strongTrans.twoCell_app_base_aux {x y : Γ} (g : x ⟶ y) (a) :
     base ((A.map (CategoryTheory.inv g) ⋙ app B s hs x ⋙ sigmaMap B g).obj a) =
     base ((app B s hs y).obj a) := by
-  simp only [Functor.map_inv, sigma_obj, Functor.comp_obj, sigmaMap_obj_base, app_obj_base]
+  simp only [Functor.map_inv, Functor.comp_obj, sigmaMap_obj_base, app_obj_base]
   simp [← Functor.comp_obj, ← Grpd.comp_eq_comp]
 
+-- The bundled groupoid coercions in the whiskered component require backward unfolding.
+set_option backward.isDefEq.respectTransparency false in
 @[simp]
 lemma strongTrans.twoCell_app_base {x y : Γ} (g : x ⟶ y) (a) :
     ((strongTrans.twoCell B s hs g).app a).base = eqToHom (twoCell_app_base_aux ..) := by
   have := NatTrans.congr_app (PGrpd.mapFiber' hs g).2 a
-  simp only [sigma_obj, sigma.fstNatTrans_app, pi_obj_α, Functor.comp_obj,
-    Functor.Groupoidal.forget_obj, IsOverId, Set.mem_setOf_eq, Functor.whiskerRight_app, forget_map,
+  simp only [sigma.fstNatTrans_app, Functor.comp_obj,
+    Functor.Groupoidal.forget_obj, IsOverId, Functor.whiskerRight_app, forget_map,
     Category.id_comp, eqToHom_trans, eqToHom_app] at this
   rw [twoCell, this]
 
+-- Map the section transport through its typed inclusion into the functor category.
+set_option backward.isDefEq.respectTransparency false in
 @[simp]
 lemma strongTrans.twoCell_id (x) :
     twoCell B s hs (𝟙 x) = eqToHom (by simp) := by
-  simp [twoCell]
-  rfl
+  have h := congrArg ((Section.ι ((sigma.fstNatTrans A B).app x)).map)
+    (PGrpd.mapFiber'_id hs (x := x))
+  exact h.trans (eqToHom_map _ _)
 
 set_option maxHeartbeats 400000 in
 lemma strongTrans.pi_map_map {x y z} (f : x ⟶ y) (g : y ⟶ z) :
-    (((pi A B).map g).map (PGrpd.mapFiber' hs f)).1 =
+    (((pi A B).map g).map (PGrpd.mapFiber' hs f)).1.hom =
     Functor.whiskerLeft (A.map (CategoryTheory.inv g))
     (Functor.whiskerRight (twoCell B s hs f) (sigmaMap B g)) :=
   Section.functor_map_map (A := A)
     (B := sigma A B) (sigma.fstNatTrans A B) g (PGrpd.mapFiber' hs f)
 
+-- Use the same typed inclusion for the composite section transport.
+set_option backward.isDefEq.respectTransparency false in
 set_option maxHeartbeats 300000 in
 /--
 ```
@@ -746,49 +820,72 @@ lemma strongTrans.twoCell_comp {x y z} (f : x ⟶ y) (g : y ⟶ z) :
     Functor.whiskerLeft (A.map (CategoryTheory.inv g))
       (Functor.whiskerRight (twoCell B s hs f) (sigmaMap B g)) ≫
     twoCell B s hs g := by
-  conv => left; simp only [twoCell, sigma_obj, pi_obj_α, Set.mem_setOf_eq,
-    PGrpd.mapFiber'_comp' hs f g, MorphismProperty.WideSubcategory.comp_def,
-    MorphismProperty.WideSubcategory.coe_eqToHom, pi_map_map]
-  rfl
+  have h := congrArg ((Section.ι ((sigma.fstNatTrans A B).app z)).map)
+    (PGrpd.mapFiber'_comp' hs f g)
+  simp only [Functor.map_comp, eqToHom_map] at h
+  change twoCell B s hs (f ≫ g) =
+    eqToHom _ ≫ (((pi A B).map g).map (PGrpd.mapFiber' hs f)).1.hom ≫
+      twoCell B s hs g at h
+  rw [strongTrans.pi_map_map] at h
+  exact h
 
 def strongTrans.naturality {x y : Γ} (g : x ⟶ y) :
     A.map g ⋙ strongTrans.app B s hs y ≅ strongTrans.app B s hs x ⋙ sigmaMap B g :=
   ((conjugatingObjNatTransEquiv₁ _ _ _ _ _).toFun (twoCell B s hs g)).symm
 
+-- Unfold the bundled groupoid functor coercions while elaborating this projection.
+set_option backward.isDefEq.respectTransparency false in
 lemma strongTrans.naturality_inv_app {x y} (f : x ⟶ y) (a) :
     (strongTrans.naturality B s hs f).inv.app a =
     eqToHom (by simp [← Functor.comp_obj]; simp [← Grpd.comp_eq_comp]) ≫
     (twoCell B s hs f).app ((A.map f).obj a) := by
-  simp only [sigma_obj, Functor.comp_obj, naturality, sigma_map,
-    conjugatingObjNatTransEquiv₁, Grpd.Functor.iso, Grpd.functorIsoOfIso_inv, Functor.mapIso_inv,
-    asIso_inv, Grpd.functorIsoOfIso_hom, Functor.mapIso_hom, asIso_hom,
+  simp only [Functor.comp_obj, naturality,
+    conjugatingObjNatTransEquiv₁, Grpd.Functor.iso,
     conjugatingObjNatTransEquiv', Groupoid.isoEquivHom, Groupoid.inv_eq_inv, Equiv.toFun_as_coe,
     Equiv.trans_apply, Equiv.coe_fn_mk, Equiv.coe_fn_symm_mk, IsIso.inv_comp,
     Functor.inv_whiskerLeft, inv_eqToHom, Iso.symm_mk, NatTrans.comp_app, eqToHom_app,
     Functor.whiskerLeft_app]
+  rfl
 
+-- Bundled groupoid coercions must be unfolded when elaborating the base equation.
+set_option backward.isDefEq.respectTransparency false in
 @[simp]
 lemma strongTrans.naturality_inv_app_base {x y} (f : x ⟶ y) (a) :
     Hom.base ((strongTrans.naturality B s hs f).inv.app a) = eqToHom (by simp) := by
   rw [strongTrans.naturality_inv_app, comp_base, base_eqToHom]
   simp
 
+-- Reduce bundled groupoid projections in the dependent fiber equation.
+set_option backward.isDefEq.respectTransparency false in
 @[simp]
 lemma strongTrans.naturality_inv_app_fiber {x y} (f : x ⟶ y) (a) :
     ((strongTrans.naturality B s hs f).inv.app a).fiber =
-    eqToHom (by simp only [← Functor.comp_obj, naturality_inv_app_base, twoCell_app_base,
-      ← Grpd.comp_eq_comp]; rw! [← Functor.map_comp_assoc, IsIso.hom_inv_id,
-      CategoryTheory.Functor.map_id, Category.id_comp]) ≫
+    eqToHom (by
+      simp only [← Functor.comp_obj, naturality_inv_app_base, twoCell_app_base,
+      ← Grpd.comp_eq_comp]
+      have h : A.map f ≫ A.map (inv f) ≫ app B s hs x ≫ sigmaMap B f =
+          app B s hs x ≫ sigmaMap B f := by
+        rw [← Functor.map_comp_assoc, IsIso.hom_inv_id,
+          CategoryTheory.Functor.map_id, Category.id_comp]
+      apply eq_of_heq
+      simp only [Grpd.map_eqToHom_obj, heq_cast_iff_heq, cast_heq_iff_heq]
+      have hf : ∀ {p q : ∫ (ι A y ⋙ B)}, p = q → p.fiber ≍ q.fiber := by
+        intro p q hpq
+        cases hpq
+        rfl
+      exact (hf (Functor.congr_obj h a)).symm) ≫
     Hom.fiber ((twoCell B s hs f).app ((A.map f).obj a)) := by
   rw! [strongTrans.naturality_inv_app, comp_fiber, fiber_eqToHom, eqToHom_map]
   simp
 
+-- Bundled groupoid coercions need the legacy transparency for transport simplification.
+set_option backward.isDefEq.respectTransparency false in
 @[simp]
 lemma strongTrans.naturality_id_hom (x : Γ) :
     (strongTrans.naturality B s hs (𝟙 x)).hom = eqToHom (by simp) := by
   dsimp [strongTrans.naturality]
   erw [conjugatingObjNatTransEquiv₁_id_inv]
-  simp [sigma_obj, sigma_map, eqToHom_trans, twoCell_id]
+  simp [eqToHom_trans, twoCell_id]
 
 lemma inv_heq_inv {C : Type*} [Category C] {X Y : C} {X' Y' : C}
     (hX : X = X') (hY : Y = Y') {f : X ⟶ Y} {f' : X' ⟶ Y'} (hf : f ≍ f') [IsIso f] :
@@ -797,6 +894,8 @@ lemma inv_heq_inv {C : Type*} [Category C] {X Y : C} {X' Y' : C}
   subst hX hY hf
   rfl
 
+-- Use local transparency to unfold the bundled groupoid coercions.
+set_option backward.isDefEq.respectTransparency false in
 lemma strongTrans.naturality_comp_hom {x y z : Γ} (g1 : x ⟶ y) (g2 : y ⟶ z) :
     (strongTrans.naturality B s hs (g1 ≫ g2)).hom =
     eqToHom (by simp [Functor.assoc]) ≫
@@ -809,6 +908,7 @@ lemma strongTrans.naturality_comp_hom {x y z : Γ} (g1 : x ⟶ y) (g2 : y ⟶ z)
     (twoCell B s hs g1) (twoCell B s hs g2)
     (twoCell B s hs (g1 ≫ g2)) ?_).trans
   · simp [naturality]
+    rfl
   · apply (strongTrans.twoCell_comp ..).trans
     rw [Functor.whiskerRight_whiskerLeft]
     simp only [sigma, eqToHom_refl]
@@ -816,26 +916,17 @@ lemma strongTrans.naturality_comp_hom {x y z : Γ} (g1 : x ⟶ y) (g2 : y ⟶ z)
 
 lemma strongTrans.app_comp_fstNatTrans_app (x : Γ) :
     strongTrans.app B s hs x ⋙ (sigma.fstNatTrans A B).app x = 𝟭 ↑(A.obj x) := by
-  simpa [strongTrans.app] using (PGrpd.objFiber' hs x).obj.property
+  simpa [strongTrans.app, IsSection] using (PGrpd.objFiber' hs x).obj.property
 
+-- Unfold bundled groupoid coercions in the inverse-base projection.
+set_option backward.isDefEq.respectTransparency false in
 lemma strongTrans.app_map_naturality_hom_app {x y : Γ} (f : x ⟶ y) (a : (A.obj x)) :
     ((sigma.fstNatTrans A B).app y).map (((strongTrans.naturality B s hs) f).hom.app a) =
     eqToHom (Section.strongTrans_comp_toStrongTrans'_self_aux (sigma.fstNatTrans A B)
       (app B s hs) (app_comp_fstNatTrans_app B s hs) f a) := by
-  simp only [sigma_obj, sigma.fstNatTrans, Functor.comp_obj, Functor.Groupoidal.forget_obj,
-    sigmaMap_obj_base, naturality, sigma_map, conjugatingObjNatTransEquiv₁, Grpd.Functor.iso,
-    Grpd.functorIsoOfIso_inv, Functor.mapIso_inv, asIso_inv, Grpd.functorIsoOfIso_hom,
-    Functor.mapIso_hom, asIso_hom, conjugatingObjNatTransEquiv', Groupoid.isoEquivHom,
-    Groupoid.inv_eq_inv, Equiv.toFun_as_coe, Equiv.trans_apply, Equiv.coe_fn_mk,
-    Equiv.coe_fn_symm_mk, IsIso.inv_comp, Functor.inv_whiskerLeft, inv_eqToHom, Iso.symm_mk,
-    NatTrans.comp_app, Functor.whiskerLeft_app, NatIso.isIso_inv_app, eqToHom_app, forget_map]
-  rw [Functor.Groupoidal.comp_base, Functor.Groupoidal.base_eqToHom,
-    ← Functor.Groupoidal.inv_base]
-  have h := NatTrans.congr_app ((PGrpd.mapFiber' hs f)).2 ((A.map f).obj a)
-  simp only [Set.mem_setOf_eq, IsOverId, sigma.fstNatTrans] at h
-  simp only [sigma_obj, pi_obj_α, Functor.comp_obj, Functor.Groupoidal.forget_obj,
-    Functor.whiskerRight_app, forget_map, Category.id_comp, eqToHom_trans, eqToHom_app] at h
-  simp [twoCell, h]
+  change Hom.base ((strongTrans.naturality B s hs f).hom.app a) = _
+  rw [← NatIso.inv_inv_app, ← Functor.Groupoidal.inv_base]
+  simp only [strongTrans.naturality_inv_app_base, inv_eqToHom]
 
 def mapStrongTrans : ∫ A ⥤ ∫ sigma A B :=
   Section.mapStrongTrans (strongTrans.app B s hs) (strongTrans.naturality B s hs)
@@ -853,29 +944,34 @@ lemma mapStrongTrans_obj_fiber (x) : ((mapStrongTrans B s hs).obj x).fiber =
 @[simp]
 lemma mapStrongTrans_obj_fiber_base (x) : ((mapStrongTrans B s hs).obj x).fiber.base =
     x.fiber := by
-  simp [mapStrongTrans]
+  exact strongTrans.app_obj_base B s hs x.base x.fiber
 
 @[simp]
 lemma mapStrongTrans_obj_fiber_fiber (x) : ((mapStrongTrans B s hs).obj x).fiber.fiber =
     ((strongTrans.app B s hs x.base).obj x.fiber).fiber := by
-  simp [mapStrongTrans]
+  rfl
 
 @[simp]
 lemma mapStrongTrans_map_base {x y} (f : x ⟶ y) : ((mapStrongTrans B s hs).map f).base =
     f.base :=
   rfl
 
+-- Unfold bundled groupoid coercions in the naturality projection.
+set_option backward.isDefEq.respectTransparency false in
 lemma mapStrongTrans_map_fiber {x y} (f : x ⟶ y) : ((mapStrongTrans B s hs).map f).fiber =
     eqToHom (by simp [← Functor.comp_obj]; simp [← Grpd.comp_eq_comp, mapStrongTrans_obj_fiber]) ≫
     (strongTrans.twoCell B s hs f.base).app ((A.map f.base).obj x.fiber) ≫
     (strongTrans.app B s hs y.base).map f.fiber := by
   simp [mapStrongTrans, strongTrans.naturality_inv_app]
 
+-- Unfold bundled groupoid coercions in the fiber base projection.
+set_option backward.isDefEq.respectTransparency false in
 @[simp]
 lemma mapStrongTrans_map_fiber_base {x y} (f : x ⟶ y) :
     ((mapStrongTrans B s hs).map f).fiber.base =
-    eqToHom (by simp [mapStrongTrans_obj_fiber]) ≫
-    f.fiber ≫ eqToHom (by simp [mapStrongTrans_obj_fiber]) := by
+    eqToHom (by simp only [mapStrongTrans_map_base, mapStrongTrans_obj_fiber,
+      sigma_map, sigmaMap_obj_base, strongTrans.app_obj_base]) ≫
+    f.fiber ≫ eqToHom (by simp only [mapStrongTrans_obj_fiber, strongTrans.app_obj_base]) := by
   rw [mapStrongTrans_map_fiber, comp_base, comp_base, base_eqToHom, strongTrans.twoCell_app_base]
   simp
 
@@ -891,31 +987,22 @@ def inversion : ∫(A) ⥤ PGrpd := mapStrongTrans B s hs ⋙ (sigma.assoc B).in
 lemma assocHom_app_base_base
     {Γ : Type u₂} [Groupoid Γ] {A : Γ ⥤ Grpd} (B : ∫ A ⥤ Grpd)
     {x y : Γ} (f : x ⟶ y) (a) :
-    ((sigma.assocHom B f).app a).base.base = f := by
-  simp [sigma.assocHom, sigma.assocIso, ιNatIso_hom]
+    ((sigma.assocHom B f).app a).base.base = f :=
+  sigma.assocIso_hom_app_base_base B f a
 
 lemma assocHom_app_base_fiber
     {Γ : Type u₂} [Groupoid Γ] {A : Γ ⥤ Grpd} (B : ∫ A ⥤ Grpd)
     {x y : Γ} (f : x ⟶ y) (a) :
-    ((sigma.assocHom B f).app a).base.fiber = eqToHom (by
-      simp only [sigma.assocFib.eq_1, Functor.comp_obj, assocHom_app_base_base]
-      rw! (castMode := .all) [pre_obj_base B (ι A y) ((sigmaMap B f).obj a)]
-      rw! (castMode := .all) [pre_obj_base B (ι A x) a]
-      simp) := by
-  simp only [sigma.assocFib.eq_1, Functor.comp_obj, sigma.assocHom,
-    sigma.assocIso, eqToHom_refl]
-  rw! (castMode := .all) [preNatIso_hom_app_base, ιNatIso_hom]
-  simp
-  rfl
+    ((sigma.assocHom B f).app a).base.fiber = eqToHom (by rfl) := by
+  exact sigma.assocIso_hom_app_base_fiber B f a
 
 lemma mapStrongTrans_comp_map_fstNatTrans :
     mapStrongTrans B s hs ⋙ map (sigma.fstNatTrans A B) = 𝟭 _ := by
-  convert Section.mapStrongTrans_comp_map_self (sigma.fstNatTrans A B)
+  exact Section.mapStrongTrans_comp_map_self (sigma.fstNatTrans A B)
     (strongTrans.app B s hs) (strongTrans.naturality B s hs)
-    (strongTrans.naturality_id_hom B s hs) (strongTrans.naturality_comp_hom B s hs) _ _
-  · apply strongTrans.app_comp_fstNatTrans_app
-  · intro x y f a
-    apply strongTrans.app_map_naturality_hom_app
+    (strongTrans.naturality_id_hom B s hs) (strongTrans.naturality_comp_hom B s hs)
+    (strongTrans.app_comp_fstNatTrans_app B s hs)
+    (fun f a => strongTrans.app_map_naturality_hom_app B s hs f a)
 
 @[simp]
 lemma inversion_comp_forgetToGrpd : inversion B s hs ⋙ PGrpd.forgetToGrpd = B := by
@@ -924,6 +1011,8 @@ lemma inversion_comp_forgetToGrpd : inversion B s hs ⋙ PGrpd.forgetToGrpd = B
   simp [← Functor.assoc, mapStrongTrans_comp_map_fstNatTrans]
 
 -- NOTE: this is not as general as the `mapStrongTrans` simp lemmas
+-- The groupoid coercions in the dependent fiber rewrites require backward unfolding.
+set_option backward.isDefEq.respectTransparency false in
 lemma mapStrongTrans_map_ι_map_fiber_fiber_heq {x : Γ} {a b : A.obj x} (h : a ⟶ b) :
     ((mapStrongTrans B s hs).map ((ι A x).map h)).fiber.fiber ≍
     ((strongTrans.app B s hs x).map h).fiber := by
@@ -933,11 +1022,13 @@ lemma mapStrongTrans_map_ι_map_fiber_fiber_heq {x : Γ} {a b : A.obj x} (h : a
   · simp
   · conv => left; right; rw [ι_map_fiber, Functor.map_comp, eqToHom_map]
     rw! (castMode := .all) [ι_obj_base]
-    simp only [mapStrongTrans_obj_base, ι_obj_base, ι_map_base, sigma_obj, ι_obj_fiber,
+    simp only [mapStrongTrans_obj_base, ι_obj_base, ι_map_base, ι_obj_fiber,
       Functor.comp_obj, strongTrans.twoCell_id, eqToHom_app, eqToHom_trans_assoc]
     apply HEq.trans (eqToHom_comp_heq ..)
     rfl
 
+-- The dependent fiber comparisons require backward unfolding of groupoid coercions.
+set_option backward.isDefEq.respectTransparency false in
 lemma ι_comp_inversion {x} : ι A x ⋙ inversion B s hs =
     strongTrans.app B s hs x ⋙ toPGrpd (ι A x ⋙ B) := by
   apply PGrpd.Functor.hext
@@ -945,13 +1036,13 @@ lemma ι_comp_inversion {x} : ι A x ⋙ inversion B s hs =
     erw [toPGrpd_forgetToGrpd, ← Functor.assoc, strongTrans.app_comp_fstNatTrans_app,
       Functor.id_comp]
   · intro a
-    simp only [Functor.comp_obj, inversion_obj_base, inversion_obj_fiber, ι_obj_base, sigma_obj,
+    simp only [Functor.comp_obj, inversion_obj_fiber, ι_obj_base,
       toPGrpd_obj_base, toPGrpd_obj_fiber, heq_eq_eq]
     rw! (castMode := .all) [mapStrongTrans_obj_fiber]
     simp
   · intro a b h
-    simp only [Functor.comp_obj, inversion_obj_base, Functor.comp_map, inversion_map_base,
-      inversion_obj_fiber, ι_obj_base, inversion_map_fiber, ι_map_base, sigma_obj, toPGrpd_obj_base,
+    simp only [Functor.comp_obj, Functor.comp_map,
+       ι_obj_base, inversion_map_fiber, ι_map_base, toPGrpd_obj_base,
       toPGrpd_map_base, toPGrpd_obj_fiber, toPGrpd_map_fiber, eqToHom_comp_heq_iff]
     apply mapStrongTrans_map_ι_map_fiber_fiber_heq
 
@@ -981,6 +1072,7 @@ def lamObjFiberObj : A.obj x ⥤ sigmaObj (β ⋙ PGrpd.forgetToGrpd) x :=
 @[simp] lemma lamObjFiberObj_map_fiber {a a'} (h: a ⟶ a'):
     ((lamObjFiberObj A β x).map h).fiber = PGrpd.mapFiber (ι A x ⋙ β) h := by
   simp [lamObjFiberObj]
+  rfl
 
 def lamObjFiber : Grpd.of ((pi _ (β ⋙ PGrpd.forgetToGrpd)).obj x) :=
   ⟨lamObjFiberObj A β x, rfl⟩
@@ -1000,22 +1092,28 @@ variable {x y : Γ} (f : x ⟶ y)
 
 open CategoryTheory.Functor
 
+-- These local settings reconcile bundled groupoid coercions in the dependent fiber projections.
+set_option backward.isDefEq.respectTransparency false in
 def lamObjFiberObjCompSigMap.app (a : A.obj x) :
     (lamObjFiberObj A β x ⋙ sigmaMap (β ⋙ PGrpd.forgetToGrpd) f).obj a ⟶
     (A.map f ⋙ lamObjFiberObj A β y).obj a :=
   homMk (𝟙 _) (eqToHom (by simp; rfl) ≫ (β.map ((ιNatTrans f).app a)).fiber)
 
+set_option backward.isDefEq.respectTransparency false in
 @[simp] lemma lamObjFiberObjCompSigMap.app_base (a : A.obj x) : (app A β f a).base = 𝟙 _ := by
   simp [app]
 
+set_option backward.isDefEq.respectTransparency false in
 lemma lamObjFiberObjCompSigMap.app_fiber_eq (a : A.obj x) : (app A β f a).fiber =
     eqToHom (by simp; rfl) ≫ (β.map ((ιNatTrans f).app a)).fiber := by
   simp [app]
 
+set_option backward.isDefEq.respectTransparency false in
 lemma lamObjFiberObjCompSigMap.app_fiber_heq (a : A.obj x) : (app A β f a).fiber ≍
     (β.map ((ιNatTrans f).app a)).fiber := by
   simp [app]
 
+set_option backward.isDefEq.respectTransparency false in
 lemma lamObjFiberObjCompSigMap.naturality {x y : Γ} (f : x ⟶ y) {a1 a2 : A.obj x} (h : a1 ⟶ a2) :
     (lamObjFiberObj A β x ⋙ sigmaMap (β ⋙ PGrpd.forgetToGrpd) f).map h
     ≫ lamObjFiberObjCompSigMap.app A β f a2 =
@@ -1030,11 +1128,12 @@ lemma lamObjFiberObjCompSigMap.naturality {x y : Γ} (f : x ⟶ y) {a1 a2 : A.ob
         ≫ (β.map ((ιNatTrans f).app a2)).fiber ≍
         (β.map ((ι A y).map ((A.map f).map h))).base.map (β.map ((ιNatTrans f).app a1)).fiber
         ≫ (β.map ((ι A y).map ((A.map f).map h))).fiber := by
-      simpa [← heq_eq_eq] using Grothendieck.Hom.congr β_ιNatTrans_naturality
-    simp only [Grpd.forgetToCat.eq_1, sigmaObj, Grpd.coe_of, comp_obj, sigmaMap_obj_base,
+      simpa [← heq_eq_eq, Grpd.forgetToCat, Functor.comp_obj] using
+        Grothendieck.Hom.congr β_ιNatTrans_naturality
+    simp only [sigmaObj, Grpd.coe_of, comp_obj, sigmaMap_obj_base,
       Functor.comp_map, comp_base, sigmaMap_map_base, sigmaMap_obj_fiber, comp_fiber,
-      sigmaMap_map_fiber, lamObjFiberObj_map_fiber, map_comp, eqToHom_map, app_fiber_eq, Cat.of_α,
-      id_eq, Category.assoc, eqToHom_trans_assoc, heq_eqToHom_comp_iff, eqToHom_comp_heq_iff]
+      sigmaMap_map_fiber, lamObjFiberObj_map_fiber, map_comp, eqToHom_map, app_fiber_eq,
+       Category.assoc, eqToHom_trans_assoc, heq_eqToHom_comp_iff, eqToHom_comp_heq_iff]
     rw [← Category.assoc]
     apply HEq.trans _ h_naturality
     apply heq_comp _ rfl rfl _ HEq.rfl
@@ -1043,6 +1142,7 @@ lemma lamObjFiberObjCompSigMap.naturality {x y : Γ} (f : x ⟶ y) {a1 a2 : A.ob
       congr 3
       aesop_cat
 
+set_option backward.isDefEq.respectTransparency false in
 @[simp] lemma lamObjFiberObjCompSigMap.app_id (a) : lamObjFiberObjCompSigMap.app A β (𝟙 x) a
     = eqToHom (by simp) := by
   apply Hom.hext
@@ -1054,21 +1154,22 @@ lemma lamObjFiberObjCompSigMap.naturality {x y : Γ} (f : x ⟶ y) {a1 a2 : A.ob
       eqToHom_trans]
     apply (eqToHom_heq_id_cod _ _ _).trans (eqToHom_heq_id_cod _ _ _).symm
 
+set_option backward.isDefEq.respectTransparency false in
 lemma lamObjFiberObjCompSigMap.app_comp {x y z : Γ} (f : x ⟶ y) (g : y ⟶ z) (a) :
     app A β (f ≫ g) a
     = eqToHom (by simp)
     ≫ (sigmaMap (β ⋙ PGrpd.forgetToGrpd) g).map (app A β f a)
     ≫ app A β g ((A.map f).obj a) ≫ eqToHom (by simp) := by
   fapply Hom.hext
-  · simp only [Grpd.forgetToCat.eq_1, sigmaObj, Grpd.coe_of, comp_obj, sigmaMap_obj_base, app_base,
+  · simp only [sigmaObj, Grpd.coe_of, comp_obj, sigmaMap_obj_base, app_base,
     comp_base, base_eqToHom, sigmaMap_map_base, map_id, lamObjFiberObj_obj_base, map_comp,
     Grpd.comp_eq_comp, eqToHom_naturality, Category.comp_id, eqToHom_trans, eqToHom_refl]
   · have : (β.map ((ιNatTrans (f ≫ g)).app a)) = β.map ((ιNatTrans f).app a)
       ≫ β.map ((ιNatTrans g).app ((A.map f).obj a))
       ≫ eqToHom (by simp) := by
       simp [ιNatTrans_comp_app]
-    simp only [Grpd.forgetToCat.eq_1, sigmaObj, Grpd.coe_of, comp_obj, sigmaMap_obj_base, app,
-      Functor.comp_map, PGrpd.forgetToGrpd_map, sigmaMap_obj_fiber, Cat.of_α, id_eq, homMk_base,
+    simp only [sigmaObj, Grpd.coe_of, comp_obj, sigmaMap_obj_base, app,
+      Functor.comp_map, PGrpd.forgetToGrpd_map, sigmaMap_obj_fiber, homMk_base,
       homMk_fiber, Grothendieck.Hom.congr this, Grothendieck.Hom.comp_base, Grpd.comp_eq_comp,
       Grothendieck.Hom.comp_fiber, eqToHom_refl, Functor.Grothendieck.fiber_eqToHom,
       Category.id_comp, eqToHom_trans_assoc, comp_base, sigmaMap_map_base, comp_fiber,
@@ -1143,6 +1244,7 @@ lemma whiskerLeftInvLamObjObjSimgaMap_comp_aux {A A' B B' C C' : Type*}
       whiskerLeft G.inv lamG ≫
       eqToHom (by aesop) := by aesop_cat
 
+set_option backward.isDefEq.respectTransparency false in
 lemma whiskerLeftInvLamObjObjSigMap_comp {x y z} (f : x ⟶ y) (g : y ⟶ z) :
     whiskerLeftInvLamObjObjSigMap A β (f ≫ g)
     = eqToHom (by simp [Functor.assoc, sigmaMap_comp])
@@ -1157,23 +1259,27 @@ lemma whiskerLeftInvLamObjObjSigMap_comp {x y z} (f : x ⟶ y) (g : y ⟶ z) :
     _ _ _ (sigmaMap (β ⋙ PGrpd.forgetToGrpd) f) (sigmaMap (β ⋙ PGrpd.forgetToGrpd) g)]
   simp only [Category.assoc, eqToHom_trans, Grpd.Functor.iso_hom, Grpd.Functor.iso_inv]
 
+-- Unfold bundled groupoid coercions in the section transport proofs.
+set_option backward.isDefEq.respectTransparency false in
 def lamMapFiber :
     ((pi A (β ⋙ PGrpd.forgetToGrpd)).map f).obj (lamObjFiber A β x) ⟶ lamObjFiber A β y :=
-  ⟨whiskerLeftInvLamObjObjSigMap A β f, by
+  ⟨⟨whiskerLeftInvLamObjObjSigMap A β f⟩, by
     ext
-    simp only [sigma_obj, sigma.fstNatTrans_app, pi_obj_α, comp_obj, Groupoidal.forget_obj,
+    simp only [sigma.fstNatTrans_app, comp_obj, Groupoidal.forget_obj,
       lamObjFiber_obj_obj, whiskerLeftInvLamObjObjSigMap, lamObjFiberObjCompSigMap,
       whiskerRight_comp, eqToHom_whiskerRight, NatTrans.comp_app, whiskerRight_app, whiskerLeft_app,
       forget_map, lamObjFiberObjCompSigMap.app_base, sigmaMap_obj_base, eqToHom_app, eqToHom_refl,
       Category.comp_id]
     erw [Category.id_comp]⟩
 
+set_option backward.isDefEq.respectTransparency false in
 @[simp] lemma lamMapFiber_id (x : Γ) : lamMapFiber A β (𝟙 x) = eqToHom (by simp) := by
-  apply MorphismProperty.WideSubcategory.hom_ext
-  simp only [sigma_obj, sigma.fstNatTrans_app, pi_obj_α, Set.mem_setOf_eq, lamMapFiber,
-    whiskerLeftInvLamObjObjSigMap_id, MorphismProperty.WideSubcategory.coe_eqToHom]
-  rfl
+  apply (Section.ι ((sigma.fstNatTrans A (β ⋙ PGrpd.forgetToGrpd)).app x)).map_injective
+  rw [eqToHom_map]
+  change whiskerLeftInvLamObjObjSigMap A β (𝟙 x) = eqToHom _
+  exact whiskerLeftInvLamObjObjSigMap_id A β x
 
+set_option backward.isDefEq.respectTransparency false in
 lemma lamMapFiber_comp {x y z} (f : x ⟶ y) (g : y ⟶ z) :
     (lamMapFiber A β (f ≫ g))
     = eqToHom (by
@@ -1182,13 +1288,15 @@ lemma lamMapFiber_comp {x y z} (f : x ⟶ y) (g : y ⟶ z) :
         rw [← Grpd.comp_eq_comp, Functor.map_comp])
     ≫ (((pi A (β ⋙ PGrpd.forgetToGrpd)).map g).map ((lamMapFiber A β) f))
     ≫ (lamMapFiber A β g) := by
-  apply MorphismProperty.WideSubcategory.hom_ext
-  simp only [sigma_obj, pi, Set.mem_setOf_eq, lamMapFiber, whiskerLeftInvLamObjObjSigMap_comp]
-  rw [MorphismProperty.WideSubcategory.comp_def,
-    MorphismProperty.WideSubcategory.comp_def,
-    MorphismProperty.WideSubcategory.coe_eqToHom]
-  simp
-  rfl
+  apply (Section.ι ((sigma.fstNatTrans A (β ⋙ PGrpd.forgetToGrpd)).app z)).map_injective
+  simp only [Functor.map_comp, eqToHom_map]
+  change whiskerLeftInvLamObjObjSigMap A β (f ≫ g) = eqToHom _ ≫
+    (((pi A (β ⋙ PGrpd.forgetToGrpd)).map g).map (lamMapFiber A β f)).1.hom ≫
+    whiskerLeftInvLamObjObjSigMap A β g
+  simp only [pi]
+  rw [Section.functor_map_map (A := A) (B := sigma A (β ⋙ PGrpd.forgetToGrpd))
+    (sigma.fstNatTrans A (β ⋙ PGrpd.forgetToGrpd)) g (lamMapFiber A β f)]
+  exact whiskerLeftInvLamObjObjSigMap_comp A β f g
 
 def lam : Γ ⥤ PGrpd.{u₁,u₁} :=
   PGrpd.functorTo
@@ -1223,6 +1331,8 @@ lemma lam_comp_aux (x) :
     ι A (σ.obj x) ⋙ β ⋙ PGrpd.forgetToGrpd = ι (σ ⋙ A) x ⋙ pre A σ ⋙ β ⋙ PGrpd.forgetToGrpd := by
   simp [← Functor.assoc, ← ι_comp_pre]
 
+-- Unfold bundled groupoid coercions when comparing the dependent section objects.
+set_option backward.isDefEq.respectTransparency false in
 lemma lamObjFiberObj_naturality (x) :
     lamObjFiberObj A β (σ.obj x) ≍ lamObjFiberObj (σ ⋙ A) (pre A σ ⋙ β) x := by
   simp only [lamObjFiberObj, ← ι_comp_pre, comp_obj, Functor.assoc]
@@ -1240,11 +1350,13 @@ theorem lamObjFiber_naturality (x : Δ) : lamObjFiber A β (σ.obj x) ≍
   apply Section.obj_hext
   · simp [sigmaObj_naturality, Functor.assoc]
   · simp
-  · simp only [sigma_obj, sigma.fstNatTrans_app, comp_obj]
+  · simp only [sigma.fstNatTrans_app, comp_obj]
     apply naturality_forget_heq_forget
-  · simp only [sigma_obj, sigma.fstNatTrans_app, lamObjFiber_obj_obj, comp_obj]
+  · simp only [sigma.fstNatTrans_app, lamObjFiber_obj_obj, comp_obj]
     apply lamObjFiberObj_naturality
 
+-- The fiber projection uses the same bundled groupoid coercions.
+set_option backward.isDefEq.respectTransparency false in
 lemma lamObjFiberObjCompSigMap.app_naturality {x y} (f : x ⟶ y) (a) :
     lamObjFiberObjCompSigMap.app A β (σ.map f) a ≍
     lamObjFiberObjCompSigMap.app (σ ⋙ A) (pre A σ ⋙ β) f a := by
@@ -1263,7 +1375,7 @@ lemma lamObjFiberObjCompSigMap_naturality {x y} (f : x ⟶ y) :
     lamObjFiberObjCompSigMap (σ ⋙ A) (pre A σ ⋙ β) f := by
   apply Grpd.NatTrans.hext
   any_goals apply Grpd.comp_hcongr
-  any_goals simp only [comp_obj, Functor.comp_map, heq_eq_eq, eqToHom_refl]
+  any_goals simp only [comp_obj, Functor.comp_map, heq_eq_eq]
   any_goals apply sigmaObj_naturality
   any_goals apply lamObjFiberObj_naturality
   · apply sigmaMap_naturality_heq
@@ -1284,22 +1396,40 @@ lemma whiskerLeftInvLamObjObjSigMap_naturality_heq {x y} (f : x ⟶ y) :
   · apply sigmaMap_naturality_heq
   · apply lamObjFiberObjCompSigMap_naturality
 
+-- Match bundled groupoid projections in the section naturality proof.
+set_option backward.isDefEq.respectTransparency false in
 lemma lam_comp_map {x y} (f : x ⟶ y) :
     lamMapFiber A β (σ.map f) ≍ lamMapFiber (σ ⋙ A) (pre A σ ⋙ β) f := by
-  apply Section.hom_hext
+  apply Section.hom_hext'
   · simp [Functor.assoc, sigmaObj_naturality]
   · simp
   · simp [Functor.assoc]
     apply naturality_forget_heq_forget
-  · simp only [sigma_obj, sigma.fstNatTrans_app, pi_obj_α, comp_obj, Functor.assoc]
+  · simp only [sigma.fstNatTrans_app, comp_obj, Functor.assoc]
     rw [Functor.congr_obj (Functor.congr_hom (pi_comp A (β ⋙ PGrpd.forgetToGrpd) σ) f)]
-    simp only [pi_obj_α, comp_obj, Functor.comp_map, Grpd.comp_eq_comp, Grpd.eqToHom_obj,
+    simp only [comp_obj, Functor.comp_map, Grpd.comp_eq_comp, Grpd.eqToHom_obj,
       heq_cast_iff_heq, heq_eq_eq]
     congr 1
     simp only [← heq_eq_eq, heq_cast_iff_heq]
     apply lamObjFiber_naturality
   · apply lamObjFiber_naturality
-  · apply whiskerLeftInvLamObjObjSigMap_naturality_heq
+  · intro k k' hk
+    have h := whiskerLeftInvLamObjObjSigMap_naturality_heq A β σ f
+    dsimp only [lamMapFiber]
+    cases hk
+    have happ {C D D' : Grpd.{u₁,u₁}} (hD : D ≍ D')
+        {F G : C ⥤ D} {F' G' : C ⥤ D'} (hF : F ≍ F') (hG : G ≍ G')
+        {α : F ⟶ G} {α' : F' ⟶ G'} (hα : α ≍ α') (a : C) :
+        α.app a ≍ α'.app a := by
+      subst hD hF hG hα
+      rfl
+    apply happ _ _ _ h k
+    any_goals apply Grpd.comp_hcongr
+    any_goals apply Grpd.comp_hcongr
+    any_goals simp only [comp_obj, Functor.comp_map, Functor.map_inv, heq_eq_eq, Functor.assoc]
+    any_goals apply sigmaObj_naturality
+    any_goals apply lamObjFiberObj_naturality
+    any_goals apply sigmaMap_naturality_heq
 
 theorem lam_comp : σ ⋙ lam A β = lam (σ ⋙ A) (pre A σ ⋙ β) := by
   apply PGrpd.Functor.hext
@@ -1325,6 +1455,8 @@ lemma strongTrans.app_lam_map_base {x y : ∫ A} (f : x ⟶ y) :
     f.fiber :=
   rfl
 
+-- Match bundled groupoid coercions in the section projections.
+set_option backward.isDefEq.respectTransparency false in
 @[simp]
 lemma strongTrans.app_lam_map_fiber {x y : ∫ A} (f : x ⟶ y) :
     ((strongTrans.app (β ⋙ PGrpd.forgetToGrpd) (lam A β)
@@ -1332,50 +1464,86 @@ lemma strongTrans.app_lam_map_fiber {x y : ∫ A} (f : x ⟶ y) :
     PGrpd.mapFiber (ι A y.base ⋙ β) (Hom.fiber f) := by
   simp [lam, app, PGrpd.objFiber]
 
+-- Reduce bundled groupoid projections in the dependent lambda equation.
+set_option backward.isDefEq.respectTransparency false in
 lemma strongTrans.twoCell_lam_app {x y : ∫ A} (f : x ⟶ y) :
     ((strongTrans.twoCell (β ⋙ PGrpd.forgetToGrpd) (lam A β) (lam_comp_forgetToGrpd ..)
       (Hom.base f)).app ((A.map (Hom.base f)).obj x.fiber)) =
       homMk (eqToHom (by
-        simp only [Functor.map_inv, sigma_obj, comp_obj, sigmaMap_obj_base, app_obj_base]
+        simp only [Functor.map_inv, comp_obj, sigmaMap_obj_base, app_obj_base]
         simp [← Functor.comp_obj, ← Grpd.comp_eq_comp]))
         (eqToHom (by
-        simp only [comp_obj, Functor.Grothendieck.forget_obj, sigma_obj, sigmaMap_obj_base,
+        simp only [comp_obj, sigmaMap_obj_base,
           Functor.comp_map, eqToHom_map, Functor.Grothendieck.forget_map,
           Functor.Grothendieck.base_eqToHom, sigmaMap_obj_fiber, Grpd.eqToHom_obj, ← heq_eq_eq,
           cast_heq_iff_heq]
         simp only [← Functor.comp_obj, ← Grpd.comp_eq_comp]
-        rw! [← Functor.map_comp, IsIso.hom_inv_id, CategoryTheory.Functor.map_id, Category.id_comp]
-        rfl) ≫
+        have h : (A.map (inv f.base)).obj ((A.map f.base).obj x.fiber) = x.fiber := by
+          simp [← Functor.comp_obj, ← Grpd.comp_eq_comp]
+        have hf : ∀ {a b : A.obj x.base}, a = b →
+            (β.map ((ιNatTrans f.base).app a)).base.obj (((ι A x.base ⋙ β).obj a).fiber) ≍
+            (β.map ((ιNatTrans f.base).app b)).base.obj (((ι A x.base ⋙ β).obj b).fiber) := by
+          intro a b hab
+          cases hab
+          rfl
+        exact hf h) ≫
         (β.map ((ιNatTrans (Hom.base f)).app x.fiber)).fiber) := by
-  simp only [sigma_obj, lam, comp_obj, twoCell, sigma.fstNatTrans_app, pi_obj_α,
-    PGrpd.objFiber'_rfl, Set.mem_setOf_eq, PGrpd.mapFiber'_rfl, sigmaMap_obj_base,
-    Functor.Grothendieck.forget_obj, Functor.comp_map, Functor.Grothendieck.forget_map,
+  simp only [lam, comp_obj, twoCell, sigma.fstNatTrans_app,
+    PGrpd.objFiber'_rfl, PGrpd.mapFiber'_rfl, sigmaMap_obj_base,
+     Functor.comp_map,
     sigmaMap_obj_fiber]
-  convert_to (whiskerLeftInvLamObjObjSigMap A β f.base).app ((A.map f.base).obj x.fiber) = _
+  change (whiskerLeftInvLamObjObjSigMap A β f.base).app ((A.map f.base).obj x.fiber) = _
   simp only [comp_obj, whiskerLeftInvLamObjObjSigMap, lamObjFiberObjCompSigMap, NatTrans.comp_app,
     whiskerLeft_app, lamObjFiberObjCompSigMap.app, sigmaMap_obj_base,
-    Functor.Grothendieck.forget_obj, Functor.comp_map, Functor.Grothendieck.forget_map,
+     Functor.comp_map,
     sigmaMap_obj_fiber, eqToHom_app]
   have h : (A.map (CategoryTheory.inv (Hom.base f))).obj ((A.map (Hom.base f)).obj x.fiber) =
       x.fiber := by simp [← Functor.comp_obj, ← Grpd.comp_eq_comp]
-  rw! [h]
-  simp only [eqToHom_refl, Category.comp_id, ← heq_eq_eq]
-  congr 1
+  apply eq_of_heq
+  apply (comp_eqToHom_heq ..).trans
+  have hf : ∀ {a b : A.obj x.base}, a = b →
+      lamObjFiberObjCompSigMap.app A β f.base a ≍
+      lamObjFiberObjCompSigMap.app A β f.base b := by
+    intro a b hab
+    cases hab
+    rfl
+  apply (hf h).trans
+  apply Hom.hext' rfl
+  · exact heq_of_eq (congrArg
+      (lamObjFiberObj A β x.base ⋙ sigmaMap (β ⋙ PGrpd.forgetToGrpd) f.base).obj h).symm
+  · rfl
+  · simp only [lamObjFiberObjCompSigMap.app, homMk_base]
+    exact (eqToHom_heq_id_cod _ _ _).symm
+  · simp [lamObjFiberObjCompSigMap.app, eqToHom_comp_heq_iff]
 
+-- Reduce bundled groupoid projections in the fiber projection.
+set_option backward.isDefEq.respectTransparency false in
 lemma strongTrans.twoCell_lam_app_fiber {x y : ∫ A} (f : x ⟶ y) :
     ((strongTrans.twoCell (β ⋙ PGrpd.forgetToGrpd) (lam A β) (lam_comp_forgetToGrpd ..)
       (Hom.base f)).app ((A.map (Hom.base f)).obj x.fiber)).fiber =
     eqToHom (by
-      simp only [comp_obj, sigma_obj, sigmaMap_obj_base, Functor.Grothendieck.forget_obj,
+      simp only [comp_obj, sigmaMap_obj_base,
         twoCell_app_base, Functor.comp_map, eqToHom_map, Functor.Grothendieck.forget_map,
         Functor.Grothendieck.base_eqToHom, sigmaMap_obj_fiber]
       simp only [← Functor.comp_obj, ← Grpd.comp_eq_comp]
-      rw! [← Functor.map_comp, IsIso.hom_inv_id, CategoryTheory.Functor.map_id, Category.id_comp]
-      rfl
+      apply eq_of_heq
+      simp only [Grpd.comp_eq_comp, Functor.comp_obj, Grpd.eqToHom_obj,
+         cast_heq_iff_heq]
+      have h : (A.map (inv f.base)).obj ((A.map f.base).obj x.fiber) = x.fiber := by
+        simp [← Functor.comp_obj, ← Grpd.comp_eq_comp]
+      have hf : ∀ {a b : A.obj x.base}, a = b →
+          (β.map ((ιNatTrans f.base).app a)).base.obj (((ι A x.base ⋙ β).obj a).fiber) ≍
+          (β.map ((ιNatTrans f.base).app b)).base.obj (((ι A x.base ⋙ β).obj b).fiber) := by
+        intro a b hab
+        cases hab
+        rfl
+      exact hf h
       ) ≫ (β.map ((ιNatTrans (Hom.base f)).app x.fiber)).fiber := by
   rw! [twoCell_lam_app]
   simp
 
+-- Match bundled groupoid coercions when projecting the composite fiber.
+set_option backward.isDefEq.respectTransparency false in
 lemma mapStrongTrans_map_lam_map_fiber_fiber_heq {x y} (f : x ⟶ y) :
     ((mapStrongTrans (β ⋙ PGrpd.forgetToGrpd) (lam A β)
       (lam_comp_forgetToGrpd ..)).map f).fiber.fiber ≍
@@ -1386,8 +1554,8 @@ lemma mapStrongTrans_map_lam_map_fiber_fiber_heq {x y} (f : x ⟶ y) :
   rw [strongTrans.twoCell_lam_app_fiber]
   slice_lhs 2 3 => rw [Functor.map_comp, eqToHom_map]
   rw [strongTrans.app_lam_map_fiber]
-  simp only [mapStrongTrans_obj_base, comp_obj, Functor.Grothendieck.forget_obj, sigma_obj,
-    sigmaMap_obj_base, Functor.comp_map, Functor.Grothendieck.forget_map, sigmaMap_obj_fiber,
+  simp only [mapStrongTrans_obj_base, comp_obj,
+    sigmaMap_obj_base, Functor.comp_map, sigmaMap_obj_fiber,
     comp_base, strongTrans.app_lam_map_base, Category.assoc, eqToHom_trans_assoc,
     eqToHom_comp_heq_iff]
   simp [← Functor.comp_map, PGrpd.mapFiber]
@@ -1400,10 +1568,13 @@ lemma mapStrongTrans_map_lam_map_fiber_fiber_heq {x y} (f : x ⟶ y) :
   have := Functor.congr_map β this
   simp [Functor.Grothendieck.Hom.congr this]
   rw! [Category.comp_id, CategoryTheory.Functor.map_id]
-  simp only [Grothendieck.Hom.id_base, Grpd.id_eq_id, id_obj, eqToHom_refl, Functor.id_map,
+  simp only [Grothendieck.Hom.id_base, Grpd.id_eq_id, eqToHom_refl,
     Category.id_comp, heq_eq_eq]
   erw [Category.comp_id]
+  rfl
 
+-- Match bundled groupoid coercions in the dependent fiber projections.
+set_option backward.isDefEq.respectTransparency false in
 lemma inversion_lam : inversion (β ⋙ PGrpd.forgetToGrpd) (lam A β)
     (lam_comp_forgetToGrpd ..) = β := by
   apply PGrpd.Functor.hext
@@ -1420,11 +1591,13 @@ section
 
 variable (B : ∫ A ⥤ Grpd) (s : Γ ⥤ PGrpd) (hs : s ⋙ PGrpd.forgetToGrpd = pi A B)
 
+-- Match bundled groupoid coercions in the dependent functor projections.
+set_option backward.isDefEq.respectTransparency false in
 lemma lamObjFiber_obj_obj_inversion_heq (x) :
     (lamObjFiber A (inversion B s hs) x).obj.obj ≍ strongTrans.app B s hs x := by
   dsimp only [lamObjFiber, lamObjFiberObj]
   rw! (castMode := .all) [pi.inversion_comp_forgetToGrpd B s hs]
-  simp [sec_eq_lift, Grpd.forgetToCat.eq_1, heq_eq_eq]
+  simp [sec_eq_lift, heq_eq_eq]
   symm
   apply Functor.IsPullback.lift_uniq
   · symm
@@ -1443,6 +1616,8 @@ lemma lamObjFiber_inversion_heq (x) :
   refine HEq.trans ?_ (PGrpd.objFiber'_heq hs)
   apply lamObjFiber_inversion_heq'
 
+-- Match bundled groupoid coercions in the dependent functor projections.
+set_option backward.isDefEq.respectTransparency false in
 lemma strongTrans.twoCell_app_inversion {x y} (f : x ⟶ y) (a) :
     (strongTrans.twoCell B s hs f).app ((A.map f).obj ((A.map (CategoryTheory.inv f)).obj a)) =
     eqToHom (by simp only [← Functor.comp_obj]; simp [← Grpd.comp_eq_comp]) ≫
@@ -1455,12 +1630,15 @@ lemma strongTrans.twoCell_app_inversion {x y} (f : x ⟶ y) (a) :
   simp
 
 lemma mapStrongTrans_obj_inversion_fiber {x y} (f : x ⟶ y) (a) :
-    ((mapStrongTrans B s hs).obj ((A.map f ⋙ ι A y).obj ((A.map (CategoryTheory.inv f)).obj a))).fiber =
+    ((mapStrongTrans B s hs).obj
+      ((A.map f ⋙ ι A y).obj ((A.map (CategoryTheory.inv f)).obj a))).fiber =
     (strongTrans.app B s hs y).obj a := by
-  simp only [Functor.comp_obj, mapStrongTrans_obj_base, ι_obj_base, sigma_obj,
+  simp only [Functor.comp_obj, mapStrongTrans_obj_base, ι_obj_base,
     mapStrongTrans_obj_fiber, ι_obj_fiber, Functor.map_inv]
   simp [← Functor.comp_obj, ← Grpd.comp_eq_comp]
 
+-- Match bundled groupoid coercions in the dependent functor projections.
+set_option backward.isDefEq.respectTransparency false in
 lemma mapStrongTrans_map_inversion_fiber {x y} (f : x ⟶ y) (a) :
     ((mapStrongTrans B s hs).map ((ιNatTrans f).app ((A.map (CategoryTheory.inv f)).obj a))).fiber =
     (strongTrans.twoCell B s hs f).app a ≫
@@ -1473,27 +1651,28 @@ lemma mapStrongTrans_map_inversion_fiber {x y} (f : x ⟶ y) (a) :
   rw! (castMode := .all) [h]
   simp [mapStrongTrans_map_fiber B s hs, strongTrans.twoCell_app_inversion]
 
+-- Match bundled groupoid coercions in the dependent fiber projections.
+set_option backward.isDefEq.respectTransparency false in
 lemma lamObjFiberObjCompSigMap_app_inversion {x y} (f : x ⟶ y) (a) :
     lamObjFiberObjCompSigMap.app A (inversion B s hs) f ((A.map (CategoryTheory.inv f)).obj a) ≍
     (strongTrans.twoCell B s hs f).app a := by
   have h := mapStrongTrans_map_inversion_fiber A B s hs f a
-  simp [← heq_eq_eq] at h
-  apply HEq.trans _ h
+  apply HEq.trans _ ((heq_of_eq h).trans (comp_eqToHom_heq ..))
   fapply Functor.Groupoidal.Hom.hext'
   · simp
-  · simp only [Functor.map_inv, Functor.comp_obj, mapStrongTrans_obj_base, ι_obj_base, sigma_obj,
+  · simp only [Functor.map_inv, Functor.comp_obj, mapStrongTrans_obj_base, ι_obj_base,
       mapStrongTrans_map_base, Functor.Groupoidal.ιNatTrans_app_base, sigma_map]
     apply Grpd.Functor.hcongr_obj
     · rw [inversion_comp_forgetToGrpd]
     · rw [inversion_comp_forgetToGrpd]
     · rw [inversion_comp_forgetToGrpd]
     · rw [Functor.map_inv]
-      simp only [mapStrongTrans_obj_fiber, ι_obj_base, sigma_obj, ι_obj_fiber]
+      simp only [mapStrongTrans_obj_fiber, ι_obj_base, ι_obj_fiber]
       apply Grpd.Functor.hcongr_obj rfl _ _ HEq.rfl
       · simp [inversion_comp_forgetToGrpd]
       · apply lamObjFiber_obj_obj_inversion_heq
   · simp only [Functor.map_inv, Functor.comp_obj, mapStrongTrans_obj_base, ι_obj_base,
-      mapStrongTrans_obj_fiber, sigma_obj, ι_obj_fiber]
+      mapStrongTrans_obj_fiber, ι_obj_fiber]
     apply Grpd.Functor.hcongr_obj
     · rfl
     · simp
@@ -1510,10 +1689,12 @@ lemma whiskerLeftInvLamObjObjSigMap_inversion_app {x y} (f : x ⟶ y) (a) :
     (strongTrans.twoCell B s hs f).app a := by
   simp [whiskerLeftInvLamObjObjSigMap, lamObjFiberObjCompSigMap]
   have h := Functor.congr_obj (((pi A B).map f).obj (PGrpd.objFiber' hs x)).obj.property a
-  simp only [sigma_obj, sigma.fstNatTrans_app, pi_obj_α, Functor.comp_obj,
-    Functor.Groupoidal.forget_obj, Functor.id_obj] at h
+  simp only [sigma.fstNatTrans_app,
+     Functor.id_obj] at h
   exact (comp_eqToHom_heq ..).trans (lamObjFiberObjCompSigMap_app_inversion ..)
 
+-- Match bundled groupoid coercions in the dependent fiber projections.
+set_option backward.isDefEq.respectTransparency false in
 lemma lamMapFiber_inversion_heq {x y} (f : x ⟶ y) :
     lamMapFiber A (pi.inversion B s hs) f ≍ PGrpd.mapFiber s f := by
   refine HEq.trans ?_ (PGrpd.mapFiber'_heq hs f)
@@ -1524,13 +1705,13 @@ lemma lamMapFiber_inversion_heq {x y} (f : x ⟶ y) :
   · rw! (castMode := .all) [inversion_comp_forgetToGrpd]
     congr 1
     rw! [lamObjFiber_inversion_heq, PGrpd.objFiber'_heq]
-    simp only [pi_obj_α, Functor.Grothendieck.forget_obj, Grpd.coe_of, ← heq_eq_eq,
-      heq_cast_iff_heq, eqRec_heq_iff_heq, cast_heq_iff_heq]
+    simp only [Grpd.coe_of, ← heq_eq_eq,
+      heq_cast_iff_heq, eqRec_heq_iff, cast_heq_iff_heq]
     rfl
   · apply lamObjFiber_inversion_heq'
   · intro a a' ha
     subst ha
-    simp only [sigma_obj, sigma.fstNatTrans_app, pi_obj_α, Set.mem_setOf_eq,
+    simp only [sigma.fstNatTrans_app,
       lamMapFiber]
     exact whiskerLeftInvLamObjObjSigMap_inversion_app A B s hs f a
 
@@ -1593,6 +1774,7 @@ lemma equivInv_equivFun (F : Δ ⥤ ∫ pi A B) (hF : F ⋙ forget = σ) :
   apply (isPullback _).hom_ext
   · rw [Functor.IsPullback.fac_left, Functor.IsPullback.fac_left, lam_inversion]
   · rw! [Functor.IsPullback.fac_right, hF]
+    rfl
 
 lemma equivFun_equivInv (G : ∫ σ ⋙ A ⥤ ∫ B) (hG : G ⋙ forget = pre A σ) :
     equivFun B (equivInv B G hG) (equivInv_comp_forget B G hG) = G := by
@@ -1601,6 +1783,7 @@ lemma equivFun_equivInv (G : ∫ σ ⋙ A ⥤ ∫ B) (hG : G ⋙ forget = pre A
   · have : pre A σ ⋙ B = (G ⋙ toPGrpd B) ⋙ PGrpd.forgetToGrpd := by
       rw [Functor.assoc, toPGrpd_forgetToGrpd, ← Functor.assoc, hG]
     rw! [Functor.IsPullback.fac_left, Functor.IsPullback.fac_left, this, inversion_lam]
+    rfl
   · rw [Functor.IsPullback.fac_right, hG]
 
 lemma equivFun_comp {Δ' : Type u} [Groupoid.{v} Δ'] {σ' : Δ' ⥤ Γ} (τ : Δ' ⥤ Δ) (hτ : τ ⋙ σ = σ')
@@ -1659,6 +1842,8 @@ lemma lam_comp {Γ Δ : Ctx} (σ : Δ ⟶ Γ) {A : Γ ⟶ U.{v}.Ty} {σA : Δ 
     lam (U.substWk σ A σA eq ≫ b) = σ ≫ lam b :=
   USig.SigAux_comp pi.lam (by intros; rw [pi.lam_comp]) σ eq b
 
+-- Allow reduction of bundled groupoid coercions in this proof.
+set_option backward.isDefEq.respectTransparency false in
 lemma lam_tp {Γ : Ctx} {A : Γ ⟶ U.{v}.Ty} (B : U.ext A ⟶ U.Ty) (b : U.ext A ⟶ U.{v}.Tm)
     (b_tp : b ≫ U.tp = B) : UPi.lam b ≫ U.tp = Pi B := by
   subst b_tp
@@ -1666,6 +1851,8 @@ lemma lam_tp {Γ : Ctx} {A : Γ ⟶ U.{v}.Ty} (B : U.ext A ⟶ U.Ty) (b : U.ext
   rw [← toCoreAsSmallEquiv_symm_apply_comp_right]
   rfl
 
+-- Allow reduction of bundled groupoid coercions in this proof.
+set_option backward.isDefEq.respectTransparency false in
 def unLam {Γ : Ctx} {A : Γ ⟶ U.{v}.Ty} (B : U.ext A ⟶ U.Ty) (f : Γ ⟶ U.Tm)
     (f_tp : f ≫ U.tp = UPi.Pi B) : U.ext A ⟶ U.{v}.Tm :=
   toCoreAsSmallEquiv.symm <| pi.inversion (toCoreAsSmallEquiv B) (toCoreAsSmallEquiv f) (by
@@ -1673,6 +1860,8 @@ def unLam {Γ : Ctx} {A : Γ ⟶ U.{v}.Ty} (B : U.ext A ⟶ U.Ty) (f : Γ ⟶ U.
     rw [← toCoreAsSmallEquiv_apply_comp_right, f_tp]
     simp [Pi])
 
+-- Allow reduction of bundled groupoid coercions in this proof.
+set_option backward.isDefEq.respectTransparency false in
 lemma unLam_tp {Γ : Ctx} {A : Γ ⟶ U.{v}.Ty} (B : U.ext A ⟶ U.Ty) (f : Γ ⟶ U.Tm)
     (f_tp : f ≫ U.tp = UPi.Pi B) : UPi.unLam B f f_tp ≫ U.tp = B := by
   dsimp [unLam, U.tp]
@@ -1680,6 +1869,8 @@ lemma unLam_tp {Γ : Ctx} {A : Γ ⟶ U.{v}.Ty} (B : U.ext A ⟶ U.Ty) (f : Γ 
     pi.inversion_comp_forgetToGrpd]
   rfl
 
+-- Allow reduction of bundled groupoid coercions in this proof.
+set_option backward.isDefEq.respectTransparency false in
 lemma unLam_lam {Γ : Ctx} {A : Γ ⟶ U.{v}.Ty} (B : U.ext A ⟶ U.Ty) (b : U.ext A ⟶ U.Tm)
     (b_tp : b ≫ U.tp = B) : UPi.unLam B (UPi.lam b) (lam_tp _ _ b_tp) = b := by
   subst b_tp
@@ -1689,9 +1880,11 @@ lemma unLam_lam {Γ : Ctx} {A : Γ ⟶ U.{v}.Ty} (B : U.ext A ⟶ U.Ty) (b : U.e
   rw [pi.inversion_lam (toCoreAsSmallEquiv A) (toCoreAsSmallEquiv b)]
   rfl
 
+-- Allow reduction of bundled groupoid coercions in this proof.
+set_option backward.isDefEq.respectTransparency false in
 lemma lam_unLam {Γ : Ctx} {A : Γ ⟶ U.{v}.Ty} (B : U.ext A ⟶ U.Ty) (f : Γ ⟶ U.Tm)
     (f_tp : f ≫ U.tp = UPi.Pi B) : UPi.lam (UPi.unLam B f f_tp) = f := by
-  simp only [U_Tm, lam, USig.SigAux, unLam, toCoreAsSmallEquiv.symm_apply_eq]
+  simp only [lam, USig.SigAux, unLam, toCoreAsSmallEquiv.symm_apply_eq]
   erw [toCoreAsSmallEquiv.apply_symm_apply]
   rw [pi.lam_inversion]
 
diff --git a/HoTTLean/Groupoids/Sigma.lean b/HoTTLean/Groupoids/Sigma.lean
index dcdc59ab..0d31b85f 100644
--- a/HoTTLean/Groupoids/Sigma.lean
+++ b/HoTTLean/Groupoids/Sigma.lean
@@ -49,7 +49,8 @@ def sigmaMap : sigmaObj B x ⥤ sigmaObj B y :=
 @[simp] theorem sigmaMap_obj_fiber (a) :
     ((sigmaMap B f).obj a).fiber = (B.map ((ιNatTrans f).app a.base)).obj (a.fiber) := rfl
 
-theorem ιNatTrans_app_base (a : sigmaObj B x) : ((ιNatTrans f).app a.base) = homMk f (𝟙 (A.map f).obj a.base) :=
+theorem ιNatTrans_app_base (a : sigmaObj B x) : ((ιNatTrans f).app a.base) =
+    homMk f (𝟙 (A.map f).obj a.base) :=
   rfl
 
 @[simp] theorem sigmaMap_map_base {a b : sigmaObj B x} {p : a ⟶ b} :
@@ -58,12 +59,16 @@ theorem ιNatTrans_app_base (a : sigmaObj B x) : ((ιNatTrans f).app a.base) = h
 theorem sigmaMap_map_fiber_aux {a b : sigmaObj B x} {p : a ⟶ b} :
     (((ι A y ⋙ B)).map ((sigmaMap B f).map p).base).obj ((sigmaMap B f).obj a).fiber =
     (B.map ((ιNatTrans f).app (base b))).obj (((ι A x ⋙ B).map p.base).obj a.fiber) := by
-  simp only [sigmaObj, sigmaMap, Functor.comp_obj, Functor.comp_map, pre_map_base, map_map_base,
-    pre_obj_fiber, map_obj_fiber, Functor.whiskerRight_app]
+  change (B.map ((ι A y).map ((A.map f).map p.base))).obj
+    ((B.map ((ιNatTrans f).app a.base)).obj a.fiber) =
+    (B.map ((ιNatTrans f).app b.base)).obj
+      ((B.map ((ι A x).map p.base)).obj a.fiber)
   simp only [← Functor.comp_obj, ← Grpd.comp_eq_comp, ← Functor.map_comp]
-  congr 2
-  exact ((ιNatTrans f).naturality p.base).symm
+  exact congrArg (fun k => (B.map k).obj a.fiber)
+    ((ιNatTrans f).naturality p.base).symm
 
+-- Let the projection lemmas unfold the bundled groupoid in this proof.
+set_option backward.isDefEq.respectTransparency false in
 @[simp] theorem sigmaMap_map_fiber {a b : sigmaObj B x} {p : a ⟶ b} :
     ((sigmaMap B f).map p).fiber =
     eqToHom (sigmaMap_map_fiber_aux B f) ≫ (B.map ((ιNatTrans f).app (base b))).map p.fiber := by
@@ -74,9 +79,13 @@ variable {B}
 
 @[simp] theorem sigmaMap_id_obj {p} : (sigmaMap B (𝟙 x)).obj p = p := by
   apply hext
-  · simp [sigmaMap]
-  · simp [sigmaMap, Grpd.eqToHom_obj]
+  · simp only [sigmaMap_obj_base, Grpd.map_id_obj]
+  · simp only [sigmaMap_obj_fiber, ιNatTrans_id_app, eqToHom_map,
+      Grpd.eqToHom_obj]
+    exact cast_heq _ _
 
+-- The projection and transport simp lemmas need to unfold the bundled groupoid.
+set_option backward.isDefEq.respectTransparency false in
 @[simp] theorem sigmaMap_id_map {p1 p2} {hp2 : p2 = (sigmaMap B (𝟙 x)).obj p2}
     (f : p1 ⟶ p2) :
     (sigmaMap B (𝟙 x)).map f =
@@ -105,20 +114,25 @@ variable {B}
 
 variable {z : Γ} {f} {g : y ⟶ z}
 
+-- Unfold the bundled groupoid for the projection and transport lemmas.
+set_option backward.isDefEq.respectTransparency false in
 @[simp] theorem sigmaMap_comp_obj {p} : (sigmaMap B (f ≫ g)).obj p =
     (sigmaMap B g).obj ((sigmaMap B f).obj p) := by
   dsimp only [sigmaMap]
   apply hext
   · simp
   · simp only [sigmaObj, Functor.comp_obj, pre_obj_fiber, map_obj_fiber, Functor.whiskerRight_app,
-      ιNatTrans_comp_app, Functor.map_comp, eqToHom_map, Grpd.comp_eq_comp, Grpd.eqToHom_obj, cast_heq_iff_heq, heq_eq_eq]
+      ιNatTrans_comp_app, Functor.map_comp, eqToHom_map, Grpd.comp_eq_comp, Grpd.eqToHom_obj,
+      cast_heq_iff_heq, heq_eq_eq]
     aesop_cat
 
+-- Unfold bundled groupoids when elaborating dependent transport projections.
+set_option backward.isDefEq.respectTransparency false in
 @[simp] theorem sigmaMap_comp_map {B : ∫(A) ⥤ Grpd.{v₃,u₃}} {x y z : Γ} {f : x ⟶ y} {g : y ⟶ z}
     {p q : sigmaObj B x} (hpq : p ⟶ q)
     {h1 : (sigmaMap B (f ≫ g)).obj p = (sigmaMap B g).obj ((sigmaMap B f).obj p)}
-    {h2 : (sigmaMap B g).obj ((sigmaMap B f).obj q) = (sigmaMap B (f ≫ g)).obj q}
-    : (sigmaMap B (f ≫ g)).map hpq =
+    {h2 : (sigmaMap B g).obj ((sigmaMap B f).obj q) = (sigmaMap B (f ≫ g)).obj q} :
+    (sigmaMap B (f ≫ g)).map hpq =
     eqToHom h1 ≫ (sigmaMap B g).map ((sigmaMap B f).map hpq) ≫ eqToHom h2 := by
   have h : B.map ((ιNatTrans (f ≫ g)).app q.base) =
     B.map ((ιNatTrans f).app q.base)
@@ -167,7 +181,7 @@ theorem sigma_naturality_aux (x) :
   rfl
 
 lemma whiskerRight_ιNatTrans_naturality {x y : Δ} (f : x ⟶ y) :
-  Functor.whiskerRight (ιNatTrans f) (pre A σ ⋙ B) =
+    Functor.whiskerRight (ιNatTrans f) (pre A σ ⋙ B) =
     eqToHom (sigma_naturality_aux B σ x) ≫ Functor.whiskerRight (ιNatTrans (σ.map f)) B ≫
     eqToHom (by simp [Functor.assoc, sigma_naturality_aux B σ y]) := by
   aesop
@@ -181,6 +195,8 @@ lemma sigmaObj_naturality (x) :
     sigmaObj B (σ.obj x) = sigmaObj (pre A σ ⋙ B) x :=
   sigma_naturality_obj _ _ _
 
+-- The rewrite crosses the bundled Grpd hom and its underlying functor.
+set_option backward.isDefEq.respectTransparency false in
 lemma sigmaMap_naturality {x y : Δ} (f : x ⟶ y) : sigmaMap B (σ.map f)
     = Grpd.homOf (map (eqToHom (sigma_naturality_aux B σ x).symm)) ≫
     sigmaMap (pre A σ ⋙ B) f ≫
@@ -241,29 +257,34 @@ lemma assocIso_hom_app_fiber {x y} (f : x ⟶ y) (p) :
   rfl
 
 @[simp] theorem assocIso_id {x} :
-    assocIso B (𝟙 x) = eqToIso (by simp [sigmaMap_id, Functor.id_comp]) := by
+    assocIso B (𝟙 x) = eqToIso (by simp [sigmaMap_id]; rfl) := by
   simp [assocIso, preNatIso_congr B (ιNatIso_id A x), preNatIso_eqToIso]
+  apply eqToIso_trans
 
+-- Let projection simp lemmas unfold the bundled groupoid in this proof.
+set_option backward.isDefEq.respectTransparency false in
 theorem assocIso_comp {x y z : Γ} (f : x ⟶ y) (g : y ⟶ z) : assocIso B (f ≫ g) =
     assocIso B f ≪≫ Functor.isoWhiskerLeft (sigmaMap B f) (assocIso B g)
-    ≪≫ eqToIso (by simp [sigmaMap_comp, Functor.assoc]) := by
-  simp only [assocFib, sigmaMap, assocIso, preNatIso_congr B (ιNatIso_comp A f g), Iso.trans_hom,
-    Functor.isoWhiskerLeft_hom, eqToIso.hom, pre_comp, preNatIso_comp, preNatIso_eqToIso,
-    isoWhiskerLeft_eqToIso, eqToIso_trans, Functor.isoWhiskerLeft_trans, Iso.trans_assoc]
-  rfl
+    ≪≫ eqToIso (by simp only [sigmaMap_comp]; exact (Functor.assoc _ _ _).symm) := by
+  ext p
+  fapply Hom.ext
+  · simp [assocIso, ιNatIso_comp]
+  · simp only [assocIso, Iso.trans_hom, eqToIso.hom, NatTrans.comp_app]
+    rw! [eqToHom_app]
+    simp
 
 abbrev assocHom {x y : Γ} (f : x ⟶ y) :
     assocFib B x ⟶ sigmaMap B f ⋙ assocFib B y :=
   (assocIso B f).hom
 
 @[simp] theorem assocHom_id {x : Γ} :
-    assocHom B (𝟙 x) = eqToHom (by simp [sigmaMap_id, Functor.id_comp]) := by
-  simp [assocHom, assocIso_id]
+    assocHom B (𝟙 x) = eqToHom (by simp [sigmaMap_id]; rfl) := by
+  simp only [assocHom, assocIso_id, eqToIso.hom]
 
 theorem assocHom_comp {x y z : Γ} (f : x ⟶ y) (g : y ⟶ z) :
     assocHom B (f ≫ g) = assocHom B f ≫ Functor.whiskerLeft (sigmaMap B f) (assocHom B g) ≫
-      eqToHom (by simp [sigmaMap_comp, Functor.assoc]) := by
-  simp [assocHom, assocIso_comp]
+      eqToHom (by simp only [sigmaMap_comp]; exact (Functor.assoc _ _ _).symm) := by
+  simp only [assocHom, assocIso_comp, Iso.trans_hom, Functor.isoWhiskerLeft_hom, eqToIso.hom]
 
 section
 
@@ -276,14 +297,17 @@ def assocFibObj (x : ∫ B) : sigmaObj B x.base.base :=
 @[simp] theorem assocFibObj_base (x : ∫ B) : (assocFibObj x).base = x.base.fiber :=
   rfl
 
+-- Unfold bundled groupoid morphisms to combine the functor maps.
+set_option backward.isDefEq.respectTransparency false in
 theorem assocFibMap_aux {x y : ∫ B} (f : x ⟶ y) :
     ((ι A y.base.base ⋙ B).map (Hom.fiber (Hom.base f))).obj
     (fiber ((sigmaMap B (Hom.base (Hom.base f))).obj (assocFibObj x))) =
     (B.map (Hom.base f)).obj x.fiber := by
-  simp only [assocFibObj, objMk_base, ← Functor.comp_obj, Functor.comp_map,
-    sigmaMap_obj_fiber, objMk_fiber]
-  simp only [Functor.comp_obj, ← Grpd.comp_eq_comp, ← Functor.map_comp]
-  congr 2
+  change (B.map ((ι A y.base.base).map (Hom.fiber (Hom.base f)))).obj
+    ((B.map ((ιNatTrans (Hom.base (Hom.base f))).app x.base.fiber)).obj x.fiber) =
+    (B.map (Hom.base f)).obj x.fiber
+  simp only [← Functor.comp_obj, ← Grpd.comp_eq_comp, ← Functor.map_comp]
+  apply congrArg (fun k => (B.map k).obj x.fiber)
   apply Hom.ext <;> simp
 
 def assocFibMap {x y : ∫ B} (f : x ⟶ y) :
@@ -298,9 +322,13 @@ def assocFibMap {x y : ∫ B} (f : x ⟶ y) :
     (assocFibMap f).fiber = eqToHom (assocFibMap_aux ..) ≫ f.fiber := by
   rfl
 
+-- Expose the bundled fiber groupoid for the identity projection lemmas.
+set_option backward.isDefEq.respectTransparency false in
 lemma assocFibMap_id (x : ∫ B) : assocFibMap (𝟙 x) = eqToHom (by simp) := by
   apply Hom.ext <;> simp [sigmaObj]
 
+-- Expose the bundled groupoid for dependent projection simplification.
+set_option backward.isDefEq.respectTransparency false in
 lemma assocFibMap_comp {x y z : ∫ B} (f : x ⟶ y) (g : y ⟶ z) :
     assocFibMap (f ≫ g) = eqToHom (by simp) ≫
     (sigmaMap B (Hom.base (Hom.base g))).map (assocFibMap f) ≫ assocFibMap g := by
@@ -326,18 +354,22 @@ lemma assocFibMap_comp {x y z : ∫ B} (f : x ⟶ y) (g : y ⟶ z) :
       · simp
       · simp
     conv => left; rw! (castMode := .all) [this]
-    simp only [Functor.comp_obj, Grpd.map_comp_map, Category.assoc, eqRec_heq_iff_heq,
+    simp only [Functor.comp_obj, Grpd.map_comp_map, Category.assoc, eqRec_heq_iff,
       eqToHom_comp_heq_iff, heq_eq_eq]
     congr 1
     simp [← heq_eq_eq]
     rfl
 
+-- The functor associativity rewrites cross the bundled Grpd coercion.
+set_option backward.isDefEq.respectTransparency false in
 lemma assocFib_comp_forget (c : Γ) : assocFib B c ⋙ forget ⋙
     forget = ι (sigma A B) c ⋙ forget := by
   dsimp [assocFib]
   rw [ι_comp_forget, ← Functor.assoc, pre_comp_forget, Functor.assoc, ι_comp_forget]
   aesop_cat
 
+-- Extensionality crosses the bundled Grpd coercion.
+set_option backward.isDefEq.respectTransparency false in
 lemma assocFibObj_assocFib_obj (c : Γ) (x : sigmaObj B c) :
     assocFibObj ((assocFib B c).obj x) ≍ x := by
   simp only [assocFib, assocFibObj, pre_obj_fiber, heq_eq_eq]
@@ -346,6 +378,8 @@ lemma assocFibObj_assocFib_obj (c : Γ) (x : sigmaObj B c) :
   · rw! (castMode := .all) [pre_obj_base]
     simp
 
+-- Expose bundled groupoid projections for the dependent map equations.
+set_option backward.isDefEq.respectTransparency false in
 lemma assocFibMap_assocFib_map (c : Γ) {x y : sigmaObj B c} (f : x ⟶ y) :
     assocFibMap ((assocFib B c).map f) ≍ f := by
   dsimp [assocFib, assocFibMap]
@@ -354,6 +388,8 @@ lemma assocFibMap_assocFib_map (c : Γ) {x y : sigmaObj B c} (f : x ⟶ y) :
   rw! (castMode := .all) [pre_map_base]
   apply Hom.hext' <;> simp
 
+-- The extensionality proof crosses bundled groupoid coercions.
+set_option backward.isDefEq.respectTransparency false in
 lemma assocFib_forget_comp_forget_obj (x : ∫ B) :
     (assocFib B ((forget ⋙ forget).obj x)).obj
     (assocFibObj x) = x := by
@@ -365,6 +401,8 @@ lemma assocFib_forget_comp_forget_obj (x : ∫ B) :
       simp
   · simp
 
+-- Dependent projections cross bundled groupoid coercions.
+set_option backward.isDefEq.respectTransparency false in
 lemma assocHom_app_comp_pre_map_assocFibMap {x y : ∫ B} (f : x ⟶ y) :
     (assocHom B (Hom.base (Hom.base f))).app (assocFibObj x) ≫
       (pre B (ι A y.base.base)).map (assocFibMap f) ≍ f := by
@@ -403,16 +441,22 @@ lemma assocFibMap_assocHom_app {c c' : Γ} (f : c ⟶ c') (x : sigmaObj B c) :
   dsimp [assocFibMap, assocHom, assocIso]
   fapply Hom.hext' rfl HEq.rfl HEq.rfl
   · rfl
-  · simp only [objMk_base, Functor.comp_obj, sigmaMap_obj_base, homMk_base, Functor.comp_map,
-    sigmaMap_obj_fiber, objMk_fiber, homMk_fiber, preNatIso_hom_app_fiber, pre_comp,
-    Category.comp_id, heq_eq_eq]
+  · simp only [Functor.comp_obj, Functor.comp_map]
     symm
-    apply Functor.Groupoidal.id_fiber
+    -- The dependent fiber types require unfolding the bundled groupoid coercion.
+    rw! (transparency := .default) (castMode := .all) [Functor.Groupoidal.id_fiber]
+    rw! (transparency := .default) (castMode := .all) [homMk_fiber, preNatIso_hom_app_fiber]
+    simp
+    rw! (transparency := .default) (castMode := .all) [homMk_fiber, Category.comp_id]
+    apply eqToHom_heq_eqToHom
+    rfl
 
 end
 
+-- The coherence equations unfold bundled groupoid projections.
+set_option backward.isDefEq.respectTransparency false in
 def assoc : ∫ B ≅≅ ∫ sigma A B := .symm <| functorIsoFrom
-  (assocFib B) (assocHom B) (by simp) (by simp [assocHom_comp])
+  (assocFib B) (assocHom B) (by simp) (by intro c₁ c₂ c₃ f g; exact assocHom_comp B f g)
   (forget ⋙ forget) assocFibObj assocFibMap assocFibMap_id assocFibMap_comp
   assocFib_comp_forget assocFibObj_assocFib_obj assocFibMap_assocFib_map
   assocFib_forget_comp_forget_obj assocHom_app_comp_pre_map_assocFibMap
@@ -457,11 +501,7 @@ lemma assoc_hom_map_fiber_base {x y} (f : x ⟶ y) : ((assoc B).hom.map f).fiber
 
 @[simp]
 lemma assoc_hom_map_fiber_fiber {x y} (f : x ⟶ y) : ((assoc B).hom.map f).fiber.fiber =
-    eqToHom (by
-      simp [assoc_hom]
-      rw [← Functor.comp_obj, ← Grpd.comp_eq_comp, ← Functor.map_comp]
-      congr 2
-      fapply Hom.ext <;> simp) ≫ f.fiber :=
+    eqToHom (assocFibMap_aux f) ≫ f.fiber :=
   rfl
 
 @[simp]
@@ -476,41 +516,56 @@ lemma assoc_inv_obj_base_fiber (x) : ((assoc B).inv.obj x).base.fiber = x.fiber.
 lemma assoc_inv_obj_fiber (x) :  ((assoc B).inv.obj x).fiber = x.fiber.fiber :=
   rfl
 
+-- The inverse construction unfolds semireducible groupoid wrappers in this proof.
+set_option backward.isDefEq.respectTransparency false in
 @[simp]
 lemma assoc_inv_map_base_base {x y} (f : x ⟶ y) : ((assoc B).inv.map f).base.base = f.base := by
-  simp only [assoc, Functor.Iso.symm_inv, functorIsoFrom_hom_obj, sigma_obj, assocFib,
-    functorIsoFrom_hom_map, sigma_map, comp_base, pre_map_base, assocIso_hom_app_base_base,
-    ι_map_base, ι_obj_base]
+  simp only [assoc, Functor.Iso.symm_inv, assocFib, functorIsoFrom_hom_map, comp_base,
+    pre_map_base, assocIso_hom_app_base_base, ι_map_base, ι_obj_base]
   erw [Category.comp_id]
   rfl
 
+-- Unfold the bundled groupoid wrappers when matching dependent projections.
+set_option backward.isDefEq.respectTransparency false in
 @[simp]
 lemma assoc_inv_map_base_fiber {x y} (f : x ⟶ y) : ((assoc B).inv.map f).base.fiber =
     eqToHom (by simp) ≫ f.fiber.base := by
-  simp only [assoc, Functor.Iso.symm_inv, functorIsoFrom_hom_obj, sigma_obj, assocFib,
-    functorIsoFrom_hom_map, sigma_map, comp_base, assocIso_hom_app_base_base,
-    Functor.Groupoidal.comp_fiber, assocIso_hom_app_base_fiber, Functor.comp_obj,
-    CategoryTheory.Functor.map_id, Category.id_comp]
-  rw! [pre_map_base, ι_map_fiber]
+  simp only [assoc, Functor.Iso.symm_inv]
+  rw! (transparency := .default) [functorIsoFrom_hom_map]
+  simp only [comp_base, Functor.Groupoidal.comp_fiber, assocIso_hom_app_base_base,
+    assocHom, assocIso_hom_app_base_fiber, assocFib]
+  rw! (transparency := .default) [pre_map_base, ι_map_fiber]
   simp
+  rw! (transparency := .default) [CategoryTheory.Functor.map_id]
+  rw! (transparency := .default) [Grpd.id_eq_id, CategoryTheory.Functor.id_map]
+  rw! (transparency := .default) [Category.id_comp, ← Category.assoc, eqToHom_trans]
   rfl
 
+-- Unfold the bundled groupoid wrappers when matching dependent projections.
+set_option backward.isDefEq.respectTransparency false in
 @[simp]
 lemma assoc_inv_map_fiber {x y} (f : x ⟶ y) : ((assoc B).inv.map f).fiber =
     eqToHom (by
-      simp only [assoc_inv_obj_fiber, sigma_map,
-        Functor.comp_map, sigmaMap_obj_fiber]
-      conv => rhs; rw [← Functor.comp_obj, ← Grpd.comp_eq_comp, ← Functor.map_comp]
+      simp only [assoc_inv_obj_fiber, Functor.comp_map]
+      conv => rhs; rw! (transparency := .default) [← Functor.comp_obj, ← Grpd.comp_eq_comp,
+        ← Functor.map_comp]
       rfl) ≫ f.fiber.fiber := by
-  simp [assoc]
+  simp only [assoc, Functor.Iso.symm_inv]
+  rw! (transparency := .default) [functorIsoFrom_hom_map]
+  simp [assocFib, assocHom]
+  rw! (transparency := .default) [CategoryTheory.Functor.map_id]
+  simp only [Category.id_comp]
   rfl
 
+-- Unfold the bundled groupoid wrappers when matching dependent projections.
+set_option backward.isDefEq.respectTransparency false in
 lemma assocFibMap_pre_pre_map {Δ : Type u₄} [Groupoid.{v₄} Δ] {σ : Δ ⥤ Γ} {x y} (f : x ⟶ y) :
     assocFibMap ((pre B (pre A σ)).map f) ≍ assocFibMap f := by
   have pre_pre_obj_base_base (x) : ((pre B (pre A σ)).obj x).base.base = σ.obj x.base.base := by
     rw [pre_obj_base, pre_obj_base]
   have pre_pre_obj_base_fiber (x) : ((pre B (pre A σ)).obj x).base.fiber = x.base.fiber := by
     rw! (castMode := .all) [pre_obj_base, pre_obj_fiber]
+    rfl
   simp [assocFibMap]
   apply Hom.hext'
   · rw [sigma_naturality_aux]
@@ -524,20 +579,24 @@ lemma assocFibMap_pre_pre_map {Δ : Type u₄} [Groupoid.{v₄} Δ] {σ : Δ ⥤
     simp only [← heq_eq_eq, cast_heq_iff_heq]
     apply Functor.Groupoidal.hext'
     · rw! (castMode := .all) [sigma_naturality_aux, pre_pre_obj_base_base]
+      rfl
     · simp
     · simp
   · apply Functor.Groupoidal.hext'
     · rw! (castMode := .all) [sigma_naturality_aux, pre_pre_obj_base_base]
+      rfl
     · simp [pre_pre_obj_base_fiber]
     · simp
   · simp only [sigmaMap_obj_base, objMk_base, homMk_base, Functor.comp_obj, Functor.comp_map]
     rfl
   · simp
 
+-- Unfold the bundled groupoid wrappers when matching dependent projections.
+set_option backward.isDefEq.respectTransparency false in
 lemma assoc_comp_fiber {Δ : Type u₄} [Groupoid.{v₄} Δ] (σ : Δ ⥤ Γ) {x y} (f : x ⟶ y) :
     Hom.fiber (((assoc (pre A σ ⋙ B)).hom ⋙ map (eqToHom (sigma_naturality ..).symm) ⋙
     pre (sigma A B) σ).map f) ≍ Hom.fiber ((pre B (pre A σ) ⋙ (assoc B).hom).map f) := by
-  simp only [assoc_hom, Functor.comp_obj, sigma_obj, Functor.comp_map, sigma_map, pre_map_fiber,
+  simp only [assoc_hom, Functor.comp_obj, Functor.comp_map, pre_map_fiber,
     map_map_fiber, Functor.Groupoidal.functorTo_obj_base, Functor.Groupoidal.forget_obj,
     Functor.Groupoidal.functorTo_map_base, forget_map, Grpd.comp_eq_comp,
     Functor.Groupoidal.functorTo_obj_fiber, assocFibObj, Functor.Groupoidal.functorTo_map_fiber,
@@ -546,6 +605,8 @@ lemma assoc_comp_fiber {Δ : Type u₄} [Groupoid.{v₄} Δ] (σ : Δ ⥤ Γ) {x
   rw! [assocFibMap_pre_pre_map]
   simp
 
+-- Allow these rewrites to unfold the bundled groupoid wrappers.
+set_option backward.isDefEq.respectTransparency false in
 lemma assoc_comp {Δ : Type u₄} [Groupoid.{v₄} Δ] (σ : Δ ⥤ Γ) :
     (sigma.assoc ((pre A σ) ⋙ B)).hom ⋙
     map (eqToHom (by simp [sigma_naturality])) ⋙ pre (sigma A B) σ =
@@ -560,7 +621,7 @@ lemma assoc_comp {Δ : Type u₄} [Groupoid.{v₄} Δ] (σ : Δ ⥤ Γ) :
     conv => right; rw [← Functor.assoc, pre_comp_forget]
     simp only [Functor.assoc, pre_comp_forget]
   · intro x
-    simp only [Functor.comp_obj, sigma_obj, pre_obj_fiber, map_obj_fiber, assoc_hom_obj_base,
+    simp only [Functor.comp_obj, pre_obj_fiber, map_obj_fiber, assoc_hom_obj_base,
       eqToHom_app, heq_eq_eq]
     rw [eqToHom_eq_homOf_map]
     apply Functor.Groupoidal.hext
@@ -571,6 +632,7 @@ lemma assoc_comp {Δ : Type u₄} [Groupoid.{v₄} Δ] (σ : Δ ⥤ Γ) :
       rw [eqToHom_app, Grpd.eqToHom_obj]
       simp
       rw! (castMode := .all) [assoc_hom_obj_fiber_fiber, assoc_hom_obj_fiber_fiber, pre_obj_fiber]
+      rfl
     · rw [← Functor.assoc, ι_comp_pre A σ x.base.base]
   · intro x y f
     apply assoc_comp_fiber B σ f
@@ -622,6 +684,8 @@ abbrev SigAux
     Γ ⟶ Ctx.coreAsSmall.{max v₁ v₂, max u (max v₁ v₂ + 1)} Y :=
   toCoreAsSmallEquiv.symm (S (toCoreAsSmallEquiv A) (toCoreAsSmallEquiv B))
 
+-- Allow these rewrites to unfold the bundled groupoid wrappers.
+set_option backward.isDefEq.respectTransparency false in
 include S_naturality in
 theorem SigAux_comp
     (B : U.ext A ⟶ Ctx.coreAsSmall.{v₂, max u (max v₁ v₂ + 1)} X) :
@@ -651,6 +715,8 @@ def assoc : U.ext B ≅ U.ext (Sig.{v₁,v₂,u} B) :=
   Grpd.mkIso' (sigma.assoc (toCoreAsSmallEquiv B)) ≪≫
     eqToIso (by dsimp [U.ext, Sig]; rw [toCoreAsSmallEquiv.apply_symm_apply])
 
+-- Allow these rewrites to unfold the bundled groupoid wrappers.
+set_option backward.isDefEq.respectTransparency false in
 set_option maxHeartbeats 400000 in
 lemma assoc_comp : (assoc (U.substWk σ A σA eq ≫ B)).hom ≫ U.substWk σ (Sig.{v₁,v₂,u} B)
     (Sig.{v₁,v₂,u} (U.substWk σ A σA eq ≫ B)) (Sig_comp.{v₁,v₂,u} ..).symm =
@@ -664,6 +730,8 @@ lemma assoc_comp : (assoc (U.substWk σ A σA eq ≫ B)).hom ≫ U.substWk σ (S
   simp only [pre_comp, Functor.id_comp]
   apply sigma.assoc_comp' (toCoreAsSmallEquiv B) (σ := σ) (toCoreAsSmallEquiv σA)
 
+-- Allow these rewrites to unfold the bundled groupoid wrappers.
+set_option backward.isDefEq.respectTransparency false in
 lemma assoc_disp : (assoc B).hom ≫ U.disp (Sig.{v₁,v₂,u} B) = U.disp B ≫ U.disp A := by
   simpa [assoc] using sigma.assoc_hom_comp_forget _
 
diff --git a/HoTTLean/Groupoids/UnstructuredModel.lean b/HoTTLean/Groupoids/UnstructuredModel.lean
index c7a538ec..0813b030 100644
--- a/HoTTLean/Groupoids/UnstructuredModel.lean
+++ b/HoTTLean/Groupoids/UnstructuredModel.lean
@@ -40,6 +40,8 @@ def asSmallClosedType : (tensorUnit _ : Ctx) ⟶ Ty.{v+1, max u (v+2)} :=
   toCoreAsSmallEquiv.symm ((Functor.const _).obj
     (Grpd.of (Core (AsSmall.{v+1} Grpd.{v,v}))))
 
+-- The fiber maps reduce through bundled universe definitions in the functor laws.
+set_option backward.isDefEq.respectTransparency false in
 def isoExtAsSmallClosedTypeHom :
     Core (AsSmall.{max u (v+2)} Grpd.{v,v})
     ⥤ ∫(toCoreAsSmallEquiv (asSmallClosedType.{v, max u (v + 2)})) where
@@ -58,17 +60,9 @@ def isoExtAsSmallClosedTypeInv :
     ∫(toCoreAsSmallEquiv (asSmallClosedType.{v, max u (v + 2)})) ⥤
     Core (AsSmall.{max u (v+2)} Grpd.{v,v}) where
   obj X := ⟨AsSmall.up.obj (AsSmall.down.obj.{_,_,v+1} X.fiber.of)⟩
-  map {X Y} F := ⟨{
-    hom := AsSmall.up.map.{_,_,max u (v+2)}
-      (AsSmall.down.map F.fiber.iso.hom)
-    inv := AsSmall.up.map.{_,_,max u (v+2)}
-      (AsSmall.down.map F.fiber.iso.inv)
-    hom_inv_id := by
-      simp only [← Functor.map_comp, Iso.hom_inv_id]
-      rfl
-    inv_hom_id := by
-      simp only [← Functor.map_comp, Iso.inv_hom_id]
-      rfl }⟩
+  map {X Y} F := by
+    let e : X.fiber.of ≅ Y.fiber.of := F.fiber.iso
+    exact ⟨(AsSmall.down ⋙ AsSmall.up).mapIso e⟩
 
 def isoExtAsSmallClosedType :
     Ty.{v,max u (v+2)}
@@ -96,18 +90,23 @@ variable {Γ : Grpd} {C : Type (v+1)} [Category.{v} C] {Δ : Grpd} (σ : Δ ⟶
 
 namespace U
 
+-- Reduce the universe projections when applying the pullback equations.
+set_option backward.isDefEq.respectTransparency false in
 theorem substWk_eq (A : Γ ⟶ U.Ty.{v}) (σA : Δ ⟶ U.Ty.{v}) (eq) :
     U.substWk σ A σA eq =
     map (eqToHom (by subst eq; rfl)) ⋙ pre (toCoreAsSmallEquiv A) σ := by
   apply (U.disp_pullback A).hom_ext
   · rw [substWk_var]
     simp [var, Grpd.comp_eq_comp]
-    rw [← toCoreAsSmallEquiv_symm_apply_comp_left, Functor.assoc, pre_toPGrpd,
+    erw [← toCoreAsSmallEquiv_symm_apply_comp_left, Functor.assoc, pre_toPGrpd,
       map_eqToHom_toPGrpd]
+    rfl
   · rw [substWk_disp]
     simp [Grpd.comp_eq_comp, Functor.assoc]
     erw [pre_comp_forget, ← Functor.assoc, map_forget]
 
+-- Unfold the bundled universe projections while checking the section equation.
+set_option backward.isDefEq.respectTransparency false in
 @[simp] theorem sec_eq {Γ : Ctx} (α : Γ ⟶ U.{v}.Tm) (A : Γ ⟶ U.{v}.Ty) (hα : α ≫ U.tp = A) :
     U.sec _ α hα = sec (toCoreAsSmallEquiv A) (toCoreAsSmallEquiv α)
     (by rw [← hα, Grpd.comp_eq_comp, tp, toCoreAsSmallEquiv_apply_comp_right]) := by
diff --git a/HoTTLean/Model/Natural/Interpretation.lean b/HoTTLean/Model/Natural/Interpretation.lean
index 569dfdfc..415bf644 100644
--- a/HoTTLean/Model/Natural/Interpretation.lean
+++ b/HoTTLean/Model/Natural/Interpretation.lean
@@ -184,15 +184,19 @@ theorem var_substWk_of_lt_length {l i} {Δ Γ Γ' : 𝒞} (σ : Δ ⟶ Γ) (d :
     intro h
     cases i
     · clear ih
-      dsimp [ExtSeq.var] at st_mem ⊢
+      dsimp [ExtSeq.var] at st_mem
+      dsimp [substWk, ExtSeq.var]
       simp_part at st_mem ⊢
       obtain ⟨rfl, rfl⟩ := st_mem
-      simp
+      simp only [NaturalModel.Universe.substWk_var]
+      exact Part.mem_assert_iff.mpr ⟨rfl, Part.mem_some_iff.mpr rfl⟩
     · simp only [length, Nat.add_lt_add_iff_right] at h
-      dsimp [ExtSeq.var] at st_mem ⊢
+      dsimp [ExtSeq.var] at st_mem
+      dsimp [substWk, ExtSeq.var]
       simp_part at st_mem ⊢
       obtain ⟨a, amem, rfl⟩ := st_mem
-      refine ⟨_, ih amem h, ?_⟩
+      apply Part.mem_bind_iff.mpr
+      refine ⟨_, ih amem h, Part.mem_some_iff.mpr ?_⟩
       simp only [← Functor.map_comp_assoc]
       simp [NaturalModel.Universe.substWk_disp]
 
@@ -253,13 +257,21 @@ protected def tp {l : Nat} (Γ : s.CObj) (llen : l < s.length + 1) (i : ℕ) :
     Part (y(Γ.1) ⟶ s[l].Ty) :=
   Γ.2.tp llen i
 
+-- Unfold the CObj abbreviation when matching membership under the dependent transport.
+set_option backward.isDefEq.respectTransparency false in
 @[simp]
 theorem mem_var_zero {Γ : s.CObj} {l' l'len A l} {llen : l < s.length + 1} {x} :
     x ∈ (Γ.snoc (l := l') l'len A).var llen 0 ↔
     ∃ l'l : l' = l, x = l'l ▸ s[l'].var A := by
   dsimp only [UHomSeq.CObj.var, UHomSeq.CObj.snoc, UHomSeq.ExtSeq.var]
-  simp_part; exact exists_congr fun _ => by subst l'; simp_part
+  rw [Part.mem_assert_iff]
+  apply exists_congr
+  intro h
+  cases h
+  simp_part
 
+-- Unfold CObj while matching membership through the dependent snoc projection.
+set_option backward.isDefEq.respectTransparency false in
 @[simp]
 theorem mem_var_succ {Γ : s.CObj} {l' l'len A l i} {llen : l < s.length + 1} {x} :
     x ∈ (Γ.snoc (l := l') l'len A).var llen (i+1) ↔
@@ -484,7 +496,7 @@ theorem mem_ofTerm_pair {Γ l i j B t u} {llen : l < s.length + 1} {x} :
     have ilen : i < s.length + 1 := by> omega
     have jlen : j < s.length + 1 := by> omega
     ∃ t' : y(Γ.1) ⟶ s[i].Tm, t' ∈ I.ofTerm Γ i t ∧
-    ∃ A', ∃ eq : t' ≫ s[i].tp = A',
+    ∃ A' : y(Γ.1) ⟶ s[i].Ty, ∃ eq : t' ≫ s[i].tp = A',
     ∃ B' : y((Γ.snoc ilen A').1) ⟶ s[j].Ty,
       B' ∈ I.ofType (Γ.snoc ilen A') j B ∧
     ∃ u' : y(Γ.1) ⟶ s[j].Tm, u' ∈ I.ofTerm Γ j u ∧
@@ -542,6 +554,18 @@ theorem mem_ofTerm_idRec {Γ l i j t M r u h} {llen : l < s.length + 1} {x} :
     ∃ h_tp : h' ≫ s[i].tp = s.mkId ilen A' t' u' t_tp u_tp,
     x = s.mkIdRec ilen llen A' t' t_tp B' B_eq M' r' r_tp u' u_tp h' h_tp := by
   dsimp only [ofTerm]; simp_part; simp only [exists_prop_eq']
+  apply exists_congr
+  intro ilen
+  apply exists_congr
+  intro t'
+  apply and_congr_right
+  intro ht
+  constructor
+  · intro h
+    exact ⟨_, rfl, h⟩
+  · rintro ⟨B', B_eq, h⟩
+    subst B'
+    exact h
 
 @[simp]
 theorem mem_ofTerm_code {Γ l t} {llen : l < s.length + 1} {x} :
@@ -633,14 +657,15 @@ def sub1 {se : y(Γ.1) ⟶ s[l].Tm}
 @[simp] theorem sub1_toSb {se : y(Γ.1) ⟶ s[l].Tm}
     (A : y(Γ.1) ⟶ s[l].Ty) (e) (eq : se ≫ s[l].tp = A) (H : se ∈ I.ofTerm Γ l e) :
     (sub1 llen A e eq H).toSb = Expr.toSb e := by
-  simp [sub1, toSb, Expr.toSb]
+  rfl
 
 def up {Δ Γ σ full} (sσ : I.CSb Δ Γ σ full)
     {l} (llen : l < s.length + 1) (A : y(Γ.1) ⟶ s[l].Ty)
     (A' := ym(σ) ≫ A) (eq : ym(σ) ≫ A = A' := by rfl) :
     I.CSb (Δ.snoc llen A') (Γ.snoc llen A) (s[l].substWk σ A _ eq) full := by
   refine ((CSb.wk _ _ false).comp sσ).snoc' _ _ (.bvar 0) (by simp) _ ?_
-  simp [UHomSeq.CObj.var, UHomSeq.ExtSeq.var]
+  rw [ofTerm_bvar]
+  exact UHomSeq.CObj.mem_var_zero.mpr ⟨rfl, rfl⟩
 
 @[simp] theorem up_toSb {Δ Γ σ full} (sσ : I.CSb Δ Γ σ full)
      {l} {llen : l < s.length + 1} {A A'} {eq : ym(σ) ≫ A = A'} :
@@ -654,6 +679,8 @@ end CSb
 open UHomSeq
 variable (slen : univMax ≤ s.length)
 
+-- The dependent substitution proof relies on the earlier elaborator transparency behavior.
+set_option backward.isDefEq.respectTransparency false in
 theorem mem_ofType_ofTerm_subst' {full}
     (IH : full = true → ∀ {Δ Γ l} (llen : l < s.length + 1) {sσ} (σ : I.CSb Δ Γ sσ false) {se e},
       se ∈ I.ofTerm Γ l e llen → ym(sσ) ≫ se ∈ I.ofTerm Δ l (Expr.subst σ.toSb e) llen)
@@ -700,7 +727,7 @@ theorem mem_ofType_ofTerm_subst' {full}
     simp [ofTerm_bvar] at H
     simp [Expr.subst]
     induction σ generalizing i with simp [CSb.toSb, *]
-    | wk => exact CObj.mem_var_succ.2 ⟨_, ‹_›, rfl⟩
+    | wk => exact ⟨_, ‹_›, rfl⟩
     | @comp _ _ _ _ _ full σ τ ih1 ih2 =>
       simp [Expr.comp]
       cases full with
@@ -791,16 +818,18 @@ theorem mem_ofType_wk {e l l' hl} (hl' : l' < s.length + 1)
     ym(s[l'].disp X) ≫ se ∈ I.ofType (Γ.snoc hl' X) l (Expr.subst Expr.wk e) hl :=
   (I.mem_ofType_ofTerm_subst hl (.wk hl' X) rfl).1 H
 
+-- Let category rewrite lemmas reduce the contextual-object projections.
+set_option backward.isDefEq.respectTransparency false in
 theorem mem_ofType_of_isClosed {e l} (e_cl : e.isClosed)
     (Γ : s.CObj) (hl : l < s.length + 1) {se} (se_mem : se ∈ I.ofType s.nilCObj l e hl) :
     isTerminal_yUnit.from y(Γ.1) ≫ se ∈ I.ofType Γ l e hl := by
   rcases Γ with ⟨_, ext⟩
   induction ext
-  · convert se_mem; simp
+  · simpa only [UHomSeq.nilCObj, IsTerminal.from_self, Category.id_comp] using se_mem
   · rename_i X se_mem
     have := I.mem_ofType_wk (X := X) (by omega) se_mem
-    convert this using 1 <;>
-      simp [e.subst_of_isClosed _ e_cl, UHomSeq.CObj.snoc]
+    simpa only [e.subst_of_isClosed _ e_cl, UHomSeq.CObj.snoc,
+      ← Category.assoc, IsTerminal.comp_from] using this
 
 theorem mem_ofTerm_wk {e l l' hl} (hl' : l' < s.length + 1)
     {Γ : s.CObj} {X : y(Γ.1) ⟶ s[l'].Ty}
@@ -826,13 +855,16 @@ theorem mem_ofTerm_toSb {e l l' hl} (hl' : l' < s.length + 1)
 
 theorem tp_sound {Γ i A l} (H : Lookup Γ i A l) {sΓ} (hΓ : sΓ ∈ I.ofCtx Γ) :
     ∃ llen, ∃ sA ∈ sΓ.tp llen i, sA ∈ I.ofType sΓ l A llen := by
-  induction H generalizing sΓ with (
-    obtain ⟨_, hΓ', _, _, hB, rfl⟩ := I.mem_ofCtx_snoc.1 hΓ
-    simp [UHomSeq.CObj.tp, UHomSeq.ExtSeq.tp, *] at *)
-  | zero => exact I.mem_ofType_wk _ hB
+  induction H generalizing sΓ with
+  | zero =>
+    obtain ⟨_, hΓ', llen, _, hB, rfl⟩ := I.mem_ofCtx_snoc.1 hΓ
+    refine ⟨llen, _, ?_, I.mem_ofType_wk _ hB⟩
+    exact Part.mem_assert rfl (Part.mem_some _)
   | succ _ _ ih =>
-    have ⟨_, _, _, _⟩ := ih hΓ'
-    exact ⟨‹_›, _, ‹_›, I.mem_ofType_wk _ ‹_›⟩
+    obtain ⟨_, hΓ', _, _, hB, rfl⟩ := I.mem_ofCtx_snoc.1 hΓ
+    obtain ⟨llen, sA, hA, hA'⟩ := ih hΓ'
+    refine ⟨llen, _, ?_, I.mem_ofType_wk _ hA'⟩
+    exact Part.mem_bind hA (Part.mem_some _)
 
 theorem var_sound {Γ i A l} (H : Lookup Γ i A l) {sΓ} (hΓ : sΓ ∈ I.ofCtx Γ) :
     ∃ llen, ∃ st ∈ sΓ.var llen i, st ≫ s[l].tp ∈ I.ofType sΓ l A llen := by
@@ -1030,6 +1062,8 @@ theorem EqTmIH.refl_tm {Γ A t t' l} :
       I.mem_ofTerm_refl.2 ⟨_, ht', rfl⟩,
       mkRefl_tp ..⟩
 
+-- The dependent context projections need reducible transparency during elaboration.
+set_option backward.isDefEq.respectTransparency false in
 theorem EqTmIH.idRec {Γ A M M' t t' r r' u u' h h' l l'} :
     I.EqTmIH Γ l A t t' →
     I.EqTpIH ((.Id l (.subst .wk A) (.subst .wk t) (.bvar 0), l) :: (A, l) :: Γ) l' M M' →
@@ -1060,7 +1094,8 @@ theorem EqTmIH.idRec {Γ A M M' t t' r r' u u' h h' l l'} :
   refine ⟨_, hΓ, _, _,
     (I.mem_ofType_ofTerm_subst _ (.snoc (.sub1 _ _ _ utp hu) _ _ _ ?_ hh) ?_).1 hM, _,
     I.mem_ofTerm_idRec.2 ⟨_, _, ht, _, ttp, B, ?b, _, hM, _, hr, ?a, _, hu, utp, _, hh, htp, rfl⟩,
-    I.mem_ofTerm_idRec.2 ⟨_, _, ht', _, ttp, B, ?b, _, hM', _, hr', ?a, _, hu', utp, _, hh', htp, rfl⟩,
+    I.mem_ofTerm_idRec.2
+      ⟨_, _, ht', _, ttp, B, ?b, _, hM', _, hr', ?a, _, hu', utp, _, hh', htp, rfl⟩,
     mkIdRec_tp ..⟩
   · rw [htp, Beq, comp_mkId]
     · congr 1 <;> simp
@@ -1096,7 +1131,8 @@ theorem EqTmIH.app_lam {Γ A B t u l l'} :
         I.mem_ofTerm_lam.2 ⟨rfl, _, hA, _, ht, by simp⟩, _, hu, _, utp, _, hB,
         s.mkLam_tp (t_tp := ttp) ..,
         (s.mkApp_mkLam (t_tp := ttp) ..).symm⟩,
-      I.mem_ofTerm_toSb _ hu _ ht, by simp [ttp]⟩
+      I.mem_ofTerm_toSb _ hu _ ht, by
+        exact (Category.assoc _ _ _).trans (congrArg _ ttp)⟩
 
 theorem EqTmIH.fst_snd_pair {Γ A B t u l l'} :
     I.WfTpIH ((A, l) :: Γ) l' B → I.WfTmIH Γ l A t → I.WfTmIH Γ l' (Expr.subst t.toSb B) u →
@@ -1116,6 +1152,8 @@ theorem EqTmIH.fst_snd_pair {Γ A B t u l l'} :
        ⟨_, hΓ, _, _, I.mem_ofType_toSb _ ht ttp hB, _,
         I.mem_ofTerm_snd.2 ⟨_, _, hA, _, hB, _, hp, tp, (mkSnd_mkPair ..).symm⟩, hu, utp⟩⟩
 
+-- Keep the semantic context projections transparent in this dependent proof.
+set_option backward.isDefEq.respectTransparency false in
 theorem EqTmIH.idRec_refl {Γ A M t r l l'} :
     I.WfTmIH Γ l A t →
     I.WfTpIH ((.Id l (.subst .wk A) (.subst .wk t) (.bvar 0), l) :: (A, l) :: Γ) l' M →
@@ -1143,6 +1181,8 @@ theorem EqTmIH.idRec_refl {Γ A M t r l l'} :
     ⟨_, hΓ, _, _, sM, _, ir, hr, sr⟩
   simp [Beq, comp_mkId, sAeq]
 
+-- Keep the semantic context projections transparent in this dependent proof.
+set_option backward.isDefEq.respectTransparency false in
 theorem EqTmIH.lam_app {Γ A B f l l'} :
     I.WfTmIH Γ (max l l') (.pi l l' A B) f →
     I.EqTmIH Γ (max l l') (.pi l l' A B) f
@@ -1158,6 +1198,8 @@ theorem EqTmIH.lam_app {Γ A B f l l'} :
       ⟨_, hΓ, _, _, hF, _, hf, hl, ftp⟩
     simp [ftp, comp_mkPi]
 
+-- Keep the semantic context projections transparent in this dependent proof.
+set_option backward.isDefEq.respectTransparency false in
 theorem EqTmIH.pair_fst_snd {Γ A B p l l'} :
     I.WfTmIH Γ (max l l') (Expr.sigma l l' A B) p →
     I.EqTmIH Γ (max l l') (Expr.sigma l l' A B) p
@@ -1167,7 +1209,8 @@ theorem EqTmIH.pair_fst_snd {Γ A B p l l'} :
     exact
       have h1 := I.mem_ofTerm_fst.2 ⟨by omega, _, hA, _, hB, _, hp, ptp, rfl⟩
       have h2 := I.mem_ofTerm_snd.2 ⟨by omega, _, hA, _, hB, _, hp, ptp, rfl⟩
-      have pr := I.mem_ofTerm_pair.2 ⟨rfl, _, h1, _, mkFst_tp .., _, hB, _, h2, mkSnd_tp .., by simp⟩
+       have pr := I.mem_ofTerm_pair.2
+         ⟨rfl, _, h1, _, mkFst_tp .., _, hB, _, h2, mkSnd_tp .., by simp⟩
       ⟨_, hΓ, _, _, hP, _, hp, pr, ptp⟩
 
 theorem EqTmIH.code_el {Γ a l} :
diff --git a/HoTTLean/Model/Natural/NaturalModel.lean b/HoTTLean/Model/Natural/NaturalModel.lean
index 3671be69..90de330a 100644
--- a/HoTTLean/Model/Natural/NaturalModel.lean
+++ b/HoTTLean/Model/Natural/NaturalModel.lean
@@ -260,13 +260,12 @@ def mk (A : y(Γ) ⟶ M.Ty) (B : y(M.ext A) ⟶ X) : y(Γ) ⟶ M.Ptp.obj X :=
 @[simp]
 lemma fst_mk (A : y(Γ) ⟶ M.Ty) (B : y(M.ext A) ⟶ X) :
     fst M (mk M A B) = A := by
-  simp [fst, mk]
+  exact UvPoly.Equiv.fst_mk' M.uvPolyTp X A (M.disp_pullback A).flip B
 
 @[simp]
 lemma snd_mk (A : y(Γ) ⟶ M.Ty) (B : y(M.ext A) ⟶ X) :
     snd M (mk M A B) _ (fst_mk ..) = B := by
-  dsimp only [snd, mk]
-  rw! [UvPoly.Equiv.snd'_mk']
+  exact UvPoly.Equiv.snd'_mk' M.uvPolyTp X A (M.disp_pullback A).flip B
 
 section
 variable {Δ : Ctx} {σ : Δ ⟶ Γ} {AB : y(Γ) ⟶ M.Ptp.obj X}
@@ -279,8 +278,8 @@ theorem fst_comp_right {Y} (σ : X ⟶ Y) : fst M (AB ≫ M.Ptp.map σ) = fst M
 
 theorem snd_comp_right {Y} (σ : X ⟶ Y) {A} (eq : fst M AB = A) :
     snd M (AB ≫ M.Ptp.map σ) _ (fst_comp_right M σ ▸ eq) = snd M AB _ eq ≫ σ := by
-  simp only [snd, Ptp]
-  rw [UvPoly.Equiv.snd'_comp_right M.uvPolyTp X Y σ AB]
+  exact UvPoly.Equiv.snd'_comp_right M.uvPolyTp X Y σ AB
+    (by rw [← fst, eq]; exact (M.disp_pullback A).flip)
 
 theorem snd_comp_left {A} (eqA : fst M AB = A) {σA} (eqσ : ym(σ) ≫ A = σA) :
     snd M (ym(σ) ≫ AB) σA (by simp [fst_comp_left, eqA, eqσ]) =
@@ -290,19 +289,26 @@ theorem snd_comp_left {A} (eqA : fst M AB = A) {σA} (eqσ : ym(σ) ≫ A = σA)
   have H2 : IsPullback ym(M.disp σA) (M.var σA)
     (ym(σ) ≫ UvPoly.Equiv.fst M.uvPolyTp X AB) M.uvPolyTp.p := by
     rw [← fst, eqA, eqσ]; exact (M.disp_pullback _).flip
-  convert UvPoly.Equiv.snd'_comp_left M.uvPolyTp X AB H1 _ H2
-  apply H1.hom_ext <;> simp [← Functor.map_comp, substWk]
+  have hlift : H1.lift (ym(M.disp σA) ≫ ym(σ)) (M.var σA)
+      (by simpa only [Category.assoc] using H2.w) = ym(M.substWk σ A _ eqσ) := by
+    apply H1.hom_ext
+    · simp only [IsPullback.lift_fst, ← Functor.map_comp, substWk_disp]
+    · simp
+  have h := UvPoly.Equiv.snd'_comp_left M.uvPolyTp X AB H1 ym(σ) H2
+  rw [hlift] at h
+  exact h
 
 theorem mk_comp_left {Δ Γ : Ctx} (M : Universe Ctx) (σ : Δ ⟶ Γ)
     {X : Psh Ctx} (A : y(Γ) ⟶ M.Ty) (σA) (eq : ym(σ) ≫ A = σA) (B : y(M.ext A) ⟶ X) :
     ym(σ) ≫ PtpEquiv.mk M A B = PtpEquiv.mk M σA (ym(M.substWk σ A _ eq) ≫ B) := by
-  dsimp [PtpEquiv.mk]
-  have h := UvPoly.Equiv.mk'_comp_left M.uvPolyTp X A (M.disp_pullback A).flip B ym(σ)
-    σA eq (M.disp_pullback σA).flip
-  convert h
-  apply (M.disp_pullback _).hom_ext
-  · simp
-  · simp [← Functor.map_comp, substWk_disp]
+  apply UvPoly.Equiv.ext' M.uvPolyTp X
+    (R := y(M.ext σA)) (f := ym(M.disp σA)) (g := M.var σA)
+    (by rw [← fst, fst_comp_left, fst_mk, eq]; exact (M.disp_pullback σA).flip)
+  · change snd M (ym(σ) ≫ mk M A B) σA (by rw [fst_comp_left, fst_mk, eq]) =
+      snd M (mk M σA _) σA (fst_mk ..)
+    rw [snd_comp_left M (fst_mk M A B) eq, snd_mk, snd_mk]
+  · change fst M (ym(σ) ≫ mk M A B) = fst M (mk M σA _)
+    rw [fst_comp_left, fst_mk, fst_mk, eq]
 
 theorem mk_comp_right {Γ : Ctx} (M : Universe Ctx)
     {X Y : Psh Ctx} (σ : X ⟶ Y) (A : y(Γ) ⟶ M.Ty) (B : y(M.ext A) ⟶ X) :
@@ -312,8 +318,8 @@ theorem mk_comp_right {Γ : Ctx} (M : Universe Ctx)
 theorem ext {AB AB' : y(Γ) ⟶ M.Ptp.obj X}
     (A := fst M AB) (eq : fst M AB = A := by rfl)
     (h1 : fst M AB = fst M AB')
-    (h2 : snd M AB A eq = snd M AB' A (h1 ▸ eq))
-    : AB = AB' := UvPoly.Equiv.ext' _ _ _ h1 h2
+    (h2 : snd M AB A eq = snd M AB' A (h1 ▸ eq)) :
+    AB = AB' := UvPoly.Equiv.ext' _ _ _ h1 h2
 
 theorem eta (AB : y(Γ) ⟶ M.Ptp.obj X) : mk M (fst M AB) (snd M AB) = AB :=
   .symm <| ext _ _ rfl (by simp) (by simp)
@@ -326,7 +332,7 @@ end PtpEquiv
 theorem PtpEquiv.mk_map {Γ : Ctx} {X Y : Psh Ctx}
     (A : y(Γ) ⟶ M.Ty) (x : y(M.ext A) ⟶ X) (α : X ⟶ Y) :
     mk M A x ≫ M.Ptp.map α = mk M A (x ≫ α) := by
-  simp [mk, Ptp, UvPoly.Equiv.mk'_comp_right]
+  exact PtpEquiv.mk_comp_right M α A x
 
 /-! ## Polynomial composition `M.tp ▸ N.tp` -/
 
@@ -356,6 +362,8 @@ def fst (ab : y(Γ) ⟶ M.uvPolyTp.compDom N.uvPolyTp) : y(Γ) ⟶ M.Tm :=
   ab ≫ pullback.snd N.tp (UvPoly.PartialProduct.fan M.uvPolyTp N.Ty).snd ≫
     pullback.snd (M.uvPolyTp.fstProj N.Ty) M.uvPolyTp.p
 
+-- The presheaf category and polynomial projection require reducible instance matching.
+set_option backward.isDefEq.respectTransparency false in
 /-- Computation of `comp` (part 1).
 
 `fst_tp` is (part 1) of the computation that
@@ -373,8 +381,14 @@ theorem fst_tp (ab : y(Γ) ⟶ M.uvPolyTp.compDom N.uvPolyTp) :
   have : pullback.snd (M.uvPolyTp.fstProj N.Ty) M.tp ≫ M.tp =
     pullback.fst (M.uvPolyTp.fstProj N.Ty) M.tp ≫ M.uvPolyTp.fstProj N.Ty :=
       Eq.symm pullback.condition
-  simp [PtpEquiv.fst, fst, this]
-  rfl
+  change fst ab ≫ M.tp = UvPoly.Equiv.fst M.uvPolyTp N.Ty _
+  rw [UvPoly.Equiv.fst_eq]
+  simp only [fst, UvPoly.compP, Category.assoc]
+  change ab ≫ (pullback.snd N.tp (PartialProduct.fan M.uvPolyTp N.Ty).snd ≫
+      (pullback.snd (M.uvPolyTp.fstProj N.Ty) M.tp ≫ M.tp)) =
+    ab ≫ (pullback.snd N.tp (PartialProduct.fan M.uvPolyTp N.Ty).snd ≫
+      (pullback.fst (M.uvPolyTp.fstProj N.Ty) M.tp ≫ M.uvPolyTp.fstProj N.Ty))
+  rw [this]
 
 theorem comp_fst (ab : y(Γ) ⟶ M.uvPolyTp.compDom N.uvPolyTp) (σ : y(Δ) ⟶ y(Γ)) :
     σ ≫ fst ab = fst (σ ≫ ab) := by simp [fst]
@@ -410,8 +424,11 @@ def snd (ab : y(Γ) ⟶ M.uvPolyTp.compDom N.uvPolyTp) : y(Γ) ⟶ N.Tm :=
   ab ≫ pullback.fst N.tp (PartialProduct.fan M.uvPolyTp N.Ty).snd
 
 theorem comp_snd (ab : y(Γ) ⟶ M.uvPolyTp.compDom N.uvPolyTp) (σ : y(Δ) ⟶ y(Γ)) :
-    σ ≫ snd ab = snd (σ ≫ ab) := by simp [snd]
+    σ ≫ snd ab = snd (σ ≫ ab) := by
+  exact (Category.assoc σ ab _).symm
 
+-- The pullback presentation of compDom needs reducible instance compatibility.
+set_option backward.isDefEq.respectTransparency false in
 /-- Universal property of `compDom`, decomposition (part 4).
 
 A map `ab : y(Γ) ⟶ M.uvPolyTp.compDom N.uvPolyTp` is equivalently three maps
@@ -424,8 +441,10 @@ theorem snd_tp (ab : y(Γ) ⟶ M.uvPolyTp.compDom N.uvPolyTp)
     snd ab ≫ N.tp = ym(M.sec _ (fst ab) eq) ≫ dependent ab A eq := by
   simp [snd, pullback.condition, dependent, PtpEquiv.snd, Equiv.snd'_eq]
   simp only [← Category.assoc]; congr! 1
-  apply pullback.hom_ext <;> simp [fst, UvPoly.compP]
+  apply pullback.hom_ext <;> simp [fst, UvPoly.compP] <;> rfl
 
+-- The pullback presentation of compDom needs reducible instance compatibility.
+set_option backward.isDefEq.respectTransparency false in
 /-- Universal property of `compDom`, constructing a map into `compDom`. -/
 def mk (α : y(Γ) ⟶ M.Tm) {A} (eq : α ≫ M.tp = A) (B : y(M.ext A) ⟶ N.Ty) (β : y(Γ) ⟶ N.Tm)
     (h : β ≫ N.tp = ym(M.sec _ α eq) ≫ B) : y(Γ) ⟶ M.uvPolyTp.compDom N.uvPolyTp := by
@@ -438,25 +457,52 @@ def mk (α : y(Γ) ⟶ M.Tm) {A} (eq : α ≫ M.tp = A) (B : y(M.ext A) ⟶ N.Ty
     simp only [← Category.assoc]; congr! 1
     apply pullback.hom_ext <;> simp
 
+-- The pullback presentation of compDom needs reducible instance compatibility.
+set_option backward.isDefEq.respectTransparency false in
 @[simp]
 theorem fst_mk (α : y(Γ) ⟶ M.Tm) {A} (eq : α ≫ M.tp = A) (B : y(M.ext A) ⟶ N.Ty) (β : y(Γ) ⟶ N.Tm)
     (h : β ≫ N.tp = ym(M.sec _ α eq) ≫ B) : fst (mk α eq B β h) = α := by
-  simp [mk, fst]
-
+  simp only [mk, fst, ← Category.assoc]
+  change (pullback.lift β (pullback.lift (PtpEquiv.mk M A B) α _) _ ≫
+    pullback.snd N.uvPolyTp.p (PartialProduct.fan M.uvPolyTp N.Ty).snd) ≫
+    pullback.snd (M.uvPolyTp.fstProj N.Ty) M.uvPolyTp.p = α
+  rw [pullback.lift_snd]
+  change pullback.lift (PtpEquiv.mk M A B) α _ ≫
+    pullback.snd (PartialProduct.fan M.uvPolyTp N.Ty).fst M.uvPolyTp.p = α
+  exact pullback.lift_snd _ _ _
+
+-- The pullback presentation of compDom needs reducible instance compatibility.
+set_option backward.isDefEq.respectTransparency false in
 @[simp]
 theorem dependent_mk (α : y(Γ) ⟶ M.Tm) {A} (eq : α ≫ M.tp = A)
     (B : y(M.ext A) ⟶ N.Ty) (β : y(Γ) ⟶ N.Tm)
     (h : β ≫ N.tp = ym(M.sec _ α eq) ≫ B) :
     dependent (mk α eq B β h) A (by simp [fst_mk, eq]) = B := by
   simp [mk, dependent, UvPoly.compP]
-  convert PtpEquiv.snd_mk M A B using 2
-  slice_lhs 1 2 => apply pullback.lift_snd
-  simp
+  have hp (w₁ : PtpEquiv.mk M A B ≫ (PartialProduct.fan M.uvPolyTp N.Ty).fst =
+      α ≫ M.uvPolyTp.p)
+      (w₂ : β ≫ N.uvPolyTp.p =
+        pullback.lift (PtpEquiv.mk M A B) α w₁ ≫ (PartialProduct.fan M.uvPolyTp N.Ty).snd) :
+      (pullback.lift β (pullback.lift (PtpEquiv.mk M A B) α w₁) w₂ ≫
+        pullback.snd N.uvPolyTp.p (PartialProduct.fan M.uvPolyTp N.Ty).snd) ≫
+        pullback.fst (PartialProduct.fan M.uvPolyTp N.Ty).fst M.uvPolyTp.p =
+        PtpEquiv.mk M A B := by
+    rw [pullback.lift_snd]
+    exact pullback.lift_fst _ _ _
+  convert PtpEquiv.snd_mk M A B using 1
+  congr 1
+  rw [← Category.assoc]
+  exact hp _ _
+  all_goals apply proof_irrel_heq
 
+-- The pullback presentation of compDom needs reducible instance compatibility.
+set_option backward.isDefEq.respectTransparency false in
 @[simp]
 theorem snd_mk (α : y(Γ) ⟶ M.Tm) {A} (eq : α ≫ M.tp = A) (B : y(M.ext A) ⟶ N.Ty) (β : y(Γ) ⟶ N.Tm)
     (h : β ≫ N.tp = ym(M.sec _ α eq) ≫ B) : snd (mk α eq B β h) = β := by
-  simp [mk, snd]
+  change pullback.lift β (pullback.lift (PtpEquiv.mk M A B) α _) _ ≫
+    pullback.fst N.uvPolyTp.p (PartialProduct.fan M.uvPolyTp N.Ty).snd = β
+  exact pullback.lift_fst _ _ _
 
 theorem ext {ab₁ ab₂ : y(Γ) ⟶ M.uvPolyTp.compDom N.uvPolyTp}
     {A} (eq : fst ab₁ ≫ M.tp = A)
@@ -467,8 +513,8 @@ theorem ext {ab₁ ab₂ : y(Γ) ⟶ M.uvPolyTp.compDom N.uvPolyTp}
   simp only [dependent, PtpEquiv.snd] at h2
   generalize_proofs _ _ H at h2
   refine Equiv.ext' M.uvPolyTp N.Ty H ?_ h2
-  simp [Equiv.fst, pullback.condition]
-  simp only [← Category.assoc]; congr 1
+  exact (fst_tp ab₁).symm.trans
+    ((congrArg (fun a => a ≫ M.tp) h1).trans (fst_tp ab₂))
 
 theorem comp_mk
     (α : y(Γ) ⟶ M.Tm) {A} (e1 : α ≫ M.tp = A)
@@ -602,6 +648,8 @@ def reflSubst (a : y(Γ) ⟶ M.Tm) : Γ ⟶ idIntro.motiveCtx a :=
     congr 1
     apply idIntro.isKernelPair.hom_ext <;> simp)
 
+-- Allow the pullback projections to unfold the motive context during elaboration.
+set_option backward.isDefEq.respectTransparency false in
 @[reassoc]
 theorem comp_reflSubst' {Γ Δ} (σ : Δ ⟶ Γ) (a : y(Γ) ⟶ M.Tm) :
     ym(σ) ≫ ym(idIntro.reflSubst a) =
@@ -852,20 +900,27 @@ lemma toK_comp_left {Δ} (σ : Δ ⟶ Γ) : ii.toK (ym(σ) ≫ a) =
 
 def toI : y(ii.motiveCtx a) ⟶ ie.i :=
   ie.i_isPullback.lift (M.var _) (ym(M.disp _) ≫ toK ii a)
-  (by rw [(M.disp_pullback _).w]; simp [IdIntro.mkId, toK])
+  (by
+    dsimp only [IdIntro.motiveCtx]
+    rw [(M.disp_pullback _).w]
+    simp [IdIntro.mkId, toK])
 
-lemma toI_comp_i1 : ie.toI a ≫ ie.i1 = M.var _ := by simp [toI]
+lemma toI_comp_i1 : ie.toI a ≫ ie.i1 = M.var _ := by
+  exact ie.i_isPullback.lift_fst _ _ _
 
-lemma toI_comp_i2 : ie.toI a ≫ ie.i2 = ym(M.disp _) ≫ ii.toK a :=
-  by simp [toI]
+lemma toI_comp_i2 : ie.toI a ≫ ie.i2 = ym(M.disp _) ≫ ii.toK a := by
+    exact ie.i_isPullback.lift_snd _ _ _
 
 lemma toI_comp_left {Δ} (σ : Δ ⟶ Γ) : toI ie (ym(σ) ≫ a) =
     ym(ii.motiveSubst σ a) ≫ toI ie a := by
-  dsimp [toI]
   apply ie.i_isPullback.hom_ext
-  · simp [motiveSubst]
-  · simp [toK_comp_left, motiveSubst, substWk, substCons]
-    rfl
+  · simp only [Category.assoc, toI_comp_i1, motiveSubst]
+    exact (M.substWk_var _ _ _ _).symm
+  · simp only [Category.assoc, toI_comp_i2, toK_comp_left, motiveSubst]
+    -- Unfold the context definitions only for this projection rewrite.
+    rw! (transparency := .default) [substWk_disp_functor_map_assoc]
+    dsimp only [motiveCtx]
+    congr 2
 
 theorem motiveCtx_isPullback :
     IsPullback (ie.toI a) ym(M.disp _) ie.i2 (toK ii a) :=
@@ -887,13 +942,14 @@ def equivFst (pair : y(Γ) ⟶ ie.iFunctor.obj X) :
 lemma equivFst_comp_left (pair : y(Γ) ⟶ ie.iFunctor.obj X)
     {Δ} (σ : Δ ⟶ Γ) :
     ie.equivFst (ym(σ) ≫ pair) = ym(σ) ≫ ie.equivFst pair := by
-  dsimp [equivFst]
-  rw [UvPoly.Equiv.fst_comp_left]
+  exact UvPoly.Equiv.fst_comp_left ie.iUvPoly X pair ym(σ)
 
 def equivSnd (pair : y(Γ) ⟶ ie.iFunctor.obj X) :
     y(ii.motiveCtx (equivFst ie pair)) ⟶ X :=
   UvPoly.Equiv.snd' ie.iUvPoly X pair (ie.motiveCtx_isPullback' _).flip
 
+-- The polynomial functor and its object need semireducible unfolding for rewriting.
+set_option backward.isDefEq.respectTransparency false in
 lemma equivSnd_comp_left (pair : y(Γ) ⟶ ie.iFunctor.obj X)
     {Δ} (σ : Δ ⟶ Γ) :
     ie.equivSnd (ym(σ) ≫ pair) =
@@ -932,8 +988,11 @@ lemma equivFst_verticalNatTrans_app {Γ : Ctx} {X : Psh Ctx}
     ie.equivFst pair = UvPoly.Equiv.fst (UvPoly.id M.Tm) X
     (pair ≫ ie.verticalNatTrans.app X) := by
   dsimp [equivFst, verticalNatTrans]
-  rw [← UvPoly.fst_verticalNatTrans_app]
+  exact (UvPoly.fst_verticalNatTrans_app (UvPoly.id M.Tm) ie.iUvPoly
+    ie.comparison (by simp [iUvPoly]) X pair).symm
 
+-- The pullback projections require semireducible unfolding during rewriting.
+set_option backward.isDefEq.respectTransparency false in
 lemma equivSnd_verticalNatTrans_app {Γ : Ctx} {X : Psh Ctx}
     (pair : y(Γ) ⟶ ie.iFunctor.obj X) :
     UvPoly.Equiv.snd' (UvPoly.id M.Tm) X (pair ≫ ie.verticalNatTrans.app X)
@@ -959,6 +1018,8 @@ lemma equivSnd_verticalNatTrans_app {Γ : Ctx} {X : Psh Ctx}
         simp [reflSubst]
       · simp [reflSubst]
 
+-- Keep pullback projections at semireducible transparency during rewriting.
+set_option backward.isDefEq.respectTransparency false in
 lemma equivMk_comp_verticalNatTrans_app {Γ : Ctx} {X : Psh Ctx} (a : y(Γ) ⟶ M.Tm)
     (x : y(ii.motiveCtx a) ⟶ X) :
     ie.equivMk a x ≫ (ie.verticalNatTrans).app X =
@@ -1072,6 +1133,8 @@ Ty <-- y(motiveCtx) ----> i
 abbrev motive : y(Γ) ⟶ ie.iFunctor.obj N.Ty :=
   ie.equivMk a C
 
+-- The motive context and polynomial application need semireducible unfolding here.
+set_option backward.isDefEq.respectTransparency false in
 lemma motive_comp_left : ym(σ) ≫ motive ie a C =
     motive ie (ym(σ) ≫ a) (ym(motiveSubst ii σ a) ≫ C) := by
   dsimp [motive, equivMk]
@@ -1089,6 +1152,9 @@ lemma motive_comp_left : ym(σ) ≫ motive ie a C =
       slice_rhs 1 2 => rw [← ie.toI_comp_i2]
       simp
 
+-- Keep the polynomial functor applications at semireducible transparency while
+-- rewriting the coherent lift's naturality square.
+set_option backward.isDefEq.respectTransparency false in
 def lift : y(Γ) ⟶ ie.iFunctor.obj N.Tm :=
   i.weakPullback.coherentLift (reflCase a r) (motive ie a C) (by
     dsimp only [motive, equivMk, verticalNatTrans, reflCase]
@@ -1105,6 +1171,8 @@ def lift : y(Γ) ⟶ ie.iFunctor.obj N.Tm :=
         simp
       · simp)
 
+-- Allow the polynomial application and its functor object to unfold together.
+set_option backward.isDefEq.respectTransparency false in
 lemma lift_comp_left {Δ} (σ : Δ ⟶ Γ) : i.lift (ym(σ) ≫ a) (ym(ii.motiveSubst σ a) ≫ C)
     (ym(σ) ≫ r) (by simp [r_tp, comp_reflSubst'_assoc]) =
     ym(σ) ≫ i.lift a C r r_tp := by
@@ -1121,6 +1189,8 @@ lemma lift_comp_left {Δ} (σ : Δ ⟶ Γ) : i.lift (ym(σ) ≫ a) (ym(ii.motive
     · simp
   · rw [motive_comp_left]
 
+-- Keep the polynomial objects and motive context at the same transparency.
+set_option backward.isDefEq.respectTransparency false in
 lemma equivFst_lift_eq : ie.equivFst (i.lift a C r r_tp) = a :=
   calc ie.equivFst (i.lift a C r r_tp)
   _ = ie.equivFst (i.lift a C r r_tp ≫ ie.iFunctor.map N.tp) := by
@@ -1139,6 +1209,7 @@ lemma equivFst_lift_eq : ie.equivFst (i.lift a C r r_tp) = a :=
 def j : y(ii.motiveCtx a) ⟶ N.Tm :=
   eqToHom (by rw [equivFst_lift_eq]) ≫ ie.equivSnd (i.lift a C r r_tp)
 
+set_option backward.isDefEq.respectTransparency false in
 /-- Typing for elimination rule `J` -/
 lemma j_tp : j i a C r r_tp ≫ N.tp = C := by
   simp only [j, Category.assoc, IdElimBase.equivSnd, ← UvPoly.Equiv.snd'_comp_right]
@@ -1148,6 +1219,8 @@ lemma j_tp : j i a C r r_tp ≫ N.tp = C := by
   rw! [equivFst_lift_eq]
   simp
 
+-- Unfold dependent polynomial projections consistently while rewriting the lift.
+set_option backward.isDefEq.respectTransparency false in
 lemma comp_j : ym(ii.motiveSubst σ _) ≫ j i a C r r_tp =
     j i (ym(σ) ≫ a) (ym(ii.motiveSubst σ _) ≫ C) (ym(σ) ≫ r) (by
       simp [r_tp, IdIntro.comp_reflSubst'_assoc]) := by
@@ -1215,11 +1288,14 @@ variable {Γ} (ar : y(Γ) ⟶ (UvPoly.id M.Tm).functor.obj N.Tm)
 
 include hrC in
 lemma fst_eq_fst : UvPoly.Equiv.fst _ _ ar = ie.equivFst aC :=
+  -- The polynomial functor notation requires default transparency for these rewrites.
   calc _
   _ = UvPoly.Equiv.fst _ _ (ar ≫ (UvPoly.id M.Tm).functor.map N.tp) := by
-    rw [UvPoly.Equiv.fst_comp_right]
+    rw! (transparency := .default) [UvPoly.Equiv.fst_comp_right]
+    rfl
   _ = UvPoly.Equiv.fst _ _  (aC ≫ (IdElimBase.verticalNatTrans ie).app N.Ty) := by
-    rw [hrC]
+    rw! (transparency := .default) [hrC]
+    rfl
   _ = _ := by
     rw [ie.equivFst_verticalNatTrans_app]
 
@@ -1228,13 +1304,14 @@ abbrev motive : y(ii.motiveCtx (ie.equivFst aC)) ⟶ N.Ty :=
 
 lemma comp_motive {Δ} (σ : Δ ⟶ Γ) : motive (ym(σ) ≫ aC) =
     ym(ii.motiveSubst σ (ie.equivFst aC)) ≫ motive aC := by
-  simp only [motive, equivSnd_comp_left ie aC σ]
+  exact equivSnd_comp_left ie aC σ
 
 abbrev reflCase : y(Γ) ⟶ N.Tm := UvPoly.Equiv.snd' _ _ ar (Id.reflCase_aux _)
 
 lemma comp_reflCase {Δ} (σ : Δ ⟶ Γ) : reflCase (ym(σ) ≫ ar) = ym(σ) ≫ reflCase ar := by
   simp only [reflCase]
-  rw [UvPoly.Equiv.snd'_comp_left (UvPoly.id M.Tm) N.Tm ar
+  -- The polynomial functor notation requires default transparency for this rewrite.
+  rw! (transparency := .default) [UvPoly.Equiv.snd'_comp_left (UvPoly.id M.Tm) N.Tm ar
     (Id.reflCase_aux (UvPoly.Equiv.fst (UvPoly.id M.Tm) N.Tm ar)) ym(σ)
     (Id.reflCase_aux _)]
   congr 1
@@ -1243,18 +1320,21 @@ lemma comp_reflCase {Δ} (σ : Δ ⟶ Γ) : reflCase (ym(σ) ≫ ar) = ym(σ) 
     simp
   · simp
 
+-- Keep dependent pullback projections at semireducible transparency.
+set_option backward.isDefEq.respectTransparency false in
 include hrC in
 lemma reflCase_comp_tp : reflCase ar ≫ N.tp =
     ym(ii.reflSubst (ie.equivFst aC)) ≫ motive aC := by
   dsimp [reflCase, motive]
-  rw! [← UvPoly.Equiv.snd'_comp_right, hrC]
+  -- Polynomial functor notation requires default transparency for these rewrites.
+  rw! (transparency := .default) [← UvPoly.Equiv.snd'_comp_right, hrC]
   have H : IsPullback ym(M.disp (ii.mkId
       (ym(M.disp (ie.equivFst aC ≫ M.tp)) ≫ ie.equivFst aC)
       (M.var (ie.equivFst aC ≫ M.tp)) (by simp)) ≫
       M.disp (ie.equivFst aC ≫ M.tp))
     (ie.toI (ie.equivFst aC)) (UvPoly.Equiv.fst ie.iUvPoly N.Ty aC) ie.iUvPoly.p := by
-    convert (ie.motiveCtx_isPullback' (ie.equivFst aC)).flip
-    simp
+    change IsPullback _ _ (ie.equivFst aC) _
+    simpa only [Functor.map_comp] using (ie.motiveCtx_isPullback' (ie.equivFst aC)).flip
   -- FIXME: `transparency := .default` is like `erw` and should be avoided
   rw! (transparency := .default) [UvPoly.snd'_verticalNatTrans_app
     (R := y(ii.motiveCtx (ie.equivFst aC)))
@@ -1267,12 +1347,13 @@ lemma reflCase_comp_tp : reflCase ar ≫ N.tp =
   congr 1
   apply (M.disp_pullback _).hom_ext <;>
     simp only [reflSubst, substCons_var, substCons_disp_functor_map, substCons_var]
-  · simp [← ie.toI_comp_i1 (ie.equivFst aC), fst_eq_fst ar aC hrC, mkRefl]
+  · conv => lhs; rw [← toI_comp_i1 ie]
+    simp [comparison, mkRefl]
+    exact congrArg (fun f => f ≫ ii.refl) (fst_eq_fst ar aC hrC)
   · apply (M.disp_pullback _).hom_ext
-    · rw! [fst_eq_fst ar aC hrC]
-      slice_lhs 3 4 => rw [← ii.toK_comp_k1]
+    · slice_lhs 3 4 => rw [← ii.toK_comp_k1]
       slice_lhs 2 3 => rw [← ie.toI_comp_i2]
-      simp
+      simp [fst_eq_fst ar aC hrC]
     · simp
 
 def lift : y(Γ) ⟶ (IdElimBase.iFunctor ie).obj N.Tm :=
@@ -1289,7 +1370,7 @@ lemma lift_fst : lift i ar aC hrC ≫ ie.verticalNatTrans.app N.Tm = ar := by
 
 lemma lift_snd : lift i ar aC hrC ≫ ie.iFunctor.map N.tp = aC := by
   dsimp only [lift, equivMk]
-  rw [UvPoly.Equiv.mk'_comp_right]
+  rw! (transparency := .default) [UvPoly.Equiv.mk'_comp_right]
   apply UvPoly.Equiv.ext' ie.iUvPoly N.Ty
   · rw! [i.j_tp]
     rw [UvPoly.Equiv.snd'_mk']
@@ -1298,10 +1379,12 @@ lemma lift_snd : lift i ar aC hrC ≫ ie.iFunctor.map N.tp = aC := by
     exact (ie.motiveCtx_isPullback' _).flip
   · simp [equivFst]
 
+-- Dependent pullback projections require semireducible unfolding.
+set_option backward.isDefEq.respectTransparency false in
 lemma comp_lift {Δ} (σ : Δ ⟶ Γ) : ym(σ) ≫ lift i ar aC hrC =
     lift i (ym(σ) ≫ ar) (ym(σ) ≫ aC) (by simp [hrC]) := by
   dsimp [lift, equivMk]
-  rw [UvPoly.Equiv.mk'_comp_left ie.iUvPoly N.Tm (ie.equivFst aC) _
+  rw! (transparency := .default) [UvPoly.Equiv.mk'_comp_left ie.iUvPoly N.Tm (ie.equivFst aC) _
     (i.j (ie.equivFst aC) (motive aC) (reflCase ar) _) ym(σ) _ rfl
     (by simp only [iUvPoly_p]; exact (ie.motiveCtx_isPullback' _).flip)]
   congr 1
@@ -1310,7 +1393,7 @@ lemma comp_lift {Δ} (σ : Δ ⟶ Γ) : ym(σ) ≫ lift i ar aC hrC =
   rw [← h]
   congr 1
   simp only [iUvPoly_p, Category.assoc]
-  apply (M.disp_pullback _).hom_ext
+  apply (M.disp_pullback _).hom_ext <;> try simp only [IsPullback.lift_fst, IsPullback.lift_snd]
   · simp [toI_comp_left, ← toI_comp_i1 ie]
   · apply (M.disp_pullback _).hom_ext
     · slice_rhs 3 4 => rw [← toK_comp_k1 ii]
diff --git a/HoTTLean/Model/Natural/UHom.lean b/HoTTLean/Model/Natural/UHom.lean
index 82277fa4..b6873e83 100644
--- a/HoTTLean/Model/Natural/UHom.lean
+++ b/HoTTLean/Model/Natural/UHom.lean
@@ -34,7 +34,7 @@ def Hom.comp {M N O : Universe Ctx} (α : Hom M N) (β : Hom N O) : Hom M O wher
   mapTy := α.mapTy ≫ β.mapTy
   pb := α.pb.paste_horiz β.pb
 
-def Hom.comp_assoc {M N O P : Universe Ctx} (α : Hom M N) (β : Hom N O) (γ : Hom O P) :
+theorem Hom.comp_assoc {M N O P : Universe Ctx} (α : Hom M N) (β : Hom N O) (γ : Hom O P) :
     comp (comp α β) γ = comp α (comp β γ) := by
   simp [comp]
 
@@ -46,6 +46,8 @@ protected def pullbackHom (M : Universe Ctx) {Γ : Ctx} (A : y(Γ) ⟶ M.Ty) :
   mapTy := A
   pb := M.disp_pullback A
 
+-- The pullback projections need semireducible unfolding during elaboration.
+set_option backward.isDefEq.respectTransparency false in
 /-- Given `M : Universe`, a semantic type `A : y(Γ) ⟶ M.Ty`,
 and a substitution `σ : Δ ⟶ Γ`, construct a Hom for the substitution `A[σ]`.
 -/
@@ -54,11 +56,13 @@ def Hom.subst (M : Universe Ctx)
     Hom (M.pullback (ym(σ) ≫ A)) (M.pullback A) :=
   let Aσ := ym(σ) ≫ A
   { mapTm :=
-    (M.disp_pullback A).lift (M.var Aσ) ym(M.disp Aσ ≫ σ) (by aesop_cat)
+    (M.disp_pullback A).lift (M.var Aσ) ym(M.disp Aσ ≫ σ) (by
+      rw [(M.disp_pullback Aσ).w]
+      simp [Aσ, Category.assoc])
     mapTy := ym(σ)
     pb := by
-      convert IsPullback.of_right' (M.disp_pullback Aσ) (M.disp_pullback A)
-      simp }
+      simpa [Universe.pullback, Aσ] using
+        IsPullback.of_right' (M.disp_pullback Aσ) (M.disp_pullback A) }
 
 def Hom.cartesianNatTrans {M N : Universe Ctx} (h : Hom M N) :
     M.Ptp ⟶ N.Ptp :=
@@ -80,7 +84,7 @@ theorem Hom.mk_comp_cartesianNatTrans {M N : Universe Ctx} (h : Hom M N)
   refine this.trans ?_
   simp [UvPoly.Equiv.mk']; congr 1
   rw [← Category.assoc]; congr 1
-  generalize_proofs _ h1
+  generalize_proofs _ _ _ _ _ _ h1
   apply h1.hom_ext <;> simp
 
 /- We have a 'nice', specific terminal object in `Ctx`,
@@ -121,7 +125,7 @@ def UHom.comp {M N O : Universe Ctx} (α : UHom M N) (β : UHom N O) : UHom M O
   asTm := α.asTm ≫ β.mapTm
   U_pb := α.U_pb.paste_horiz β.pb
 
-def UHom.comp_assoc {M N O P : Universe Ctx} (α : UHom M N) (β : UHom N O) (γ : UHom O P) :
+theorem UHom.comp_assoc {M N O P : Universe Ctx} (α : UHom M N) (β : UHom N O) (γ : UHom O P) :
     comp (comp α β) γ = comp α (comp β γ) := by
   simp [comp, Hom.comp]
 
@@ -145,7 +149,10 @@ def UHom.ofTarskiU (M : Universe Ctx) (U : y(𝟭_ Ctx) ⟶ M.Ty) (El : y(M.ext
       (Iso.refl _)
       (Iso.refl _)
       (Iso.refl _)
-      (by simp) (isTerminal_yUnit.hom_ext ..)
+      (by
+        change M.var U ≫ 𝟙 M.Tm = 𝟙 y(M.ext U) ≫ M.var U
+        simp only [Category.comp_id, Category.id_comp])
+      (isTerminal_yUnit.hom_ext ..)
       (by simp) (by simp)
 
 /-! ## Universe embeddings -/
@@ -248,6 +255,7 @@ theorem mk_comp_cartesianNatTrans {i j ij jlen} {Γ X} (A : y(Γ) ⟶ s[i].Ty)
     PtpEquiv.mk s[i] A B ≫ (s.cartesianNatTrans i j).app X =
     PtpEquiv.mk s[j] (A ≫ (s.homOfLe i j).mapTy)
     (ym(substCons _ (s[j].disp _) _ (s.unliftVar i j ij jlen A rfl) (by simp)) ≫ B) := by
+  unfold cartesianNatTrans
   convert Hom.mk_comp_cartesianNatTrans _ _ _
   apply (IsPullback.paste_horiz (s[i].disp_pullback _) (s.homOfLe i j).pb).hom_ext
   · simp [unliftVar]
@@ -274,14 +282,14 @@ Given `i0 ≤ i1` and `j0 ≤ j1`
 -/
 def cartesianNatTransTm (i0 i1 j0 j1 : Nat)
     (ii : i0 ≤ i1 := by get_elem_tactic) (ilen : i1 < s.length + 1 := by get_elem_tactic)
-    (jj : j0 ≤ j1 := by get_elem_tactic) (jlen : j1 < s.length + 1 := by get_elem_tactic)
-    : s[i0].Ptp.obj s[j0].Tm ⟶ s[i1].Ptp.obj s[j1].Tm :=
+    (jj : j0 ≤ j1 := by get_elem_tactic) (jlen : j1 < s.length + 1 := by get_elem_tactic) :
+    s[i0].Ptp.obj s[j0].Tm ⟶ s[i1].Ptp.obj s[j1].Tm :=
   (s.cartesianNatTrans i0 i1).app s[j0].Tm ≫
   s[i1].Ptp.map (s.homOfLe j0 j1).mapTm
 
 theorem mk_comp_cartesianNatTransTm {i0 i1 j0 j1 ii ilen jj jlen}
-    {Γ X} (A : y(Γ) ⟶ s[i0].Ty) (B : y(s[i0].ext A) ⟶ s[j0].Tm)
-    : PtpEquiv.mk s[i0] A B ≫ s.cartesianNatTransTm i0 i1 j0 j1 ii ilen jj jlen =
+    {Γ X} (A : y(Γ) ⟶ s[i0].Ty) (B : y(s[i0].ext A) ⟶ s[j0].Tm) :
+    PtpEquiv.mk s[i0] A B ≫ s.cartesianNatTransTm i0 i1 j0 j1 ii ilen jj jlen =
       PtpEquiv.mk s[i1] (A ≫ (s.homOfLe i0 i1).mapTy)
         (ym(substCons _ (s[i1].disp _) _ (s.unliftVar i0 i1 ii ilen A rfl) (by simp))
           ≫ B ≫ (s.homOfLe j0 j1).mapTm) := by
@@ -290,20 +298,23 @@ theorem mk_comp_cartesianNatTransTm {i0 i1 j0 j1 ii ilen jj jlen}
 theorem cartesianNatTransTm_fstProj {i0 i1 j0 j1 ii ilen jj jlen} :
     s.cartesianNatTransTm i0 i1 j0 j1 ii ilen jj jlen ≫ s[i1].uvPolyTp.fstProj s[j1].Tm =
     s[i0].uvPolyTp.fstProj s[j0].Tm ≫ (s.homOfLe i0 i1).mapTy := by
-  simp [cartesianNatTransTm]
-  slice_lhs 2 3 => apply UvPoly.map_fstProj
-  apply cartesianNatTrans_fstProj
+  let α := (s.cartesianNatTrans i0 i1 ii ilen).app s[j0].Tm
+  let f := (s.homOfLe j0 j1 jj jlen).mapTm
+  exact (Category.assoc α (s[i1].Ptp.map f) (s[i1].uvPolyTp.fstProj s[j1].Tm)).trans
+    ((congrArg (fun k => α ≫ k) (UvPoly.map_fstProj s[i1].uvPolyTp f)).trans
+      (s.cartesianNatTrans_fstProj (i := i0) (j := i1) (ij := ii) (jlen := ilen)
+        (X := s[j0].Tm)))
 
 def cartesianNatTransTy (i0 i1 j0 j1 : Nat)
     (i0len : i0 ≤ i1 := by get_elem_tactic) (i1len : i1 < s.length + 1 := by get_elem_tactic)
-    (j0len : j0 ≤ j1 := by get_elem_tactic) (j1len : j1 < s.length + 1 := by get_elem_tactic)
-    : s[i0].Ptp.obj s[j0].Ty ⟶ s[i1].Ptp.obj s[j1].Ty :=
+    (j0len : j0 ≤ j1 := by get_elem_tactic) (j1len : j1 < s.length + 1 := by get_elem_tactic) :
+    s[i0].Ptp.obj s[j0].Ty ⟶ s[i1].Ptp.obj s[j1].Ty :=
   (s.cartesianNatTrans i0 i1).app s[j0].Ty ≫
   s[i1].Ptp.map (s.homOfLe j0 j1).mapTy
 
 theorem mk_comp_cartesianNatTransTy {i0 i1 j0 j1 ii ilen jj jlen}
-    {Γ X} (A : y(Γ) ⟶ s[i0].Ty) (B : y(s[i0].ext A) ⟶ s[j0].Ty)
-    : PtpEquiv.mk s[i0] A B ≫ s.cartesianNatTransTy i0 i1 j0 j1 ii ilen jj jlen =
+    {Γ X} (A : y(Γ) ⟶ s[i0].Ty) (B : y(s[i0].ext A) ⟶ s[j0].Ty) :
+    PtpEquiv.mk s[i0] A B ≫ s.cartesianNatTransTy i0 i1 j0 j1 ii ilen jj jlen =
       PtpEquiv.mk s[i1] (A ≫ (s.homOfLe i0 i1).mapTy)
         (ym(substCons _ (s[i1].disp _) _ (s.unliftVar i0 i1 ii ilen A rfl) (by simp))
           ≫ B ≫ (s.homOfLe j0 j1).mapTy) := by
@@ -312,9 +323,12 @@ theorem mk_comp_cartesianNatTransTy {i0 i1 j0 j1 ii ilen jj jlen}
 theorem cartesianNatTransTy_fstProj {i0 i1 j0 j1 ii ilen jj jlen} :
     s.cartesianNatTransTy i0 i1 j0 j1 ii ilen jj jlen ≫ s[i1].uvPolyTp.fstProj s[j1].Ty =
     s[i0].uvPolyTp.fstProj s[j0].Ty ≫ (s.homOfLe i0 i1).mapTy := by
-  simp only [cartesianNatTransTy]
-  slice_lhs 2 3 => apply UvPoly.map_fstProj
-  apply cartesianNatTrans_fstProj
+  let α := (s.cartesianNatTrans i0 i1 ii ilen).app s[j0].Ty
+  let f := (s.homOfLe j0 j1 jj jlen).mapTy
+  exact (Category.assoc α (s[i1].Ptp.map f) (s[i1].uvPolyTp.fstProj s[j1].Ty)).trans
+    ((congrArg (fun k => α ≫ k) (UvPoly.map_fstProj s[i1].uvPolyTp f)).trans
+      (s.cartesianNatTrans_fstProj (i := i0) (j := i1) (ij := ii) (jlen := ilen)
+        (X := s[j0].Ty)))
 
 theorem hom_comp_trans (s : UHomSeq Ctx) (i j k : Nat) (ij : i < j) (jk : j < k)
     (klen : k < s.length + 1) :
@@ -433,7 +447,7 @@ def Pi : s[i].Ptp.obj s[j].Ty ⟶ s[max i j].Ty :=
 def lam : s[i].Ptp.obj s[j].Tm ⟶ s[max i j].Tm :=
   s.cartesianNatTransTm i (max i j) j (max i j) ≫ (nmPi (max i j)).lam
 
-def Pi_pb :
+theorem Pi_pb :
     IsPullback (s.lam ilen jlen) (s[i].Ptp.map s[j].tp) s[max i j].tp (s.Pi ilen jlen) := by
   have p1 : NatTrans.IsCartesian (s.cartesianNatTrans i (max i j)) := by
    dsimp only [UHomSeq.cartesianNatTrans]
@@ -507,8 +521,11 @@ theorem unLam_tp {Γ : Ctx} (A : y(Γ) ⟶ s[i].Ty) (B : y(s[i].ext A) ⟶ s[j].
     (f : y(Γ) ⟶ s[max i j].Tm) (f_tp : f ≫ s[max i j].tp = s.mkPi ilen jlen A B) :
     s.unLam ilen jlen A B f f_tp ≫ s[j].tp = B := by
   rw [unLam, ← PtpEquiv.snd_comp_right]
-  convert PtpEquiv.snd_mk s[i] A B using 2; simp
+  convert PtpEquiv.snd_mk s[i] A B using 2
+  exact (s.Pi_pb ilen jlen).lift_snd ..
 
+-- The pullback projections unfold the semireducible mkPi in their proof arguments.
+set_option backward.isDefEq.respectTransparency false in
 theorem comp_unLam {Δ Γ : Ctx} (σ : Δ ⟶ Γ)
     (A : y(Γ) ⟶ s[i].Ty) (σA) (eq : ym(σ) ≫ A = σA) (B : y(s[i].ext A) ⟶ s[j].Ty)
     (f : y(Γ) ⟶ s[max i j].Tm) (f_tp : f ≫ s[max i j].tp = s.mkPi ilen jlen A B) :
@@ -555,14 +572,19 @@ theorem comp_mkApp {Δ Γ : Ctx} (σ : Δ ⟶ Γ)
 theorem mkLam_unLam {Γ : Ctx} (A : y(Γ) ⟶ s[i].Ty) (B : y(s[i].ext A) ⟶ s[j].Ty)
     (f : y(Γ) ⟶ s[max i j].Tm) (f_tp : f ≫ s[max i j].tp = s.mkPi ilen jlen A B) :
     s.mkLam ilen jlen A (s.unLam ilen jlen A B f f_tp) = f := by
+  change f ≫ s[max i j].tp = PtpEquiv.mk s[i] A B ≫ s.Pi ilen jlen at f_tp
   let total : y(Γ) ⟶ s[i].Ptp.obj s[j].Tm :=
     (s.Pi_pb ilen jlen).lift f (PtpEquiv.mk s[i] A B) f_tp
   simp [mkLam, unLam]
   have : PtpEquiv.fst s[i] total = A := by
-    simp [total, PtpEquiv.fst, UvPoly.Equiv.fst]
+    change total ≫ s[i].uvPolyTp.fstProj s[j].Tm = A
     rw [← s[i].uvPolyTp.map_fstProj s[j].tp]
-    slice_lhs 1 2 => apply (s.Pi_pb ilen jlen).lift_snd
-    apply PtpEquiv.fst_mk
+    change (s.Pi_pb ilen jlen).lift f (PtpEquiv.mk s[i] A B) f_tp ≫
+      s[i].Ptp.map s[j].tp ≫ s[i].uvPolyTp.fstProj s[j].Ty = A
+    -- `Ptp` and the polynomial functor are definitionally equal but semireducible.
+    set_option backward.isDefEq.respectTransparency false in
+      rw [(s.Pi_pb ilen jlen).lift_snd_assoc]
+    exact PtpEquiv.fst_mk s[i] A B
   slice_lhs 1 1 => equals total =>
     apply PtpEquiv.ext _ (A := A) (by simp) (by simp [this]) (by simp [total])
   apply (s.Pi_pb ilen jlen).lift_fst
@@ -574,8 +596,14 @@ theorem unLam_mkLam {Γ : Ctx} (A : y(Γ) ⟶ s[i].Ty) (B : y(s[i].ext A) ⟶ s[
     s.unLam ilen jlen A B (s.mkLam ilen jlen A t) lam_tp = t := by
   simp [mkLam, unLam]
   convert PtpEquiv.snd_mk s[i] A t using 2
-  apply (s.Pi_pb ilen jlen).hom_ext <;> simp
-  rw [PtpEquiv.mk_comp_right, t_tp]
+  congr 1
+  apply (s.Pi_pb ilen jlen).hom_ext
+  · exact (s.Pi_pb ilen jlen).lift_fst ..
+  -- The projection unfolds the semireducible mkPi in its proof argument.
+  · set_option backward.isDefEq.respectTransparency false in
+      rw [(s.Pi_pb ilen jlen).lift_snd]
+    rw [PtpEquiv.mk_comp_right, t_tp]
+  · apply proof_irrel_heq
 
 /--
 ```
@@ -645,7 +673,7 @@ def pair : UvPoly.compDom s[i].uvPolyTp s[j].uvPolyTp ⟶ s[max i j].Tm :=
       (s.homOfLe j (max i j)).pb.flip
   l ≫ (nmSig (max i j)).pair
 
-def Sig_pb : IsPullback
+theorem Sig_pb : IsPullback
     (s.pair ilen jlen)
   (s[i].uvPolyTp.compP s[j].uvPolyTp) s[max i j].tp
     (s.Sig ilen jlen) :=
@@ -689,6 +717,8 @@ theorem comp_mkPair {Δ Γ : Ctx} (σ : Δ ⟶ Γ)
         (ym(σ) ≫ u) (by simp [u_tp, comp_sec_functor_map_assoc]) := by
   simp only [← Category.assoc, mkPair]; rw [compDomEquiv.comp_mk]
 
+-- The nested pullback presentation needs reducible instance matching.
+set_option backward.isDefEq.respectTransparency false in
 @[simp]
 theorem mkPair_tp {Γ : Ctx} (A : y(Γ) ⟶ s[i].Ty) (B : y(s[i].ext A) ⟶ s[j].Ty)
     (t : y(Γ) ⟶ s[i].Tm) (t_tp : t ≫ s[i].tp = A)
@@ -701,12 +731,16 @@ def mkFst {Γ : Ctx} (A : y(Γ) ⟶ s[i].Ty) (B : y(s[i].ext A) ⟶ s[j].Ty)
     y(Γ) ⟶ s[i].Tm :=
   compDomEquiv.fst ((s.Sig_pb ilen jlen).lift p (PtpEquiv.mk _ A B) p_tp)
 
+-- The pullback projections require reducible instance matching.
+set_option backward.isDefEq.respectTransparency false in
 @[simp]
 theorem mkFst_tp {Γ : Ctx} (A : y(Γ) ⟶ s[i].Ty) (B : y(s[i].ext A) ⟶ s[j].Ty)
     (p : y(Γ) ⟶ s[max i j].Tm) (p_tp : p ≫ s[max i j].tp = s.mkSig ilen jlen A B) :
     s.mkFst ilen jlen A B p p_tp ≫ s[i].tp = A := by
   simp [mkFst, UvPoly.compP, compDomEquiv.fst_tp]
 
+-- The pullback projections require reducible instance matching.
+set_option backward.isDefEq.respectTransparency false in
 @[simp]
 theorem mkFst_mkPair {Γ : Ctx} (A : y(Γ) ⟶ s[i].Ty) (B : y(s[i].ext A) ⟶ s[j].Ty)
     (t : y(Γ) ⟶ s[i].Tm) (t_tp : t ≫ s[i].tp = A)
@@ -716,6 +750,8 @@ theorem mkFst_mkPair {Γ : Ctx} (A : y(Γ) ⟶ s[i].Ty) (B : y(s[i].ext A) ⟶ s
   convert compDomEquiv.fst_mk t t_tp B u u_tp using 2
   apply (s.Sig_pb ilen jlen).hom_ext <;> [simp; simp [compDomEquiv.mk, UvPoly.compP]]
 
+-- The pullback projections require reducible instance matching.
+set_option backward.isDefEq.respectTransparency false in
 theorem comp_mkFst {Δ Γ : Ctx} (σ : Δ ⟶ Γ)
     (A : y(Γ) ⟶ s[i].Ty) (B : y(s[i].ext A) ⟶ s[j].Ty)
     (p : y(Γ) ⟶ s[max i j].Tm) (p_tp : p ≫ s[max i j].tp = s.mkSig ilen jlen A B) :
@@ -732,6 +768,8 @@ def mkSnd {Γ : Ctx} (A : y(Γ) ⟶ s[i].Ty) (B : y(s[i].ext A) ⟶ s[j].Ty)
     y(Γ) ⟶ s[j].Tm :=
   compDomEquiv.snd ((s.Sig_pb ilen jlen).lift p (PtpEquiv.mk _ A B) p_tp)
 
+-- The pullback projections require reducible instance matching.
+set_option backward.isDefEq.respectTransparency false in
 @[simp]
 theorem mkSnd_mkPair {Γ : Ctx} (A : y(Γ) ⟶ s[i].Ty) (B : y(s[i].ext A) ⟶ s[j].Ty)
     (t : y(Γ) ⟶ s[i].Tm) (t_tp : t ≫ s[i].tp = A)
@@ -741,6 +779,8 @@ theorem mkSnd_mkPair {Γ : Ctx} (A : y(Γ) ⟶ s[i].Ty) (B : y(s[i].ext A) ⟶ s
   convert compDomEquiv.snd_mk t t_tp B u u_tp using 2
   apply (s.Sig_pb ilen jlen).hom_ext <;> [simp; simp [compDomEquiv.mk, UvPoly.compP]]
 
+-- The pullback projection requires reducible instance matching.
+set_option backward.isDefEq.respectTransparency false in
 protected theorem dependent_eq {Γ : Ctx} (A : y(Γ) ⟶ s[i].Ty) (B : y(s[i].ext A) ⟶ s[j].Ty)
     (p : y(Γ) ⟶ s[max i j].Tm) (p_tp : p ≫ s[max i j].tp = s.mkSig ilen jlen A B) :
     compDomEquiv.dependent ((s.Sig_pb ilen jlen).lift p (PtpEquiv.mk s[i] A B) p_tp) A
@@ -757,6 +797,8 @@ theorem mkSnd_tp {Γ : Ctx} (A : y(Γ) ⟶ s[i].Ty) (B : y(s[i].ext A) ⟶ s[j].
   generalize_proofs h
   simp [mkSnd, compDomEquiv.snd_tp (eq := h), s.dependent_eq]; rfl
 
+-- The pullback projections require reducible instance matching.
+set_option backward.isDefEq.respectTransparency false in
 theorem comp_mkSnd {Δ Γ : Ctx} (σ : Δ ⟶ Γ)
     (A : y(Γ) ⟶ s[i].Ty) (B : y(s[i].ext A) ⟶ s[j].Ty)
     (p : y(Γ) ⟶ s[max i j].Tm) (p_tp : p ≫ s[max i j].tp = s.mkSig ilen jlen A B) :
@@ -777,7 +819,8 @@ theorem mkPair_mkFst_mkSnd {Γ : Ctx} (A : y(Γ) ⟶ s[i].Ty) (B : y(s[i].ext A)
   have := compDomEquiv.eta ((s.Sig_pb ilen jlen).lift p (PtpEquiv.mk _ A B) p_tp)
     (eq := by rw [← mkFst.eq_def, mkFst_tp])
   conv at this => enter [1, 3]; apply s.dependent_eq
-  simp [this]
+  rw [this]
+  exact (s.Sig_pb ilen jlen).lift_fst p (PtpEquiv.mk _ A B) p_tp
 
 end Sigma
 
@@ -836,6 +879,8 @@ theorem mkRefl_tp {Γ : Ctx} (A : y(Γ) ⟶ s[i].Ty)
     s.mkRefl ilen t ≫ s[i].tp = s.mkId ilen A t t t_tp t_tp :=
   (nmII i).mkRefl_tp t
 
+-- Let elaboration unfold substWk in the dependent equality proofs.
+set_option backward.isDefEq.respectTransparency false in
 /--
 ```
 Γ ⊢ᵢ t : A
@@ -858,10 +903,12 @@ def mkIdRec {Γ : Ctx} (A : y(Γ) ⟶ s[i].Ty)
     (ym(substWk _ (substWk _ (𝟙 _) _ _ (by simp [t_tp])) _ _ ?_) ≫ M)
     r ?_ u (t_tp ▸ u_tp) h ?_
   · simp [← B_eq, comp_mkId, ← mkId.eq_def]; congr 1 <;> simp [t_tp, substWk]
-  · simp [r_tp]; rw [← Functor.map_comp_assoc]; congr 1
+  · rw [r_tp, ← Functor.map_comp_assoc]; congr 1
     apply (s[i].disp_pullback _).hom_ext <;> simp [IdIntro.reflSubst, mkRefl, substWk, sec]
   · simp [h_tp, mkId, IdIntro.mkId]
 
+-- Unfold motiveCtx when checking dependent substitution equations.
+set_option backward.isDefEq.respectTransparency false in
 theorem comp_mkIdRec {Δ Γ : Ctx} (σ : Δ ⟶ Γ)
     (A : y(Γ) ⟶ s[i].Ty) (σA) (σA_eq : ym(σ) ≫ A = σA)
     (t t_tp B B_eq σB) (σB_eq : ym(s[i].substWk σ _ _ σA_eq) ≫ B = σB)
@@ -907,6 +954,8 @@ theorem comp_mkIdRec {Δ Γ : Ctx} (σ : Δ ⟶ Γ)
     · simp [substWk_disp_functor_map_assoc]
     · simp [substWk_disp_functor_map, substWk_disp_functor_map_assoc]
 
+-- Unfold motiveCtx when checking dependent substitution equations.
+set_option backward.isDefEq.respectTransparency false in
 @[simp]
 theorem mkIdRec_tp {Γ : Ctx} (A : y(Γ) ⟶ s[i].Ty)
     (t t_tp B B_eq M) (r : y(Γ) ⟶ s[j].Tm) (r_tp u u_tp h h_tp) :
diff --git a/HoTTLean/Model/Unstructured/Hurewicz.lean b/HoTTLean/Model/Unstructured/Hurewicz.lean
index e3d2f1fb..0ada17fa 100644
--- a/HoTTLean/Model/Unstructured/Hurewicz.lean
+++ b/HoTTLean/Model/Unstructured/Hurewicz.lean
@@ -76,7 +76,8 @@ lemma δ0_app_I_obj_comp_symm_app (X) : cyl.δ0.app (cyl.I.obj X) ≫ cyl.symm.a
   NatTrans.congr_app (cyl.whiskerLeft_I_δ0_symm) X
 
 @[reassoc (attr := simp)]
-lemma δ1_app_I_obj_comp_symm_app (X) : cyl.δ1.app (cyl.I.obj X) ≫ cyl.symm.app X = cyl.I.map (cyl.δ1.app X) :=
+lemma δ1_app_I_obj_comp_symm_app (X) :
+    cyl.δ1.app (cyl.I.obj X) ≫ cyl.symm.app X = cyl.I.map (cyl.δ1.app X) :=
   NatTrans.congr_app (cyl.whiskerLeft_I_δ1_symm) X
 
 @[reassoc (attr := simp)]
@@ -138,9 +139,9 @@ def ofCartesianMonoidalCategoryLeft [CartesianMonoidalCategory Ctx] (Interval :
 ```
     y
 Γ -----> Y
-|        |
-|δ0      |f
-|        |
+  |        |
+  |δ0      |f
+  |        |
 V        V
 I;Γ ---> X
 ```
@@ -182,9 +183,9 @@ This means that the lift of the following square is just `π ≫ y`
 ```
     y
 Γ --------------> Y
-|             ↗  |
-|δ0         y⧸    |
-|           ⧸     |
+  |             ↗  |
+  |δ0         y⧸    |
+  |           ⧸     |
 V          ⧸      V
 I;Γ ---> Γ -----> X
      π       x
@@ -227,9 +228,9 @@ and "cubical paths" `(i:I);Γ ⊢ p i : A` such that `p 0 = a` and `p 1 = b`
 ```
      p
 I;Γ -----> Tm
-|          |
-|          |tp
-|          |
+  |          |
+  |          |tp
+  |          |
 V          V
 Γ ------> Ty
      A
@@ -325,6 +326,7 @@ lemma unpath_ext {Γ} (A : Γ ⟶ U0.Ty) (a0 a1 : Γ ⟶ U0.Tm) (p1 p2 : cyl.I.o
   rw [← P0.unpath_path (A := A) a0 a1 p1 p1_tp δ0_p1 δ1_p1]
   rw [← P0.unpath_path a0 a1 p2 p2_tp δ0_p2 δ1_p2]
   rw! [h]
+  rfl
 
 lemma unpath_comp {Γ Δ} (σ : Δ ⟶ Γ) {A : Γ ⟶ U0.Ty} (a0 a1 : Γ ⟶ U0.Tm) (a0_tp : a0 ≫ U0.tp = A)
     (a1_tp : a1 ≫ U0.tp = A) (p : Γ ⟶ U0.Tm) (p_tp : p ≫ U0.tp = P0.Path a0 a1 a0_tp a1_tp) :
@@ -363,7 +365,8 @@ open PolymorphicIdIntro
 
 section connection
 
-variable (hrwcz0 : Hurewicz cyl U0.tp) {Γ Δ : Ctx} (σ : Δ ⟶ Γ) {A : Γ ⟶ U0.Ty} (a : Γ ⟶ U0.Tm) (a_tp : a ≫ U0.tp = A)
+variable (hrwcz0 : Hurewicz cyl U0.tp) {Γ Δ : Ctx} (σ : Δ ⟶ Γ)
+    {A : Γ ⟶ U0.Ty} (a : Γ ⟶ U0.Tm) (a_tp : a ≫ U0.tp = A)
 
 /-- Fixing `Γ ⊢ a : A`, `ev` / `substConsEv` can be viewed as the cubical substitution
 `(i : I);(x : A).(p : Id(a,x)) ⊢ p' i : A`,
@@ -401,7 +404,7 @@ abbrev ev : cyl.I.obj (U0.ext (P0.polymorphicIdIntro.weakenId a a_tp)) ⟶ U0.Tm
 
 /-
                     ev
-       ⌐----------------------------¬
+       +----------------------------¬
        |      substCons             V
 I;Γ.(x:A).Id(a,x) ····> Γ.A -------> Tm
     |                   |             |
@@ -429,7 +432,8 @@ lemma substConsEv_var : P0.substConsEv a a_tp ≫ var .. = P0.unpath (A := disp
   simp [substConsEv]
 
 @[reassoc (attr := simp)]
-lemma δ0_substConsEv : cyl.δ0.app _ ≫ P0.substConsEv a a_tp = disp .. ≫ disp .. ≫ U0.sec A a a_tp := by
+lemma δ0_substConsEv : cyl.δ0.app _ ≫ P0.substConsEv a a_tp =
+    disp .. ≫ disp .. ≫ U0.sec A a a_tp := by
   apply (disp_pullback ..).hom_ext
   · simp [substConsEv]
   · simp [substConsEv]
@@ -530,7 +534,6 @@ lemma I_δ0_connection : cyl.I.map (cyl.δ0.app _) ≫ P0.connection hrwcz0 a a_
     cyl.π.app _ ≫ disp .. ≫ U0.disp A ≫ a := by
   fapply P0.unpath_ext (disp .. ≫ U0.disp A ≫ A) (disp .. ≫ U0.disp A ≫ a) (disp .. ≫ U0.disp A ≫ a)
     <;> simp [a_tp, connection, ← unpath_comp]
-  erw [δ0_connectionLift] -- FIXME
   simp [← path_comp]
 
 lemma connection_comp [hrwcz0.IsUniform] :
@@ -582,10 +585,9 @@ lemma symmConnection_tp : P0.symmConnection hrwcz0 a a_tp ≫ U0.tp =
 @[simp]
 lemma δ0_symmConnection : cyl.δ0.app _ ≫ P0.symmConnection hrwcz0 a a_tp =
     cyl.π.app _ ≫ disp .. ≫ U0.disp A ≫ a := by
-  simp only [motiveCtx, polymorphicIdIntro_Id, Functor.id_obj, symmConnection, Functor.comp_obj,
+  simp only [motiveCtx, Functor.id_obj, symmConnection, Functor.comp_obj,
     δ0_app_I_obj_comp_symm_app_assoc]
   erw [I_δ0_connection] -- FIXME
-  simp
 
 @[simp]
 lemma I_δ0_symmConnection : cyl.I.map (cyl.δ0.app _) ≫ P0.symmConnection hrwcz0 a a_tp =
@@ -597,7 +599,7 @@ lemma I_δ0_symmConnection : cyl.I.map (cyl.δ0.app _) ≫ P0.symmConnection hrw
 @[simp]
 lemma I_δ1_symmConnection : cyl.I.map (cyl.δ1.app _) ≫ P0.symmConnection hrwcz0 a a_tp =
     P0.ev a a_tp := by
-  simp only [motiveCtx, polymorphicIdIntro_Id, Functor.id_obj, symmConnection, Functor.comp_obj,
+  simp only [motiveCtx, Functor.id_obj, symmConnection, Functor.comp_obj,
     I_map_δ1_app_comp_symm_app_assoc]
   erw [δ1_connection] -- FIXME
 
@@ -628,13 +630,11 @@ lemma pathSymmConnection_tp : P0.pathSymmConnection hrwcz0 a a_tp ≫ U0.tp =
     (cyl.π.app _ ≫ disp .. ≫ disp .. ≫ a) (cyl.δ1.app _ ≫ P0.symmConnection hrwcz0 a a_tp)
     (by simp [a_tp]) (by simp) := by
   simp [pathSymmConnection]
-  rw! (transparency := .default) [δ0_symmConnection]
-  congr 1
 
 @[simp]
 lemma δ0_pathSymmConnection : cyl.δ0.app _ ≫ P0.pathSymmConnection hrwcz0 a a_tp =
     disp .. ≫ disp .. ≫ P0.polymorphicIdIntro.refl a a_tp := by
-  simp only [polymorphicIdIntro_Id, Functor.id_obj, pathSymmConnection, motiveCtx, ← path_comp,
+  simp only [Functor.id_obj, pathSymmConnection, motiveCtx, ← path_comp,
     δ0_π'_app_assoc, polymorphicIdIntro_refl, NatTrans.naturality_assoc, Functor.id_map]
   rw! (transparency := .default) [I_δ0_symmConnection]
   simp
@@ -642,7 +642,7 @@ lemma δ0_pathSymmConnection : cyl.δ0.app _ ≫ P0.pathSymmConnection hrwcz0 a
 @[simp]
 lemma δ1_pathSymmConnection : cyl.δ1.app _ ≫ P0.pathSymmConnection hrwcz0 a a_tp =
     U0.var _ := by
-  simp only [polymorphicIdIntro_Id, Functor.id_obj, pathSymmConnection, motiveCtx, ← path_comp,
+  simp only [Functor.id_obj, pathSymmConnection, motiveCtx, ← path_comp,
     δ1_π'_app_assoc]
   rw! (transparency := .default) [I_δ1_symmConnection]
   simp
@@ -688,13 +688,13 @@ lemma substConnection_var : P0.substConnection hrwcz0 a a_tp ≫ var .. =
 @[reassoc (attr := simp)]
 lemma δ0_substConnection : cyl.δ0.app _ ≫ P0.substConnection hrwcz0 a a_tp =
     disp .. ≫ disp .. ≫ reflInst _ a a_tp := by
-  simp only [polymorphicIdIntro_Id, Functor.id_obj, motiveCtx, substConnection, comp_substCons,
+  simp only [Functor.id_obj, motiveCtx, substConnection, comp_substCons,
     δ0_π'_app_assoc, ← cyl.δ1_naturality_assoc, polymorphicIdIntro_refl]
   rw! (transparency := .default) [δ0_pathSymmConnection]
   apply (disp_pullback ..).hom_ext
   · simp
   · apply (disp_pullback ..).hom_ext
-    · simp only [substCons_disp, substCons_var, Category.assoc, sec_var]
+    · simp only [substCons_disp, substCons_var]
       rw! (transparency := .default) [I_δ0_symmConnection]
       simp
     · simp
@@ -704,10 +704,8 @@ lemma δ1_substConnection : cyl.δ1.app _ ≫ P0.substConnection hrwcz0 a a_tp =
   simp [substConnection]
   apply (disp_pullback ..).hom_ext
   · simp only [substCons_var, Category.id_comp]
-    rw! (transparency := .default) [δ1_pathSymmConnection]
-    simp
   · apply (disp_pullback ..).hom_ext
-    · simp only [symmConnection, motiveCtx, polymorphicIdIntro_Id, Functor.comp_obj,
+    · simp only [symmConnection, motiveCtx, Functor.comp_obj,
         δ1_app_I_obj_comp_symm_app_assoc, cyl.δ1_naturality_assoc]
       rw! (transparency := .default) [δ1_connection]
       simp
@@ -717,7 +715,7 @@ lemma δ1_substConnection : cyl.δ1.app _ ≫ P0.substConnection hrwcz0 a a_tp =
 lemma substConnection_comp_motiveSubst [hrwcz0.IsUniform] :
     P0.substConnection hrwcz0 (σ ≫ a) (by simp [a_tp]) ≫ motiveSubst _ σ a a_tp rfl =
     cyl.I.map (motiveSubst _ σ a a_tp) ≫ P0.substConnection hrwcz0 a a_tp := by
-  simp only [polymorphicIdIntro_Id, motiveCtx, motiveSubst]
+  simp only [motiveCtx, motiveSubst]
   apply (disp_pullback ..).hom_ext
   · simp only [Category.assoc, substWk_var]
     erw [substConnection_var]
@@ -744,7 +742,8 @@ def polymorphicIdElim (hrwcz0 : Hurewicz cyl U0.tp) [hrwcz0.IsUniform] [hrwcz0.I
     (U1 : UnstructuredUniverse Ctx) (hrwcz1 : Hurewicz cyl U1.tp) [Hurewicz.IsUniform hrwcz1]
     [Hurewicz.IsNormal hrwcz1] : PolymorphicIdElim (polymorphicIdIntro P0) U1 where
   jElim a a_tp C c c_tp := cyl.δ1.app _ ≫ hrwcz1.lift (disp .. ≫ disp .. ≫ c)
-    (substConnection P0 hrwcz0 a a_tp ≫ C) (by rw [δ0_substConnection_assoc]; simp [c_tp]) -- FIXME simp failed
+    (substConnection P0 hrwcz0 a a_tp ≫ C)
+    (by rw [δ0_substConnection_assoc]; simp [c_tp]) -- FIXME simp failed
   jElim_comp σ A a a_tp C c c_tp := by
     slice_rhs 1 2 => rw [← δ1_naturality]
     slice_rhs 2 3 => rw [← hrwcz1.lift_comp]
@@ -752,7 +751,7 @@ def polymorphicIdElim (hrwcz0 : Hurewicz cyl U0.tp) [hrwcz0.IsUniform] [hrwcz0.I
     · simp [motiveSubst, substWk_disp_assoc]
     · rw [substConnection_comp_motiveSubst_assoc]
   jElim_tp a a_tp C c c_tp := by
-    simp only [motiveCtx, polymorphicIdIntro_Id, Category.assoc, Hurewicz.lift_comp_self']
+    simp only [motiveCtx, Category.assoc, Hurewicz.lift_comp_self']
     erw [δ1_substConnection_assoc] -- FIXME simp, rw failed
   reflSubst_jElim {Γ A} a a_tp C c c_tp := calc _
     _ = cyl.δ1.app Γ ≫ cyl.I.map (reflInst _ a a_tp) ≫
diff --git a/HoTTLean/Model/Unstructured/Interpretation.lean b/HoTTLean/Model/Unstructured/Interpretation.lean
index 521e84d3..fdd82111 100644
--- a/HoTTLean/Model/Unstructured/Interpretation.lean
+++ b/HoTTLean/Model/Unstructured/Interpretation.lean
@@ -3,8 +3,10 @@ import HoTTLean.Model.Unstructured.UHom
 
 import HoTTLean.ForMathlib
 
+-- Part membership simplification must unfold dependent context projections.
 macro "simp_part" loc:(Lean.Parser.Tactic.location)? : tactic =>
-  `(tactic| simp only [
+  `(tactic| set_option backward.isDefEq.respectTransparency false in
+    simp only [
     Part.mem_assert_iff, Part.mem_bind_iff, Part.mem_map_iff,
     Part.pure_eq_some, Part.bind_eq_bind, Part.map_bind,
     Part.map_some, Part.mem_bind_iff, Part.mem_some_iff,
@@ -20,7 +22,7 @@ namespace Model.UnstructuredUniverse
 
 open SynthLean
 
-variable {𝒞 : Type u} [Category 𝒞] (M : UnstructuredUniverse 𝒞)
+variable {𝒞 : Type u} [Category.{v} 𝒞] (M : UnstructuredUniverse 𝒞)
 variable [ChosenTerminal 𝒞]
 
 open ChosenTerminal
@@ -56,7 +58,7 @@ where `Γ` is a prefix of `Γ'`.
 It witnesses a sequence of context extension operations in `s`
 that built `Γ'` on top of `Γ`.
 We write `Γ ≤ Γ'`. -/
-inductive ExtSeq (s : UHomSeq 𝒞) (Γ : 𝒞) : 𝒞 → Type u where
+inductive ExtSeq (s : UHomSeq 𝒞) (Γ : 𝒞) : 𝒞 → Type (max u v) where
   | nil : s.ExtSeq Γ Γ
   | snoc {Γ'} {l : Nat} (d : s.ExtSeq Γ Γ') (llen : l < s.length + 1) (A : Γ' ⟶ s[l].Ty) :
     s.ExtSeq Γ (s[l].ext A)
@@ -209,7 +211,7 @@ i.e., one of the form `1.Aₙ₋₁.….A₀`,
 together with the extension sequence `[Aₙ₋₁ :: … :: A₀]`.
 
 This kind of object can be destructured. -/
-def CObj (s : UHomSeq 𝒞) : Type u := Σ Γ : 𝒞, s.ExtSeq (𝟭_ 𝒞) Γ
+def CObj (s : UHomSeq 𝒞) : Type (max u v) := Σ Γ : 𝒞, s.ExtSeq (𝟭_ 𝒞) Γ
 
 def nilCObj (s : UHomSeq 𝒞) : s.CObj :=
   ⟨𝟭_ 𝒞, .nil⟩
@@ -401,8 +403,9 @@ def ofCtx : Ctx χ → Part s.CObj
   | (A,l) :: Γ => do
     Part.assert (l < s.length + 1) fun llen => do
     let sΓ ← ofCtx Γ
-    let sA ← I.ofType sΓ l A
-    return sΓ.snoc llen sA
+    -- Use the universe-polymorphic bind: contexts and homs may live at different levels.
+    (I.ofType sΓ l A).bind fun sA =>
+      return sΓ.snoc llen sA
 
 @[simp]
 theorem mem_ofType_pi {Γ l i j A B} {llen : l < s.length + 1} {x} :
@@ -637,14 +640,15 @@ def sub1 {se : Γ.1 ⟶ s[l].Tm}
 @[simp] theorem sub1_toSb {se : Γ.1 ⟶ s[l].Tm}
     (A : Γ.1 ⟶ s[l].Ty) (e) (eq : se ≫ s[l].tp = A) (H : se ∈ I.ofTerm Γ l e) :
     (sub1 llen A e eq H).toSb = Expr.toSb e := by
-  simp [sub1, toSb, Expr.toSb]
+  rfl
 
 def up {Δ Γ σ full} (sσ : I.CSb Δ Γ σ full)
     {l} (llen : l < s.length + 1) (A : Γ.1 ⟶ s[l].Ty)
     (A' := σ ≫ A) (eq : σ ≫ A = A' := by rfl) :
     I.CSb (Δ.snoc llen A') (Γ.snoc llen A) (s[l].substWk σ A _ eq) full := by
   refine ((CSb.wk _ _ false).comp sσ).snoc' _ _ (.bvar 0) (by simp) _ ?_
-  simp [UHomSeq.CObj.var, UHomSeq.ExtSeq.var]
+  simp [UHomSeq.CObj.var, UHomSeq.ExtSeq.var, Part.assert_pos rfl]
+  exact Part.mem_some _
 
 @[simp] theorem up_toSb {Δ Γ σ full} (sσ : I.CSb Δ Γ σ full)
      {l} {llen : l < s.length + 1} {A A'} {eq : σ ≫ A = A'} :
@@ -658,6 +662,8 @@ end CSb
 open UHomSeq PolymorphicSigma PolymorphicPi PolymorphicIdIntro PolymorphicIdElim
 variable (slen : univMax ≤ s.length)
 
+-- Unfold dependent context projections in this proof.
+set_option backward.isDefEq.respectTransparency false in
 theorem mem_ofType_ofTerm_subst' {full}
     (IH : full = true → ∀ {Δ Γ l} (llen : l < s.length + 1) {sσ} (σ : I.CSb Δ Γ sσ false) {se e},
       se ∈ I.ofTerm Γ l e llen → sσ ≫ se ∈ I.ofTerm Δ l (Expr.subst σ.toSb e) llen)
@@ -704,7 +710,7 @@ theorem mem_ofType_ofTerm_subst' {full}
     simp [ofTerm_bvar] at H
     simp [Expr.subst]
     induction σ generalizing i with simp [CSb.toSb, *]
-    | wk => exact CObj.mem_var_succ.2 ⟨_, ‹_›, rfl⟩
+    | wk => exact ⟨_, ‹_›, rfl⟩
     | @comp _ _ _ _ _ full σ τ ih1 ih2 =>
       simp [Expr.comp]
       cases full with
@@ -798,12 +804,14 @@ theorem mem_ofType_wk {e l l' hl} (hl' : l' < s.length + 1)
     (s[l'].disp X) ≫ se ∈ I.ofType (Γ.snoc hl' X) l (Expr.subst Expr.wk e) hl :=
   (I.mem_ofType_ofTerm_subst hl (.wk hl' X) rfl).1 H
 
+-- Unfold dependent context projections in this proof.
+set_option backward.isDefEq.respectTransparency false in
 theorem mem_ofType_of_isClosed {e l} (e_cl : e.isClosed)
     (Γ : s.CObj) (hl : l < s.length + 1) {se} (se_mem : se ∈ I.ofType s.nilCObj l e hl) :
     isTerminal.from Γ.1 ≫ se ∈ I.ofType Γ l e hl := by
   rcases Γ with ⟨_, ext⟩
   induction ext
-  · convert se_mem; simp
+  · simpa [UHomSeq.nilCObj] using se_mem
   · rename_i X se_mem
     have := I.mem_ofType_wk (X := X) (by omega) se_mem
     convert this using 1 <;>
@@ -831,6 +839,8 @@ theorem mem_ofTerm_toSb {e l l' hl} (hl' : l' < s.length + 1)
 
 /-! ## Soundness of interpretation -/
 
+-- Unfold dependent context projections in this proof.
+set_option backward.isDefEq.respectTransparency false in
 theorem tp_sound {Γ i A l} (H : Lookup Γ i A l) {sΓ} (hΓ : sΓ ∈ I.ofCtx Γ) :
     ∃ llen, ∃ sA ∈ sΓ.tp llen i, sA ∈ I.ofType sΓ l A llen := by
   induction H generalizing sΓ with (
@@ -954,6 +964,8 @@ theorem WfTmIH.bvar {Γ A i l} (H : Lookup Γ i A l) : I.WfCtxIH Γ → I.WfTmIH
     have ⟨llen, _, h1, h2⟩ := I.var_sound H hΓ
     ⟨_, ‹_›, llen, _, h2, _, h1, rfl⟩
 
+-- Unfold dependent context projections in this proof.
+set_option backward.isDefEq.respectTransparency false in
 theorem EqTmIH.lam {Γ A A' B t t' l l'} :
     I.EqTpIH Γ l A A' → I.EqTmIH ((A, l) :: Γ) l' B t t' →
     I.EqTmIH Γ (max l l') (Expr.pi l l' A B) (Expr.lam l l' A t) (Expr.lam l l' A' t')
@@ -1040,6 +1052,8 @@ theorem EqTmIH.refl_tm {Γ A t t' l} :
       ?_⟩
     simp; congr
 
+-- Unfold dependent context projections in this proof.
+set_option backward.isDefEq.respectTransparency false in
 theorem EqTmIH.idRec {Γ A M M' t t' r r' u u' h h' l l'} :
     I.EqTmIH Γ l A t t' →
     I.EqTpIH ((.Id l (.subst .wk A) (.subst .wk t) (.bvar 0), l) :: (A, l) :: Γ) l' M M' →
@@ -1070,7 +1084,8 @@ theorem EqTmIH.idRec {Γ A M M' t t' r r' u u' h h' l l'} :
   refine ⟨_, hΓ, _, _,
     (I.mem_ofType_ofTerm_subst _ (.snoc (.sub1 _ _ _ utp hu) _ _ _ ?_ hh) ?_).1 hM, _,
     I.mem_ofTerm_idRec.2 ⟨_, _, ht, _, ttp, B, ?b, _, hM, _, hr, ?a, _, hu, utp, _, hh, htp, rfl⟩,
-    I.mem_ofTerm_idRec.2 ⟨_, _, ht', _, ttp, B, ?b, _, hM', _, hr', ?a, _, hu', utp, _, hh', htp, rfl⟩,
+    I.mem_ofTerm_idRec.2
+      ⟨_, _, ht', _, ttp, B, ?b, _, hM', _, hr', ?a, _, hu', utp, _, hh', htp, rfl⟩,
     idRec_tp (I_eq := _) ..⟩
   · rw [htp, Beq, ← Id_comp]
     congr 1 <;> simp [sAeq]
@@ -1093,6 +1108,8 @@ theorem EqTmIH.code {Γ A A' l} (_ : l < univMax) :
       I.mem_ofTerm_code.2 ⟨_, rfl, _, hA', by simp⟩,
       s.code_tp ..⟩
 
+-- Unfold dependent context projections in this proof.
+set_option backward.isDefEq.respectTransparency false in
 theorem EqTmIH.app_lam {Γ A B t u l l'} :
     I.WfTmIH ((A, l) :: Γ) l' B t → I.WfTmIH Γ l A u →
     I.EqTmIH Γ l' (Expr.subst u.toSb B) (Expr.app l l' B (Expr.lam l l' A t) u)
@@ -1128,6 +1145,8 @@ theorem EqTmIH.fst_snd_pair {Γ A B t u l l'} :
        ⟨_, hΓ, _, _, I.mem_ofType_toSb _ ht ttp hB, _,
         I.mem_ofTerm_snd.2 ⟨_, _, hA, _, hB, _, hp, tp, (snd_pair ..).symm⟩, hu, utp⟩⟩
 
+-- Unfold dependent context projections in this proof.
+set_option backward.isDefEq.respectTransparency false in
 theorem EqTmIH.idRec_refl {Γ A M t r l l'} :
     I.WfTmIH Γ l A t →
     I.WfTpIH ((.Id l (.subst .wk A) (.subst .wk t) (.bvar 0), l) :: (A, l) :: Γ) l' M →
@@ -1152,10 +1171,12 @@ theorem EqTmIH.idRec_refl {Γ A M t r l l'} :
     have sr := rtp ▸ Part.mem_unique hR sM
     have ir := I.mem_ofTerm_idRec.2 ⟨_, _, ht, _, ttp, B, by simp [Beq, sAeq],
       _, hM, _, hr, by simp [ttp, sr], _, ht, ttp, _, h1, by simp [ttp],
-        by rw! [ttp, PolymorphicIdElim.idRec_refl (I_eq := _)]⟩
+        by rw! [ttp, PolymorphicIdElim.idRec_refl (I_eq := _)]; rfl⟩
     ⟨_, hΓ, _, _, sM, _, ir, hr, sr⟩
   simp [Beq, ← Id_comp, sAeq, ttp]
 
+-- Unfold dependent context projections in this proof.
+set_option backward.isDefEq.respectTransparency false in
 theorem EqTmIH.lam_app {Γ A B f l l'} :
     I.WfTmIH Γ (max l l') (.pi l l' A B) f →
     I.EqTmIH Γ (max l l') (.pi l l' A B) f
@@ -1179,6 +1200,8 @@ theorem EqTmIH.lam_app {Γ A B f l l'} :
       congr 1
       apply (s[l].disp_pullback _).hom_ext <;> simp
 
+-- Unfold dependent context projections in this proof.
+set_option backward.isDefEq.respectTransparency false in
 theorem EqTmIH.pair_fst_snd {Γ A B p l l'} :
     I.WfTmIH Γ (max l l') (Expr.sigma l l' A B) p →
     I.EqTmIH Γ (max l l') (Expr.sigma l l' A B) p
diff --git a/HoTTLean/Model/Unstructured/UHom.lean b/HoTTLean/Model/Unstructured/UHom.lean
index 3c05dc06..36c353e6 100644
--- a/HoTTLean/Model/Unstructured/UHom.lean
+++ b/HoTTLean/Model/Unstructured/UHom.lean
@@ -35,7 +35,8 @@ def Hom.comp {M N O : UnstructuredUniverse Ctx} (α : Hom M N) (β : Hom N O) :
   mapTy := α.mapTy ≫ β.mapTy
   pb := α.pb.paste_horiz β.pb
 
-def Hom.comp_assoc {M N O P : UnstructuredUniverse Ctx} (α : Hom M N) (β : Hom N O) (γ : Hom O P) :
+theorem Hom.comp_assoc {M N O P : UnstructuredUniverse Ctx}
+    (α : Hom M N) (β : Hom N O) (γ : Hom O P) :
     comp (comp α β) γ = comp α (comp β γ) := by
   simp [comp]
 
@@ -55,10 +56,12 @@ def Hom.subst (M : UnstructuredUniverse Ctx)
     Hom (M.pullback ((σ) ≫ A)) (M.pullback A) :=
   let Aσ := (σ) ≫ A
   { mapTm :=
-    (M.disp_pullback A).lift (M.var Aσ) (M.disp Aσ ≫ σ) (by aesop_cat)
+    (M.disp_pullback A).lift (M.var Aσ) (M.disp Aσ ≫ σ)
+      (by exact (M.disp_pullback Aσ).w.trans (Category.assoc _ _ _).symm)
     mapTy := (σ)
     pb := by
-      convert IsPullback.of_right' (M.disp_pullback Aσ) (M.disp_pullback A)}
+      change IsPullback _ (M.disp Aσ) (M.disp A) σ
+      exact IsPullback.of_right' (M.disp_pullback Aσ) (M.disp_pullback A)}
 
 @[simp] def Hom.extIsoExt {M N : UnstructuredUniverse Ctx} (h : Hom M N)
     {Γ} (A : Γ ⟶ M.Ty) : (N.ext (A ≫ h.mapTy)) ≅ (M.ext A) :=
@@ -99,7 +102,8 @@ def UHom.comp {M N O : UnstructuredUniverse Ctx} (α : UHom M N) (β : UHom N O)
   asTm := α.asTm ≫ β.mapTm
   U_pb := α.U_pb.paste_horiz β.pb
 
-def UHom.comp_assoc {M N O P : UnstructuredUniverse Ctx} (α : UHom M N) (β : UHom N O) (γ : UHom O P) :
+theorem UHom.comp_assoc {M N O P : UnstructuredUniverse Ctx} (α : UHom M N) (β : UHom N O)
+    (γ : UHom O P) :
     comp (comp α β) γ = comp α (comp β γ) := by
   simp [comp, Hom.comp]
 
@@ -118,13 +122,11 @@ def UHom.ofTarskiU (M : UnstructuredUniverse Ctx) (U : (𝟭_ Ctx) ⟶ M.Ty) (El
   __ := M.pullbackHom El
   U
   asTm := M.var U
-  U_pb := (M.disp_pullback U).of_iso
-      (Iso.refl _)
-      (Iso.refl _)
-      (Iso.refl _)
-      (Iso.refl _)
-      (by simp) (isTerminal.hom_ext ..)
-      (by simp) (by simp)
+  U_pb := by
+    change IsPullback (M.var U) (isTerminal.from (M.ext U)) M.tp U
+    convert M.disp_pullback U using 1
+    exact isTerminal.hom_ext _ _
+
 
 section
 
@@ -135,6 +137,7 @@ def Hom.extCompMapTyIsoExt : N.ext (A ≫ α.mapTy) ≅ M.ext A :=
   (N.disp_pullback (A ≫ α.mapTy)).isoIsPullback _ _
   (IsPullback.paste_horiz (M.disp_pullback A) α.pb)
 
+omit [ChosenTerminal Ctx] in
 lemma Hom.extCompMapTyIsoExt_hom_comp_substWk  :
     (α.extCompMapTyIsoExt σA).hom ≫ M.substWk σ A σA eq =
     N.substWk σ (A ≫ α.mapTy) (σA ≫ α.mapTy) (by simp [← eq]) ≫ (α.extCompMapTyIsoExt A).hom := by
@@ -370,7 +373,7 @@ class PiSeq (s : UHomSeq Ctx) where
 -- Re-export for use with dot notation.
 abbrev polyPi := @PiSeq.polyPi
 
-def PiSeq.ofMonomorphic
+abbrev PiSeq.ofMonomorphic
     (nmPi : (i : Nat) → (ilen : i < s.length + 1 := by get_elem_tactic) →
     s[i].PolymorphicPi s[i] s[i]) : PiSeq s where
   polyPi i j _ _ := .ofMonomorphic (nmPi (max i j)) (s.homOfLe _ _) (s.homOfLe _ _)
diff --git a/HoTTLean/Model/Unstructured/UnstructuredUniverse.lean b/HoTTLean/Model/Unstructured/UnstructuredUniverse.lean
index 5e57936b..b2476a72 100644
--- a/HoTTLean/Model/Unstructured/UnstructuredUniverse.lean
+++ b/HoTTLean/Model/Unstructured/UnstructuredUniverse.lean
@@ -320,12 +320,14 @@ lemma fst_comp {Γ Δ} (σ : Δ ⟶ Γ) {A : Γ ⟶ U0.Ty} {σA} (eq) {B : U0.ex
     S.fst (U0.substWk σ A σA eq ≫ B) (σ ≫ s) (by simp [s_tp, S.Sig_comp]) =
     σ ≫ S.fst B s s_tp := by
   rw! [(S.pair_fst_snd B s (by simp [s_tp])).symm, ← S.pair_comp, S.fst_pair, S.fst_pair]
+  rfl
 
 lemma snd_comp {Γ Δ} (σ : Δ ⟶ Γ) {A : Γ ⟶ U0.Ty} {σA} (eq) {B : U0.ext A ⟶ U1.Ty}
     (s : Γ ⟶ U2.Tm) (s_tp : s ≫ U2.tp = S.Sig B) :
     S.snd (U0.substWk σ A σA eq ≫ B) (σ ≫ s) (by simp [s_tp, S.Sig_comp]) =
     σ ≫ S.snd B s s_tp := by
   rw! [(S.pair_fst_snd B s (by simp [s_tp])).symm, ← S.pair_comp, S.snd_pair, S.snd_pair]
+  rfl
 
 end PolymorphicSigma
 
@@ -363,6 +365,7 @@ lemma unLam_comp {Γ Δ} (σ : Δ ⟶ Γ) {A : Γ ⟶ U0.Ty} {σA} (eq) {B : U0.
     U0.substWk σ A σA eq ≫ P.unLam B f f_tp := by
   rw [← P.unLam_lam (U0.substWk σ A σA eq ≫ B) (U0.substWk σ A σA eq ≫ P.unLam B f f_tp)]
   . rw! [P.lam_comp σ eq B, P.lam_unLam]
+    rfl
   . rw [Category.assoc, P.unLam_tp]
 
 /--
diff --git a/HoTTLean/Pointed/Basic.lean b/HoTTLean/Pointed/Basic.lean
index b41f69d6..73b0e7e9 100644
--- a/HoTTLean/Pointed/Basic.lean
+++ b/HoTTLean/Pointed/Basic.lean
@@ -1,4 +1,4 @@
-import Mathlib.CategoryTheory.Category.Grpd
+import Mathlib.CategoryTheory.Groupoid.Grpd.Basic
 import HoTTLean.ForMathlib
 import HoTTLean.Grothendieck.Groupoidal.Basic
 import HoTTLean.ForMathlib.CategoryTheory.Functor.IsPullback
@@ -12,10 +12,12 @@ universe w v u v₁ u₁ v₂ u₂
 noncomputable section
 
 namespace CategoryTheory
+-- The Grothendieck fiber equations reduce through bundled category morphisms.
+set_option backward.isDefEq.respectTransparency false
 
 attribute [local simp] eqToHom_map Grpd.id_eq_id Grpd.comp_eq_comp Functor.id_comp
 
-open Functor
+open _root_.CategoryTheory.Functor
 
 abbrev PCat := ∫ 𝟭 Cat.{v,u}
 
@@ -34,32 +36,32 @@ prefix:max "⇓" => forgetToCat.obj
 -- write using `\d==`
 postfix:max "⟱" => forgetToCat.map
 
-lemma forgetToCat_map {C D : PCat} (F : C ⟶ D) :
+@[local simp] lemma forgetToCat_map {C D : PCat} (F : C ⟶ D) :
     F⟱ = F.base := rfl
 
 @[simp]
-theorem id_obj {C : PCat} (X : C.base) : (𝟙 C)⟱.obj X = X :=
+theorem id_obj {C : PCat} (X : C.base) : (𝟙 C)⟱.toFunctor.obj X = X :=
   rfl
 
 @[simp]
 theorem id_map {C : PCat} {X Y : C.base} (f : X ⟶ Y) :
-    (𝟙 C)⟱.map f = f :=
+    (𝟙 C)⟱.toFunctor.map f = f :=
   rfl
 
 @[simp] lemma id_fiber {C : PCat} : Hom.fiber (𝟙 C) = 𝟙 _ := rfl
 
 @[simp]
 theorem comp_obj {C D E : PCat} (F : C ⟶ D) (G : D ⟶ E) (X : C.base) :
-    (F ≫ G)⟱.obj X = G⟱.obj (F⟱.obj X) :=
+    (F ≫ G)⟱.toFunctor.obj X = G⟱.toFunctor.obj (F⟱.toFunctor.obj X) :=
   rfl
 
 @[simp]
 theorem comp_map {C D E : PCat} (F : C ⟶ D) (G : D ⟶ E) {X Y : C.base}
-    (f : X ⟶ Y) : (F ≫ G)⟱.map f = G⟱.map (F⟱.map f) :=
+    (f : X ⟶ Y) : (F ≫ G)⟱.toFunctor.map f = G⟱.toFunctor.map (F⟱.toFunctor.map f) :=
   rfl
 
 @[simp] lemma comp_fiber {C D E : PCat} (F : C ⟶ D) (G : D ⟶ E) :
-    (F ≫ G).fiber = G⟱.map F.fiber ≫ G.fiber := by
+    (F ≫ G).fiber = G⟱.toFunctor.map F.fiber ≫ G.fiber := by
   simp
 
 -- formerly `map_id_point`
@@ -72,13 +74,13 @@ theorem comp_map {C D E : PCat} (F : C ⟶ D) (G : D ⟶ E) {X Y : C.base}
 -- formerly `map_comp_point`
 @[simp] theorem map_comp_fiber {C : Type u} [Category.{v} C] {F : C ⥤ PCat}
     {x y z: C} (f : x ⟶ y) (g : y ⟶ z) : (F.map (f ≫ g)).fiber =
-    eqToHom (by simp) ≫ (F.map g)⟱.map (F.map f).fiber ≫ (F.map g).fiber := by
+    eqToHom (by simp) ≫ (F.map g)⟱.toFunctor.map (F.map f).fiber ≫ (F.map g).fiber := by
   rw! [Functor.map_comp]
   simp
 
 /-- This is the proof of equality used in the eqToHom in `PCat.eqToHom_point` -/
 theorem eqToHom_point_aux {P1 P2 : PCat.{v,u}} (eq : P1 = P2) :
-    (eqToHom eq)⟱.obj P1.fiber = P2.fiber := by
+    (eqToHom eq)⟱.toFunctor.obj P1.fiber = P2.fiber := by
   subst eq
   simp
 
@@ -100,7 +102,7 @@ def objFiber (x : Γ) : ⇓(α.obj x) := (α.obj x).fiber
 
 -- formerly `mapObjPt`
 def mapObjFiber {x y : Γ} (f : x ⟶ y) : ⇓(α.obj y) :=
-    (α.map f)⟱.obj (objFiber α x)
+    (α.map f)⟱.toFunctor.obj (objFiber α x)
 
 -- formerly `mapPoint`
 def mapFiber {x y : Γ} (f : x ⟶ y) :
@@ -114,7 +116,7 @@ def mapFiber {x y : Γ} (f : x ⟶ y) :
 -- formerly `mapPoint_comp`
 theorem mapFiber_comp {x y z} (f : x ⟶ y) (g : y ⟶ z) :
     mapFiber α (f ≫ g) = eqToHom (by simp [mapObjFiber, objFiber])
-      ≫ (α.map g)⟱.map (mapFiber α f) ≫ mapFiber α g := by
+      ≫ (α.map g)⟱.toFunctor.map (mapFiber α f) ≫ mapFiber α g := by
   simp [mapFiber]
 
 theorem mapFiber_inv {x y} (f : x ⟶ y) [IsIso f] :
@@ -124,7 +126,9 @@ theorem mapFiber_inv {x y} (f : x ⟶ y) [IsIso f] :
 end
 
 theorem eqToHom_base_map {x y : PCat} (eq : x = y) {a b} (f : a ⟶ b) :
-    (eqToHom eq).base.map f = eqToHom (by simp) ≫ (eqToHom (by simp [eq] : x.base = y.base)).map f ≫ eqToHom (by simp) := by
+    (eqToHom eq).base.toFunctor.map f = eqToHom (by simp) ≫
+      (eqToHom (by simp [eq] : x.base = y.base)).toFunctor.map f ≫
+      eqToHom (by simp) := by
   cases eq
   simp
 
@@ -166,7 +170,7 @@ prefix:max "⇓" => forgetToGrpd.obj
 -- write using `\d==`
 postfix:max "⟱" => forgetToGrpd.map
 
-lemma forgetToGrpd_map {C D : PGrpd} (F : C ⟶ D) :
+@[local simp] lemma forgetToGrpd_map {C D : PGrpd} (F : C ⟶ D) :
     F⟱ = F.base := rfl
 
 @[simp]
@@ -385,8 +389,8 @@ end
 theorem Functor.hext (F G : Γ ⥤ PGrpd)
     (hbase : F ⋙ forgetToGrpd = G ⋙ forgetToGrpd)
     (hfiber_obj : ∀ x : Γ, HEq (F.obj x).fiber (G.obj x).fiber)
-    (hfiber_map : ∀ {x y : Γ} (f : x ⟶ y), HEq (F.map f).fiber (G.map f).fiber)
-    : F = G :=
+    (hfiber_map : ∀ {x y : Γ} (f : x ⟶ y), HEq (F.map f).fiber (G.map f).fiber) :
+    F = G :=
   Grothendieck.FunctorTo.hext F G hbase hfiber_obj hfiber_map
 
 section
diff --git a/HoTTLean/Pointed/IsPullback.lean b/HoTTLean/Pointed/IsPullback.lean
index bc889780..d15e3df6 100644
--- a/HoTTLean/Pointed/IsPullback.lean
+++ b/HoTTLean/Pointed/IsPullback.lean
@@ -22,7 +22,7 @@ namespace CategoryTheory
 namespace PGrpd
 
 lemma forgetToPCat_forgetToCat :
-  PGrpd.forgetToPCat.{v,u} ⋙ PCat.forgetToCat.{v,u} =
+    PGrpd.forgetToPCat.{v,u} ⋙ PCat.forgetToCat.{v,u} =
     PGrpd.forgetToGrpd.{v,u} ⋙ Grpd.forgetToCat.{v,u} :=
   rfl
 
@@ -38,7 +38,7 @@ The following square is a (meta-theoretic) pullback
       Grpd------forgetToCat------->Cat
 -/
 def isPullback : Functor.IsPullback forgetToPCat.{v,u} forgetToGrpd.{v,u}
-      PCat.forgetToCat Grpd.forgetToCat :=
+    PCat.forgetToCat Grpd.forgetToCat :=
   Functor.Grothendieck.isPullback _
 
 /--
diff --git a/HoTTLean/Syntax/Axioms.lean b/HoTTLean/Syntax/Axioms.lean
index a7056c45..82b37410 100644
--- a/HoTTLean/Syntax/Axioms.lean
+++ b/HoTTLean/Syntax/Axioms.lean
@@ -29,8 +29,8 @@ open Classical
 instance : LE (Axioms χ) where
   le E E' := ∀ ⦃c p⦄, (E c) = some p → (E' c) = some p
 
-instance : IsRefl (Axioms χ) (· ≤ ·) where
-  refl _ _ _ := id
+instance : Std.Refl (· ≤ · : Axioms χ → Axioms χ → Prop) where
+  refl _ _ _ h := h
 
 instance : IsTrans (Axioms χ) (· ≤ ·) where
   trans _ _ _ h h' _ _ Ec := h' (h Ec)
diff --git a/HoTTLean/Syntax/Basic.lean b/HoTTLean/Syntax/Basic.lean
index d05dfe5a..0160b43b 100644
--- a/HoTTLean/Syntax/Basic.lean
+++ b/HoTTLean/Syntax/Basic.lean
@@ -42,7 +42,7 @@ inductive Expr where
 
 @[simp]
 theorem Expr.sizeOf_pos {χ} (e : Expr χ) : 0 < sizeOf e := by
-  induction e <;> { dsimp; omega }
+  induction e <;> simp <;> omega
 
 /-- A convergent rewriting system for the HoTT0 σ-calculus. -/
 -- The attribute has to be initialized here for use in downstream modules.
diff --git a/HoTTLean/Syntax/EqCtx.lean b/HoTTLean/Syntax/EqCtx.lean
index ab28a0af..013fa8b7 100644
--- a/HoTTLean/Syntax/EqCtx.lean
+++ b/HoTTLean/Syntax/EqCtx.lean
@@ -8,13 +8,12 @@ variable {χ : Type*} {E : Axioms χ} {Δ Δ' Γ Γ' Γ'' : Ctx χ}
 
 /-! ## Context equality -/
 
-variable (E : Axioms χ) in
 /-- The two contexts are judgmentally equal. -/
-inductive EqCtx : Ctx χ → Ctx χ → Prop
-  | nil : EqCtx [] []
+inductive EqCtx (E : Axioms χ) : Ctx χ → Ctx χ → Prop
+  | nil : EqCtx E [] []
   /-- Prefer using `EqCtx.snoc`. -/
-  | snoc' {Γ Γ' A A' l} :
-    EqCtx Γ Γ' → E ∣ Γ ⊢[l] A ≡ A' → E ∣ Γ' ⊢[l] A ≡ A' → EqCtx ((A, l) :: Γ) ((A', l) :: Γ')
+  | snoc' {Γ Γ' : Ctx χ} {A A' : Expr χ} {l : Nat} :
+    EqCtx E Γ Γ' → E ∣ Γ ⊢[l] A ≡ A' → E ∣ Γ' ⊢[l] A ≡ A' → EqCtx E ((A, l) :: Γ) ((A', l) :: Γ')
 
 theorem EqCtx.refl : WfCtx E Γ → EqCtx E Γ Γ := by
   revert Γ; mutual_induction WfCtx <;> grind [EqCtx.nil, EqCtx.snoc', EqTp.refl_tp]
diff --git a/HoTTLean/Syntax/GCongr.lean b/HoTTLean/Syntax/GCongr.lean
index af584802..4127002e 100644
--- a/HoTTLean/Syntax/GCongr.lean
+++ b/HoTTLean/Syntax/GCongr.lean
@@ -203,10 +203,10 @@ attribute [gcongr] EqTm.cong_idRec
 
 /-! ## Lemmas for substitution -/
 
-attribute [gcongr] WfTp.subst_eq
-attribute [gcongr] EqTp.subst_eq
-attribute [gcongr] WfTm.subst_eq
-attribute [gcongr] EqTm.subst_eq
+attribute [gcongr only] WfTp.subst_eq
+attribute [gcongr only] EqTp.subst_eq
+attribute [gcongr only] WfTm.subst_eq
+attribute [gcongr only] EqTm.subst_eq
 
 attribute [gcongr] EqTp.subst
 attribute [gcongr] EqTm.subst
diff --git a/HoTTLean/Syntax/Inversion.lean b/HoTTLean/Syntax/Inversion.lean
index 307fb278..d4057ed6 100644
--- a/HoTTLean/Syntax/Inversion.lean
+++ b/HoTTLean/Syntax/Inversion.lean
@@ -75,7 +75,7 @@ theorem inv_all :
     (∀ {Γ l A t u}, E ∣ Γ ⊢[l] t ≡ u : A →
       (WfCtx E Γ) ∧ (E ∣ Γ ⊢[l] A) ∧ (E ∣ Γ ⊢[l] t : A) ∧ (E ∣ Γ ⊢[l] u : A)) := by
   mutual_induction WfCtx
-  all_goals dsimp; try intros
+  all_goals (try dsimp); try intros
   case bvar => grind [WfCtx.lookup_wf]
   case cong_pi' => grind [WfTp.pi']
   case cong_sigma' => grind [WfTp.sigma']
@@ -252,7 +252,8 @@ theorem comp : WfSb E Θ σ Δ → WfSb E Δ σ' Γ → WfSb E Θ (Expr.comp σ
   intro σ σ'
   apply mk σ.wf_dom σ'.wf_cod
   intro _ _ _ lk
-  exact autosubst% σ'.lookup lk |>.subst σ
+  rw [← Expr.subst_subst]
+  exact σ'.lookup lk |>.subst σ
 
 theorem toSb : E ∣ Γ ⊢[l] t : A → WfSb E Γ t.toSb ((A, l) :: Γ) :=
   fun t => SubstProof.wfSb_toSb t.wf_ctx t.wf_tp t
diff --git a/HoTTLean/Syntax/InversionLemmas.lean b/HoTTLean/Syntax/InversionLemmas.lean
index 663ff739..a5bccf5b 100644
--- a/HoTTLean/Syntax/InversionLemmas.lean
+++ b/HoTTLean/Syntax/InversionLemmas.lean
@@ -289,7 +289,8 @@ theorem WfTm.inv_pair {Γ B C t u l₀ l l'} : E ∣ Γ ⊢[l₀] .pair l l' B t
           (E ∣ Γ ⊢[l₂] u' : B.subst t'.toSb) ∧
           (E ∣ Γ ⊢[l] C ≡ .sigma l₁ l₂ A B) from
     fun h => this h rfl
-  mutual_induction WfCtx <;> grind [WfTp.sigma, WfTm.wf_tp, EqTp.refl_tp, EqTp.symm_tp, EqTp.trans_tp]
+  mutual_induction WfCtx <;>
+    grind [WfTp.sigma, WfTm.wf_tp, EqTp.refl_tp, EqTp.symm_tp, EqTp.trans_tp]
 
 theorem WfTm.inv_fst {Γ A B C p l₀ l l'} : E ∣ Γ ⊢[l₀] .fst l l' A B p : C →
     l₀ = l ∧ (E ∣ Γ ⊢[max l l'] p : .sigma l l' A B) ∧ (E ∣ Γ ⊢[l₀] C ≡ A) := by
diff --git a/HoTTLean/Syntax/Substitution.lean b/HoTTLean/Syntax/Substitution.lean
index e31830aa..1114a24c 100644
--- a/HoTTLean/Syntax/Substitution.lean
+++ b/HoTTLean/Syntax/Substitution.lean
@@ -1,3 +1,4 @@
+import Mathlib.Tactic.Basic
 import Mathlib.Tactic.Convert
 import Mathlib.Tactic.SimpRw
 import HoTTLean.Syntax.Typing
@@ -20,7 +21,6 @@ theorem le_univMax_all :
     (∀ {Γ l A t}, E ∣ Γ ⊢[l] t : A → l ≤ univMax) ∧
     (∀ {Γ l A t u}, E ∣ Γ ⊢[l] t ≡ u : A → l ≤ univMax) := by
   mutual_induction WfCtx
-  -- I ❤ grind and omega
   all_goals first | omega | try grind
 
 theorem WfCtx.le_univMax_of_lookup : WfCtx E Γ → Lookup Γ i A l → l ≤ univMax :=
@@ -62,8 +62,10 @@ theorem wk (Γ : Ctx χ) (A l) : WfRen ((A,l) :: Γ) Nat.succ Γ := by
   exact autosubst% Lookup.succ _ lk
 
 theorem comp : WfRen Θ ξ Δ → WfRen Δ ξ' Γ → WfRen Θ (ξ ∘ ξ') Γ := by
-  unfold WfRen; intro wf wf' _ _ _ lk
-  exact autosubst% wf <| wf' lk
+  unfold WfRen; intro wf wf' i A l lk
+  have h := wf (wf' lk)
+  have e : (A.rename ξ').rename ξ = A.rename (ξ ∘ ξ') := by autosubst
+  simpa only [e, Function.comp_apply] using h
 
 theorem upr : WfRen Δ ξ Γ → WfRen ((A.rename ξ, l) :: Δ) (Expr.upr ξ) ((A, l) :: Γ) := by
   unfold WfRen; intro wf _ _ _ lk
@@ -76,7 +78,7 @@ theorem upr : WfRen Δ ξ Γ → WfRen ((A.rename ξ, l) :: Δ) (Expr.upr ξ) ((
 
 end WfRen
 
-attribute [local grind ←] WfCtx.snoc WfRen.upr in
+attribute [local grind ← ] WfCtx.snoc WfRen.upr in
 theorem rename_all :
     (∀ {Γ l A}, E ∣ Γ ⊢[l] A →
       ∀ {Δ ξ}, WfCtx E Δ → WfRen Δ ξ Γ → E ∣ Δ ⊢[l] A.rename ξ) ∧
@@ -90,7 +92,7 @@ theorem rename_all :
   have ih_subst (B a : Expr χ) (ξ) :
       (B.subst a.toSb).rename ξ = (B.rename (Expr.upr ξ)).subst (a.rename ξ).toSb := by autosubst
   mutual_induction WfCtx
-  all_goals dsimp only; try intros
+  all_goals (try dsimp only); try intros
   all_goals try simp only [Expr.rename, ih_subst] at *; clear ih_subst
   -- Cases that don't go through by `grind_cases`.
   case ax p _ Ec _ _ ihA _ _ Δ ξ =>
@@ -353,7 +355,7 @@ theorem Id_bvar : WfCtx E Γ → E ∣ Γ ⊢[l] A → E ∣ Γ ⊢[l] t : A →
     E ∣ (A, l) :: Γ ⊢[l] .Id l (A.subst Expr.wk) (t.subst Expr.wk) (.bvar 0) :=
   fun Γ A t => WfTp.Id' (tp_wk Γ A A) (tm_wk Γ A t) (.bvar (Γ.snoc A) (.zero ..))
 
-attribute [local grind ←] WfCtx.snoc eqSb_up wfSb_up in
+attribute [local grind ← ] WfCtx.snoc eqSb_up wfSb_up in
 attribute [local grind →] EqSb.wf_left EqSb.wf_right in
 attribute [local grind .] -- TODO: fwd or bwd for properties of equality?
   EqTp.refl_tp EqTp.symm_tp EqTp.trans_tp
@@ -371,7 +373,8 @@ theorem subst_all :
     (∀ {Γ l A t u}, E ∣ Γ ⊢[l] t ≡ u : A →
       ∀ {Δ σ σ'}, EqSb E Δ σ σ' Γ → E ∣ Δ ⊢[l] t.subst σ ≡ u.subst σ' : A.subst σ) := by
   mutual_induction WfCtx
-  all_goals dsimp; try intros
+  all_goals try dsimp
+  all_goals try intros
   all_goals try simp only [Expr.subst_toSb_subst, Expr.subst_snoc_toSb_subst, Expr.subst] at *
   case ax p _ Ec _ _ ihA =>
     constructor
diff --git a/HoTTLean/Syntax/Synth.lean b/HoTTLean/Syntax/Synth.lean
index b168d9eb..80b6fb07 100644
--- a/HoTTLean/Syntax/Synth.lean
+++ b/HoTTLean/Syntax/Synth.lean
@@ -40,8 +40,7 @@ Furthermore, the correctness proof `eq_synthLvl` needs zero metatheory.
 Does this imply we could omit level annotations from the syntax?
 In the interpretation function, we'd invoke `synthLvl.go` on `ExtSeq`.  -/
 noncomputable def synthLvl (Γ : Ctx χ) (e : Expr χ) : Nat :=
-  go (Γ.map (·.2)) e
-where
+  go (Γ.map (·.2)) e where
   go (Γ : List Nat) : Expr χ → Nat
   | .ax _ A => go Γ A
   | .bvar i => Γ[i]? |>.getD default
@@ -133,7 +132,7 @@ theorem WfTm.tp_eq_synthTp : ∀ {Γ l A t}, E ∣ Γ ⊢[l] t : A → E ∣ Γ
   case snd' => grind [WfTp.subst, WfSb.toSb, WfTm.fst]
   case refl' =>
     simp only [synthTp]
-    gcongr <;> grind
+    gcongr
   case idRec' C _ _ _ _ _ _ _ _ _ =>
     unfold synthTp
     apply EqTp.refl_tp <| C.subst <| WfSb.snoc (WfSb.toSb ..) ..
diff --git a/HoTTLean/Typechecker/Cache.lean b/HoTTLean/Typechecker/Cache.lean
index 23e70989..d7ec9b39 100644
--- a/HoTTLean/Typechecker/Cache.lean
+++ b/HoTTLean/Typechecker/Cache.lean
@@ -9,7 +9,8 @@ structure Caches where
   checkTm : Std.HashMap (ExprStructEq × ExprStructEq × ExprStructEq × ExprStructEq) Expr := {}
   synthTm : Std.HashMap (ExprStructEq × ExprStructEq × ExprStructEq) (Expr × Expr) := {}
   equateTp : Std.HashMap (ExprStructEq × ExprStructEq × ExprStructEq × ExprStructEq) Expr := {}
-  equateTm : Std.HashMap (ExprStructEq × ExprStructEq × ExprStructEq × ExprStructEq × ExprStructEq) Expr := {}
+  equateTm : Std.HashMap
+    (ExprStructEq × ExprStructEq × ExprStructEq × ExprStructEq × ExprStructEq) Expr := {}
   equateNeutTm : Std.HashMap (ExprStructEq × ExprStructEq × ExprStructEq) Expr := {}
   evalTp : Std.HashMap (ExprStructEq × ExprStructEq) (Expr × Expr) := {}
   evalTm : Std.HashMap (ExprStructEq × ExprStructEq) (Expr × Expr) := {}
@@ -19,14 +20,16 @@ structure Caches where
   evalClosTp : Std.HashMap (ExprStructEq × ExprStructEq) (Expr × Expr) := {}
   forceClosTp : Std.HashMap (ExprStructEq × ExprStructEq × ExprStructEq) (Expr × Expr) := {}
   evalClos₂Tp : Std.HashMap (ExprStructEq × ExprStructEq × ExprStructEq) (Expr × Expr) := {}
-  forceClos₂Tp : Std.HashMap (ExprStructEq × ExprStructEq × ExprStructEq × ExprStructEq) (Expr × Expr) := {}
+  forceClos₂Tp : Std.HashMap (ExprStructEq × ExprStructEq × ExprStructEq × ExprStructEq)
+    (Expr × Expr) := {}
   evalClosTm : Std.HashMap (ExprStructEq × ExprStructEq) (Expr × Expr) := {}
   forceClosTm : Std.HashMap (ExprStructEq × ExprStructEq × ExprStructEq) (Expr × Expr) := {}
   evalEl : Std.HashMap (ExprStructEq) (Expr × Expr) := {}
   evalApp : Std.HashMap (ExprStructEq × ExprStructEq) (Expr × Expr) := {}
   evalFst : Std.HashMap (ExprStructEq) (Expr × Expr) := {}
   evalSnd : Std.HashMap (ExprStructEq) (Expr × Expr) := {}
-  evalIdRec : Std.HashMap (ExprStructEq × ExprStructEq × ExprStructEq × ExprStructEq) (Expr × Expr) := {}
+  evalIdRec : Std.HashMap (ExprStructEq × ExprStructEq × ExprStructEq × ExprStructEq)
+    (Expr × Expr) := {}
 
 inductive TypecheckerM.CacheEntry
   | checkTp (vΓ l T : ExprStructEq)
diff --git a/HoTTLean/Typechecker/Equate.lean b/HoTTLean/Typechecker/Equate.lean
index 6b38e88f..c0f63ced 100644
--- a/HoTTLean/Typechecker/Equate.lean
+++ b/HoTTLean/Typechecker/Equate.lean
@@ -266,7 +266,7 @@ partial def equateNeutTm (d : Q(Nat)) (nt nu : Q(Neut $χ)) :
       refine ⟨TUeq, ?_⟩
       apply eqt.trans_tm _ |>.trans_tm (eqt'.conv_eq TUeq.symm_tp).symm_tm
       apply EqTm.conv_eq _ eq.symm_tp
-      gcongr
+      exact EqTm.cong_app Beq feq aeq
     )
   | ~q(.fst _ $k' $p), ~q(.fst _ $m' $p') => do
     let km' ← equateNat q($k') q($m')
@@ -296,7 +296,7 @@ partial def equateNeutTm (d : Q(Nat)) (nt nu : Q(Neut $χ)) :
       have ⟨_, _, _, Aeq, Beq⟩ := Seq.inv_sigma
       refine have TUeq := ?_; ⟨TUeq, ?_⟩
       . apply eq.trans_tp _ |>.trans_tp eq'.symm_tp
-        gcongr; apply EqSb.toSb; gcongr
+        exact Beq.subst_eq (EqSb.toSb (EqTm.cong_fst Aeq Beq peq))
       . apply eqt.trans_tm _ |>.trans_tm (eqt'.conv_eq TUeq.symm_tp).symm_tm
         apply EqTm.conv_eq _ eq.symm_tp
         gcongr
@@ -341,7 +341,7 @@ partial def equateNeutTm (d : Q(Nat)) (nt nu : Q(Neut $χ)) :
           autosubst; gcongr
           exact aeq.wf_right
           exact aeq.symm_tm
-        gcongr
+        exact EqTm.cong_idRec aeq Meq this beq heq
     )
   | nt, nu =>
     throwError "cannot prove neutral terms are equal\
diff --git a/HoTTLean/Typechecker/Evaluate.lean b/HoTTLean/Typechecker/Evaluate.lean
index 858a26ba..260980ca 100644
--- a/HoTTLean/Typechecker/Evaluate.lean
+++ b/HoTTLean/Typechecker/Evaluate.lean
@@ -123,6 +123,7 @@ partial def evalTm (env : Q(List (Val $χ))) (t' : Q(Expr $χ)) :
       subst $v
       have ⟨_, h⟩ := List.getElem?_eq_some_iff.mp ($this).symm
       rw [h]
+      all_goals rfl
     )⟩
   | ~q(.lam $k $k' $C $b) => do
     let ⟨vC, vCpost⟩ ← evalTp q($env) q($C)
@@ -175,7 +176,7 @@ partial def evalTm (env : Q(List (Val $χ))) (t' : Q(Expr $χ)) :
       obtain ⟨rfl, p, eq⟩ := t.inv_snd
       apply ValEqTm.conv_tp _ (eq.subst env.wf_sb).symm_tp
       convert ($vpost) ($vppost env p) using 1
-      autosubst
+      all_goals first | rfl | autosubst
     )⟩
   | ~q(.refl $l $u) => do
     let ⟨vu, vupost⟩ ← evalTm q($env) q($u)
@@ -397,6 +398,7 @@ partial def evalNeutTm (env : Q(List (Val $χ))) (nt : Q(Neut $χ)) :
       obtain ⟨_, rfl⟩ := List.getElem?_eq_some_iff.mp ($this).symm
       congr 3
       exact env.eq_length
+      all_goals rfl
     )⟩
   | ~q(.app _ _ _ $nf $va) =>
     let ⟨vf, vfpost⟩ ← evalNeutTm q($env) q($nf)
@@ -409,7 +411,7 @@ partial def evalNeutTm (env : Q(List (Val $χ))) (nt : Q(Neut $χ)) :
       apply ValEqTm.conv_tm _ (eqt.subst env.wf_sb).symm_tm
       apply ValEqTm.conv_tp _ (eq.subst env.wf_sb).symm_tp
       convert ($vpost ($vfpost env nf) ($vapost env va)) using 1
-      autosubst
+      all_goals autosubst
     )⟩
   | ~q(.fst $k $k' $np) =>
     let ⟨vp, vppost⟩ ← evalNeutTm q($env) q($np)
@@ -432,7 +434,7 @@ partial def evalNeutTm (env : Q(List (Val $χ))) (nt : Q(Neut $χ)) :
       apply ValEqTm.conv_tm _ (eqt.subst env.wf_sb).symm_tm
       apply ValEqTm.conv_tp _ (eq.subst env.wf_sb).symm_tp
       convert ($vpost ($vppost env np_eq)) using 1
-      autosubst
+      all_goals autosubst
     )⟩
   | ~q(.idRec $k $k' $vA $va $cM $vr $vh) =>
     /- NOTE: the type arguments to `forceClos₂Tp`
@@ -479,7 +481,7 @@ partial def evalClosTp (vB : Q(Clos $χ)) (vt : Q(Val $χ)) :
       simp +zetaDelta only at vB
       rcases vB with ⟨env, Aeq, B⟩
       convert ($vpost (env.snoc B.wf_binder (vt.conv_tp Aeq.symm_tp)) B) using 1
-      autosubst
+      all_goals autosubst
     )⟩
   | ~q(.of_val $env $vB') => do
     let ⟨v, vpost⟩ ← evalValTp q($vt :: $env) q($vB')
@@ -489,7 +491,7 @@ partial def evalClosTp (vB : Q(Clos $χ)) (vt : Q(Val $χ)) :
       rcases vB with _ | ⟨env, Aeq, B⟩
       have := env.snoc B.wf_tp.wf_binder (vt.conv_tp Aeq.symm_tp)
       convert ($vpost this B) using 1
-      autosubst
+      all_goals autosubst
     )⟩
   | vB => throwError "expected a type closure, got{Lean.indentExpr vB}"
 
@@ -597,7 +599,7 @@ partial def evalClosTm (vb : Q(Clos $χ)) (vt : Q(Val $χ)) :
       have := env.snoc b.wf_binder (vt.conv_tp Aeq.symm_tp)
       have Beq := Beq.subst <| WfSb.toSb vt.wf_tm
       convert ($vpost this b |>.conv_tp (by convert Beq using 1; autosubst)) using 1
-      autosubst
+      all_goals autosubst
     )⟩
   | ~q(.of_val $env $vb') => do
     let ⟨v, vpost⟩ ← evalValTm q($vt :: $env) q($vb')
@@ -608,7 +610,7 @@ partial def evalClosTm (vb : Q(Clos $χ)) (vt : Q(Val $χ)) :
       have := env.snoc b.wf_tm.wf_binder (vt.conv_tp Aeq.symm_tp)
       have Beq := Beq.subst <| WfSb.toSb vt.wf_tm
       convert ($vpost this b |>.conv_tp (by convert Beq using 1; autosubst)) using 1
-      autosubst
+      all_goals autosubst
     )⟩
   | vB => throwError "expected a type closure, got{Lean.indentExpr vB}"
 
@@ -682,7 +684,6 @@ partial def evalApp (vf va : Q(Val $χ)) : TypecheckerM ((v : Q(Val $χ)) ×
       apply EqTm.cong_app (EqTp.refl_tp b.wf_tp) _ (EqTm.refl_tm va.wf_tm)
       apply EqTm.symm_tm; apply eqt.trans_tm
       apply EqTm.symm_tm; gcongr
-      assumption
     )⟩
   | ~q(.neut $n (.pi $k $k' $vA $vB)) => do
     let ⟨vBa, vBpost⟩ ← evalClosTp q($vB) q($va)
@@ -719,7 +720,7 @@ partial def evalFst (vp : Q(Val $χ)) : TypecheckerM ((v : Q(Val $χ)) ×
         apply EqTm.fst_pair Beq.wf_left t u |>.symm_tm.trans_tm
         gcongr
         apply EqTm.trans_tm _ eqt.symm_tm
-        gcongr <;> assumption
+        gcongr
       apply v.conv_nf (this.conv_eq Aeq) Aeq.symm_tp
     )⟩
   | ~q(.neut $n (.sigma $k $k' $vA $vB)) =>
@@ -753,14 +754,14 @@ partial def evalSnd (vp : Q(Val $χ)) : TypecheckerM ((v : Q(Val $χ)) ×
         apply EqTm.fst_pair Beq.wf_left t u |>.symm_tm.trans_tm
         gcongr
         apply EqTm.trans_tm _ eqt.symm_tm
-        gcongr <;> assumption
+        gcongr
       replace w := w.conv_tp <| Beq.symm_tp.subst_eq (EqSb.toSb feq)
       apply w.conv_tm
       apply EqTm.snd_pair Beq.wf_left t u |>.symm_tm.conv_eq
         (Beq'.wf_left.subst_eq (EqSb.toSb feq)) |>.trans_tm _
       apply EqTm.symm_tm; gcongr
       apply eqt.trans_tm
-      apply EqTm.symm_tm; gcongr <;> assumption
+      apply EqTm.symm_tm; gcongr
     )⟩
   | ~q(.neut $n (.sigma $k $k' $vA $vB)) => do
     let ⟨vf, vfpost⟩ ← evalFst q($vp)
@@ -805,7 +806,7 @@ partial def evalIdRec (l' : Q(Nat)) (cM : Q(Clos $χ)) (vr vh : Q(Val $χ)) :
         apply EqTm.symm_tm
         apply EqTm.cong_idRec (.refl_tm t) (.refl_tp M) (.refl_tm vr.wf_tm) tu
         refine ?eq
-        apply EqTm.trans_tm _ <| eqt.symm_tm.conv_eq _ <;> gcongr; assumption
+        apply EqTm.trans_tm _ <| eqt.symm_tm.conv_eq _ <;> gcongr
       . apply M.subst_eq <| EqSb.snoc (EqSb.toSb tu) (.Id_bvar t) (autosubst% ?eq)
     )⟩
   | ~q(.neut $nh (.Id $l $vA $va $vb)) => do
diff --git a/HoTTLean/Typechecker/Synth.lean b/HoTTLean/Typechecker/Synth.lean
index bbfc8ed7..770accfc 100644
--- a/HoTTLean/Typechecker/Synth.lean
+++ b/HoTTLean/Typechecker/Synth.lean
@@ -72,8 +72,11 @@ partial def lookupAxiom (E : Q(Axioms Lean.Name)) (c : Q(Lean.Name)) : Lean.Meta
         {Lean.indentD "="}\
           {Lean.indentExpr c |>.nest 2}"
   | ~q(CheckedAx.snocAxioms _) =>
-    let E ← Lean.Meta.unfoldDefinition E
-    lookupAxiom E c
+    let E' : Q(Axioms Lean.Name) ← Lean.Meta.unfoldDefinition E
+    have : $E' =Q $E := .unsafeIntro
+    match ← lookupAxiom E' c with
+    | .inl ⟨A, l, h⟩ => return .inl ⟨A, l, q($h)⟩
+    | .inr h => return .inr q($h)
   | _ => throwError "unsupported axiom environment{Lean.indentExpr E}"
 
 partial def checkAxiomsLe (E E' : Q(Axioms Lean.Name)) : Lean.MetaM Q($E ≤ $E') := do
@@ -104,8 +107,9 @@ variable (E : Q(Axioms Lean.Name)) (Ewf : Q(($E).Wf))
 
 partial def checkTp (vΓ : Q(TpEnv Lean.Name)) (l : Q(Nat)) (T : Q(Expr Lean.Name)) :
     TypecheckerM Q(∀ {Γ}, TpEnvEqCtx $E $vΓ Γ → $E ∣ Γ ⊢[$l] ($T)) :=
-  Lean.withTraceNode traceClsTypechecker (fun e =>
-    return m!"{Lean.exceptEmoji e} {vΓ} ⊢[{l}] {T}") do
+  Lean.withTraceNode (ε := Lean.Exception) traceClsTypechecker (fun
+    | .ok _ => return m!"✅️ {vΓ} ⊢[{l}] {T}"
+    | .error _ => return m!"❌️ {vΓ} ⊢[{l}] {T}") do
   let key := (⟨vΓ⟩, ⟨l⟩, ⟨T⟩)
   if let some pf := (← get).checkTp[key]? then return pf
   eventually (fun pf =>
@@ -165,8 +169,9 @@ partial def checkTm (vΓ : Q(TpEnv Lean.Name)) (l : Q(Nat))
     (vT : Q(Val Lean.Name)) (t : Q(Expr Lean.Name)) :
     TypecheckerM Q(∀ {Γ T}, TpEnvEqCtx $E $vΓ Γ → ValEqTp $E Γ $l $vT T →
       $E ∣ Γ ⊢[$l] ($t) : T) := do
-  Lean.withTraceNode traceClsTypechecker (fun e =>
-    return m!"{Lean.exceptEmoji e} {vΓ} ⊢[{l}] {t} ⇐ {vT}") do
+  Lean.withTraceNode (ε := Lean.Exception) traceClsTypechecker (fun
+    | .ok _ => return m!"✅️ {vΓ} ⊢[{l}] {t} ⇐ {vT}"
+    | .error _ => return m!"❌️ {vΓ} ⊢[{l}] {t} ⇐ {vT}") do
   let key := (⟨vΓ⟩, ⟨l⟩, ⟨vT⟩, ⟨t⟩)
   if let some pf := (← get).checkTm[key]? then return pf
   eventually (fun pf =>
diff --git a/HoTTLean/Typechecker/Value.lean b/HoTTLean/Typechecker/Value.lean
index f88be533..f2ddc000 100644
--- a/HoTTLean/Typechecker/Value.lean
+++ b/HoTTLean/Typechecker/Value.lean
@@ -274,8 +274,8 @@ theorem lookup_eq : ∀ {Δ Eᵥ σ Γ}, (env : EnvEqSb E Δ Eᵥ σ Γ) →
   case nil lk => cases lk
   case snoc E A v ih _ _ _ _ lk =>
     rcases lk with _ | ⟨_, lk⟩
-    . exact autosubst% v
-    . exact autosubst% ih lk
+    . convert v using 1 <;> first | rfl | autosubst
+    . convert ih lk using 1 <;> first | rfl | autosubst
 
 private lemma Expr.eq_snoc_get_zero (σ : Nat → Expr χ) :
     σ = Expr.snoc (Expr.comp σ Expr.wk) (σ 0) := by
@@ -298,9 +298,9 @@ theorem mk : ∀ {Γ}, WfCtx E Γ → ∀ {Δ} {Eᵥ : List (Val χ)} {σ},
       rw [Expr.eq_snoc_get_zero σ]
       apply EnvEqSb.snoc
       . refine ih Δ eq fun lk => ?_
-        exact autosubst% h (lk.succ ..)
+        convert h (lk.succ ..) using 1 <;> first | rfl | autosubst
       . assumption
-      . exact autosubst% h (Lookup.zero ..)
+      . convert h (Lookup.zero ..) using 1 <;> first | rfl | autosubst
 
 end EnvEqSb
 
@@ -311,11 +311,12 @@ private theorem wf_expr :
     (∀ {Γ l vt t A}, ValEqTm E Γ l vt t A → E ∣ Γ ⊢[l] t : A) ∧
     (∀ {Γ l vt t A}, NeutEqTm E Γ l vt t A → E ∣ Γ ⊢[l] t : A) ∧
     (∀ {Γ l l' A vB B}, ClosEqTp E Γ l l' A vB B → E ∣ (A, l) :: Γ ⊢[l'] B) ∧
-    (∀ {Γ A l B l' l'' cC C}, Clos₂EqTp E Γ A l B l' l'' cC C → E ∣ (B, l') :: (A, l) :: Γ ⊢[l''] C) ∧
+    (∀ {Γ A l B l' l'' cC C}, Clos₂EqTp E Γ A l B l' l'' cC C →
+      E ∣ (B, l') :: (A, l) :: Γ ⊢[l''] C) ∧
     (∀ {Γ l l' A B vb b}, ClosEqTm E Γ l l' A B vb b → E ∣ (A, l) :: Γ ⊢[l'] b : B) ∧
     (∀ {Γ Eᵥ σ Γ'}, EnvEqSb E Γ Eᵥ σ Γ' → WfSb E Γ σ Γ') := by
   mutual_induction ValEqTp
-  all_goals dsimp; intros
+  all_goals intros
   case ax => apply WfTm.ax <;> assumption
   case conv_tp => grind [EqTp.wf_right]
   case conv_nf tt' AA' _ => exact tt'.wf_right.conv AA'
@@ -496,7 +497,7 @@ private theorem wk_all :
     apply ValEqTm.pair this (iht C) (autosubst% ihu C)
   case conv_nf => grind [ValEqTm.conv_nf, EqTp.subst, EqTm.subst, WfSb.wk]
   case bvar Γ lk _ _ C =>
-    convert NeutEqTm.bvar (Γ.snoc C) (.succ _ lk) using 1; grind
+    convert NeutEqTm.bvar (Γ.snoc C) (.succ _ lk) using 1 <;> first | rfl | grind
   case app ihA ihf iha _ _ C =>
     exact autosubst% NeutEqTm.app (ihA C) (ihf C) (iha C)
   case snd ih _ _ C =>
diff --git a/HoTTLean/Typechecker/ValueInversion.lean b/HoTTLean/Typechecker/ValueInversion.lean
index 3707e4b9..5c213c1e 100644
--- a/HoTTLean/Typechecker/ValueInversion.lean
+++ b/HoTTLean/Typechecker/ValueInversion.lean
@@ -139,7 +139,7 @@ theorem ValEqTm.inv_neut {Γ vA A vt t l} : ValEqTm E Γ l (.neut vt vA) t A →
   all_goals grind [NeutEqTm.conv_neut, ValEqTp.conv_tp]
 
 theorem NeutEqTm.inv_ax {Γ C c vA t l₀} : NeutEqTm E Γ l₀ (.ax c vA) t C → ∃ Al,
-   l₀ = Al.val.2 ∧ E c = some Al ∧ ValEqTp E Γ Al.val.2 vA Al.val.1 ∧
+    l₀ = Al.val.2 ∧ E c = some Al ∧ ValEqTp E Γ Al.val.2 vA Al.val.1 ∧
     (E ∣ Γ ⊢[l₀] t ≡ .ax c Al.val.1 : C) ∧ (E ∣ Γ ⊢[l₀] C ≡ Al.val.1) := by
   suffices ∀ {Γ l₀ vt t C}, NeutEqTm E Γ l₀ vt t C → ∀ {c vA}, vt = .ax c vA → ∃ Al,
       l₀ = Al.val.2 ∧ E c = some Al ∧ ValEqTp E Γ Al.val.2 vA Al.val.1 ∧
@@ -203,10 +203,12 @@ theorem NeutEqTm.inv_fst {Γ C vp f l₀ l l'} : NeutEqTm E Γ l₀ (.fst l l' v
 
 theorem NeutEqTm.inv_snd {Γ C vp s l₀ l l'} : NeutEqTm E Γ l₀ (.snd l l' vp) s C →
     l₀ = l' ∧ ∃ A B p, NeutEqTm E Γ (max l l') vp p (.sigma l l' A B) ∧
-      (E ∣ Γ ⊢[l'] s ≡ .snd l l' A B p : C) ∧ (E ∣ Γ ⊢[l'] C ≡ B.subst (Expr.fst l l' A B p).toSb) := by
+       (E ∣ Γ ⊢[l'] s ≡ .snd l l' A B p : C) ∧
+       (E ∣ Γ ⊢[l'] C ≡ B.subst (Expr.fst l l' A B p).toSb) := by
   suffices ∀ {Γ l₀ vn n C}, NeutEqTm E Γ l₀ vn n C → ∀ {vp l l'}, vn = .snd l l' vp →
       l₀ = l' ∧ ∃ A B p, NeutEqTm E Γ (max l l') vp p (.sigma l l' A B) ∧
-      (E ∣ Γ ⊢[l'] n ≡ .snd l l' A B p : C) ∧ (E ∣ Γ ⊢[l'] C ≡ B.subst (Expr.fst l l' A B p).toSb) from
+       (E ∣ Γ ⊢[l'] n ≡ .snd l l' A B p : C) ∧
+       (E ∣ Γ ⊢[l'] C ≡ B.subst (Expr.fst l l' A B p).toSb) from
     fun h => this h rfl
   mutual_induction NeutEqTm
   all_goals intros; try exact True.intro
diff --git a/HoTTLeanTest.lean b/HoTTLeanTest.lean
new file mode 100644
index 00000000..af9d2503
--- /dev/null
+++ b/HoTTLeanTest.lean
@@ -0,0 +1,5 @@
+import HoTTLeanTest.basic
+import HoTTLeanTest.functorMap
+import HoTTLeanTest.import
+import HoTTLeanTest.hott0
+import HoTTLeanTest.unitt
diff --git a/test/basic.lean b/HoTTLeanTest/basic.lean
similarity index 97%
rename from test/basic.lean
rename to HoTTLeanTest/basic.lean
index 99b86d7e..31d22bc5 100644
--- a/test/basic.lean
+++ b/HoTTLeanTest/basic.lean
@@ -84,6 +84,6 @@ mltt noncomputable def c' : Cb := c
 
 /-! ## Using `sorry` -/
 
-/-- warning: declaration uses 'sorry' -/
+/-- warning: declaration uses `sorry` -/
 #guard_msgs in
 mltt def foo : Type := sorry
diff --git a/HoTTLeanTest/functorMap.lean b/HoTTLeanTest/functorMap.lean
new file mode 100644
index 00000000..b6c75e16
--- /dev/null
+++ b/HoTTLeanTest/functorMap.lean
@@ -0,0 +1,38 @@
+import HoTTLean.ForMathlib.Tactic.CategoryTheory.FunctorMap
+
+/-!
+# Tests for `functor_map`
+
+Check the generated declarations, nested attributes, and term elaborator with independent
+object and morphism universes in the source and target categories.
+-/
+
+universe v₁ u₁ v₂ u₂
+
+namespace CategoryTheory.FunctorMapTest
+
+variable {C : Type u₁} [Category.{v₁} C]
+
+@[functor_map (attr := reassoc (attr := simp))]
+theorem comp_id_of_eq {X Y : C} (f g : X ⟶ Y) (h : f = g) : f ≫ 𝟙 Y = g := by
+  simpa using h
+
+run_cmd do
+  let env ← Lean.getEnv
+  for name in [``comp_id_of_eq_functor_map, ``comp_id_of_eq_functor_map_assoc] do
+    unless (Lean.Meta.simpExtension.getState env).lemmaNames.contains (.decl name) do
+      throwError "missing simp attribute on {name}"
+
+variable {D : Type u₂} [Category.{v₂} D] (F : C ⥤ D)
+
+example {X Y : C} (f g : X ⟶ Y) (h : f = g) : F.map f = F.map g :=
+  comp_id_of_eq_functor_map f g h F
+
+example {X Y : C} (f g : X ⟶ Y) (h : f = g) {Z : D} (k : F.obj Y ⟶ Z) :
+    F.map f ≫ k = F.map g ≫ k :=
+  comp_id_of_eq_functor_map_assoc f g h F k
+
+example {X Y : C} (f g : X ⟶ Y) (h : f = g) : F.map f = F.map g :=
+  (functor_map_of% (comp_id_of_eq f g h)) F
+
+end CategoryTheory.FunctorMapTest
diff --git a/test/hott0.lean b/HoTTLeanTest/hott0.lean
similarity index 100%
rename from test/hott0.lean
rename to HoTTLeanTest/hott0.lean
diff --git a/test/import.lean b/HoTTLeanTest/import.lean
similarity index 81%
rename from test/import.lean
rename to HoTTLeanTest/import.lean
index aab44aca..17148e1f 100644
--- a/test/import.lean
+++ b/HoTTLeanTest/import.lean
@@ -1,4 +1,4 @@
-import test.basic
+import HoTTLeanTest.basic
 
 /-! Test importing a theory. -/
 
diff --git a/test/unitt.lean b/HoTTLeanTest/unitt.lean
similarity index 65%
rename from test/unitt.lean
rename to HoTTLeanTest/unitt.lean
index 9024b7b1..26c8a895 100644
--- a/test/unitt.lean
+++ b/HoTTLeanTest/unitt.lean
@@ -1,6 +1,6 @@
 import HoTTLean.Frontend.Commands
-import HoTTLean.Model.Interpretation
-import HoTTLean.Groupoids.NaturalModelBase
+import HoTTLean.Model.Unstructured.Interpretation
+import HoTTLean.Groupoids.UHom
 import HoTTLean.Groupoids.Pi
 import HoTTLean.Groupoids.Sigma
 import HoTTLean.Groupoids.Id
@@ -29,29 +29,24 @@ unitt def uniq_fn {A : Type} (f g : A → Unit) : Identity f g := by
 /-! ## Interpretation -/
 
 open SynthLean
-open CategoryTheory MonoidalCategory NaturalModel Universe GroupoidModel
-
-instance : uHomSeq.IdSeq := sorry
+open CategoryTheory MonoidalCategory Model.UnstructuredUniverse GroupoidModel ChosenTerminal
 
 theorem slen : univMax ≤ uHomSeq.length := by grind [uHomSeq, univMax]
 
-def Groupoid.asTy (G : Type 0) [Groupoid.{0,0} G] : y(𝟙_ Ctx) ⟶ uHomSeq[0].Ty :=
-  yonedaEquiv.symm <| ULift.up {
-      obj _ := Core.mk <| ULift.up <| Grpd.of G
-      map _ := CoreHom.mk <| Iso.refl _
-    }
+def Groupoid.asTy (G : Type 0) [Groupoid.{0,0} G] : (𝟭_ Ctx) ⟶ uHomSeq[0].Ty :=
+  GroupoidModel.toCoreAsSmallEquiv.symm ((Functor.const _).obj (Grpd.of G))
 
-def sUnit : y(𝟙_ Ctx) ⟶ uHomSeq[0].Ty :=
+def sUnit : (𝟭_ Ctx) ⟶ uHomSeq[0].Ty :=
   Groupoid.asTy (Discrete _root_.Unit)
 
-def sUnit' : y(𝟙_ Ctx) ⟶ uHomSeq[1].Tm :=
+def sUnit' : (𝟭_ Ctx) ⟶ uHomSeq[1].Tm :=
   uHomSeq.code (Nat.zero_lt_succ _) sUnit
 
 @[simp]
-def sUnit'_tp : sUnit' ≫ uHomSeq[1].tp = (uHomSeq.homSucc 0).wkU _ := by
-  simp [sUnit']
+theorem sUnit'_tp : sUnit' ≫ uHomSeq[1].tp = (uHomSeq.homSucc 0).wkU _ := by
+  exact uHomSeq.code_tp _ _
 
-def I : Universe.Interpretation Lean.Name uHomSeq where
+def I : Interpretation Lean.Name uHomSeq where
   ax := fun
     | ``Unit, 1, _ => some sUnit'
     | _, _, _ => none
@@ -65,7 +60,10 @@ theorem I_wf : I.Wf slen Unit.snocAxioms where
     subst_vars
     unfold Unit
     simp [I, Interpretation.ofType, UHomSeq.nilCObj]
-    rfl
+    -- The axiom lookup proof contains reducible dependent projections.
+    set_option backward.isDefEq.respectTransparency false in
+      simp [Part.mem_assert_iff]
+    exact sUnit'_tp
 
 instance : Fact (I.Wf slen Unit.snocAxioms) := ⟨I_wf⟩
 
@@ -73,4 +71,4 @@ example : I.interpTm Unit.wf_val = sUnit' := by
   unfold Interpretation.interpTm Interpretation.ofTerm CheckedAx.val I Unit
   simp only [Part.pure_eq_some, Part.get_some]
   conv => rhs; rw [← Category.id_comp sUnit']
-  congr 1; apply Limits.IsTerminal.hom_ext ChosenTerminal.isTerminal_yUnit
+  congr 1
diff --git a/README.md b/README.md
index 4d899b32..456763d3 100644
--- a/README.md
+++ b/README.md
@@ -6,14 +6,15 @@ together with a proof mode for developing mathematics synthetically in those typ
 HoTTLean is work-in-progress.
 
 It currently contains the following components:
+
 - A deep embedding of MLTT syntax with Π, Σ, Id types, and base constants (`HoTTLean.Syntax`).
 - **SynthLean**, a proof assistant for these deeply embedded theories
   (`HoTTLean.Frontend`).
   It includes a certifying typechecker (`HoTTLean.Typechecker`).
 - Natural model semantics of MLTT in presheaf categories (`HoTTLean.Model`)
   and a proof that this semantics is sound for the syntax (`ofType_ofTerm_sound`).
-
-- A `sorry`-free construction of the groupoid model of type theory with Π, Σ, Id types (`HoTTLean.Groupoids`).
+- A `sorry`-free construction of the groupoid model of type theory with Π, Σ, Id types
+  (`HoTTLean.Groupoids`).
 - Pieces of general mathematics and category theory
   such as the Grothendieck construction for groupoids
   (`HoTTLean.ForMathlib`, `HoTTLean.Grothendieck`, `HoTTLean.Pointed`).
@@ -23,7 +24,8 @@ Documentation of the Lean code can be found
 [here](https://sinhp.github.io/HoTTLean/docs/).
 (We also have [a blueprint](https://sinhp.github.io/HoTTLean/),
 but it is very outdated.)
-Relevant papers to this project are listed below
+Relevant papers to this project are listed below:
+
 - [A Certifying Proof Assistant for Synthetic
 Mathematics in Lean](https://voidma.in/assets/papers/2026nawrocki_certifying_proof_assistant_synthetic_mathematics_lean.pdf)
 - [Path Types in Algebraic Type Theory](https://arxiv.org/abs/2601.06567v1)
@@ -35,6 +37,13 @@ We rely on [Mathlib](https://github.com/leanprover-community/mathlib4)
 and [Poly](https://github.com/sinhp/Poly/),
 a formalization of polynomial functors.
 
+The project uses Lean and Mathlib v4.34.1.
+The required Lean version is recorded in [`lean-toolchain`](lean-toolchain),
+and dependency revisions are pinned in `lake-manifest.json`.
+The Poly dependency currently uses the Lean v4.34.1 port from
+[`sosudo/Poly`](https://github.com/sosudo/Poly/), proposed in
+[Poly PR #41](https://github.com/sinhp/Poly/pull/41).
+
 ### How can I try out HoTTLean?
 
 First make sure that [Lean is installed](https://lean-lang.org/install/).
@@ -46,15 +55,18 @@ then in a terminal execute
 lake exe cache get
 # Build the project
 lake build
+# Build the alternative natural model
+lake build NaturalModel
 # Run tests (optional)
 lake test
 ```
 
-Examples demonstrating the usage of SynthLean (for internal reasoning)
-and of our model definitions (for external reasoning)
-can be found under `test/`:
-- `test/unitt` specifies a type theory with a unit type.
-- `test/hott0` defines HoTT0,
+Examples demonstrating SynthLean and our model definitions are in `HoTTLeanTest/`.
+These are checked by `lake test`, including an interpretation of the unit type
+in the groupoid model:
+
+- [`HoTTLeanTest/unitt.lean`](HoTTLeanTest/unitt.lean) specifies a type theory with a unit type.
+- [`HoTTLeanTest/hott0.lean`](HoTTLeanTest/hott0.lean) defines HoTT0,
   a version of HoTT where univalence only holds for h-sets.
 
 ### Can I contribute to HoTTLean?
diff --git a/home_page/_site/404.html b/home_page/_site/404.html
deleted file mode 100644
index 0d983fdc..00000000
--- a/home_page/_site/404.html
+++ /dev/null
@@ -1,90 +0,0 @@
-<!DOCTYPE html>
-<html lang="en-US">
-
-<head>
-  <meta charset="UTF-8">
-
-  <!-- Begin Jekyll SEO tag v2.8.0 -->
-<title>Groupoid Model of HoTT in Lean 4 | by S. Awodey, M. Carneiro, S. Hazratpour, J. Hua, W. Nawrocki, S. Woolfson</title>
-<meta name="generator" content="Jekyll v3.9.2" />
-<meta property="og:title" content="Groupoid Model of HoTT in Lean 4" />
-<meta property="og:locale" content="en_US" />
-<meta name="description" content="by S. Awodey, M. Carneiro, S. Hazratpour, J. Hua, W. Nawrocki, S. Woolfson" />
-<meta property="og:description" content="by S. Awodey, M. Carneiro, S. Hazratpour, J. Hua, W. Nawrocki, S. Woolfson" />
-<link rel="canonical" href="http://localhost:4000/404.html" />
-<meta property="og:url" content="http://localhost:4000/404.html" />
-<meta property="og:site_name" content="Groupoid Model of HoTT in Lean 4" />
-<meta property="og:type" content="website" />
-<meta name="twitter:card" content="summary" />
-<meta property="twitter:title" content="Groupoid Model of HoTT in Lean 4" />
-<script type="application/ld+json">
-{"@context":"https://schema.org","@type":"WebPage","description":"by S. Awodey, M. Carneiro, S. Hazratpour, J. Hua, W. Nawrocki, S. Woolfson","headline":"Groupoid Model of HoTT in Lean 4","url":"http://localhost:4000/404.html"}</script>
-<!-- End Jekyll SEO tag -->
-
-  <link rel="preconnect" href="https://fonts.gstatic.com">
-  <link rel="preload" href="https://fonts.googleapis.com/css?family=Open+Sans:400,700&display=swap" as="style"
-    type="text/css" crossorigin>
-  <meta name="viewport" content="width=device-width, initial-scale=1">
-  <meta name="theme-color" content="#157878">
-  <meta name="apple-mobile-web-app-status-bar-style" content="black-translucent">
-  
-  <link rel="stylesheet" href="/assets/css/style.css?v=940c502b710098d4daa8ab0ddcbdd354ce3727a1">
-  
-  <!-- start custom head snippets, customize with your own _includes/head-custom.html file -->
-
-<!-- Setup Google Analytics -->
-
-
-
-<!-- You can set your favicon here -->
-<!-- link rel="shortcut icon" type="image/x-icon" href="/favicon.ico" -->
-
-<!-- end custom head snippets -->
-
-</head>
-
-<body>
-  <a id="skip-to-content" href="#content">Skip to the content.</a>
-
-  <header class="page-header" role="banner">
-    <h1 class="project-name">Groupoid Model of HoTT in Lean 4</h1>
-    <h2 class="project-tagline">by S. Awodey, M. Carneiro, S. Hazratpour, J. Hua, W. Nawrocki, S. Woolfson</h2>
-    <a href="blueprint" class="btn">Blueprint (web)</a>
-    <a href="docs" class="btn">Documentation</a>
-    
-    <a href="https://github.com/sinhp/groupoid_model_in_lean4" class="btn">GitHub</a>
-    
-  </header>
-
-  <main id="content" class="main-content" role="main">
-    <style type="text/css" media="screen">
-  .container {
-    margin: 10px auto;
-    max-width: 600px;
-    text-align: center;
-  }
-  h1 {
-    margin: 30px 0;
-    font-size: 4em;
-    line-height: 1;
-    letter-spacing: -1px;
-  }
-</style>
-
-<div class="container">
-  <h1>404</h1>
-
-  <p><strong>Page not found :(</strong></p>
-  <p>The requested page could not be found.</p>
-</div>
-
-    <footer class="site-footer">
-      
-      <span class="site-footer-owner"><a href="https://github.com/sinhp/groupoid_model_in_lean4">groupoid_model_in_lean4</a>
-	is maintained by <a href="https://sinhp.github.io">Sina Hazratpour</a>. Visit the GitHub repository for more information.</span>
-      
-    </footer>
-  </main>
-</body>
-
-</html>
diff --git a/home_page/_site/assets/css/style.css b/home_page/_site/assets/css/style.css
deleted file mode 100644
index 5647b980..00000000
--- a/home_page/_site/assets/css/style.css
+++ /dev/null
@@ -1,327 +0,0 @@
-/* In this file you can add css rules overriding rules defined by your Jekyll theme.  */
-/* Import the CSS from the specified theme */
-/*! normalize.css v3.0.2 | MIT License | git.io/normalize */
-/** 1. Set default font family to sans-serif. 2. Prevent iOS text size adjust after orientation change, without disabling user zoom. */
-@import url("https://fonts.googleapis.com/css?family=Open+Sans:400,700&display=swap");
-html { font-family: sans-serif; /* 1 */ -ms-text-size-adjust: 100%; /* 2 */ -webkit-text-size-adjust: 100%; /* 2 */ }
-
-/** Remove default margin. */
-body { margin: 0; }
-
-/* HTML5 display definitions ========================================================================== */
-/** Correct `block` display not defined for any HTML5 element in IE 8/9. Correct `block` display not defined for `details` or `summary` in IE 10/11 and Firefox. Correct `block` display not defined for `main` in IE 11. */
-article, aside, details, figcaption, figure, footer, header, hgroup, main, menu, nav, section, summary { display: block; }
-
-/** 1. Correct `inline-block` display not defined in IE 8/9. 2. Normalize vertical alignment of `progress` in Chrome, Firefox, and Opera. */
-audio, canvas, progress, video { display: inline-block; /* 1 */ vertical-align: baseline; /* 2 */ }
-
-/** Prevent modern browsers from displaying `audio` without controls. Remove excess height in iOS 5 devices. */
-audio:not([controls]) { display: none; height: 0; }
-
-/** Address `[hidden]` styling not present in IE 8/9/10. Hide the `template` element in IE 8/9/11, Safari, and Firefox < 22. */
-[hidden], template { display: none; }
-
-/* Links ========================================================================== */
-/** Remove the gray background color from active links in IE 10. */
-a { background-color: transparent; }
-
-/** Improve readability when focused and also mouse hovered in all browsers. */
-a:active, a:hover { outline: 0; }
-
-/* Text-level semantics ========================================================================== */
-/** Address styling not present in IE 8/9/10/11, Safari, and Chrome. */
-abbr[title] { border-bottom: 1px dotted; }
-
-/** Address style set to `bolder` in Firefox 4+, Safari, and Chrome. */
-b, strong { font-weight: bold; }
-
-/** Address styling not present in Safari and Chrome. */
-dfn { font-style: italic; }
-
-/** Address variable `h1` font-size and margin within `section` and `article` contexts in Firefox 4+, Safari, and Chrome. */
-h1 { font-size: 2em; margin: 0.67em 0; }
-
-/** Address styling not present in IE 8/9. */
-mark { background: #ff0; color: #000; }
-
-/** Address inconsistent and variable font size in all browsers. */
-small { font-size: 80%; }
-
-/** Prevent `sub` and `sup` affecting `line-height` in all browsers. */
-sub, sup { font-size: 75%; line-height: 0; position: relative; vertical-align: baseline; }
-
-sup { top: -0.5em; }
-
-sub { bottom: -0.25em; }
-
-/* Embedded content ========================================================================== */
-/** Remove border when inside `a` element in IE 8/9/10. */
-img { border: 0; }
-
-/** Correct overflow not hidden in IE 9/10/11. */
-svg:not(:root) { overflow: hidden; }
-
-/* Grouping content ========================================================================== */
-/** Address margin not present in IE 8/9 and Safari. */
-figure { margin: 1em 40px; }
-
-/** Address differences between Firefox and other browsers. */
-hr { box-sizing: content-box; height: 0; }
-
-/** Contain overflow in all browsers. */
-pre { overflow: auto; }
-
-/** Address odd `em`-unit font size rendering in all browsers. */
-code, kbd, pre, samp { font-family: monospace, monospace; font-size: 1em; }
-
-/* Forms ========================================================================== */
-/** Known limitation: by default, Chrome and Safari on OS X allow very limited styling of `select`, unless a `border` property is set. */
-/** 1. Correct color not being inherited. Known issue: affects color of disabled elements. 2. Correct font properties not being inherited. 3. Address margins set differently in Firefox 4+, Safari, and Chrome. */
-button, input, optgroup, select, textarea { color: inherit; /* 1 */ font: inherit; /* 2 */ margin: 0; /* 3 */ }
-
-/** Address `overflow` set to `hidden` in IE 8/9/10/11. */
-button { overflow: visible; }
-
-/** Address inconsistent `text-transform` inheritance for `button` and `select`. All other form control elements do not inherit `text-transform` values. Correct `button` style inheritance in Firefox, IE 8/9/10/11, and Opera. Correct `select` style inheritance in Firefox. */
-button, select { text-transform: none; }
-
-/** 1. Avoid the WebKit bug in Android 4.0.* where (2) destroys native `audio` and `video` controls. 2. Correct inability to style clickable `input` types in iOS. 3. Improve usability and consistency of cursor style between image-type `input` and others. */
-button, html input[type="button"], input[type="reset"], input[type="submit"] { -webkit-appearance: button; /* 2 */ cursor: pointer; /* 3 */ }
-
-/** Re-set default cursor for disabled elements. */
-button[disabled], html input[disabled] { cursor: default; }
-
-/** Remove inner padding and border in Firefox 4+. */
-button::-moz-focus-inner, input::-moz-focus-inner { border: 0; padding: 0; }
-
-/** Address Firefox 4+ setting `line-height` on `input` using `!important` in the UA stylesheet. */
-input { line-height: normal; }
-
-/** It's recommended that you don't attempt to style these elements. Firefox's implementation doesn't respect box-sizing, padding, or width.  1. Address box sizing set to `content-box` in IE 8/9/10. 2. Remove excess padding in IE 8/9/10. */
-input[type="checkbox"], input[type="radio"] { box-sizing: border-box; /* 1 */ padding: 0; /* 2 */ }
-
-/** Fix the cursor style for Chrome's increment/decrement buttons. For certain `font-size` values of the `input`, it causes the cursor style of the decrement button to change from `default` to `text`. */
-input[type="number"]::-webkit-inner-spin-button, input[type="number"]::-webkit-outer-spin-button { height: auto; }
-
-/** 1. Address `appearance` set to `searchfield` in Safari and Chrome. 2. Address `box-sizing` set to `border-box` in Safari and Chrome (include `-moz` to future-proof). */
-input[type="search"] { -webkit-appearance: textfield; /* 1 */ /* 2 */ box-sizing: content-box; }
-
-/** Remove inner padding and search cancel button in Safari and Chrome on OS X. Safari (but not Chrome) clips the cancel button when the search input has padding (and `textfield` appearance). */
-input[type="search"]::-webkit-search-cancel-button, input[type="search"]::-webkit-search-decoration { -webkit-appearance: none; }
-
-/** Define consistent border, margin, and padding. */
-fieldset { border: 1px solid #c0c0c0; margin: 0 2px; padding: 0.35em 0.625em 0.75em; }
-
-/** 1. Correct `color` not being inherited in IE 8/9/10/11. 2. Remove padding so people aren't caught out if they zero out fieldsets. */
-legend { border: 0; /* 1 */ padding: 0; /* 2 */ }
-
-/** Remove default vertical scrollbar in IE 8/9/10/11. */
-textarea { overflow: auto; }
-
-/** Don't inherit the `font-weight` (applied by a rule above). NOTE: the default cannot safely be changed in Chrome and Safari on OS X. */
-optgroup { font-weight: bold; }
-
-/* Tables ========================================================================== */
-/** Remove most spacing between table cells. */
-table { border-collapse: collapse; border-spacing: 0; }
-
-td, th { padding: 0; }
-
-.highlight table td { padding: 5px; }
-
-.highlight table pre { margin: 0; }
-
-.highlight .cm { color: #999988; font-style: italic; }
-
-.highlight .cp { color: #999999; font-weight: bold; }
-
-.highlight .c1 { color: #999988; font-style: italic; }
-
-.highlight .cs { color: #999999; font-weight: bold; font-style: italic; }
-
-.highlight .c, .highlight .cd { color: #999988; font-style: italic; }
-
-.highlight .err { color: #a61717; background-color: #e3d2d2; }
-
-.highlight .gd { color: #000000; background-color: #ffdddd; }
-
-.highlight .ge { color: #000000; font-style: italic; }
-
-.highlight .gr { color: #aa0000; }
-
-.highlight .gh { color: #999999; }
-
-.highlight .gi { color: #000000; background-color: #ddffdd; }
-
-.highlight .go { color: #888888; }
-
-.highlight .gp { color: #555555; }
-
-.highlight .gs { font-weight: bold; }
-
-.highlight .gu { color: #aaaaaa; }
-
-.highlight .gt { color: #aa0000; }
-
-.highlight .kc { color: #000000; font-weight: bold; }
-
-.highlight .kd { color: #000000; font-weight: bold; }
-
-.highlight .kn { color: #000000; font-weight: bold; }
-
-.highlight .kp { color: #000000; font-weight: bold; }
-
-.highlight .kr { color: #000000; font-weight: bold; }
-
-.highlight .kt { color: #445588; font-weight: bold; }
-
-.highlight .k, .highlight .kv { color: #000000; font-weight: bold; }
-
-.highlight .mf { color: #009999; }
-
-.highlight .mh { color: #009999; }
-
-.highlight .il { color: #009999; }
-
-.highlight .mi { color: #009999; }
-
-.highlight .mo { color: #009999; }
-
-.highlight .m, .highlight .mb, .highlight .mx { color: #009999; }
-
-.highlight .sb { color: #d14; }
-
-.highlight .sc { color: #d14; }
-
-.highlight .sd { color: #d14; }
-
-.highlight .s2 { color: #d14; }
-
-.highlight .se { color: #d14; }
-
-.highlight .sh { color: #d14; }
-
-.highlight .si { color: #d14; }
-
-.highlight .sx { color: #d14; }
-
-.highlight .sr { color: #009926; }
-
-.highlight .s1 { color: #d14; }
-
-.highlight .ss { color: #990073; }
-
-.highlight .s { color: #d14; }
-
-.highlight .na { color: #008080; }
-
-.highlight .bp { color: #999999; }
-
-.highlight .nb { color: #0086B3; }
-
-.highlight .nc { color: #445588; font-weight: bold; }
-
-.highlight .no { color: #008080; }
-
-.highlight .nd { color: #3c5d5d; font-weight: bold; }
-
-.highlight .ni { color: #800080; }
-
-.highlight .ne { color: #990000; font-weight: bold; }
-
-.highlight .nf { color: #990000; font-weight: bold; }
-
-.highlight .nl { color: #990000; font-weight: bold; }
-
-.highlight .nn { color: #555555; }
-
-.highlight .nt { color: #000080; }
-
-.highlight .vc { color: #008080; }
-
-.highlight .vg { color: #008080; }
-
-.highlight .vi { color: #008080; }
-
-.highlight .nv { color: #008080; }
-
-.highlight .ow { color: #000000; font-weight: bold; }
-
-.highlight .o { color: #000000; font-weight: bold; }
-
-.highlight .w { color: #bbbbbb; }
-
-.highlight { background-color: #f8f8f8; }
-
-* { box-sizing: border-box; }
-
-body { padding: 0; margin: 0; font-family: "Open Sans", "Helvetica Neue", Helvetica, Arial, sans-serif; font-size: 16px; line-height: 1.5; color: #606c71; }
-
-#skip-to-content { height: 1px; width: 1px; position: absolute; overflow: hidden; top: -10px; }
-#skip-to-content:focus { position: fixed; top: 10px; left: 10px; height: auto; width: auto; background: #e19447; outline: thick solid #e19447; }
-
-a { color: #1e6bb8; text-decoration: none; }
-a:hover { text-decoration: underline; }
-
-.btn { display: inline-block; margin-bottom: 1rem; color: rgba(255, 255, 255, 0.7); background-color: rgba(255, 255, 255, 0.08); border-color: rgba(255, 255, 255, 0.2); border-style: solid; border-width: 1px; border-radius: 0.3rem; transition: color 0.2s, background-color 0.2s, border-color 0.2s; }
-.btn:hover { color: rgba(255, 255, 255, 0.8); text-decoration: none; background-color: rgba(255, 255, 255, 0.2); border-color: rgba(255, 255, 255, 0.3); }
-.btn + .btn { margin-left: 1rem; }
-@media screen and (min-width: 64em) { .btn { padding: 0.75rem 1rem; } }
-@media screen and (min-width: 42em) and (max-width: 64em) { .btn { padding: 0.6rem 0.9rem; font-size: 0.9rem; } }
-@media screen and (max-width: 42em) { .btn { display: block; width: 100%; padding: 0.75rem; font-size: 0.9rem; }
-  .btn + .btn { margin-top: 1rem; margin-left: 0; } }
-
-.page-header { color: #fff; text-align: center; background-color: #159957; background-image: linear-gradient(120deg, #155799, #159957); }
-@media screen and (min-width: 64em) { .page-header { padding: 5rem 6rem; } }
-@media screen and (min-width: 42em) and (max-width: 64em) { .page-header { padding: 3rem 4rem; } }
-@media screen and (max-width: 42em) { .page-header { padding: 2rem 1rem; } }
-
-.project-name { margin-top: 0; margin-bottom: 0.1rem; }
-@media screen and (min-width: 64em) { .project-name { font-size: 3.25rem; } }
-@media screen and (min-width: 42em) and (max-width: 64em) { .project-name { font-size: 2.25rem; } }
-@media screen and (max-width: 42em) { .project-name { font-size: 1.75rem; } }
-
-.project-tagline { margin-bottom: 2rem; font-weight: normal; opacity: 0.7; }
-@media screen and (min-width: 64em) { .project-tagline { font-size: 1.25rem; } }
-@media screen and (min-width: 42em) and (max-width: 64em) { .project-tagline { font-size: 1.15rem; } }
-@media screen and (max-width: 42em) { .project-tagline { font-size: 1rem; } }
-
-.main-content { word-wrap: break-word; }
-.main-content :first-child { margin-top: 0; }
-@media screen and (min-width: 64em) { .main-content { max-width: 64rem; padding: 2rem 6rem; margin: 0 auto; font-size: 1.1rem; } }
-@media screen and (min-width: 42em) and (max-width: 64em) { .main-content { padding: 2rem 4rem; font-size: 1.1rem; } }
-@media screen and (max-width: 42em) { .main-content { padding: 2rem 1rem; font-size: 1rem; } }
-.main-content kbd { background-color: #fafbfc; border: 1px solid #c6cbd1; border-bottom-color: #959da5; border-radius: 3px; box-shadow: inset 0 -1px 0 #959da5; color: #444d56; display: inline-block; font-size: 11px; line-height: 10px; padding: 3px 5px; vertical-align: middle; }
-.main-content img { max-width: 100%; }
-.main-content h1, .main-content h2, .main-content h3, .main-content h4, .main-content h5, .main-content h6 { margin-top: 2rem; margin-bottom: 1rem; font-weight: normal; color: #159957; }
-.main-content p { margin-bottom: 1em; }
-.main-content code { padding: 2px 4px; font-family: Consolas, "Liberation Mono", Menlo, Courier, monospace; font-size: 0.9rem; color: #567482; background-color: #f3f6fa; border-radius: 0.3rem; }
-.main-content pre { padding: 0.8rem; margin-top: 0; margin-bottom: 1rem; font: 1rem Consolas, "Liberation Mono", Menlo, Courier, monospace; color: #567482; word-wrap: normal; background-color: #f3f6fa; border: solid 1px #dce6f0; border-radius: 0.3rem; }
-.main-content pre > code { padding: 0; margin: 0; font-size: 0.9rem; color: #567482; word-break: normal; white-space: pre; background: transparent; border: 0; }
-.main-content .highlight { margin-bottom: 1rem; }
-.main-content .highlight pre { margin-bottom: 0; word-break: normal; }
-.main-content .highlight pre, .main-content pre { padding: 0.8rem; overflow: auto; font-size: 0.9rem; line-height: 1.45; border-radius: 0.3rem; -webkit-overflow-scrolling: touch; }
-.main-content pre code, .main-content pre tt { display: inline; max-width: initial; padding: 0; margin: 0; overflow: initial; line-height: inherit; word-wrap: normal; background-color: transparent; border: 0; }
-.main-content pre code:before, .main-content pre code:after, .main-content pre tt:before, .main-content pre tt:after { content: normal; }
-.main-content ul, .main-content ol { margin-top: 0; }
-.main-content blockquote { padding: 0 1rem; margin-left: 0; color: #819198; border-left: 0.3rem solid #dce6f0; }
-.main-content blockquote > :first-child { margin-top: 0; }
-.main-content blockquote > :last-child { margin-bottom: 0; }
-.main-content table { display: block; width: 100%; overflow: auto; word-break: normal; word-break: keep-all; -webkit-overflow-scrolling: touch; }
-.main-content table th { font-weight: bold; }
-.main-content table th, .main-content table td { padding: 0.5rem 1rem; border: 1px solid #e9ebec; }
-.main-content dl { padding: 0; }
-.main-content dl dt { padding: 0; margin-top: 1rem; font-size: 1rem; font-weight: bold; }
-.main-content dl dd { padding: 0; margin-bottom: 1rem; }
-.main-content hr { height: 2px; padding: 0; margin: 1rem 0; background-color: #eff0f1; border: 0; }
-
-.site-footer { padding-top: 2rem; margin-top: 2rem; border-top: solid 1px #eff0f1; }
-@media screen and (min-width: 64em) { .site-footer { font-size: 1rem; } }
-@media screen and (min-width: 42em) and (max-width: 64em) { .site-footer { font-size: 1rem; } }
-@media screen and (max-width: 42em) { .site-footer { font-size: 0.9rem; } }
-
-.site-footer-owner { display: block; font-weight: bold; }
-
-.site-footer-credits { color: #819198; }
-
-/* Put your rules below this line */
diff --git a/home_page/_site/index.html b/home_page/_site/index.html
deleted file mode 100644
index 5e1110cf..00000000
--- a/home_page/_site/index.html
+++ /dev/null
@@ -1,80 +0,0 @@
-<!DOCTYPE html>
-<html lang="en-US">
-
-<head>
-  <meta charset="UTF-8">
-
-  <!-- Begin Jekyll SEO tag v2.8.0 -->
-<title>Groupoid Model of HoTT in Lean 4 | by S. Awodey, M. Carneiro, S. Hazratpour, J. Hua, W. Nawrocki, S. Woolfson</title>
-<meta name="generator" content="Jekyll v3.9.2" />
-<meta property="og:title" content="Groupoid Model of HoTT in Lean 4" />
-<meta property="og:locale" content="en_US" />
-<meta name="description" content="by S. Awodey, M. Carneiro, S. Hazratpour, J. Hua, W. Nawrocki, S. Woolfson" />
-<meta property="og:description" content="by S. Awodey, M. Carneiro, S. Hazratpour, J. Hua, W. Nawrocki, S. Woolfson" />
-<link rel="canonical" href="http://localhost:4000/" />
-<meta property="og:url" content="http://localhost:4000/" />
-<meta property="og:site_name" content="Groupoid Model of HoTT in Lean 4" />
-<meta property="og:type" content="website" />
-<meta name="twitter:card" content="summary" />
-<meta property="twitter:title" content="Groupoid Model of HoTT in Lean 4" />
-<script type="application/ld+json">
-{"@context":"https://schema.org","@type":"WebSite","description":"by S. Awodey, M. Carneiro, S. Hazratpour, J. Hua, W. Nawrocki, S. Woolfson","headline":"Groupoid Model of HoTT in Lean 4","name":"Groupoid Model of HoTT in Lean 4","url":"http://localhost:4000/"}</script>
-<!-- End Jekyll SEO tag -->
-
-  <link rel="preconnect" href="https://fonts.gstatic.com">
-  <link rel="preload" href="https://fonts.googleapis.com/css?family=Open+Sans:400,700&display=swap" as="style"
-    type="text/css" crossorigin>
-  <meta name="viewport" content="width=device-width, initial-scale=1">
-  <meta name="theme-color" content="#157878">
-  <meta name="apple-mobile-web-app-status-bar-style" content="black-translucent">
-  
-  <link rel="stylesheet" href="/assets/css/style.css?v=940c502b710098d4daa8ab0ddcbdd354ce3727a1">
-  
-  <!-- start custom head snippets, customize with your own _includes/head-custom.html file -->
-
-<!-- Setup Google Analytics -->
-
-
-
-<!-- You can set your favicon here -->
-<!-- link rel="shortcut icon" type="image/x-icon" href="/favicon.ico" -->
-
-<!-- end custom head snippets -->
-
-</head>
-
-<body>
-  <a id="skip-to-content" href="#content">Skip to the content.</a>
-
-  <header class="page-header" role="banner">
-    <h1 class="project-name">Groupoid Model of HoTT in Lean 4</h1>
-    <h2 class="project-tagline">by S. Awodey, M. Carneiro, S. Hazratpour, J. Hua, W. Nawrocki, S. Woolfson</h2>
-    <a href="blueprint" class="btn">Blueprint (web)</a>
-    <a href="docs" class="btn">Documentation</a>
-    
-    <a href="https://github.com/sinhp/groupoid_model_in_lean4" class="btn">GitHub</a>
-    
-  </header>
-
-  <main id="content" class="main-content" role="main">
-    <p>Useful links:</p>
-
-<ul>
-  <li><a href="https://leanprover.zulipchat.com/">Zulip chat for Lean</a> for coordination</li>
-  <li><a href="http://localhost:4000/blueprint/">Blueprint</a></li>
-  <li><a href="http://localhost:4000/blueprint.pdf">Blueprint as pdf</a></li>
-  <li><a href="http://localhost:4000/blueprint/dep_graph_document.html">Dependency graph</a></li>
-  <li><a href="http://localhost:4000/docs/">Doc pages for this repository</a></li>
-</ul>
-
-
-    <footer class="site-footer">
-      
-      <span class="site-footer-owner"><a href="https://github.com/sinhp/groupoid_model_in_lean4">groupoid_model_in_lean4</a>
-	is maintained by <a href="https://sinhp.github.io">Sina Hazratpour</a>. Visit the GitHub repository for more information.</span>
-      
-    </footer>
-  </main>
-</body>
-
-</html>
diff --git a/lake-manifest.json b/lake-manifest.json
index 930c29a9..a4828b70 100644
--- a/lake-manifest.json
+++ b/lake-manifest.json
@@ -1,41 +1,38 @@
-{"version": "1.1.0",
+{"version": "1.2.0",
  "packagesDir": ".lake/packages",
  "packages":
- [{"url": "https://github.com/PatrickMassot/checkdecls.git",
+ [{"url": "https://github.com/sosudo/Poly",
    "type": "git",
    "subDir": null,
    "scope": "",
-   "rev": "3d425859e73fcfbef85b9638c2a91708ef4a22d4",
-   "name": "checkdecls",
+   "rev": "ba73d5149ac19b1186b6e58648217b52db6b8cdb",
+   "name": "Poly",
    "manifestFile": "lake-manifest.json",
-   "inputRev": null,
+   "inputRev": "ba73d5149ac19b1186b6e58648217b52db6b8cdb",
    "inherited": false,
    "configFile": "lakefile.lean"},
-  {"url": "https://github.com/sinhp/Poly",
-   "type": "git",
-   "subDir": null,
+  {"type": "path",
    "scope": "",
-   "rev": "aedee22f07d681d845bcbe4a1fb9aa10f95c9977",
-   "name": "Poly",
+   "name": "checkdecls",
    "manifestFile": "lake-manifest.json",
-   "inputRev": "master",
-   "inherited": false,
+   "inherited": true,
+   "dir": ".lake/packages/Poly/vendor/checkdecls",
    "configFile": "lakefile.lean"},
   {"url": "https://github.com/leanprover-community/mathlib4.git",
    "type": "git",
    "subDir": null,
    "scope": "",
-   "rev": "32bd6c7c8ca4a4be1c71bc04df0c9cf929d04818",
+   "rev": "d13f23b723b8a846827a245b89c10fc7d3f11612",
    "name": "mathlib",
    "manifestFile": "lake-manifest.json",
-   "inputRev": null,
+   "inputRev": "v4.34.1",
    "inherited": true,
    "configFile": "lakefile.lean"},
   {"url": "https://github.com/leanprover-community/plausible",
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "8864a73bf79aad549e34eff972c606343935106d",
+   "rev": "118aa17ee84656b8bd727fef7c458ee8c833385c",
    "name": "plausible",
    "manifestFile": "lake-manifest.json",
    "inputRev": "main",
@@ -45,7 +42,7 @@
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "2ed4ba69b6127de8f5c2af83cccacd3c988b06bf",
+   "rev": "ddf04cf3949fa556442341e87d47f9f6e6074707",
    "name": "LeanSearchClient",
    "manifestFile": "lake-manifest.json",
    "inputRev": "main",
@@ -55,7 +52,7 @@
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "451499ea6e97cee4c8979b507a9af5581a849161",
+   "rev": "e928b72544873815af278d38681b31c0293588e3",
    "name": "importGraph",
    "manifestFile": "lake-manifest.json",
    "inputRev": "main",
@@ -65,17 +62,17 @@
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "fb8ed0a85a96e3176f6e94b20d413ea72d92576d",
+   "rev": "106ff4fafc74ef4ac99d81dbf3ab399118f497a5",
    "name": "proofwidgets",
    "manifestFile": "lake-manifest.json",
-   "inputRev": "v0.0.77",
+   "inputRev": "main",
    "inherited": true,
    "configFile": "lakefile.lean"},
   {"url": "https://github.com/leanprover-community/aesop",
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "1fa48c6a63b4c4cda28be61e1037192776e77ac0",
+   "rev": "355695d523e41d0554926416cba2a2b3544fbbc9",
    "name": "aesop",
    "manifestFile": "lake-manifest.json",
    "inputRev": "master",
@@ -85,7 +82,7 @@
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "95c2f8afe09d9e49d3cacca667261da04f7f93f7",
+   "rev": "6a489d9af5d0c47e5b259e2e8bcdfc1811b5a259",
    "name": "Qq",
    "manifestFile": "lake-manifest.json",
    "inputRev": "master",
@@ -95,7 +92,7 @@
    "type": "git",
    "subDir": null,
    "scope": "leanprover-community",
-   "rev": "c44068fa1b40041e6df42bd67639b690eb2764ca",
+   "rev": "f2effa3d803fda822b1f97b806c47cf2adfbcbc2",
    "name": "batteries",
    "manifestFile": "lake-manifest.json",
    "inputRev": "main",
@@ -105,11 +102,12 @@
    "type": "git",
    "subDir": null,
    "scope": "leanprover",
-   "rev": "72ae7004d9f0ddb422aec5378204fdd7828c5672",
+   "rev": "e92c9f15fdfacc8536f31cfb3b7ad26c3c8cd204",
    "name": "Cli",
    "manifestFile": "lake-manifest.json",
-   "inputRev": "v4.25.0-rc2",
+   "inputRev": "v4.34.0",
    "inherited": true,
    "configFile": "lakefile.toml"}],
  "name": "hottlean",
- "lakeDir": ".lake"}
+ "lakeDir": ".lake",
+ "fixedToolchain": false}
diff --git a/lakefile.lean b/lakefile.lean
index 2807a875..6337022d 100644
--- a/lakefile.lean
+++ b/lakefile.lean
@@ -1,13 +1,12 @@
 import Lake
 open Lake DSL
 
-require Poly from git "https://github.com/sinhp/Poly" @ "master"
-
-require checkdecls from git "https://github.com/PatrickMassot/checkdecls.git"
+-- Lean v4.34.1 port, proposed in sinhp/Poly#41.
+require Poly from git "https://github.com/sosudo/Poly" @ "ba73d5149ac19b1186b6e58648217b52db6b8cdb"
 
 meta if get_config? env = some "dev" then
 require «doc-gen4» from git
-  "https://github.com/leanprover/doc-gen4" @ "v4.25.0-rc2"
+  "https://github.com/leanprover/doc-gen4" @ "v4.34.1"
 
 package hottlean where
   -- Settings applied to both builds and interactive editing
@@ -37,4 +36,4 @@ lean_lib HoTTLean where
   needs := #[Prelude]
 
 @[test_driver]
-lean_lib test where
+lean_lib HoTTLeanTest where
diff --git a/lean-toolchain b/lean-toolchain
index 137937a3..ba8ebf2d 100644
--- a/lean-toolchain
+++ b/lean-toolchain
@@ -1 +1 @@
-leanprover/lean4:v4.25.0-rc2
\ No newline at end of file
+leanprover/lean4:v4.34.1
diff --git a/test.lean b/test.lean
index dc13b5c9..7f33fde8 100644
--- a/test.lean
+++ b/test.lean
@@ -1,3 +1,3 @@
-import test.basic
-import test.import
-import test.hott0
+import HoTTLeanTest.basic
+import HoTTLeanTest.import
+import HoTTLeanTest.hott0