feat(hott): rename definition and cleanup in HoTT library

also add more definitions in types.pi, types.path, algebra.precategory

the (pre)category library still needs cleanup
authors of this commit: @avigad, @javra, @fpvandoorn

hott/algebra/category/basic.hlean

@@ -4,7 +4,7 @@
 
 import ..precategory.basic ..precategory.morphism ..precategory.iso
 
-open precategory morphism is_equiv eq truncation nat sigma sigma.ops
+open precategory morphism is_equiv eq is_trunc nat sigma sigma.ops
 
 -- A category is a precategory extended by a witness,
 -- that the function assigning to each isomorphism a path,
@@ -27,16 +27,33 @@ namespace category
 
   set_option apply.class_instance false -- disable class instance resolution in the apply tactic
 
-  definition ob_1_type : is_trunc nat.zero .+1 ob :=
+  definition ob_1_type : is_trunc (succ nat.zero) ob :=
   begin
-    apply is_trunc_succ, intros (a, b),
+    apply is_trunc_succ_intro, intros (a, b),
-    fapply trunc_equiv,
+    fapply is_trunc_is_equiv_closed,
           exact (@path_of_iso _ _ a b),
-        apply inv_closed,
+        apply is_equiv_inv,
     apply is_hset_iso,
   end
 
 end category
 
 -- Bundled version of categories
-inductive Category : Type := mk : Π (ob : Type), category ob → Category
+
+structure Category : Type :=
+  (objects : Type)
+  (category_instance : category objects)
+
+namespace category
+  definition Mk {ob} (C) : Category := Category.mk ob C
+  --definition MK (a b c d e f g h i) : Category := Category.mk a (category.mk b c d e f g h i)
+
+  definition objects [coercion] [reducible] := Category.objects
+  definition category_instance [instance] [coercion] [reducible] := Category.category_instance
+
+end category
+
+open category
+
+protected definition Category.eta (C : Category) : Category.mk C C = C :=
+Category.rec (λob c, idp) C

hott/algebra/category/set.hlean

@@ -3,9 +3,9 @@
 -- Authors: Jakob von Raumer
 -- Category of sets
 
-import .basic types.pi trunc
+import .basic types.pi types.trunc
 
-open truncation sigma sigma.ops pi function eq morphism precategory
+open is_trunc sigma sigma.ops pi function eq morphism precategory
 open equiv
 
 namespace precategory
@@ -15,13 +15,13 @@ namespace precategory
   definition set_precategory : precategory.{l+1 l} (Σ (A : Type.{l}), is_hset A) :=
   begin
     fapply precategory.mk.{l+1 l},
-                  intros, apply (a.1 → a_1.1),
+                  intros (a, a_1), apply (a.1 → a_1.1),
-                intros, apply trunc_pi, intros, apply b.2,
+                intros, apply is_trunc_pi, intros, apply b.2,
               intros, intro x, exact (a_1 (a_2 x)),
             intros, exact (λ (x : a.1), x),
-          intros, apply funext.path_pi, intro x, apply idp,
+          intros, apply funext.eq_of_homotopy, intro x, apply idp,
-        intros, apply funext.path_pi, intro x, apply idp,
+        intros, apply funext.eq_of_homotopy, intro x, apply idp,
-      intros, apply funext.path_pi, intro x, apply idp,
+      intros, apply funext.eq_of_homotopy, intro x, apply idp,
   end
 
 end precategory
@@ -51,19 +51,19 @@ namespace category
     assert (C : precategory.{l+1 l} (Σ (A : Type.{l}), is_hset A)),
       apply precategory.set_precategory,
     apply category.mk,
-    assert (p : (λ A B p, (set_category_equiv_iso A B) ▹ iso_of_path p) = (λ A B p, @equiv_path A.1 B.1 p)),
+    assert (p : (λ A B p, (set_category_equiv_iso A B) ▹ iso_of_path p) = (λ A B p, @equiv_of_eq A.1 B.1 p)),
     apply is_equiv.adjointify,
         intros,
         apply (isomorphic.rec_on a_1), intros (iso', is_iso'),
         apply (is_iso.rec_on is_iso'), intros (f', f'sect, f'retr),
-        fapply sigma.path,
+        fapply sigma_eq,
           apply ua, fapply equiv.mk, exact iso',
           fapply is_equiv.adjointify,
               exact f',
             intros, apply (f'retr ▹ _),
           intros, apply (f'sect ▹ _),
         apply (@is_hprop.elim),
-        apply is_trunc_is_hprop,
+        apply is_hprop_is_trunc,
       intros,
   end -/ sorry
 

hott/algebra/group.hlean

@@ -10,7 +10,7 @@ Various multiplicative and additive structures. Partially modeled on Isabelle's
 
 import algebra.binary
 
-open eq truncation binary  -- note: ⁻¹ will be overloaded
+open eq is_trunc binary  -- note: ⁻¹ will be overloaded
 
 namespace path_algebra
 
@@ -117,11 +117,11 @@ theorem add_right_cancel [s : add_right_cancel_semigroup A] {a b c : A} :
 /- monoid -/
 
 structure monoid [class] (A : Type) extends semigroup A, has_one A :=
-(mul_left_id : ∀a, mul one a = a) (mul_right_id : ∀a, mul a one = a)
+(one_mul : ∀a, mul one a = a) (mul_one : ∀a, mul a one = a)
 
-theorem mul_left_id [s : monoid A] (a : A) : 1 * a = a := !monoid.mul_left_id
+theorem one_mul [s : monoid A] (a : A) : 1 * a = a := !monoid.one_mul
 
-theorem mul_right_id [s : monoid A] (a : A) : a * 1 = a := !monoid.mul_right_id
+theorem mul_one [s : monoid A] (a : A) : a * 1 = a := !monoid.mul_one
 
 structure comm_monoid [class] (A : Type) extends monoid A, comm_semigroup A
 
@@ -129,11 +129,11 @@ structure comm_monoid [class] (A : Type) extends monoid A, comm_semigroup A
 /- additive monoid -/
 
 structure add_monoid [class] (A : Type) extends add_semigroup A, has_zero A :=
-(add_left_id : ∀a, add zero a = a) (add_right_id : ∀a, add a zero = a)
+(zero_add : ∀a, add zero a = a) (add_zero : ∀a, add a zero = a)
 
-theorem add_left_id [s : add_monoid A] (a : A) : 0 + a = a := !add_monoid.add_left_id
+theorem zero_add [s : add_monoid A] (a : A) : 0 + a = a := !add_monoid.zero_add
 
-theorem add_right_id [s : add_monoid A] (a : A) : a + 0 = a := !add_monoid.add_right_id
+theorem add_zero [s : add_monoid A] (a : A) : a + 0 = a := !add_monoid.add_zero
 
 structure add_comm_monoid [class] (A : Type) extends add_monoid A, add_comm_semigroup A
 
@@ -144,7 +144,7 @@ structure add_comm_monoid [class] (A : Type) extends add_monoid A, add_comm_semi
 structure group [class] (A : Type) extends monoid A, has_inv A :=
 (mul_left_inv : ∀a, mul (inv a) a = one)
 
--- Note: with more work, we could derive the axiom mul_left_id
+-- Note: with more work, we could derive the axiom one_mul
 
 section group
 
@@ -157,28 +157,28 @@ section group
   calc
     a⁻¹ * (a * b) = a⁻¹ * a * b : mul_assoc
       ... = 1 * b : mul_left_inv
-      ... = b : mul_left_id
+      ... = b : one_mul
 
   theorem inv_mul_cancel_right (a b : A) : a * b⁻¹ * b = a :=
   calc
     a * b⁻¹ * b = a * (b⁻¹ * b) : mul_assoc
       ... = a * 1 : mul_left_inv
-    ... = a : mul_right_id
+    ... = a : mul_one
 
-  theorem inv_unique {a b : A} (H : a * b = 1) : a⁻¹ = b :=
+  theorem inv_eq_of_mul_eq_one {a b : A} (H : a * b = 1) : a⁻¹ = b :=
   calc
-    a⁻¹ = a⁻¹ * 1 : mul_right_id
+    a⁻¹ = a⁻¹ * 1 : mul_one
       ... = a⁻¹ * (a * b) : H
       ... = b : inv_mul_cancel_left
 
-  theorem inv_one : 1⁻¹ = 1 := inv_unique (mul_left_id 1)
+  theorem inv_one : 1⁻¹ = 1 := inv_eq_of_mul_eq_one (one_mul 1)
 
-  theorem inv_inv (a : A) : (a⁻¹)⁻¹ = a := inv_unique (mul_left_inv a)
+  theorem inv_inv (a : A) : (a⁻¹)⁻¹ = a := inv_eq_of_mul_eq_one (mul_left_inv a)
 
   theorem inv_inj {a b : A} (H : a⁻¹ = b⁻¹) : a = b :=
   calc
     a = (a⁻¹)⁻¹ : inv_inv
-      ... = b : inv_unique (H⁻¹ ▹ (mul_left_inv _))
+      ... = b : inv_eq_of_mul_eq_one (H⁻¹ ▹ (mul_left_inv _))
 
   --theorem inv_eq_inv_iff_eq (a b : A) : a⁻¹ = b⁻¹ ↔ a = b :=
   --iff.intro (assume H, inv_inj H) (assume H, congr_arg _ H)
@@ -201,57 +201,57 @@ section group
   calc
     a * (a⁻¹ * b) = a * a⁻¹ * b : mul_assoc
       ... = 1 * b : mul_right_inv
-      ... = b : mul_left_id
+      ... = b : one_mul
 
   theorem mul_inv_cancel_right (a b : A) : a * b * b⁻¹ = a :=
   calc
     a * b * b⁻¹ = a * (b * b⁻¹) : mul_assoc
       ... = a * 1 : mul_right_inv
-      ... = a : mul_right_id
+      ... = a : mul_one
 
   theorem inv_mul (a b : A) : (a * b)⁻¹ = b⁻¹ * a⁻¹ :=
-  inv_unique
+  inv_eq_of_mul_eq_one
     (calc
       a * b * (b⁻¹ * a⁻¹) = a * (b * (b⁻¹ * a⁻¹)) : mul_assoc
         ... = a * a⁻¹ : mul_inv_cancel_left
         ... = 1 : mul_right_inv)
 
-  theorem mul_inv_eq_one_imp_eq {a b : A} (H : a * b⁻¹ = 1) : a = b :=
+  theorem eq_of_mul_inv_eq_one {a b : A} (H : a * b⁻¹ = 1) : a = b :=
   calc
     a = a * b⁻¹ * b : inv_mul_cancel_right
       ... = 1 * b : H
-      ... = b : mul_left_id
+      ... = b : one_mul
 
   -- TODO: better names for the next eight theorems? (Also for additive ones.)
-  theorem mul_eq_imp_eq_mul_inv {a b c : A} (H : a * b = c) : a = c * b⁻¹ :=
+  theorem eq_mul_inv_of_mul_eq {a b c : A} (H : a * b = c) : a = c * b⁻¹ :=
   H ▹ !mul_inv_cancel_right⁻¹
 
-  theorem mul_eq_imp_eq_inv_mul {a b c : A} (H : a * b = c) : b = a⁻¹ * c :=
+  theorem eq_inv_mul_of_mul_eq {a b c : A} (H : a * b = c) : b = a⁻¹ * c :=
   H ▹ !inv_mul_cancel_left⁻¹
 
-  theorem eq_mul_imp_inv_mul_eq {a b c : A} (H : a = b * c) : b⁻¹ * a = c :=
+  theorem inv_mul_eq_of_eq_mul {a b c : A} (H : a = b * c) : b⁻¹ * a = c :=
   H⁻¹ ▹ !inv_mul_cancel_left
 
-  theorem eq_mul_imp_mul_inv_eq {a b c : A} (H : a = b * c) : a * c⁻¹ = b :=
+  theorem mul_inv_eq_of_eq_mul {a b c : A} (H : a = b * c) : a * c⁻¹ = b :=
   H⁻¹ ▹ !mul_inv_cancel_right
 
-  theorem mul_inv_eq_imp_eq_mul {a b c : A} (H : a * b⁻¹ = c) : a = c * b :=
+  theorem eq_mul_of_mul_inv_eq {a b c : A} (H : a * b⁻¹ = c) : a = c * b :=
-  !inv_inv ▹ (mul_eq_imp_eq_mul_inv H)
+  !inv_inv ▹ (eq_mul_inv_of_mul_eq H)
 
-  theorem inv_mul_eq_imp_eq_mul {a b c : A} (H : a⁻¹ * b = c) : b = a * c :=
+  theorem eq_mul_of_inv_mul_eq {a b c : A} (H : a⁻¹ * b = c) : b = a * c :=
-  !inv_inv ▹ (mul_eq_imp_eq_inv_mul H)
+  !inv_inv ▹ (eq_inv_mul_of_mul_eq H)
 
-  theorem eq_inv_mul_imp_mul_eq {a b c : A} (H : a = b⁻¹ * c) : b * a = c :=
+  theorem mul_eq_of_eq_inv_mul {a b c : A} (H : a = b⁻¹ * c) : b * a = c :=
-  !inv_inv ▹ (eq_mul_imp_inv_mul_eq H)
+  !inv_inv ▹ (inv_mul_eq_of_eq_mul H)
 
-  theorem eq_mul_inv_imp_mul_eq {a b c : A} (H : a = b * c⁻¹) : a * c = b :=
+  theorem mul_eq_of_eq_mul_inv {a b c : A} (H : a = b * c⁻¹) : a * c = b :=
-  !inv_inv ▹ (eq_mul_imp_mul_inv_eq H)
+  !inv_inv ▹ (mul_inv_eq_of_eq_mul H)
 
   --theorem mul_eq_iff_eq_inv_mul (a b c : A) : a * b = c ↔ b = a⁻¹ * c :=
-  --iff.intro mul_eq_imp_eq_inv_mul eq_inv_mul_imp_mul_eq
+  --iff.intro eq_inv_mul_of_mul_eq mul_eq_of_eq_inv_mul
 
   --theorem mul_eq_iff_eq_mul_inv (a b c : A) : a * b = c ↔ a = c * b⁻¹ :=
-  --iff.intro mul_eq_imp_eq_mul_inv eq_mul_inv_imp_mul_eq
+  --iff.intro eq_mul_inv_of_mul_eq mul_eq_of_eq_mul_inv
 
   definition group.to_left_cancel_semigroup [instance] : left_cancel_semigroup A :=
   left_cancel_semigroup.mk (@group.mul A s) (@group.carrier_hset A s) (@group.mul_assoc A s)
@@ -292,28 +292,28 @@ section add_group
   calc
     -a + (a + b) = -a + a + b : add_assoc
       ... = 0 + b : add_left_inv
-      ... = b : add_left_id
+      ... = b : zero_add
 
   theorem neg_add_cancel_right (a b : A) : a + -b + b = a :=
   calc
     a + -b + b = a + (-b + b) : add_assoc
       ... = a + 0 : add_left_inv
-      ... = a : add_right_id
+      ... = a : add_zero
 
-  theorem neg_unique {a b : A} (H : a + b = 0) : -a = b :=
+  theorem neq_eq_of_add_eq_zero {a b : A} (H : a + b = 0) : -a = b :=
   calc
-    -a = -a + 0 : add_right_id
+    -a = -a + 0 : add_zero
       ... = -a + (a + b) : H
       ... = b : neg_add_cancel_left
 
-  theorem neg_zero : -0 = 0 := neg_unique (add_left_id 0)
+  theorem neg_zero : -0 = 0 := neq_eq_of_add_eq_zero (zero_add 0)
 
-  theorem neg_neg (a : A) : -(-a) = a := neg_unique (add_left_inv a)
+  theorem neg_neg (a : A) : -(-a) = a := neq_eq_of_add_eq_zero (add_left_inv a)
 
   theorem neg_inj {a b : A} (H : -a = -b) : a = b :=
   calc
     a = -(-a) : neg_neg
-      ... = b : neg_unique (H⁻¹ ▹ (add_left_inv _))
+      ... = b : neq_eq_of_add_eq_zero (H⁻¹ ▹ (add_left_inv _))
 
   --theorem neg_eq_neg_iff_eq (a b : A) : -a = -b ↔ a = b :=
   --iff.intro (assume H, neg_inj H) (assume H, congr_arg _ H)
@@ -321,11 +321,11 @@ section add_group
   --theorem neg_eq_zero_iff_eq_zero (a b : A) : -a = 0 ↔ a = 0 :=
   --neg_zero ▹ !neg_eq_neg_iff_eq
 
-  theorem eq_neg_imp_eq_neg {a b : A} (H : a = -b) : b = -a :=
+  theorem eq_neq_of_eq_neg {a b : A} (H : a = -b) : b = -a :=
   H⁻¹ ▹ (neg_neg b)⁻¹
 
   --theorem eq_neg_iff_eq_neg (a b : A) : a = -b ↔ b = -a :=
-  --iff.intro !eq_neg_imp_eq_neg !eq_neg_imp_eq_neg
+  --iff.intro !eq_neq_of_eq_neg !eq_neq_of_eq_neg
 
   theorem add_right_inv (a : A) : a + -a = 0 :=
   calc
@@ -336,50 +336,50 @@ section add_group
   calc
     a + (-a + b) = a + -a + b : add_assoc
       ... = 0 + b : add_right_inv
-      ... = b : add_left_id
+      ... = b : zero_add
 
   theorem add_neg_cancel_right (a b : A) : a + b + -b = a :=
   calc
     a + b + -b = a + (b + -b) : add_assoc
       ... = a + 0 : add_right_inv
-      ... = a : add_right_id
+      ... = a : add_zero
 
-  theorem neg_add (a b : A) : -(a + b) = -b + -a :=
+  theorem neq_add_rev (a b : A) : -(a + b) = -b + -a :=
-  neg_unique
+  neq_eq_of_add_eq_zero
     (calc
       a + b + (-b + -a) = a + (b + (-b + -a)) : add_assoc
         ... = a + -a : add_neg_cancel_left
         ... = 0 : add_right_inv)
 
-  theorem add_eq_imp_eq_add_neg {a b c : A} (H : a + b = c) : a = c + -b :=
+  theorem eq_add_neq_of_add_eq {a b c : A} (H : a + b = c) : a = c + -b :=
   H ▹ !add_neg_cancel_right⁻¹
 
-  theorem add_eq_imp_eq_neg_add {a b c : A} (H : a + b = c) : b = -a + c :=
+  theorem eq_neg_add_of_add_eq {a b c : A} (H : a + b = c) : b = -a + c :=
   H ▹ !neg_add_cancel_left⁻¹
 
-  theorem eq_add_imp_neg_add_eq {a b c : A} (H : a = b + c) : -b + a = c :=
+  theorem neg_add_eq_of_eq_add {a b c : A} (H : a = b + c) : -b + a = c :=
   H⁻¹ ▹ !neg_add_cancel_left
 
-  theorem eq_add_imp_add_neg_eq {a b c : A} (H : a = b + c) : a + -c = b :=
+  theorem add_neg_eq_of_eq_add {a b c : A} (H : a = b + c) : a + -c = b :=
   H⁻¹ ▹ !add_neg_cancel_right
 
-  theorem add_neg_eq_imp_eq_add {a b c : A} (H : a + -b = c) : a = c + b :=
+  theorem eq_add_of_add_neg_eq {a b c : A} (H : a + -b = c) : a = c + b :=
-  !neg_neg ▹ (add_eq_imp_eq_add_neg H)
+  !neg_neg ▹ (eq_add_neq_of_add_eq H)
 
-  theorem neg_add_eq_imp_eq_add {a b c : A} (H : -a + b = c) : b = a + c :=
+  theorem eq_add_of_neg_add_eq {a b c : A} (H : -a + b = c) : b = a + c :=
-  !neg_neg ▹ (add_eq_imp_eq_neg_add H)
+  !neg_neg ▹ (eq_neg_add_of_add_eq H)
 
-  theorem eq_neg_add_imp_add_eq {a b c : A} (H : a = -b + c) : b + a = c :=
+  theorem add_eq_of_eq_neg_add {a b c : A} (H : a = -b + c) : b + a = c :=
-  !neg_neg ▹ (eq_add_imp_neg_add_eq H)
+  !neg_neg ▹ (neg_add_eq_of_eq_add H)
 
-  theorem eq_add_neg_imp_add_eq {a b c : A} (H : a = b + -c) : a + c = b :=
+  theorem add_eq_of_eq_add_neg {a b c : A} (H : a = b + -c) : a + c = b :=
-  !neg_neg ▹ (eq_add_imp_add_neg_eq H)
+  !neg_neg ▹ (add_neg_eq_of_eq_add H)
 
   --theorem add_eq_iff_eq_neg_add (a b c : A) : a + b = c ↔ b = -a + c :=
-  --iff.intro add_eq_imp_eq_neg_add eq_neg_add_imp_add_eq
+  --iff.intro eq_neg_add_of_add_eq add_eq_of_eq_neg_add
 
   --theorem add_eq_iff_eq_add_neg (a b c : A) : a + b = c ↔ a = c + -b :=
-  --iff.intro add_eq_imp_eq_add_neg eq_add_neg_imp_add_eq
+  --iff.intro eq_add_neq_of_add_eq add_eq_of_eq_add_neg
 
   definition add_group.to_left_cancel_semigroup [instance] :
     add_left_cancel_semigroup A :=
@@ -401,53 +401,53 @@ section add_group
           ... = (c + b) + -b : H
           ... = c : add_neg_cancel_right)
 
-  /- minus -/
+  /- sub -/
 
   -- TODO: derive corresponding facts for div in a field
-  definition minus [reducible] (a b : A) : A := a + -b
+  definition sub [reducible] (a b : A) : A := a + -b
 
-  infix `-` := minus
+  infix `-` := sub
 
-  theorem minus_self (a : A) : a - a = 0 := !add_right_inv
+  theorem sub_self (a : A) : a - a = 0 := !add_right_inv
 
-  theorem minus_add_cancel (a b : A) : a - b + b = a := !neg_add_cancel_right
+  theorem sub_add_cancel (a b : A) : a - b + b = a := !neg_add_cancel_right
 
-  theorem add_minus_cancel (a b : A) : a + b - b = a := !add_neg_cancel_right
+  theorem add_sub_cancel (a b : A) : a + b - b = a := !add_neg_cancel_right
 
-  theorem minus_eq_zero_imp_eq {a b : A} (H : a - b = 0) : a = b :=
+  theorem eq_of_sub_eq_zero {a b : A} (H : a - b = 0) : a = b :=
   calc
-    a = (a - b) + b : minus_add_cancel
+    a = (a - b) + b : sub_add_cancel
       ... = 0 + b : H
-      ... = b : add_left_id
+      ... = b : zero_add
 
   --theorem eq_iff_minus_eq_zero (a b : A) : a = b ↔ a - b = 0 :=
-  --iff.intro (assume H, H ▹ !minus_self) (assume H, minus_eq_zero_imp_eq H)
+  --iff.intro (assume H, H ▹ !sub_self) (assume H, eq_of_sub_eq_zero H)
 
-  theorem zero_minus (a : A) : 0 - a = -a := !add_left_id
+  theorem zero_sub (a : A) : 0 - a = -a := !zero_add
 
-  theorem minus_zero (a : A) : a - 0 = a := (neg_zero⁻¹) ▹ !add_right_id
+  theorem sub_zero (a : A) : a - 0 = a := (neg_zero⁻¹) ▹ !add_zero
 
-  theorem minus_neg_eq_add (a b : A) : a - (-b) = a + b := !neg_neg ▹ idp
+  theorem sub_neg_eq_add (a b : A) : a - (-b) = a + b := !neg_neg ▹ idp
 
-  theorem neg_minus_eq (a b : A) : -(a - b) = b - a :=
+  theorem neg_sub (a b : A) : -(a - b) = b - a :=
-  neg_unique
+  neq_eq_of_add_eq_zero
     (calc
       a - b + (b - a) = a - b + b - a : add_assoc
-        ... = a - a : minus_add_cancel
+        ... = a - a : sub_add_cancel
-        ... = 0 : minus_self)
+        ... = 0 : sub_self)
 
-  theorem add_minus_eq (a b c : A) : a + (b - c) = a + b - c := !add_assoc⁻¹
+  theorem add_sub (a b c : A) : a + (b - c) = a + b - c := !add_assoc⁻¹
 
-  theorem minus_add_eq_minus_swap (a b c : A) : a - (b + c) = a - c - b :=
+  theorem sub_add_eq_sub_sub_swap (a b c : A) : a - (b + c) = a - c - b :=
   calc
-    a - (b + c) = a + (-c - b) : neg_add
+    a - (b + c) = a + (-c - b) : neq_add_rev
       ... = a - c - b : add_assoc
 
   --theorem minus_eq_iff_eq_add (a b c : A) : a - b = c ↔ a = c + b :=
-  --iff.intro (assume H, add_neg_eq_imp_eq_add H) (assume H, eq_add_imp_add_neg_eq H)
+  --iff.intro (assume H, eq_add_of_add_neg_eq H) (assume H, add_neg_eq_of_eq_add H)
 
   --theorem eq_minus_iff_add_eq (a b c : A) : a = b - c ↔ a + c = b :=
-  --iff.intro (assume H, eq_add_neg_imp_add_eq H) (assume H, add_eq_imp_eq_add_neg H)
+  --iff.intro (assume H, add_eq_of_eq_add_neg H) (assume H, eq_add_neq_of_add_eq H)
 
   --theorem minus_eq_minus_iff {a b c d : A} (H : a - b = c - d) : a = b ↔ c = d :=
   --calc
@@ -464,26 +464,26 @@ section add_comm_group
 variable [s : add_comm_group A]
 include s
 
-  theorem minus_add_eq (a b c : A) : a - (b + c) = a - b - c :=
+  theorem sub_add_eq_sub_sub (a b c : A) : a - (b + c) = a - b - c :=
-  !add_comm ▹ !minus_add_eq_minus_swap
+  !add_comm ▹ !sub_add_eq_sub_sub_swap
 
-  theorem neg_add_eq_minus (a b : A) : -a + b = b - a := !add_comm
+  theorem neq_add_eq_sub (a b : A) : -a + b = b - a := !add_comm
 
-  theorem neg_add_distrib (a b : A) : -(a + b) = -a + -b := !add_comm ▹ !neg_add
+  theorem neg_add_distrib (a b : A) : -(a + b) = -a + -b := !add_comm ▹ !neq_add_rev
 
-  theorem minus_add_right_comm (a b c : A) : a - b + c = a + c - b := !add_right_comm
+  theorem sub_add_eq_add_sub (a b c : A) : a - b + c = a + c - b := !add_right_comm
 
-  theorem minus_minus_eq (a b c : A) : a - b - c = a - (b + c) :=
+  theorem sub_sub (a b c : A) : a - b - c = a - (b + c) :=
   calc
     a - b - c = a + (-b + -c) : add_assoc
       ... = a + -(b + c) : neg_add_distrib
       ... = a - (b + c) : idp
 
-  theorem add_minus_cancel_left (a b c : A) : (c + a) - (c + b) = a - b :=
+  theorem add_sub_add_left_eq_sub (a b c : A) : (c + a) - (c + b) = a - b :=
   calc
-    (c + a) - (c + b) = c + a - c - b : minus_add_eq
+    (c + a) - (c + b) = c + a - c - b : sub_add_eq_sub_sub
       ... = a + c - c - b : add_comm a c
-      ... = a - b : add_minus_cancel
+      ... = a - b : add_sub_cancel
 
 
 end add_comm_group

hott/algebra/groupoid.hlean

@@ -4,7 +4,7 @@
 -- Ported from Coq HoTT
 import .precategory.basic .precategory.morphism .group types.pi
 
-open eq function prod sigma pi truncation morphism nat path_algebra unit prod sigma.ops
+open eq function prod sigma pi is_trunc morphism nat path_algebra unit prod sigma.ops
 
 structure foo (A : Type) := (bsp : A)
 
@@ -18,21 +18,21 @@ attribute all_iso [instance]
 
 universe variable l
 open precategory
-definition path_groupoid (A : Type.{l})
+definition groupoid_of_1_type (A : Type.{l})
     (H : is_trunc (nat.zero .+1) A) : groupoid.{l l} A :=
 groupoid.mk
   (λ (a b : A), a = b)
-  (λ (a b : A), have ish : is_hset (a = b), from succ_is_trunc nat.zero a b, ish)
+  (λ (a b : A), have ish : is_hset (a = b), from is_trunc_eq nat.zero a b, ish)
   (λ (a b c : A) (p : b = c) (q : a = b), q ⬝ p)
   (λ (a : A), refl a)
-  (λ (a b c d : A) (p : c = d) (q : b = c) (r : a = b), concat_pp_p r q p)
+  (λ (a b c d : A) (p : c = d) (q : b = c) (r : a = b), con.assoc r q p)
-  (λ (a b : A) (p : a = b), concat_p1 p)
+  (λ (a b : A) (p : a = b), con_idp p)
-  (λ (a b : A) (p : a = b), concat_1p p)
+  (λ (a b : A) (p : a = b), idp_con p)
   (λ (a b : A) (p : a = b), @is_iso.mk A _ a b p (p⁻¹)
-    !concat_pV !concat_Vp)
+    !con.left_inv !con.right_inv)
 
 -- A groupoid with a contractible carrier is a group
-definition group_of_contr {ob : Type} (H : is_contr ob)
+definition group_of_is_contr_groupoid {ob : Type} (H : is_contr ob)
   (G : groupoid ob) : group (hom (center ob) (center ob)) :=
 begin
   fapply group.mk,
@@ -46,7 +46,7 @@ begin
     intro f, exact (morphism.inverse_compose f),
 end
 
-definition group_of_unit (G : groupoid unit) : group (hom ⋆ ⋆) :=
+definition group_of_unit_groupoid (G : groupoid unit) : group (hom ⋆ ⋆) :=
 begin
   fapply group.mk,
     intros (f, g), apply (comp f g),
@@ -68,8 +68,8 @@ begin
     intros (a, b, c, g, h), exact (@group.mul A G g h),
     intro a, exact (@group.one A G),
     intros, exact ((@group.mul_assoc A G h g f)⁻¹),
-    intros, exact (@group.mul_left_id A G f),
+    intros, exact (@group.one_mul A G f),
-    intros, exact (@group.mul_right_id A G f),
+    intros, exact (@group.mul_one A G f),
     intros, apply is_iso.mk,
       apply mul_left_inv,
       apply mul_right_inv,

hott/algebra/precategory/basic.hlean

@@ -2,7 +2,7 @@
 -- Released under Apache 2.0 license as described in the file LICENSE.
 -- Author: Floris van Doorn
 
-open eq truncation
+open eq is_trunc
 
 structure precategory [class] (ob : Type) : Type :=
   (hom : ob → ob → Type)
@@ -26,14 +26,12 @@ namespace precategory
 
   definition id [reducible] {a : ob} : hom a a := ID a
 
-  infixr `∘` := compose
+  infixr `∘` := comp
   infixl `⟶`:25 := hom -- input ⟶ using \--> (this is a different arrow than \-> (→))
 
   variables {h : hom c d} {g : hom b c} {f : hom a b} {i : hom a a}
 
-
+  theorem id_compose (a : ob) : ID a ∘ ID a = ID a := !id_left
-  --the following is the only theorem for which "include C" is necessary if C is a variable (why?)
-  theorem id_compose (a : ob) : (ID a) ∘ id = id := !id_left
 
   theorem left_id_unique (H : Π{b} {f : hom b a}, i ∘ f = f) : i = id :=
   calc i = i ∘ id : id_right
@@ -42,23 +40,29 @@ namespace precategory
   theorem right_id_unique (H : Π{b} {f : hom a b}, f ∘ i = f) : i = id :=
   calc i = id ∘ i : id_left
      ... = id     : H
+
+  definition homset [reducible] (x y : ob) : hset :=
+  hset.mk (hom x y) _
+
 end precategory
 
-inductive Precategory : Type := mk : Π (ob : Type), precategory ob → Precategory
+structure Precategory : Type :=
+  (objects : Type)
+  (category_instance : precategory objects)
 
 namespace precategory
   definition Mk {ob} (C) : Precategory := Precategory.mk ob C
   definition MK (a b c d e f g h) : Precategory := Precategory.mk a (precategory.mk b c d e f g h)
 
-  definition objects [coercion] [reducible] (C : Precategory) : Type
+  definition objects [coercion] [reducible] := Precategory.objects
-  := Precategory.rec (fun c s, c) C
+  definition category_instance [instance] [coercion] [reducible] := Precategory.category_instance
-
+  notation g `∘⁅` C `⁆` f := @compose (objects C) (category_instance C) _ _ _ g f
-  definition category_instance [instance] [coercion] [reducible] (C : Precategory) : precategory (objects C)
+  -- TODO: make this left associative
-  := Precategory.rec (fun c s, s) C
+  -- TODO: change this notation?
 
 end precategory
 
 open precategory
 
-theorem Precategory.equal (C : Precategory) : Precategory.mk C C = C :=
+protected definition Precategory.eta (C : Precategory) : Precategory.mk C C = C :=
-  Precategory.rec (λ ob c, idp) C
+Precategory.rec (λob c, idp) C

hott/algebra/precategory/constructions.hlean

@@ -5,15 +5,15 @@
 -- This file contains basic constructions on precategories, including common precategories
 
 
-import .natural_transformation
+import .nat_trans
 import types.prod types.sigma types.pi
 
-open eq prod eq eq.ops equiv truncation
+open eq prod eq eq.ops equiv is_trunc funext
 
 namespace precategory
   namespace opposite
 
-  definition opposite {ob : Type} (C : precategory ob) : precategory ob :=
+  definition opposite [reducible] {ob : Type} (C : precategory ob) : precategory ob :=
   mk (λ a b, hom b a)
      (λ b a, !homH)
      (λ a b c f g, g ∘ f)
@@ -22,7 +22,7 @@ namespace precategory
      (λ a b f, !id_right)
      (λ a b f, !id_left)
 
-  definition Opposite (C : Precategory) : Precategory := Mk (opposite C)
+  definition Opposite [reducible] (C : Precategory) : Precategory := Mk (opposite C)
 
   infixr `∘op`:60 := @compose _ (opposite _) _ _ _
 
