michael/lean2
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

feat(hott): add some [constructor] attributes

Browse source
This commit is contained in:
Floris van Doorn 2016-03-24 17:28:29 -04:00 committed by Leonardo de Moura
parent 3887efa7c1
commit 54da5bcbda
3 changed files with 10 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
hott/homotopy/join.hlean
View file

@ -489,7 +489,7 @@ end join_switch
protected definition ap_assoc_inv_glue_inl {A B : Type} (C : Type) (a : A) (b : B)
: ap (to_inv (join.assoc A B C)) (glue a (inl b)) = ap inl (glue a b) :=
begin
unfold join.assoc, unfold equiv.trans, rewrite ap_compose, krewrite join.elim_glue,
unfold join.assoc, rewrite ap_compose, krewrite join.elim_glue,
rewrite ap_compose, krewrite join.elim_glue, rewrite ap_inv, krewrite join.elim_glue,
unfold switch_coh, unfold join.symm, unfold join.swap, esimp, rewrite eq.inv_inv
end
@ -497,7 +497,7 @@ end join_switch
protected definition ap_assoc_inv_glue_inr {A C : Type} (B : Type) (a : A) (c : C)
: ap (to_inv (join.assoc A B C)) (glue a (inr c)) = glue (inl a) c :=
begin
unfold join.assoc, unfold equiv.trans, rewrite ap_compose, krewrite join.elim_glue,
unfold join.assoc, rewrite ap_compose, krewrite join.elim_glue,
rewrite ap_compose, krewrite join.elim_glue, rewrite ap_inv, krewrite join.elim_glue,
unfold switch_coh, unfold join.symm, unfold join.swap, esimp, rewrite eq.inv_inv
end

6
hott/init/equiv.hlean
View file

@ -148,7 +148,7 @@ namespace is_equiv
ap_con_eq_con_ap (right_inv f) q,inv_con_cancel_left,ap_id],
end
definition is_equiv_ap [instance] (x y : A) : is_equiv (ap f : x = y → f x = f y) :=
definition is_equiv_ap [instance] [constructor] (x y : A) : is_equiv (ap f : x = y → f x = f y) :=
adjointify
(ap f)
(eq_of_fn_eq_fn' f)
@ -313,10 +313,10 @@ namespace equiv
protected definition refl [refl] [constructor] : A ≃ A :=
equiv.mk id !is_equiv_id
protected definition symm [symm] (f : A ≃ B) : B ≃ A :=
protected definition symm [symm] [constructor] (f : A ≃ B) : B ≃ A :=
equiv.mk f⁻¹ !is_equiv_inv
protected definition trans [trans] (f : A ≃ B) (g : B ≃ C) : A ≃ C :=
protected definition trans [trans] [constructor] (f : A ≃ B) (g : B ≃ C) : A ≃ C :=
equiv.mk (g ∘ f) !is_equiv_compose
infixl ` ⬝e `:75 := equiv.trans

10
hott/types/fiber.hlean
View file

@ -72,7 +72,7 @@ namespace fiber
-- pre and post composition with equivalences
open function
protected definition equiv_postcompose {B' : Type} (g : B → B') [H : is_equiv g]
protected definition equiv_postcompose [constructor] {B' : Type} (g : B → B') [H : is_equiv g]
: fiber (g ∘ f) (g b) ≃ fiber f b :=
calc
fiber (g ∘ f) (g b) ≃ Σa : A, g (f a) = g b : fiber.sigma_char
@ -82,7 +82,7 @@ namespace fiber
end
... ≃ fiber f b : fiber.sigma_char
protected definition equiv_precompose {A' : Type} (g : A' → A) [H : is_equiv g]
protected definition equiv_precompose [constructor] {A' : Type} (g : A' → A) [H : is_equiv g]
: fiber (f ∘ g) b ≃ fiber f b :=
calc
fiber (f ∘ g) b ≃ Σa' : A', f (g a') = b : fiber.sigma_char
@ -98,7 +98,7 @@ open unit is_trunc pointed
namespace fiber
definition fiber_star_equiv (A : Type) : fiber (λx : A, star) star ≃ A :=
definition fiber_star_equiv [constructor] (A : Type) : fiber (λx : A, star) star ≃ A :=
begin
fapply equiv.MK,
{ intro f, cases f with a H, exact a },
@ -108,7 +108,7 @@ namespace fiber
rewrite [is_set.elim H (refl star)] }
end
definition fiber_const_equiv (A : Type) (a₀ : A) (a : A)
definition fiber_const_equiv [constructor] (A : Type) (a₀ : A) (a : A)
: fiber (λz : unit, a₀) a ≃ a₀ = a :=
calc
fiber (λz : unit, a₀) a
@ -131,7 +131,7 @@ namespace fiber
variables {A : Type} {P Q : A → Type}
variable (f : Πa, P a → Q a)
definition fiber_total_equiv {a : A} (q : Q a)
definition fiber_total_equiv [constructor] {a : A} (q : Q a)
: fiber (total f) ⟨a , q⟩ ≃ fiber (f a) q :=
calc
fiber (total f) ⟨a , q⟩