Require Import Eqdep JMeq List.
Require Import CpdtTactics.
Set Implicit Arguments.
(* Exercise (40 minutes) : Axioms equivalence *)
(* Here we proove the equivalence of 4 statements about dependent equality *)
Section equivalences.
Variable U : Type.
(* Streicher's K axiom *)
Print Streicher_K_.
(* Uniqueness of reflexive identity proofs *)
Print UIP_refl_.
(* Uniqueness of identity proofs *)
Print UIP_.
(* Invariance by substitution of reflexive equality proofs *)
Print Eq_rect_eq.
(* Injectivity of dependent equality*)
Print Eq_dep_eq.
Lemma eq_rect_eq_eq_dep_eq : Eq_rect_eq U -> Eq_dep_eq U.
unfold Eq_rect_eq. unfold Eq_dep_eq.
(*By Antal Antal Spector-Zabusky*)
Proof.
unfold Eq_rect_eq, Eq_dep_eq; intros.
inversion H0.
generalize (eq_sigT_snd (P:=P) H3).
generalize (H p P x (eq_sigT_fst H3)).
apply eq_trans.
(*By Arthur Azevedo de Amorim*)
(*
intros Ax P p x y H.
assert (H' : forall p' y' (Hxy : eq_dep U P p x p' y') (Hpp' : p = p'),
eq_rect p P x p' Hpp' = y').
clear - Ax. intros p' y' Hxy' Hpp'. destruct Hxy'.
rewrite <- Ax. trivial.
change x with (eq_rect p P x p eq_refl).
auto.
*)
Qed.
Lemma eq_dep_eq__UIP : Eq_dep_eq U -> UIP_ U.
unfold Eq_dep_eq, UIP_. intros H x y p1 p2.
crush. eapply H. rewrite p2. constructor.
(*By Arthur Azevedo de Amorim*)
(*
unfold Eq_dep_eq, UIP_.
intros Ax x y p1 p2.
assert (H : eq_dep U (eq x) y p1 y p2).
destruct p1. destruct p2. trivial.
auto.
*)
Qed.
Print Assumptions eq_dep_eq__UIP.
Lemma UIP__UIP_refl : UIP_ U -> UIP_refl_ U.
unfold UIP_, UIP_refl_.
auto.
Qed.
Lemma UIP_refl__Streicher_K : UIP_refl_ U -> Streicher_K_ U.
unfold UIP_refl_, Streicher_K_.
intros H1 x P H2 p. pose proof (H1 x p) as H3. rewrite H3. assumption.
Qed.
Lemma Streicher_K__eq_rect_eq : Streicher_K_ U -> Eq_rect_eq U.
unfold Streicher_K_, Eq_rect_eq.
intros Ax p Q x h.
apply (Ax p (fun Heq => x = eq_rect p Q x p Heq)).
trivial.
Qed.
End equivalences.
(*End Exercise*)
(* Exercise 10 minutes - Inductive Heterogeneous Lists *)
(* Prove that [happ] is associative for inductive heterogeneous lists*)
Section hlist.
Variable A : Type.
Variable B : A -> Type.
Inductive hlist : list A -> Type :=
| HNil : hlist nil
| HCons : forall (x : A) (ls : list A), B x -> hlist ls -> hlist (x :: ls).
End hlist.
Implicit Arguments HNil [A B].
Implicit Arguments HCons [A B x ls].
Section happ.
Variable A : Type.
Variable B : A -> Type.
Fixpoint happ (ls1 ls2 : list A) (hl1: hlist B ls1) (hl2 : hlist B ls2) :
hlist B (ls1 ++ ls2) :=
match hl1 in hlist _ l1 return hlist B (l1 ++ ls2) with
| HNil => hl2
| HCons _ _ x hl1' => HCons x (happ hl1' hl2)
end.
Theorem happ_ass : forall ls1 ls2 ls3 (hls1 : hlist B ls1) (hls2 : hlist B ls2)
(hls3 : hlist B ls3)
(pf : (ls1 ++ ls2) ++ ls3 = ls1 ++ (ls2 ++ ls3)),
happ hls1 (happ hls2 hls3)
= match pf in (_ = ls) return hlist _ ls with
| eq_refl => happ (happ hls1 hls2) hls3
end.
induction hls1; crush.
rewrite (UIP_refl _ _ _); reflexivity.
rewrite (IHhls1 _ _ H1).
generalize pf H1.
rewrite <- app_ass.
intros.
repeat rewrite (UIP_refl _ _ _).
reflexivity.
Qed.
End happ.
Implicit Arguments happ [A B ls1 ls2].
(*End Exercise*)
(* Exercise : 45 minutes - unject_inverse *)
(* Our favorite indexed lists *)
Section ilist.
Variable A : Set.
Inductive ilist : nat -> Set :=
| Nil : ilist O
| Cons : forall n, A -> ilist n -> ilist (S n).
Fixpoint inject (ls : list A) : ilist (length ls) :=
match ls with
| nil => Nil
| h :: t => Cons h (inject t)
end.
Fixpoint unject n (ls : ilist n) : list A :=
match ls with
| Nil => nil
| Cons _ h t => h :: unject t
end.
(*
It is quite easy to prove [unject (inject ls) = ls]. We might want to prove the
reverse theorem, that is [inject (unject ls) = ls]. However, stated like this, the
theorem will not typecheck, just like fhapp_ass. Modify the statement like Adam did
for fhapp_ass and prove it using the same proof technique.
*)
Theorem unject_inverse : forall n (ls : ilist n)
(pf : (length (unject ls) = n)),
ls = match pf in _=n' return ilist n' with
|eq_refl => inject (unject ls)
end.
Proof.
induction ls; crush.
rewrite (UIP_refl _ _ pf). reflexivity.
rewrite (IHls H) at 1.
generalize (inject (unject ls)).
generalize pf H. rewrite H.
intros.
repeat rewrite (UIP_refl _ _ _).
reflexivity.
Qed.
End ilist.
(* End Exercise *)
Infix "==" := JMeq (at level 70, no associativity).
(* Exercise - 10 minutes - Inductive Homegeneous lists #2 *)
(* Use the same technique to prove the following theorem *)
Section happ'.
Variable A : Type.
Variable B : A -> Type.
Theorem happ_ass' : forall ls1 ls2 ls3 (hls1 : hlist B ls1) (hls2 : hlist B ls2)
(hls3 : hlist B ls3),
happ hls1 (happ hls2 hls3) == happ (happ hls1 hls2) hls3.
induction hls1; crush.
generalize (happ hls1 (happ hls2 hls3))
(happ (happ hls1 hls2) hls3)
(IHhls1 hls2 hls3).
rewrite app_ass.
intros ? ? H; rewrite H; reflexivity.
Qed.
End happ'.
(*End Exercise*)
(* Exercise (10 minutes): unject_inverse #2*)
(* Prove the following theorem using Adam's proof technique *)
Section ilist'.
Variable A : Set.
Lemma length_unject : forall n (l : ilist A n),
n = length (unject l).
induction l; crush.
Qed.
Theorem unject_inverse' : forall n (ls : ilist A n),
ls == inject (unject ls).
induction ls; crush.
generalize (inject (unject ls)) IHls.
rewrite <- length_unject.
intros ls' H.
rewrite H.
trivial.
Qed.
End ilist'.
(*End Exercise*)
(* Exercise (15 minutes) - Magic lemma ?*)
(*
1.
*In the previous exercise (unject_inverse #2), do you see when [rewrite] used [JM_eq] ?
It is the [rewrite H1] that used the axiom [JM_eq].
*Do you think it would be possible to come up with a lemma such as [pair_cong] to
*help [rewrite] not to use this axiom ?
*If yes, write this lemma, prove it, add it as a hint, and prove [unject_inverse''].
*If not, explain what is the problem.
It is not possible. We would like to prove something like
Theorem cons_cong : forall A1 A2 n1 n2 (a1 : A1) (a2 : A2)
(l1 : ilist A1 n1) (l2 : ilist A2 n2),
a1 == a2 ->
l1 == l2 ->
Cons a1 l1 == Cons a2 l2.
But when we try to use the proof l1 == l2, we need to abstract over (ilist A2 n2),
which leads to an ill-typed term, since Cons can only be applied to ilists. Cons is not
polymorphic enough.
*)
(*
2.
Same questions with (Inductive Heterogeneous lists #2)
We will run into the same problem, since HCons is again not enough polymorphic to
abstract the type of one of its arguments.
*)
(*End exercise*)