@@ -40,13 +40,13 @@ namespace precategory
   begin
     apply (precategory.rec_on C), intros (hom', homH', comp', ID', assoc', id_left', id_right'),
     apply (ap (λassoc'', precategory.mk hom' @homH' comp' ID' assoc'' id_left' id_right')),
-    repeat ( apply funext.path_pi ; intros ),
+    repeat ( apply funext.eq_of_homotopy ; intros ),
     apply ap,
     apply (@is_hset.elim), apply !homH',
   end
 
-  theorem op_op : Opposite (Opposite C) = C :=
+  definition op_op : Opposite (Opposite C) = C :=
-  (ap (Precategory.mk C) (op_op' C)) ⬝ !Precategory.equal
+  (ap (Precategory.mk C) (op_op' C)) ⬝ !Precategory.eta
 
   end opposite
 
@@ -86,27 +86,25 @@ namespace precategory
 
   namespace product
   section
-  open prod truncation
+  open prod is_trunc
 
-  definition prod_precategory {obC obD : Type} (C : precategory obC) (D : precategory obD)
+  definition prod_precategory [reducible] [instance] {obC obD : Type} (C : precategory obC) (D : precategory obD)
       : precategory (obC × obD) :=
   mk (λ a b, hom (pr1 a) (pr1 b) × hom (pr2 a) (pr2 b))
-     (λ a b, !trunc_prod)
+     (λ a b, !is_trunc_prod)
      (λ a b c g f, (pr1 g ∘ pr1 f , pr2 g ∘ pr2 f) )
      (λ a, (id, id))
-     (λ a b c d h g f, pair_path  !assoc    !assoc   )
+     (λ a b c d h g f, pair_eq  !assoc    !assoc   )
-     (λ a b f,         prod.path  !id_left  !id_left )
+     (λ a b f,         prod_eq  !id_left  !id_left )
-     (λ a b f,         prod.path  !id_right !id_right)
+     (λ a b f,         prod_eq  !id_right !id_right)
 
-  definition Prod_precategory (C D : Precategory) : Precategory := Mk (prod_precategory C D)
+  definition Prod_precategory [reducible] (C D : Precategory) : Precategory := Mk (prod_precategory C D)
 
   end
   end product
 
   namespace ops
-
+    --notation 1 := Category_one
-    --notation `type`:max := Type_category
-    --notation 1 := Category_one --it was confusing for me (Floris) that no ``s are needed here
     --notation 2 := Category_two
     postfix `ᵒᵖ`:max := opposite.Opposite
     infixr `×c`:30 := product.Prod_precategory
@@ -118,248 +116,55 @@ namespace precategory
 
   open ops
   namespace opposite
-  section
   open ops functor
-  set_option pp.universes true
+  definition opposite_functor [reducible] {C D : Precategory} (F : C ⇒ D) : Cᵒᵖ ⇒ Dᵒᵖ :=
-
+  begin
-  definition opposite_functor {C D : Precategory} (F : C ⇒ D) : Cᵒᵖ ⇒ Dᵒᵖ :=
-  /-begin
     apply (@functor.mk (Cᵒᵖ) (Dᵒᵖ)),
       intro a, apply (respect_id F),
       intros, apply (@respect_comp C D)
-  end-/ sorry
-
   end
+
   end opposite
 
   namespace product
   section
   open ops functor
-  definition prod_functor {C C' D D' : Precategory} (F : C ⇒ D) (G : C' ⇒ D') : C ×c C' ⇒ D ×c D' :=
+  definition prod_functor [reducible] {C C' D D' : Precategory} (F : C ⇒ D) (G : C' ⇒ D') : C ×c C' ⇒ D ×c D' :=
   functor.mk (λ a, pair (F (pr1 a)) (G (pr2 a)))
              (λ a b f, pair (F (pr1 f)) (G (pr2 f)))
-             (λ a, pair_path !respect_id !respect_id)
+             (λ a, pair_eq !respect_id !respect_id)
-             (λ a b c g f, pair_path !respect_comp !respect_comp)
+             (λ a b c g f, pair_eq !respect_comp !respect_comp)
   end
   end product
 
+  definition precategory_hset [reducible] : precategory hset :=
+  precategory.mk (λx y : hset, x → y)
+                 _
+                 (λx y z g f a, g (f a))
+                 (λx a, a)
+                 (λx y z w h g f, eq_of_homotopy (λa, idp))
+                 (λx y f, eq_of_homotopy (λa, idp))
+                 (λx y f, eq_of_homotopy (λa, idp))
+
+  definition Precategory_hset [reducible] : Precategory :=
+  Precategory.mk hset precategory_hset
+
   namespace ops
   infixr `×f`:30 := product.prod_functor
   infixr `ᵒᵖᶠ`:max := opposite.opposite_functor
+  abbreviation set := Precategory_hset
   end ops
 
-  section functor_category
+  section precategory_functor
   variables (C D : Precategory)
-  definition functor_category [fx : funext] : precategory (functor C D) :=
+  definition precategory_functor [reducible] : precategory (functor C D) :=
-  mk (λa b, natural_transformation a b)
+  mk (λa b, nat_trans a b)
-     (λ a b, @natural_transformation.to_hset C D a b)
+     (λ a b, @nat_trans.to_hset C D a b)
-     (λ a b c g f, natural_transformation.compose g f)
+     (λ a b c g f, nat_trans.compose g f)
-     (λ a, natural_transformation.id)
+     (λ a, nat_trans.id)
-     (λ a b c d h g f, !natural_transformation.assoc)
+     (λ a b c d h g f, !nat_trans.assoc)
-     (λ a b f, !natural_transformation.id_left)
+     (λ a b f, !nat_trans.id_left)
-     (λ a b f, !natural_transformation.id_right)
+     (λ a b f, !nat_trans.id_right)
-  end functor_category
+  end precategory_functor
 
-  namespace slice
+end precategory
-  open sigma function
-  variables {ob : Type} {C : precategory ob} {c : ob}
-  protected definition slice_obs (C : precategory ob) (c : ob) := Σ(b : ob), hom b c
-  variables {a b : slice_obs C c}
-  protected definition to_ob  (a : slice_obs C c) : ob              := pr1 a
-  protected definition to_ob_def (a : slice_obs C c) : to_ob a = pr1 a := rfl
-  protected definition ob_hom (a : slice_obs C c) : hom (to_ob a) c := pr2 a
-  -- protected theorem slice_obs_equal (H₁ : to_ob a = to_ob b)
-  --     (H₂ : eq.drec_on H₁ (ob_hom a) = ob_hom b) : a = b :=
-  -- sigma.equal H₁ H₂
-
-
-  protected definition slice_hom (a b : slice_obs C c) : Type :=
-  Σ(g : hom (to_ob a) (to_ob b)), ob_hom b ∘ g = ob_hom a
-
-  protected definition hom_hom  (f : slice_hom a b) : hom (to_ob a) (to_ob b)          := pr1 f
-  protected definition commute (f : slice_hom a b) : ob_hom b ∘ (hom_hom f) = ob_hom a := pr2 f
-  -- protected theorem slice_hom_equal (f g : slice_hom a b) (H : hom_hom f = hom_hom g) : f = g :=
-  -- sigma.equal H !proof_irrel
-
-  /- TODO wait for some helping lemmas
-  definition slice_category (C : precategory ob) (c : ob) : precategory (slice_obs C c) :=
-  mk (λa b, slice_hom a b)
-     sorry
-     (λ a b c g f, dpair (hom_hom g ∘ hom_hom f)
-       (show ob_hom c ∘ (hom_hom g ∘ hom_hom f) = ob_hom a,
-         proof
-         calc
-           ob_hom c ∘ (hom_hom g ∘ hom_hom f) = (ob_hom c ∘ hom_hom g) ∘ hom_hom f : !assoc
-             ... = ob_hom b ∘ hom_hom f : {commute g}
-             ... = ob_hom a : {commute f}
-         qed))
-     (λ a, dpair id !id_right)
-     (λ a b c d h g f, dpair_path  !assoc    sorry)
-     (λ a b f,         sigma.path !id_left  sorry)
-     (λ a b f,         sigma.path !id_right sorry)
-  -/
-
-
-  -- definition slice_category {ob : Type} (C : category ob) (c : ob) : category (Σ(b : ob), hom b c)
-  -- :=
-  -- mk (λa b, Σ(g : hom (dpr1 a) (dpr1 b)), dpr2 b ∘ g = dpr2 a)
-  --    (λ a b c g f, dpair (dpr1 g ∘ dpr1 f)
-  --      (show dpr2 c ∘ (dpr1 g ∘ dpr1 f) = dpr2 a,
-  --        proof
-  --        calc
-  --          dpr2 c ∘ (dpr1 g ∘ dpr1 f) = (dpr2 c ∘ dpr1 g) ∘ dpr1 f : !assoc
-  --            ... = dpr2 b ∘ dpr1 f : {dpr2 g}
-  --            ... = dpr2 a : {dpr2 f}
-  --        qed))
-  --    (λ a, dpair id !id_right)
-  --    (λ a b c d h g f, dpair_eq    !assoc    !proof_irrel)
-  --    (λ a b f,         sigma.equal !id_left  !proof_irrel)
-  --    (λ a b f,         sigma.equal !id_right !proof_irrel)
-  -- We use !proof_irrel instead of rfl, to give the unifier an easier time
-
-exit
-  definition Slice_category [reducible] (C : Category) (c : C) := Mk (slice_category C c)
-  open category.ops
-  attribute slice_category [instance]
-  variables {D : Category}
-  definition forgetful (x : D) : (Slice_category D x) ⇒ D :=
-  functor.mk (λ a, to_ob a)
-             (λ a b f, hom_hom f)
-             (λ a, rfl)
-             (λ a b c g f, rfl)
-
-  definition postcomposition_functor {x y : D} (h : x ⟶ y)
-      : Slice_category D x ⇒ Slice_category D y :=
-  functor.mk (λ a, dpair (to_ob a) (h ∘ ob_hom a))
-             (λ a b f, dpair (hom_hom f)
-       (calc
-         (h ∘ ob_hom b) ∘ hom_hom f = h ∘ (ob_hom b ∘ hom_hom f) : assoc h (ob_hom b) (hom_hom f)⁻¹
-           ... = h ∘ ob_hom a : congr_arg (λx, h ∘ x) (commute f)))
-             (λ a, rfl)
-             (λ a b c g f, dpair_eq rfl !proof_irrel)
-
-  -- -- in the following comment I tried to have (A = B) in the type of a == b, but that doesn't solve the problems
-  -- definition heq2 {A B : Type} (H : A = B) (a : A) (b : B) := a == b
-  -- definition heq2.intro {A B : Type} {a : A} {b : B} (H : a == b) : heq2 (heq.type_eq H) a b := H
-  -- definition heq2.elim {A B : Type} {a : A} {b : B} (H : A = B) (H2 : heq2 H a b) : a == b := H2
-  -- definition heq2.proof_irrel {A B : Prop} (a : A) (b : B) (H : A = B) : heq2 H a b :=
-  -- hproof_irrel H a b
-  -- theorem functor.mk_eq2 {C D : Category} {obF obG : C → D} {homF homG idF idG compF compG}
-  --    (Hob : ∀x, obF x = obG x)
-  --    (Hmor : ∀(a b : C) (f : a ⟶ b), heq2 (congr_arg (λ x, x a ⟶ x b) (funext Hob)) (homF a b f) (homG a b f))
-  --      : functor.mk obF homF idF compF = functor.mk obG homG idG compG :=
-  -- hddcongr_arg4 functor.mk
-  --             (funext Hob)
-  --             (hfunext (λ a, hfunext (λ b, hfunext (λ f, !Hmor))))
-  --             !proof_irrel
-  --             !proof_irrel
-
---  set_option pp.implicit true
---  set_option pp.coercions true
-
-  -- definition slice_functor : D ⇒ Category_of_categories :=
-  -- functor.mk (λ a, Category.mk (slice_obs D a) (slice_category D a))
-  --            (λ a b f, postcomposition_functor f)
-  --            (λ a, functor.mk_heq
-  --              (λx, sigma.equal rfl !id_left)
-  --              (λb c f, sigma.hequal sorry !heq.refl (hproof_irrel sorry _ _)))
-  --            (λ a b c g f, functor.mk_heq
-  --                    (λx, sigma.equal (sorry ⬝ refl (dpr1 x)) sorry)
-  --                    (λb c f, sorry))
-
-  --the error message generated here is really confusing: the type of the above refl should be
-  -- "@dpr1 D (λ (a_1 : D), a_1 ⟶ a) x = @dpr1 D (λ (a_1 : D), a_1 ⟶ c) x", but the second dpr1 is not even well-typed
-
-  end slice
-
-  -- section coslice
-  -- open sigma
-
-  -- definition coslice {ob : Type} (C : category ob) (c : ob) : category (Σ(b : ob), hom c b) :=
-  -- mk (λa b, Σ(g : hom (dpr1 a) (dpr1 b)), g ∘ dpr2 a = dpr2 b)
-  --    (λ a b c g f, dpair (dpr1 g ∘ dpr1 f)
-  --      (show (dpr1 g ∘ dpr1 f) ∘ dpr2 a = dpr2 c,
-  --        proof
-  --        calc
-  --          (dpr1 g ∘ dpr1 f) ∘ dpr2 a = dpr1 g ∘ (dpr1 f ∘ dpr2 a): symm !assoc
-  --            ... = dpr1 g ∘ dpr2 b : {dpr2 f}
-  --            ... = dpr2 c : {dpr2 g}
-  --        qed))
-  --    (λ a, dpair id !id_left)
-  --    (λ a b c d h g f, dpair_eq    !assoc    !proof_irrel)
-  --    (λ a b f,         sigma.equal !id_left  !proof_irrel)
-  --    (λ a b f,         sigma.equal !id_right !proof_irrel)
-
-  -- -- theorem slice_coslice_opp {ob : Type} (C : category ob) (c : ob) :
-  -- --     coslice C c = opposite (slice (opposite C) c) :=
-  -- -- sorry
-  -- end coslice
-
-  section arrow
-  open sigma eq.ops
-  -- theorem concat_commutative_squares {ob : Type} {C : category ob} {a1 a2 a3 b1 b2 b3 : ob}
-  --     {f1 : a1 => b1} {f2 : a2 => b2} {f3 : a3 => b3} {g2 : a2 => a3} {g1 : a1 => a2}
-  --     {h2 : b2 => b3} {h1 : b1 => b2} (H1 : f2 ∘ g1 = h1 ∘ f1) (H2 : f3 ∘ g2 = h2 ∘ f2)
-  --       : f3 ∘ (g2 ∘ g1) = (h2 ∘ h1) ∘ f1 :=
-  -- calc
-  --   f3 ∘ (g2 ∘ g1) = (f3 ∘ g2) ∘ g1 : assoc
-  --     ... = (h2 ∘ f2) ∘ g1 : {H2}
-  --     ... = h2 ∘ (f2 ∘ g1) : symm assoc
-  --     ... = h2 ∘ (h1 ∘ f1) : {H1}
-  --     ... = (h2 ∘ h1) ∘ f1 : assoc
-
-  -- definition arrow {ob : Type} (C : category ob) : category (Σ(a b : ob), hom a b) :=
-  -- mk (λa b, Σ(g : hom (dpr1 a) (dpr1 b)) (h : hom (dpr2' a) (dpr2' b)),
-  --      dpr3 b ∘ g = h ∘ dpr3 a)
-  --    (λ a b c g f, dpair (dpr1 g ∘ dpr1 f) (dpair (dpr2' g ∘ dpr2' f) (concat_commutative_squares (dpr3 f) (dpr3 g))))
-  --    (λ a, dpair id (dpair id (id_right ⬝ (symm id_left))))
-  --    (λ a b c d h g f, dtrip_eq2   assoc    assoc    !proof_irrel)
-  --    (λ a b f,         trip.equal2 id_left  id_left  !proof_irrel)
-  --    (λ a b f,         trip.equal2 id_right id_right !proof_irrel)
-
-  -- make these definitions private?
-  variables {ob : Type} {C : category ob}
-  protected definition arrow_obs (ob : Type) (C : category ob) := Σ(a b : ob), hom a b
-  variables {a b : arrow_obs ob C}
-  protected definition src    (a : arrow_obs ob C) : ob                  := dpr1 a
-  protected definition dst    (a : arrow_obs ob C) : ob                  := dpr2' a
-  protected definition to_hom (a : arrow_obs ob C) : hom (src a) (dst a) := dpr3 a
-
-  protected definition arrow_hom (a b : arrow_obs ob C) : Type :=
-  Σ (g : hom (src a) (src b)) (h : hom (dst a) (dst b)), to_hom b ∘ g = h ∘ to_hom a
-
-  protected definition hom_src (m : arrow_hom a b) : hom (src a) (src b) := dpr1 m
-  protected definition hom_dst (m : arrow_hom a b) : hom (dst a) (dst b) := dpr2' m
-  protected definition commute (m : arrow_hom a b) : to_hom b ∘ (hom_src m) = (hom_dst m) ∘ to_hom a
-  := dpr3 m
-
-  definition arrow (ob : Type) (C : category ob) : category (arrow_obs ob C) :=
-  mk (λa b, arrow_hom a b)
-     (λ a b c g f, dpair (hom_src g ∘ hom_src f) (dpair (hom_dst g ∘ hom_dst f)
-        (show to_hom c ∘ (hom_src g ∘ hom_src f) = (hom_dst g ∘ hom_dst f) ∘ to_hom a,
-         proof
-         calc
-         to_hom c ∘ (hom_src g ∘ hom_src f) = (to_hom c ∘ hom_src g) ∘ hom_src f : !assoc
-           ... = (hom_dst g ∘ to_hom b) ∘ hom_src f  : {commute g}
-           ... = hom_dst g ∘ (to_hom b ∘ hom_src f)  : symm !assoc
-           ... = hom_dst g ∘ (hom_dst f ∘ to_hom a)  : {commute f}
-           ... = (hom_dst g ∘ hom_dst f) ∘ to_hom a  : !assoc
-         qed)
-       ))
-     (λ a, dpair id (dpair id (!id_right ⬝ (symm !id_left))))
-     (λ a b c d h g f, ndtrip_eq       !assoc    !assoc    !proof_irrel)
-     (λ a b f,         ndtrip_equal !id_left  !id_left  !proof_irrel)
-     (λ a b f,         ndtrip_equal !id_right !id_right !proof_irrel)
-
-  end arrow
-
-end category
-
-  -- definition foo
-  --     : category (sorry) :=
-  -- mk (λa b, sorry)
-  --    (λ a b c g f, sorry)
-  --    (λ a, sorry)
-  --    (λ a b c d h g f, sorry)
-  --    (λ a b f, sorry)
-  --    (λ a b f, sorry)

hott/algebra/precategory/functor.hlean

@@ -4,7 +4,7 @@
 
 import .basic types.pi
 
-open function precategory eq prod equiv is_equiv sigma sigma.ops truncation
+open function precategory eq prod equiv is_equiv sigma sigma.ops is_trunc
 open pi
 
 structure functor (C D : Precategory) : Type :=
@@ -49,25 +49,25 @@ namespace functor
   protected definition strict_cat_has_functor_hset
     [HD : is_hset (objects D)] : is_hset (functor C D) :=
   begin
-    apply trunc_equiv, apply equiv.to_is_equiv,
+    apply is_trunc_is_equiv_closed, apply equiv.to_is_equiv,
       apply sigma_char,
-    apply trunc_sigma, apply trunc_pi, intros, exact HD, intro F,
+    apply is_trunc_sigma, apply is_trunc_pi, intros, exact HD, intro F,
-    apply trunc_sigma, apply trunc_pi, intro a,
+    apply is_trunc_sigma, apply is_trunc_pi, intro a,
-      apply trunc_pi, intro b,
+      apply is_trunc_pi, intro b,
-      apply trunc_pi, intro c, apply !homH,
+      apply is_trunc_pi, intro c, apply !homH,
-    intro H, apply trunc_prod,
+    intro H, apply is_trunc_prod,
-      apply trunc_pi, intro a,
+      apply is_trunc_pi, intro a,
-      apply succ_is_trunc, apply trunc_succ, apply !homH,
+      apply is_trunc_eq, apply is_trunc_succ, apply !homH,
-    apply trunc_pi, intro a,
+    apply is_trunc_pi, intro a,
-    apply trunc_pi, intro b,
+    apply is_trunc_pi, intro b,
-    apply trunc_pi, intro c,
+    apply is_trunc_pi, intro c,
-    apply trunc_pi, intro g,
+    apply is_trunc_pi, intro g,
-    apply trunc_pi, intro f,
+    apply is_trunc_pi, intro f,
-      apply succ_is_trunc, apply trunc_succ, apply !homH,
+      apply is_trunc_eq, apply is_trunc_succ, apply !homH,
   end
 
   -- The following lemmas will later be used to prove that the type of
-  -- precategories formes a precategory itself
+  -- precategories forms a precategory itself
   protected definition compose (G : functor D E) (F : functor C D) : functor C E :=
   functor.mk
     (λ x, G (F x))
@@ -106,10 +106,10 @@ namespace functor
     apply (functor.rec_on G), intros (G1, G2, G3, G4),
     apply (functor.rec_on F), intros (F1, F2, F3, F4),
     fapply functor.congr,
-      apply funext.path_pi, intro a,
+      apply funext.eq_of_homotopy, intro a,
       apply (@is_hset.elim), apply !homH,
-    apply funext.path_pi, intro a,
+    apply funext.eq_of_homotopy, intro a,
-    repeat (apply funext.path_pi; intros),
+    repeat (apply funext.eq_of_homotopy; intros),
     apply (@is_hset.elim), apply !homH,
   end
 
@@ -122,9 +122,9 @@ namespace functor
   begin
     apply (functor.rec_on F), intros (F1, F2, F3, F4),
     fapply functor.congr,
-      apply funext.path_pi, intro a,
+      apply funext.eq_of_homotopy, intro a,
       apply (@is_hset.elim), apply !homH,
-    repeat (apply funext.path_pi; intros),
+    repeat (apply funext.eq_of_homotopy; intros),
     apply (@is_hset.elim), apply !homH,
   end
 
@@ -132,9 +132,9 @@ namespace functor
   begin
     apply (functor.rec_on F), intros (F1, F2, F3, F4),
     fapply functor.congr,
-      apply funext.path_pi, intro a,
+      apply funext.eq_of_homotopy, intro a,
       apply (@is_hset.elim), apply !homH,
-    repeat (apply funext.path_pi; intros),
+    repeat (apply funext.eq_of_homotopy; intros),
     apply (@is_hset.elim), apply !homH,
   end
 

hott/algebra/precategory/iso.hlean

@@ -4,7 +4,7 @@
 
 import .basic .morphism types.sigma
 
-open eq precategory sigma sigma.ops equiv is_equiv function truncation
+open eq precategory sigma sigma.ops equiv is_equiv function is_trunc
 open prod
 
 namespace morphism
@@ -45,20 +45,20 @@ namespace morphism
   -- The statement "f is an isomorphism" is a mere proposition
   definition is_hprop_of_is_iso : is_hset (is_iso f) :=
   begin
-    apply trunc_equiv,
+    apply is_trunc_is_equiv_closed,
       apply (equiv.to_is_equiv (!sigma_char)),
-    apply trunc_sigma,
+    apply is_trunc_sigma,
       apply (!homH),
-    intro g, apply trunc_prod,
+    intro g, apply is_trunc_prod,
-      repeat (apply succ_is_trunc; apply trunc_succ; apply (!homH)),
+      repeat (apply is_trunc_eq; apply is_trunc_succ; apply (!homH)),
   end
 
   -- The type of isomorphisms between two objects is a set
   definition is_hset_iso : is_hset (a ≅ b) :=
   begin
-    apply trunc_equiv,
+    apply is_trunc_is_equiv_closed,
       apply (equiv.to_is_equiv (!sigma_is_iso_equiv)),
-    apply trunc_sigma,
+    apply is_trunc_sigma,
       apply homH,
     intro f, apply is_hprop_of_is_iso,
   end

hott/algebra/precategory/morphism.hlean

@@ -4,7 +4,7 @@
 
 import .basic
 
-open eq precategory sigma sigma.ops equiv is_equiv function truncation
+open eq precategory sigma sigma.ops equiv is_equiv function is_trunc
 
 namespace morphism
   variables {ob : Type} [C : precategory ob] include C
@@ -39,16 +39,16 @@ namespace morphism
   theorem compose_section (f : a ⟶ b) [H : is_retraction f] : f ∘ section_of f = id :=
   is_retraction.rec (λg h, h) H
 
-  theorem iso_imp_retraction [instance] (f : a ⟶ b) [H : is_iso f] : is_section f :=
+  theorem is_section_of_is_iso [instance] (f : a ⟶ b) [H : is_iso f] : is_section f :=
   is_section.mk !inverse_compose
 
-  theorem iso_imp_section [instance] (f : a ⟶ b) [H : is_iso f] : is_retraction f :=
+  theorem is_retraction_of_is_iso [instance] (f : a ⟶ b) [H : is_iso f] : is_retraction f :=
   is_retraction.mk !compose_inverse
 
-  theorem id_is_iso [instance] : is_iso (ID a) :=
+  theorem is_iso_id [instance] : is_iso (ID a) :=
   is_iso.mk !id_compose !id_compose
 
-  theorem inverse_is_iso [instance] (f : a ⟶ b) [H : is_iso f] : is_iso (f⁻¹) :=
+  theorem is_iso_inverse [instance] (f : a ⟶ b) [H : is_iso f] : is_iso (f⁻¹) :=
   is_iso.mk !compose_inverse !inverse_compose
 
   theorem left_inverse_eq_right_inverse {f : a ⟶ b} {g g' : hom b a}
@@ -72,13 +72,13 @@ namespace morphism
   theorem inverse_eq_intro_left [H : is_iso f] (H2 : h ∘ f = id) : f⁻¹ = h
   := (left_inverse_eq_right_inverse H2 !compose_inverse)⁻¹
 
-  theorem section_eq_retraction (f : a ⟶ b) [Hl : is_section f] [Hr : is_retraction f] :
+  theorem section_of_eq_retraction_of (f : a ⟶ b) [Hl : is_section f] [Hr : is_retraction f] :
       retraction_of f = section_of f :=
   retraction_eq_intro !compose_section
 
-  theorem section_retraction_imp_iso (f : a ⟶ b) [Hl : is_section f] [Hr : is_retraction f]
+  theorem is_iso_of_is_retraction_of_is_section (f : a ⟶ b) [Hl : is_section f] [Hr : is_retraction f]
       : is_iso f :=
-  is_iso.mk ((section_eq_retraction f) ▹ (retraction_compose f)) (compose_section f)
+  is_iso.mk ((section_of_eq_retraction_of f) ▹ (retraction_compose f)) (compose_section f)
 
   theorem inverse_unique (H H' : is_iso f) : @inverse _ _ _ _ f H = @inverse _ _ _ _ f H' :=
   inverse_eq_intro_left !inverse_compose
@@ -92,10 +92,10 @@ namespace morphism
   theorem section_of_id : section_of (ID a) = id :=
   section_eq_intro !id_compose
 
-  theorem iso_of_id [H : is_iso (ID a)] : (ID a)⁻¹ = id :=
+  theorem id_inverse [H : is_iso (ID a)] : (ID a)⁻¹ = id :=
   inverse_eq_intro_left !id_compose
 
-  theorem composition_is_section [instance] [Hf : is_section f] [Hg : is_section g]
+  theorem is_section_comp [instance] [Hf : is_section f] [Hg : is_section g]
       : is_section (g ∘ f) :=
   have aux : retraction_of g ∘ g ∘ f = (retraction_of g ∘ g) ∘ f,
     from !assoc,
@@ -108,7 +108,7 @@ namespace morphism
         ... = retraction_of f ∘ f : {id_left f}
         ... = id : retraction_compose f)
 
-  theorem composition_is_retraction [instance] (Hf : is_retraction f) (Hg : is_retraction g)
+  theorem is_retraction_comp [instance] (Hf : is_retraction f) (Hg : is_retraction g)
       : is_retraction (g ∘ f) :=
   have aux : f ∘ section_of f ∘ section_of g = (f ∘ section_of f) ∘ section_of g,
     from !assoc,
@@ -121,20 +121,18 @@ namespace morphism
         ... = g ∘ section_of g : {id_left (section_of g)}
         ... = id : compose_section)
 
-  theorem composition_is_inverse [instance] (Hf : is_iso f) (Hg : is_iso g) : is_iso (g ∘ f) :=
+  theorem is_inverse_comp [instance] (Hf : is_iso f) (Hg : is_iso g) : is_iso (g ∘ f) :=
-  !section_retraction_imp_iso
+  !is_iso_of_is_retraction_of_is_section
 
   structure isomorphic (a b : ob) :=
     (iso : hom a b)
     [is_iso : is_iso iso]
 
   infix `≅`:50 := morphism.isomorphic
+  attribute isomorphic.is_iso [instance]
 
   namespace isomorphic
 
-    -- openrelation
-    attribute is_iso [instance]
-
     definition refl (a : ob) : a ≅ a :=
     mk id
 
@@ -144,8 +142,6 @@ namespace morphism
     definition trans ⦃a b c : ob⦄ (H1 : a ≅ b) (H2 : b ≅ c) : a ≅ c :=
     mk (iso H2 ∘ iso H1)
 
-  --theorem is_equivalence_eq [instance] (T : Type) : is_equivalence isomorphic :=
-  --is_equivalence.mk (is_reflexive.mk refl) (is_symmetric.mk symm) (is_transitive.mk trans)
   end isomorphic
 
   inductive is_mono [class] (f : a ⟶ b) : Type :=
@@ -153,12 +149,12 @@ namespace morphism
   inductive is_epi  [class] (f : a ⟶ b) : Type :=
   mk : (∀c (g h : hom b c), g ∘ f = h ∘ f → g = h) → is_epi f
 
-  theorem mono_elim [H : is_mono f] {g h : c ⟶ a} (H2 : f ∘ g = f ∘ h) : g = h
+  theorem is_mono.elim [H : is_mono f] {g h : c ⟶ a} (H2 : f ∘ g = f ∘ h) : g = h
   := is_mono.rec (λH3, H3 c g h H2) H
-  theorem epi_elim [H : is_epi f] {g h : b ⟶ c} (H2 : g ∘ f = h ∘ f) : g = h
+  theorem is_epi.elim [H : is_epi f] {g h : b ⟶ c} (H2 : g ∘ f = h ∘ f) : g = h
   := is_epi.rec  (λH3, H3 c g h H2) H
 
-  theorem section_is_mono [instance] (f : a ⟶ b) [H : is_section f] : is_mono f :=
+  theorem is_mono_of_is_section [instance] (f : a ⟶ b) [H : is_section f] : is_mono f :=
   is_mono.mk
     (λ c g h H,
       calc
@@ -170,7 +166,7 @@ namespace morphism
       ... = id ∘ h : retraction_compose f
       ... = h : id_left)
 
-  theorem retraction_is_epi [instance] (f : a ⟶ b) [H : is_retraction f] : is_epi f :=
+  theorem is_epi_of_is_retraction [instance] (f : a ⟶ b) [H : is_retraction f] : is_epi f :=
   is_epi.mk
     (λ c g h H,
       calc
@@ -182,28 +178,24 @@ namespace morphism
       ... = h ∘ id : compose_section f
       ... = h : id_right)
 
-  --these theorems are now proven automatically using type classes
+  theorem is_mono_comp [instance] [Hf : is_mono f] [Hg : is_mono g] : is_mono (g ∘ f) :=
-  --should they be instances?
-  theorem id_is_mono : is_mono (ID a)
-  theorem id_is_epi  : is_epi  (ID a)
-
-  theorem composition_is_mono [instance] [Hf : is_mono f] [Hg : is_mono g] : is_mono (g ∘ f) :=
   is_mono.mk
     (λ d h₁ h₂ H,
       have H2 : g ∘ (f ∘ h₁) = g ∘ (f ∘ h₂),
         from calc g ∘ (f ∘ h₁) = (g ∘ f) ∘ h₁ : !assoc
                           ... = (g ∘ f) ∘ h₂ : H
-                          ... = g ∘ (f ∘ h₂) : !assoc, mono_elim (mono_elim H2))
+                          ... = g ∘ (f ∘ h₂) : !assoc, is_mono.elim (is_mono.elim H2))
 
-  theorem composition_is_epi  [instance] [Hf : is_epi f] [Hg : is_epi g] : is_epi  (g ∘ f) :=
+  theorem is_epi_comp  [instance] [Hf : is_epi f] [Hg : is_epi g] : is_epi  (g ∘ f) :=
   is_epi.mk
     (λ d h₁ h₂ H,
       have H2 : (h₁ ∘ g) ∘ f = (h₂ ∘ g) ∘ f,
         from calc (h₁ ∘ g) ∘ f = h₁ ∘ g ∘ f : !assoc
                           ... = h₂ ∘ g ∘ f : H
-                          ... = (h₂ ∘ g) ∘ f: !assoc, epi_elim (epi_elim H2))
+                          ... = (h₂ ∘ g) ∘ f: !assoc, is_epi.elim (is_epi.elim H2))
 
 end morphism
+
 namespace morphism
 --rewrite lemmas for inverses, modified from
 --https://github.com/JasonGross/HoTT-categories/blob/master/theories/Categories/Category/Morphisms.v
@@ -237,7 +229,7 @@ namespace morphism
       ... = f ∘ id : inverse_compose q
       ... = f : id_right f
 
-  theorem inv_pp [H' : is_iso p] [Hpq : is_iso (q ∘ p)] : (q ∘ p)⁻¹ = p⁻¹ ∘ q⁻¹ :=
+  theorem con_inv [H' : is_iso p] [Hpq : is_iso (q ∘ p)] : (q ∘ p)⁻¹ = p⁻¹ ∘ q⁻¹ :=
   have H1 : (p⁻¹ ∘ q⁻¹) ∘ q ∘ p = p⁻¹ ∘ (q⁻¹ ∘ (q ∘ p)), from assoc (p⁻¹) (q⁻¹) (q ∘ p)⁻¹,
   have H2 : (p⁻¹) ∘ (q⁻¹ ∘ (q ∘ p)) = p⁻¹ ∘ p, from ap _ (compose_V_pp q p),
   have H3 : p⁻¹ ∘ p = id, from inverse_compose p,
@@ -249,14 +241,14 @@ namespace morphism
   --     (p⁻¹ ∘ (q⁻¹)) ∘ q ∘ p = p⁻¹ ∘ (q⁻¹ ∘ (q ∘ p)) : assoc (p⁻¹) (q⁻¹) (q ∘ p)⁻¹
   --     ... = (p⁻¹) ∘ p : congr_arg (λx, p⁻¹ ∘ x) (compose_V_pp q p)
   --     ... = id : inverse_compose p)
-  theorem inv_Vp [H' : is_iso g] : (q⁻¹ ∘ g)⁻¹ = g⁻¹ ∘ q :=
+  theorem inv_con_inv_left [H' : is_iso g] : (q⁻¹ ∘ g)⁻¹ = g⁻¹ ∘ q :=
-  inverse_involutive q ▹ inv_pp (q⁻¹) g
+  inverse_involutive q ▹ con_inv (q⁻¹) g
 
-  theorem inv_pV [H' : is_iso f] : (q ∘ f⁻¹)⁻¹ = f ∘ q⁻¹ :=
+  theorem inv_con_inv_right [H' : is_iso f] : (q ∘ f⁻¹)⁻¹ = f ∘ q⁻¹ :=
-  inverse_involutive f ▹ inv_pp q (f⁻¹)
+  inverse_involutive f ▹ con_inv q (f⁻¹)
 
-  theorem inv_VV [H' : is_iso r] : (q⁻¹ ∘ r⁻¹)⁻¹ = r ∘ q :=
+  theorem inv_con_inv_inv [H' : is_iso r] : (q⁻¹ ∘ r⁻¹)⁻¹ = r ∘ q :=
-  inverse_involutive r ▹ inv_Vp q (r⁻¹)
+  inverse_involutive r ▹ inv_con_inv_left q (r⁻¹)
 
   end
   section
@@ -269,22 +261,22 @@ namespace morphism
                    {y : d ⟶ b} {w : c ⟶ a}
   variable [Hq : is_iso q] include Hq
 
-  theorem moveR_Mp (H : y = q⁻¹ ∘ g) : q ∘ y = g := H⁻¹ ▹ compose_p_Vp q g
+  theorem con_eq_of_eq_inv_con (H : y = q⁻¹ ∘ g) : q ∘ y = g := H⁻¹ ▹ compose_p_Vp q g
-  theorem moveR_pM (H : w = f ∘ q⁻¹) : w ∘ q = f := H⁻¹ ▹ compose_pV_p f q
+  theorem con_eq_of_eq_con_inv (H : w = f ∘ q⁻¹) : w ∘ q = f := H⁻¹ ▹ compose_pV_p f q
-  theorem moveR_Vp (H : z = q ∘ p) : q⁻¹ ∘ z = p := H⁻¹ ▹ compose_V_pp q p
+  theorem inv_con_eq_of_eq_con (H : z = q ∘ p) : q⁻¹ ∘ z = p := H⁻¹ ▹ compose_V_pp q p
-  theorem moveR_pV (H : x = r ∘ q) : x ∘ q⁻¹ = r := H⁻¹ ▹ compose_pp_V r q
+  theorem con_inv_eq_of_eq_con (H : x = r ∘ q) : x ∘ q⁻¹ = r := H⁻¹ ▹ compose_pp_V r q
-  theorem moveL_Mp (H : q⁻¹ ∘ g = y) : g = q ∘ y := moveR_Mp (H⁻¹)⁻¹
+  theorem eq_con_of_inv_con_eq (H : q⁻¹ ∘ g = y) : g = q ∘ y := con_eq_of_eq_inv_con (H⁻¹)⁻¹
-  theorem moveL_pM (H : f ∘ q⁻¹ = w) : f = w ∘ q := moveR_pM (H⁻¹)⁻¹
+  theorem eq_con_of_con_inv_eq (H : f ∘ q⁻¹ = w) : f = w ∘ q := con_eq_of_eq_con_inv (H⁻¹)⁻¹
-  theorem moveL_Vp (H : q ∘ p = z) : p = q⁻¹ ∘ z := moveR_Vp (H⁻¹)⁻¹
+  theorem eq_inv_con_of_con_eq (H : q ∘ p = z) : p = q⁻¹ ∘ z := inv_con_eq_of_eq_con (H⁻¹)⁻¹
-  theorem moveL_pV (H : r ∘ q = x) : r = x ∘ q⁻¹ := moveR_pV (H⁻¹)⁻¹
+  theorem eq_con_inv_of_con_eq (H : r ∘ q = x) : r = x ∘ q⁻¹ := con_inv_eq_of_eq_con (H⁻¹)⁻¹
-  theorem moveL_1V (H : h ∘ q = id) : h = q⁻¹ := inverse_eq_intro_left H⁻¹
+  theorem eq_inv_of_con_eq_idp' (H : h ∘ q = id) : h = q⁻¹ := inverse_eq_intro_left H⁻¹
-  theorem moveL_V1 (H : q ∘ h = id) : h = q⁻¹ := inverse_eq_intro_right H⁻¹
+  theorem eq_inv_of_con_eq_idp (H : q ∘ h = id) : h = q⁻¹ := inverse_eq_intro_right H⁻¹
-  theorem moveL_1M (H : i ∘ q⁻¹ = id) : i = q := moveL_1V H ⬝ inverse_involutive q
+  theorem eq_of_con_inv_eq_idp (H : i ∘ q⁻¹ = id) : i = q := eq_inv_of_con_eq_idp' H ⬝ inverse_involutive q
-  theorem moveL_M1 (H : q⁻¹ ∘ i = id) : i = q := moveL_V1 H ⬝ inverse_involutive q
+  theorem eq_of_inv_con_eq_idp (H : q⁻¹ ∘ i = id) : i = q := eq_inv_of_con_eq_idp H ⬝ inverse_involutive q
-  theorem moveR_1M (H : id = i ∘ q⁻¹) : q = i := moveL_1M (H⁻¹)⁻¹
+  theorem eq_of_idp_eq_con_inv (H : id = i ∘ q⁻¹) : q = i := eq_of_con_inv_eq_idp (H⁻¹)⁻¹
-  theorem moveR_M1 (H : id = q⁻¹ ∘ i) : q = i := moveL_M1 (H⁻¹)⁻¹
+  theorem eq_of_idp_eq_inv_con (H : id = q⁻¹ ∘ i) : q = i := eq_of_inv_con_eq_idp (H⁻¹)⁻¹
-  theorem moveR_1V (H : id = h ∘ q) : q⁻¹ = h := moveL_1V (H⁻¹)⁻¹
+  theorem inv_eq_of_idp_eq_con (H : id = h ∘ q) : q⁻¹ = h := eq_inv_of_con_eq_idp' (H⁻¹)⁻¹
-  theorem moveR_V1 (H : id = q ∘ h) : q⁻¹ = h := moveL_V1 (H⁻¹)⁻¹
+  theorem inv_eq_of_idp_eq_con' (H : id = q ∘ h) : q⁻¹ = h := eq_inv_of_con_eq_idp (H⁻¹)⁻¹
   end
   end iso
 

hott/algebra/precategory/nat_trans.hlean

@@ -2,27 +2,27 @@
 -- Released under Apache 2.0 license as described in the file LICENSE.
 -- Author: Floris van Doorn, Jakob von Raumer
 
-import .functor types.pi
+import .functor
-open eq precategory functor truncation equiv sigma.ops sigma is_equiv function pi
+open eq precategory functor is_trunc equiv sigma.ops sigma is_equiv function pi
 
-inductive natural_transformation {C D : Precategory} (F G : C ⇒ D) : Type :=
+inductive nat_trans {C D : Precategory} (F G : C ⇒ D) : Type :=
 mk : Π (η : Π (a : C), hom (F a) (G a))
   (nat : Π {a b : C} (f : hom a b), G f ∘ η a = η b ∘ F f),
-  natural_transformation F G
+  nat_trans F G
 
-infixl `⟹`:25 := natural_transformation -- \==>
+infixl `⟹`:25 := nat_trans -- \==>
 
-namespace natural_transformation
+namespace nat_trans
   variables {C D : Precategory} {F G H I : functor C D}
 
   definition natural_map [coercion] (η : F ⟹ G) : Π (a : C), F a ⟶ G a :=
-  natural_transformation.rec (λ x y, x) η
+  nat_trans.rec (λ x y, x) η
 
   theorem naturality (η : F ⟹ G) : Π⦃a b : C⦄ (f : a ⟶ b), G f ∘ η a = η b ∘ F f :=
-  natural_transformation.rec (λ x y, y) η
+  nat_trans.rec (λ x y, y) η
 
   protected definition compose (η : G ⟹ H) (θ : F ⟹ G) : F ⟹ H :=
-  natural_transformation.mk
+  nat_trans.mk
     (λ a, η a ∘ θ a)
     (λ a b f,
       calc
@@ -41,10 +41,10 @@ namespace natural_transformation
     (nat₁ : Π (a b : C) (f : hom a b), G f ∘ η₁ a = η₁ b ∘ F f)
     (nat₂ : Π (a b : C) (f : hom a b), G f ∘ η₂ a = η₂ b ∘ F f)
     (p₁ : η₁ = η₂) (p₂ : p₁ ▹ nat₁ = nat₂)
-    : @natural_transformation.mk C D F G η₁ nat₁ = @natural_transformation.mk C D F G η₂ nat₂
+    : @nat_trans.mk C D F G η₁ nat₁ = @nat_trans.mk C D F G η₂ nat₂
   :=
   begin
-    apply (dcongr_arg2 (@natural_transformation.mk C D F G) p₁ p₂),
+    apply (apD011 (@nat_trans.mk C D F G) p₁ p₂),
   end
 
   set_option apply.class_instance false -- disable class instance resolution in the apply tactic
@@ -52,45 +52,45 @@ namespace natural_transformation
   protected definition assoc (η₃ : H ⟹ I) (η₂ : G ⟹ H) (η₁ : F ⟹ G) :
       η₃ ∘n (η₂ ∘n η₁) = (η₃ ∘n η₂) ∘n η₁ :=
   begin
-    apply (natural_transformation.rec_on η₃), intros (η₃1, η₃2),
+    apply (nat_trans.rec_on η₃), intros (η₃1, η₃2),
-    apply (natural_transformation.rec_on η₂), intros (η₂1, η₂2),
+    apply (nat_trans.rec_on η₂), intros (η₂1, η₂2),
-    apply (natural_transformation.rec_on η₁), intros (η₁1, η₁2),
+    apply (nat_trans.rec_on η₁), intros (η₁1, η₁2),
-    fapply natural_transformation.congr,
+    fapply nat_trans.congr,
-      apply funext.path_pi, intro a,
+      apply funext.eq_of_homotopy, intro a,
       apply assoc,
-    apply funext.path_pi, intro a,
+    apply funext.eq_of_homotopy, intro a,
-    apply funext.path_pi, intro b,
+    apply funext.eq_of_homotopy, intro b,
-    apply funext.path_pi, intro f,
+    apply funext.eq_of_homotopy, intro f,
     apply (@is_hset.elim), apply !homH,
   end
 
-  protected definition id {C D : Precategory} {F : functor C D} : natural_transformation F F :=
+  protected definition id {C D : Precategory} {F : functor C D} : nat_trans F F :=
   mk (λa, id) (λa b f, !id_right ⬝ (!id_left⁻¹))
 
-  protected definition ID {C D : Precategory} (F : functor C D) : natural_transformation F F :=
+  protected definition ID {C D : Precategory} (F : functor C D) : nat_trans F F :=
   id
 
   protected definition id_left (η : F ⟹ G) : id ∘n η = η :=
   begin
-    apply (natural_transformation.rec_on η), intros (η₁, nat₁),
+    apply (nat_trans.rec_on η), intros (η₁, nat₁),
-    fapply (natural_transformation.congr F G),
+    fapply (nat_trans.congr F G),
-      apply funext.path_pi, intro a,
+      apply funext.eq_of_homotopy, intro a,
       apply id_left,
-    apply funext.path_pi, intro a,
+    apply funext.eq_of_homotopy, intro a,
-    apply funext.path_pi, intro b,
+    apply funext.eq_of_homotopy, intro b,
-    apply funext.path_pi, intro f,
+    apply funext.eq_of_homotopy, intro f,
     apply (@is_hset.elim), apply !homH,
   end
 
   protected definition id_right (η : F ⟹ G) : η ∘n id = η :=
   begin
-    apply (natural_transformation.rec_on η), intros (η₁, nat₁),
+    apply (nat_trans.rec_on η), intros (η₁, nat₁),
-    fapply (natural_transformation.congr F G),
+    fapply (nat_trans.congr F G),
-      apply funext.path_pi, intro a,
+      apply funext.eq_of_homotopy, intro a,
       apply id_right,
-    apply funext.path_pi, intro a,
+    apply funext.eq_of_homotopy, intro a,
-    apply funext.path_pi, intro b,
+    apply funext.eq_of_homotopy, intro b,
-    apply funext.path_pi, intro f,
+    apply funext.eq_of_homotopy, intro f,
     apply (@is_hset.elim), apply !homH,
   end
 
@@ -99,34 +99,34 @@ namespace natural_transformation
     (Σ (η : Π (a : C), hom (F a) (G a)), Π (a b : C) (f : hom a b), G f ∘ η a = η b ∘ F f) ≃  (F ⟹ G) :=
   begin
     fapply equiv.mk,
-      intro S, apply natural_transformation.mk, exact (S.2),
+      intro S, apply nat_trans.mk, exact (S.2),
     fapply adjointify,
       intro H,
           fapply sigma.mk,
             intro a, exact (H a),
           intros (a, b, f), exact (naturality H f),
-    intro H, apply (natural_transformation.rec_on H),
+    intro H, apply (nat_trans.rec_on H),
     intros (eta, nat), unfold function.id,
-    fapply natural_transformation.congr,
+    fapply nat_trans.congr,
         apply idp,
-      repeat ( apply funext.path_pi ; intro a ),
+      repeat ( apply funext.eq_of_homotopy ; intro a ),
       apply (@is_hset.elim), apply !homH,
     intro S,
-    fapply sigma.path,
+    fapply sigma_eq,
-      apply funext.path_pi, intro a,
+      apply funext.eq_of_homotopy, intro a,
       apply idp,
-    repeat ( apply funext.path_pi ; intro a ),
+    repeat ( apply funext.eq_of_homotopy ; intro a ),
     apply (@is_hset.elim), apply !homH,
   end
 
   protected definition to_hset : is_hset (F ⟹ G) :=
   begin
-    apply trunc_equiv, apply (equiv.to_is_equiv !sigma_char),
+    apply is_trunc_is_equiv_closed, apply (equiv.to_is_equiv !sigma_char),
-    apply trunc_sigma,
+    apply is_trunc_sigma,
-      apply trunc_pi, intro a, exact (@homH (objects D) _ (F a) (G a)),
+      apply is_trunc_pi, intro a, exact (@homH (objects D) _ (F a) (G a)),
-    intro η, apply trunc_pi, intro a,
+    intro η, apply is_trunc_pi, intro a,
-    apply trunc_pi, intro b, apply trunc_pi, intro f,
+    apply is_trunc_pi, intro b, apply is_trunc_pi, intro f,
-    apply succ_is_trunc, apply trunc_succ, exact (@homH (objects D) _ (F a) (G b)),
+    apply is_trunc_eq, apply is_trunc_succ, exact (@homH (objects D) _ (F a) (G b)),
   end
 
-end natural_transformation
+end nat_trans

hott/algebra/precategory/yoneda.hlean

@@ -0,0 +1,91 @@
+/-
+Copyright (c) 2014 Floris van Doorn. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+
+Module: algebra.precategory.yoneda
+Author: Floris van Doorn
+-/
+
+--note: modify definition in category.set
+import .constructions .morphism
+
+open eq precategory equiv is_equiv is_trunc
+open is_trunc.trunctype funext precategory.ops prod.ops
+
+set_option pp.beta true
+
+namespace yoneda
+  definition representable_functor_assoc [C : Precategory] {a1 a2 a3 a4 a5 a6 : C} (f1 : a5 ⟶ a6) (f2 : a4 ⟶ a5) (f3 : a3 ⟶ a4) (f4 : a2 ⟶ a3) (f5 : a1 ⟶ a2) : (f1 ∘ f2) ∘ f3 ∘ (f4 ∘ f5) = f1 ∘ (f2 ∘ f3 ∘ f4) ∘ f5 :=
+  calc
+    (f1 ∘ f2) ∘ f3 ∘ f4 ∘ f5 = f1 ∘ f2 ∘ f3 ∘ f4 ∘ f5 : assoc
+    ... = f1 ∘ (f2 ∘ f3) ∘ f4 ∘ f5 : assoc
+    ... = f1 ∘ ((f2 ∘ f3) ∘ f4) ∘ f5 : assoc
+    ... = f1 ∘ (f2 ∘ f3 ∘ f4) ∘ f5 : assoc
+
+  --disturbing behaviour: giving the type of f "(x ⟶ y)" explicitly makes the unifier loop
+  definition representable_functor (C : Precategory) : Cᵒᵖ ×c C ⇒ set :=
+  functor.mk (λ(x : Cᵒᵖ ×c C), homset x.1 x.2)
+             (λ(x y : Cᵒᵖ ×c C) (f : _) (h : homset x.1 x.2), f.2 ∘⁅ C ⁆ (h ∘⁅ C ⁆ f.1))
+             proof (λ(x : Cᵒᵖ ×c C), eq_of_homotopy (λ(h : homset x.1 x.2), !id_left ⬝ !id_right)) qed
+             -- (λ(x y z : Cᵒᵖ ×c C) (g : y ⟶ z) (f : x ⟶ y), eq_of_homotopy (λ(h : hom x.1 x.2), representable_functor_assoc g.2 f.2 h f.1 g.1))
+             begin
+               intros (x, y, z, g, f), apply eq_of_homotopy, intro h,
+               exact (representable_functor_assoc g.2 f.2 h f.1 g.1),
+             end
+end yoneda
+
+attribute precategory_functor [instance] [reducible]
+namespace nat_trans
+  open morphism functor
+  variables {C D : Precategory} {F G : C ⇒ D} (η : F ⟹ G) (H : Π(a : C), is_iso (η a))
+  include H
+  definition nat_trans_inverse : G ⟹ F :=
+  nat_trans.mk
+    (λc, (η c)⁻¹)
+    (λc d f,
+    begin
+      apply iso.con_inv_eq_of_eq_con,
+      apply concat, rotate_left 1, apply assoc,
+      apply iso.eq_inv_con_of_con_eq,
+      apply inverse,
+      apply naturality,
+    end)
+
+  definition nat_trans_left_inverse : nat_trans_inverse η H ∘ η = nat_trans.id :=
+  begin
+  fapply (apD011 nat_trans.mk),
+    apply eq_of_homotopy, intro c, apply inverse_compose,
+  apply eq_of_homotopy, intros, apply eq_of_homotopy, intros, apply eq_of_homotopy, intros, fapply is_hset.elim
+  end
+
+  definition nat_trans_right_inverse : η ∘ nat_trans_inverse η H = nat_trans.id :=
+  begin
+  fapply (apD011 nat_trans.mk),
+    apply eq_of_homotopy, intro c, apply compose_inverse,
+  apply eq_of_homotopy, intros, apply eq_of_homotopy, intros, apply eq_of_homotopy, intros, fapply is_hset.elim
+  end
+
+  definition nat_trans_is_iso.mk : is_iso η :=
+  is_iso.mk (nat_trans_left_inverse η H) (nat_trans_right_inverse η H)
+
+end nat_trans
+
+-- Coq uses unit/counit definitions as basic
+
+-- open yoneda precategory.product precategory.opposite functor morphism
+--   --universe levels are given explicitly because Lean uses 6 variables otherwise
+
+--   structure adjoint.{u v} [C D : Precategory.{u v}] (F : C ⇒ D) (G : D ⇒ C) : Type.{max u v} :=
+--   (nat_iso : (representable_functor D) ∘f (prod_functor (opposite_functor F) (functor.ID D)) ⟹
+--              (representable_functor C) ∘f (prod_functor (functor.ID (Cᵒᵖ)) G))
+--   (is_iso_nat_iso : is_iso nat_iso)
+
+--   infix `⊣`:55 := adjoint
+
+-- namespace adjoint
+--   universe variables l1 l2
+--   variables [C D : Precategory.{l1 l2}] (F : C ⇒ D) (G : D ⇒ C)
+
+
+
+-- end adjoint

hott/default.hlean

@@ -1,8 +0,0 @@
--- Copyright (c) 2014 Jeremy Avigad. All rights reserved.
--- Released under Apache 2.0 license as described in the file LICENSE.
--- Author: Jeremy Avigad, Jakob von Raumer
-
--- hott.default
--- ============
-
--- A library for homotopy type theory

hott/equiv_precomp.hlean

@@ -1,60 +1,65 @@
--- Copyright (c) 2014 Jakob von Raumer. All rights reserved.
+/-
--- Released under Apache 2.0 license as described in the file LICENSE.
+Copyright (c) 2014 Jakob von Raumer. All rights reserved.
--- Author: Jakob von Raumer
+Released under Apache 2.0 license as described in the file LICENSE.
--- Ported from Coq HoTT
 
+Module: equiv_precomp
+Author: Jakob von Raumer
+
+Ported from Coq HoTT
+-/
+exit
 open eq function funext
 
 namespace is_equiv
   context
 
   --Precomposition of arbitrary functions with f
-  definition precomp {A B : Type} (f : A → B) (C : Type) (h : B → C) : A → C := h ∘ f
+  definition precompose {A B : Type} (f : A → B) (C : Type) (h : B → C) : A → C := h ∘ f
 
   --Postcomposition of arbitrary functions with f
-  definition postcomp {A B : Type} (f : A → B) (C : Type) (l : C → A) : C → B := f ∘ l
+  definition postcompose {A B : Type} (f : A → B) (C : Type) (l : C → A) : C → B := f ∘ l
 
   --Precomposing with an equivalence is an equivalence
-  definition precomp_closed [instance] {A B : Type} (f : A → B) [F : funext] [Hf : is_equiv f] (C : Type)
+  definition arrow_equiv_arrow_of_equiv_dom [instance] {A B : Type} (f : A → B) [F : funext] [Hf : is_equiv f] (C : Type)
-      : is_equiv (precomp f C) :=
+      : is_equiv (precompose f C) :=
-    adjointify (precomp f C) (λh, h ∘ f⁻¹)
+    adjointify (precompose f C) (λh, h ∘ f⁻¹)
-      (λh, path_pi (λx, ap h (sect f x)))
+      (λh, eq_of_homotopy (λx, ap h (sect f x)))
-      (λg, path_pi (λy, ap g (retr f y)))
+      (λg, eq_of_homotopy (λy, ap g (retr f y)))
 
   --Postcomposing with an equivalence is an equivalence
-  definition postcomp_closed [instance] {A B : Type} (f : A → B) [F : funext] [Hf : is_equiv f] (C : Type)
+  definition arrow_equiv_arrow_of_equiv_cod [instance] {A B : Type} (f : A → B) [F : funext] [Hf : is_equiv f] (C : Type)
-      : is_equiv (postcomp f C) :=
+      : is_equiv (postcompose f C) :=
-    adjointify (postcomp f C) (λl, f⁻¹ ∘ l)
+    adjointify (postcompose f C) (λl, f⁻¹ ∘ l)
-      (λh, path_pi (λx, retr f (h x)))
+      (λh, eq_of_homotopy (λx, retr f (h x)))
-      (λg, path_pi (λy, sect f (g y)))
+      (λg, eq_of_homotopy (λy, sect f (g y)))
 
   --Conversely, if pre- or post-composing with a function is always an equivalence,
   --then that function is also an equivalence.  It's convenient to know
   --that we only need to assume the equivalence when the other type is
   --the domain or the codomain.
-  protected definition isequiv_precompose_eq {A B : Type} (f : A → B) (C D : Type)
+  private definition isequiv_precompose_eq {A B : Type} (f : A → B) (C D : Type)
-      (Ceq : is_equiv (precomp f C)) (Deq : is_equiv (precomp f D)) (k : C → D) (h : A → C) :
+      (Ceq : is_equiv (precompose f C)) (Deq : is_equiv (precompose f D)) (k : C → D) (h : A → C) :
-      k ∘ (inv (precomp f C)) h = (inv (precomp f D)) (k ∘ h) :=
+      k ∘ (precompose f C)⁻¹ h = (precompose f D)⁻¹ (k ∘ h) :=
-    let invD := inv (precomp f D) in
+    let invD := inv (precompose f D) in
-    let invC := inv (precomp f C) in
+    let invC := inv (precompose f C) in
     have eq1 : invD (k ∘ h) = k ∘ (invC h),
-      from calc invD (k ∘ h) = invD (k ∘ (precomp f C (invC h))) : retr (precomp f C) h
+      from calc invD (k ∘ h) = invD (k ∘ (precompose f C (invC h))) : retr (precompose f C) h
 		... = k ∘ (invC h) : !sect,
       eq1⁻¹
 
-  definition from_isequiv_precomp {A B : Type} (f : A → B) (Aeq : is_equiv (precomp f A))
+  definition is_equiv_of_is_equiv_precomp {A B : Type} (f : A → B) (Aeq : is_equiv (precompose f A))
-      (Beq : is_equiv (precomp f B)) : (is_equiv f) :=
+      (Beq : is_equiv (precompose f B)) : (is_equiv f) :=
-    let invA := inv (precomp f A) in
+    let invA := inv (precompose f A) in
-    let invB := inv (precomp f B) in
+    let invB := inv (precompose f B) in
     let sect' : f ∘ (invA id) ∼ id  := (λx,
       calc f (invA id x) = (f ∘ invA id) x : idp
 	... = invB (f ∘ id) x : apD10 (!isequiv_precompose_eq)
-	... = invB (precomp f B id) x : idp
+	... = invB (precompose f B id) x : idp
-	... = x : apD10 (sect (precomp f B) id))
+	... = x : apD10 (sect (precompose f B) id))
       in
     let retr' : (invA id) ∘ f ∼ id := (λx,
-      calc invA id (f x) = precomp f A (invA id) x : idp
+      calc invA id (f x) = precompose f A (invA id) x : idp
-	... = x : apD10 (retr (precomp f A) id)) in
+	... = x : apD10 (retr (precompose f A) id)) in
     adjointify f (invA id) sect' retr'
 
   end
@@ -64,18 +69,18 @@ end is_equiv
 --Bundled versions of the previous theorems
 namespace equiv
 
-  definition precomp_closed [F : funext] {A B C : Type} {eqf : A ≃ B}
+  definition arrow_equiv_arrow_of_equiv_dom [F : funext] {A B C : Type} {eqf : A ≃ B}
       : (B → C) ≃ (A → C) :=
     let f := to_fun eqf in
     let Hf := to_is_equiv eqf in
-    equiv.mk (is_equiv.precomp f C)
+    equiv.mk (is_equiv.precompose f C)
-      (@is_equiv.precomp_closed A B f F Hf C)
+      (@is_equiv.arrow_equiv_arrow_of_equiv_dom A B f F Hf C)
 
-  definition postcomp_closed [F : funext] {A B C : Type} {eqf : A ≃ B}
+  definition arrow_equiv_arrow_of_equiv_cod [F : funext] {A B C : Type} {eqf : A ≃ B}
       : (C → A) ≃ (C → B) :=
     let f := to_fun eqf in
     let Hf := to_is_equiv eqf in
-    equiv.mk (is_equiv.postcomp f C)
+    equiv.mk (is_equiv.postcompose f C)
-      (@is_equiv.postcomp_closed A B f F Hf C)
+      (@is_equiv.arrow_equiv_arrow_of_equiv_cod A B f F Hf C)
 
 end equiv

hott/init/axioms/funext.hlean

@@ -10,25 +10,19 @@ open eq
 -- ------
 
 -- Define function extensionality as a type class
-inductive funext [class] : Type  :=
+structure funext [class] : Type  :=
-  mk : (Π (A : Type) (P : A → Type ) (f g : Π x, P x), is_equiv (@apD10 A P f g))
+(elim : Π (A : Type) (P : A → Type ) (f g : Π x, P x), is_equiv (@apD10 A P f g))
-         → funext
+
 
 namespace funext
 
-  universe variables l k
+  attribute elim [instance]
-  variables [F : funext.{l k}] {A : Type.{l}} {P : A → Type.{k}}
 
-  include F
+  definition eq_of_homotopy [F : funext] {A : Type} {P : A → Type} {f g : Π x, P x} : f ∼ g → f = g :=
-  protected definition ap [instance] (f g : Π x, P x) : is_equiv (@apD10 A P f g) :=
-    funext.rec_on F (λ(H : Π A P f g, _), !H)
-
-  definition path_pi {f g : Π x, P x} : f ∼ g → f = g :=
   is_equiv.inv (@apD10 A P f g)
 
-  omit F
+  definition eq_of_homotopy2 [F : funext] {A B : Type} {P : A → B → Type}
-  definition path_pi2 [F : funext] {A B : Type} {P : A → B → Type}
       (f g : Πx y, P x y) : (Πx y, f x y = g x y) → f = g :=
-    λ E, path_pi (λx, path_pi (E x))
+    λ E, eq_of_homotopy (λx, eq_of_homotopy (E x))
 
 end funext

hott/init/axioms/funext_of_ua.hlean

@@ -6,28 +6,28 @@ prelude
 import ..equiv ..datatypes ..types.prod
 import .funext_varieties .ua .funext
 
-open eq function prod sigma truncation equiv is_equiv unit
+open eq function prod is_trunc sigma equiv is_equiv unit
 
 context
   universe variables l
 
-  protected theorem ua_isequiv_postcompose {A B : Type.{l}} {C : Type}
+  private theorem ua_isequiv_postcompose {A B : Type.{l}} {C : Type}
-      {w : A → B} {H0 : is_equiv w} : is_equiv (@compose C A B w) :=
+      {w : A → B} [H0 : is_equiv w] : is_equiv (@compose C A B w) :=
     let w' := equiv.mk w H0 in
-    let eqinv : A = B := ((@is_equiv.inv _ _ _ (ua_is_equiv A B)) w') in
+    let eqinv : A = B := ((@is_equiv.inv _ _ _ (univalence A B)) w') in
-    let eq' := equiv_path eqinv in
+    let eq' := equiv_of_eq eqinv in
     is_equiv.adjointify (@compose C A B w)
       (@compose C B A (is_equiv.inv w))
       (λ (x : C → B),
         have eqretr : eq' = w',
-          from (@retr _ _ (@equiv_path A B) (ua_is_equiv A B) w'),
+          from (@retr _ _ (@equiv_of_eq A B) (univalence A B) w'),
         have invs_eq : (to_fun eq')⁻¹ = (to_fun w')⁻¹,
           from inv_eq eq' w' eqretr,
         have eqfin : (to_fun eq') ∘ ((to_fun eq')⁻¹ ∘ x) = x,
           from (λ p,
             (@eq.rec_on Type.{l} A
-              (λ B' p', Π (x' : C → B'), (to_fun (equiv_path p'))
+              (λ B' p', Π (x' : C → B'), (to_fun (equiv_of_eq p'))
-                ∘ ((to_fun (equiv_path p'))⁻¹ ∘ x') = x')
+                ∘ ((to_fun (equiv_of_eq p'))⁻¹ ∘ x') = x')
               B p (λ x', idp))
             ) eqinv x,
         have eqfin' : (to_fun w') ∘ ((to_fun eq')⁻¹ ∘ x) = x,
@@ -38,7 +38,7 @@ context
       )
       (λ (x : C → A),
         have eqretr : eq' = w',
-          from (@retr _ _ (@equiv_path A B) (ua_is_equiv A B) w'),
+          from (@retr _ _ (@equiv_of_eq A B) (univalence A B) w'),
         have invs_eq : (to_fun eq')⁻¹ = (to_fun w')⁻¹,
           from inv_eq eq' w' eqretr,
         have eqfin : (to_fun eq')⁻¹ ∘ ((to_fun eq') ∘ x) = x,
@@ -52,10 +52,10 @@ context
 
   -- We are ready to prove functional extensionality,
   -- starting with the naive non-dependent version.
-  protected definition diagonal [reducible] (B : Type) : Type
+  private definition diagonal [reducible] (B : Type) : Type
     := Σ xy : B × B, pr₁ xy = pr₂ xy
 
-  protected definition isequiv_src_compose {A B : Type}
+  private definition isequiv_src_compose {A B : Type}
       : @is_equiv (A → diagonal B)
                  (A → B)
                  (compose (pr₁ ∘ pr1)) :=
@@ -66,7 +66,7 @@ context
             (λ xy, prod.rec_on xy
               (λ b c p, eq.rec_on p idp))))
 
-  protected definition isequiv_tgt_compose {A B : Type}
+  private definition isequiv_tgt_compose {A B : Type}
       : @is_equiv (A → diagonal B)
                  (A → B)
                  (compose (pr₂ ∘ pr1)) :=
@@ -86,7 +86,7 @@ context
         have equiv1 [visible] : is_equiv precomp1,
           from @isequiv_src_compose A B,
         have equiv2 [visible] : Π x y, is_equiv (ap precomp1),
-          from is_equiv.ap_closed precomp1,
+          from is_equiv.is_equiv_ap precomp1,
         have H' : Π (x y : A → diagonal B),
             pr₁ ∘ pr1 ∘ x = pr₁ ∘ pr1 ∘ y → x = y,
           from (λ x y, is_equiv.inv (ap precomp1)),
@@ -103,14 +103,14 @@ end
 
 -- Now we use this to prove weak funext, which as we know
 -- implies (with dependent eta) also the strong dependent funext.
-theorem weak_funext_from_ua : weak_funext :=
+theorem weak_funext_of_ua : weak_funext :=
   (λ (A : Type) (P : A → Type) allcontr,
     let U := (λ (x : A), unit) in
   have pequiv : Π (x : A), P x ≃ U x,
-    from (λ x, @equiv_contr_unit(P x) (allcontr x)),
+    from (λ x, @equiv_unit_of_is_contr (P x) (allcontr x)),
   have psim : Π (x : A), P x = U x,
     from (λ x, @is_equiv.inv _ _
-      equiv_path (ua_is_equiv _ _) (pequiv x)),
+      equiv_of_eq (univalence _ _) (pequiv x)),
   have p : P = U,
     from @nondep_funext_from_ua A Type P U psim,
   have tU' : is_contr (A → unit),
@@ -125,5 +125,5 @@ theorem weak_funext_from_ua : weak_funext :=
 )
 
 -- In the following we will proof function extensionality using the univalence axiom
-definition funext_from_ua [instance] : funext :=
+definition funext_of_ua [instance] : funext :=
-  funext_from_weak_funext (@weak_funext_from_ua)
+  funext_of_weak_funext (@weak_funext_of_ua)

hott/init/axioms/funext_varieties.hlean

@@ -5,7 +5,7 @@
 prelude
 import ..path ..trunc ..equiv .funext
 
-open eq truncation sigma function
+open eq is_trunc sigma function
 
 /- In hott.axioms.funext, we defined function extensionality to be the assertion
    that the map apD10 is an equivalence.   We now prove that this follows
@@ -27,14 +27,9 @@ definition weak_funext :=
 -- The obvious implications are Funext -> NaiveFunext -> WeakFunext
 -- TODO: Get class inference to work locally
 definition naive_funext_from_funext [F : funext] : naive_funext :=
-  (λ A P f g h,
+  (λ A P f g h, funext.eq_of_homotopy h)
-    have Fefg: is_equiv (@apD10 A P f g),
-      from (@funext.ap F A P f g),
-    have eq1 : _, from (@is_equiv.inv _ _ (@apD10 A P f g) Fefg h),
-    eq1
-  )
 
-definition weak_funext_from_naive_funext : naive_funext → weak_funext :=
+definition weak_funext_of_naive_funext : naive_funext → weak_funext :=
   (λ nf A P (Pc : Πx, is_contr (P x)),
     let c := λx, center (P x) in
     is_contr.mk c (λ f,
@@ -55,10 +50,8 @@ context
   universes l k
   parameters (wf : weak_funext.{l k}) {A : Type.{l}} {B : A → Type.{k}} (f : Π x, B x)
 
-  protected definition idhtpy : f ∼ f := (λ x, idp)
+  definition is_contr_sigma_homotopy [instance] : is_contr (Σ (g : Π x, B x), f ∼ g) :=
-
+    is_contr.mk (sigma.mk f (homotopy.refl f))
-  definition contr_basedhtpy [instance] : is_contr (Σ (g : Π x, B x), f ∼ g) :=
-    is_contr.mk (sigma.mk f idhtpy)
       (λ dp, sigma.rec_on dp
         (λ (g : Π x, B x) (h : f ∼ g),
           let r := λ (k : Π x, Σ y, f x = y),
@@ -66,47 +59,47 @@ context
               (λx, pr1 (k x)) (λx, pr2 (k x)) in
           let s := λ g h x, @sigma.mk _ (λy, f x = y) (g x) (h x) in
           have t1 : Πx, is_contr (Σ y, f x = y),
-            from (λx, !contr_basedpaths),
+            from (λx, !is_contr_sigma_eq),
           have t2 : is_contr (Πx, Σ y, f x = y),
             from !wf,
           have t3 : (λ x, @sigma.mk _ (λ y, f x = y) (f x) idp) = s g h,
-            from @path_contr (Π x, Σ y, f x = y) t2 _ _,
+            from @center_eq (Π x, Σ y, f x = y) t2 _ _,
           have t4 : r (λ x, sigma.mk (f x) idp) = r (s g h),
             from ap r t3,
-          have endt : sigma.mk f idhtpy = sigma.mk g h,
+          have endt : sigma.mk f (homotopy.refl f) = sigma.mk g h,
             from t4,
           endt
         )
       )
 
-  parameters (Q : Π g (h : f ∼ g), Type) (d : Q f idhtpy)
+  parameters (Q : Π g (h : f ∼ g), Type) (d : Q f (homotopy.refl f))
 
-  definition htpy_ind (g : Πx, B x) (h : f ∼ g) : Q g h :=
+  definition homotopy_ind (g : Πx, B x) (h : f ∼ g) : Q g h :=
-    @transport _ (λ gh, Q (pr1 gh) (pr2 gh)) (sigma.mk f idhtpy) (sigma.mk g h)
+    @transport _ (λ gh, Q (pr1 gh) (pr2 gh)) (sigma.mk f (homotopy.refl f)) (sigma.mk g h)
-      (@path_contr _ contr_basedhtpy _ _) d
+      (@center_eq _ is_contr_sigma_homotopy _ _) d
 
-  local attribute htpy_ind [reducible]
+  local attribute homotopy_ind [reducible]
-  definition htpy_ind_beta : htpy_ind f idhtpy = d :=
+  definition homotopy_ind_comp : homotopy_ind f (homotopy.refl f) = d :=
-    (@path2_contr _ _ _ _ !path_contr idp)⁻¹ ▹ idp
+    (@hprop_eq _ _ _ _ !center_eq idp)⁻¹ ▹ idp
 
 end
 
 -- Now the proof is fairly easy; we can just use the same induction principle on both sides.
 universe variables l k
 
-theorem funext_from_weak_funext (wf : weak_funext.{l k}) : funext.{l k} :=
+theorem funext_of_weak_funext (wf : weak_funext.{l k}) : funext.{l k} :=
   funext.mk (λ A B f g,
     let eq_to_f := (λ g' x, f = g') in
-    let sim2path := htpy_ind _ f eq_to_f idp in
+    let sim2path := homotopy_ind _ f eq_to_f idp in
-    have t1 : sim2path f (idhtpy f) = idp,
+    have t1 : sim2path f (homotopy.refl f) = idp,
-      proof htpy_ind_beta _ f eq_to_f idp qed,
+      proof homotopy_ind_comp _ f eq_to_f idp qed,
-    have t2 : apD10 (sim2path f (idhtpy f)) = (idhtpy f),
+    have t2 : apD10 (sim2path f (homotopy.refl f)) = (homotopy.refl f),
       proof ap apD10 t1 qed,
     have sect : apD10 ∘ (sim2path g) ∼ id,
-      proof (htpy_ind _ f (λ g' x, apD10 (sim2path g' x) = x) t2) g qed,
+      proof (homotopy_ind _ f (λ g' x, apD10 (sim2path g' x) = x) t2) g qed,
     have retr : (sim2path g) ∘ apD10 ∼ id,
-      from (λ h, eq.rec_on h (htpy_ind_beta _ f _ idp)),
+      from (λ h, eq.rec_on h (homotopy_ind_comp _ f _ idp)),
     is_equiv.adjointify apD10 (sim2path g) sect retr)
 
 definition funext_from_naive_funext : naive_funext -> funext :=
-  compose funext_from_weak_funext weak_funext_from_naive_funext
+  compose funext_of_weak_funext weak_funext_of_naive_funext

hott/init/axioms/ua.hlean

@@ -4,40 +4,38 @@
 -- Ported from Coq HoTT
 prelude
 import ..path ..equiv
-open eq equiv
+open eq equiv is_equiv
 
 --Ensure that the types compared are in the same universe
 section
   universe variable l
   variables {A B : Type.{l}}
 
-  definition isequiv_path (H : A = B) :=
+  definition is_equiv_tr_of_eq (H : A = B) : is_equiv (transport (λX:Type, X) H) :=
-    (@is_equiv.transport Type (λX, X) A B H)
+    (@is_equiv_tr Type (λX, X) A B H)
 
-  definition equiv_path (H : A = B) : A ≃ B :=
+  definition equiv_of_eq (H : A = B) : A ≃ B :=
-    equiv.mk _ (isequiv_path H)
+    equiv.mk _ (is_equiv_tr_of_eq H)
 
 end
 
-axiom ua_is_equiv (A B : Type) : is_equiv (@equiv_path A B)
+axiom univalence (A B : Type) : is_equiv (@equiv_of_eq A B)
 
--- Make the Equivalence given by the axiom an instance
+attribute univalence [instance]
-protected definition inst [instance] (A B : Type) : is_equiv (@equiv_path A B) :=
-ua_is_equiv A B
 
 -- This is the version of univalence axiom we will probably use most often
 definition ua {A B : Type} : A ≃ B →  A = B :=
-@is_equiv.inv _ _ (@equiv_path A B) (inst A B)
+(@equiv_of_eq A B)⁻¹
 
 -- One consequence of UA is that we can transport along equivalencies of types
-namespace Equiv
+namespace equiv
   universe variable l
 
-  protected definition subst (P : Type → Type) {A B : Type.{l}} (H : A ≃ B)
+  protected definition transport_of_equiv (P : Type → Type) {A B : Type.{l}} (H : A ≃ B)
     : P A → P B :=
   eq.transport P (ua H)
 
   -- We can use this for calculation evironments
-  calc_subst subst
+  calc_subst transport_of_equiv
 
-end Equiv
+end equiv

hott/init/bool.hlean

@@ -1,6 +1,8 @@
 /-
 Copyright (c) 2014 Microsoft Corporation. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
+
+Module: init.bool
 Author: Leonardo de Moura
 -/
 prelude

hott/init/datatypes.hlean

@@ -2,6 +2,7 @@
 Copyright (c) 2014 Microsoft Corporation. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 
+Module: init.datatypes
 Authors: Leonardo de Moura, Jakob von Raumer
 
 Basic datatypes

hott/init/default.hlean

@@ -2,6 +2,7 @@
 Copyright (c) 2014 Microsoft Corporation. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 
+Module: init.default
 Authors: Leonardo de Moura, Jakob von Raumer
 -/
 prelude
@@ -9,5 +10,5 @@ import init.datatypes init.reserved_notation init.tactic init.logic
 import init.bool init.num init.priority init.relation init.wf
 import init.types.sigma init.types.prod init.types.empty
 import init.trunc init.path init.equiv init.util
-import init.axioms.ua init.axioms.funext init.axioms.funext_from_ua
+import init.axioms.ua init.axioms.funext init.axioms.funext_of_ua
 import init.hedberg init.nat

hott/init/equiv.hlean

@@ -1,13 +1,18 @@
--- Copyright (c) 2014 Microsoft Corporation. All rights reserved.
+/-
--- Released under Apache 2.0 license as described in the file LICENSE.
+Copyright (c) 2014 Microsoft Corporation. All rights reserved.
--- Author: Jeremy Avigad, Jakob von Raumer
+Released under Apache 2.0 license as described in the file LICENSE.
--- Ported from Coq HoTT
+
+Module: init.equiv
+Author: Jeremy Avigad, Jakob von Raumer
+
+Ported from Coq HoTT
+-/
+
 prelude
 import .path .function
 open eq function
 
--- Equivalences
+/- Equivalences -/
--- ------------
 
 -- This is our definition of equivalence. In the HoTT-book it's called
 -- ihae (half-adjoint equivalence).
@@ -18,37 +23,38 @@ structure is_equiv [class] {A B : Type} (f : A → B) :=
   (adj : Πx, retr (f x) = ap f (sect x))
 
 
--- A more bundled version of equivalence to calculate with
+-- A more bundled version of equivalence
 structure equiv (A B : Type) :=
   (to_fun : A → B)
   (to_is_equiv : is_equiv to_fun)
 
- -- Some instances and closure properties of equivalences
-namespace is_equiv
 
+namespace is_equiv
+  /- Some instances and closure properties of equivalences -/
   postfix `⁻¹` := inv
 
+  section
   variables {A B C : Type} (f : A → B) (g : B → C) {f' : A → B}
 
   -- The identity function is an equivalence.
-  definition id_is_equiv : (@is_equiv A A id) := is_equiv.mk id (λa, idp) (λa, idp) (λa, idp)
+  definition is_equiv_id : (@is_equiv A A id) := is_equiv.mk id (λa, idp) (λa, idp) (λa, idp)
 
   -- The composition of two equivalences is, again, an equivalence.
-  protected definition compose [Hf : is_equiv f] [Hg : is_equiv g] : (is_equiv (g ∘ f)) :=
+  definition is_equiv_compose [Hf : is_equiv f] [Hg : is_equiv g] : (is_equiv (g ∘ f)) :=
     is_equiv.mk ((inv f) ∘ (inv g))
                (λc, ap g (retr f (g⁻¹ c)) ⬝ retr g c)
                (λa, ap (inv f) (sect g (f a)) ⬝ sect f a)
-               (λa, (whiskerL _ (adj g (f a))) ⬝
+               (λa, (whisker_left _ (adj g (f a))) ⬝
-                    (ap_pp g _ _)⁻¹ ⬝
+                    (ap_con g _ _)⁻¹ ⬝
-                    ap02 g (concat_A1p (retr f) (sect g (f a))⁻¹ ⬝
+                    ap02 g (ap_con_eq_con (retr f) (sect g (f a))⁻¹ ⬝
                             (ap_compose (inv f) f _ ◾  adj f a) ⬝
-                            (ap_pp f _ _)⁻¹
+                            (ap_con f _ _)⁻¹
                            ) ⬝
                     (ap_compose f g _)⁻¹
                )
 
   -- Any function equal to an equivalence is an equivlance as well.
-  definition path_closed [Hf : is_equiv f] (Heq : f = f') : (is_equiv f') :=
+  definition is_equiv_eq_closed [Hf : is_equiv f] (Heq : f = f') : (is_equiv f') :=
      eq.rec_on Heq Hf
 
   -- Any function pointwise equal to an equivalence is an equivalence as well.
@@ -64,36 +70,35 @@ namespace is_equiv
       have eq1 : _ = _,
         from calc ap f secta ⬝ ff'a
               = retrfa ⬝ ff'a : ap _ (@adj _ _ f _ _)
-          ... = ap (f ∘ invf) ff'a ⬝ retrf'a : concat_A1p
+          ... = ap (f ∘ invf) ff'a ⬝ retrf'a : ap_con_eq_con
           ... = ap f (ap invf ff'a) ⬝ retrf'a : ap_compose invf f,
       have eq2 : _ = _,
         from calc retrf'a
-              = (ap f (ap invf ff'a))⁻¹ ⬝ (ap f secta ⬝ ff'a) : moveL_Vp _ _ _ (eq1⁻¹)
+              = (ap f (ap invf ff'a))⁻¹ ⬝ (ap f secta ⬝ ff'a) : eq_inv_con_of_con_eq _ _ _ (eq1⁻¹)
-          ... = ap f (ap invf ff'a)⁻¹ ⬝ (ap f secta ⬝ Hty a) : ap_V invf ff'a
+          ... = ap f (ap invf ff'a)⁻¹ ⬝ (ap f secta ⬝ Hty a) : ap_inv invf ff'a
-          ... = ap f (ap invf ff'a)⁻¹ ⬝ (Hty (invf (f a)) ⬝ ap f' secta) : concat_Ap
+          ... = ap f (ap invf ff'a)⁻¹ ⬝ (Hty (invf (f a)) ⬝ ap f' secta) : ap_con_eq_con_ap
-          ... = (ap f (ap invf ff'a)⁻¹ ⬝ Hty (invf (f a))) ⬝ ap f' secta : concat_pp_p
+          ... = (ap f (ap invf ff'a)⁻¹ ⬝ Hty (invf (f a))) ⬝ ap f' secta : con.assoc
-          ... = (ap f ((ap invf ff'a)⁻¹) ⬝ Hty (invf (f a))) ⬝ ap f' secta : ap_V
+          ... = (ap f ((ap invf ff'a)⁻¹) ⬝ Hty (invf (f a))) ⬝ ap f' secta : ap_inv
-          ... = (Hty (invf (f' a)) ⬝ ap f' ((ap invf ff'a)⁻¹)) ⬝ ap f' secta : concat_Ap
+          ... = (Hty (invf (f' a)) ⬝ ap f' ((ap invf ff'a)⁻¹)) ⬝ ap f' secta : ap_con_eq_con_ap
-          ... = (Hty (invf (f' a)) ⬝ (ap f' (ap invf ff'a))⁻¹) ⬝ ap f' secta : ap_V
+          ... = (Hty (invf (f' a)) ⬝ (ap f' (ap invf ff'a))⁻¹) ⬝ ap f' secta : ap_inv
-          ... = Hty (invf (f' a)) ⬝ ((ap f' (ap invf ff'a))⁻¹ ⬝ ap f' secta) : concat_pp_p,
+          ... = Hty (invf (f' a)) ⬝ ((ap f' (ap invf ff'a))⁻¹ ⬝ ap f' secta) : con.assoc,
       have eq3 : _ = _,
         from calc (Hty (invf (f' a)))⁻¹ ⬝ retrf'a
-              = (ap f' (ap invf ff'a))⁻¹ ⬝ ap f' secta : moveR_Vp _ _ _ eq2
+              = (ap f' (ap invf ff'a))⁻¹ ⬝ ap f' secta : inv_con_eq_of_eq_con _ _ _ eq2
-          ... = (ap f' ((ap invf ff'a)⁻¹)) ⬝ ap f' secta : ap_V
+          ... = (ap f' ((ap invf ff'a)⁻¹)) ⬝ ap f' secta : ap_inv
-          ... = ap f' ((ap invf ff'a)⁻¹ ⬝ secta) : ap_pp,
+          ... = ap f' ((ap invf ff'a)⁻¹ ⬝ secta) : ap_con,
     eq3) in
   is_equiv.mk (inv f) sect' retr' adj'
-end is_equiv
+  end
 
-namespace is_equiv
   context
   parameters {A B : Type} (f : A → B) (g : B → A)
             (ret : f ∘ g ∼ id) (sec : g ∘ f ∼ id)
 
-  definition adjointify_sect' : g ∘ f ∼ id :=
+  private definition adjointify_sect' : g ∘ f ∼ id :=
     (λx, ap g (ap f (inverse (sec x))) ⬝ ap g (ret (f x)) ⬝ sec x)
 
-  definition adjointify_adj' : Π (x : A), ret (f x) = ap f (adjointify_sect' x) :=
+  private definition adjointify_adj' : Π (x : A), ret (f x) = ap f (adjointify_sect' x) :=
     (λ (a : A),
       let fgretrfa := ap f (ap g (ret (f a))) in
       let fgfinvsect := ap f (ap g (ap f ((sec a)⁻¹))) in
@@ -101,88 +106,84 @@ namespace is_equiv
       let retrfa := ret (f a) in
       have eq1 : ap f (sec a) = _,
         from calc ap f (sec a)
-              = idp ⬝ ap f (sec a) : !concat_1p⁻¹
+              = idp ⬝ ap f (sec a) : !idp_con⁻¹
-          ... = (ret (f a) ⬝ (ret (f a)⁻¹)) ⬝ ap f (sec a) : {!concat_pV⁻¹}
+          ... = (ret (f a) ⬝ (ret (f a)⁻¹)) ⬝ ap f (sec a) : {!con.left_inv⁻¹}
-          ... = ((ret (fgfa))⁻¹ ⬝ ap (f ∘ g) (ret (f a))) ⬝ ap f (sec a) : {!concat_pA1⁻¹}
+          ... = ((ret (fgfa))⁻¹ ⬝ ap (f ∘ g) (ret (f a))) ⬝ ap f (sec a) : {!con_ap_eq_con⁻¹}
           ... = ((ret (fgfa))⁻¹ ⬝ fgretrfa) ⬝ ap f (sec a) : {ap_compose g f _}
-          ... = (ret (fgfa))⁻¹ ⬝ (fgretrfa ⬝ ap f (sec a)) : !concat_pp_p,
+          ... = (ret (fgfa))⁻¹ ⬝ (fgretrfa ⬝ ap f (sec a)) : !con.assoc,
       have eq2 : ap f (sec a) ⬝ idp = (ret fgfa)⁻¹ ⬝ (fgretrfa ⬝ ap f (sec a)),
-        from !concat_p1 ⬝ eq1,
+        from !con_idp ⬝ eq1,
       have eq3 : idp = _,
         from calc idp
-              = (ap f (sec a))⁻¹ ⬝ ((ret fgfa)⁻¹ ⬝ (fgretrfa ⬝ ap f (sec a))) : moveL_Vp _ _ _ eq2
+              = (ap f (sec a))⁻¹ ⬝ ((ret fgfa)⁻¹ ⬝ (fgretrfa ⬝ ap f (sec a))) : eq_inv_con_of_con_eq _ _ _ eq2
-          ... = (ap f (sec a)⁻¹ ⬝ (ret fgfa)⁻¹) ⬝ (fgretrfa ⬝ ap f (sec a)) : !concat_p_pp
+          ... = (ap f (sec a)⁻¹ ⬝ (ret fgfa)⁻¹) ⬝ (fgretrfa ⬝ ap f (sec a)) : !con.assoc'
-          ... = (ap f ((sec a)⁻¹) ⬝ (ret fgfa)⁻¹) ⬝ (fgretrfa ⬝ ap f (sec a)) : {!ap_V⁻¹}
+          ... = (ap f ((sec a)⁻¹) ⬝ (ret fgfa)⁻¹) ⬝ (fgretrfa ⬝ ap f (sec a)) : {!ap_inv⁻¹}
-          ... = ((ap f ((sec a)⁻¹) ⬝ (ret fgfa)⁻¹) ⬝ fgretrfa) ⬝ ap f (sec a) : !concat_p_pp
+          ... = ((ap f ((sec a)⁻¹) ⬝ (ret fgfa)⁻¹) ⬝ fgretrfa) ⬝ ap f (sec a) : !con.assoc'
-          ... = ((retrfa⁻¹ ⬝ ap (f ∘ g) (ap f ((sec a)⁻¹))) ⬝ fgretrfa) ⬝ ap f (sec a) : {!concat_pA1⁻¹}
+          ... = ((retrfa⁻¹ ⬝ ap (f ∘ g) (ap f ((sec a)⁻¹))) ⬝ fgretrfa) ⬝ ap f (sec a) : {!con_ap_eq_con⁻¹}
           ... = ((retrfa⁻¹ ⬝ fgfinvsect) ⬝ fgretrfa) ⬝ ap f (sec a) : {ap_compose g f _}
-          ... = (retrfa⁻¹ ⬝ (fgfinvsect ⬝ fgretrfa)) ⬝ ap f (sec a) : {!concat_p_pp⁻¹}
+          ... = (retrfa⁻¹ ⬝ (fgfinvsect ⬝ fgretrfa)) ⬝ ap f (sec a) : {!con.assoc'⁻¹}
-          ... = retrfa⁻¹ ⬝ ap f (ap g (ap f ((sec a)⁻¹)) ⬝ ap g (ret (f a))) ⬝ ap f (sec a) : {!ap_pp⁻¹}
+          ... = retrfa⁻¹ ⬝ ap f (ap g (ap f ((sec a)⁻¹)) ⬝ ap g (ret (f a))) ⬝ ap f (sec a) : {!ap_con⁻¹}
-          ... = retrfa⁻¹ ⬝ (ap f (ap g (ap f ((sec a)⁻¹)) ⬝ ap g (ret (f a))) ⬝ ap f (sec a)) : !concat_p_pp⁻¹
+          ... = retrfa⁻¹ ⬝ (ap f (ap g (ap f ((sec a)⁻¹)) ⬝ ap g (ret (f a))) ⬝ ap f (sec a)) : !con.assoc'⁻¹
-          ... = retrfa⁻¹ ⬝ ap f ((ap g (ap f ((sec a)⁻¹)) ⬝ ap g (ret (f a))) ⬝ sec a) : {!ap_pp⁻¹},
+          ... = retrfa⁻¹ ⬝ ap f ((ap g (ap f ((sec a)⁻¹)) ⬝ ap g (ret (f a))) ⬝ sec a) : {!ap_con⁻¹},
       have eq4 : ret (f a) = ap f ((ap g (ap f ((sec a)⁻¹)) ⬝ ap g (ret (f a))) ⬝ sec a),
-        from moveR_M1 _ _ eq3,
+        from eq_of_idp_eq_inv_con _ _ eq3,
       eq4)
 
   definition adjointify : is_equiv f :=
     is_equiv.mk g ret adjointify_sect' adjointify_adj'
 
   end
-end is_equiv
 
-namespace is_equiv
+  section
   variables {A B: Type} (f : A → B)
 
   --The inverse of an equivalence is, again, an equivalence.
-  definition inv_closed [instance] [Hf : is_equiv f] : (is_equiv (inv f)) :=
+  definition is_equiv_inv [instance] [Hf : is_equiv f] : (is_equiv (inv f)) :=
     adjointify (inv f) f (sect f) (retr f)
+  end
 
-end is_equiv
-
-namespace is_equiv
-  variables {A : Type}
   section
-  variables {B C : Type} (f : A → B) {f' : A → B} [Hf : is_equiv f]
+  variables {A B C : Type} (f : A → B) {f' : A → B} [Hf : is_equiv f]
   include Hf
 
   variable (g : B → C)
 
-  definition cancel_R (g : B → C) [Hgf : is_equiv (g ∘ f)] : (is_equiv g) :=
+  definition cancel_right (g : B → C) [Hgf : is_equiv (g ∘ f)] : (is_equiv g) :=
-    have Hfinv [visible] : is_equiv (f⁻¹), from inv_closed f,
+    have Hfinv [visible] : is_equiv (f⁻¹), from is_equiv_inv f,
-    @homotopy_closed _ _ _ _ (is_equiv.compose (f⁻¹) (g ∘ f)) (λb, ap g (@retr _ _ f _ b))
+    @homotopy_closed _ _ _ _ (is_equiv_compose (f⁻¹) (g ∘ f)) (λb, ap g (@retr _ _ f _ b))
 
-  definition cancel_L (g : C → A) [Hgf : is_equiv (f ∘ g)] : (is_equiv g) :=
+  definition cancel_left (g : C → A) [Hgf : is_equiv (f ∘ g)] : (is_equiv g) :=
-    have Hfinv [visible] : is_equiv (f⁻¹), from inv_closed f,
+    have Hfinv [visible] : is_equiv (f⁻¹), from is_equiv_inv f,
-    @homotopy_closed _ _ _ _ (is_equiv.compose (f ∘ g) (f⁻¹)) (λa, sect f (g a))
+    @homotopy_closed _ _ _ _ (is_equiv_compose (f ∘ g) (f⁻¹)) (λa, sect f (g a))
 
   --Rewrite rules
-  definition moveR_M {x : A} {y : B} (p : x = (inv f) y) : (f x = y) :=
+  definition eq_of_eq_inv {x : A} {y : B} (p : x = (inv f) y) : (f x = y) :=
     (ap f p) ⬝ (@retr _ _ f _ y)
 
-  definition moveL_M {x : A} {y : B} (p : (inv f) y = x) : (y = f x) :=
+  definition eq_of_inv_eq {x : A} {y : B} (p : (inv f) y = x) : (y = f x) :=
-    (moveR_M f (p⁻¹))⁻¹
+    (eq_of_eq_inv f (p⁻¹))⁻¹
 
-  definition moveR_V {x : B} {y : A} (p : x = f y) : (inv f) x = y :=
+  definition inv_eq_of_eq {x : B} {y : A} (p : x = f y) : (inv f) x = y :=
     ap (f⁻¹) p ⬝ sect f y
 
-  definition moveL_V {x : B} {y : A} (p : f y = x) : y = (inv f) x :=
+  definition eq_inv_of_eq {x : B} {y : A} (p : f y = x) : y = (inv f) x :=
-    (moveR_V f (p⁻¹))⁻¹
+    (inv_eq_of_eq f (p⁻¹))⁻¹
 
-  definition ap_closed [instance] (x y : A) : is_equiv (ap f) :=
+  definition is_equiv_ap [instance] (x y : A) : is_equiv (ap f) :=
     adjointify (ap f)
       (λq, (inverse (sect f x)) ⬝ ap (f⁻¹) q ⬝ sect f y)
-      (λq, !ap_pp
+      (λq, !ap_con
-        ⬝ whiskerR !ap_pp _
+        ⬝ whisker_right !ap_con _
-        ⬝ ((!ap_V ⬝ inverse2 ((adj f _)⁻¹))
+        ⬝ ((!ap_inv ⬝ inverse2 ((adj f _)⁻¹))
           ◾ (inverse (ap_compose (f⁻¹) f _))
           ◾ (adj f _)⁻¹)
-        ⬝ concat_pA1_p (retr f) _ _
+        ⬝ con_ap_con_eq_con_con (retr f) _ _
-        ⬝ whiskerR !concat_Vp _
+        ⬝ whisker_right !con.right_inv _
-        ⬝ !concat_1p)
+        ⬝ !idp_con)
-      (λp, whiskerR (whiskerL _ ((ap_compose f (f⁻¹) _)⁻¹)) _
+      (λp, whisker_right (whisker_left _ ((ap_compose f (f⁻¹) _)⁻¹)) _
-        ⬝ concat_pA1_p (sect f) _ _
+        ⬝ con_ap_con_eq_con_con (sect f) _ _
-        ⬝ whiskerR !concat_Vp _
+        ⬝ whisker_right !con.right_inv _
-        ⬝ !concat_1p)
+        ⬝ !idp_con)
 
   -- The function equiv_rect says that given an equivalence f : A → B,
   -- and a hypothesis from B, one may always assume that the hypothesis
@@ -192,7 +193,7 @@ namespace is_equiv
   -- once pulled back along an equivalence f : A → B, then it has a section
   -- over all of B.
 
-  definition equiv_rect (P : B -> Type) :
+  definition equiv_rect (P : B → Type) :
       (Πx, P (f x)) → (Πy, P y) :=
     (λg y, eq.transport _ (retr f y) (g (f⁻¹ y)))
 
@@ -200,18 +201,20 @@ namespace is_equiv
       (df : Π (x : A), P (f x)) (x : A) : equiv_rect f P df (f x) = df x :=
     calc equiv_rect f P df (f x)
           = transport P (retr f (f x)) (df (f⁻¹ (f x))) : idp
-      ... = transport P (ap f (sect f x)) (df (f⁻¹ (f x))) : adj f
+      ... = transport P (eq.ap f (sect f x)) (df (f⁻¹ (f x))) : adj f
       ... = transport (P ∘ f) (sect f x) (df (f⁻¹ (f x))) : transport_compose
       ... = df x : apD df (sect f x)
 
   end
 
   --Transporting is an equivalence
-  protected definition transport [instance] (P : A → Type) {x y : A} (p : x = y) : (is_equiv (transport P p)) :=
+  definition is_equiv_tr [instance] {A : Type} (P : A → Type) {x y : A} (p : x = y) : (is_equiv (transport P p)) :=
-    is_equiv.mk (transport P (p⁻¹)) (transport_pV P p) (transport_Vp P p) (transport_pVp P p)
+    is_equiv.mk (transport P (p⁻¹)) (tr_inv_tr P p) (inv_tr_tr P p) (tr_inv_tr_lemma P p)
+
 
 end is_equiv
 
+open is_equiv
 namespace equiv
 
   attribute to_is_equiv [instance]
@@ -224,42 +227,27 @@ namespace equiv
   private definition f : A → B := to_fun eqf
   private definition Hf [instance] : is_equiv f := to_is_equiv eqf
 
-  protected definition refl : A ≃ A := equiv.mk id is_equiv.id_is_equiv
+  protected definition refl : A ≃ A := equiv.mk id is_equiv.is_equiv_id
 
-  theorem trans (eqg: B ≃ C) : A ≃ C :=
+  definition trans (eqg: B ≃ C) : A ≃ C :=
     equiv.mk ((to_fun eqg) ∘ f)
-             (is_equiv.compose f (to_fun eqg))
+             (is_equiv_compose f (to_fun eqg))
 
-  theorem path_closed (f' : A → B) (Heq : to_fun eqf = f') : A ≃ B :=
+  definition equiv_of_eq_of_equiv (f' : A → B) (Heq : to_fun eqf = f') : A ≃ B :=
-    equiv.mk f' (is_equiv.path_closed f Heq)
+    equiv.mk f' (is_equiv.is_equiv_eq_closed f Heq)
 
-  theorem symm : B ≃ A :=
+  definition symm : B ≃ A :=
-    equiv.mk (is_equiv.inv f) !is_equiv.inv_closed
+    equiv.mk (is_equiv.inv f) !is_equiv.is_equiv_inv
 
-  theorem cancel_R (g : B → C) [Hgf : is_equiv (g ∘ f)] : B ≃ C :=
+  definition equiv_ap (P : A → Type) {x y : A} {p : x = y} : (P x) ≃ (P y) :=
-    equiv.mk g (is_equiv.cancel_R f _)
+    equiv.mk (eq.transport P p) (is_equiv_tr P p)
-
-  theorem cancel_L (g : C → A) [Hgf : is_equiv (f ∘ g)] : C ≃ A :=
-    equiv.mk g (is_equiv.cancel_L f _)
-
-  protected theorem transport (P : A → Type) {x y : A} {p : x = y} : (P x) ≃ (P y) :=
-    equiv.mk (transport P p) (is_equiv.transport P p)
 
   end
 
-  context
+  --we need this theorem for the funext_of_ua proof
-  parameters {A B : Type} (eqf eqg : A ≃ B)
+  theorem inv_eq {A B : Type} (eqf eqg : A ≃ B) (p : eqf = eqg) : (to_fun eqf)⁻¹ = (to_fun eqg)⁻¹ :=
-
-  private definition Hf [instance] : is_equiv (to_fun eqf) := to_is_equiv eqf
-  private definition Hg [instance] : is_equiv (to_fun eqg) := to_is_equiv eqg
-
-  --We need this theorem for the funext_from_ua proof
-  theorem inv_eq (p : eqf = eqg)
-      : is_equiv.inv (to_fun eqf) = is_equiv.inv (to_fun eqg) :=
     eq.rec_on p idp
 
-  end
-
   -- calc enviroment
   -- Note: Calculating with substitutions needs univalence
   calc_trans equiv.trans

hott/init/function.hlean

@@ -1,6 +1,8 @@
 /-
 Copyright (c) 2014 Microsoft Corporation. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
+
+Module: init.function
 Author: Leonardo de Moura
 
 General operations on functions.

hott/init/hedberg.hlean

@@ -8,7 +8,7 @@ Hedberg's Theorem: every type with decidable equality is a hset
 -/
 prelude
 import init.trunc
-open eq eq.ops nat truncation sigma
+open eq eq.ops nat is_trunc sigma
 
 -- TODO(Leo): move const coll and path_coll to a different file?
 private definition const {A B : Type} (f : A → B) := ∀ x y, f x = f y

hott/init/logic.hlean

@@ -2,6 +2,7 @@
 Copyright (c) 2014 Microsoft Corporation. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 
+Module: init.logic
 Authors: Leonardo de Moura
 -/
 prelude
@@ -16,8 +17,7 @@ empty.rec (λ e, b) (H₂ H₁)
 definition mt {a b : Type} (H₁ : a → b) (H₂ : ¬b) : ¬a :=
 assume Ha : a, absurd (H₁ Ha) H₂
 
--- not
+/- not -/
--- ---
 
 protected definition not_empty : ¬ empty :=
 assume H : empty, H
@@ -35,8 +35,7 @@ assume Hna : ¬a, absurd (assume Ha : a, absurd Ha Hna) H
 definition not_of_not_implies {a b : Type} (H : ¬(a → b)) : ¬b :=
 assume Hb : b, absurd (assume Ha : a, Hb) H
 
--- eq
+/- eq -/
--- --
 
 notation a = b := eq a b
 definition rfl {A : Type} {a : A} := eq.refl a
@@ -74,8 +73,7 @@ namespace lift
   lift.rec_on a (λ d, rfl)
 end lift
 
--- ne
+/- ne -/
--- --
 
 definition ne {A : Type} (a b : A) := ¬(a = b)
 notation a ≠ b := ne a b
@@ -115,8 +113,7 @@ end
 calc_trans ne.of_eq_of_ne
 calc_trans ne.of_ne_of_eq
 
--- iff
+/- iff -/
--- ---
 
 definition iff (a b : Type) := prod (a → b) (b → a)
 
@@ -178,8 +175,7 @@ end iff
 calc_refl iff.refl
 calc_trans iff.trans
 
--- inhabited
+/- inhabited -/
--- ---------
 
 inductive inhabited [class] (A : Type) : Type :=
 mk : A → inhabited A
@@ -200,8 +196,7 @@ definition default (A : Type) [H : inhabited A] : A := destruct H (take a, a)
 
 end inhabited
 
--- decidable
+/- decidable -/
--- ---------
 
 inductive decidable.{l} [class] (p : Type.{l}) : Type.{l} :=
 inl :  p → decidable p,

hott/init/nat.hlean

@@ -3,6 +3,7 @@ Copyright (c) 2014 Microsoft Corporation. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 Authors: Floris van Doorn, Leonardo de Moura
 -/
+
 prelude
 import init.wf init.tactic init.hedberg init.util init.types.sum
 

hott/init/path.hlean

@@ -1,19 +1,19 @@
--- Copyright (c) 2014 Microsoft Corporation. All rights reserved.
+/-
--- Released under Apache 2.0 license as described in the file LICENSE.
+Copyright (c) 2014 Microsoft Corporation. All rights reserved.
--- Author: Jeremy Avigad, Jakob von Raumer
+Released under Apache 2.0 license as described in the file LICENSE.
--- Ported from Coq HoTT
+
---
+Module: init.path
--- TODO: things to test:
+Author: Jeremy Avigad, Jakob von Raumer
--- o To what extent can we use opaque definitions outside the file?
+
--- o Try doing these proofs with tactics.
+Ported from Coq HoTT
--- o Try using the simplifier on some of these proofs.
+-/
+
 prelude
 import .function .datatypes .relation .tactic
 
 open function eq
 
--- Path equality
+/- Path equality -/
--- ---- --------
 
 namespace eq
   variables {A B C : Type} {P : A → Type} {x y z t : A}
@@ -21,6 +21,7 @@ namespace eq
   --notation a = b := eq a b
   notation x = y `:>`:50 A:49 := @eq A x y
   definition idp {a : A} := refl a
+  definition idpath (a : A) := refl a
 
   -- unbased path induction
   definition rec' [reducible] {P : Π (a b : A), (a = b) -> Type}
@@ -31,8 +32,7 @@ namespace eq
       (H : Π (a : A), P a a idp) : P a b p :=
   eq.rec (H a) p
 
-  -- Concatenation and inverse
+  /- Concatenation and inverse -/
-  -- -------------------------
 
   definition concat (p : x = y) (q : y = z) : x = z :=
   eq.rec (λu, u) q p
@@ -43,137 +43,133 @@ namespace eq
   notation p₁ ⬝ p₂ := concat p₁ p₂
   notation p ⁻¹ := inverse p
 
-  -- The 1-dimensional groupoid structure
+  /- The 1-dimensional groupoid structure -/
-  -- ------------------------------------
 
   -- The identity path is a right unit.
-  definition concat_p1 (p : x = y) : p ⬝ idp = p :=
+  definition con_idp (p : x = y) : p ⬝ idp = p :=
   eq.rec_on p idp
 
   -- The identity path is a right unit.
-  definition concat_1p (p : x = y) : idp ⬝ p = p :=
+  definition idp_con (p : x = y) : idp ⬝ p = p :=
   eq.rec_on p idp
 
   -- Concatenation is associative.
-  definition concat_p_pp (p : x = y) (q : y = z) (r : z = t) :
+  definition con.assoc' (p : x = y) (q : y = z) (r : z = t) :
     p ⬝ (q ⬝ r) = (p ⬝ q) ⬝ r :=
   eq.rec_on r (eq.rec_on q idp)
 
-  definition concat_pp_p (p : x = y) (q : y = z) (r : z = t) :
+  definition con.assoc (p : x = y) (q : y = z) (r : z = t) :
     (p ⬝ q) ⬝ r = p ⬝ (q ⬝ r) :=
   eq.rec_on r (eq.rec_on q idp)
 
   -- The left inverse law.
-  definition concat_pV (p : x = y) : p ⬝ p⁻¹ = idp :=
+  definition con.left_inv (p : x = y) : p ⬝ p⁻¹ = idp :=
   eq.rec_on p idp
 
   -- The right inverse law.
-  definition concat_Vp (p : x = y) : p⁻¹ ⬝ p = idp :=
+  definition con.right_inv (p : x = y) : p⁻¹ ⬝ p = idp :=
   eq.rec_on p idp
 
-  -- Several auxiliary theorems about canceling inverses across associativity. These are somewhat
+  /- Several auxiliary theorems about canceling inverses across associativity. These are somewhat
-  -- redundant, following from earlier theorems.
+     redundant, following from earlier theorems. -/
 
-  definition concat_V_pp (p : x = y) (q : y = z) : p⁻¹ ⬝ (p ⬝ q) = q :=
+  definition inv_con_cancel_left (p : x = y) (q : y = z) : p⁻¹ ⬝ (p ⬝ q) = q :=
   eq.rec_on q (eq.rec_on p idp)
 
-  definition concat_p_Vp (p : x = y) (q : x = z) : p ⬝ (p⁻¹ ⬝ q) = q :=
+  definition con_inv_cancel_left (p : x = y) (q : x = z) : p ⬝ (p⁻¹ ⬝ q) = q :=
   eq.rec_on q (eq.rec_on p idp)
 
-  definition concat_pp_V (p : x = y) (q : y = z) : (p ⬝ q) ⬝ q⁻¹ = p :=
+  definition con_inv_cancel_right (p : x = y) (q : y = z) : (p ⬝ q) ⬝ q⁻¹ = p :=
   eq.rec_on q (eq.rec_on p idp)
 
-  definition concat_pV_p (p : x = z) (q : y = z) : (p ⬝ q⁻¹) ⬝ q = p :=
+  definition inv_con_cancel_right (p : x = z) (q : y = z) : (p ⬝ q⁻¹) ⬝ q = p :=
   eq.rec_on q (take p, eq.rec_on p idp) p
 
   -- Inverse distributes over concatenation
-  definition inv_pp (p : x = y) (q : y = z) : (p ⬝ q)⁻¹ = q⁻¹ ⬝ p⁻¹ :=
+  definition con_inv (p : x = y) (q : y = z) : (p ⬝ q)⁻¹ = q⁻¹ ⬝ p⁻¹ :=
   eq.rec_on q (eq.rec_on p idp)
 
-  definition inv_Vp (p : y = x) (q : y = z) : (p⁻¹ ⬝ q)⁻¹ = q⁻¹ ⬝ p :=
+  definition inv_con_inv_left (p : y = x) (q : y = z) : (p⁻¹ ⬝ q)⁻¹ = q⁻¹ ⬝ p :=
   eq.rec_on q (eq.rec_on p idp)
 
   -- universe metavariables
-  definition inv_pV (p : x = y) (q : z = y) : (p ⬝ q⁻¹)⁻¹ = q ⬝ p⁻¹ :=
+  definition inv_con_inv_right (p : x = y) (q : z = y) : (p ⬝ q⁻¹)⁻¹ = q ⬝ p⁻¹ :=
   eq.rec_on p (take q, eq.rec_on q idp) q
 
-  definition inv_VV (p : y = x) (q : z = y) : (p⁻¹ ⬝ q⁻¹)⁻¹ = q ⬝ p :=
+  definition inv_con_inv_inv (p : y = x) (q : z = y) : (p⁻¹ ⬝ q⁻¹)⁻¹ = q ⬝ p :=
   eq.rec_on p (eq.rec_on q idp)
 
   -- Inverse is an involution.
-  definition inv_V (p : x = y) : p⁻¹⁻¹ = p :=
+  definition inv_inv (p : x = y) : p⁻¹⁻¹ = p :=
   eq.rec_on p idp
 
-  -- Theorems for moving things around in equations
+  /- Theorems for moving things around in equations -/
-  -- ----------------------------------------------
 
-  definition moveR_Mp (p : x = z) (q : y = z) (r : y = x) :
+  definition con_eq_of_eq_inv_con (p : x = z) (q : y = z) (r : y = x) :
-    p = (r⁻¹ ⬝ q) → (r ⬝ p) = q :=
+    p = r⁻¹ ⬝ q → r ⬝ p = q :=
-  eq.rec_on r (take p h, concat_1p _ ⬝ h ⬝ concat_1p _) p
+  eq.rec_on r (take p h, idp_con _ ⬝ h ⬝ idp_con _) p
 
-  definition moveR_pM (p : x = z) (q : y = z) (r : y = x) :
+  definition con_eq_of_eq_con_inv (p : x = z) (q : y = z) (r : y = x) :
     r = q ⬝ p⁻¹ → r ⬝ p = q :=
-  eq.rec_on p (take q h, (concat_p1 _ ⬝ h ⬝ concat_p1 _)) q
+  eq.rec_on p (take q h, (con_idp _ ⬝ h ⬝ con_idp _)) q
 
-  definition moveR_Vp (p : x = z) (q : y = z) (r : x = y) :
+  definition inv_con_eq_of_eq_con (p : x = z) (q : y = z) (r : x = y) :
     p = r ⬝ q → r⁻¹ ⬝ p = q :=
-  eq.rec_on r (take q h, concat_1p _ ⬝ h ⬝ concat_1p _) q
+  eq.rec_on r (take q h, idp_con _ ⬝ h ⬝ idp_con _) q
 
-  definition moveR_pV (p : z = x) (q : y = z) (r : y = x) :
+  definition con_inv_eq_of_eq_con (p : z = x) (q : y = z) (r : y = x) :
     r = q ⬝ p → r ⬝ p⁻¹ = q :=
-  eq.rec_on p (take r h, concat_p1 _ ⬝ h ⬝ concat_p1 _) r
+  eq.rec_on p (take r h, con_idp _ ⬝ h ⬝ con_idp _) r
 
-  definition moveL_Mp (p : x = z) (q : y = z) (r : y = x) :
+  definition eq_con_of_inv_con_eq (p : x = z) (q : y = z) (r : y = x) :
     r⁻¹ ⬝ q = p → q = r ⬝ p :=
-  eq.rec_on r (take p h, (concat_1p _)⁻¹ ⬝ h ⬝ (concat_1p _)⁻¹) p
+  eq.rec_on r (take p h, (idp_con _)⁻¹ ⬝ h ⬝ (idp_con _)⁻¹) p
 
-  definition moveL_pM (p : x = z) (q : y = z) (r : y = x) :
+  definition eq_con_of_con_inv_eq (p : x = z) (q : y = z) (r : y = x) :
     q ⬝ p⁻¹ = r → q = r ⬝ p :=
-  eq.rec_on p (take q h, (concat_p1 _)⁻¹ ⬝ h ⬝ (concat_p1 _)⁻¹) q
+  eq.rec_on p (take q h, (con_idp _)⁻¹ ⬝ h ⬝ (con_idp _)⁻¹) q
 
-  definition moveL_Vp (p : x = z) (q : y = z) (r : x = y) :
+  definition eq_inv_con_of_con_eq (p : x = z) (q : y = z) (r : x = y) :
     r ⬝ q = p → q = r⁻¹ ⬝ p :=
-  eq.rec_on r (take q h, (concat_1p _)⁻¹ ⬝ h ⬝ (concat_1p _)⁻¹) q
+  eq.rec_on r (take q h, (idp_con _)⁻¹ ⬝ h ⬝ (idp_con _)⁻¹) q
 
-  definition moveL_pV (p : z = x) (q : y = z) (r : y = x) :
+  definition eq_con_inv_of_con_eq (p : z = x) (q : y = z) (r : y = x) :
     q ⬝ p = r → q = r ⬝ p⁻¹ :=
-  eq.rec_on p (take r h, (concat_p1 _)⁻¹ ⬝ h ⬝ (concat_p1 _)⁻¹) r
+  eq.rec_on p (take r h, (con_idp _)⁻¹ ⬝ h ⬝ (con_idp _)⁻¹) r
 
-  definition moveL_1M (p q : x = y) :
+  definition eq_of_con_inv_eq_idp (p q : x = y) :
     p ⬝ q⁻¹ = idp → p = q :=
-  eq.rec_on q (take p h, (concat_p1 _)⁻¹ ⬝ h) p
+  eq.rec_on q (take p h, (con_idp _)⁻¹ ⬝ h) p
 
-  definition moveL_M1 (p q : x = y) :
+  definition eq_of_inv_con_eq_idp (p q : x = y) :
     q⁻¹ ⬝ p = idp → p = q :=
-  eq.rec_on q (take p h, (concat_1p _)⁻¹ ⬝ h) p
+  eq.rec_on q (take p h, (idp_con _)⁻¹ ⬝ h) p
 
-  definition moveL_1V (p : x = y) (q : y = x) :
+  definition eq_inv_of_con_eq_idp' (p : x = y) (q : y = x) :
     p ⬝ q = idp → p = q⁻¹ :=
-  eq.rec_on q (take p h, (concat_p1 _)⁻¹ ⬝ h) p
+  eq.rec_on q (take p h, (con_idp _)⁻¹ ⬝ h) p
 
-  definition moveL_V1 (p : x = y) (q : y = x) :
+  definition eq_inv_of_con_eq_idp (p : x = y) (q : y = x) :
     q ⬝ p = idp → p = q⁻¹ :=
-  eq.rec_on q (take p h, (concat_1p _)⁻¹ ⬝ h) p
+  eq.rec_on q (take p h, (idp_con _)⁻¹ ⬝ h) p
 
-  definition moveR_M1 (p q : x = y) :
+  definition eq_of_idp_eq_inv_con (p q : x = y) :
     idp = p⁻¹ ⬝ q → p = q :=
-  eq.rec_on p (take q h, h ⬝ (concat_1p _)) q
+  eq.rec_on p (take q h, h ⬝ (idp_con _)) q
 
-  definition moveR_1M (p q : x = y) :
+  definition eq_of_idp_eq_con_inv (p q : x = y) :
     idp = q ⬝ p⁻¹ → p = q :=
-  eq.rec_on p (take q h, h ⬝ (concat_p1 _)) q
+  eq.rec_on p (take q h, h ⬝ (con_idp _)) q
 
-  definition moveR_1V (p : x = y) (q : y = x) :
+  definition inv_eq_of_idp_eq_con (p : x = y) (q : y = x) :
     idp = q ⬝ p → p⁻¹ = q :=
-  eq.rec_on p (take q h, h ⬝ (concat_p1 _)) q
+  eq.rec_on p (take q h, h ⬝ (con_idp _)) q
 
-  definition moveR_V1 (p : x = y) (q : y = x) :
+  definition inv_eq_of_idp_eq_con' (p : x = y) (q : y = x) :
     idp = p ⬝ q → p⁻¹ = q :=
-  eq.rec_on p (take q h, h ⬝ (concat_1p _)) q
+  eq.rec_on p (take q h, h ⬝ (idp_con _)) q
 
-
+  /- Transport -/
-  -- Transport
-  -- ---------
 
   definition transport [reducible] (P : A → Type) {x y : A} (p : x = y) (u : P x) : P y :=
   eq.rec_on p u
@@ -181,6 +177,9 @@ namespace eq
   -- This idiom makes the operation right associative.
   notation p `▹`:65 x:64 := transport _ p x
 
+  definition tr_inv [reducible] (P : A → Type) {x y : A} (p : x = y) (u : P y) : P x :=
+  p⁻¹ ▹ u
+
   definition ap ⦃A B : Type⦄ (f : A → B) {x y:A} (p : x = y) : f x = f y :=
   eq.rec_on p idp
 
@@ -191,6 +190,21 @@ namespace eq
 
   notation f ∼ g := homotopy f g
 
+  namespace homotopy
+  protected definition refl (f : Πx, P x) : f ∼ f :=
+  λ x, idp
+
+  protected definition symm {f g : Πx, P x} (H : f ∼ g) : g ∼ f :=
+  λ x, inverse (H x)
+
+  protected definition trans {f g h : Πx, P x} (H1 : f ∼ g) (H2 : g ∼ h) : f ∼ h :=
+  λ x, concat (H1 x) (H2 x)
+
+  calc_refl refl
+  calc_symm symm
+  calc_trans trans
+  end homotopy
+
   definition apD10 {f g : Πx, P x} (H : f = g) : f ∼ g :=
   λx, eq.rec_on H idp
 
@@ -202,68 +216,64 @@ namespace eq
   definition apD (f : Πa:A, P a) {x y : A} (p : x = y) : p ▹ (f x) = f y :=
   eq.rec_on p idp
 
-
+  /- calc enviroment -/
-  -- calc enviroment
-  -- ---------------
 
   calc_subst transport
   calc_trans concat
   calc_refl refl
   calc_symm inverse
 
-  -- More theorems for moving things around in equations
+  /- More theorems for moving things around in equations -/
-  -- ---------------------------------------------------
 
-  definition moveR_transport_p (P : A → Type) {x y : A} (p : x = y) (u : P x) (v : P y) :
+  definition tr_eq_of_eq_inv_tr (P : A → Type) {x y : A} (p : x = y) (u : P x) (v : P y) :
     u = p⁻¹ ▹ v → p ▹ u = v :=
   eq.rec_on p (take v, id) v
 
-  definition moveR_transport_V (P : A → Type) {x y : A} (p : y = x) (u : P x) (v : P y) :
+  definition inv_tr_eq_of_eq_tr (P : A → Type) {x y : A} (p : y = x) (u : P x) (v : P y) :
     u = p ▹ v → p⁻¹ ▹ u = v :=
   eq.rec_on p (take u, id) u
 
-  definition moveL_transport_V (P : A → Type) {x y : A} (p : x = y) (u : P x) (v : P y) :
+  definition eq_inv_tr_of_tr_eq (P : A → Type) {x y : A} (p : x = y) (u : P x) (v : P y) :
     p ▹ u = v → u = p⁻¹ ▹ v :=
   eq.rec_on p (take v, id) v
 
-  definition moveL_transport_p (P : A → Type) {x y : A} (p : y = x) (u : P x) (v : P y) :
+  definition eq_tr_of_inv_tr_eq (P : A → Type) {x y : A} (p : y = x) (u : P x) (v : P y) :
     p⁻¹ ▹ u = v → u = p ▹ v :=
   eq.rec_on p (take u, id) u
 
-  -- Functoriality of functions
+  /- Functoriality of functions -/
-  -- --------------------------
 
   -- Here we prove that functions behave like functors between groupoids, and that [ap] itself is
   -- functorial.
 
   -- Functions take identity paths to identity paths
-  definition ap_1 (x : A) (f : A → B) : (ap f idp) = idp :> (f x = f x) := idp
+  definition ap_idp (x : A) (f : A → B) : (ap f idp) = idp :> (f x = f x) := idp
 
-  definition apD_1 (x : A) (f : Π x : A, P x) : apD f idp = idp :> (f x = f x) := idp
+  definition apD_idp (x : A) (f : Π x : A, P x) : apD f idp = idp :> (f x = f x) := idp
 
   -- Functions commute with concatenation.
-  definition ap_pp (f : A → B) {x y z : A} (p : x = y) (q : y = z) :
+  definition ap_con (f : A → B) {x y z : A} (p : x = y) (q : y = z) :
     ap f (p ⬝ q) = (ap f p) ⬝ (ap f q) :=
   eq.rec_on q (eq.rec_on p idp)
 
-  definition ap_p_pp (f : A → B) {w x y z : A} (r : f w = f x) (p : x = y) (q : y = z) :
+  definition con_ap_con_eq_con_ap_con_ap (f : A → B) {w x y z : A} (r : f w = f x) (p : x = y) (q : y = z) :
     r ⬝ (ap f (p ⬝ q)) = (r ⬝ ap f p) ⬝ (ap f q) :=
-  eq.rec_on q (take p, eq.rec_on p (concat_p_pp r idp idp)) p
+  eq.rec_on q (take p, eq.rec_on p (con.assoc' r idp idp)) p
 
-  definition ap_pp_p (f : A → B) {w x y z : A} (p : x = y) (q : y = z) (r : f z = f w) :
+  definition ap_con_con_eq_ap_con_ap_con (f : A → B) {w x y z : A} (p : x = y) (q : y = z) (r : f z = f w) :
     (ap f (p ⬝ q)) ⬝ r = (ap f p) ⬝ (ap f q ⬝ r) :=
-  eq.rec_on q (eq.rec_on p (take r, concat_pp_p _ _ _)) r
+  eq.rec_on q (eq.rec_on p (take r, con.assoc _ _ _)) r
 
   -- Functions commute with path inverses.
-  definition inverse_ap (f : A → B) {x y : A} (p : x = y) : (ap f p)⁻¹ = ap f (p⁻¹) :=
+  definition ap_inv' (f : A → B) {x y : A} (p : x = y) : (ap f p)⁻¹ = ap f (p⁻¹) :=
   eq.rec_on p idp
 
-  definition ap_V {A B : Type} (f : A → B) {x y : A} (p : x = y) : ap f (p⁻¹) = (ap f p)⁻¹ :=
+  definition ap_inv {A B : Type} (f : A → B) {x y : A} (p : x = y) : ap f (p⁻¹) = (ap f p)⁻¹ :=
   eq.rec_on p idp
 
   -- [ap] itself is functorial in the first argument.
 
-  definition ap_idmap (p : x = y) : ap id p = p :=
+  definition ap_id (p : x = y) : ap id p = p :=
   eq.rec_on p idp
 
   definition ap_compose (f : A → B) (g : B → C) {x y : A} (p : x = y) :
@@ -276,104 +286,103 @@ namespace eq
   eq.rec_on p idp
 
   -- The action of constant maps.
-  definition ap_const (p : x = y) (z : B) :
+  definition ap_constant (p : x = y) (z : B) :
     ap (λu, z) p = idp :=
   eq.rec_on p idp
 
   -- Naturality of [ap].
-  definition concat_Ap {f g : A → B} (p : Π x, f x = g x) {x y : A} (q : x = y) :
+  definition ap_con_eq_con_ap {f g : A → B} (p : Π x, f x = g x) {x y : A} (q : x = y) :
     (ap f q) ⬝ (p y) = (p x) ⬝ (ap g q) :=
-  eq.rec_on q (concat_1p _ ⬝ (concat_p1 _)⁻¹)
+  eq.rec_on q (idp_con _ ⬝ (con_idp _)⁻¹)
 
   -- Naturality of [ap] at identity.
-  definition concat_A1p {f : A → A} (p : Πx, f x = x) {x y : A} (q : x = y) :
+  definition ap_con_eq_con {f : A → A} (p : Πx, f x = x) {x y : A} (q : x = y) :
     (ap f q) ⬝ (p y) = (p x) ⬝ q :=
-  eq.rec_on q (concat_1p _ ⬝ (concat_p1 _)⁻¹)
+  eq.rec_on q (idp_con _ ⬝ (con_idp _)⁻¹)
 
-  definition concat_pA1 {f : A → A} (p : Πx, x = f x) {x y : A} (q : x = y) :
+  definition con_ap_eq_con {f : A → A} (p : Πx, x = f x) {x y : A} (q : x = y) :
     (p x) ⬝ (ap f q) =  q ⬝ (p y) :=
-  eq.rec_on q (concat_p1 _ ⬝ (concat_1p _)⁻¹)
+  eq.rec_on q (con_idp _ ⬝ (idp_con _)⁻¹)
 
   -- Naturality with other paths hanging around.
 
-  definition concat_pA_pp {f g : A → B} (p : Πx, f x = g x) {x y : A} (q : x = y)
+  definition con_ap_con_con_eq_con_con_ap_con {f g : A → B} (p : f ∼ g) {x y : A} (q : x = y)
       {w z : B} (r : w = f x) (s : g y = z) :
     (r ⬝ ap f q) ⬝ (p y ⬝ s) = (r ⬝ p x) ⬝ (ap g q ⬝ s) :=
   eq.rec_on s (eq.rec_on q idp)
 
-  definition concat_pA_p {f g : A → B} (p : Πx, f x = g x) {x y : A} (q : x = y)
+  definition con_ap_con_eq_con_con_ap {f g : A → B} (p : f ∼ g) {x y : A} (q : x = y)
       {w : B} (r : w = f x) :
     (r ⬝ ap f q) ⬝ p y = (r ⬝ p x) ⬝ ap g q :=
   eq.rec_on q idp
 
   -- TODO: try this using the simplifier, and compare proofs
-  definition concat_A_pp {f g : A → B} (p : Πx, f x = g x) {x y : A} (q : x = y)
+  definition ap_con_con_eq_con_ap_con {f g : A → B} (p : f ∼ g) {x y : A} (q : x = y)
       {z : B} (s : g y = z) :
     (ap f q) ⬝ (p y ⬝ s) = (p x) ⬝ (ap g q ⬝ s) :=
   eq.rec_on s (eq.rec_on q
     (calc
       (ap f idp) ⬝ (p x ⬝ idp) = idp ⬝ p x : idp
-        ... = p x : concat_1p _
+        ... = p x : idp_con _
         ... = (p x) ⬝ (ap g idp ⬝ idp) : idp))
   -- This also works:
-  -- eq.rec_on s (eq.rec_on q (concat_1p _ ▹ idp))
+  -- eq.rec_on s (eq.rec_on q (idp_con _ ▹ idp))
 
-  definition concat_pA1_pp {f : A → A} (p : Πx, f x = x) {x y : A} (q : x = y)
+  definition con_ap_con_con_eq_con_con_con {f : A → A} (p : f ∼ id) {x y : A} (q : x = y)
       {w z : A} (r : w = f x) (s : y = z) :
     (r ⬝ ap f q) ⬝ (p y ⬝ s) = (r ⬝ p x) ⬝ (q ⬝ s) :=
   eq.rec_on s (eq.rec_on q idp)
 
-  definition concat_pp_A1p {g : A → A} (p : Πx, x = g x) {x y : A} (q : x = y)
+  definition con_con_ap_con_eq_con_con_con {g : A → A} (p : id ∼ g) {x y : A} (q : x = y)
       {w z : A} (r : w = x) (s : g y = z) :
     (r ⬝ p x) ⬝ (ap g q ⬝ s) = (r ⬝ q) ⬝ (p y ⬝ s) :=
   eq.rec_on s (eq.rec_on q idp)
 
-  definition concat_pA1_p {f : A → A} (p : Πx, f x = x) {x y : A} (q : x = y)
+  definition con_ap_con_eq_con_con {f : A → A} (p : f ∼ id) {x y : A} (q : x = y)
       {w : A} (r : w = f x) :
     (r ⬝ ap f q) ⬝ p y = (r ⬝ p x) ⬝ q :=
   eq.rec_on q idp
 
-  definition concat_A1_pp {f : A → A} (p : Πx, f x = x) {x y : A} (q : x = y)
+  definition ap_con_con_eq_con_con {f : A → A} (p : f ∼ id) {x y : A} (q : x = y)
       {z : A} (s : y = z) :
     (ap f q) ⬝ (p y ⬝ s) = (p x) ⬝ (q ⬝ s) :=
-  eq.rec_on s (eq.rec_on q (concat_1p _ ▹ idp))
+  eq.rec_on s (eq.rec_on q (idp_con _ ▹ idp))
 
-  definition concat_pp_A1 {g : A → A} (p : Πx, x = g x) {x y : A} (q : x = y)
+  definition con_con_ap_eq_con_con {g : A → A} (p : id ∼ g) {x y : A} (q : x = y)
       {w : A} (r : w = x) :
     (r ⬝ p x) ⬝ ap g q = (r ⬝ q) ⬝ p y :=
   eq.rec_on q idp
 
-  definition concat_p_A1p {g : A → A} (p : Πx, x = g x) {x y : A} (q : x = y)
+  definition con_ap_con_eq_con_con' {g : A → A} (p : id ∼ g) {x y : A} (q : x = y)
       {z : A} (s : g y = z) :
     p x ⬝ (ap g q ⬝ s) = q ⬝ (p y ⬝ s) :=
   begin
     apply (eq.rec_on s),
     apply (eq.rec_on q),
-    apply (concat_1p (p x) ▹ idp)
+    apply (idp_con (p x) ▹ idp)
   end
 
-  -- Action of [apD10] and [ap10] on paths
+  /- Action of [apD10] and [ap10] on paths -/
-  -- -------------------------------------
 
   -- Application of paths between functions preserves the groupoid structure
 
-  definition apD10_1 (f : Πx, P x) (x : A) : apD10 (refl f) x = idp := idp
+  definition apD10_idp (f : Πx, P x) (x : A) : apD10 (refl f) x = idp := idp
 
-  definition apD10_pp {f f' f'' : Πx, P x} (h : f = f') (h' : f' = f'') (x : A) :
+  definition apD10_con {f f' f'' : Πx, P x} (h : f = f') (h' : f' = f'') (x : A) :
     apD10 (h ⬝ h') x = apD10 h x ⬝ apD10 h' x :=
   eq.rec_on h (take h', eq.rec_on h' idp) h'
 
-  definition apD10_V {f g : Πx : A, P x} (h : f = g) (x : A) :
+  definition apD10_inv {f g : Πx : A, P x} (h : f = g) (x : A) :
     apD10 (h⁻¹) x = (apD10 h x)⁻¹ :=
   eq.rec_on h idp
 
-  definition ap10_1 {f : A → B} (x : A) : ap10 (refl f) x = idp := idp
+  definition ap10_idp {f : A → B} (x : A) : ap10 (refl f) x = idp := idp
 
-  definition ap10_pp {f f' f'' : A → B} (h : f = f') (h' : f' = f'') (x : A) :
+  definition ap10_con {f f' f'' : A → B} (h : f = f') (h' : f' = f'') (x : A) :
-  ap10 (h ⬝ h') x = ap10 h x ⬝ ap10 h' x := apD10_pp h h' x
+  ap10 (h ⬝ h') x = ap10 h x ⬝ ap10 h' x := apD10_con h h' x
 
-  definition ap10_V {f g : A → B} (h : f = g) (x : A) : ap10 (h⁻¹) x = (ap10 h x)⁻¹ :=
+  definition ap10_inv {f g : A → B} (h : f = g) (x : A) : ap10 (h⁻¹) x = (ap10 h x)⁻¹ :=
-  apD10_V h x
+  apD10_inv h x
 
   -- [ap10] also behaves nicely on paths produced by [ap]
   definition ap_ap10 (f g : A → B) (h : B → C) (p : f = g) (a : A) :
@@ -381,35 +390,34 @@ namespace eq
   eq.rec_on p idp
 
 
-  -- Transport and the groupoid structure of paths
+  /- Transport and the groupoid structure of paths -/
-  -- ---------------------------------------------
 
-  definition transport_1 (P : A → Type) {x : A} (u : P x) :
+  definition tr_idp (P : A → Type) {x : A} (u : P x) :
     idp ▹ u = u := idp
 
-  definition transport_pp (P : A → Type) {x y z : A} (p : x = y) (q : y = z) (u : P x) :
+  definition tr_con (P : A → Type) {x y z : A} (p : x = y) (q : y = z) (u : P x) :
     p ⬝ q ▹ u = q ▹ p ▹ u :=
   eq.rec_on q (eq.rec_on p idp)
 
-  definition transport_pV (P : A → Type) {x y : A} (p : x = y) (z : P y) :
+  definition tr_inv_tr (P : A → Type) {x y : A} (p : x = y) (z : P y) :
     p ▹ p⁻¹ ▹ z = z :=
-  (transport_pp P (p⁻¹) p z)⁻¹ ⬝ ap (λr, transport P r z) (concat_Vp p)
+  (tr_con P (p⁻¹) p z)⁻¹ ⬝ ap (λr, transport P r z) (con.right_inv p)
 
-  definition transport_Vp (P : A → Type) {x y : A} (p : x = y) (z : P x) :
+  definition inv_tr_tr (P : A → Type) {x y : A} (p : x = y) (z : P x) :
     p⁻¹ ▹ p ▹ z = z :=
-  (transport_pp P p (p⁻¹) z)⁻¹ ⬝ ap (λr, transport P r z) (concat_pV p)
+  (tr_con P p (p⁻¹) z)⁻¹ ⬝ ap (λr, transport P r z) (con.left_inv p)
 
-  definition transport_p_pp (P : A → Type)
+  definition tr_con_lemma (P : A → Type)
       {x y z w : A} (p : x = y) (q : y = z) (r : z = w) (u : P x) :
-    ap (λe, e ▹ u) (concat_p_pp p q r) ⬝ (transport_pp P (p ⬝ q) r u) ⬝
+    ap (λe, e ▹ u) (con.assoc' p q r) ⬝ (tr_con P (p ⬝ q) r u) ⬝
-        ap (transport P r) (transport_pp P p q u)
+        ap (transport P r) (tr_con P p q u)
-      = (transport_pp P p (q ⬝ r) u) ⬝ (transport_pp P q r (p ▹ u))
+      = (tr_con P p (q ⬝ r) u) ⬝ (tr_con P q r (p ▹ u))
       :> ((p ⬝ (q ⬝ r)) ▹ u = r ▹ q ▹ p ▹ u) :=
   eq.rec_on r (eq.rec_on q (eq.rec_on p idp))
 
   --  Here is another coherence lemma for transport.
-  definition transport_pVp (P : A → Type) {x y : A} (p : x = y) (z : P x) :
+  definition tr_inv_tr_lemma (P : A → Type) {x y : A} (p : x = y) (z : P x) :
-    transport_pV P p (transport P p z) = ap (transport P p) (transport_Vp P p z) :=
+    tr_inv_tr P p (transport P p z) = ap (transport P p) (inv_tr_tr P p z) :=
   eq.rec_on p idp
 
   -- Dependent transport in a doubly dependent type.
@@ -428,17 +436,17 @@ namespace eq
   notation p `▹2`:65 x:64 := transport2 _ p _ x
 
   -- An alternative definition.
-  definition transport2_is_ap10 (Q : A → Type) {x y : A} {p q : x = y} (r : p = q)
+  definition tr2_eq_ap10 (Q : A → Type) {x y : A} {p q : x = y} (r : p = q)
       (z : Q x) :
     transport2 Q r z = ap10 (ap (transport Q) r) z :=
   eq.rec_on r idp
 
-  definition transport2_p2p (P : A → Type) {x y : A} {p1 p2 p3 : x = y}
+  definition tr2_con (P : A → Type) {x y : A} {p1 p2 p3 : x = y}
       (r1 : p1 = p2) (r2 : p2 = p3) (z : P x) :
     transport2 P (r1 ⬝ r2) z = transport2 P r1 z ⬝ transport2 P r2 z :=
   eq.rec_on r1 (eq.rec_on r2 idp)
 
-  definition transport2_V (Q : A → Type) {x y : A} {p q : x = y} (r : p = q) (z : Q x) :
+  definition tr2_inv (Q : A → Type) {x y : A} {p q : x = y} (r : p = q) (z : Q x) :
     transport2 Q (r⁻¹) z = ((transport2 Q r z)⁻¹) :=
   eq.rec_on r idp
 
@@ -448,19 +456,17 @@ namespace eq
 
   notation p `▹D2`:65 x:64 := transportD2 _ _ _ p _ _ x
 
-  definition concat_AT (P : A → Type) {x y : A} {p q : x = y} {z w : P x} (r : p = q)
+  definition ap_tr_con_tr2 (P : A → Type) {x y : A} {p q : x = y} {z w : P x} (r : p = q)
       (s : z = w) :
     ap (transport P p) s  ⬝  transport2 P r w = transport2 P r z  ⬝  ap (transport P q) s :=
-  eq.rec_on r (concat_p1 _ ⬝ (concat_1p _)⁻¹)
+  eq.rec_on r (con_idp _ ⬝ (idp_con _)⁻¹)
 
-  -- TODO (from Coq library): What should this be called?
+
-  definition ap_transport {P Q : A → Type} {x y : A} (p : x = y) (f : Πx, P x → Q x) (z : P x) :
+  definition fn_tr_eq_tr_fn {P Q : A → Type} {x y : A} (p : x = y) (f : Πx, P x → Q x) (z : P x) :
     f y (p ▹ z) = (p ▹ (f x z)) :=
   eq.rec_on p idp
 
-
+  /- Transporting in particular fibrations -/
-  -- Transporting in particular fibrations
-  -- -------------------------------------
 
   /-
   From the Coq HoTT library:
@@ -472,12 +478,12 @@ namespace eq
   -/
 
   -- Transporting in a constant fibration.
-  definition transport_const (p : x = y) (z : B) : transport (λx, B) p z = z :=
+  definition tr_constant (p : x = y) (z : B) : transport (λx, B) p z = z :=
   eq.rec_on p idp
 
-  definition transport2_const {p q : x = y} (r : p = q) (z : B) :
+  definition tr2_constant {p q : x = y} (r : p = q) (z : B) :
-    transport_const p z = transport2 (λu, B) r z ⬝ transport_const q z :=
+    tr_constant p z = transport2 (λu, B) r z ⬝ tr_constant q z :=
-  eq.rec_on r (concat_1p _)⁻¹
+  eq.rec_on r (idp_con _)⁻¹
 
   -- Transporting in a pulled back fibration.
   -- TODO: P can probably be implicit
@@ -485,8 +491,8 @@ namespace eq
     transport (P ∘ f) p z  =  transport P (ap f p) z :=
   eq.rec_on p idp
 
-  definition transport_precompose (f : A → B) (g g' : B → C) (p : g = g') :
+  definition ap_precompose (f : A → B) (g g' : B → C) (p : g = g') :
-    transport (λh : B → C, g ∘ f = h ∘ f) p idp = ap (λh, h ∘ f) p :=
+    ap (λh, h ∘ f) p = transport (λh : B → C, g ∘ f = h ∘ f) p idp :=
   eq.rec_on p idp
 
   definition apD10_ap_precompose (f : A → B) (g g' : B → C) (p : g = g') (a : A) :
@@ -498,22 +504,20 @@ namespace eq
   eq.rec_on p idp
 
   -- A special case of [transport_compose] which seems to come up a lot.
-  definition transport_idmap_ap (P : A → Type) x y (p : x = y) (u : P x) :
+  definition tr_eq_tr_id_ap (P : A → Type) x y (p : x = y) (u : P x) :
-    transport P p u = transport (λz, z) (ap P p) u :=
+    transport P p u = transport id (ap P p) u :=
   eq.rec_on p idp
 
 
-  -- The behavior of [ap] and [apD]
+  /- The behavior of [ap] and [apD] -/
-  -- ------------------------------
 
   -- In a constant fibration, [apD] reduces to [ap], modulo [transport_const].
-  definition apD_const (f : A → B) (p: x = y) :
+  definition apD_eq_tr_constant_con_ap (f : A → B) (p: x = y) :
-    apD f p = transport_const p (f x) ⬝ ap f p :=
+    apD f p = tr_constant p (f x) ⬝ ap f p :=
   eq.rec_on p idp
 
 
-  -- The 2-dimensional groupoid structure
+  /- The 2-dimensional groupoid structure -/
-  -- ------------------------------------
 
   -- Horizontal composition of 2-dimensional paths.
   definition concat2 {p p' : x = y} {q q' : y = z} (h : p = p') (h' : q = q') :
@@ -527,127 +531,126 @@ namespace eq
   eq.rec_on h idp
 
 
-  -- Whiskering
+  /- Whiskering -/
-  -- ----------
 
-  definition whiskerL (p : x = y) {q r : y = z} (h : q = r) : p ⬝ q = p ⬝ r :=
+  definition whisker_left (p : x = y) {q r : y = z} (h : q = r) : p ⬝ q = p ⬝ r :=
   idp ◾ h
 
-  definition whiskerR {p q : x = y} (h : p = q) (r : y = z) : p ⬝ r = q ⬝ r :=
+  definition whisker_right {p q : x = y} (h : p = q) (r : y = z) : p ⬝ r = q ⬝ r :=
   h ◾ idp
 
   -- Unwhiskering, a.k.a. cancelling
 
-  definition cancelL {x y z : A} (p : x = y) (q r : y = z) : (p ⬝ q = p ⬝ r) → (q = r) :=
+  definition cancel_left {x y z : A} (p : x = y) (q r : y = z) : (p ⬝ q = p ⬝ r) → (q = r) :=
-  eq.rec_on p (take r, eq.rec_on r (take q a, (concat_1p q)⁻¹ ⬝ a)) r q
+  eq.rec_on p (take r, eq.rec_on r (take q a, (idp_con q)⁻¹ ⬝ a)) r q
 
-  definition cancelR {x y z : A} (p q : x = y) (r : y = z) : (p ⬝ r = q ⬝ r) → (p = q) :=
+  definition cancel_right {x y z : A} (p q : x = y) (r : y = z) : (p ⬝ r = q ⬝ r) → (p = q) :=
-  eq.rec_on r (eq.rec_on p (take q a, a ⬝ concat_p1 q)) q
+  eq.rec_on r (eq.rec_on p (take q a, a ⬝ con_idp q)) q
 
   -- Whiskering and identity paths.
 
-  definition whiskerR_p1 {p q : x = y} (h : p = q) :
+  definition whisker_right_idp_right {p q : x = y} (h : p = q) :
-    (concat_p1 p)⁻¹ ⬝ whiskerR h idp ⬝ concat_p1 q = h :=
+    (con_idp p)⁻¹ ⬝ whisker_right h idp ⬝ con_idp q = h :=
   eq.rec_on h (eq.rec_on p idp)
 
-  definition whiskerR_1p (p : x = y) (q : y = z) :
+  definition whisker_right_idp_left (p : x = y) (q : y = z) :
-    whiskerR idp q = idp :> (p ⬝ q = p ⬝ q) :=
+    whisker_right idp q = idp :> (p ⬝ q = p ⬝ q) :=
   eq.rec_on q idp
 
-  definition whiskerL_p1 (p : x = y) (q : y = z) :
+  definition whisker_left_idp_right (p : x = y) (q : y = z) :
-    whiskerL p idp = idp :> (p ⬝ q = p ⬝ q) :=
+    whisker_left p idp = idp :> (p ⬝ q = p ⬝ q) :=
   eq.rec_on q idp
 
-  definition whiskerL_1p {p q : x = y} (h : p = q) :
+  definition whisker_left_idp_left {p q : x = y} (h : p = q) :
-    (concat_1p p) ⁻¹ ⬝ whiskerL idp h ⬝ concat_1p q = h :=
+    (idp_con p) ⁻¹ ⬝ whisker_left idp h ⬝ idp_con q = h :=
   eq.rec_on h (eq.rec_on p idp)
 
-  definition concat2_p1 {p q : x = y} (h : p = q) :
+  definition con2_idp {p q : x = y} (h : p = q) :
-    h ◾ idp = whiskerR h idp :> (p ⬝ idp = q ⬝ idp) :=
+    h ◾ idp = whisker_right h idp :> (p ⬝ idp = q ⬝ idp) :=
   eq.rec_on h idp
 
-  definition concat2_1p {p q : x = y} (h : p = q) :
+  definition idp_con2 {p q : x = y} (h : p = q) :
-    idp ◾ h = whiskerL idp h :> (idp ⬝ p = idp ⬝ q) :=
+    idp ◾ h = whisker_left idp h :> (idp ⬝ p = idp ⬝ q) :=
   eq.rec_on h idp
 
   -- TODO: note, 4 inductions
   -- The interchange law for concatenation.
-  definition concat_concat2 {p p' p'' : x = y} {q q' q'' : y = z}
+  definition con2_con_con2 {p p' p'' : x = y} {q q' q'' : y = z}
       (a : p = p') (b : p' = p'') (c : q = q') (d : q' = q'') :
     (a ◾ c) ⬝ (b ◾ d) = (a ⬝ b) ◾ (c ⬝ d) :=
   eq.rec_on d (eq.rec_on c (eq.rec_on b (eq.rec_on a idp)))
 
-  definition concat_whisker {x y z : A} (p p' : x = y) (q q' : y = z) (a : p = p') (b : q = q') :
+  definition whisker_right_con_whisker_left {x y z : A} (p p' : x = y) (q q' : y = z) (a : p = p') (b : q = q') :
-    (whiskerR a q) ⬝ (whiskerL p' b) = (whiskerL p b) ⬝ (whiskerR a q') :=
+    (whisker_right a q) ⬝ (whisker_left p' b) = (whisker_left p b) ⬝ (whisker_right a q') :=
-  eq.rec_on b (eq.rec_on a (concat_1p _)⁻¹)
+  eq.rec_on b (eq.rec_on a (idp_con _)⁻¹)
 
   -- Structure corresponding to the coherence equations of a bicategory.
 
   -- The "pentagonator": the 3-cell witnessing the associativity pentagon.
   definition pentagon {v w x y z : A} (p : v = w) (q : w = x) (r : x = y) (s : y = z) :
-    whiskerL p (concat_p_pp q r s)
+    whisker_left p (con.assoc' q r s)
-      ⬝ concat_p_pp p (q ⬝ r) s
+      ⬝ con.assoc' p (q ⬝ r) s
-      ⬝ whiskerR (concat_p_pp p q r) s
+      ⬝ whisker_right (con.assoc' p q r) s
-    = concat_p_pp p q (r ⬝ s) ⬝ concat_p_pp (p ⬝ q) r s :=
+    = con.assoc' p q (r ⬝ s) ⬝ con.assoc' (p ⬝ q) r s :=
   eq.rec_on s (eq.rec_on r (eq.rec_on q (eq.rec_on p idp)))
 
   -- The 3-cell witnessing the left unit triangle.
   definition triangulator (p : x = y) (q : y = z) :
-    concat_p_pp p idp q ⬝ whiskerR (concat_p1 p) q = whiskerL p (concat_1p q) :=
+    con.assoc' p idp q ⬝ whisker_right (con_idp p) q = whisker_left p (idp_con q) :=
   eq.rec_on q (eq.rec_on p idp)
 
   definition eckmann_hilton {x:A} (p q : idp = idp :> (x = x)) : p ⬝ q = q ⬝ p :=
-    (!whiskerR_p1 ◾ !whiskerL_1p)⁻¹
+    (!whisker_right_idp_right ◾ !whisker_left_idp_left)⁻¹
-    ⬝ (!concat_p1 ◾ !concat_p1)
+    ⬝ (!con_idp ◾ !con_idp)
-    ⬝ (!concat_1p ◾ !concat_1p)
+    ⬝ (!idp_con ◾ !idp_con)
-    ⬝ !concat_whisker
+    ⬝ !whisker_right_con_whisker_left
-    ⬝ (!concat_1p ◾ !concat_1p)⁻¹
+    ⬝ (!idp_con ◾ !idp_con)⁻¹
-    ⬝ (!concat_p1 ◾ !concat_p1)⁻¹
+    ⬝ (!con_idp ◾ !con_idp)⁻¹
-    ⬝ (!whiskerL_1p ◾ !whiskerR_p1)
+    ⬝ (!whisker_left_idp_left ◾ !whisker_right_idp_right)
 
   -- The action of functions on 2-dimensional paths
   definition ap02 (f:A → B) {x y : A} {p q : x = y} (r : p = q) : ap f p = ap f q :=
   eq.rec_on r idp
 
-  definition ap02_pp (f : A → B) {x y : A} {p p' p'' : x = y} (r : p = p') (r' : p' = p'') :
+  definition ap02_con (f : A → B) {x y : A} {p p' p'' : x = y} (r : p = p') (r' : p' = p'') :
     ap02 f (r ⬝ r') = ap02 f r ⬝ ap02 f r' :=
   eq.rec_on r (eq.rec_on r' idp)
 
-  definition ap02_p2p (f : A → B) {x y z : A} {p p' : x = y} {q q' :y = z} (r : p = p')
+  definition ap02_con2 (f : A → B) {x y z : A} {p p' : x = y} {q q' :y = z} (r : p = p')
     (s : q = q') :
-      ap02 f (r ◾ s) = ap_pp f p q
+      ap02 f (r ◾ s) = ap_con f p q
                         ⬝ (ap02 f r  ◾  ap02 f s)
-                        ⬝ (ap_pp f p' q')⁻¹ :=
+                        ⬝ (ap_con f p' q')⁻¹ :=
   eq.rec_on r (eq.rec_on s (eq.rec_on q (eq.rec_on p idp)))
   -- eq.rec_on r (eq.rec_on s (eq.rec_on p (eq.rec_on q idp)))
 
   definition apD02 {p q : x = y} (f : Π x, P x) (r : p = q) :
     apD f p = transport2 P r (f x) ⬝ apD f q :=
-  eq.rec_on r (concat_1p _)⁻¹
+  eq.rec_on r (idp_con _)⁻¹
 
   -- And now for a lemma whose statement is much longer than its proof.
-  definition apD02_pp (P : A → Type) (f : Π x:A, P x) {x y : A}
+  definition apD02_con (P : A → Type) (f : Π x:A, P x) {x y : A}
       {p1 p2 p3 : x = y} (r1 : p1 = p2) (r2 : p2 = p3) :
     apD02 f (r1 ⬝ r2) = apD02 f r1
-      ⬝ whiskerL (transport2 P r1 (f x)) (apD02 f r2)
+      ⬝ whisker_left (transport2 P r1 (f x)) (apD02 f r2)
-      ⬝ concat_p_pp _ _ _
+      ⬝ con.assoc' _ _ _
-      ⬝ (whiskerR ((transport2_p2p P r1 r2 (f x))⁻¹) (apD f p3)) :=
+      ⬝ (whisker_right ((tr2_con P r1 r2 (f x))⁻¹) (apD f p3)) :=
   eq.rec_on r2 (eq.rec_on r1 (eq.rec_on p1 idp))
 end eq
 
 namespace eq
 variables {A B C D E : Type} {a a' : A} {b b' : B} {c c' : C} {d d' : D}
 
-theorem congr_arg2 (f : A → B → C) (Ha : a = a') (Hb : b = b') : f a b = f a' b' :=
+theorem ap011 (f : A → B → C) (Ha : a = a') (Hb : b = b') : f a b = f a' b' :=
 eq.rec_on Ha (eq.rec_on Hb idp)
 
-theorem congr_arg3 (f : A → B → C → D) (Ha : a = a') (Hb : b = b') (Hc : c = c')
+theorem ap0111 (f : A → B → C → D) (Ha : a = a') (Hb : b = b') (Hc : c = c')
     : f a b c = f a' b' c' :=
-eq.rec_on Ha (congr_arg2 (f a) Hb Hc)
+eq.rec_on Ha (ap011 (f a) Hb Hc)
 
-theorem congr_arg4 (f : A → B → C → D → E) (Ha : a = a') (Hb : b = b') (Hc : c = c') (Hd : d = d')
+theorem ap01111 (f : A → B → C → D → E) (Ha : a = a') (Hb : b = b') (Hc : c = c') (Hd : d = d')
     : f a b c d = f a' b' c' d' :=
-eq.rec_on Ha (congr_arg3 (f a) Hb Hc Hd)
+eq.rec_on Ha (ap0111 (f a) Hb Hc Hd)
 
 end eq
 
@@ -659,60 +662,8 @@ variables {a a' : A}
           {c : C a b} {c' : C a' b'}
           {d : D a b c} {d' : D a' b' c'}
 
-theorem dcongr_arg2 (f : Πa, B a → F) (Ha : a = a') (Hb : (Ha ▹ b) = b')
+theorem apD011 (f : Πa, B a → F) (Ha : a = a') (Hb : (Ha ▹ b) = b')
     : f a b = f a' b' :=
 eq.rec_on Hb (eq.rec_on Ha idp)
 
-  /- From the Coq version:
-
-  -- ** Tactics, hints, and aliases
-
-  -- [concat], with arguments flipped. Useful mainly in the idiom [apply (concatR (expression))].
-  -- Given as a notation not a definition so that the resultant terms are literally instances of
-  -- [concat], with no unfolding required.
-  Notation concatR := (λp q, concat q p).
-
-  Hint Resolve
-    concat_1p concat_p1 concat_p_pp
-    inv_pp inv_V
-   : path_hints.
-
-  (* First try at a paths db
-  We want the RHS of the equation to become strictly simpler
-  Hint Rewrite
-  ⬝concat_p1
-  ⬝concat_1p
-  ⬝concat_p_pp (* there is a choice here !*)
-  ⬝concat_pV
-  ⬝concat_Vp
-  ⬝concat_V_pp
-  ⬝concat_p_Vp
-  ⬝concat_pp_V
-  ⬝concat_pV_p
-  (*⬝inv_pp*) (* I am not sure about this one
-  ⬝inv_V
-  ⬝moveR_Mp
-  ⬝moveR_pM
-  ⬝moveL_Mp
-  ⬝moveL_pM
-  ⬝moveL_1M
-  ⬝moveL_M1
-  ⬝moveR_M1
-  ⬝moveR_1M
-  ⬝ap_1
-  (* ⬝ap_pp
-  ⬝ap_p_pp ?*)
-  ⬝inverse_ap
-  ⬝ap_idmap
-  (* ⬝ap_compose
-  ⬝ap_compose'*)
-  ⬝ap_const
-  (* Unsure about naturality of [ap], was absent in the old implementation*)
-  ⬝apD10_1
-  :paths.
-
-  Ltac hott_simpl :=
-    autorewrite with paths in * |- * ; auto with path_hints.
-
-  -/
 end eq

hott/init/priority.hlean

@@ -2,6 +2,7 @@
 Copyright (c) 2014 Microsoft Corporation. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 
+Module: init.priority
 Authors: Leonardo de Moura
 -/
 prelude

hott/init/relation.hlean

@@ -1,6 +1,8 @@
 /-
 Copyright (c) 2014 Microsoft Corporation. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
+
+Module: init.relation
 Authors: Leonardo de Moura
 -/
 prelude

hott/init/reserved_notation.hlean

@@ -2,6 +2,7 @@
 Copyright (c) 2014 Microsoft Corporation. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 
+Module: init.reserved_notation
 Authors: Leonardo de Moura
 
 Basic datatypes

hott/init/tactic.hlean

@@ -2,6 +2,7 @@
 Copyright (c) 2014 Microsoft Corporation. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 
+Module: init.tactic
 Author: Leonardo de Moura
 
 This is just a trick to embed the 'tactic language' as a Lean

hott/init/trunc.hlean

@@ -1,31 +1,38 @@
--- Copyright (c) 2014 Microsoft Corporation. All rights reserved.
+/-
--- Released under Apache 2.0 license as described in the file LICENSE.
+Copyright (c) 2014 Microsoft Corporation. All rights reserved.
--- Authors: Jeremy Avigad, Floris van Doorn
+Released under Apache 2.0 license as described in the file LICENSE.
--- Ported from Coq HoTT
+
+Module: init.trunc
+Authors: Jeremy Avigad, Floris van Doorn
+
+Ported from Coq HoTT.
+-/
+
 prelude
 import .path .logic .datatypes .equiv .types.empty .types.sigma
 open eq nat sigma unit
-set_option pp.universes true
 
--- Truncation levels
+/- Truncation levels -/
--- -----------------
 
--- TODO: make everything universe polymorphic
+-- TODO: can we replace some definitions with a hprop as codomain by theorems?
-
--- TODO: everything definition with a hprop as codomain can be a theorem?
 
 /- truncation indices -/
 
-namespace truncation
+namespace is_trunc
 
   inductive trunc_index : Type₁ :=
   minus_two : trunc_index,
-  trunc_S : trunc_index → trunc_index
+  succ : trunc_index → trunc_index
 
-  postfix `.+1`:(max+1) := trunc_index.trunc_S
+  /-
+     notation for trunc_index is -2, -1, 0, 1, ...
+     from 0 and up this comes from a coercion from num to trunc_index (via nat)
+  -/
+  postfix `.+1`:(max+1) := trunc_index.succ
   postfix `.+2`:(max+1) := λn, (n .+1 .+1)
   notation `-2` := trunc_index.minus_two
-  notation `-1` := (-2.+1)
+  notation `-1` := -2.+1
+  export [coercions] nat -- does this export
 
   namespace trunc_index
   definition add (n m : trunc_index) : trunc_index :=
@@ -35,20 +42,18 @@ namespace truncation
   trunc_index.rec_on n (λm, unit) (λ n p m, trunc_index.rec_on m (λ p, empty) (λ m q p, p m) p) m
   end trunc_index
 
-  -- Coq calls this `-2+`, but `+2+` looks more natural, since trunc_index_add 0 0 = 2
   infix `+2+`:65 := trunc_index.add
 
   notation x <= y := trunc_index.leq x y
   notation x ≤ y := trunc_index.leq x y
 
   namespace trunc_index
-  definition succ_le {n m : trunc_index} (H : n ≤ m) : n.+1 ≤ m.+1 := H
+  definition succ_le_succ {n m : trunc_index} (H : n ≤ m) : n.+1 ≤ m.+1 := H
-  definition succ_le_cancel {n m : trunc_index} (H : n.+1 ≤ m.+1) : n ≤ m := H
+  definition le_of_succ_le_succ {n m : trunc_index} (H : n.+1 ≤ m.+1) : n ≤ m := H
   definition minus_two_le (n : trunc_index) : -2 ≤ n := star
-  definition not_succ_le_minus_two {n : trunc_index} (H : n .+1 ≤ -2) : empty := H
+  definition empty_of_succ_le_minus_two {n : trunc_index} (H : n .+1 ≤ -2) : empty := H
   end trunc_index
-
+  definition trunc_index.of_nat [coercion] (n : nat) : trunc_index :=
-  definition nat_to_trunc_index [coercion] (n : nat) : trunc_index :=
   nat.rec_on n (-1.+1) (λ n k, k.+1)
 
   /- truncated types -/
@@ -62,29 +67,29 @@ namespace truncation
     (center : A) (contr : Π(a : A), center = a)
 
   definition is_trunc_internal (n : trunc_index) : Type → Type :=
-    trunc_index.rec_on n (λA, contr_internal A)
+    trunc_index.rec_on n
+      (λA, contr_internal A)
       (λn trunc_n A, (Π(x y : A), trunc_n (x = y)))
 
-  structure is_trunc [class] (n : trunc_index) (A : Type) :=
+end is_trunc
-    (to_internal : is_trunc_internal n A)
 
-  -- should this be notation or definitions?
+open is_trunc
-  notation `is_contr` := is_trunc -2
+structure is_trunc [class] (n : trunc_index) (A : Type) :=
-  notation `is_hprop` := is_trunc -1
+  (to_internal : is_trunc_internal n A)
-  notation `is_hset`  := is_trunc (nat_to_trunc_index nat.zero)
+open nat num is_trunc.trunc_index
-  -- definition is_contr := is_trunc -2
+namespace is_trunc
-  -- definition is_hprop := is_trunc -1
+
-  -- definition is_hset  := is_trunc 0
+  abbreviation is_contr := is_trunc -2
+  abbreviation is_hprop := is_trunc -1
+  abbreviation is_hset  := is_trunc nat.zero
 
   variables {A B : Type}
 
-  -- TODO: rename to is_trunc_succ
+  definition is_trunc_succ_intro (A : Type) (n : trunc_index) [H : ∀x y : A, is_trunc n (x = y)]
-  definition is_trunc_succ (A : Type) (n : trunc_index) [H : ∀x y : A, is_trunc n (x = y)]
     : is_trunc n.+1 A :=
   is_trunc.mk (λ x y, !is_trunc.to_internal)
 
-  -- TODO: rename to is_trunc_path
+  definition is_trunc_eq (n : trunc_index) [H : is_trunc (n.+1) A] (x y : A) : is_trunc n (x = y) :=
-  definition succ_is_trunc (n : trunc_index) [H : is_trunc (n.+1) A] (x y : A) : is_trunc n (x = y) :=
   is_trunc.mk (!is_trunc.to_internal x y)
 
   /- contractibility -/
@@ -98,157 +103,159 @@ namespace truncation
   definition contr [H : is_contr A] (a : A) : !center = a :=
   @contr_internal.contr A !is_trunc.to_internal a
 
-  definition path_contr [H : is_contr A] (x y : A) : x = y :=
+  definition center_eq [H : is_contr A] (x y : A) : x = y :=
   contr x⁻¹ ⬝ (contr y)
 
-  definition path2_contr {A : Type} [H : is_contr A] {x y : A} (p q : x = y) : p = q :=
+  definition hprop_eq {A : Type} [H : is_contr A] {x y : A} (p q : x = y) : p = q :=
-  have K : ∀ (r : x = y), path_contr x y = r, from (λ r, eq.rec_on r !concat_Vp),
+  have K : ∀ (r : x = y), center_eq x y = r, from (λ r, eq.rec_on r !con.right_inv),
   K p⁻¹ ⬝ K q
 
-  definition contr_paths_contr [instance] {A : Type} [H : is_contr A] (x y : A) : is_contr (x = y) :=
+  definition is_contr_eq [instance] {A : Type} [H : is_contr A] (x y : A) : is_contr (x = y)
-  is_contr.mk !path_contr (λ p, !path2_contr)
+  :=
+  is_contr.mk !center_eq (λ p, !hprop_eq)
 
   /- truncation is upward close -/
 
   -- n-types are also (n+1)-types
-  definition trunc_succ [instance] (A : Type) (n : trunc_index) [H : is_trunc n A] : is_trunc (n.+1) A :=
+  definition is_trunc_succ [instance] (A : Type) (n : trunc_index) [H : is_trunc n A] : is_trunc (n.+1) A :=
   trunc_index.rec_on n
-    (λ A (H : is_contr A), !is_trunc_succ)
+    (λ A (H : is_contr A), !is_trunc_succ_intro)
-    (λ n IH A (H : is_trunc (n.+1) A), @is_trunc_succ _ _ (λ x y, IH _ !succ_is_trunc))
+    (λ n IH A (H : is_trunc (n.+1) A), @is_trunc_succ_intro _ _ (λ x y, IH _ !is_trunc_eq))
     A H
   --in the proof the type of H is given explicitly to make it available for class inference
 
-
+  definition is_trunc_of_leq (A : Type) (n m : trunc_index) (Hnm : n ≤ m)
-  definition trunc_leq (A : Type) (n m : trunc_index) (Hnm : n ≤ m)
     [Hn : is_trunc n A] : is_trunc m A :=
   have base : ∀k A, k ≤ -2 → is_trunc k A → (is_trunc -2 A), from
     λ k A, trunc_index.cases_on k
            (λh1 h2, h2)
-           (λk h1 h2, empty.elim (is_trunc -2 A) (trunc_index.not_succ_le_minus_two h1)),
+           (λk h1 h2, empty.elim (is_trunc -2 A) (trunc_index.empty_of_succ_le_minus_two h1)),
   have step : Π (m : trunc_index)
                 (IHm : Π (n : trunc_index) (A : Type), n ≤ m → is_trunc n A → is_trunc m A)
                 (n : trunc_index) (A : Type)
                 (Hnm : n ≤ m .+1) (Hn : is_trunc n A), is_trunc m .+1 A, from
     λm IHm n, trunc_index.rec_on n
-           (λA Hnm Hn, @trunc_succ A m (IHm -2 A star Hn))
+           (λA Hnm Hn, @is_trunc_succ A m (IHm -2 A star Hn))
            (λn IHn A Hnm (Hn : is_trunc n.+1 A),
-           @is_trunc_succ A m (λx y, IHm n (x = y) (trunc_index.succ_le_cancel Hnm) !succ_is_trunc)),
+           @is_trunc_succ_intro A m (λx y, IHm n (x = y) (trunc_index.le_of_succ_le_succ Hnm) !is_trunc_eq)),
   trunc_index.rec_on m base step n A Hnm Hn
 
-  -- the following cannot be instances in their current form, because it is looping
+  -- the following cannot be instances in their current form, because they are looping
-  definition trunc_contr (A : Type) (n : trunc_index) [H : is_contr A] : is_trunc n A :=
+  definition is_trunc_of_is_contr (A : Type) (n : trunc_index) [H : is_contr A] : is_trunc n A :=
   trunc_index.rec_on n H _
 
-  definition trunc_hprop (A : Type) (n : trunc_index) [H : is_hprop A]
+  definition is_trunc_succ_of_is_hprop (A : Type) (n : trunc_index) [H : is_hprop A]
       : is_trunc (n.+1) A :=
-  trunc_leq A -1 (n.+1) star
+  is_trunc_of_leq A -1 (n.+1) star
 
-  definition trunc_hset (A : Type) (n : trunc_index) [H : is_hset A]
+  definition is_trunc_succ_succ_of_is_hset (A : Type) (n : trunc_index) [H : is_hset A]
       : is_trunc (n.+2) A :=
-  trunc_leq A nat.zero (n.+2) star
+  is_trunc_of_leq A nat.zero (n.+2) star
 
   /- hprops -/
 
   definition is_hprop.elim [H : is_hprop A] (x y : A) : x = y :=
-  @center _ !succ_is_trunc
+  @center _ !is_trunc_eq
 
-  definition contr_inhabited_hprop {A : Type} [H : is_hprop A] (x : A) : is_contr A :=
+  definition is_contr_of_inhabited_hprop {A : Type} [H : is_hprop A] (x : A) : is_contr A :=
   is_contr.mk x (λy, !is_hprop.elim)
 
   --Coq has the following as instance, but doesn't look too useful
-  definition hprop_inhabited_contr {A : Type} (H : A → is_contr A) : is_hprop A :=
+  definition is_hprop_of_imp_is_contr {A : Type} (H : A → is_contr A) : is_hprop A :=
-  @is_trunc_succ A -2
+  @is_trunc_succ_intro A -2
     (λx y,
       have H2 [visible] : is_contr A, from H x,
-      !contr_paths_contr)
+      !is_contr_eq)
 
   definition is_hprop.mk {A : Type} (H : ∀x y : A, x = y) : is_hprop A :=
-  hprop_inhabited_contr (λ x, is_contr.mk x (H x))
+  is_hprop_of_imp_is_contr (λ x, is_contr.mk x (H x))
 
   /- hsets -/
 
   definition is_hset.mk (A : Type) (H : ∀(x y : A) (p q : x = y), p = q) : is_hset A :=
-  @is_trunc_succ _ _ (λ x y, is_hprop.mk (H x y))
+  @is_trunc_succ_intro _ _ (λ x y, is_hprop.mk (H x y))
 
   definition is_hset.elim [H : is_hset A] ⦃x y : A⦄ (p q : x = y) : p = q :=
-  @is_hprop.elim _ !succ_is_trunc p q
+  @is_hprop.elim _ !is_trunc_eq p q
 
   /- instances -/
 
-  definition contr_basedpaths [instance] {A : Type} (a : A) : is_contr (Σ(x : A), a = x) :=
+  definition is_contr_sigma_eq [instance] {A : Type} (a : A) : is_contr (Σ(x : A), a = x) :=
   is_contr.mk (sigma.mk a idp) (λp, sigma.rec_on p (λ b q, eq.rec_on q idp))
 
-  definition unit_contr [instance] : is_contr unit :=
+  definition is_contr_unit [instance] : is_contr unit :=
   is_contr.mk star (λp, unit.rec_on p idp)
 
-  definition empty_hprop [instance] : is_hprop empty :=
+  definition is_hprop_empty [instance] : is_hprop empty :=
   is_hprop.mk (λx, !empty.elim x)
 
   /- truncated universe -/
 
   structure trunctype (n : trunc_index) :=
   (trunctype_type : Type) (is_trunc_trunctype_type : is_trunc n trunctype_type)
-  local attribute trunctype.trunctype_type [coercion]
+  attribute trunctype.trunctype_type [coercion]
+  attribute trunctype.is_trunc_trunctype_type [instance]
 
   notation n `-Type` := trunctype n
-  notation `hprop` := -1-Type
+  abbreviation hprop := -1-Type
-  notation `hset` := 0-Type
+  abbreviation hset := (-1.+1)-Type
 
-  definition hprop.mk := @trunctype.mk -1
+  protected definition hprop.mk := @trunctype.mk -1
-  definition hset.mk := @trunctype.mk nat.zero
+  protected definition hset.mk := @trunctype.mk (-1.+1)
-
-  --what does the following line in Coq do?
-  --Canonical Structure default_TruncType := fun n T P => (@BuildTruncType n T P).
 
   /- interaction with equivalences -/
 
   section
   open is_equiv equiv
 
-  --should we remove the following two theorems as they are special cases of "trunc_equiv"
+  --should we remove the following two theorems as they are special cases of
-  definition equiv_preserves_contr (f : A → B) [Hf : is_equiv f] [HA: is_contr A] : (is_contr B) :=
+  --"is_trunc_is_equiv_closed"
-    is_contr.mk (f (center A)) (λp, moveR_M f !contr)
+  definition is_contr_is_equiv_closed (f : A → B) [Hf : is_equiv f] [HA: is_contr A] : (is_contr B) :=
+    is_contr.mk (f (center A)) (λp, eq_of_eq_inv f !contr)
 
-  theorem contr_equiv (H : A ≃ B) [HA: is_contr A] : is_contr B :=
+  theorem is_contr_equiv_closed (H : A ≃ B) [HA: is_contr A] : is_contr B :=
-    @equiv_preserves_contr _ _ (to_fun H) (to_is_equiv H) _
+    @is_contr_is_equiv_closed _ _ (to_fun H) (to_is_equiv H) _
 
-  definition contr_equiv_contr [HA : is_contr A] [HB : is_contr B] : A ≃ B :=
+  definition equiv_of_is_contr_of_is_contr [HA : is_contr A] [HB : is_contr B] : A ≃ B :=
   equiv.mk
     (λa, center B)
     (is_equiv.adjointify (λa, center B) (λb, center A) contr contr)
 
-  definition trunc_equiv (n : trunc_index) (f : A → B) [H : is_equiv f] [HA : is_trunc n A]
+  definition is_trunc_is_equiv_closed (n : trunc_index) (f : A → B) [H : is_equiv f]
-      : is_trunc n B :=
+    [HA : is_trunc n A] : is_trunc n B :=
   trunc_index.rec_on n
-    (λA (HA : is_contr A) B f (H : is_equiv f), !equiv_preserves_contr)
+    (λA (HA : is_contr A) B f (H : is_equiv f), !is_contr_is_equiv_closed)
-    (λn IH A (HA : is_trunc n.+1 A) B f (H : is_equiv f), @is_trunc_succ _ _ (λ x y : B,
+    (λn IH A (HA : is_trunc n.+1 A) B f (H : is_equiv f), @is_trunc_succ_intro _ _ (λ x y : B,
-      IH (f⁻¹ x = f⁻¹ y) !succ_is_trunc (x = y) ((ap (f⁻¹))⁻¹) !inv_closed))
+      IH (f⁻¹ x = f⁻¹ y) !is_trunc_eq (x = y) ((ap (f⁻¹))⁻¹) !is_equiv_inv))
     A HA B f H
 
-  definition trunc_equiv' (n : trunc_index) (f : A ≃ B) [HA : is_trunc n A] : is_trunc n B :=
+  definition is_trunc_equiv_closed (n : trunc_index) (f : A ≃ B) [HA : is_trunc n A]
-  trunc_equiv n (to_fun f)
+    : is_trunc n B :=
+  is_trunc_is_equiv_closed n (to_fun f)
 
-  definition isequiv_iff_hprop [HA : is_hprop A] [HB : is_hprop B] (f : A → B) (g : B → A)
+  definition is_equiv_of_is_hprop [HA : is_hprop A] [HB : is_hprop B] (f : A → B) (g : B → A)
-      : is_equiv f :=
+    : is_equiv f :=
-  is_equiv.adjointify f g (λb, !is_hprop.elim) (λa, !is_hprop.elim)
+  is_equiv.mk g (λb, !is_hprop.elim) (λa, !is_hprop.elim) (λa, !is_hset.elim)
 
-  -- definition equiv_iff_hprop_uncurried [HA : is_hprop A] [HB : is_hprop B] : (A ↔ B) → (A ≃ B)  := sorry
+  definition equiv_of_is_hprop [HA : is_hprop A] [HB : is_hprop B] (f : A → B) (g : B → A)
+    : A ≃ B :=
+  equiv.mk f (is_equiv_of_is_hprop f g)
 
-  definition equiv_iff_hprop [HA : is_hprop A] [HB : is_hprop B] (f : A → B) (g : B → A) : A ≃ B :=
+  definition equiv_of_iff_of_is_hprop [HA : is_hprop A] [HB : is_hprop B] (H : A ↔ B) : A ≃ B :=
-  equiv.mk f (isequiv_iff_hprop f g)
+  equiv_of_is_hprop (iff.elim_left H) (iff.elim_right H)
 
   end
 
   /- interaction with the Unit type -/
 
   -- A contractible type is equivalent to [Unit]. *)
-  definition equiv_contr_unit [H : is_contr A] : A ≃ unit :=
+  definition equiv_unit_of_is_contr [H : is_contr A] : A ≃ unit :=
     equiv.mk (λ (x : A), ⋆)
       (is_equiv.mk (λ (u : unit), center A)
         (λ (u : unit), unit.rec_on u idp)
         (λ (x : A), contr x)
-        (λ (x : A), (!ap_const)⁻¹))
+        (λ (x : A), (!ap_constant)⁻¹))
 
   -- TODO: port "Truncated morphisms"
 
-end truncation
+end is_trunc

hott/init/types/empty.hlean

@@ -1,6 +1,10 @@
--- Copyright (c) 2014 Microsoft Corporation. All rights reserved.
+/-
--- Released under Apache 2.0 license as described in the file LICENSE.
+Copyright (c) 2014 Microsoft Corporation. All rights reserved.
--- Author: Jeremy Avigad, Floris van Doorn, Jakob von Raumer
+Released under Apache 2.0 license as described in the file LICENSE.
+
+Module: init.types.empty
+Author: Jeremy Avigad, Floris van Doorn, Jakob von Raumer
+-/
 
 prelude
 import ..datatypes ..logic

hott/init/types/prod.hlean

@@ -2,10 +2,11 @@
 Copyright (c) 2014 Microsoft Corporation. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 
+Module: init.types.prod
 Author: Leonardo de Moura, Jeremy Avigad
 -/
 prelude
-import ..wf
+import ..wf ..num
 
 definition pair := @prod.mk
 
@@ -14,6 +15,13 @@ namespace prod
   notation A * B := prod A B
   notation A × B := prod A B
 
+  namespace ops
+  postfix `.1`:(max+1) := pr1
+  postfix `.2`:(max+1) := pr2
+  abbreviation pr₁ := @pr1
+  abbreviation pr₂ := @pr2
+  end ops
+
   namespace low_precedence_times
 
     reserve infixr `*`:30  -- conflicts with notation for multiplication
@@ -21,7 +29,7 @@ namespace prod
 
   end low_precedence_times
 
-  -- TODO: add lemmas about flip to /hott/types/prod.hlean
+  -- TODO: add lemmas about flip to hott/types/prod.hlean
   definition flip {A B : Type} (a : A × B) : B × A := pair (pr2 a) (pr1 a)
 
   notation `pr₁` := pr1

hott/init/types/sigma.hlean

@@ -1,6 +1,8 @@
 /-
 Copyright (c) 2014 Microsoft Corporation. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
+
+Module: init.types.sigma
 Authors: Leonardo de Moura, Jeremy Avigad, Floris van Doorn
 -/
 prelude
@@ -12,12 +14,12 @@ mk :: (pr1 : A) (pr2 : B pr1)
 notation `Σ` binders `,` r:(scoped P, sigma P) := r
 
 namespace sigma
-  notation `pr₁` := pr1
-  notation `pr₂` := pr2
   notation `⟨`:max t:(foldr `,` (e r, mk e r)) `⟩`:0 := t --input ⟨ ⟩ as \< \>
 
   namespace ops
   postfix `.1`:(max+1) := pr1
   postfix `.2`:(max+1) := pr2
+  abbreviation pr₁ := @pr1
+  abbreviation pr₂ := @pr2
   end ops
 end sigma

hott/init/types/sum.hlean

@@ -2,6 +2,7 @@
 Copyright (c) 2014 Microsoft Corporation. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 
+Module: init.types.sum
 Author: Leonardo de Moura, Jeremy Avigad
 -/
 prelude

hott/init/util.hlean

@@ -2,6 +2,7 @@
 Copyright (c) 2014 Microsoft Corporation. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
 
+Module: init.util
 Author: Leonardo de Moura
 
 Auxiliary definitions used by automation
@@ -9,7 +10,7 @@ Auxiliary definitions used by automation
 prelude
 import init.trunc
 
-open truncation
+open is_trunc
 
 definition eq_rec_eq.{l₁ l₂} {A : Type.{l₁}} {B : A → Type.{l₂}} [h : is_hset A] {a : A} (b : B a) (p : a = a) :
    b = @eq.rec.{l₂ l₁} A a (λ (a' : A) (h : a = a'), B a') b a p :=

hott/init/wf.hlean

@@ -1,6 +1,8 @@
 /-
 Copyright (c) 2014 Microsoft Corporation. All rights reserved.
 Released under Apache 2.0 license as described in the file LICENSE.
+
+Module: init.wf
 Author: Leonardo de Moura
 -/
 prelude

hott/logic.hlean

@@ -1,3 +1,4 @@
+exit
 --javra:        Maybe this should go somewhere else
 
 open eq

hott/trunc.hlean

@@ -1,61 +0,0 @@
--- Copyright (c) 2015 Jakob von Raumer. All rights reserved.
--- Released under Apache 2.0 license as described in the file LICENSE.
--- Authors: Jakob von Raumer
--- Truncation properties of truncatedness
-
-import types.pi
-
-open truncation sigma sigma.ops pi function eq equiv
-
-namespace truncation
-
-  definition is_contr.sigma_char (A : Type) :
-    (Σ (center : A), Π (a : A), center = a) ≃ (is_contr A) :=
-  begin
-    fapply equiv.mk,
-      intro S, apply is_contr.mk, exact S.2,
-    fapply is_equiv.adjointify,
-        intro H, apply sigma.mk, exact (@contr A H),
-      intro H, apply (is_trunc.rec_on H), intro Hint,
-      apply (contr_internal.rec_on Hint), intros (H1, H2),
-      apply idp,
-    intro S, apply (sigma.rec_on S), intros (H1, H2),
-    apply idp,
-  end
-
-  set_option pp.implicit true
-  definition is_trunc.pi_char (n : trunc_index) (A : Type) :
-    (Π (x y : A), is_trunc n (x = y)) ≃ (is_trunc (n .+1) A) :=
-  begin
-    fapply equiv.mk,
-      intro H, apply is_trunc_succ,
-    fapply is_equiv.adjointify,
-        intros (H, x, y), apply succ_is_trunc,
-      intro H, apply (is_trunc.rec_on H), intro Hint, apply idp,
-    intro P,
-   exact sorry,
-  end
-
-  definition is_trunc_is_hprop {n : trunc_index} :
-    Π (A : Type), is_hprop (is_trunc n A) :=
-  begin
-    apply (trunc_index.rec_on n),
-      intro A,
-      apply trunc_equiv, apply equiv.to_is_equiv,
-      apply is_contr.sigma_char,
-      apply (@is_hprop.mk), intros,
-      fapply sigma.path, apply x.2,
-      apply (@is_hprop.elim),
-      apply trunc_pi, intro a,
-      apply is_hprop.mk, intros (w, z),
-      assert (H : is_hset A),
-        apply trunc_succ, apply trunc_succ,
-        apply is_contr.mk, exact y.2,
-      fapply (@is_hset.elim A _ _ _ w z),
-    intros (n', IH, A),
-    apply trunc_equiv,
-      apply equiv.to_is_equiv,
-      apply is_trunc.pi_char,
-  end
-
-end truncation

hott/truncation.hlean

@@ -2,7 +2,7 @@
 -- Released under Apache 2.0 license as described in the file LICENSE.
 -- Authors: Jakob von Raumer
 
-open truncation
+open is_trunc
 
 -- Axiomatize the truncation operator as long as we do not have
 -- Higher inductive types

hott/types/W.hlean

@@ -22,10 +22,10 @@ namespace Wtype
   variables {A A' : Type.{u}} {B B' : A → Type.{v}} {C : Π(a : A), B a → Type}
             {a a' : A} {f : B a → W a, B a} {f' : B a' → W a, B a} {w w' : W(a : A), B a}
 
-  definition pr1 (w : W(a : A), B a) : A :=
+  protected definition pr1 (w : W(a : A), B a) : A :=
   Wtype.rec_on w (λa f IH, a)
 
-  definition pr2 (w : W(a : A), B a) : B (pr1 w) → W(a : A), B a :=
+  protected definition pr2 (w : W(a : A), B a) : B (pr1 w) → W(a : A), B a :=
   Wtype.rec_on w (λa f IH, f)
 
   namespace ops
@@ -38,28 +38,28 @@ namespace Wtype
   protected definition eta (w : W a, B a) : ⟨w.1 , w.2⟩ = w :=
   cases_on w (λa f, idp)
 
-  definition path_W_sup (p : a = a') (q : p ▹ f = f') : ⟨a, f⟩ = ⟨a', f'⟩ :=
+  definition sup_eq_sup (p : a = a') (q : p ▹ f = f') : ⟨a, f⟩ = ⟨a', f'⟩ :=
   path.rec_on p (λf' q, path.rec_on q idp) f' q
 
-  definition path_W (p : w.1 = w'.1) (q : p ▹ w.2 = w'.2) : w = w' :=
+  protected definition Wtype_eq (p : w.1 = w'.1) (q : p ▹ w.2 = w'.2) : w = w' :=
   cases_on w
-           (λw1 w2, cases_on w' (λ w1' w2', path_W_sup))
+           (λw1 w2, cases_on w' (λ w1' w2', sup_eq_sup))
            p q
 
-  definition pr1_path (p : w = w') : w.1 = w'.1 :=
+  protected definition Wtype_eq_pr1 (p : w = w') : w.1 = w'.1 :=
   path.rec_on p idp
 
-  definition pr2_path (p : w = w') : pr1_path p ▹ w.2 = w'.2 :=
+  protected definition Wtype_eq_pr2 (p : w = w') : Wtype_eq_pr1 p ▹ w.2 = w'.2 :=
   path.rec_on p idp
 
   namespace ops
-  postfix `..1`:(max+1) := pr1_path
+  postfix `..1`:(max+1) := Wtype_eq_pr1
-  postfix `..2`:(max+1) := pr2_path
+  postfix `..2`:(max+1) := Wtype_eq_pr2
   end ops
   open ops
 
   definition sup_path_W (p : w.1 = w'.1) (q : p ▹ w.2 = w'.2)
-      :  dpair (path_W p q)..1 (path_W p q)..2 = dpair p q :=
+      :  dpair (Wtype_eq p q)..1 (Wtype_eq p q)..2 = dpair p q :=
   begin
     reverts (p, q),
     apply (cases_on w), intros (w1, w2),
@@ -68,14 +68,14 @@ namespace Wtype
     apply (path.rec_on q), apply idp
   end
 
-  definition pr1_path_W (p : w.1 = w'.1) (q : p ▹ w.2 = w'.2) : (path_W p q)..1 = p :=
+  definition pr1_path_W (p : w.1 = w'.1) (q : p ▹ w.2 = w'.2) : (Wtype_eq p q)..1 = p :=
   (!sup_path_W)..1
 
   definition pr2_path_W (p : w.1 = w'.1) (q : p ▹ w.2 = w'.2)
-      : pr1_path_W p q ▹ (path_W p q)..2 = q :=
+      : pr1_path_W p q ▹ (Wtype_eq p q)..2 = q :=
   (!sup_path_W)..2
 
-  definition eta_path_W (p : w = w') : path_W (p..1) (p..2) = p :=
+  definition eta_path_W (p : w = w') : Wtype_eq (p..1) (p..2) = p :=
   begin
     apply (path.rec_on p),
     apply (cases_on w), intros (w1, w2),
@@ -83,7 +83,7 @@ namespace Wtype
   end
 
   definition transport_pr1_path_W {B' : A → Type} (p : w.1 = w'.1) (q : p ▹ w.2 = w'.2)
-      : transport (λx, B' x.1) (path_W p q) = transport B' p :=
+      : transport (λx, B' x.1) (Wtype_eq p q) = transport B' p :=
   begin
     reverts (p, q),
     apply (cases_on w), intros (w1, w2),
@@ -93,7 +93,7 @@ namespace Wtype
   end
 
   definition path_W_uncurried (pq : Σ(p : w.1 = w'.1), p ▹ w.2 = w'.2) : w = w' :=
-  destruct pq path_W
+  destruct pq Wtype_eq
 
   definition sup_path_W_uncurried (pq : Σ(p : w.1 = w'.1), p ▹ w.2 = w'.2)
       :  dpair (path_W_uncurried pq)..1 (path_W_uncurried pq)..2 = pq :=
@@ -137,18 +137,18 @@ namespace Wtype
 
   /- truncatedness -/
   open truncation
-  definition trunc_W [FUN : funext.{v (max 1 u v)}] (n : trunc_index) [HA : is_trunc (n.+1) A]
+  definition trunc_W [instance] [FUN : funext.{v (max 1 u v)}] (n : trunc_index)
-    : is_trunc (n.+1) (W a, B a) :=
+    [HA : is_trunc (n.+1) A] : is_trunc (n.+1) (W a, B a) :=
   begin
   fapply is_trunc_succ, intros (w, w'),
   apply (double_induction_on w w'), intros (a, a', f, f', IH),
-  fapply trunc_equiv',
+  fapply is_trunc_equiv_closed,
     apply equiv_path_W,
-    apply trunc_sigma,
+    apply is_trunc_sigma,
-      fapply (succ_is_trunc n),
+      fapply (is_trunc_eq n),
       intro p, revert IH, generalize f', --change to revert after simpl
       apply (path.rec_on p), intros (f', IH),
-      apply pi.trunc_path_pi, intro b,
+      apply pi.is_trunc_eq_pi, intro b,
       apply IH
   end
 

hott/types/path.hlean

@@ -0,0 +1,572 @@
+/-
+Copyright (c) 2014 Floris van Doorn. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+Author: Floris van Doorn
+Ported from Coq HoTT
+
+Theorems about path types (identity types)
+-/
+
+open eq sigma sigma.ops equiv is_equiv
+
+namespace path
+  /- Path spaces -/
+
+  /- The path spaces of a path space are not, of course, determined; they are just the
+      higher-dimensional structure of the original space. -/
+
+  /- Transporting in path spaces.
+
+     There are potentially a lot of these lemmas, so we adopt a uniform naming scheme:
+
+     - `l` means the left endpoint varies
+     - `r` means the right endpoint varies
+     - `F` means application of a function to that (varying) endpoint.
+  -/
+
+  variables {A B : Type} {a a1 a2 a3 a4 : A} {b b1 b2 : B} {f g : A → B} {h : B → A}
+
+  definition transport_paths_l (p : a1 = a2) (q : a1 = a3)
+    : transport (λx, x = a3) p q = p⁻¹ ⬝ q :=
+  begin
+  apply (eq.rec_on p), apply (eq.rec_on q), apply idp
+  end
+
+  definition transport_paths_r (p : a2 = a3) (q : a1 = a2)
+    : transport (λx, a1 = x) p q = q ⬝ p :=
+  begin
+  apply (eq.rec_on p), apply (eq.rec_on q), apply idp
+  end
+
+  definition transport_paths_lr (p : a1 = a2) (q : a1 = a1)
+    : transport (λx, x = x) p q = p⁻¹ ⬝ q ⬝ p :=
+  begin
+  apply (eq.rec_on p),
+  apply inverse, apply concat,
+    apply con_idp,
+  apply idp_con
+  end
+
+  definition transport_paths_Fl (p : a1 = a2) (q : f a1 = b)
+    : transport (λx, f x = b) p q = (ap f p)⁻¹ ⬝ q :=
+  begin
+  apply (eq.rec_on p), apply (eq.rec_on q), apply idp
+  end
+
+  definition transport_paths_Fr (p : a1 = a2) (q : b = f a1)
+    : transport (λx, b = f x) p q = q ⬝ (ap f p) :=
+  begin
+  apply (eq.rec_on p), apply idp
+  end
+
+  definition transport_paths_FlFr (p : a1 = a2) (q : f a1 = g a1)
+    : transport (λx, f x = g x) p q = (ap f p)⁻¹ ⬝ q ⬝ (ap g p) :=
+  begin
+  apply (eq.rec_on p),
+  apply inverse, apply concat,
+    apply con_idp,
+  apply idp_con
+  end
+
+  definition transport_paths_FlFr_D {B : A → Type} {f g : Πa, B a}
+    (p : a1 = a2) (q : f a1 = g a1)
+      : transport (λx, f x = g x) p q = (apD f p)⁻¹ ⬝ ap (transport B p) q ⬝ (apD g p) :=
+  begin
+  apply (eq.rec_on p),
+  apply inverse,
+  apply concat, apply con_idp,
+  apply concat, apply idp_con,
+  apply ap_id
+  end
+
+  definition transport_paths_FFlr (p : a1 = a2) (q : h (f a1) = a1)
+    : transport (λx, h (f x) = x) p q = (ap h (ap f p))⁻¹ ⬝ q ⬝ p :=
+  begin
+  apply (eq.rec_on p),
+  apply inverse,
+  apply concat, apply con_idp,
+  apply idp_con,
+  end
+
+  definition transport_paths_lFFr (p : a1 = a2) (q : a1 = h (f a1))
+    : transport (λx, x = h (f x)) p q = p⁻¹ ⬝ q ⬝ (ap h (ap f p)) :=
+  begin
+  apply (eq.rec_on p),
+  apply inverse,
+  apply concat, apply con_idp,
+  apply idp_con,
+  end
+
+
+  /- The Functorial action of paths is [ap]. -/
+
+  /- Equivalences between path spaces -/
+
+  /- [ap_closed] is in init.equiv  -/
+
+  definition equiv_ap (f : A → B) [H : is_equiv f] (a1 a2 : A)
+    : (a1 = a2) ≃ (f a1 = f a2) :=
+  equiv.mk _ _
+
+  /- Path operations are equivalences -/
+
+  definition isequiv_path_inverse [instance] (a1 a2 : A) : is_equiv (@inverse A a1 a2) :=
+  is_equiv.mk inverse inv_inv inv_inv (λp, eq.rec_on p idp)
+
+  definition equiv_path_inverse (a1 a2 : A) : (a1 = a2) ≃ (a2 = a1) :=
+  equiv.mk inverse _
+
+  definition isequiv_concat_l [instance] (p : a1 = a2) (a3 : A)
+    : is_equiv (@concat _ a1 a2 a3 p) :=
+  is_equiv.mk (concat (p⁻¹))
+              (con_inv_cancel_left p)
+              (inv_con_cancel_left p)
+              (eq.rec_on p (λq, eq.rec_on q idp))
+
+  definition equiv_concat_l (p : a1 = a2) (a3 : A) : (a1 = a3) ≃ (a2 = a3) :=
+  equiv.mk (concat (p⁻¹)) _
+
+  definition isequiv_concat_r [instance] (p : a2 = a3) (a1 : A)
+    : is_equiv (λq : a1 = a2, q ⬝ p) :=
+  is_equiv.mk (λq, q ⬝ p⁻¹)
+              (λq, inv_con_cancel_right q p)
+              (λq, con_inv_cancel_right q p)
+              (eq.rec_on p (λq, eq.rec_on q idp))
+
+  definition equiv_concat_r (p : a2 = a3) (a1 : A) : (a1 = a2) ≃ (a1 = a3) :=
+  equiv.mk (λq, q ⬝ p) _
+
+  definition equiv_concat_lr {a1 a2 a3 a4 : A} (p : a1 = a2) (q : a3 = a4)
+    : (a1 = a3) ≃ (a2 = a4) :=
+  equiv.trans (equiv_concat_l p a3) (equiv_concat_r q a2)
+
+/- BELOW STILL NEEDS TO BE PORTED FROM COQ HOTT -/
+
+  -- definition isequiv_whiskerL [instance] (p : a1 = a2) (q r : a2 = a3)
+  -- : is_equiv (@whisker_left A a1 a2 a3 p q r) :=
+  -- begin
+
+  -- end
+  -- /-begin
+  --   refine (isequiv_adjointify _ _ _ _).
+  --   - apply cancelL.
+  --   - intros k. unfold cancelL.
+  --     rewrite !whiskerL_pp.
+  --     refine ((_ @@ 1 @@ _) ⬝ whiskerL_pVL p k).
+  --     + destruct p, q; reflexivity.
+  --     + destruct p, r; reflexivity.
+  --   - intros k. unfold cancelL.
+  --     refine ((_ @@ 1 @@ _) ⬝ whiskerL_VpL p k).
+  --     + destruct p, q; reflexivity.
+  --     + destruct p, r; reflexivity.
+  -- end-/
+
+  -- definition equiv_whiskerL {A} {x y z : A} (p : x = y) (q r : y = z)
+  -- : (q = r) ≃ (p ⬝ q = p ⬝ r) :=
+  --      equiv.mk _ _ (whisker_left p) _.
+
+  -- definition equiv_cancelL {A} {x y z : A} (p : x = y) (q r : y = z)
+  -- : (p ⬝ q = p ⬝ r) ≃ (q = r) :=
+  --      equiv_inverse (equiv_whiskerL p q r).
+
+  -- definition isequiv_cancelL {A} {x y z : A} (p : x = y) (q r : y = z)
+  --   : is_equiv (cancel_left p q r).
+  -- /-begin
+  --   change (is_equiv (equiv_cancelL p q r)); exact _.
+  -- end-/
+
+  -- definition isequiv_whiskerR [instance] {A} {x y z : A} {p q : x = y} (r : y = z)
+  -- : is_equiv (λh, @whisker_right A x y z p q h r).
+  -- /-begin
+  --   refine (isequiv_adjointify _ _ _ _).
+  --   - apply cancelR.
+  --   - intros k. unfold cancelR.
+  --     rewrite !whiskerR_pp.
+  --     refine ((_ @@ 1 @@ _) ⬝ whiskerR_VpR k r).
+  --     + destruct p, r; reflexivity.
+  --     + destruct q, r; reflexivity.
+  --   - intros k. unfold cancelR.
+  --     refine ((_ @@ 1 @@ _) ⬝ whiskerR_pVR k r).
+  --     + destruct p, r; reflexivity.
+  --     + destruct q, r; reflexivity.
+  -- end-/
+
+  -- definition equiv_whiskerR {A} {x y z : A} (p q : x = y) (r : y = z)
+  -- : (p = q) ≃ (p ⬝ r = q ⬝ r) :=
+  --      equiv.mk _ _ (λh, whisker_right h r) _.
+
+  -- definition equiv_cancelR {A} {x y z : A} (p q : x = y) (r : y = z)
+  -- : (p ⬝ r = q ⬝ r) ≃ (p = q) :=
+  --      equiv_inverse (equiv_whiskerR p q r).
+
+  -- definition isequiv_cancelR {A} {x y z : A} (p q : x = y) (r : y = z)
+  --   : is_equiv (cancel_right p q r).
+  -- /-begin
+  --   change (is_equiv (equiv_cancelR p q r)); exact _.
+  -- end-/
+
+  -- /- We can use these to build up more complicated equivalences.
+
+  -- In particular, all of the [move] family are equivalences.
+
+  -- (Note: currently, some but not all of these [isequiv_] lemmas have corresponding [equiv_] lemmas.  Also, they do *not* currently contain the computational content that e.g. the inverse of [moveR_Mp] is [moveL_Vp]; perhaps it would be useful if they did? -/
+
+  -- Global Instance isequiv_moveR_Mp
+  --  {A : Type} {x y z : A} (p : x = z) (q : y = z) (r : y = x)
+  -- : is_equiv (con_eq_of_eq_inv_con p q r).
+  -- /-begin
+  --   destruct r.
+  --   apply (isequiv_compose' _ (isequiv_concat_l _ _) _ (isequiv_concat_r _ _)).
+  -- end-/
+
+  -- definition equiv_moveR_Mp
+  --   {A : Type} {x y z : A} (p : x = z) (q : y = z) (r : y = x)
+  -- : (p = r⁻¹ ⬝ q) ≃ (r ⬝ p = q) :=
+  --    equiv.mk _ _ (con_eq_of_eq_inv_con p q r) _.
+
+  -- Global Instance isequiv_moveR_pM
+  --   {A : Type} {x y z : A} (p : x = z) (q : y = z) (r : y = x)
+  -- : is_equiv (con_eq_of_eq_con_inv p q r).
+  -- /-begin
+  --   destruct p.
+  --   apply (isequiv_compose' _ (isequiv_concat_l _ _) _ (isequiv_concat_r _ _)).
+  -- end-/
+
+  -- definition equiv_moveR_pM
+  --   {A : Type} {x y z : A} (p : x = z) (q : y = z) (r : y = x)
+  -- : (r = q ⬝ p⁻¹) ≃ (r ⬝ p = q) :=
+  --    equiv.mk _ _ (con_eq_of_eq_con_inv p q r) _.
+
+  -- Global Instance isequiv_moveR_Vp
+  --   {A : Type} {x y z : A} (p : x = z) (q : y = z) (r : x = y)
+  -- : is_equiv (inv_con_eq_of_eq_con p q r).
+  -- /-begin
+  --   destruct r.
+  --   apply (isequiv_compose' _ (isequiv_concat_l _ _) _ (isequiv_concat_r _ _)).
+  -- end-/
+
+  -- definition equiv_moveR_Vp
+  --   {A : Type} {x y z : A} (p : x = z) (q : y = z) (r : x = y)
+  -- : (p = r ⬝ q) ≃ (r⁻¹ ⬝ p = q) :=
+  --    equiv.mk _ _ (inv_con_eq_of_eq_con p q r) _.
+
+  -- Global Instance isequiv_moveR_pV
+  --   {A : Type} {x y z : A} (p : z = x) (q : y = z) (r : y = x)
+  -- : is_equiv (con_inv_eq_of_eq_con p q r).
+  -- /-begin
+  --   destruct p.
+  --   apply (isequiv_compose' _ (isequiv_concat_l _ _) _ (isequiv_concat_r _ _)).
+  -- end-/
+
+  -- definition equiv_moveR_pV
+  --   {A : Type} {x y z : A} (p : z = x) (q : y = z) (r : y = x)
+  -- : (r = q ⬝ p) ≃ (r ⬝ p⁻¹ = q) :=
+  --    equiv.mk _ _ (con_inv_eq_of_eq_con p q r) _.
+
+  -- Global Instance isequiv_moveL_Mp
+  --   {A : Type} {x y z : A} (p : x = z) (q : y = z) (r : y = x)
+  -- : is_equiv (eq_con_of_inv_con_eq p q r).
+  -- /-begin
+  --   destruct r.
+  --   apply (isequiv_compose' _ (isequiv_concat_l _ _) _ (isequiv_concat_r _ _)).
+  -- end-/
+
+  -- definition equiv_moveL_Mp
+  --   {A : Type} {x y z : A} (p : x = z) (q : y = z) (r : y = x)
+  -- : (r⁻¹ ⬝ q = p) ≃ (q = r ⬝ p) :=
+  --    equiv.mk _ _ (eq_con_of_inv_con_eq p q r) _.
+
+  -- definition isequiv_moveL_pM
+  --   {A : Type} {x y z : A} (p : x = z) (q : y = z) (r : y = x)
+  -- : is_equiv (eq_con_of_con_inv_eq p q r).
+  -- /-begin
+  --   destruct p.
+  --   apply (isequiv_compose' _ (isequiv_concat_l _ _) _ (isequiv_concat_r _ _)).
+  -- end-/
+
+  -- definition equiv_moveL_pM
+  --   {A : Type} {x y z : A} (p : x = z) (q : y = z) (r : y = x) :
+  --   q ⬝ p⁻¹ = r ≃ q = r ⬝ p :=
+  --      equiv.mk _ _ _ (isequiv_moveL_pM p q r).
+
+  -- Global Instance isequiv_moveL_Vp
+  --   {A : Type} {x y z : A} (p : x = z) (q : y = z) (r : x = y)
+  -- : is_equiv (eq_inv_con_of_con_eq p q r).
+  -- /-begin
+  --   destruct r.
+  --   apply (isequiv_compose' _ (isequiv_concat_l _ _) _ (isequiv_concat_r _ _)).
+  -- end-/
+
+  -- definition equiv_moveL_Vp
+  --   {A : Type} {x y z : A} (p : x = z) (q : y = z) (r : x = y)
+  -- : r ⬝ q = p ≃ q = r⁻¹ ⬝ p :=
+  --    equiv.mk _ _ (eq_inv_con_of_con_eq p q r) _.
+
+  -- Global Instance isequiv_moveL_pV
+  --   {A : Type} {x y z : A} (p : z = x) (q : y = z) (r : y = x)
+  -- : is_equiv (eq_con_inv_of_con_eq p q r).
+  -- /-begin
+  --   destruct p.
+  --   apply (isequiv_compose' _ (isequiv_concat_l _ _) _ (isequiv_concat_r _ _)).
+  -- end-/
+
+  -- definition equiv_moveL_pV
+  --   {A : Type} {x y z : A} (p : z = x) (q : y = z) (r : y = x)
+  -- : q ⬝ p = r ≃ q = r ⬝ p⁻¹ :=
+  --    equiv.mk _ _ (eq_con_inv_of_con_eq p q r) _.
+
+  -- definition isequiv_moveL_1M {A : Type} {x y : A} (p q : x = y)
+  -- : is_equiv (eq_of_con_inv_eq_idp p q).
+  -- /-begin
+  --   destruct q. apply isequiv_concat_l.
+  -- end-/
+
+  -- definition isequiv_moveL_M1 {A : Type} {x y : A} (p q : x = y)
+  -- : is_equiv (eq_of_inv_con_eq_idp p q).
+  -- /-begin
+  --   destruct q. apply isequiv_concat_l.
+  -- end-/
+
+  -- definition isequiv_moveL_1V {A : Type} {x y : A} (p : x = y) (q : y = x)
+  -- : is_equiv (eq_inv_of_con_eq_idp' p q).
+  -- /-begin
+  --   destruct q. apply isequiv_concat_l.
+  -- end-/
+
+  -- definition isequiv_moveL_V1 {A : Type} {x y : A} (p : x = y) (q : y = x)
+  -- : is_equiv (eq_inv_of_con_eq_idp p q).
+  -- /-begin
+  --   destruct q. apply isequiv_concat_l.
+  -- end-/
+
+  -- definition isequiv_moveR_M1 {A : Type} {x y : A} (p q : x = y)
+  -- : is_equiv (eq_of_idp_eq_inv_con p q).
+  -- /-begin
+  --   destruct p. apply isequiv_concat_r.
+  -- end-/
+
+  -- definition isequiv_moveR_1M {A : Type} {x y : A} (p q : x = y)
+  -- : is_equiv (eq_of_idp_eq_con_inv p q).
+  -- /-begin
+  --   destruct p. apply isequiv_concat_r.
+  -- end-/
+
+  -- definition isequiv_moveR_1V {A : Type} {x y : A} (p : x = y) (q : y = x)
+  -- : is_equiv (inv_eq_of_idp_eq_con p q).
+  -- /-begin
+  --   destruct p. apply isequiv_concat_r.
+  -- end-/
+
+  -- definition isequiv_moveR_V1 {A : Type} {x y : A} (p : x = y) (q : y = x)
+  -- : is_equiv (inv_eq_of_idp_eq_con' p q).
+  -- /-begin
+  --   destruct p. apply isequiv_concat_r.
+  -- end-/
+
+  -- definition isequiv_moveR_transport_p [instance] {A : Type} (P : A → Type) {x y : A}
+  --   (p : x = y) (u : P x) (v : P y)
+  -- : is_equiv (tr_eq_of_eq_inv_tr P p u v).
+  -- /-begin
+  --   destruct p. apply isequiv_idmap.
+  -- end-/
+
+  -- definition equiv_moveR_transport_p {A : Type} (P : A → Type) {x y : A}
+  --   (p : x = y) (u : P x) (v : P y)
+  -- : u = transport P p⁻¹ v ≃ transport P p u = v :=
+  --    equiv.mk _ _ (tr_eq_of_eq_inv_tr P p u v) _.
+
+  -- definition isequiv_moveR_transport_V [instance] {A : Type} (P : A → Type) {x y : A}
+  --   (p : y = x) (u : P x) (v : P y)
+  -- : is_equiv (inv_tr_eq_of_eq_tr P p u v).
+  -- /-begin
+  --   destruct p. apply isequiv_idmap.
+  -- end-/
+
+  -- definition equiv_moveR_transport_V {A : Type} (P : A → Type) {x y : A}
+  --   (p : y = x) (u : P x) (v : P y)
+  -- : u = transport P p v ≃ transport P p⁻¹ u = v :=
+  --    equiv.mk _ _ (inv_tr_eq_of_eq_tr P p u v) _.
+
+  -- definition isequiv_moveL_transport_V [instance] {A : Type} (P : A → Type) {x y : A}
+  --   (p : x = y) (u : P x) (v : P y)
+  -- : is_equiv (eq_inv_tr_of_tr_eq P p u v).
+  -- /-begin
+  --   destruct p. apply isequiv_idmap.
+  -- end-/
+
+  -- definition equiv_moveL_transport_V {A : Type} (P : A → Type) {x y : A}
+  --   (p : x = y) (u : P x) (v : P y)
+  -- : transport P p u = v ≃ u = transport P p⁻¹ v :=
+  --    equiv.mk _ _ (eq_inv_tr_of_tr_eq P p u v) _.
+
+  -- definition isequiv_moveL_transport_p [instance] {A : Type} (P : A → Type) {x y : A}
+  --   (p : y = x) (u : P x) (v : P y)
+  -- : is_equiv (eq_tr_of_inv_tr_eq P p u v).
+  -- /-begin
+  --   destruct p. apply isequiv_idmap.
+  -- end-/
+
+  -- definition equiv_moveL_transport_p {A : Type} (P : A → Type) {x y : A}
+  --   (p : y = x) (u : P x) (v : P y)
+  -- : transport P p⁻¹ u = v ≃ u = transport P p v :=
+  --    equiv.mk _ _ (eq_tr_of_inv_tr_eq P p u v) _.
+
+  -- definition isequiv_moveR_equiv_M [instance] [H : is_equiv A B f] (x : A) (y : B)
+  -- : is_equiv (@moveR_equiv_M A B f _ x y).
+  -- /-begin
+  --   unfold moveR_equiv_M.
+  --   refine (@isequiv_compose _ _ (ap f) _ _ (λq, q ⬝ retr f y) _).
+  -- end-/
+
+  -- definition equiv_moveR_equiv_M [H : is_equiv A B f] (x : A) (y : B)
+  --   : (x = f⁻¹ y) ≃ (f x = y) :=
+  --      equiv.mk _ _ (@moveR_equiv_M A B f _ x y) _.
+
+  -- definition isequiv_moveR_equiv_V [instance] [H : is_equiv A B f] (x : B) (y : A)
+  -- : is_equiv (@moveR_equiv_V A B f _ x y).
+  -- /-begin
+  --   unfold moveR_equiv_V.
+  --   refine (@isequiv_compose _ _ (ap f⁻¹) _ _ (λq, q ⬝ sect f y) _).
+  -- end-/
+
+  -- definition equiv_moveR_equiv_V [H : is_equiv A B f] (x : B) (y : A)
+  --   : (x = f y) ≃ (f⁻¹ x = y) :=
+  --      equiv.mk _ _ (@moveR_equiv_V A B f _ x y) _.
+
+  -- definition isequiv_moveL_equiv_M [instance] [H : is_equiv A B f] (x : A) (y : B)
+  -- : is_equiv (@moveL_equiv_M A B f _ x y).
+  -- /-begin
+  --   unfold moveL_equiv_M.
+  --   refine (@isequiv_compose _ _ (ap f) _ _ (λq, (retr f y)⁻¹ ⬝ q) _).
+  -- end-/
+
+  -- definition equiv_moveL_equiv_M [H : is_equiv A B f] (x : A) (y : B)
+  --   : (f⁻¹ y = x) ≃ (y = f x) :=
+  --      equiv.mk _ _ (@moveL_equiv_M A B f _ x y) _.
+
+  -- definition isequiv_moveL_equiv_V [instance] [H : is_equiv A B f] (x : B) (y : A)
+  -- : is_equiv (@moveL_equiv_V A B f _ x y).
+  -- /-begin
+  --   unfold moveL_equiv_V.
+  --   refine (@isequiv_compose _ _ (ap f⁻¹) _ _ (λq, (sect f y)⁻¹ ⬝ q) _).
+  -- end-/
+
+  -- definition equiv_moveL_equiv_V [H : is_equiv A B f] (x : B) (y : A)
+  --   : (f y = x) ≃ (y = f⁻¹ x) :=
+  --      equiv.mk _ _ (@moveL_equiv_V A B f _ x y) _.
+
+  -- /- Dependent paths -/
+
+  -- /- Usually, a dependent path over [p:x1=x2] in [P:A->Type] between [y1:P x1] and [y2:P x2] is a path [transport P p y1 = y2] in [P x2].  However, when [P] is a path space, these dependent paths have a more convenient description: rather than transporting the left side both forwards and backwards, we transport both sides of the equation forwards, forming a sort of "naturality square".
+
+  --    We use the same naming scheme as for the transport lemmas. -/
+
+  -- definition dpath_path_l {A : Type} {x1 x2 y : A}
+  --   (p : x1 = x2) (q : x1 = y) (r : x2 = y)
+  --   : q = p ⬝ r
+  --   ≃
+  --   transport (λx, x = y) p q = r.
+  -- /-begin
+  --   destruct p; simpl.
+  --   exact (equiv_concat_r (idp_con r) q).
+  -- end-/
+
+  -- definition dpath_path_r {A : Type} {x y1 y2 : A}
+  --   (p : y1 = y2) (q : x = y1) (r : x = y2)
+  --   : q ⬝ p = r
+  --   ≃
+  --   transport (λy, x = y) p q = r.
+  -- /-begin
+  --   destruct p; simpl.
+  --   exact (equiv_concat_l (con_idp q)⁻¹ r).
+  -- end-/
+
+  -- definition dpath_path_lr {A : Type} {x1 x2 : A}
+  --   (p : x1 = x2) (q : x1 = x1) (r : x2 = x2)
+  --   : q ⬝ p = p ⬝ r
+  --   ≃
+  --   transport (λx, x = x) p q = r.
+  -- /-begin
+  --   destruct p; simpl.
+  --   refine (equiv_compose' (B := (q ⬝ 1 = r)) _ _).
+  --   exact (equiv_concat_l (con_idp q)⁻¹ r).
+  --   exact (equiv_concat_r (idp_con r) (q ⬝ 1)).
+  -- end-/
+
+  -- definition dpath_path_Fl {A B : Type} {f : A → B} {x1 x2 : A} {y : B}
+  --   (p : x1 = x2) (q : f x1 = y) (r : f x2 = y)
+  --   : q = ap f p ⬝ r
+  --   ≃
+  --   transport (λx, f x = y) p q = r.
+  -- /-begin
+  --   destruct p; simpl.
+  --   exact (equiv_concat_r (idp_con r) q).
+  -- end-/
+
+  -- definition dpath_path_Fr {A B : Type} {g : A → B} {x : B} {y1 y2 : A}
+  --   (p : y1 = y2) (q : x = g y1) (r : x = g y2)
+  --   : q ⬝ ap g p = r
+  --   ≃
+  --   transport (λy, x = g y) p q = r.
+  -- /-begin
+  --   destruct p; simpl.
+  --   exact (equiv_concat_l (con_idp q)⁻¹ r).
+  -- end-/
+
+  -- definition dpath_path_FlFr {A B : Type} {f g : A → B} {x1 x2 : A}
+  --   (p : x1 = x2) (q : f x1 = g x1) (r : f x2 = g x2)
+  --   : q ⬝ ap g p = ap f p ⬝ r
+  --   ≃
+  --   transport (λx, f x = g x) p q = r.
+  -- /-begin
+  --   destruct p; simpl.
+  --   refine (equiv_compose' (B := (q ⬝ 1 = r)) _ _).
+  --   exact (equiv_concat_l (con_idp q)⁻¹ r).
+  --   exact (equiv_concat_r (idp_con r) (q ⬝ 1)).
+  -- end-/
+
+  -- definition dpath_path_FFlr {A B : Type} {f : A → B} {g : B → A}
+  --   {x1 x2 : A} (p : x1 = x2) (q : g (f x1) = x1) (r : g (f x2) = x2)
+  --   : q ⬝ p = ap g (ap f p) ⬝ r
+  --   ≃
+  --   transport (λx, g (f x) = x) p q = r.
+  -- /-begin
+  --   destruct p; simpl.
+  --   refine (equiv_compose' (B := (q ⬝ 1 = r)) _ _).
+  --   exact (equiv_concat_l (con_idp q)⁻¹ r).
+  --   exact (equiv_concat_r (idp_con r) (q ⬝ 1)).
+  -- end-/
+
+  -- definition dpath_path_lFFr {A B : Type} {f : A → B} {g : B → A}
+  --   {x1 x2 : A} (p : x1 = x2) (q : x1 = g (f x1)) (r : x2 = g (f x2))
+  --   : q ⬝ ap g (ap f p) = p ⬝ r
+  --   ≃
+  --   transport (λx, x = g (f x)) p q = r.
+  -- /-begin
+  --   destruct p; simpl.
+  --   refine (equiv_compose' (B := (q ⬝ 1 = r)) _ _).
+  --   exact (equiv_concat_l (con_idp q)⁻¹ r).
+  --   exact (equiv_concat_r (idp_con r) (q ⬝ 1)).
+  -- end-/
+
+
+  -- /- Universal mapping property -/
+
+  -- definition isequiv_paths_ind [instance] [H : funext] {A : Type} (a : A)
+  --   (P : Πx, (a = x) → Type)
+  --   : is_equiv (paths_ind a P) | 0 :=
+  --      isequiv_adjointify (paths_ind a P) (λf, f a 1) _ _.
+  -- /-begin
+  --   - intros f.
+  --     apply path_forall; intros x.
+  --     apply path_forall; intros p.
+  --     destruct p; reflexivity.
+  --   - intros u. reflexivity.
+  -- end-/
+
+  -- definition equiv_paths_ind [H : funext] {A : Type} (a : A)
+  --   (P : Πx, (a = x) → Type)
+  --   : P a 1 ≃ Πx p, P x p :=
+  --      equiv.mk _ _ (paths_ind a P) _.
+
+end path

hott/types/pi.hlean

@@ -12,7 +12,7 @@ open eq equiv is_equiv funext
 
 namespace pi
   universe variables l k
-  variables {A A' : Type.{l}} {B : A → Type.{k}} {C : Πa, B a → Type}
+  variables {A A' : Type.{l}} {B : A → Type.{k}} {B' : A' → Type.{k}} {C : Πa, B a → Type}
             {D : Πa b, C a b → Type}
             {a a' a'' : A} {b b₁ b₂ : B a} {b' : B a'} {b'' : B a''} {f g : Πa, B a}
 
@@ -24,75 +24,138 @@ namespace pi
 
   /- Now we show how these things compute. -/
 
-  definition apD10_path_pi [H : funext] (h : f ∼ g) : apD10 (path_pi h) ∼ h :=
+  definition apD10_eq_of_homotopy (h : f ∼ g) : apD10 (eq_of_homotopy h) ∼ h :=
   apD10 (retr apD10 h)
 
-  definition path_pi_eta [H : funext] (p : f = g) : path_pi (apD10 p) = p :=
+  definition eq_of_homotopy_eta (p : f = g) : eq_of_homotopy (apD10 p) = p :=
   sect apD10 p
 
-  definition path_pi_idp [H : funext] : path_pi (λx : A, refl (f x)) = refl f :=
+  definition eq_of_homotopy_idp (f : Πa, B a) : eq_of_homotopy (λx : A, refl (f x)) = refl f :=
-  !path_pi_eta
+  !eq_of_homotopy_eta
 
   /- The identification of the path space of a dependent function space, up to equivalence, is of course just funext. -/
 
-  definition path_equiv_homotopy [H : funext] (f g : Πx, B x) : (f = g) ≃ (f ∼ g) :=
+  definition eq_equiv_homotopy (f g : Πx, B x) : (f = g) ≃ (f ∼ g) :=
-  equiv.mk _ !funext.ap
+  equiv.mk _ !funext.elim
 
-  definition is_equiv_path_pi [instance] [H : funext] (f g : Πx, B x)
+  definition is_equiv_eq_of_homotopy [instance] (f g : Πx, B x)
-      : is_equiv (@path_pi _ _ _ f g) :=
+      : is_equiv (@eq_of_homotopy _ _ _ f g) :=
-  inv_closed apD10
+  is_equiv_inv apD10
 
-  definition homotopy_equiv_path [H : funext] (f g : Πx, B x) : (f ∼ g) ≃ (f = g) :=
+  definition homotopy_equiv_eq (f g : Πx, B x) : (f ∼ g) ≃ (f = g) :=
-  equiv.mk _ !is_equiv_path_pi
+  equiv.mk _ !is_equiv_eq_of_homotopy
 
 
   /- Transport -/
 
-  protected definition transport (p : a = a') (f : Π(b : B a), C a b)
+  definition pi_transport (p : a = a') (f : Π(b : B a), C a b)
     : (transport (λa, Π(b : B a), C a b) p f)
-      ∼ (λb, transport (C a') !transport_pV (transportD _ _ p _ (f (p⁻¹ ▹ b)))) :=
+      ∼ (λb, transport (C a') !tr_inv_tr (transportD _ _ p _ (f (p⁻¹ ▹ b)))) :=
   eq.rec_on p (λx, idp)
 
   /- A special case of [transport_pi] where the type [B] does not depend on [A],
       and so it is just a fixed type [B]. -/
-  definition transport_constant {C : A → A' → Type} (p : a = a') (f : Π(b : A'), C a b)
+  definition pi_transport_constant {C : A → A' → Type} (p : a = a') (f : Π(b : A'), C a b)
-    : (eq.transport (λa, Π(b : A'), C a b) p f) ∼ (λb, eq.transport (λa, C a b) p (f b)) :=
+    : (transport (λa, Π(b : A'), C a b) p f) ∼ (λb, transport (λa, C a b) p (f b)) :=
   eq.rec_on p (λx, idp)
 
   /- Maps on paths -/
 
   /- The action of maps given by lambda. -/
-  definition ap_lambdaD [H : funext] {C : A' → Type} (p : a = a') (f : Πa b, C b) :
+  definition ap_lambdaD {C : A' → Type} (p : a = a') (f : Πa b, C b) :
-    ap (λa b, f a b) p = path_pi (λb, ap (λa, f a b) p) :=
+    ap (λa b, f a b) p = eq_of_homotopy (λb, ap (λa, f a b) p) :=
   begin
     apply (eq.rec_on p),
     apply inverse,
-    apply path_pi_idp
+    apply eq_of_homotopy_idp
   end
 
   /- Dependent paths -/
 
   /- with more implicit arguments the conclusion of the following theorem is
-     (Π(b : B a), transportD B C p b (f b) = g (eq.transport B p b)) ≃
+     (Π(b : B a), transportD B C p b (f b) = g (transport B p b)) ≃
-     (eq.transport (λa, Π(b : B a), C a b) p f = g) -/
+     (transport (λa, Π(b : B a), C a b) p f = g) -/
-  definition dpath_pi [H : funext] (p : a = a') (f : Π(b : B a), C a b) (g : Π(b' : B a'), C a' b')
+  definition heq_piD (p : a = a') (f : Π(b : B a), C a b)
-    : (Π(b : B a), p ▹D (f b) = g (p ▹ b)) ≃ (p ▹ f = g) :=
+    (g : Π(b' : B a'), C a' b') : (Π(b : B a), p ▹D (f b) = g (p ▹ b)) ≃ (p ▹ f = g) :=
-  eq.rec_on p (λg, !homotopy_equiv_path) g
+  eq.rec_on p (λg, !homotopy_equiv_eq) g
 
-  section open sigma sigma.ops
+  definition heq_pi {C : A → Type.{k}} (p : a = a') (f : Π(b : B a), C a)
+    (g : Π(b' : B a'), C a') : (Π(b : B a), p ▹ (f b) = g (p ▹ b)) ≃ (p ▹ f = g) :=
+  eq.rec_on p (λg, !homotopy_equiv_eq) g
+
+
+  section
+  open sigma sigma.ops
   /- more implicit arguments:
-  (Π(b : B a), eq.transport C (sigma.path p idp) (f b) = g (p ▹ b)) ≃
+  (Π(b : B a), transport C (sigma_eq p idp) (f b) = g (p ▹ b)) ≃
-  (Π(b : B a), transportD B (λ(a : A) (b : B a), C ⟨a, b⟩) p b (f b) = g (eq.transport B p b)) -/
+  (Π(b : B a), transportD B (λ(a : A) (b : B a), C ⟨a, b⟩) p b (f b) = g (transport B p b)) -/
-  definition dpath_pi_sigma {C : (Σa, B a) → Type} (p : a = a')
+  definition heq_pi_sigma {C : (Σa, B a) → Type} (p : a = a')
     (f : Π(b : B a), C ⟨a, b⟩) (g : Π(b' : B a'), C ⟨a', b'⟩) :
-    (Π(b : B a), (sigma.path p idp) ▹ (f b) = g (p ▹ b)) ≃ (Π(b : B a), p ▹D (f b) = g (p ▹ b)) :=
+    (Π(b : B a), (sigma_eq p idp) ▹ (f b) = g (p ▹ b)) ≃ (Π(b : B a), p ▹D (f b) = g (p ▹ b)) :=
   eq.rec_on p (λg, !equiv.refl) g
   end
 
-  /- truncation -/
+  /- Functorial action -/
+  variables (f0 : A' → A) (f1 : Π(a':A'), B (f0 a') → B' a')
 
-  open truncation
+  /- The functoriality of [forall] is slightly subtle: it is contravariant in the domain type and covariant in the codomain, but the codomain is dependent on the domain. -/
-  definition trunc_pi [instance] [H : funext.{l k}] (B : A → Type.{k}) (n : trunc_index)
+
+  definition pi_functor : (Π(a:A), B a) → (Π(a':A'), B' a') := (λg a', f1 a' (g (f0 a')))
+
+  definition ap_pi_functor {g g' : Π(a:A), B a} (h : g ∼ g')
+      : ap (pi_functor f0 f1) (eq_of_homotopy h) = eq_of_homotopy (λa':A', (ap (f1 a') (h (f0 a')))) :=
+  begin
+  apply (equiv_rect (@apD10 A B g g')), intro p, clear h, --revert p, revert g',
+  apply (eq.rec_on p),
+  apply concat, --(@concat _ _ (refl (pi_functor f0 f1 g))),
+    exact (ap (ap (pi_functor f0 f1)) (eq_of_homotopy_idp g)),
+    apply symm, apply eq_of_homotopy_idp
+  end
+
+  /- Equivalences -/
+
+  definition is_equiv_pi_functor [instance] (f0 : A' → A) (f1 : Π(a':A'), B (f0 a') → B' a')
+    [H0 : is_equiv f0] [H1 : Πa', @is_equiv (B (f0 a')) (B' a') (f1 a')]
+      : is_equiv (pi_functor f0 f1) :=
+  begin
+  apply (adjointify (pi_functor f0 f1) (pi_functor (f0⁻¹)
+        (λ(a : A) (b' : B' (f0⁻¹ a)), transport B (retr f0 a) ((f1 (f0⁻¹ a))⁻¹ b')))),
+  intro h, apply eq_of_homotopy,
+  unfold pi_functor, unfold function.compose, unfold function.id,
+  --first subgoal
+  intro a',
+  beta,
+  apply (tr_inv _ (adj f0 a')),
+  apply (transport (λx, f1 a' x = h a') (transport_compose B f0 (sect f0 a') _)), beta,
+  apply (tr_inv (λx, x = h a') (fn_tr_eq_tr_fn _ f1 _)), beta, unfold function.compose,
+  apply (tr_inv (λx, sect f0 a' ▹ x = h a') (retr (f1 _) _)), beta, unfold function.id,
+  apply apD,
+  --second subgoal
+  intro h, beta,
+  apply eq_of_homotopy, intro a, beta,
+  apply (tr_inv (λx, retr f0 a ▹ x = h a) (sect (f1 _) _)), unfold function.id, beta,
+  apply apD
+  end
+
+
+  definition pi_equiv_pi_of_is_equiv [H : is_equiv f0] [H1 : Πa', @is_equiv (B (f0 a')) (B' a') (f1 a')]
+    : (Πa, B a) ≃ (Πa', B' a') :=
+  equiv.mk (pi_functor f0 f1) _
+
+  context
+  attribute inv [irreducible] --this is needed for the following class instance resolution
+  definition pi_equiv_pi (f0 : A' ≃ A) (f1 : Πa', (B (to_fun f0 a') ≃ B' a'))
+    : (Πa, B a) ≃ (Πa', B' a') :=
+  pi_equiv_pi_of_is_equiv (to_fun f0) (λa', to_fun (f1 a'))
+  end
+
+  definition pi_equiv_pi_id {P Q : A → Type} (g : Πa, P a ≃ Q a) : (Πa, P a) ≃ (Πa, Q a) :=
+  pi_equiv_pi equiv.refl g.
+
+  /- Truncatedness: any dependent product of n-types is an n-type -/
+
+  open is_trunc
+  definition is_trunc_pi [instance] [H : funext.{l k}] (B : A → Type.{k}) (n : trunc_index)
       [H : ∀a, is_trunc n (B a)] : is_trunc n (Πa, B a) :=
   begin
     reverts (B, H),
@@ -100,23 +163,37 @@ namespace pi
       intros (B, H),
         fapply is_contr.mk,
           intro a, apply center,
-          intro f, apply path_pi,
+          intro f, apply eq_of_homotopy,
             intro x, apply (contr (f x)),
       intros (n, IH, B, H),
-        fapply is_trunc_succ, intros (f, g),
+        fapply is_trunc_succ_intro, intros (f, g),
-          fapply trunc_equiv',
+          fapply is_trunc_equiv_closed,
-            apply equiv.symm, apply path_equiv_homotopy,
+            apply equiv.symm, apply eq_equiv_homotopy,
             apply IH,
               intro a,
               show is_trunc n (f a = g a), from
-              succ_is_trunc n (f a) (g a)
+              is_trunc_eq n (f a) (g a)
   end
 
-  definition trunc_path_pi [instance] [H : funext.{l k}] (n : trunc_index) (f g : Πa, B a)
+  definition is_trunc_eq_pi [instance] [H : funext.{l k}] (n : trunc_index) (f g : Πa, B a)
       [H : ∀a, is_trunc n (f a = g a)] : is_trunc n (f = g) :=
   begin
-    apply trunc_equiv', apply equiv.symm,
+    apply is_trunc_equiv_closed, apply equiv.symm,
-    apply path_equiv_homotopy
+    apply eq_equiv_homotopy
   end
 
+  /- Symmetry of Π -/
+
+  definition is_equiv_flip [instance] {P : A → A' → Type} : is_equiv (@function.flip _ _ P) :=
+  begin
+  fapply is_equiv.mk,
+  exact (@function.flip _ _ (function.flip P)),
+  repeat (intro f; apply idp)
+  end
+
+  definition pi_comm_equiv {P : A → A' → Type} : (Πa b, P a b) ≃ (Πb a, P a b) :=
+  equiv.mk (@function.flip _ _ P) _
+
 end pi
+
+attribute pi.is_trunc_pi [instance]

hott/types/pointed.hlean

@@ -1,9 +1,14 @@
--- Copyright (c) 2014 Jakob von Raumer. All rights reserved.
+/-
--- Released under Apache 2.0 license as described in the file LICENSE.
+Copyright (c) 2014 Jakob von Raumer. All rights reserved.
--- Author: Jakob von Raumer
+Released under Apache 2.0 license as described in the file LICENSE.
--- Ported from Coq HoTT
+
-import init.trunc
+Module: types.pointed
-open eq prod truncation
+Author: Jakob von Raumer
+
+Ported from Coq HoTT
+-/
+
+open eq prod is_trunc sigma
 
 structure is_pointed [class] (A : Type) :=
   (point : A)
@@ -13,7 +18,7 @@ namespace is_pointed
 
   -- Any contractible type is pointed
   protected definition contr [instance] [H : is_contr A] : is_pointed A :=
-    is_pointed.mk (center A)
+    is_pointed.mk !center
 
   -- A pi type with a pointed target is pointed
   protected definition pi [instance] {P : A → Type} [H : Πx, is_pointed (P x)]
@@ -22,12 +27,12 @@ namespace is_pointed
 
   -- A sigma type of pointed components is pointed
   protected definition sigma [instance] {P : A → Type} [G : is_pointed A]
-      [H : is_pointed (P (point A))] : is_pointed (Σx, P x) :=
+      [H : is_pointed (P !point)] : is_pointed (Σx, P x) :=
-    is_pointed.mk (sigma.mk (point A) (point (P (point A))))
+    is_pointed.mk ⟨!point,!point⟩
 
   protected definition prod [H1 : is_pointed A] [H2 : is_pointed B]
       : is_pointed (A × B) :=
-    is_pointed.mk (prod.mk (point A) (point B))
+    is_pointed.mk (!point,!point)
 
   protected definition loop_space (a : A) : is_pointed (a = a) :=
     is_pointed.mk idp

hott/types/prod.hlean

@@ -7,8 +7,7 @@ Ported from Coq HoTT
 Theorems about products
 -/
 
-import init.trunc init.datatypes
+open eq equiv is_equiv is_trunc prod
-open eq equiv is_equiv truncation prod
 
 variables {A A' B B' C D : Type}
           {a a' a'' : A} {b b₁ b₂ b' b'' : B} {u v w : A × B}
@@ -16,32 +15,32 @@ variables {A A' B B' C D : Type}
 namespace prod
 
   -- prod.eta is already used for the eta rule for strict equality
-  protected definition peta (u : A × B) : (pr₁ u , pr₂ u) = u :=
+  protected definition eta (u : A × B) : (pr₁ u , pr₂ u) = u :=
   destruct u (λu1 u2, idp)
 
-  definition pair_path (pa : a = a') (pb : b = b') : (a , b) = (a' , b') :=
+  definition pair_eq (pa : a = a') (pb : b = b') : (a , b) = (a' , b') :=
   eq.rec_on pa (eq.rec_on pb idp)
 
-  protected definition path : (pr₁ u = pr₁ v) → (pr₂ u = pr₂ v) → u = v :=
+  definition prod_eq : (pr₁ u = pr₁ v) → (pr₂ u = pr₂ v) → u = v :=
   begin
     apply (prod.rec_on u), intros (a₁, b₁),
     apply (prod.rec_on v), intros (a₂, b₂, H₁, H₂),
-    apply (transport _ (peta (a₁, b₁))),
+    apply (transport _ (eta (a₁, b₁))),
-    apply (transport _ (peta (a₂, b₂))),
+    apply (transport _ (eta (a₂, b₂))),
-    apply (pair_path H₁ H₂),
+    apply (pair_eq H₁ H₂),
   end
 
   /- Symmetry -/
 
-  definition isequiv_flip [instance] (A B : Type) : is_equiv (@flip A B) :=
+  definition is_equiv_flip [instance] (A B : Type) : is_equiv (@flip A B) :=
   adjointify flip
              flip
              (λu, destruct u (λb a, idp))
              (λu, destruct u (λa b, idp))
 
-  definition symm_equiv (A B : Type) : A × B ≃ B × A :=
+  definition prod_comm_equiv (A B : Type) : A × B ≃ B × A :=
   equiv.mk flip _
 
-  -- trunc_prod is defined in sigma
+  -- is_trunc_prod is defined in sigma
 
 end prod

hott/types/sigma.hlean

@@ -17,7 +17,7 @@ namespace sigma
             {a a' a'' : A} {b b₁ b₂ : B a} {b' : B a'} {b'' : B a''} {u v w : Σa, B a}
 
   -- sigma.eta is already used for the eta rule for strict equality
-  protected definition peta (u : Σa, B a) : ⟨u.1 , u.2⟩ = u :=
+  protected definition eta (u : Σa, B a) : ⟨u.1 , u.2⟩ = u :=
   destruct u (λu1 u2, idp)
 
   definition eta2 (u : Σa b, C a b) : ⟨u.1, u.2.1, u.2.2⟩ = u :=
@@ -26,31 +26,31 @@ namespace sigma
   definition eta3 (u : Σa b c, D a b c) : ⟨u.1, u.2.1, u.2.2.1, u.2.2.2⟩ = u :=
   destruct u (λu1 u2, destruct u2 (λu21 u22, destruct u22 (λu221 u222, idp)))
 
-  definition dpair_eq_dpair (p : a = a') (q : p ▹ b = b') : sigma.mk a b = sigma.mk a' b' :=
+  definition dpair_eq_dpair (p : a = a') (q : p ▹ b = b') : ⟨a, b⟩ = ⟨a', b'⟩ :=
   eq.rec_on p (λb b' q, eq.rec_on q idp) b b' q
 
   /- In Coq they often have to give u and v explicitly -/
-  protected definition path (p : u.1 = v.1) (q : p ▹ u.2 = v.2) : u = v :=
+  definition sigma_eq (p : u.1 = v.1) (q : p ▹ u.2 = v.2) : u = v :=
   destruct u
            (λu1 u2, destruct v (λ v1 v2, dpair_eq_dpair))
            p q
 
   /- Projections of paths from a total space -/
 
-  definition path_pr1 (p : u = v) : u.1 = v.1 :=
+  definition eq_pr1 (p : u = v) : u.1 = v.1 :=
   ap pr1 p
 
-  postfix `..1`:(max+1) := path_pr1
+  postfix `..1`:(max+1) := eq_pr1
 
-  definition path_pr2 (p : u = v) : p..1 ▹ u.2 = v.2 :=
+  definition eq_pr2 (p : u = v) : p..1 ▹ u.2 = v.2 :=
   eq.rec_on p idp
   --Coq uses the following proof, which only computes if u,v are dpairs AND p is idp
   --(transport_compose B dpr1 p u.2)⁻¹ ⬝ apD dpr2 p
 
-  postfix `..2`:(max+1) := path_pr2
+  postfix `..2`:(max+1) := eq_pr2
 
-  definition dpair_sigma_path (p : u.1 = v.1) (q : p ▹ u.2 = v.2)
+  private definition dpair_sigma_eq (p : u.1 = v.1) (q : p ▹ u.2 = v.2)
-      :  sigma.mk (sigma.path p q)..1 (sigma.path p q)..2 = ⟨p, q⟩ :=
+      : ⟨(sigma_eq p q)..1, (sigma_eq p q)..2⟩ = ⟨p, q⟩ :=
   begin
     reverts (p, q),
     apply (destruct u), intros (u1, u2),
@@ -59,22 +59,22 @@ namespace sigma
     apply (eq.rec_on q), apply idp
   end
 
-  definition sigma_path_pr1 (p : u.1 = v.1) (q : p ▹ u.2 = v.2) : (sigma.path p q)..1 = p :=
+  definition sigma_eq_pr1 (p : u.1 = v.1) (q : p ▹ u.2 = v.2) : (sigma_eq p q)..1 = p :=
-  (!dpair_sigma_path)..1
+  (!dpair_sigma_eq)..1
 
-  definition sigma_path_pr2 (p : u.1 = v.1) (q : p ▹ u.2 = v.2)
+  definition sigma_eq_pr2 (p : u.1 = v.1) (q : p ▹ u.2 = v.2)
-      : sigma_path_pr1 p q ▹ (sigma.path p q)..2 = q :=
+      : sigma_eq_pr1 p q ▹ (sigma_eq p q)..2 = q :=
-  (!dpair_sigma_path)..2
+  (!dpair_sigma_eq)..2
 
-  definition sigma_path_eta (p : u = v) : sigma.path (p..1) (p..2) = p :=
+  definition sigma_eq_eta (p : u = v) : sigma_eq (p..1) (p..2) = p :=
   begin
     apply (eq.rec_on p),
     apply (destruct u), intros (u1, u2),
     apply idp
   end
 
-  definition transport_dpr1_sigma_path {B' : A → Type} (p : u.1 = v.1) (q : p ▹ u.2 = v.2)
+  definition tr_pr1_sigma_eq {B' : A → Type} (p : u.1 = v.1) (q : p ▹ u.2 = v.2)
-      : transport (λx, B' x.1) (sigma.path p q) = transport B' p :=
+      : transport (λx, B' x.1) (sigma_eq p q) = transport B' p :=
   begin
     reverts (p, q),
     apply (destruct u), intros (u1, u2),
@@ -85,42 +85,42 @@ namespace sigma
 
   /- the uncurried version of sigma_eq. We will prove that this is an equivalence -/
 
-  definition sigma_path_uncurried (pq : Σ(p : pr1 u = pr1 v), p ▹ (pr2 u) = pr2 v) : u = v :=
+  definition sigma_eq_uncurried (pq : Σ(p : pr1 u = pr1 v), p ▹ (pr2 u) = pr2 v) : u = v :=
-  destruct pq sigma.path
+  destruct pq sigma_eq
 
-  definition dpair_sigma_path_uncurried (pq : Σ(p : u.1 = v.1), p ▹ u.2 = v.2)
+  definition dpair_sigma_eq_uncurried (pq : Σ(p : u.1 = v.1), p ▹ u.2 = v.2)
-      :  sigma.mk (sigma_path_uncurried pq)..1 (sigma_path_uncurried pq)..2 = pq :=
+      :  sigma.mk (sigma_eq_uncurried pq)..1 (sigma_eq_uncurried pq)..2 = pq :=
-  destruct pq dpair_sigma_path
+  destruct pq dpair_sigma_eq
 
-  definition sigma_path_pr1_uncurried (pq : Σ(p : u.1 = v.1), p ▹ u.2 = v.2)
+  definition sigma_eq_pr1_uncurried (pq : Σ(p : u.1 = v.1), p ▹ u.2 = v.2)
-      : (sigma_path_uncurried pq)..1 = pq.1 :=
+      : (sigma_eq_uncurried pq)..1 = pq.1 :=
-  (!dpair_sigma_path_uncurried)..1
+  (!dpair_sigma_eq_uncurried)..1
 
-  definition sigma_path_pr2_uncurried (pq : Σ(p : u.1 = v.1), p ▹ u.2 = v.2)
+  definition sigma_eq_pr2_uncurried (pq : Σ(p : u.1 = v.1), p ▹ u.2 = v.2)
-      : (sigma_path_pr1_uncurried pq) ▹ (sigma_path_uncurried pq)..2 = pq.2 :=
+      : (sigma_eq_pr1_uncurried pq) ▹ (sigma_eq_uncurried pq)..2 = pq.2 :=
-  (!dpair_sigma_path_uncurried)..2
+  (!dpair_sigma_eq_uncurried)..2
 
-  definition sigma_path_eta_uncurried (p : u = v) : sigma_path_uncurried (sigma.mk p..1 p..2) = p :=
+  definition sigma_eq_eta_uncurried (p : u = v) : sigma_eq_uncurried (sigma.mk p..1 p..2) = p :=
-  !sigma_path_eta
+  !sigma_eq_eta
 
-  definition transport_sigma_path_dpr1_uncurried {B' : A → Type}
+  definition tr_sigma_eq_pr1_uncurried {B' : A → Type}
     (pq : Σ(p : u.1 = v.1), p ▹ u.2 = v.2)
-      : transport (λx, B' x.1) (@sigma_path_uncurried A B u v pq) = transport B' pq.1 :=
+      : transport (λx, B' x.1) (@sigma_eq_uncurried A B u v pq) = transport B' pq.1 :=
-  destruct pq transport_dpr1_sigma_path
+  destruct pq tr_pr1_sigma_eq
 
-  definition is_equiv_sigma_path [instance] (u v : Σa, B a)
+  definition is_equiv_sigma_eq [instance] (u v : Σa, B a)
-      : is_equiv (@sigma_path_uncurried A B u v) :=
+      : is_equiv (@sigma_eq_uncurried A B u v) :=
-  adjointify sigma_path_uncurried
+  adjointify sigma_eq_uncurried
              (λp, ⟨p..1, p..2⟩)
-             sigma_path_eta_uncurried
+             sigma_eq_eta_uncurried
-             dpair_sigma_path_uncurried
+             dpair_sigma_eq_uncurried
 
-  definition equiv_sigma_path (u v : Σa, B a) : (Σ(p : u.1 = v.1),  p ▹ u.2 = v.2) ≃ (u = v) :=
+  definition equiv_sigma_eq (u v : Σa, B a) : (Σ(p : u.1 = v.1),  p ▹ u.2 = v.2) ≃ (u = v) :=
-  equiv.mk sigma_path_uncurried !is_equiv_sigma_path
+  equiv.mk sigma_eq_uncurried !is_equiv_sigma_eq
 
-  definition dpair_eq_dpair_pp_pp (p1 : a  = a' ) (q1 : p1 ▹ b  = b' )
+  definition dpair_eq_dpair_con (p1 : a  = a' ) (q1 : p1 ▹ b  = b' )
                                   (p2 : a' = a'') (q2 : p2 ▹ b' = b'') :
-      dpair_eq_dpair (p1 ⬝ p2) (transport_pp B p1 p2 b ⬝ ap (transport B p2) q1 ⬝ q2)
+      dpair_eq_dpair (p1 ⬝ p2) (tr_con B p1 p2 b ⬝ ap (transport B p2) q1 ⬝ q2)
     = dpair_eq_dpair p1 q1 ⬝ dpair_eq_dpair  p2 q2 :=
   begin
     reverts (b', p2, b'', q1, q2),
@@ -130,20 +130,20 @@ namespace sigma
     apply (eq.rec_on q2), apply idp
   end
 
-  definition sigma_path_pp_pp (p1 : u.1 = v.1) (q1 : p1 ▹ u.2 = v.2)
+  definition sigma_eq_con (p1 : u.1 = v.1) (q1 : p1 ▹ u.2 = v.2)
                               (p2 : v.1 = w.1) (q2 : p2 ▹ v.2 = w.2) :
-      sigma.path (p1 ⬝ p2) (transport_pp B p1 p2 u.2 ⬝ ap (transport B p2) q1 ⬝ q2)
+      sigma_eq (p1 ⬝ p2) (tr_con B p1 p2 u.2 ⬝ ap (transport B p2) q1 ⬝ q2)
-    = sigma.path p1 q1 ⬝ sigma.path p2 q2 :=
+    = sigma_eq p1 q1 ⬝ sigma_eq p2 q2 :=
   begin
     reverts (p1, q1, p2, q2),
     apply (destruct u), intros (u1, u2),
     apply (destruct v), intros (v1, v2),
     apply (destruct w), intros,
-    apply dpair_eq_dpair_pp_pp
+    apply dpair_eq_dpair_con
   end
 
   local attribute dpair_eq_dpair [reducible]
-  definition dpair_eq_dpair_p1_1p (p : a = a') (q : p ▹ b = b') :
+  definition dpair_eq_dpair_con_idp (p : a = a') (q : p ▹ b = b') :
       dpair_eq_dpair p q = dpair_eq_dpair p idp ⬝ dpair_eq_dpair idp q :=
   begin
     reverts (b', q),
@@ -151,11 +151,11 @@ namespace sigma
     apply (eq.rec_on q), apply idp
   end
 
-  /- path_pr1 commutes with the groupoid structure. -/
+  /- eq_pr1 commutes with the groupoid structure. -/
 
-  definition path_pr1_idp (u : Σa, B a)           : (refl u)..1 = refl (u.1)       := idp
+  definition eq_pr1_idp (u : Σa, B a)           : (refl u) ..1 = refl (u.1)      := idp
-  definition path_pr1_pp  (p : u = v) (q : v = w) : (p ⬝ q)   ..1 = (p..1) ⬝ (q..1) := !ap_pp
+  definition eq_pr1_con  (p : u = v) (q : v = w) : (p ⬝ q)  ..1 = (p..1) ⬝ (q..1) := !ap_con
-  definition path_pr1_V   (p : u = v)             : p⁻¹       ..1 = (p..1)⁻¹        := !ap_V
+  definition eq_pr1_inv   (p : u = v)             : p⁻¹      ..1 = (p..1)⁻¹        := !ap_inv
 
   /- Applying dpair to one argument is the same as dpair_eq_dpair with reflexivity in the first place. -/
 
@@ -168,8 +168,8 @@ namespace sigma
       p ▹D c = transport (λu, C (u.1) (u.2)) (dpair_eq_dpair p idp) c :=
   eq.rec_on p idp
 
-  definition sigma_path_eq_sigma_path {p1 q1 : a = a'} {p2 : p1 ▹ b = b'} {q2 : q1 ▹ b = b'}
+  definition sigma_eq_eq_sigma_eq {p1 q1 : a = a'} {p2 : p1 ▹ b = b'} {q2 : q1 ▹ b = b'}
-      (r : p1 = q1) (s : r ▹ p2 = q2) : sigma.path p1 p2 = sigma.path q1 q2 :=
+      (r : p1 = q1) (s : r ▹ p2 = q2) : sigma_eq p1 p2 = sigma_eq q1 q2 :=
   eq.rec_on r
               proof (λq2 s, eq.rec_on s idp) qed
               q2
@@ -182,20 +182,21 @@ namespace sigma
 
 
   /- A path between paths in a total space is commonly shown component wise. -/
-  definition path_sigma_path {p q : u = v} (r : p..1 = q..1) (s : r ▹ p..2 = q..2) : p = q :=
+  definition sigma_eq2 {p q : u = v} (r : p..1 = q..1) (s : r ▹ p..2 = q..2)
+    : p = q :=
   begin
     reverts (q, r, s),
     apply (eq.rec_on p),
     apply (destruct u), intros (u1, u2, q, r, s),
     apply concat, rotate 1,
-    apply sigma_path_eta,
+    apply sigma_eq_eta,
-    apply (sigma_path_eq_sigma_path r s)
+    apply (sigma_eq_eq_sigma_eq r s)
   end
 
   /- In Coq they often have to give u and v explicitly when using the following definition -/
-  definition path_sigma_path_uncurried {p q : u = v}
+  definition sigma_eq2_uncurried {p q : u = v}
       (rs : Σ(r : p..1 = q..1), transport (λx, transport B x u.2 = v.2) r p..2 = q..2) : p = q :=
-  destruct rs path_sigma_path
+  destruct rs sigma_eq2
 
   /- Transport -/
 
@@ -212,7 +213,7 @@ namespace sigma
   end
 
   /- The special case when the second variable doesn't depend on the first is simpler. -/
-  definition transport_eq_deg {B : Type} {C : A → B → Type} (p : a = a') (bc : Σ(b : B), C a b)
+  definition tr_eq_nondep {B : Type} {C : A → B → Type} (p : a = a') (bc : Σ(b : B), C a b)
       : p ▹ bc = ⟨bc.1, p ▹ bc.2⟩ :=
   begin
     apply (eq.rec_on p),
@@ -222,7 +223,7 @@ namespace sigma
 
   /- Or if the second variable contains a first component that doesn't depend on the first. -/
 
-  definition transport_eq_4deg {C : A → Type} {D : Π a:A, B a → C a → Type} (p : a = a')
+  definition tr_eq2_nondep {C : A → Type} {D : Π a:A, B a → C a → Type} (p : a = a')
       (bcd : Σ(b : B a) (c : C a), D a b c) : p ▹ bcd = ⟨p ▹ bcd.1, p ▹ bcd.2.1, p ▹D2 bcd.2.2⟩ :=
   begin
     revert bcd,
@@ -235,70 +236,71 @@ namespace sigma
   /- Functorial action -/
   variables (f : A → A') (g : Πa, B a → B' (f a))
 
-  protected definition functor (u : Σa, B a) : Σa', B' a' :=
+  definition sigma_functor (u : Σa, B a) : Σa', B' a' :=
   ⟨f u.1, g u.1 u.2⟩
 
   /- Equivalences -/
 
-  --TODO: remove explicit arguments of is_equiv
+  definition is_equiv_sigma_functor [H1 : is_equiv f] [H2 : Π a, is_equiv (g a)]
-  definition is_equiv_functor [H1 : is_equiv f] [H2 : Π a, is_equiv (g a)]
+      : is_equiv (sigma_functor f g) :=
-      : is_equiv (functor f g) :=
+  adjointify (sigma_functor f g)
-  adjointify (functor f g)
+             (sigma_functor (f⁻¹) (λ(a' : A') (b' : B' a'),
-             (functor (f⁻¹) (λ(a' : A') (b' : B' a'),
                ((g (f⁻¹ a'))⁻¹ (transport B' (retr f a'⁻¹) b'))))
   begin
     intro u',
     apply (destruct u'), intros (a', b'),
-    apply (sigma.path (retr f a')),
+    apply (sigma_eq (retr f a')),
+  --   rewrite retr,
+  -- end
     -- "rewrite retr (g (f⁻¹ a'))"
     apply concat, apply (ap (λx, (transport B' (retr f a') x))), apply (retr (g (f⁻¹ a'))),
     show retr f a' ▹ (((retr f a') ⁻¹) ▹ b') = b',
-    from transport_pV B' (retr f a') b'
+    from tr_inv_tr B' (retr f a') b'
   end
   begin
     intro u,
     apply (destruct u), intros (a, b),
-    apply (sigma.path (sect f a)),
+    apply (sigma_eq (sect f a)),
     show transport B (sect f a) (g (f⁻¹ (f a))⁻¹ (transport B' (retr f (f a)⁻¹) (g a b))) = b,
     from calc
       transport B (sect f a) (g (f⁻¹ (f a))⁻¹ (transport B' (retr f (f a)⁻¹) (g a b)))
           = g a⁻¹ (transport (B' ∘ f) (sect f a) (transport B' (retr f (f a)⁻¹) (g a b)))
-              : ap_transport (sect f a) (λ a, g a⁻¹)
+              : fn_tr_eq_tr_fn (sect f a) (λ a, g a⁻¹)
       ... = g a⁻¹ (transport B' (ap f (sect f a)) (transport B' (retr f (f a)⁻¹) (g a b)))
               : ap (g a⁻¹) !transport_compose
       ... = g a⁻¹ (transport B' (ap f (sect f a)) (transport B' (ap f (sect f a)⁻¹) (g a b)))
            : ap (λ x, g a⁻¹ (transport B' (ap f (sect f a)) (transport B' (x⁻¹) (g a b)))) (adj f a)
-      ... = g a⁻¹ (g a b) : {!transport_pV}
+      ... = g a⁻¹ (g a b) : {!tr_inv_tr}
       ... = b : sect (g a) b
   end
-    -- -- "rewrite ap_transport"
+    -- -- "rewrite fn_tr_eq_tr_fn"
-    -- apply concat, apply inverse, apply (ap_transport (sect f a) (λ a, g a⁻¹)),
+    -- apply concat, apply inverse, apply (fn_tr_eq_tr_fn (sect f a) (λ a, g a⁻¹)),
     -- apply concat, apply (ap (g a⁻¹)),
     --   -- "rewrite transport_compose"
     --   apply concat, apply transport_compose,
     --   -- "rewrite adj"
-    --   -- "rewrite transport_pV"
+    --   -- "rewrite tr_inv_tr"
     -- apply sect,
 
-  definition equiv_functor_of_is_equiv [H1 : is_equiv f] [H2 : Π a, is_equiv (g a)]
+  definition sigma_equiv_sigma_of_is_equiv [H1 : is_equiv f] [H2 : Π a, is_equiv (g a)]
     : (Σa, B a) ≃ (Σa', B' a') :=
-  equiv.mk (functor f g) !is_equiv_functor
+  equiv.mk (sigma_functor f g) !is_equiv_sigma_functor
 
-  context --remove
+  context
   attribute inv [irreducible]
-  attribute function.compose [irreducible] --remove
+  attribute function.compose [irreducible] --this is needed for the following class inference problem
-  definition equiv_functor (Hf : A ≃ A') (Hg : Π a, B a ≃ B' (to_fun Hf a)) :
+  definition sigma_equiv_sigma (Hf : A ≃ A') (Hg : Π a, B a ≃ B' (to_fun Hf a)) :
       (Σa, B a) ≃ (Σa', B' a') :=
-  equiv_functor_of_is_equiv (to_fun Hf) (λ a, to_fun (Hg a))
+  sigma_equiv_sigma_of_is_equiv (to_fun Hf) (λ a, to_fun (Hg a))
-  end --remove
+  end
 
-  definition equiv_functor_id {B' : A → Type} (Hg : Π a, B a ≃ B' a) : (Σa, B a) ≃ Σa, B' a :=
+  definition sigma_equiv_sigma_id {B' : A → Type} (Hg : Π a, B a ≃ B' a) : (Σa, B a) ≃ Σa, B' a :=
-  equiv_functor equiv.refl Hg
+  sigma_equiv_sigma equiv.refl Hg
 
-  definition ap_functor_sigma_dpair (p : a = a') (q : p ▹ b = b')
+  definition ap_sigma_functor_eq_dpair (p : a = a') (q : p ▹ b = b')
-    : ap (sigma.functor f g) (sigma.path p q)
+    : ap (sigma.sigma_functor f g) (sigma_eq p q)
-    = sigma.path (ap f p)
+    = sigma_eq (ap f p)
-                 (transport_compose _ f p (g a b)⁻¹ ⬝ ap_transport p g b⁻¹ ⬝ ap (g a') q) :=
+                 (transport_compose _ f p (g a b)⁻¹ ⬝ fn_tr_eq_tr_fn p g b⁻¹ ⬝ ap (g a') q) :=
   begin
     reverts (b', q),
     apply (eq.rec_on p),
@@ -306,47 +308,47 @@ namespace sigma
     apply idp
   end
 
-  definition ap_functor_sigma (p : u.1 = v.1) (q : p ▹ u.2 = v.2)
+  definition ap_sigma_functor_eq (p : u.1 = v.1) (q : p ▹ u.2 = v.2)
-    : ap (sigma.functor f g) (sigma.path p q)
+    : ap (sigma.sigma_functor f g) (sigma_eq p q)
-    = sigma.path (ap f p)
+    = sigma_eq (ap f p)
-                 (transport_compose B' f p (g u.1 u.2)⁻¹ ⬝ ap_transport p g u.2⁻¹ ⬝ ap (g v.1) q) :=
+                 (transport_compose B' f p (g u.1 u.2)⁻¹ ⬝ fn_tr_eq_tr_fn p g u.2⁻¹ ⬝ ap (g v.1) q) :=
   begin
     reverts (p, q),
     apply (destruct u), intros (a, b),
     apply (destruct v), intros (a', b', p, q),
-    apply ap_functor_sigma_dpair
+    apply ap_sigma_functor_eq_dpair
   end
 
   /- definition 3.11.9(i): Summing up a contractible family of types does nothing. -/
-  open truncation
+  open is_trunc
-  definition is_equiv_dpr1 [instance] (B : A → Type) [H : Π a, is_contr (B a)]
+  definition is_equiv_pr1 [instance] (B : A → Type) [H : Π a, is_contr (B a)]
       : is_equiv (@pr1 A B) :=
   adjointify pr1
              (λa, ⟨a, !center⟩)
              (λa, idp)
-             (λu, sigma.path idp !contr)
+             (λu, sigma_eq idp !contr)
 
-  definition equiv_of_all_contr [H : Π a, is_contr (B a)] : (Σa, B a) ≃ A :=
+  definition sigma_equiv_of_is_contr_pr2 [H : Π a, is_contr (B a)] : (Σa, B a) ≃ A :=
   equiv.mk pr1 _
 
   /- definition 3.11.9(ii): Dually, summing up over a contractible type does nothing. -/
 
-  definition equiv_center_of_contr (B : A → Type) [H : is_contr A] : (Σa, B a) ≃ B (center A)
+  definition sigma_equiv_of_is_contr_pr1 (B : A → Type) [H : is_contr A] : (Σa, B a) ≃ B (center A)
   :=
   equiv.mk _ (adjointify
     (λu, contr u.1⁻¹ ▹ u.2)
     (λb, ⟨!center, b⟩)
-    (λb, ap (λx, x ▹ b) !path2_contr)
+    (λb, ap (λx, x ▹ b) !hprop_eq)
-    (λu, sigma.path !contr !transport_pV))
+    (λu, sigma_eq !contr !tr_inv_tr))
 
   /- Associativity -/
 
   --this proof is harder than in Coq because we don't have eta definitionally for sigma
-  protected definition assoc_equiv (C : (Σa, B a) → Type) : (Σa b, C ⟨a, b⟩) ≃ (Σu, C u) :=
+  definition sigma_assoc_equiv (C : (Σa, B a) → Type) : (Σa b, C ⟨a, b⟩) ≃ (Σu, C u) :=
   -- begin
   --   apply equiv.mk,
   --   apply (adjointify (λav, ⟨⟨av.1, av.2.1⟩, av.2.2⟩)
-  --                     (λuc, ⟨uc.1.1, uc.1.2, !peta⁻¹ ▹ uc.2⟩)),
+  --                     (λuc, ⟨uc.1.1, uc.1.2, !eta⁻¹ ▹ uc.2⟩)),
   --     intro uc, apply (destruct uc), intro u,
   --               apply (destruct u), intros (a, b, c),
   --               apply idp,
@@ -356,7 +358,7 @@ namespace sigma
   -- end
   equiv.mk _ (adjointify
     (λav, ⟨⟨av.1, av.2.1⟩, av.2.2⟩)
-    (λuc, ⟨uc.1.1, uc.1.2, !peta⁻¹ ▹ uc.2⟩)
+    (λuc, ⟨uc.1.1, uc.1.2, !eta⁻¹ ▹ uc.2⟩)
     proof (λuc, destruct uc (λu, destruct u (λa b c, idp))) qed
     proof (λav, destruct av (λa v, destruct v (λb c, idp))) qed)
 
@@ -364,20 +366,21 @@ namespace sigma
   definition assoc_equiv_prod (C : (A × A') → Type) : (Σa a', C (a,a')) ≃ (Σu, C u) :=
   equiv.mk _ (adjointify
     (λav, ⟨(av.1, av.2.1), av.2.2⟩)
-    (λuc, ⟨pr₁ (uc.1), pr₂ (uc.1), !prod.peta⁻¹ ▹ uc.2⟩)
+    (λuc, ⟨pr₁ (uc.1), pr₂ (uc.1), !prod.eta⁻¹ ▹ uc.2⟩)
     proof (λuc, destruct uc (λu, prod.destruct u (λa b c, idp))) qed
     proof (λav, destruct av (λa v, destruct v (λb c, idp))) qed)
 
   /- Symmetry -/
-  definition symm_equiv_uncurried (C : A × A' → Type) : (Σa a', C (a, a')) ≃ (Σa' a, C (a, a')) :=
+
+  definition comm_equiv_uncurried (C : A × A' → Type) : (Σa a', C (a, a')) ≃ (Σa' a, C (a, a')) :=
   calc
     (Σa a', C (a, a')) ≃ Σu, C u : assoc_equiv_prod
-                 ... ≃ Σv, C (flip v) : equiv_functor !prod.symm_equiv
+                 ... ≃ Σv, C (flip v) : sigma_equiv_sigma !prod_comm_equiv
                                           (λu, prod.destruct u (λa a', equiv.refl))
                  ... ≃ (Σa' a, C (a, a')) : assoc_equiv_prod
 
-  definition symm_equiv (C : A → A' → Type) : (Σa a', C a a') ≃ (Σa' a, C a a') :=
+  definition sigma_comm_equiv (C : A → A' → Type) : (Σa a', C a a') ≃ (Σa' a, C a a') :=
-  symm_equiv_uncurried (λu, C (prod.pr1 u) (prod.pr2 u))
+  comm_equiv_uncurried (λu, C (prod.pr1 u) (prod.pr2 u))
 
   definition equiv_prod (A B : Type) : (Σ(a : A), B) ≃ A × B :=
   equiv.mk _ (adjointify
@@ -386,10 +389,10 @@ namespace sigma
     proof (λp, prod.destruct p (λa b, idp)) qed
     proof (λs, destruct s (λa b, idp)) qed)
 
-  definition symm_equiv_deg (A B : Type) : (Σ(a : A), B) ≃ Σ(b : B), A :=
+  definition comm_equiv_nondep (A B : Type) : (Σ(a : A), B) ≃ Σ(b : B), A :=
   calc
     (Σ(a : A), B) ≃ A × B : equiv_prod
-              ... ≃ B × A : prod.symm_equiv
+              ... ≃ B × A : prod_comm_equiv
               ... ≃ Σ(b : B), A : equiv_prod
 
   /- ** Universal mapping properties -/
@@ -397,79 +400,78 @@ namespace sigma
 
   section
   open funext
-  --in Coq this can be done without function extensionality
+  definition is_equiv_sigma_rec [instance] (C : (Σa, B a) → Type)
-  definition is_equiv_sigma_rec [instance] [FUN : funext] (C : (Σa, B a) → Type)
     : is_equiv (@sigma.rec _ _ C) :=
   adjointify _ (λ g a b, g ⟨a, b⟩)
-               (λ g, proof path_pi (λu, destruct u (λa b, idp)) qed)
+               (λ g, proof eq_of_homotopy (λu, destruct u (λa b, idp)) qed)
                (λ f, refl f)
 
-  definition equiv_sigma_rec [FUN : funext] (C : (Σa, B a) → Type)
+  definition equiv_sigma_rec (C : (Σa, B a) → Type)
     : (Π(a : A) (b: B a), C ⟨a, b⟩) ≃ (Πxy, C xy) :=
   equiv.mk sigma.rec _
 
   /- *** The negative universal property. -/
 
-  definition coind_uncurried (fg : Σ(f : Πa, B a), Πa, C a (f a)) (a : A) : Σ(b : B a), C a b
+  protected definition coind_uncurried (fg : Σ(f : Πa, B a), Πa, C a (f a)) (a : A)
+    : Σ(b : B a), C a b
   := ⟨fg.1 a, fg.2 a⟩
 
-  definition coind (f : Π a, B a) (g : Π a, C a (f a)) (a : A) : Σ(b : B a), C a b :=
+  protected definition coind (f : Π a, B a) (g : Π a, C a (f a)) (a : A) : Σ(b : B a), C a b :=
   coind_uncurried ⟨f, g⟩ a
 
   --is the instance below dangerous?
   --in Coq this can be done without function extensionality
-  definition is_equiv_coind [instance] [FUN : funext] (C : Πa, B a → Type)
+  definition is_equiv_coind [instance] (C : Πa, B a → Type)
     : is_equiv (@coind_uncurried _ _ C) :=
   adjointify _ (λ h, ⟨λa, (h a).1, λa, (h a).2⟩)
-               (λ h, proof path_pi (λu, !peta) qed)
+               (λ h, proof eq_of_homotopy (λu, !eta) qed)
                (λfg, destruct fg (λ(f : Π (a : A), B a) (g : Π (x : A), C x (f x)), proof idp qed))
 
-  definition equiv_coind [FUN : funext] : (Σ(f : Πa, B a), Πa, C a (f a)) ≃ (Πa, Σb, C a b) :=
+  definition equiv_coind : (Σ(f : Πa, B a), Πa, C a (f a)) ≃ (Πa, Σb, C a b) :=
   equiv.mk coind_uncurried _
   end
 
   /- ** Subtypes (sigma types whose second components are hprops) -/
 
   /- To prove equality in a subtype, we only need equality of the first component. -/
-  definition path_hprop [H : Πa, is_hprop (B a)] (u v : Σa, B a) : u.1 = v.1 → u = v :=
+  definition subtype_eq [H : Πa, is_hprop (B a)] (u v : Σa, B a) : u.1 = v.1 → u = v :=
-  (sigma_path_uncurried ∘ (@inv _ _ pr1 (@is_equiv_dpr1 _ _ (λp, !succ_is_trunc))))
+  (sigma_eq_uncurried ∘ (@inv _ _ pr1 (@is_equiv_pr1 _ _ (λp, !is_trunc.is_trunc_eq))))
 
-  definition is_equiv_path_hprop [instance] [H : Πa, is_hprop (B a)] (u v : Σa, B a)
+  definition is_equiv_subtype_eq [instance] [H : Πa, is_hprop (B a)] (u v : Σa, B a)
-      : is_equiv (path_hprop u v) :=
+      : is_equiv (subtype_eq u v) :=
-  !is_equiv.compose
+  !is_equiv_compose
 
-  definition equiv_path_hprop [H : Πa, is_hprop (B a)] (u v : Σa, B a) : (u.1 = v.1) ≃ (u = v)
+  definition equiv_subtype [H : Πa, is_hprop (B a)] (u v : Σa, B a) : (u.1 = v.1) ≃ (u = v)
   :=
-  equiv.mk !path_hprop _
+  equiv.mk !subtype_eq _
 
   /- truncatedness -/
-  definition trunc_sigma [instance] (B : A → Type) (n : trunc_index)
+  definition is_trunc_sigma (B : A → Type) (n : trunc_index)
       [HA : is_trunc n A] [HB : Πa, is_trunc n (B a)] : is_trunc n (Σa, B a) :=
   begin
   reverts (A, B, HA, HB),
   apply (trunc_index.rec_on n),
     intros (A, B, HA, HB),
-      fapply trunc_equiv',
+      fapply is_trunc.is_trunc_equiv_closed,
         apply equiv.symm,
-          apply equiv_center_of_contr,
+          apply sigma_equiv_of_is_contr_pr1,
      intros (n, IH, A, B, HA, HB),
-       fapply is_trunc_succ, intros (u, v),
+       fapply is_trunc.is_trunc_succ_intro, intros (u, v),
-      fapply trunc_equiv',
+      fapply is_trunc.is_trunc_equiv_closed,
-         apply equiv_sigma_path,
+         apply equiv_sigma_eq,
          apply IH,
-           apply succ_is_trunc,
+           apply is_trunc.is_trunc_eq,
            intro p,
              show is_trunc n (p ▹ u .2 = v .2), from
-             succ_is_trunc n (p ▹ u.2) (v.2),
+             is_trunc.is_trunc_eq n (p ▹ u.2) (v.2),
   end
 
 end sigma
 
-open truncation sigma
+attribute sigma.is_trunc_sigma [instance]
 
-namespace prod
+open is_trunc sigma prod
-  /- truncatedness -/
+/- truncatedness -/
-  definition trunc_prod [instance] (A B : Type) (n : trunc_index)
+definition prod.is_trunc_prod [instance] (A B : Type) (n : trunc_index)
-      [HA : is_trunc n A] [HB : is_trunc n B] : is_trunc n (A × B) :=
+  [HA : is_trunc n A] [HB : is_trunc n B] : is_trunc n (A × B) :=
-  trunc_equiv' n !equiv_prod
+is_trunc.is_trunc_equiv_closed n !equiv_prod
-end prod

hott/types/trunc.hlean

@@ -0,0 +1,119 @@
+/-
+Copyright (c) 2015 Jakob von Raumer. All rights reserved.
+Released under Apache 2.0 license as described in the file LICENSE.
+
+Module: types.trunc
+Authors: Jakob von Raumer, Floris van Doorn
+
+Properties of is_trunc
+-/
+
+import types.pi types.path
+
+open sigma sigma.ops pi function eq equiv path funext
+
+namespace is_trunc
+
+  definition is_contr.sigma_char (A : Type) :
+    (Σ (center : A), Π (a : A), center = a) ≃ (is_contr A) :=
+  begin
+    fapply equiv.mk,
+      intro S, apply is_contr.mk, exact S.2,
+    fapply is_equiv.adjointify,
+        intro H, apply sigma.mk, exact (@contr A H),
+      intro H, apply (is_trunc.rec_on H), intro Hint,
+      apply (contr_internal.rec_on Hint), intros (H1, H2),
+      apply idp,
+    intro S, apply (sigma.rec_on S), intros (H1, H2),
+    apply idp,
+  end
+
+  set_option pp.implicit true
+  definition is_trunc.pi_char (n : trunc_index) (A : Type) :
+    (Π (x y : A), is_trunc n (x = y)) ≃ (is_trunc (n .+1) A) :=
+  begin
+    fapply equiv.mk,
+      intro H, apply is_trunc_succ_intro,
+    fapply is_equiv.adjointify,
+        intros (H, x, y), apply is_trunc_eq,
+      intro H, apply (is_trunc.rec_on H), intro Hint, apply idp,
+    intro P,
+    unfold compose, apply eq_of_homotopy,
+    exact sorry,
+  end
+
+  definition is_hprop_is_trunc {n : trunc_index} :
+    Π (A : Type), is_hprop (is_trunc n A) :=
+  begin
+    apply (trunc_index.rec_on n),
+      intro A,
+      apply is_trunc_is_equiv_closed, apply equiv.to_is_equiv,
+      apply is_contr.sigma_char,
+      apply (@is_hprop.mk), intros,
+      fapply sigma_eq, apply x.2,
+      apply (@is_hprop.elim),
+      apply is_trunc_pi, intro a,
+      apply is_hprop.mk, intros (w, z),
+      assert (H : is_hset A),
+        apply is_trunc_succ, apply is_trunc_succ,
+        apply is_contr.mk, exact y.2,
+      fapply (@is_hset.elim A _ _ _ w z),
+    intros (n', IH, A),
+    apply is_trunc_is_equiv_closed,
+      apply equiv.to_is_equiv,
+      apply is_trunc.pi_char,
+  end
+
+  definition is_trunc_succ_of_imp_is_trunc_succ {A : Type} {n : trunc_index} (H : A → is_trunc (n.+1) A)
+      : is_trunc (n.+1) A :=
+  @is_trunc_succ_intro _ _ (λx y, @is_trunc_eq _ _ (H x) x y)
+
+  definition is_trunc_of_imp_is_trunc_of_leq {A : Type} {n : trunc_index} (Hn : -1 ≤ n)
+      (H : A → is_trunc n A) : is_trunc n A :=
+  trunc_index.rec_on n (λHn H, empty.rec _ Hn)
+                       (λn IH Hn, is_trunc_succ_of_imp_is_trunc_succ)
+                       Hn H
+
+  definition is_hset_of_axiom_K {A : Type} (K : Π{a : A} (p : a = a), p = idp) : is_hset A :=
+  is_hset.mk _ (λa b p q, eq.rec_on q K p)
+
+  theorem is_hset_of_relation.{u} {A : Type.{u}} (R : A → A → Type.{u})
+    (mere : Π(a b : A), is_hprop (R a b)) (refl : Π(a : A), R a a)
+    (imp : Π{a b : A}, R a b → a = b) : is_hset A :=
+  is_hset_of_axiom_K
+    (λa p,
+      have H2 : transport (λx, R a x → a = x) p (@imp a a) = @imp a a, from !apD,
+      have H3 : Π(r : R a a), transport (λx, a = x) p (imp r)
+                              = imp (transport (λx, R a x) p r), from
+        to_fun (symm !heq_pi) H2,
+      have H4 : imp (refl a) ⬝ p = imp (refl a), from
+        calc
+          imp (refl a) ⬝ p = transport (λx, a = x) p (imp (refl a)) : transport_paths_r
+            ... = imp (transport (λx, R a x) p (refl a)) : H3
+            ... = imp (refl a) : is_hprop.elim,
+      cancel_left (imp (refl a)) _ _ H4)
+
+  definition relation_equiv_eq {A : Type} (R : A → A → Type)
+    (mere : Π(a b : A), is_hprop (R a b)) (refl : Π(a : A), R a a)
+    (imp : Π{a b : A}, R a b → a = b) (a b : A) : R a b ≃ a = b :=
+  @equiv_of_is_hprop _ _ _
+    (@is_trunc_eq _ _ (is_hset_of_relation R mere refl @imp) a b)
+    imp
+    (λp, p ▹ refl a)
+
+  definition is_hset_of_double_neg_elim {A : Type} (H : Π(a b : A), ¬¬a = b → a = b)
+    : is_hset A :=
+  is_hset_of_relation (λa b, ¬¬a = b) _ (λa n, n idp) H
+
+  section
+  open decidable
+  definition is_hset_of_decidable_eq (A : Type)
+    [H : Π(a b : A), decidable (a = b)] : is_hset A :=
+  is_hset_of_double_neg_elim (λa b, by_contradiction)
+  end
+
+  definition is_trunc_of_axiom_K_of_leq {A : Type} (n : trunc_index) (H : -1 ≤ n)
+    (K : Π(a : A), is_trunc n (a = a)) : is_trunc (n.+1) A :=
+  @is_trunc_succ_intro _ _ (λa b, is_trunc_of_imp_is_trunc_of_leq H (λp, eq.rec_on p !K))
+
+end is_trunc

src/library/constants.txt

@@ -101,9 +101,9 @@ tactic.unfold
 tactic.whnf
 true
 true.intro
-truncation
+is_trunc
-truncation.is_trunc
+is_trunc
-truncation.nat_to_trunc_index
+is_trunc.trunc_index.of_nat
 unit
 unit.star
 well_founded