2014-08-15 03:12:54 +00:00
|
|
|
-- Copyright (c) 2014 Microsoft Corporation. All rights reserved.
|
|
|
|
-- Released under Apache 2.0 license as described in the file LICENSE.
|
2014-09-26 23:36:04 +00:00
|
|
|
-- Author: Leonardo de Moura, Jeremy Avigad, Floris van Doorn
|
2014-09-16 18:44:50 +00:00
|
|
|
import logic.core.inhabited logic.core.eq
|
2014-10-02 00:51:17 +00:00
|
|
|
open inhabited eq.ops
|
2014-08-20 02:32:44 +00:00
|
|
|
|
2014-08-15 03:12:54 +00:00
|
|
|
inductive sigma {A : Type} (B : A → Type) : Type :=
|
2014-08-22 22:46:10 +00:00
|
|
|
dpair : Πx : A, B x → sigma B
|
2014-08-15 03:12:54 +00:00
|
|
|
|
|
|
|
notation `Σ` binders `,` r:(scoped P, sigma P) := r
|
|
|
|
|
|
|
|
namespace sigma
|
|
|
|
section
|
|
|
|
parameters {A : Type} {B : A → Type}
|
|
|
|
|
2014-09-17 21:39:05 +00:00
|
|
|
definition dpr1 (p : Σ x, B x) : A := rec (λ a b, a) p
|
|
|
|
definition dpr2 (p : Σ x, B x) : B (dpr1 p) := rec (λ a b, b) p
|
2014-08-15 03:12:54 +00:00
|
|
|
|
2014-09-04 23:36:06 +00:00
|
|
|
theorem dpr1_dpair (a : A) (b : B a) : dpr1 (dpair a b) = a := rfl
|
|
|
|
theorem dpr2_dpair (a : A) (b : B a) : dpr2 (dpair a b) = b := rfl
|
2014-08-15 03:12:54 +00:00
|
|
|
|
2014-09-19 22:04:52 +00:00
|
|
|
protected theorem destruct {P : sigma B → Prop} (p : sigma B) (H : ∀a b, P (dpair a b)) : P p :=
|
2014-09-04 22:03:59 +00:00
|
|
|
rec H p
|
2014-08-15 03:12:54 +00:00
|
|
|
|
|
|
|
theorem dpair_ext (p : sigma B) : dpair (dpr1 p) (dpr2 p) = p :=
|
2014-09-05 14:48:36 +00:00
|
|
|
destruct p (take a b, rfl)
|
|
|
|
|
|
|
|
theorem dpair_eq {a₁ a₂ : A} {b₁ : B a₁} {b₂ : B a₂} (H₁ : a₁ = a₂) (H₂ : eq.rec_on H₁ b₁ = b₂) :
|
|
|
|
dpair a₁ b₁ = dpair a₂ b₂ :=
|
2014-09-26 23:36:04 +00:00
|
|
|
congr_arg2_dep dpair H₁ H₂
|
2014-09-05 14:48:36 +00:00
|
|
|
|
2014-09-19 22:04:52 +00:00
|
|
|
protected theorem equal {p₁ p₂ : Σx : A, B x} :
|
feat(library): add constructions of categories, some changes in eq, sigma and path
in eq, add theorem for proof irrelevance and congruence for binary functions
in sigma, add some support for triplets
in path, comment out two unneccesary definitions
in category, add Cat, slice, coslice, product and arrow categories, also add fully bundled approach
2014-09-22 18:48:09 +00:00
|
|
|
∀(H₁ : dpr1 p₁ = dpr1 p₂) (H₂ : eq.rec_on H₁ (dpr2 p₁) = dpr2 p₂), p₁ = p₂ :=
|
2014-09-05 14:48:36 +00:00
|
|
|
destruct p₁ (take a₁ b₁, destruct p₂ (take a₂ b₂ H₁ H₂, dpair_eq H₁ H₂))
|
|
|
|
|
2014-09-19 22:04:52 +00:00
|
|
|
protected theorem is_inhabited [instance] (H₁ : inhabited A) (H₂ : inhabited (B (default A))) :
|
2014-08-15 03:12:54 +00:00
|
|
|
inhabited (sigma B) :=
|
2014-09-05 14:48:36 +00:00
|
|
|
inhabited.destruct H₁ (λa, inhabited.destruct H₂ (λb, inhabited.mk (dpair (default A) b)))
|
2014-08-15 03:12:54 +00:00
|
|
|
end
|
feat(library): add constructions of categories, some changes in eq, sigma and path
in eq, add theorem for proof irrelevance and congruence for binary functions
in sigma, add some support for triplets
in path, comment out two unneccesary definitions
in category, add Cat, slice, coslice, product and arrow categories, also add fully bundled approach
2014-09-22 18:48:09 +00:00
|
|
|
|
|
|
|
section trip_quad
|
|
|
|
parameters {A : Type} {B : A → Type} {C : Πa, B a → Type} {D : Πa b, C a b → Type}
|
|
|
|
|
|
|
|
definition dtrip (a : A) (b : B a) (c : C a b) := dpair a (dpair b c)
|
|
|
|
definition dquad (a : A) (b : B a) (c : C a b) (d : D a b c) := dpair a (dpair b (dpair c d))
|
|
|
|
|
|
|
|
definition dpr1' (x : Σ a, B a) := dpr1 x
|
|
|
|
definition dpr2' (x : Σ a b, C a b) := dpr1 (dpr2 x)
|
|
|
|
definition dpr3 (x : Σ a b, C a b) := dpr2 (dpr2 x)
|
|
|
|
definition dpr3' (x : Σ a b c, D a b c) := dpr1 (dpr2 (dpr2 x))
|
|
|
|
definition dpr4 (x : Σ a b c, D a b c) := dpr2 (dpr2 (dpr2 x))
|
|
|
|
|
2014-09-26 23:36:04 +00:00
|
|
|
theorem dtrip_eq {a₁ a₂ : A} {b₁ : B a₁} {b₂ : B a₂} {c₁ : C a₁ b₁} {c₂ : C a₂ b₂}
|
|
|
|
(H₁ : a₁ = a₂) (H₂ : eq.rec_on H₁ b₁ = b₂) (H₃ : eq.rec_on (congr_arg2_dep C H₁ H₂) c₁ = c₂) :
|
|
|
|
dtrip a₁ b₁ c₁ = dtrip a₂ b₂ c₂ :=
|
|
|
|
congr_arg3_dep dtrip H₁ H₂ H₃
|
feat(library): add constructions of categories, some changes in eq, sigma and path
in eq, add theorem for proof irrelevance and congruence for binary functions
in sigma, add some support for triplets
in path, comment out two unneccesary definitions
in category, add Cat, slice, coslice, product and arrow categories, also add fully bundled approach
2014-09-22 18:48:09 +00:00
|
|
|
end trip_quad
|
|
|
|
|
2014-09-26 23:36:04 +00:00
|
|
|
theorem dtrip_eq_ndep {A B : Type} {C : A → B → Type} {a₁ a₂ : A} {b₁ b₂ : B}
|
feat(library): add constructions of categories, some changes in eq, sigma and path
in eq, add theorem for proof irrelevance and congruence for binary functions
in sigma, add some support for triplets
in path, comment out two unneccesary definitions
in category, add Cat, slice, coslice, product and arrow categories, also add fully bundled approach
2014-09-22 18:48:09 +00:00
|
|
|
{c₁ : C a₁ b₁} {c₂ : C a₂ b₂} (H₁ : a₁ = a₂) (H₂ : b₁ = b₂)
|
2014-09-26 23:36:04 +00:00
|
|
|
(H₃ : eq.rec_on (congr_arg2 C H₁ H₂) c₁ = c₂) :
|
feat(library): add constructions of categories, some changes in eq, sigma and path
in eq, add theorem for proof irrelevance and congruence for binary functions
in sigma, add some support for triplets
in path, comment out two unneccesary definitions
in category, add Cat, slice, coslice, product and arrow categories, also add fully bundled approach
2014-09-22 18:48:09 +00:00
|
|
|
dtrip a₁ b₁ c₁ = dtrip a₂ b₂ c₂ :=
|
2014-09-26 23:36:04 +00:00
|
|
|
congr_arg3_ndep_dep dtrip H₁ H₂ H₃
|
|
|
|
|
|
|
|
theorem trip.equal_ndep {A B : Type} {C : A → B → Type} {p₁ p₂ : Σa b, C a b} :
|
feat(library): add constructions of categories, some changes in eq, sigma and path
in eq, add theorem for proof irrelevance and congruence for binary functions
in sigma, add some support for triplets
in path, comment out two unneccesary definitions
in category, add Cat, slice, coslice, product and arrow categories, also add fully bundled approach
2014-09-22 18:48:09 +00:00
|
|
|
∀(H₁ : dpr1 p₁ = dpr1 p₂) (H₂ : dpr2' p₁ = dpr2' p₂)
|
2014-09-26 23:36:04 +00:00
|
|
|
(H₃ : eq.rec_on (congr_arg2 C H₁ H₂) (dpr3 p₁) = dpr3 p₂), p₁ = p₂ :=
|
feat(library): add constructions of categories, some changes in eq, sigma and path
in eq, add theorem for proof irrelevance and congruence for binary functions
in sigma, add some support for triplets
in path, comment out two unneccesary definitions
in category, add Cat, slice, coslice, product and arrow categories, also add fully bundled approach
2014-09-22 18:48:09 +00:00
|
|
|
destruct p₁ (take a₁ q₁, destruct q₁ (take b₁ c₁, destruct p₂ (take a₂ q₂, destruct q₂
|
2014-09-26 23:36:04 +00:00
|
|
|
(take b₂ c₂ H₁ H₂ H₃, dtrip_eq_ndep H₁ H₂ H₃))))
|
feat(library): add constructions of categories, some changes in eq, sigma and path
in eq, add theorem for proof irrelevance and congruence for binary functions
in sigma, add some support for triplets
in path, comment out two unneccesary definitions
in category, add Cat, slice, coslice, product and arrow categories, also add fully bundled approach
2014-09-22 18:48:09 +00:00
|
|
|
|
2014-08-15 03:12:54 +00:00
|
|
|
end sigma
|