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

refactor(library/standard): reorganize cast and piext theorems

Browse source 
Signed-off-by: Leonardo de Moura <leonardo@microsoft.com>
This commit is contained in:
Leonardo de Moura 2014-07-12 20:24:36 +01:00
parent 6d95250d4b
commit ae2f019c23
2 changed files with 25 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
library/standard/cast.lean
View file

@ -81,3 +81,24 @@ theorem cast_trans {A B C : Type} (Hab : A = B) (Hbc : B = C) (a : A) : cast Hbc
:= heq_to_eq (calc cast Hbc (cast Hab a) == cast Hab a : cast_heq Hbc (cast Hab a) := heq_to_eq (calc cast Hbc (cast Hab a) == cast Hab a : cast_heq Hbc (cast Hab a)
... == a : cast_heq Hab a ... == a : cast_heq Hab a
... == cast (trans Hab Hbc) a : hsymm (cast_heq (trans Hab Hbc) a)) ... == cast (trans Hab Hbc) a : hsymm (cast_heq (trans Hab Hbc) a))
theorem pi_eq {A : Type} {B B' : A → Type} (H : B = B') : (Π x, B x) = (Π x, B' x)
:= subst H (refl (Π x, B x))
theorem cast_app' {A : Type} {B B' : A → Type} (H : B = B') (f : Π x, B x) (a : A) : cast (pi_eq H) f a == f a
:= have H1 : ∀ (H : (Π x, B x) = (Π x, B x)), cast H f a == f a, from
assume H, eq_to_heq (congr1 (cast_eq H f) a),
have H2 : ∀ (H : (Π x, B x) = (Π x, B' x)), cast H f a == f a, from
subst H H1,
H2 (pi_eq H)
theorem cast_pull {A : Type} {B B' : A → Type} (H : B = B') (f : Π x, B x) (a : A) :
cast (pi_eq H) f a = cast (congr1 H a) (f a)
:= heq_to_eq (calc cast (pi_eq H) f a == f a : cast_app' H f a
... == cast (congr1 H a) (f a) : hsymm (cast_heq (congr1 H a) (f a)))
theorem hcongr1' {A : Type} {B B' : A → Type} {f : Π x, B x} {f' : Π x, B' x} (a : A) (H1 : f == f') (H2 : B = B') : f a == f' a
:= heq_elim H1 (λ (Ht : (Π x, B x) = (Π x, B' x)) (Hw : cast Ht f = f'),
calc f a == cast (pi_eq H2) f a : hsymm (cast_app' H2 f a)
... = cast Ht f a : refl (cast Ht f a)
... = f' a : congr1 Hw a)

17
library/standard/piext.lean
View file

@ -9,21 +9,12 @@ axiom piext {A : Type} {B B' : A → Type} {H : inhabited (Π x, B x)} : (Π x,
theorem cast_app {A : Type} {B B' : A → Type} (H : (Π x, B x) = (Π x, B' x)) (f : Π x, B x) (a : A) : cast H f a == f a theorem cast_app {A : Type} {B B' : A → Type} (H : (Π x, B x) = (Π x, B' x)) (f : Π x, B x) (a : A) : cast H f a == f a
:= have Hi [fact] : inhabited (Π x, B x), from inhabited_intro f, := have Hi [fact] : inhabited (Π x, B x), from inhabited_intro f,
have Hb : B = B', from piext H, have Hb : B = B', from piext H,
have H1 : ∀ (H : (Π x, B x) = (Π x, B x)), cast H f a == f a, from cast_app' Hb f a
assume H, eq_to_heq (congr1 (cast_eq H f) a),
have H2 : ∀ (H : (Π x, B x) = (Π x, B' x)), cast H f a == f a, from
subst Hb H1,
H2 H
theorem cast_pull {A : Type} {B B' : A → Type} (f : Π x, B x) (a : A) (Hb : (Π x, B x) = (Π x, B' x)) (Hba : (B a) = (B' a)) :
cast Hb f a = cast Hba (f a)
:= heq_to_eq (calc cast Hb f a == f a : cast_app Hb f a
... == cast Hba (f a) : hsymm (cast_heq Hba (f a)))
theorem hcongr1 {A : Type} {B B' : A → Type} {f : Π x, B x} {f' : Π x, B' x} (a : A) (H : f == f') : f a == f' a theorem hcongr1 {A : Type} {B B' : A → Type} {f : Π x, B x} {f' : Π x, B' x} (a : A) (H : f == f') : f a == f' a
:= heq_elim H (λ (Ht : (Π x, B x) = (Π x, B' x)) (Hw : cast Ht f = f'), := have Hi [fact] : inhabited (Π x, B x), from inhabited_intro f,
calc f a == cast Ht f a : hsymm (cast_app Ht f a) have Hb : B = B', from piext (type_eq H),
... = f' a : congr1 Hw a) hcongr1' a H Hb
theorem hcongr {A A' : Type} {B : A → Type} {B' : A' → Type} {f : Π x, B x} {f' : Π x, B' x} {a : A} {a' : A'} theorem hcongr {A A' : Type} {B : A → Type} {B' : A' → Type} {f : Π x, B x} {f' : Π x, B' x} {a : A} {a' : A'}
(Hff' : f == f') (Haa' : a == a') : f a == f' a' (Hff' : f == f') (Haa' : a == a') : f a == f' a'